0001: /*
0002: * ------------------------------------------------------------------------
0003: * PACKAGE: [incr Tcl]
0004: * DESCRIPTION: Object-Oriented Extensions to Tcl
0005: *
0006: * [incr Tcl] provides object-oriented extensions to Tcl, much as
0007: * C++ provides object-oriented extensions to C. It provides a means
0008: * of encapsulating related procedures together with their shared data
0009: * in a local namespace that is hidden from the outside world. It
0010: * promotes code re-use through inheritance. More than anything else,
0011: * it encourages better organization of Tcl applications through the
0012: * object-oriented paradigm, leading to code that is easier to
0013: * understand and maintain.
0014: *
0015: * These procedures handle commands available within a class scope.
0016: * In [incr Tcl], the term "method" is used for a procedure that has
0017: * access to object-specific data, while the term "proc" is used for
0018: * a procedure that has access only to common class data.
0019: *
0020: * ========================================================================
0021: * AUTHOR: Michael J. McLennan
0022: * Bell Labs Innovations for Lucent Technologies
0023: * mmclennan@lucent.com
0024: * http://www.tcltk.com/itcl
0025: *
0026: * RCS: $Id: Methods.java,v 1.3 2006/01/26 19:49:18 mdejong Exp $
0027: * ========================================================================
0028: * Copyright (c) 1993-1998 Lucent Technologies, Inc.
0029: * ------------------------------------------------------------------------
0030: * See the file "license.itcl" for information on usage and redistribution
0031: * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
0032: */
0033:
0034: package itcl.lang;
0035:
0036: import tcl.lang.*;
0037:
0038: import java.util.Hashtable;
0039:
0040: class Methods {
0041:
0042: /*
0043: * ------------------------------------------------------------------------
0044: * Itcl_BodyCmd -> Methods.BodyCmd.cmdProc
0045: *
0046: * Invoked by Tcl whenever the user issues an "itcl::body" command to
0047: * define or redefine the implementation for a class method/proc.
0048: * Handles the following syntax:
0049: *
0050: * itcl::body <class>::<func> <arglist> <body>
0051: *
0052: * Looks for an existing class member function with the name <func>,
0053: * and if found, tries to assign the implementation. If an argument
0054: * list was specified in the original declaration, it must match
0055: * <arglist> or an error is flagged. If <body> has the form "@name"
0056: * then it is treated as a reference to a C handling procedure;
0057: * otherwise, it is taken as a body of Tcl statements.
0058: *
0059: * Returns if successful, raises TclException if something goes wrong.
0060: * ------------------------------------------------------------------------
0061: */
0062:
0063: static class BodyCmd implements Command {
0064: public void cmdProc(Interp interp, // Current interp.
0065: TclObject[] objv) // Args passed to the command.
0066: throws TclException {
0067: String head, tail, token, arglist, body;
0068: ItclClass cdefn;
0069: ItclMemberFunc mfunc;
0070:
0071: if (objv.length != 4) {
0072: throw new TclNumArgsException(interp, 1, objv,
0073: "class::func arglist body");
0074: }
0075:
0076: // Parse the member name "namesp::namesp::class::func".
0077: // Make sure that a class name was specified, and that the
0078: // class exists.
0079:
0080: token = objv[1].toString();
0081: Util.ParseNamespPathResult res = Util
0082: .ParseNamespPath(token);
0083: head = res.head;
0084: tail = res.tail;
0085:
0086: if (head == null || head.length() == 0) {
0087: throw new TclException(interp,
0088: "missing class specifier for body declaration \""
0089: + token + "\"");
0090: }
0091:
0092: cdefn = Class.FindClass(interp, head, true);
0093: if (cdefn == null) {
0094: throw new TclException(interp, interp.getResult()
0095: .toString());
0096: }
0097:
0098: // Find the function and try to change its implementation.
0099: // Note that command resolution table contains *all* functions,
0100: // even those in a base class. Make sure that the class
0101: // containing the method definition is the requested class.
0102:
0103: mfunc = (ItclMemberFunc) cdefn.resolveCmds.get(tail);
0104: if (mfunc != null) {
0105: if (mfunc.member.classDefn != cdefn) {
0106: mfunc = null;
0107: }
0108: }
0109:
0110: if (mfunc == null) {
0111: throw new TclException(interp, "function \"" + tail
0112: + "\" is not defined in class \""
0113: + cdefn.fullname + "\"");
0114: }
0115:
0116: arglist = objv[2].toString();
0117: body = objv[3].toString();
0118:
0119: Methods.ChangeMemberFunc(interp, mfunc, arglist, body);
0120: }
0121: } // end class BodyCmd
0122:
0123: /*
0124: * ------------------------------------------------------------------------
0125: * Itcl_ConfigBodyCmd -> Methods.ConfigBodyCmd.cmdProc
0126: *
0127: * Invoked by Tcl whenever the user issues an "itcl::configbody" command
0128: * to define or redefine the configuration code associated with a
0129: * public variable. Handles the following syntax:
0130: *
0131: * itcl::configbody <class>::<publicVar> <body>
0132: *
0133: * Looks for an existing public variable with the name <publicVar>,
0134: * and if found, tries to assign the implementation. If <body> has
0135: * the form "@name" then it is treated as a reference to a C handling
0136: * procedure; otherwise, it is taken as a body of Tcl statements.
0137: *
0138: * Returns if successful, raises TclException if something goes wrong.
0139: * ------------------------------------------------------------------------
0140: */
0141:
0142: static class ConfigBodyCmd implements Command {
0143: public void cmdProc(Interp interp, // Current interp.
0144: TclObject[] objv) // Args passed to the command.
0145: throws TclException {
0146: String head, tail, token;
0147: ItclClass cdefn;
0148: ItclVarLookup vlookup;
0149: ItclMember member;
0150: ItclMemberCode mcode;
0151:
0152: if (objv.length != 3) {
0153: throw new TclNumArgsException(interp, 1, objv,
0154: "class::option body");
0155: }
0156:
0157: // Parse the member name "namesp::namesp::class::option".
0158: // Make sure that a class name was specified, and that the
0159: // class exists.
0160:
0161: token = objv[1].toString();
0162: Util.ParseNamespPathResult res = Util
0163: .ParseNamespPath(token);
0164: head = res.head;
0165: tail = res.tail;
0166:
0167: if (head == null || head.length() == 0) {
0168: throw new TclException(interp,
0169: "missing class specifier for body declaration \""
0170: + token + "\"");
0171: }
0172:
0173: cdefn = Class.FindClass(interp, head, true);
0174: if (cdefn == null) {
0175: throw new TclException(interp, interp.getResult()
0176: .toString());
0177: }
0178:
0179: // Find the variable and change its implementation.
0180: // Note that variable resolution table has *all* variables,
0181: // even those in a base class. Make sure that the class
0182: // containing the variable definition is the requested class.
0183:
0184: vlookup = (ItclVarLookup) cdefn.resolveVars.get(tail);
0185: if (vlookup != null) {
0186: if (vlookup.vdefn.member.classDefn != cdefn) {
0187: vlookup = null;
0188: }
0189: }
0190:
0191: if (vlookup == null) {
0192: throw new TclException(interp, "option \"" + tail
0193: + "\" is not defined in class \""
0194: + cdefn.fullname + "\"");
0195: }
0196: member = vlookup.vdefn.member;
0197:
0198: if (member.protection != Itcl.PUBLIC) {
0199: throw new TclException(interp, "option \""
0200: + member.fullname
0201: + "\" is not a public configuration option");
0202: }
0203:
0204: token = objv[2].toString();
0205:
0206: mcode = Methods
0207: .CreateMemberCode(interp, cdefn, null, token);
0208:
0209: Util.PreserveData(mcode);
0210: //Itcl_EventuallyFree(mcode, Itcl_DeleteMemberCode);
0211:
0212: if (member.code != null) {
0213: Util.ReleaseData(member.code);
0214: }
0215: member.code = mcode;
0216: }
0217: } // end class ConfigBodyCmd
0218:
0219: /*
0220: * ------------------------------------------------------------------------
0221: * Itcl_CreateMethod -> Methods.CreateMethod
0222: *
0223: * Installs a method into the namespace associated with a class.
0224: * If another command with the same name is already installed, then
0225: * it is overwritten.
0226: *
0227: * Returns if successful, raises TclException if something goes wrong.
0228: * ------------------------------------------------------------------------
0229: */
0230:
0231: static void CreateMethod(Interp interp, // interpreter managing this action
0232: ItclClass cdefn, // class definition
0233: String name, // name of new method
0234: String arglist, // space-separated list of arg names
0235: String body) // body of commands for the method
0236: throws TclException {
0237: ItclMemberFunc mfunc;
0238: StringBuffer buffer;
0239: String qname;
0240:
0241: // Make sure that the method name does not contain anything
0242: // goofy like a "::" scope qualifier.
0243:
0244: if (name.indexOf("::") != -1) {
0245: throw new TclException(interp, "bad method name \"" + name
0246: + "\"");
0247: }
0248:
0249: // Create the method definition.
0250:
0251: mfunc = Methods.CreateMemberFunc(interp, cdefn, name, arglist,
0252: body);
0253:
0254: // Build a fully-qualified name for the method, and install
0255: // the command handler.
0256:
0257: buffer = new StringBuffer(64);
0258: buffer.append(cdefn.namesp.fullName);
0259: buffer.append("::");
0260: buffer.append(name);
0261: qname = buffer.toString();
0262:
0263: Util.PreserveData(mfunc);
0264: interp.createCommand(qname, new ExecMethod(mfunc));
0265:
0266: mfunc.w_accessCmd = Namespace.findCommand(interp, qname, null,
0267: TCL.NAMESPACE_ONLY);
0268: mfunc.accessCmd = mfunc.w_accessCmd.cmd;
0269: }
0270:
0271: /*
0272: * ------------------------------------------------------------------------
0273: * Itcl_CreateProc -> Methods.CreateProc
0274: *
0275: * Installs a class proc into the namespace associated with a class.
0276: * If another command with the same name is already installed, then
0277: * it is overwritten. Returns if successful, raises TclException if
0278: * something goes wrong.
0279: * ------------------------------------------------------------------------
0280: */
0281:
0282: static void CreateProc(Interp interp, // interpreter managing this action
0283: ItclClass cdefn, // class definition
0284: String name, // name of new proc
0285: String arglist, // space-separated list of arg names
0286: String body) // body of commands for the proc
0287: throws TclException {
0288: ItclMemberFunc mfunc;
0289: StringBuffer buffer;
0290: String qname;
0291:
0292: // Make sure that the proc name does not contain anything
0293: // goofy like a "::" scope qualifier.
0294:
0295: if (name.indexOf("::") != -1) {
0296: throw new TclException(interp, "bad proc name \"" + name
0297: + "\"");
0298: }
0299:
0300: // Create the proc definition.
0301:
0302: mfunc = Methods.CreateMemberFunc(interp, cdefn, name, arglist,
0303: body);
0304:
0305: // Mark procs as "common". This distinguishes them from methods.
0306:
0307: mfunc.member.flags |= ItclInt.COMMON;
0308:
0309: // Build a fully-qualified name for the proc, and install
0310: // the command handler.
0311:
0312: buffer = new StringBuffer(64);
0313: buffer.append(cdefn.namesp.fullName);
0314: buffer.append("::");
0315: buffer.append(name);
0316: qname = buffer.toString();
0317:
0318: Util.PreserveData(mfunc);
0319: interp.createCommand(qname, new ExecProc(mfunc));
0320:
0321: mfunc.w_accessCmd = Namespace.findCommand(interp, qname, null,
0322: TCL.NAMESPACE_ONLY);
0323: mfunc.accessCmd = mfunc.w_accessCmd.cmd;
0324: }
0325:
0326: /*
0327: * ------------------------------------------------------------------------
0328: * Itcl_CreateMemberFunc -> Methods.CreateMemberFunc
0329: *
0330: * Creates the data record representing a member function. This
0331: * includes the argument list and the body of the function. If the
0332: * body is of the form "@name", then it is treated as a label for
0333: * a Java procedure registered by Itcl_RegisterC().
0334: *
0335: * If any errors are encountered, this procedure raises a TclException.
0336: * Otherwise, it returns a new ItclMemberFunc reference.
0337: * ------------------------------------------------------------------------
0338: */
0339:
0340: static ItclMemberFunc CreateMemberFunc(Interp interp, // interpreter managing this action
0341: ItclClass cdefn, // class definition
0342: String name, // name of new member
0343: String arglist, // space-separated list of arg names
0344: String body) // body of commands for the method
0345: throws TclException {
0346: boolean newEntry;
0347: ItclMemberFunc mfunc;
0348: ItclMemberCode mcode;
0349:
0350: // Add the member function to the list of functions for
0351: // the class. Make sure that a member function with the
0352: // same name doesn't already exist.
0353:
0354: newEntry = (cdefn.functions.get(name) == null);
0355: if (!newEntry) {
0356: throw new TclException(interp, "\"" + name
0357: + "\" already defined in class \"" + cdefn.fullname
0358: + "\"");
0359: }
0360:
0361: // Try to create the implementation for this command member.
0362:
0363: try {
0364: mcode = Methods.CreateMemberCode(interp, cdefn, arglist,
0365: body);
0366: } catch (TclException ex) {
0367: cdefn.functions.remove(name);
0368: throw ex;
0369: }
0370: Util.PreserveData(mcode);
0371: //Util.EventuallyFree(mcode, Itcl_DeleteMemberCode);
0372:
0373: // Allocate a member function definition and return.
0374:
0375: mfunc = new ItclMemberFunc();
0376: mfunc.member = Class.CreateMember(interp, cdefn, name);
0377: mfunc.member.code = mcode;
0378:
0379: if (mfunc.member.protection == Itcl.DEFAULT_PROTECT) {
0380: mfunc.member.protection = Itcl.PUBLIC;
0381: }
0382:
0383: mfunc.arglist = null;
0384: mfunc.argcount = 0;
0385: mfunc.accessCmd = null;
0386:
0387: if (arglist != null) {
0388: mfunc.member.flags |= ItclInt.ARG_SPEC;
0389: }
0390: if (mcode.arglist != null) {
0391: CreateArgListResult cr = Methods.CreateArgList(interp,
0392: arglist);
0393: mfunc.arglist = cr.arglist;
0394: mfunc.argcount = cr.argcount;
0395: }
0396:
0397: if (name.equals("constructor")) {
0398: mfunc.member.flags |= ItclInt.CONSTRUCTOR;
0399: }
0400: if (name.equals("destructor")) {
0401: mfunc.member.flags |= ItclInt.DESTRUCTOR;
0402: }
0403:
0404: cdefn.functions.put(name, mfunc);
0405: Util.PreserveData(mfunc);
0406: //Util.EventuallyFree(mfunc, Itcl_DeleteMemberFunc);
0407:
0408: return mfunc;
0409: }
0410:
0411: /*
0412: * ------------------------------------------------------------------------
0413: * Itcl_ChangeMemberFunc -> Methods.ChangeMemberFunc
0414: *
0415: * Modifies the data record representing a member function. This
0416: * is usually the body of the function, but can include the argument
0417: * list if it was not defined when the member was first created.
0418: * If the body is of the form "@name", then it is treated as a label
0419: * for a Java procedure registered by Itcl_RegisterC().
0420: *
0421: * Returns if successful, raises TclException if something goes wrong.
0422: * ------------------------------------------------------------------------
0423: */
0424:
0425: static void ChangeMemberFunc(Interp interp, // interpreter managing this action
0426: ItclMemberFunc mfunc, // command member being changed
0427: String arglist, // space-separated list of arg names
0428: String body) // body of commands for the method
0429: throws TclException {
0430: ItclMemberCode mcode = null;
0431: TclObject obj;
0432:
0433: // Try to create the implementation for this command member.
0434:
0435: mcode = Methods.CreateMemberCode(interp,
0436: mfunc.member.classDefn, arglist, body);
0437:
0438: // If the argument list was defined when the function was
0439: // created, compare the arg lists or usage strings to make sure
0440: // that the interface is not being redefined.
0441:
0442: if ((mfunc.member.flags & ItclInt.ARG_SPEC) != 0
0443: && !Methods.EquivArgLists(mfunc.arglist,
0444: mfunc.argcount, mcode.arglist, mcode.argcount)) {
0445:
0446: obj = Methods.ArgList(mfunc.argcount, mfunc.arglist);
0447:
0448: StringBuffer buffer = new StringBuffer(64);
0449: buffer.append("argument list changed for function \"");
0450: buffer.append(mfunc.member.fullname);
0451: buffer.append("\": should be \"");
0452: buffer.append(obj.toString());
0453: buffer.append("\"");
0454:
0455: Methods.DeleteMemberCode(mcode);
0456:
0457: throw new TclException(interp, buffer.toString());
0458: }
0459:
0460: // Free up the old implementation and install the new one.
0461:
0462: Util.PreserveData(mcode);
0463: //Util.EventuallyFree(mcode, Itcl_DeleteMemberCode);
0464:
0465: Util.ReleaseData(mfunc.member.code);
0466: mfunc.member.code = mcode;
0467: }
0468:
0469: /*
0470: * ------------------------------------------------------------------------
0471: * Itcl_DeleteMemberFunc -> Methods.DeleteMemberFunc
0472: *
0473: * Destroys all data associated with the given member function definition.
0474: * Usually invoked by the interpreter when a member function is deleted.
0475: * ------------------------------------------------------------------------
0476: */
0477:
0478: static void DeleteMemberFunc(ItclMemberFunc mfunc) // ref to member function definition
0479: {
0480: if (mfunc != null) {
0481: Class.DeleteMember(mfunc.member);
0482:
0483: if (mfunc.arglist != null) {
0484: Methods.DeleteArgList(mfunc.arglist);
0485: }
0486: }
0487: }
0488:
0489: /*
0490: * ------------------------------------------------------------------------
0491: * Itcl_CreateMemberCode -> Methods.CreateMemberCode
0492: *
0493: * Creates the data record representing the implementation behind a
0494: * class member function. This includes the argument list and the body
0495: * of the function. If the body is of the form "@name", then it is
0496: * treated as a label for a C procedure registered by Itcl_RegisterC().
0497: *
0498: * The implementation is kept by the member function definition, and
0499: * controlled by a preserve/release paradigm. That way, if it is in
0500: * use while it is being redefined, it will stay around long enough
0501: * to avoid a core dump.
0502: *
0503: * If any errors are encountered, this procedure raises a TclException.
0504: * Otherwise, it returns a new ItclMemberCode reference.
0505: * ------------------------------------------------------------------------
0506: */
0507:
0508: static ItclMemberCode CreateMemberCode(Interp interp, // interpreter managing this action
0509: ItclClass cdefn, // class containing this member
0510: String arglist, // space-separated list of arg names
0511: String body) // body of commands for the method
0512: throws TclException {
0513: ItclMemberCode mcode;
0514:
0515: // Allocate some space to hold the implementation.
0516:
0517: mcode = new ItclMemberCode();
0518: mcode.flags = 0;
0519: mcode.argcount = 0;
0520: mcode.arglist = null;
0521: mcode.proc = null;
0522: mcode.objCmd = null;
0523: //mcode.clientData = null;
0524:
0525: if (arglist != null) {
0526: CreateArgListResult cr;
0527:
0528: try {
0529: cr = Methods.CreateArgList(interp, arglist);
0530: } catch (TclException ex) {
0531: Methods.DeleteMemberCode(mcode);
0532: throw ex;
0533: }
0534: mcode.argcount = cr.argcount;
0535: mcode.arglist = cr.arglist;
0536: mcode.flags |= ItclInt.ARG_SPEC;
0537: } else {
0538: // No-op
0539: }
0540:
0541: // NOTE: Don't bother creating a Procedure object here,
0542: // just eval() the command body later.
0543:
0544: // Create a Tcl Procedure object for this code body.
0545: // This Procedure will not actually be used to push
0546: // a call frame or setup locals before code is
0547: // evaluated in a procedures scope.
0548:
0549: //String proc_name = "itcl_member_code";
0550: //TclObject proc_body;
0551:
0552: if (body != null) {
0553: //proc_body = TclString.newInstance(body);
0554: mcode.body = body;
0555: } else {
0556: //proc_body = TclString.newInstance("");
0557: mcode.body = null;
0558: }
0559:
0560: mcode.proc = null;
0561:
0562: // Note: Skipped compiled locals processing.
0563:
0564: // If the body definition starts with '@', then treat the value
0565: // as a symbolic name for a C procedure.
0566:
0567: if (body == null) {
0568: mcode.flags |= ItclInt.IMPLEMENT_NONE;
0569: } else if (body.length() >= 2 && body.charAt(0) == '@') {
0570: String rbody = body.substring(1);
0571: ItclJavafunc jfunc = Linkage.FindC(interp, rbody);
0572:
0573: if (jfunc == null) {
0574: Methods.DeleteMemberCode(mcode);
0575: throw new TclException(interp,
0576: "no registered C procedure with name \""
0577: + rbody + "\"");
0578: } else {
0579: mcode.flags = ItclInt.IMPLEMENT_OBJCMD;
0580: mcode.objCmd = jfunc.objCmdProc;
0581: }
0582: }
0583: // Otherwise, treat the body as a chunk of Tcl code.
0584: else {
0585: mcode.flags |= ItclInt.IMPLEMENT_TCL;
0586: }
0587:
0588: return mcode;
0589: }
0590:
0591: /*
0592: * ------------------------------------------------------------------------
0593: * Methods.IsMemberCodeImplemented
0594: *
0595: * Return true if the "body" for a given command has been implemented.
0596: * ------------------------------------------------------------------------
0597: */
0598:
0599: static boolean IsMemberCodeImplemented(ItclMemberCode mcode) {
0600: return ((mcode.flags & ItclInt.IMPLEMENT_NONE) == 0);
0601: }
0602:
0603: /*
0604: * ------------------------------------------------------------------------
0605: * Itcl_DeleteMemberCode -> Methods.DeleteMemberCode
0606: *
0607: * Destroys all data associated with the given command implementation.
0608: * Invoked automatically by Util.ReleaseData() when the implementation
0609: * is no longer being used.
0610: * ------------------------------------------------------------------------
0611: */
0612:
0613: static void DeleteMemberCode(ItclMemberCode mcode) // ref to member function definition
0614: {
0615: if (mcode.arglist != null) {
0616: Methods.DeleteArgList(mcode.arglist);
0617: }
0618: if (mcode.proc != null) {
0619: mcode.proc = null;
0620: }
0621: }
0622:
0623: /*
0624: * ------------------------------------------------------------------------
0625: * Itcl_GetMemberCode -> Methods.GetMemberCode
0626: *
0627: * Makes sure that the implementation for an [incr Tcl] code body is
0628: * ready to run. Note that a member function can be declared without
0629: * being defined. The class definition may contain a declaration of
0630: * the member function, but its body may be defined in a separate file.
0631: * If an undefined function is encountered, this routine automatically
0632: * attempts to autoload it. If the body is implemented via Tcl code,
0633: * then it is compiled here as well.
0634: *
0635: * Raises a TclException if an error is encountered, or if the
0636: * implementation is not defined and cannot be autoloaded.
0637: * Returns if implementation is ready to use.
0638: * ------------------------------------------------------------------------
0639: */
0640:
0641: static void GetMemberCode(Interp interp, // interpreter managing this action
0642: ItclMember member) // member containing code body
0643: throws TclException {
0644: ItclMemberCode mcode = member.code;
0645:
0646: int result;
0647:
0648: // If the implementation has not yet been defined, try to
0649: // autoload it now.
0650:
0651: if (!IsMemberCodeImplemented(mcode)) {
0652: try {
0653: interp.eval("::auto_load " + member.fullname);
0654: } catch (TclException ex) {
0655: interp
0656: .addErrorInfo("\n (while autoloading code for \""
0657: + member.fullname + "\")");
0658: throw ex;
0659: }
0660: interp.resetResult(); // get rid of 1/0 status
0661: }
0662:
0663: // If the implementation is still not available, then
0664: // autoloading must have failed.
0665: //
0666: // TRICKY NOTE: If code has been autoloaded, then the
0667: // old mcode pointer is probably invalid. Go back to
0668: // the member and look at the current code pointer again.
0669:
0670: mcode = member.code;
0671:
0672: if (!IsMemberCodeImplemented(mcode)) {
0673: throw new TclException(interp, "member function \""
0674: + member.fullname
0675: + "\" is not defined and cannot be autoloaded");
0676: }
0677:
0678: // Skip compiling Tcl code for constructor or body
0679: }
0680:
0681: /*
0682: * ------------------------------------------------------------------------
0683: * Itcl_EvalMemberCode -> Methods.EvalMemberCode
0684: *
0685: * Used to execute an ItclMemberCode representation of a code
0686: * fragment. This code may be a body of Tcl commands, or a
0687: * Java handler procedure.
0688: *
0689: * Executes the command with the given objv arguments.
0690: * ------------------------------------------------------------------------
0691: */
0692:
0693: static void EvalMemberCode(Interp interp, // current interpreter
0694: ItclMemberFunc mfunc, // member func, or null (for error messages)
0695: ItclMember member, // command member containing code
0696: ItclObject contextObj, // object context, or null
0697: TclObject[] objv) // argument objects
0698: throws TclException {
0699: CallFrame oldFrame = null;
0700:
0701: boolean transparent;
0702: ItclObjectInfo info;
0703: ItclMemberCode mcode;
0704: ItclContext context;
0705: CallFrame frame, transFrame;
0706:
0707: // If this code does not have an implementation yet, then
0708: // try to autoload one. Also, if this is Tcl code, make sure
0709: // that it's compiled and ready to use.
0710:
0711: GetMemberCode(interp, member);
0712: mcode = member.code;
0713:
0714: // Bump the reference count on this code, in case it is
0715: // redefined or deleted during execution.
0716:
0717: // FIXME: It is possible that bumping this ref could be
0718: // in error if this function fails before entring the
0719: // try block below. The C version seems to have a problem
0720: // here too. Could this be moved into the try block?
0721:
0722: Util.PreserveData(mcode);
0723:
0724: // Install a new call frame context for the current code.
0725: // If the current call frame is marked as "transparent", then
0726: // do an "uplevel" operation to move past it. Transparent
0727: // call frames are installed by Itcl_HandleInstance. They
0728: // provide a way of entering an object context without
0729: // interfering with the normal call stack.
0730:
0731: transparent = false;
0732:
0733: info = member.classDefn.info;
0734: frame = Migrate.GetCallFrame(interp, 0);
0735: for (int i = Util.GetStackSize(info.transparentFrames) - 1; i >= 0; i--) {
0736: transFrame = (CallFrame) Util.GetStackValue(
0737: info.transparentFrames, i);
0738:
0739: if (frame == transFrame) {
0740: transparent = true;
0741: break;
0742: }
0743: }
0744:
0745: if (transparent) {
0746: frame = Migrate.GetCallFrame(interp, 1);
0747: oldFrame = Migrate.ActivateCallFrame(interp, frame);
0748: }
0749:
0750: context = new ItclContext(interp);
0751: Methods.PushContext(interp, member, member.classDefn,
0752: contextObj, context);
0753:
0754: try { // start try block that releases context
0755:
0756: // If this is a method with a Tcl implementation, or a
0757: // constructor with initCode, then parse its arguments now.
0758:
0759: if (mfunc != null && objv.length > 0) {
0760: if ((mcode.flags & ItclInt.IMPLEMENT_TCL) != 0
0761: || ((member.flags & ItclInt.CONSTRUCTOR) != 0 && (member.classDefn.initCode != null))) {
0762: AssignArgs(interp, objv, mfunc);
0763: }
0764: }
0765:
0766: // If this code is a constructor, and if it is being invoked
0767: // when an object is first constructed (i.e., the "constructed"
0768: // table is still active within the object), then handle the
0769: // "initCode" associated with the constructor and make sure that
0770: // all base classes are properly constructed.
0771: //
0772: // TRICKY NOTE:
0773: // The "initCode" must be executed here. This is the only
0774: // opportunity where the arguments of the constructor are
0775: // available in a call frame.
0776:
0777: if ((member.flags & ItclInt.CONSTRUCTOR) != 0
0778: && contextObj != null
0779: && contextObj.constructed != null) {
0780:
0781: ConstructBase(interp, contextObj, member.classDefn);
0782: }
0783:
0784: // Execute the code body...
0785:
0786: if ((mcode.flags & ItclInt.IMPLEMENT_OBJCMD) != 0) {
0787: // FIXME: Need to handle unexpected return results
0788: // via the interp somehow.
0789: mcode.objCmd.cmdProc(interp, objv);
0790: } else if ((mcode.flags & ItclInt.IMPLEMENT_ARGCMD) != 0) {
0791: throw new TclRuntimeError("unexpected IMPLEMENT_ARGCMD");
0792: } else if ((mcode.flags & ItclInt.IMPLEMENT_TCL) != 0) {
0793: interp.eval(mcode.body);
0794: } else {
0795: throw new TclRuntimeError(
0796: "bad implementation flag for "
0797: + member.fullname);
0798: }
0799:
0800: // If this is a constructor or destructor, and if it is being
0801: // invoked at the appropriate time, keep track of which methods
0802: // have been called. This information is used to implicitly
0803: // invoke constructors/destructors as needed.
0804:
0805: if ((member.flags & ItclInt.DESTRUCTOR) != 0
0806: && contextObj != null
0807: && contextObj.destructed != null) {
0808:
0809: contextObj.destructed.put(member.classDefn.name, "");
0810: }
0811: if ((member.flags & ItclInt.CONSTRUCTOR) != 0
0812: && contextObj != null
0813: && contextObj.constructed != null) {
0814:
0815: contextObj.constructed.put(member.classDefn.name, "");
0816: }
0817:
0818: } finally { // end try block that releases context
0819: Methods.PopContext(interp, context);
0820:
0821: if (transparent) {
0822: Migrate.ActivateCallFrame(interp, oldFrame);
0823: }
0824:
0825: Util.ReleaseData(mcode);
0826: }
0827:
0828: return;
0829: }
0830:
0831: /*
0832: * ------------------------------------------------------------------------
0833: * Itcl_CreateArgList -> Methods.CreateArgList
0834: *
0835: * Parses a Tcl list representing an argument declaration and returns
0836: * a linked list of CompiledLocal values. Usually invoked as part
0837: * of Itcl_CreateMemberFunc() when a new method or procedure is being
0838: * defined.
0839: * ------------------------------------------------------------------------
0840: */
0841:
0842: static CreateArgListResult CreateArgList(Interp interp, // interpreter managing this function
0843: String decl) // string representing argument list
0844: throws TclException {
0845: int argc = 0;
0846: CompiledLocal local, last;
0847: CompiledLocal retLocal;
0848: TclObject[] argv, fargv;
0849:
0850: retLocal = last = null;
0851:
0852: try {
0853:
0854: if (decl != null) {
0855: argv = TclList.getElements(interp, TclString
0856: .newInstance(decl));
0857: argc = argv.length;
0858:
0859: for (int i = 0; i < argv.length; i++) {
0860: fargv = TclList.getElements(interp, argv[i]);
0861: local = null;
0862:
0863: if (fargv.length == 0
0864: || fargv[0].toString().length() == 0) {
0865: throw new TclException(interp, "argument #" + i
0866: + " has no name");
0867: } else if (fargv.length > 2) {
0868: throw new TclException(interp,
0869: "too many fields in argument specifier \""
0870: + argv[i] + "\"");
0871: } else if (fargv[0].toString().indexOf("::") != -1) {
0872: throw new TclException(interp,
0873: "bad argument name \"" + fargv[0]
0874: + "\"");
0875: } else if (fargv.length == 1) {
0876: local = CreateArg(fargv[0].toString(), null);
0877: } else {
0878: local = CreateArg(fargv[0].toString(), fargv[1]
0879: .toString());
0880: }
0881:
0882: if (local != null) {
0883: //local.frameIndex = i;
0884:
0885: if (retLocal == null) {
0886: retLocal = last = local;
0887: } else {
0888: last.next = local;
0889: last = local;
0890: }
0891: }
0892: //ckfree(fargv);
0893: }
0894: //ckfree(argv);
0895: }
0896:
0897: } catch (TclException ex) {
0898: // If anything went wrong, destroy whatever arguments were
0899: // created and rethrow the TclException
0900:
0901: DeleteArgList(retLocal);
0902: throw ex;
0903: }
0904:
0905: CreateArgListResult res = new CreateArgListResult();
0906: res.arglist = retLocal;
0907: res.argcount = argc;
0908:
0909: return res;
0910: }
0911:
0912: static class CreateArgListResult {
0913: int argcount;
0914: CompiledLocal arglist;
0915: }
0916:
0917: /*
0918: * ------------------------------------------------------------------------
0919: * Itcl_CreateArg -> Methods.CreateArg
0920: *
0921: * Creates a new Tcl Arg structure and fills it with the given
0922: * information. Returns a pointer to the new Arg structure.
0923: * ------------------------------------------------------------------------
0924: */
0925:
0926: static CompiledLocal CreateArg(String name, // name of new argument
0927: String init) // initial value
0928: {
0929: CompiledLocal local = null;
0930:
0931: local = new CompiledLocal();
0932:
0933: local.next = null;
0934: //localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
0935:
0936: if (init != null) {
0937: local.defValue = TclString.newInstance(init);
0938: local.defValue.preserve();
0939: } else {
0940: local.defValue = null;
0941: }
0942:
0943: local.name = name;
0944: return local;
0945: }
0946:
0947: /*
0948: * ------------------------------------------------------------------------
0949: * Itcl_DeleteArgList -> Methods.DeleteArgList
0950: *
0951: * Destroys a chain of arguments acting as an argument list. Usually
0952: * invoked when a method/proc is being destroyed, to discard its
0953: * argument list.
0954: * ------------------------------------------------------------------------
0955: */
0956:
0957: static void DeleteArgList(CompiledLocal arglist) // first argument in arg list chain
0958: {
0959: CompiledLocal local, next;
0960:
0961: for (local = arglist; local != null; local = next) {
0962: if (local.defValue != null) {
0963: local.defValue.release();
0964: local.defValue = null;
0965: }
0966: local.name = null;
0967: next = local.next;
0968: local.next = null;
0969: }
0970: }
0971:
0972: /*
0973: * ------------------------------------------------------------------------
0974: * Itcl_ArgList -> Methods.ArgList
0975: *
0976: * Returns a TclObject containing the string representation for the
0977: * given argument list.
0978: * ------------------------------------------------------------------------
0979: */
0980:
0981: static TclObject ArgList(int argc, // number of arguments
0982: CompiledLocal arglist) // first argument in arglist
0983: {
0984: String val;
0985: TclObject obj;
0986: StringBuffer buffer;
0987: buffer = new StringBuffer(64);
0988:
0989: while (arglist != null && argc-- > 0) {
0990: if (arglist.defValue != null) {
0991: val = arglist.defValue.toString();
0992:
0993: Util.StartSublist(buffer);
0994: Util.AppendElement(buffer, arglist.name);
0995: Util.AppendElement(buffer, val);
0996: Util.EndSublist(buffer);
0997: } else {
0998: Util.AppendElement(buffer, arglist.name);
0999: }
1000: arglist = arglist.next;
1001: }
1002:
1003: obj = TclString.newInstance(buffer.toString());
1004: return obj;
1005: }
1006:
1007: /*
1008: * ------------------------------------------------------------------------
1009: * Itcl_EquivArgLists -> Methods.EquivArgLists
1010: *
1011: * Compares two argument lists to see if they are equivalent. The
1012: * first list is treated as a prototype, and the second list must
1013: * match it. Argument names may be different, but they must match in
1014: * meaning. If one argument is optional, the corresponding argument
1015: * must also be optional. If the prototype list ends with the magic
1016: * "args" argument, then it matches everything in the other list.
1017: *
1018: * Returns true if the argument lists are equivalent.
1019: * ------------------------------------------------------------------------
1020: */
1021:
1022: static boolean EquivArgLists(CompiledLocal arg1, // prototype argument list
1023: int arg1c, // number of args in prototype arg list
1024: CompiledLocal arg2, // another argument list to match against
1025: int arg2c) // number of args in matching list
1026: {
1027: String dval1, dval2;
1028:
1029: while (arg1 != null && arg1c > 0 && arg2 != null && arg2c > 0) {
1030: // If the prototype argument list ends with the magic "args"
1031: // argument, then it matches everything in the other list.
1032:
1033: if (arg1c == 1 && arg1.name.equals("args")) {
1034: return true;
1035: }
1036:
1037: // If one has a default value, then the other must have the
1038: // same default value.
1039:
1040: if (arg1.defValue != null) {
1041: if (arg2.defValue == null) {
1042: return false;
1043: }
1044:
1045: dval1 = arg1.defValue.toString();
1046: dval2 = arg2.defValue.toString();
1047: if (!dval1.equals(dval2)) {
1048: return false;
1049: }
1050: } else if (arg2.defValue != null) {
1051: return false;
1052: }
1053:
1054: arg1 = arg1.next;
1055: arg1c--;
1056: arg2 = arg2.next;
1057: arg2c--;
1058: }
1059: if (arg1c == 1 && arg1.name.equals("args")) {
1060: return true;
1061: }
1062: return (arg1c == 0 && arg2c == 0);
1063: }
1064:
1065: /*
1066: * ------------------------------------------------------------------------
1067: * Itcl_GetMemberFuncUsage -> Methods.GetMemberFuncUsage
1068: *
1069: * Returns a string showing how a command member should be invoked.
1070: * If the command member is a method, then the specified object name
1071: * is reported as part of the invocation path:
1072: *
1073: * obj method arg ?arg arg ...?
1074: *
1075: * Otherwise, the "obj" pointer is ignored, and the class name is
1076: * used as the invocation path:
1077: *
1078: * class::proc arg ?arg arg ...?
1079: *
1080: * Returns the string by appending it onto the TclObject passed in as
1081: * an argument.
1082: * ------------------------------------------------------------------------
1083: */
1084:
1085: static void GetMemberFuncUsage(ItclMemberFunc mfunc, // command member being examined
1086: ItclObject contextObj, // invoked with respect to this object
1087: StringBuffer buffer) // returns: string showing usage
1088: {
1089: int argcount;
1090: String name;
1091: CompiledLocal arglist, arg;
1092: ItclMemberFunc mf;
1093: ItclClass cdefn;
1094:
1095: // If the command is a method and an object context was
1096: // specified, then add the object context. If the method
1097: // was a constructor, and if the object is being created,
1098: // then report the invocation via the class creation command.
1099:
1100: if ((mfunc.member.flags & ItclInt.COMMON) == 0) {
1101: if ((mfunc.member.flags & ItclInt.CONSTRUCTOR) != 0
1102: && contextObj.constructed != null) {
1103:
1104: cdefn = contextObj.classDefn;
1105: mf = (ItclMemberFunc) cdefn.resolveCmds
1106: .get("constructor");
1107:
1108: if (mf == mfunc) {
1109: String fname = contextObj.classDefn.interp
1110: .getCommandFullName(contextObj.classDefn.w_accessCmd);
1111: buffer.append(fname);
1112: buffer.append(" ");
1113: name = contextObj.classDefn.interp
1114: .getCommandName(contextObj.w_accessCmd);
1115: buffer.append(name);
1116: } else {
1117: buffer.append(mfunc.member.fullname);
1118: }
1119: } else if (contextObj != null
1120: && contextObj.accessCmd != null) {
1121: name = contextObj.classDefn.interp
1122: .getCommandName(contextObj.w_accessCmd);
1123: buffer.append(name);
1124: buffer.append(" ");
1125: buffer.append(mfunc.member.name);
1126: } else {
1127: buffer.append("<object> ");
1128: buffer.append(mfunc.member.name);
1129: }
1130: } else {
1131: buffer.append(mfunc.member.fullname);
1132: }
1133:
1134: // Add the argument usage info.
1135:
1136: if (mfunc.member.code != null) {
1137: arglist = mfunc.member.code.arglist;
1138: argcount = mfunc.member.code.argcount;
1139: } else if (mfunc.arglist != null) {
1140: arglist = mfunc.arglist;
1141: argcount = mfunc.argcount;
1142: } else {
1143: arglist = null;
1144: argcount = 0;
1145: }
1146:
1147: if (arglist != null) {
1148: for (arg = arglist; arg != null && argcount > 0; arg = arg.next, argcount--) {
1149:
1150: if (argcount == 1 && arg.name.equals("args")) {
1151: buffer.append(" ?arg arg ...?");
1152: } else if (arg.defValue != null) {
1153: buffer.append(" ?");
1154: buffer.append(arg.name);
1155: buffer.append("?");
1156: } else {
1157: buffer.append(" ");
1158: buffer.append(arg.name);
1159: }
1160: }
1161: }
1162: }
1163:
1164: /*
1165: * ------------------------------------------------------------------------
1166: * Itcl_ExecMethod -> Methods.ExecMethod.cmdProc
1167: *
1168: * Invoked by Tcl to handle the execution of a user-defined method.
1169: * A method is similar to the usual Tcl proc, but has access to
1170: * object-specific data. If for some reason there is no current
1171: * object context, then a method call is inappropriate, and an error
1172: * is returned.
1173: *
1174: * Methods are implemented either as Tcl code fragments, or as Java-coded
1175: * procedures. For Tcl code fragments, command arguments are parsed
1176: * according to the argument list, and the body is executed in the
1177: * scope of the class where it was defined. For Java procedures, the
1178: * arguments are passed in "as-is", and the procedure is executed in
1179: * the most-specific class scope.
1180: * ------------------------------------------------------------------------
1181: */
1182:
1183: static class ExecMethod implements CommandWithDispose {
1184: final ItclMemberFunc mfunc;
1185:
1186: ExecMethod(ItclMemberFunc mfunc) {
1187: if (mfunc == null) {
1188: throw new NullPointerException();
1189: }
1190: this .mfunc = mfunc;
1191: }
1192:
1193: public void disposeCmd() {
1194: Util.ReleaseData(mfunc);
1195: }
1196:
1197: public void cmdProc(Interp interp, // Current interp.
1198: TclObject[] objv) // Args passed to the command.
1199: throws TclException {
1200: ItclMemberFunc mfunc = this .mfunc;
1201: ItclMember member = mfunc.member;
1202:
1203: String token;
1204: ItclClass contextClass;
1205: ItclObject contextObj;
1206:
1207: // Make sure that the current namespace context includes an
1208: // object that is being manipulated. Methods can be executed
1209: // only if an object context exists.
1210:
1211: Methods.GetContextResult gcr = Methods.GetContext(interp);
1212: contextClass = gcr.cdefn;
1213: contextObj = gcr.odefn;
1214:
1215: if (contextObj == null) {
1216: throw new TclException(interp,
1217: "cannot access object-specific info without an object context");
1218: }
1219:
1220: // Make sure that this command member can be accessed from
1221: // the current namespace context.
1222:
1223: if (mfunc.member.protection != Itcl.PUBLIC) {
1224: Namespace contextNs = Util.GetTrueNamespace(interp,
1225: contextClass.info);
1226:
1227: if (!Util.CanAccessFunc(mfunc, contextNs)) {
1228: throw new TclException(interp, "can't access \""
1229: + member.fullname + "\": "
1230: + Util.ProtectionStr(member.protection)
1231: + " function");
1232: }
1233: }
1234:
1235: // All methods should be "virtual" unless they are invoked with
1236: // a "::" scope qualifier.
1237: //
1238: // To implement the "virtual" behavior, find the most-specific
1239: // implementation for the method by looking in the "resolveCmds"
1240: // table for this class.
1241:
1242: token = objv[0].toString();
1243: if (token.indexOf("::") == -1) {
1244: ItclMemberFunc tmp = (ItclMemberFunc) contextObj.classDefn.resolveCmds
1245: .get(member.name);
1246: if (tmp != null) {
1247: mfunc = tmp;
1248: member = mfunc.member;
1249: }
1250: }
1251:
1252: // Execute the code for the method. Be careful to protect
1253: // the method in case it gets deleted during execution.
1254:
1255: Util.PreserveData(mfunc);
1256:
1257: try {
1258: Methods.EvalMemberCode(interp, mfunc, member,
1259: contextObj, objv);
1260: } catch (TclException ex) {
1261: Methods.ReportFuncErrors(interp, mfunc, contextObj, ex);
1262: } finally {
1263: Util.ReleaseData(mfunc);
1264: }
1265: }
1266: } // end class ExecMethod
1267:
1268: /*
1269: * ------------------------------------------------------------------------
1270: * Itcl_ExecProc -> Methods.ExecProc.cmdProc
1271: *
1272: * Invoked by Tcl to handle the execution of a user-defined proc.
1273: *
1274: * Procs are implemented either as Tcl code fragments, or as Java-coded
1275: * procedures. For Tcl code fragments, command arguments are parsed
1276: * according to the argument list, and the body is executed in the
1277: * scope of the class where it was defined. For Java procedures, the
1278: * arguments are passed in "as-is", and the procedure is executed in
1279: * the most-specific class scope.
1280: * ------------------------------------------------------------------------
1281: */
1282:
1283: static class ExecProc implements CommandWithDispose {
1284: ItclMemberFunc mfunc;
1285:
1286: ExecProc(ItclMemberFunc mfunc) {
1287: this .mfunc = mfunc;
1288: }
1289:
1290: public void disposeCmd() {
1291: Util.ReleaseData(mfunc);
1292: }
1293:
1294: public void cmdProc(Interp interp, // Current interp.
1295: TclObject[] objv) // Args passed to the command.
1296: throws TclException {
1297: ItclMember member = mfunc.member;
1298:
1299: // Make sure that this command member can be accessed from
1300: // the current namespace context.
1301:
1302: if (mfunc.member.protection != Itcl.PUBLIC) {
1303: Namespace contextNs = Util.GetTrueNamespace(interp,
1304: mfunc.member.classDefn.info);
1305:
1306: if (!Util.CanAccessFunc(mfunc, contextNs)) {
1307: throw new TclException(interp, "can't access \""
1308: + member.fullname + "\": "
1309: + Util.ProtectionStr(member.protection)
1310: + " function");
1311: }
1312: }
1313:
1314: // Execute the code for the proc. Be careful to protect
1315: // the proc in case it gets deleted during execution.
1316:
1317: Util.PreserveData(mfunc);
1318:
1319: try {
1320: Methods.EvalMemberCode(interp, mfunc, member, null,
1321: objv);
1322: } catch (TclException ex) {
1323: Methods.ReportFuncErrors(interp, mfunc, null, ex);
1324: } finally {
1325: Util.ReleaseData(mfunc);
1326: }
1327: }
1328: } // end class ExecProc
1329:
1330: /*
1331: * ------------------------------------------------------------------------
1332: * Itcl_PushContext -> Methods.PushContext
1333: *
1334: * Sets up the class/object context so that a body of [incr Tcl]
1335: * code can be executed. This procedure pushes a call frame with
1336: * the proper namespace context for the class. If an object context
1337: * is supplied, the object's instance variables are integrated into
1338: * the call frame so they can be accessed as local variables.
1339: * Returns if successful, raises TclException if something goes wrong.
1340: * ------------------------------------------------------------------------
1341: */
1342:
1343: static void PushContext(Interp interp, // interpreter managing this body of code
1344: ItclMember member, // member containing code body
1345: ItclClass contextClass, // class context
1346: ItclObject contextObj, // object context, or null
1347: ItclContext context) // storage space for class/object context
1348: throws TclException {
1349: CallFrame frame = context.frame;
1350:
1351: int localCt, newEntry;
1352: ItclMemberCode mcode;
1353: Procedure proc;
1354:
1355: // Activate the call frame. If this fails, we'll bail out
1356: // before allocating any resources.
1357: //
1358: // NOTE: Always push a call frame that looks like a proc.
1359: // This causes global variables to be handled properly
1360: // inside methods/procs.
1361:
1362: Namespace.pushCallFrame(interp, frame, contextClass.namesp,
1363: true);
1364:
1365: context.classDefn = contextClass;
1366: //context.compiledLocals = new Var[20];
1367:
1368: // If this is an object context, register it in a hash table
1369: // of all known contexts. We'll need this later if we
1370: // call Itcl_GetContext to get the object context for the
1371: // current call frame.
1372:
1373: if (contextObj != null) {
1374: contextClass.info.contextFrames.put(frame, contextObj);
1375: Util.PreserveData(contextObj);
1376: }
1377:
1378: // Set up the compiled locals in the call frame and assign
1379: // argument variables.
1380:
1381: if (member != null) {
1382: //mcode = member.code;
1383: //proc = mcode.proc;
1384:
1385: // If there are too many compiled locals to fit in the default
1386: // storage space for the context, then allocate more space.
1387:
1388: //localCt = proc.numCompiledLocals; // C impl
1389: //localCt = mcode.argcount; // Jacl Procedure has no numCompiledLocals
1390: //if (localCt > context.compiledLocals.length) {
1391: // context.compiledLocals = new Var[localCt];
1392: //}
1393:
1394: // Initialize and resolve compiled variable references.
1395: // Class variables will have special resolution rules.
1396: // In that case, we call their "resolver" procs to get our
1397: // hands on the variable, and we make the compiled local a
1398: // link to the real variable.
1399:
1400: //frame.proc = proc;
1401: //frame.numCompiledLocals = localCt;
1402: //frame.compiledLocals = context.compiledLocals;
1403:
1404: // This method will plug Var objects into the
1405: // compiled local list that starts at frame.proc.firstLocal.
1406: // It makes use of the type flags for each CompiledLocal
1407: // and resolves to actual Var references. Not clear if this
1408: // is something we want for this port.
1409:
1410: //TclInitCompiledLocals(interp, framePtr,
1411: // (Namespace*)contextClass->namesp);
1412: }
1413: }
1414:
1415: /*
1416: * ------------------------------------------------------------------------
1417: * Itcl_PopContext -> Methods.PopContext
1418: *
1419: * Removes a class/object context previously set up by PushContext.
1420: * Usually called after an [incr Tcl] code body has been executed,
1421: * to clean up.
1422: * ------------------------------------------------------------------------
1423: */
1424:
1425: static void PopContext(Interp interp, // interpreter managing this body of code
1426: ItclContext context) // storage space for class/object context
1427: {
1428: CallFrame frame;
1429: ItclObjectInfo info;
1430: ItclObject contextObj;
1431:
1432: // See if the current call frame has an object context
1433: // associated with it. If so, release the claim on the
1434: // object info.
1435:
1436: frame = Migrate.GetCallFrame(interp, 0);
1437: info = context.classDefn.info;
1438:
1439: contextObj = (ItclObject) info.contextFrames.get(frame);
1440: if (contextObj != null) {
1441: Util.ReleaseData(contextObj);
1442: info.contextFrames.remove(frame);
1443: }
1444:
1445: // Remove the call frame.
1446:
1447: Namespace.popCallFrame(interp);
1448:
1449: // Release compiledLocals
1450:
1451: //context.compiledLocals = null;
1452: }
1453:
1454: /*
1455: * ------------------------------------------------------------------------
1456: * Itcl_GetContext -> Methods.GetContext
1457: *
1458: * Convenience routines for looking up the current object/class context.
1459: * Useful in implementing methods/procs to see what class or
1460: * what object, is active.
1461: *
1462: * Returns the current class and or object.
1463: * Raises a TclException if a class namespace is not active.
1464: * ------------------------------------------------------------------------
1465: */
1466:
1467: static GetContextResult GetContext(Interp interp) // current interpreter
1468: throws TclException {
1469: Namespace activeNs = Namespace.getCurrentNamespace(interp);
1470: ItclObjectInfo info;
1471: CallFrame frame;
1472: ItclClass cdefn;
1473: ItclObject odefn;
1474:
1475: // Return null for anything that cannot be found.
1476:
1477: cdefn = null;
1478: odefn = null;
1479:
1480: // If the active namespace is a class namespace, then return
1481: // all known info. See if the current call frame is a known
1482: // object context, and if so, return that context.
1483:
1484: if (Class.IsClassNamespace(activeNs)) {
1485: cdefn = Class.GetClassFromNamespace(activeNs);
1486:
1487: frame = Migrate.GetCallFrame(interp, 0);
1488:
1489: info = cdefn.info;
1490: odefn = (ItclObject) info.contextFrames.get(frame);
1491:
1492: return new GetContextResult(cdefn, odefn);
1493: }
1494:
1495: // If there is no class/object context, return an error message.
1496:
1497: throw new TclException(interp, "namespace \""
1498: + activeNs.fullName + "\" is not a class namespace");
1499: }
1500:
1501: static class GetContextResult {
1502: ItclClass cdefn;
1503: ItclObject odefn;
1504:
1505: public GetContextResult(ItclClass cdefn, ItclObject odefn) {
1506: this .cdefn = cdefn;
1507: this .odefn = odefn;
1508: }
1509: }
1510:
1511: /*
1512: * ------------------------------------------------------------------------
1513: * Itcl_AssignArgs -> Methods.AssignArgs
1514: *
1515: * Matches a list of arguments against a Tcl argument specification.
1516: * Supports all of the rules regarding arguments for Tcl procs, including
1517: * default arguments and variable-length argument lists.
1518: *
1519: * Assumes that a local call frame is already installed. As variables
1520: * are successfully matched, they are stored as variables in the call
1521: * frame. Raises a TclException if anything goes wrong.
1522: * ------------------------------------------------------------------------
1523: */
1524:
1525: static void AssignArgs(Interp interp, // interpreter
1526: TclObject[] objv, // argument objects
1527: ItclMemberFunc mfunc) // member function info (for error messages)
1528: throws TclException {
1529: ItclMemberCode mcode = mfunc.member.code;
1530:
1531: int defargc;
1532: String[] defargv = null;
1533: TclObject[] defobjv = null;
1534: int configc = 0;
1535: ItclVarDefn[] configVars = null;
1536: String[] configVals = null;
1537:
1538: int vi, argsLeft;
1539: ItclClass contextClass;
1540: ItclObject contextObj;
1541: CompiledLocal arg;
1542: CallFrame frame;
1543: Var var;
1544: TclObject obj, list;
1545: String value;
1546: int objvi, objc;
1547: ParseConfigResult pcr = null;
1548:
1549: frame = Migrate.GetCallFrame(interp, 0);
1550: ItclAccess.setCallFrameObjv(frame, objv); // ref counts for args are incremented below
1551:
1552: // See if there is a current object context. We may need
1553: // it later on.
1554:
1555: try {
1556: Methods.GetContextResult gcr = Methods.GetContext(interp);
1557: contextClass = gcr.cdefn;
1558: contextObj = gcr.odefn;
1559: } catch (TclException ex) {
1560: contextClass = null;
1561: contextObj = null;
1562: }
1563: interp.resetResult();
1564:
1565: // Match the actual arguments against the procedure's formal
1566: // parameters to compute local variables.
1567:
1568: //varPtr = framePtr->compiledLocals;
1569:
1570: try { // start of argErrors: finally block
1571:
1572: for (argsLeft = mcode.argcount, arg = mcode.arglist, objvi = 1, objc = objv.length - 1; argsLeft > 0; arg = arg.next, argsLeft--, /*varPtr++,*/objvi++, objc--) {
1573: //if (!TclIsVarArgument(argPtr)) {
1574: // Tcl_Panic("local variable %s is not argument but should be",
1575: // argPtr->name);
1576: // return TCL_ERROR;
1577: //}
1578: //if (TclIsVarTemporary(argPtr)) {
1579: // Tcl_Panic("local variable is temporary but should be an argument");
1580: // return TCL_ERROR;
1581: //}
1582:
1583: // Handle the special case of the last formal being "args".
1584: // When it occurs, assign it a list consisting of all the
1585: // remaining actual arguments.
1586:
1587: if ((argsLeft == 1) && arg.name.equals("args")) {
1588: //listPtr = Tcl_NewListObj(objc, objv);
1589: //varPtr->value.objPtr = listPtr;
1590: //Tcl_IncrRefCount(listPtr); /* local var is a reference */
1591: //varPtr->flags &= ~VAR_UNDEFINED;
1592: //objc = 0;
1593:
1594: if (objc < 0)
1595: objc = 0;
1596:
1597: list = TclList.newInstance();
1598: for (int i = objvi; i < (objvi + objc); i++) {
1599: TclList.append(interp, list, objv[i]);
1600: }
1601: AssignLocal(interp, "args", list, frame);
1602: objc = 0;
1603: break;
1604: }
1605:
1606: // Handle the special case of the last formal being "config".
1607: // When it occurs, treat all remaining arguments as public
1608: // variable assignments. Set the local "config" variable
1609: // to the list of public variables assigned.
1610:
1611: else if ((argsLeft == 1) && arg.name.equals("config")
1612: && contextObj != null) {
1613: // If this is not an old-style method, discourage against
1614: // the use of the "config" argument.
1615:
1616: if ((mfunc.member.flags & ItclInt.OLD_STYLE) == 0) {
1617: throw new TclException(
1618: interp,
1619: "\"config\" argument is an anachronism\n"
1620: + "[incr Tcl] no longer supports the \"config\" argument.\n"
1621: + "Instead, use the \"args\" argument and then use the\n"
1622: + "built-in configure method to handle args like this:\n"
1623: + " eval configure $args");
1624: }
1625:
1626: // Otherwise, handle the "config" argument in the usual way...
1627: // - parse all "-name value" assignments
1628: // - set "config" argument to the list of variable names
1629:
1630: if (objc > 0) { // still have some arguments left?
1631:
1632: pcr = ParseConfig(interp, objc, objv, objvi,
1633: contextObj);
1634: configc = pcr.num_variables;
1635: configVars = pcr.variables;
1636: configVals = pcr.values;
1637:
1638: list = TclList.newInstance();
1639: for (vi = 0; vi < configc; vi++) {
1640: StringBuffer buffer = new StringBuffer(64);
1641: buffer
1642: .append(configVars[vi].member.classDefn.name);
1643: buffer.append("::");
1644: buffer.append(configVars[vi].member.name);
1645: obj = TclString.newInstance(buffer
1646: .toString());
1647: TclList.append(interp, list, obj);
1648: }
1649:
1650: //varPtr->value.objPtr = listPtr;
1651: //Tcl_IncrRefCount(listPtr); // local var is a reference
1652: //varPtr->flags &= ~VAR_UNDEFINED;
1653:
1654: // FIXME: is setting a local named "config" correct?
1655: AssignLocal(interp, arg.name, list, frame);
1656: objc = 0; // all remaining args handled
1657: }
1658:
1659: else if (arg.defValue != null) {
1660: //value = arg.defValue.toString();
1661: //defargv = null;
1662: //defargc = 0;
1663: defobjv = TclList.getElements(interp,
1664: arg.defValue);
1665: defargc = defobjv.length;
1666:
1667: for (vi = 0; vi < defargc; vi++) {
1668: defobjv[vi].preserve();
1669: }
1670:
1671: pcr = ParseConfig(interp, defargc, defobjv, 0,
1672: contextObj);
1673: configc = pcr.num_variables;
1674: configVars = pcr.variables;
1675: configVals = pcr.values;
1676:
1677: list = TclList.newInstance();
1678: for (vi = 0; vi < configc; vi++) {
1679: StringBuffer buffer = new StringBuffer(64);
1680: buffer
1681: .append(configVars[vi].member.classDefn.name);
1682: buffer.append("::");
1683: buffer.append(configVars[vi].member.name);
1684:
1685: obj = TclString.newInstance(buffer
1686: .toString());
1687: TclList.append(interp, list, obj);
1688: }
1689:
1690: //varPtr->value.objPtr = listPtr;
1691: //Tcl_IncrRefCount(listPtr); // local var is a reference
1692: //varPtr->flags &= ~VAR_UNDEFINED;
1693: AssignLocal(interp, arg.name, list, frame);
1694: } else {
1695: //objPtr = Tcl_NewStringObj("", 0);
1696: //varPtr->value.objPtr = objPtr;
1697: //Tcl_IncrRefCount(objPtr); /* local var is a reference */
1698: //varPtr->flags &= ~VAR_UNDEFINED;
1699: obj = TclString.newInstance("");
1700: AssignLocal(interp, arg.name, obj, frame);
1701: }
1702: }
1703:
1704: // Resume the usual processing of arguments...
1705:
1706: else if (objc > 0) { // take next arg as value
1707: //objPtr = *objv;
1708: //varPtr->value.objPtr = objPtr;
1709: //varPtr->flags &= ~VAR_UNDEFINED;
1710: //Tcl_IncrRefCount(objPtr); // local var is a reference
1711: obj = objv[objvi];
1712: AssignLocal(interp, arg.name, obj, frame);
1713: } else if (arg.defValue != null) { // ...or use default value
1714: //objPtr = argPtr->defValuePtr;
1715: //varPtr->value.objPtr = objPtr;
1716: //varPtr->flags &= ~VAR_UNDEFINED;
1717: //Tcl_IncrRefCount(objPtr); // local var is a reference
1718: obj = arg.defValue;
1719: AssignLocal(interp, arg.name, obj, frame);
1720: } else {
1721: if (mfunc != null) {
1722: StringBuffer buffer = new StringBuffer(64);
1723: buffer.append("wrong # args: should be \"");
1724: GetMemberFuncUsage(mfunc, contextObj, buffer);
1725: buffer.append("\"");
1726: throw new TclException(interp, buffer
1727: .toString());
1728: } else {
1729: throw new TclException(interp,
1730: "no value given for parameter \""
1731: + arg.name + "\"");
1732: }
1733: }
1734: }
1735:
1736: if (objc > 0) {
1737: if (mfunc != null) {
1738: StringBuffer buffer = new StringBuffer(64);
1739: buffer.append("wrong # args: should be \"");
1740: GetMemberFuncUsage(mfunc, contextObj, buffer);
1741: buffer.append("\"");
1742: throw new TclException(interp, buffer.toString());
1743: } else {
1744: throw new TclException(interp, "too many arguments");
1745: }
1746: }
1747:
1748: // Handle any "config" assignments.
1749:
1750: if (configc > 0) {
1751: HandleConfig(interp, pcr, contextObj);
1752: }
1753:
1754: } finally { // end of argErrors: finally block
1755: if (defobjv != null) {
1756: for (vi = 0; vi < defobjv.length; vi++) {
1757: defobjv[vi].release();
1758: }
1759: }
1760: }
1761: }
1762:
1763: /*
1764: * ------------------------------------------------------------------------
1765: * Methods.AssignLocal
1766: *
1767: * Assign a local variable by adding a Var to the varTable
1768: * for the current frame. This is needed so that we don't
1769: * accidently overwrite common or instance vars while setting
1770: * the values/defaults for arguments.
1771: * ------------------------------------------------------------------------
1772: */
1773:
1774: static void AssignLocal(Interp interp, // interpreter
1775: String name, // local variable name
1776: TclObject val, // value of variable
1777: CallFrame frame) // frame that contains the local varTable
1778: throws TclException {
1779: ItclAccess.assignLocalVar(interp, name, val, frame);
1780: }
1781:
1782: /*
1783: * ------------------------------------------------------------------------
1784: * ItclParseConfig -> Methods.ParseConfig
1785: *
1786: * Parses a set of arguments as "-variable value" assignments.
1787: * Interprets all variable names in the most-specific class scope,
1788: * so that an inherited method with a "config" parameter will work
1789: * correctly. Returns an objects containing the number of
1790: * variables accessed, an array of public variable names, and
1791: * their corresponding values. These values are passed to
1792: * HandleConfig to perform assignments.
1793: * ------------------------------------------------------------------------
1794: */
1795:
1796: static ParseConfigResult ParseConfig(Interp interp, // interpreter
1797: int objc, // count of objects remaining (after objvIndex)
1798: TclObject[] objv, // argument objects
1799: int objvIndex, // index of first object in objv to consider
1800: ItclObject contextObj) // object whose public vars are being config'd
1801: throws TclException {
1802: ItclVarLookup vlookup;
1803: String varName, value;
1804:
1805: int rargc; // return: number of variables accessed
1806: ItclVarDefn[] rvars; // return: list of variables
1807: String[] rvals; // return: list of values
1808:
1809: if (objc < 0)
1810: objc = 0;
1811: rargc = 0;
1812: rvars = new ItclVarDefn[objc];
1813: rvals = new String[objc];
1814:
1815: while (objc-- > 0) {
1816: // Next argument should be "-variable"
1817:
1818: varName = objv[objvIndex].toString();
1819: if (varName.length() < 2 || varName.charAt(0) != '-') {
1820: throw new TclException(interp,
1821: "syntax error in config assignment \""
1822: + varName
1823: + "\": should be \"-variable value\"");
1824: } else if (objc-- <= 0) {
1825: throw new TclException(
1826: interp,
1827: "syntax error in config assignment \""
1828: + varName
1829: + "\": should be \"-variable value\" (missing value)");
1830: }
1831:
1832: vlookup = (ItclVarLookup) contextObj.classDefn.resolveVars
1833: .get(varName.substring(1));
1834:
1835: if (vlookup != null) {
1836: value = objv[objvIndex + 1].toString();
1837:
1838: rvars[rargc] = vlookup.vdefn; // variable definition
1839: rvals[rargc] = value; // config value
1840: rargc++;
1841: objvIndex += 2;
1842: } else {
1843: throw new TclException(interp,
1844: "syntax error in config assignment \""
1845: + varName + "\": unrecognized variable");
1846: }
1847: }
1848:
1849: ParseConfigResult pcr = new ParseConfigResult();
1850: pcr.num_variables = rargc;
1851: pcr.variables = rvars;
1852: pcr.values = rvals;
1853: return pcr;
1854: }
1855:
1856: static class ParseConfigResult {
1857: int num_variables;
1858: ItclVarDefn[] variables;
1859: String[] values;
1860: }
1861:
1862: /*
1863: * ------------------------------------------------------------------------
1864: * ItclHandleConfig -> Methods.HandleConfig
1865: *
1866: * Handles the assignment of "config" values to public variables.
1867: * The list of assignments is parsed in ParseConfig(), but the
1868: * actual assignments are performed here. If the variables have any
1869: * associated "config" code, it is invoked here as well. If errors
1870: * are detected during assignment or "config" code execution, the
1871: * variable is set back to its previous value and an exception is raised.
1872: *
1873: * Raises a TclException if anything goes wrong.
1874: * ------------------------------------------------------------------------
1875: */
1876:
1877: static void HandleConfig(Interp interp, // interpreter currently in control
1878: ParseConfigResult pres, // assignments, variables, and values
1879: ItclObject contextObj) // object whose public vars are being config'd
1880: throws TclException {
1881: TclObject valObj;
1882: String val;
1883: StringBuffer lastval;
1884: ItclContext context;
1885: CallFrame oldFrame, uplevelFrame;
1886:
1887: int argc = pres.num_variables;
1888: ItclVarDefn[] vars = pres.variables;
1889: String[] vals = pres.values;
1890:
1891: lastval = new StringBuffer(64);
1892:
1893: // All "config" assignments are performed in the most-specific
1894: // class scope, so that inherited methods with "config" arguments
1895: // will work correctly.
1896:
1897: context = new ItclContext(interp);
1898: Methods.PushContext(interp, null, contextObj.classDefn,
1899: contextObj, context);
1900:
1901: try {
1902:
1903: // Perform each assignment and execute the "config" code
1904: // associated with each variable. If any errors are encountered,
1905: // set the variable back to its previous value, and return an error.
1906:
1907: for (int i = 0; i < argc; i++) {
1908: valObj = interp.getVar(vars[i].member.fullname, 0);
1909: if (valObj == null) {
1910: val = "";
1911: } else {
1912: val = valObj.toString();
1913: }
1914: lastval.setLength(0);
1915: lastval.append(val);
1916:
1917: // Set the variable to the specified value.
1918:
1919: try {
1920: // FIXME: is this set going to change and of the
1921: // local variables or will it be effected by
1922: // local setting that happened?
1923: interp.setVar(vars[i].member.fullname, TclString
1924: .newInstance(vals[i]), 0);
1925: } catch (TclException ex) {
1926: interp
1927: .addErrorInfo("\n (while configuring public variable \""
1928: + vars[i].member.fullname + "\")");
1929: throw ex;
1930: }
1931:
1932: // If the variable has a "config" condition, then execute it.
1933: // If it fails, put the variable back the way it was and return
1934: // an error.
1935: //
1936: // TRICKY NOTE: Be careful to evaluate the code one level
1937: // up in the call stack, so that it's executed in the
1938: // calling context, and not in the context that we've
1939: // set up for public variable access.
1940:
1941: if (vars[i].member.code != null) {
1942:
1943: uplevelFrame = Migrate.GetCallFrame(interp, 1);
1944: oldFrame = Migrate.ActivateCallFrame(interp,
1945: uplevelFrame);
1946:
1947: TclException evalEx = null;
1948:
1949: try {
1950: Methods.EvalMemberCode(interp, null,
1951: vars[i].member, contextObj, null);
1952: } catch (TclException ex) {
1953: evalEx = ex;
1954: } finally {
1955: Migrate.ActivateCallFrame(interp, oldFrame);
1956: }
1957:
1958: if (evalEx != null) {
1959: interp
1960: .addErrorInfo("\n (while configuring public variable \""
1961: + vars[i].member.fullname
1962: + "\")");
1963:
1964: interp.setVar(vars[i].member.fullname,
1965: TclString.newInstance(lastval
1966: .toString()), 0);
1967:
1968: throw evalEx;
1969: }
1970: }
1971: }
1972:
1973: } finally {
1974: // Clean up before returning
1975: Methods.PopContext(interp, context);
1976: }
1977: }
1978:
1979: /*
1980: * ------------------------------------------------------------------------
1981: * Itcl_ConstructBase -> Methods.ConstructBase
1982: *
1983: * Usually invoked just before executing the body of a constructor
1984: * when an object is first created. This procedure makes sure that
1985: * all base classes are properly constructed. If an "initCode" fragment
1986: * was defined with the constructor for the class, then it is invoked.
1987: * After that, the list of base classes is checked for constructors
1988: * that are defined but have not yet been invoked. Each of these is
1989: * invoked implicitly with no arguments.
1990: *
1991: * Assumes that a local call frame is already installed, and that
1992: * constructor arguments have already been matched and are sitting in
1993: * this frame. Raises a TclException if anything goes wrong.
1994: * ------------------------------------------------------------------------
1995: */
1996:
1997: static void ConstructBase(Interp interp, // interpreter
1998: ItclObject contextObj, // object being constructed
1999: ItclClass contextClass) // current class being constructed
2000: throws TclException {
2001: Itcl_ListElem elem;
2002: ItclClass cdefn;
2003:
2004: // If the class has an "initCode", invoke it in the current context.
2005: //
2006: // TRICKY NOTE:
2007: // This context is the call frame containing the arguments
2008: // for the constructor. The "initCode" makes sense right
2009: // now--just before the body of the constructor is executed.
2010:
2011: if (contextClass.initCode != null) {
2012: interp.eval(contextClass.initCode.toString());
2013: }
2014:
2015: // Scan through the list of base classes and see if any of these
2016: // have not been constructed. Invoke base class constructors
2017: // implicitly, as needed. Go through the list of base classes
2018: // in reverse order, so that least-specific classes are constructed
2019: // first.
2020:
2021: elem = Util.LastListElem(contextClass.bases);
2022: while (elem != null) {
2023: cdefn = (ItclClass) Util.GetListValue(elem);
2024:
2025: if (contextObj.constructed.get(cdefn.name) == null) {
2026:
2027: Methods.InvokeMethodIfExists(interp, "constructor",
2028: cdefn, contextObj, null);
2029:
2030: // The base class may not have a constructor, but its
2031: // own base classes could have one. If the constructor
2032: // wasn't found in the last step, then other base classes
2033: // weren't constructed either. Make sure that all of its
2034: // base classes are properly constructed.
2035:
2036: if (cdefn.functions.get("constructor") == null) {
2037: Methods.ConstructBase(interp, contextObj, cdefn);
2038: }
2039: }
2040: elem = Util.PrevListElem(elem);
2041: }
2042: }
2043:
2044: /*
2045: * ------------------------------------------------------------------------
2046: * Itcl_InvokeMethodIfExists -> Methods.InvokeMethodIfExists
2047: *
2048: * Looks for a particular method in the specified class. If the
2049: * method is found, it is invoked with the given arguments. Any
2050: * protection level (protected/private) for the method is ignored.
2051: * If the method does not exist, this procedure does nothing.
2052: *
2053: * This procedure is used primarily to invoke the constructor/destructor
2054: * when an object is created/destroyed.
2055: *
2056: * Raises a TclException if anything goes wrong.
2057: * ------------------------------------------------------------------------
2058: */
2059:
2060: static void InvokeMethodIfExists(Interp interp, // interpreter
2061: String name, // name of desired method
2062: ItclClass contextClass, // current class being constructed
2063: ItclObject contextObj, // object being constructed
2064: TclObject[] objv) // argument objects, can be null
2065: throws TclException {
2066: ItclMemberFunc mfunc;
2067: ItclMember member;
2068: TclObject cmdline;
2069: TclObject[] cmdlinev;
2070:
2071: // Scan through the list of base classes and see if any of these
2072: // have not been constructed. Invoke base class constructors
2073: // implicitly, as needed. Go through the list of base classes
2074: // in reverse order, so that least-specific classes are constructed
2075: // first.
2076:
2077: mfunc = (ItclMemberFunc) contextClass.functions.get(name);
2078:
2079: if (mfunc != null) {
2080: member = mfunc.member;
2081:
2082: // Prepend the method name to the list of arguments.
2083:
2084: cmdline = Util.CreateArgs(interp, name, objv, 0);
2085: cmdlinev = TclList.getElements(interp, cmdline);
2086:
2087: // Execute the code for the method. Be careful to protect
2088: // the method in case it gets deleted during execution.
2089:
2090: Util.PreserveData(mfunc);
2091:
2092: try {
2093: EvalMemberCode(interp, mfunc, member, contextObj,
2094: cmdlinev);
2095: } catch (TclException ex) {
2096: ReportFuncErrors(interp, mfunc, contextObj, ex);
2097: } finally {
2098: Util.ReleaseData(mfunc);
2099: }
2100: }
2101: }
2102:
2103: /*
2104: * ------------------------------------------------------------------------
2105: * Itcl_ReportFuncErrors -> Methods.ReportFuncErrors
2106: *
2107: * Used to interpret the status code returned when the body of a
2108: * Tcl-style proc is executed. Handles the "errorInfo" and "errorCode"
2109: * variables properly, and adds error information into the interpreter
2110: * if anything went wrong. Returns a new status code that should be
2111: * treated as the return status code for the command.
2112: *
2113: * This same operation is usually buried in the Tcl InterpProc()
2114: * procedure. It is defined here so that it can be reused more easily.
2115: * ------------------------------------------------------------------------
2116: */
2117:
2118: static void ReportFuncErrors(Interp interp, // interpreter being modified
2119: ItclMemberFunc mfunc, // command member that was invoked
2120: ItclObject contextObj, // object context for this command
2121: TclException exp) // TclException from proc body
2122: throws TclException {
2123: StringBuffer buffer;
2124:
2125: if (exp != null) {
2126: int code = exp.getCompletionCode();
2127:
2128: if (code == TCL.RETURN) {
2129: code = interp.updateReturnInfo();
2130:
2131: if (code != TCL.OK && code != TCL.ERROR) {
2132: interp.processUnexpectedResult(code);
2133: } else if (code != TCL.OK) {
2134: exp.setCompletionCode(code);
2135: throw exp;
2136: } else if (code == TCL.OK) {
2137: return;
2138: }
2139: } else if (code != TCL.ERROR) {
2140: exp.printStackTrace(System.out);
2141: throw new TclRuntimeError(
2142: "unexpected TclException completion code : "
2143: + code);
2144: }
2145: buffer = new StringBuffer(64);
2146: buffer.append("\n ");
2147:
2148: if ((mfunc.member.flags & ItclInt.CONSTRUCTOR) != 0) {
2149: buffer.append("while constructing object \"");
2150: buffer.append(contextObj.classDefn.interp
2151: .getCommandFullName(contextObj.w_accessCmd));
2152: buffer.append("\" in ");
2153: buffer.append(mfunc.member.fullname);
2154: if ((mfunc.member.code.flags & ItclInt.IMPLEMENT_TCL) != 0) {
2155: buffer.append(" (");
2156: }
2157: } else if ((mfunc.member.flags & ItclInt.DESTRUCTOR) != 0) {
2158: buffer.append("while deleting object \"");
2159: buffer.append(contextObj.classDefn.interp
2160: .getCommandFullName(contextObj.w_accessCmd));
2161: buffer.append("\" in ");
2162: buffer.append(mfunc.member.fullname);
2163: if ((mfunc.member.code.flags & ItclInt.IMPLEMENT_TCL) != 0) {
2164: buffer.append(" (");
2165: }
2166: } else {
2167: buffer.append("(");
2168:
2169: if (contextObj != null && contextObj.accessCmd != null) {
2170: buffer.append("object \"");
2171: buffer
2172: .append(contextObj.classDefn.interp
2173: .getCommandFullName(contextObj.w_accessCmd));
2174: buffer.append("\" ");
2175: }
2176:
2177: if ((mfunc.member.flags & ItclInt.COMMON) != 0) {
2178: buffer.append("procedure");
2179: } else {
2180: buffer.append("method");
2181: }
2182:
2183: buffer.append(" \"");
2184: buffer.append(mfunc.member.fullname);
2185: buffer.append("\" ");
2186: }
2187:
2188: if ((mfunc.member.code.flags & ItclInt.IMPLEMENT_TCL) != 0) {
2189: buffer.append("body line ");
2190: buffer.append(interp.getErrorLine());
2191: buffer.append(")");
2192: } else {
2193: buffer.append(")");
2194: }
2195:
2196: interp.addErrorInfo(buffer.toString());
2197: throw exp;
2198: }
2199: }
2200:
2201: } // end class Methods
2202:
2203: // This class is like the CompiledLocal struct in the C version
2204: // of Tcl. It is not really "compiled" in Jacl, but the name
2205: // is the same.
2206:
2207: class CompiledLocal {
2208: CompiledLocal next; // Next local var or null for last local.
2209:
2210: /*
2211: int flags; // Flag bits for the local variable. Same as
2212: // the flags for the Var structure above,
2213: // although only VAR_SCALAR, VAR_ARRAY,
2214: // VAR_LINK, VAR_ARGUMENT, VAR_TEMPORARY, and
2215: // VAR_RESOLVED make sense.
2216: */
2217:
2218: TclObject defValue; // default argument value, null if not
2219: // and argument or no default.
2220:
2221: String name; // Name of local variable, can be null.
2222: }
|