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();
}
}
}
