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();
}
}
}
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();
}
/**
* Executes a "case" statement. See Tcl user documentation for details.
*
* @param interp the current interpreter.
* @param argv command arguments.
* @exception TclException If incorrect number of arguments.
*/
public void cmdProc(Interp interp, TclObject argv[]) throws TclException {
if (argv.length < 3) {
throw new TclNumArgsException(interp, 1, argv, "string ?in? patList body ... ?default body?");
}
int i, result;
int body;
TclObject caseArgv[];
String string;
string = argv[1].toString();
caseArgv = argv;
body = -1;
if (argv[2].toString().equals("in")) {
i = 3;
} else {
i = 2;
}
/*
* If all of the pattern/command pairs are lumped into a single
* argument, split them out again.
*/
if (argv.length - i == 1) {
caseArgv = TclList.getElements(interp, argv[i]);
i = 0;
}
match_loop:
{
for (; i < caseArgv.length; i += 2) {
int j;
if (i == (caseArgv.length - 1)) {
throw new TclException(interp, "extra case pattern with no body");
}
/*
* Check for special case of single pattern (no list) with
* no backslash sequences.
*/
String caseString = caseArgv[i].toString();
int len = caseString.length();
for (j = 0; j < len; j++) {
char c = caseString.charAt(j);
if (Character.isWhitespace(c) || (c == '\\')) {
break;
}
}
if (j == len) {
if (caseString.equals("default")) {
body = i + 1;
}
if (Util.stringMatch(string, caseString)) {
body = i + 1;
break match_loop;
}
continue;
}
/*
* Break up pattern lists, then check each of the patterns
* in the list.
*/
int numPats = TclList.getLength(interp, caseArgv[i]);
for (j = 0; j < numPats; j++) {
if (Util.stringMatch(string, TclList.index(interp, caseArgv[i], j).toString())) {
body = i + 1;
break match_loop;
}
}
}
}
if (body != -1) {
try {
interp.eval(caseArgv[body], 0);
} catch (TclException e) {
if (e.getCompletionCode() == TCL.ERROR) {
interp.addErrorInfo(
"\n (\"" + caseArgv[body - 1] + "\" arm line " + interp.errorLine + ")");
}
throw e;
}
}
}