001: /*
002: * Procedure.java --
003: *
004: * This class implements the body of a Tcl procedure.
005: *
006: * Copyright (c) 1997 Cornell University.
007: * Copyright (c) 1997 Sun Microsystems, Inc.
008: *
009: * See the file "license.terms" for information on usage and
010: * redistribution of this file, and for a DISCLAIMER OF ALL
011: * WARRANTIES.
012: *
013: * RCS: @(#) $Id: Procedure.java,v 1.8 2006/03/20 18:43:27 mdejong Exp $
014: *
015: */
016:
017: package tcl.lang;
018:
019: /**
020: * This class implements the body of a Tcl procedure.
021: */
022:
023: public class Procedure implements Command, CommandWithDispose {
024:
025: // The formal parameters of the procedure and their default values.
026: // argList[0][0] = name of the 1st formal param
027: // argList[0][1] = if non-null, default value of the 1st formal param
028:
029: TclObject[][] argList;
030:
031: // True if this proc takes a variable number of arguments. False
032: // otherwise.
033:
034: boolean isVarArgs;
035:
036: // The body of the procedure.
037:
038: CharPointer body;
039: int body_length;
040:
041: // The wrapped command that corresponds to this
042: // procedure. This is used to find the namespace
043: // a proc is currently defined in.
044: WrappedCommand wcmd;
045:
046: // Name of the source file that contains this procedure. May be null, which
047: // indicates that the source file is unknown.
048:
049: String srcFileName;
050:
051: // Position where the body of the procedure starts in the source file.
052: // 1 means the first line in the source file.
053:
054: int srcLineNumber;
055:
056: /*
057: *----------------------------------------------------------------------
058: *
059: * Procedure --
060: *
061: * Creates a procedure instance.
062: *
063: * Results:
064: * None.
065: *
066: * Side effects:
067: * The procedure body object as well as the argument objects
068: * are locked.
069: *
070: *----------------------------------------------------------------------
071: */
072:
073: Procedure(Interp interp, // Current interpreter.
074: Namespace ns, // The namespace that the proc is defined in.
075: String name, // Name of the procedure.
076: TclObject args, // The formal arguments of this procedure.
077: TclObject b, // The body of the procedure.
078: String sFileName, // Initial value for the srcFileName member.
079: int sLineNumber) // Initial value for the srcLineNumber member.
080: throws TclException // Standard Tcl exception.
081: {
082: srcFileName = sFileName;
083: srcLineNumber = sLineNumber;
084:
085: // Break up the argument list into argument specifiers, then process
086: // each argument specifier.
087:
088: int numArgs = TclList.getLength(interp, args);
089: argList = new TclObject[numArgs][2];
090:
091: for (int i = 0; i < numArgs; i++) {
092: // Now divide the specifier up into name and default.
093:
094: TclObject argSpec = TclList.index(interp, args, i);
095: int specLen = TclList.getLength(interp, argSpec);
096:
097: if (specLen == 0) {
098: throw new TclException(interp, "procedure \"" + name
099: + "\" has argument with no name");
100: }
101: if (specLen > 2) {
102: throw new TclException(interp,
103: "too many fields in argument " + "specifier \""
104: + argSpec + "\"");
105: }
106: TclObject argName = TclList.index(interp, argSpec, 0);
107: String argNameStr = argName.toString();
108: if (argNameStr.indexOf("::") != -1) {
109: throw new TclException(interp, "procedure \"" + name
110: + "\" has formal parameter \"" + argSpec
111: + "\" that is not a simple name");
112: } else if (Var.isArrayVarname(argNameStr)) {
113: throw new TclException(interp, "procedure \"" + name
114: + "\" has formal parameter \"" + argSpec
115: + "\" that is an array element");
116: }
117:
118: argList[i][0] = argName;
119: argList[i][0].preserve();
120: if (specLen == 2) {
121: argList[i][1] = TclList.index(interp, argSpec, 1);
122: argList[i][1].preserve();
123: } else {
124: argList[i][1] = null;
125: }
126: }
127:
128: if (numArgs > 0
129: && (argList[numArgs - 1][0].toString().equals("args"))) {
130: isVarArgs = true;
131: } else {
132: isVarArgs = false;
133: }
134:
135: body = new CharPointer(b.toString());
136: body_length = body.length();
137: }
138:
139: /*
140: *----------------------------------------------------------------------
141: *
142: * cmdProc --
143: *
144: * When a Tcl procedure gets invoked, this routine gets invoked
145: * to interpret the procedure.
146: *
147: * Results:
148: * None.
149: *
150: * Side effects:
151: * Depends on the commands in the procedure.
152: *
153: *----------------------------------------------------------------------
154: */
155:
156: public void cmdProc(Interp interp, // Current interpreter.
157: TclObject argv[]) // Argument list.
158: throws TclException // Standard Tcl exception.
159: {
160: // Create the call frame and parameter bindings
161:
162: CallFrame frame = interp.newCallFrame(this , argv);
163:
164: // Execute the body
165:
166: interp.pushDebugStack(srcFileName, srcLineNumber);
167: try {
168: Parser
169: .eval2(interp, body.array, body.index, body_length,
170: 0);
171: } catch (TclException e) {
172: int code = e.getCompletionCode();
173: if (code == TCL.RETURN) {
174: int realCode = interp.updateReturnInfo();
175: if (realCode != TCL.OK) {
176: e.setCompletionCode(realCode);
177: throw e;
178: }
179: } else if (code == TCL.ERROR) {
180: interp.addErrorInfo("\n (procedure \"" + argv[0]
181: + "\" line " + interp.errorLine + ")");
182: throw e;
183: } else if (code == TCL.BREAK) {
184: throw new TclException(interp,
185: "invoked \"break\" outside of a loop");
186: } else if (code == TCL.CONTINUE) {
187: throw new TclException(interp,
188: "invoked \"continue\" outside of a loop");
189: } else {
190: throw e;
191: }
192: } finally {
193: interp.popDebugStack();
194:
195: // The check below is a hack. The problem is that there
196: // could be unset traces on the variables, which cause
197: // scripts to be evaluated. This will clear the
198: // errInProgress flag, losing stack trace information if
199: // the procedure was exiting with an error. The code
200: // below preserves the flag. Unfortunately, that isn't
201: // really enough: we really should preserve the errorInfo
202: // variable too (otherwise a nested error in the trace
203: // script will trash errorInfo). What's really needed is
204: // a general-purpose mechanism for saving and restoring
205: // interpreter state.
206:
207: if (interp.errInProgress) {
208: frame.dispose();
209: interp.errInProgress = true;
210: } else {
211: frame.dispose();
212: }
213: }
214: }
215:
216: /*
217: *----------------------------------------------------------------------
218: *
219: * disposeCmd --
220: *
221: * This method is called when the object command has been deleted
222: * from an interpreter.
223: *
224: * Results:
225: * None.
226: *
227: * Side effects:
228: * It releases the procedure body object as well as all the
229: * argument objects that were previously locked.
230: *
231: *----------------------------------------------------------------------
232: */
233:
234: public void disposeCmd() {
235: //body.release();
236: body = null;
237: for (int i = 0; i < argList.length; i++) {
238: argList[i][0].release();
239: argList[i][0] = null;
240:
241: if (argList[i][1] != null) {
242: argList[i][1].release();
243: argList[i][1] = null;
244: }
245: }
246: argList = null;
247: }
248:
249: /*
250: *----------------------------------------------------------------------
251: *
252: * TclIsProc -- isProc
253: *
254: * Tells whether a command is a Tcl procedure or not.
255: *
256: * Results:
257: * If the given command is actually a Tcl procedure, the
258: * return value is true. Otherwise the return value is false.
259: *
260: * Side effects:
261: * None.
262: *
263: *----------------------------------------------------------------------
264: */
265:
266: static boolean isProc(WrappedCommand cmd) {
267: return (cmd.cmd instanceof Procedure);
268:
269: /*
270: // FIXME: do we really want to get the original command
271: // and test that? Methods like InfoCmd.InfoProcsCmd seem
272: // to do this already.
273:
274: WrappedCommand origCmd;
275:
276: origCmd = Namespace.getOriginalCommand(cmd);
277: if (origCmd != null) {
278: cmd = origCmd;
279: }
280: return (cmd.cmd instanceof Procedure);
281: */
282: }
283:
284: /*
285: *----------------------------------------------------------------------
286: *
287: * TclFindProc -- findProc
288: *
289: * Given the name of a procedure, return a reference to the
290: * Command instance for the given Procedure. The procedure will be
291: * looked up using the usual rules: first in the current
292: * namespace and then in the global namespace.
293: *
294: * Results:
295: * null is returned if the name doesn't correspond to any
296: * procedure. Otherwise, the return value is a pointer to
297: * the procedure's Command. If the name is found but refers
298: * to an imported command that points to a "real" procedure
299: * defined in another namespace, a pointer to that "real"
300: * procedure's structure is returned.
301: *
302: * Side effects:
303: * None.
304: *
305: *----------------------------------------------------------------------
306: */
307:
308: static Procedure findProc(Interp interp, String procName) {
309: WrappedCommand cmd;
310: WrappedCommand origCmd;
311:
312: try {
313: cmd = Namespace.findCommand(interp, procName, null, 0);
314: } catch (TclException e) {
315: // This should never happen
316: throw new TclRuntimeError("unexpected TclException: " + e);
317: }
318:
319: if (cmd == null) {
320: return null;
321: }
322:
323: origCmd = Namespace.getOriginalCommand(cmd);
324: if (origCmd != null) {
325: cmd = origCmd;
326: }
327: if (!(cmd.cmd instanceof Procedure)) {
328: return null;
329: }
330: return (Procedure) cmd.cmd;
331: }
332:
333: } // end Procedure
|