public Procedure( Interp interp, // Current interpreter. Namespace ns, // The namespace that the proc is defined in. String name, // Name of the procedure. TclObject args, // The formal arguments of this procedure. TclObject b, // The body of the procedure. String sFileName, // Initial value for the srcFileName member. int sLineNumber) // Initial value for the srcLineNumber member. throws TclException // Standard Tcl exception. { srcFileName = sFileName; srcLineNumber = sLineNumber; // Break up the argument list into argument specifiers, then process // each argument specifier. int numArgs = TclList.getLength(interp, args); argList = new TclObject[numArgs][2]; for (int i = 0; i < numArgs; i++) { // Now divide the specifier up into name and default. TclObject argSpec = TclList.index(interp, args, i); int specLen = TclList.getLength(interp, argSpec); if (specLen == 0) { // NEM 2010-06-14: updated to match Tcl 8.5+ and [apply] throw new TclException(interp, "argument with no name"); } if (specLen > 2) { throw new TclException( interp, "too many fields in argument " + "specifier \"" + argSpec + "\""); } TclObject argName = TclList.index(interp, argSpec, 0); String argNameStr = argName.toString(); if (argNameStr.indexOf("::") != -1) { // NEM: 2010-06-14: updated to match Tcl 8.5+ throw new TclException(interp, "formal parameter \"" + argSpec + "\" is not a simple name"); } else if (Var.isArrayVarname(argNameStr)) { // NEM: 2010-06-14: updated to match Tcl 8.5+ throw new TclException(interp, "formal parameter \"" + argSpec + "\" is an array element"); } argList[i][0] = argName; argList[i][0].preserve(); if (specLen == 2) { argList[i][1] = TclList.index(interp, argSpec, 1); argList[i][1].preserve(); } else { argList[i][1] = null; } } if (numArgs > 0 && (argList[numArgs - 1][0].toString().equals("args"))) { isVarArgs = true; } else { isVarArgs = false; } body = new CharPointer(b.toString()); body_length = body.length(); }
public void cmdProc( Interp interp, // Current interpreter. TclObject argv[]) // Argument list. throws TclException // Standard Tcl exception. { // Create the call frame and parameter bindings CallFrame frame = interp.newCallFrame(this, argv); // Execute the body interp.pushDebugStack(srcFileName, srcLineNumber); try { Parser.eval2(interp, body.array, body.index, body_length, 0); } catch (TclException e) { int code = e.getCompletionCode(); if (code == TCL.RETURN) { int realCode = interp.updateReturnInfo(); if (realCode != TCL.OK) { e.setCompletionCode(realCode); throw e; } } else if (code == TCL.ERROR) { if (this.isLambda()) { TclObject name = TclList.newInstance(); TclList.append(interp, name, argv, 0, 2); interp.addErrorInfo( "\n (lambda term \"" + name.toString() + "\" line " + interp.errorLine + ")"); } else { interp.addErrorInfo( "\n (procedure \"" + argv[0] + "\" line " + interp.errorLine + ")"); } throw e; } else if (code == TCL.BREAK) { throw new TclException(interp, "invoked \"break\" outside of a loop"); } else if (code == TCL.CONTINUE) { throw new TclException(interp, "invoked \"continue\" outside of a loop"); } else { throw e; } } finally { interp.popDebugStack(); // The check below is a hack. The problem is that there // could be unset traces on the variables, which cause // scripts to be evaluated. This will clear the // errInProgress flag, losing stack trace information if // the procedure was exiting with an error. The code // below preserves the flag. Unfortunately, that isn't // really enough: we really should preserve the errorInfo // variable too (otherwise a nested error in the trace // script will trash errorInfo). What's really needed is // a general-purpose mechanism for saving and restoring // interpreter state. if (interp.errInProgress) { frame.dispose(); interp.errInProgress = true; } else { frame.dispose(); } } }