0001: /*
0002: * Interp.java --
0003: *
0004: * Implements the core Tcl interpreter.
0005: *
0006: * Copyright (c) 1997 Cornell University.
0007: * Copyright (c) 1997-1998 Sun Microsystems, Inc.
0008: *
0009: * See the file "license.terms" for information on usage and
0010: * redistribution of this file, and for a DISCLAIMER OF ALL
0011: * WARRANTIES.
0012: *
0013: * RCS: @(#) $Id: Interp.java,v 1.87 2007/06/07 20:52:15 mdejong Exp $
0014: *
0015: */
0016:
0017: package tcl.lang;
0018:
0019: import java.lang.reflect.*;
0020: import java.util.*;
0021: import java.io.*;
0022: import java.net.*;
0023:
0024: /**
0025: * The Tcl interpreter class.
0026: */
0027:
0028: public class Interp extends EventuallyFreed {
0029:
0030: // The following three variables are used to maintain a translation
0031: // table between ReflectObject's and their string names. These
0032: // variables are accessed by the ReflectObject class, they
0033: // are defined here be cause we need them to be per interp data.
0034:
0035: // Translates Object to ReflectObject. This makes sure we have only
0036: // one ReflectObject internalRep for the same Object -- this
0037: // way Object identity can be done by string comparison.
0038:
0039: HashMap reflectObjTable = new HashMap();
0040:
0041: // Number of reflect objects created so far inside this Interp
0042: // (including those that have be freed)
0043:
0044: long reflectObjCount = 0;
0045:
0046: // Table used to store reflect hash index conflicts, see
0047: // ReflectObject implementation for more details
0048:
0049: HashMap reflectConflictTable = new HashMap();
0050:
0051: // The number of chars to copy from an offending command into error
0052: // message.
0053:
0054: private static final int MAX_ERR_LENGTH = 200;
0055:
0056: // We pretend this is Tcl 8.0, patch level 0.
0057:
0058: static final String TCL_VERSION = "8.0";
0059: static final String TCL_PATCH_LEVEL = "8.0";
0060:
0061: // Total number of times a command procedure
0062: // has been called for this interpreter.
0063:
0064: protected int cmdCount;
0065:
0066: // Table of channels currently registered in this interp.
0067:
0068: HashMap interpChanTable;
0069:
0070: // The Notifier associated with this Interp.
0071:
0072: private Notifier notifier;
0073:
0074: // Hash table for associating data with this interpreter. Cleaned up
0075: // when this interpreter is deleted.
0076:
0077: HashMap assocData;
0078:
0079: // Current working directory.
0080:
0081: private File workingDir;
0082:
0083: // Points to top-most in stack of all nested procedure
0084: // invocations. null means there are no active procedures.
0085:
0086: CallFrame frame;
0087:
0088: // Points to the call frame whose variables are currently in use
0089: // (same as frame unless an "uplevel" command is being
0090: // executed). null means no procedure is active or "uplevel 0" is
0091: // being exec'ed.
0092:
0093: CallFrame varFrame;
0094:
0095: // The interpreter's global namespace.
0096:
0097: Namespace globalNs;
0098:
0099: // Hash table used to keep track of hidden commands on a per-interp basis.
0100:
0101: HashMap hiddenCmdTable;
0102:
0103: // Information used by InterpCmd.java to keep
0104: // track of master/slave interps on a per-interp basis.
0105:
0106: // Keeps track of all interps for which this interp is the Master.
0107: // First, slaveTable (a hashtable) maps from names of commands to
0108: // slave interpreters. This hashtable is used to store information
0109: // about slave interpreters of this interpreter, to map over all slaves, etc.
0110:
0111: HashMap slaveTable;
0112:
0113: // Hash table for Target Records. Contains all Target records which denote
0114: // aliases from slaves or sibling interpreters that direct to commands in
0115: // this interpreter. This table is used to remove dangling pointers
0116: // from the slave (or sibling) interpreters when this interpreter is deleted.
0117:
0118: HashMap targetTable;
0119:
0120: // Information necessary for this interp to function as a slave.
0121: InterpSlaveCmd slave;
0122:
0123: // Table which maps from names of commands in slave interpreter to
0124: // InterpAliasCmd objects.
0125:
0126: HashMap aliasTable;
0127:
0128: // FIXME : does globalFrame need to be replaced by globalNs?
0129: // Points to the global variable frame.
0130:
0131: //CallFrame globalFrame;
0132:
0133: // The script file currently under execution. Can be null if the
0134: // interpreter is not evaluating any script file.
0135:
0136: String scriptFile;
0137:
0138: // Number of times the interp.eval() routine has been recursively
0139: // invoked.
0140:
0141: int nestLevel;
0142:
0143: // Used to catch infinite loops in Parser.eval2.
0144:
0145: final int maxNestingDepth = 1000;
0146:
0147: // Flags used when evaluating a command.
0148:
0149: int evalFlags;
0150:
0151: // Flags used when evaluating a command.
0152:
0153: int flags;
0154:
0155: // Is this interpreted marked as safe?
0156:
0157: boolean isSafe;
0158:
0159: // Offset of character just after last one compiled or executed
0160: // by Parser.eval2().
0161:
0162: int termOffset;
0163:
0164: // List of name resolution schemes added to this interpreter.
0165: // Schemes are added/removed by calling addInterpResolver and
0166: // removeInterpResolver.
0167:
0168: ArrayList resolvers;
0169:
0170: // The expression parser for this interp.
0171:
0172: Expression expr;
0173:
0174: // Used by the Expression class. If it is equal to zero, then the
0175: // parser will evaluate commands and retrieve variable values from
0176: // the interp.
0177:
0178: int noEval;
0179:
0180: // Used in the Expression.java file for the
0181: // SrandFunction.class and RandFunction.class.
0182: // Set to true if a seed has been set.
0183:
0184: boolean randSeedInit;
0185:
0186: // Used in the Expression.java file for the SrandFunction.class and
0187: // RandFunction.class. Stores the value of the seed.
0188:
0189: long randSeed;
0190:
0191: // If returnCode is TCL.ERROR, stores the errorInfo.
0192:
0193: String errorInfo;
0194:
0195: // If returnCode is TCL.ERROR, stores the errorCode.
0196:
0197: String errorCode;
0198:
0199: // Completion code to return if current procedure exits with a
0200: // TCL_RETURN code.
0201:
0202: protected int returnCode;
0203:
0204: // True means the interpreter has been deleted: don't process any
0205: // more commands for it, and destroy the structure as soon as all
0206: // nested invocations of eval() are done.
0207:
0208: protected boolean deleted;
0209:
0210: // True means an error unwind is already in progress. False
0211: // means a command proc has been invoked since last error occured.
0212:
0213: protected boolean errInProgress;
0214:
0215: // True means information has already been logged in $errorInfo
0216: // for the current eval() instance, so eval() needn't log it
0217: // (used to implement the "error" command).
0218:
0219: protected boolean errAlreadyLogged;
0220:
0221: // True means that addErrorInfo has been called to record
0222: // information for the current error. False means Interp.eval
0223: // must clear the errorCode variable if an error is returned.
0224:
0225: protected boolean errCodeSet;
0226:
0227: // When TCL_ERROR is returned, this gives the line number within
0228: // the command where the error occurred (1 means first line).
0229:
0230: int errorLine;
0231:
0232: // Stores the current result in the interpreter.
0233:
0234: private TclObject m_result;
0235:
0236: // Value m_result is set to when resetResult() is called.
0237:
0238: private final TclObject m_nullResult;
0239:
0240: // Shared common result values. For common values, it
0241: // is much better to use a shared TclObject. These
0242: // common values are used in interp.setResult()
0243: // methods for built-in Java types. The internal rep
0244: // of these shared values should not be changed.
0245:
0246: // The boolean true and false constants are tricky.
0247: // The true value is the integer 1, it is not
0248: // an instance of TclBoolean with a string rep
0249: // of "true". The false value is the integer 0.
0250: // This approach makes it possible for the expr
0251: // module to treat boolean results as integers.
0252:
0253: private final TclObject m_falseBooleanResult; // false (int 0)
0254: private final TclObject m_trueBooleanResult; // true (int 1)
0255:
0256: private final TclObject m_minusoneIntegerResult; // -1
0257: private final TclObject m_zeroIntegerResult; // 0
0258: private final TclObject m_oneIntegerResult; // 1
0259: private final TclObject m_twoIntegerResult; // 2
0260:
0261: private final TclObject m_zeroDoubleResult; // 0.0
0262: private final TclObject m_onehalfDoubleResult; // 0.5
0263: private final TclObject m_oneDoubleResult; // 1.0
0264: private final TclObject m_twoDoubleResult; // 2.0
0265:
0266: // Set to true to enable debug code that will double check
0267: // that each common value is a shared object. It is
0268: // possible that buggy code might decr the ref count
0269: // of a shared result so this code would raise an
0270: // error if that case were detected.
0271:
0272: private final static boolean VALIDATE_SHARED_RESULTS = false;
0273:
0274: // When a method like setResult(int) is invoked with
0275: // an int that is not a common value, the recycledI
0276: // TclObject is modified so that it contains the
0277: // new value. This is much faster than allocating
0278: // a new TclObject and setResult() and setVar()
0279: // are performance critical.
0280:
0281: private TclObject recycledI;
0282: private TclObject recycledD;
0283:
0284: // Common char values wrapped in a TclObject
0285:
0286: private final TclObject[] m_charCommon;
0287: private final int m_charCommonMax = 128;
0288:
0289: // Java thread this interp was created in. This is used
0290: // to check for user coding errors where the user tries
0291: // to create an interp in one thread and then invoke
0292: // methods from another thread.
0293:
0294: private Thread cThread;
0295: private String cThreadName;
0296:
0297: // Used ONLY by PackageCmd.
0298:
0299: HashMap packageTable;
0300: String packageUnknown;
0301:
0302: // Used ONLY by the Parser.
0303:
0304: TclObject[][][] parserObjv;
0305: int[] parserObjvUsed;
0306:
0307: TclToken[] parserTokens;
0308: int parserTokensUsed;
0309:
0310: // Used ONLY by JavaImportCmd
0311: HashMap[] importTable = { new HashMap(), new HashMap() };
0312:
0313: // Used by callers of Util.strtoul(), also used in FormatCmd.strtoul().
0314: // There is typically only one instance of a StrtoulResult around
0315: // at any one time. Callers should exercise care to use the results
0316: // before any other code could call strtoul() again.
0317:
0318: StrtoulResult strtoulResult = new StrtoulResult();
0319:
0320: // Used by callers of Util.strtod(). Usage is same as above.
0321:
0322: StrtodResult strtodResult = new StrtodResult();
0323:
0324: // Used only with Namespace.getNamespaceForQualName()
0325:
0326: Namespace.GetNamespaceForQualNameResult getnfqnResult = new Namespace.GetNamespaceForQualNameResult();
0327:
0328: // Cached array object accessed only in Var.lookupVar().
0329: // This array is returned by Var.lookupVar(), so a ref
0330: // to it should not be held by the caller for longer than
0331: // is needed to query the return values.
0332:
0333: Var[] lookupVarResult = new Var[2];
0334:
0335: // List of unsafe commands:
0336:
0337: static final String[] unsafeCmds = { "encoding", "exit", "load",
0338: "cd", "fconfigure", "file", "glob", "open", "pwd",
0339: "socket", "beep", "echo", "ls", "resource", "source",
0340: "exec", "source" };
0341:
0342: // Flags controlling the call of invoke.
0343:
0344: static final int INVOKE_HIDDEN = 1;
0345: static final int INVOKE_NO_UNKNOWN = 2;
0346: static final int INVOKE_NO_TRACEBACK = 4;
0347:
0348: // The ClassLoader for this interp
0349:
0350: TclClassLoader classLoader = null;
0351:
0352: // Map of Tcl library scripts that is initialized
0353: // the first time a script is loaded. All interps
0354: // will use the cached value once it has been
0355: // initialized. Tcl library scripts are located
0356: // in jacl.jar and tcljava.jar, this logic assumes
0357: // that they will not change at runtime. This
0358: // feature can be disabled by changing the
0359: // USE_SCRIPT_CACHE flag in evalResource to false,
0360: // but this object must be statically initialized
0361: // in order to avoid a possible race condition
0362: // during the first call to evalResource.
0363:
0364: static HashMap tclLibraryScripts = new HashMap();
0365:
0366: // The interruptedEvent field is set after a call
0367: // to Interp.setInterrupted(). When non-null, this
0368: // field indicates that the user has requested
0369: // that the interp execution should be interrupted
0370: // at the next safe moment.
0371:
0372: private TclInterruptedExceptionEvent interruptedEvent = null;
0373:
0374: /*
0375: *----------------------------------------------------------------------
0376: *
0377: * Tcl_CreateInterp -> Interp
0378: * Initializes an interpreter object.
0379: *
0380: * Side effects:
0381: * Various parts of the interpreter are initialized; built-in
0382: * commands are created; global variables are initialized, etc.
0383: *
0384: *----------------------------------------------------------------------
0385: */
0386:
0387: public Interp() {
0388:
0389: //freeProc = null;
0390: errorLine = 0;
0391:
0392: // An empty result is used pretty often. We will use a shared
0393: // TclObject instance to represent the empty result so that we
0394: // don't need to create a new TclObject instance every time the
0395: // interpreter result is set to empty. Do the same for other
0396: // common values.
0397:
0398: m_nullResult = TclString.newInstance("");
0399: m_nullResult.preserve(); // Increment refCount to 1
0400: m_nullResult.preserve(); // Increment refCount to 2 (shared)
0401: m_result = m_nullResult; // correcponds to iPtr->objResultPtr
0402:
0403: m_minusoneIntegerResult = TclInteger.newInstance(-1);
0404: m_minusoneIntegerResult.preserve(); // Increment refCount to 1
0405: m_minusoneIntegerResult.preserve(); // Increment refCount to 2 (shared)
0406:
0407: m_zeroIntegerResult = TclInteger.newInstance(0);
0408: m_zeroIntegerResult.preserve(); // Increment refCount to 1
0409: m_zeroIntegerResult.preserve(); // Increment refCount to 2 (shared)
0410:
0411: m_oneIntegerResult = TclInteger.newInstance(1);
0412: m_oneIntegerResult.preserve(); // Increment refCount to 1
0413: m_oneIntegerResult.preserve(); // Increment refCount to 2 (shared)
0414:
0415: m_falseBooleanResult = m_zeroIntegerResult;
0416: m_trueBooleanResult = m_oneIntegerResult;
0417:
0418: m_twoIntegerResult = TclInteger.newInstance(2);
0419: m_twoIntegerResult.preserve(); // Increment refCount to 1
0420: m_twoIntegerResult.preserve(); // Increment refCount to 2 (shared)
0421:
0422: m_zeroDoubleResult = TclDouble.newInstance(0.0);
0423: m_zeroDoubleResult.preserve(); // Increment refCount to 1
0424: m_zeroDoubleResult.preserve(); // Increment refCount to 2 (shared)
0425:
0426: m_onehalfDoubleResult = TclDouble.newInstance(0.5);
0427: m_onehalfDoubleResult.preserve(); // Increment refCount to 1
0428: m_onehalfDoubleResult.preserve(); // Increment refCount to 2 (shared)
0429:
0430: m_oneDoubleResult = TclDouble.newInstance(1.0);
0431: m_oneDoubleResult.preserve(); // Increment refCount to 1
0432: m_oneDoubleResult.preserve(); // Increment refCount to 2 (shared)
0433:
0434: m_twoDoubleResult = TclDouble.newInstance(2.0);
0435: m_twoDoubleResult.preserve(); // Increment refCount to 1
0436: m_twoDoubleResult.preserve(); // Increment refCount to 2 (shared)
0437:
0438: // Create common char values wrapped in a TclObject
0439:
0440: m_charCommon = new TclObject[m_charCommonMax];
0441: for (int i = 0; i < m_charCommonMax; i++) {
0442: TclObject obj = null;
0443: if (((i < ((int) ' ')) && (i == ((int) '\t')
0444: || i == ((int) '\r') || i == ((int) '\n')))
0445: || (i >= ((int) ' ')) && (i <= ((int) '~'))) {
0446:
0447: // Create cached value for '\t' '\r' '\n'
0448: // and all ASCII characters in the range
0449: // 32 -> ' ' to 126 -> '~'. Intern each
0450: // of the String objects so that an equals test
0451: // like tobj.toString().equals("\n") will
0452: // refrence compare to true.
0453:
0454: String s = "" + ((char) i);
0455: s = s.intern();
0456: obj = TclString.newInstance(s);
0457:
0458: //System.out.println("m_charCommon[" + i + "] is \"" + obj + "\"");
0459: }
0460:
0461: m_charCommon[i] = obj;
0462:
0463: if (obj != null) {
0464: obj.preserve();
0465: obj.preserve();
0466: }
0467: }
0468:
0469: // Init recycled TclObject values.
0470:
0471: recycledI = TclInteger.newInstance(0);
0472: recycledI.preserve(); // refCount is 1 when unused
0473:
0474: recycledD = TclDouble.newInstance(0);
0475: recycledD.preserve(); // refCount is 1 when unused
0476:
0477: expr = new Expression();
0478: nestLevel = 0;
0479:
0480: frame = null;
0481: varFrame = null;
0482:
0483: returnCode = TCL.OK;
0484: errorInfo = null;
0485: errorCode = null;
0486:
0487: packageTable = new HashMap();
0488: packageUnknown = null;
0489: cmdCount = 0;
0490: termOffset = 0;
0491: resolvers = null;
0492: evalFlags = 0;
0493: scriptFile = null;
0494: flags = 0;
0495: isSafe = false;
0496: assocData = null;
0497:
0498: globalNs = null; // force creation of global ns below
0499: globalNs = Namespace.createNamespace(this , null, null);
0500: if (globalNs == null) {
0501: throw new TclRuntimeError(
0502: "Interp(): can't create global namespace");
0503: }
0504:
0505: // Init things that are specific to the Jacl implementation
0506:
0507: workingDir = new File(Util
0508: .tryGetSystemProperty("user.dir", "."));
0509: noEval = 0;
0510:
0511: cThread = Thread.currentThread();
0512: cThreadName = cThread.getName();
0513: notifier = Notifier.getNotifierForThread(cThread);
0514: notifier.preserve();
0515:
0516: randSeedInit = false;
0517:
0518: deleted = false;
0519: errInProgress = false;
0520: errAlreadyLogged = false;
0521: errCodeSet = false;
0522:
0523: dbg = initDebugInfo();
0524:
0525: slaveTable = new HashMap();
0526: targetTable = new HashMap();
0527: aliasTable = new HashMap();
0528:
0529: // init parser variables
0530: Parser.init(this );
0531: TclParse.init(this );
0532:
0533: // Initialize the Global (static) channel table and the local
0534: // interp channel table.
0535:
0536: interpChanTable = TclIO.getInterpChanTable(this );
0537:
0538: // Sets up the variable trace for tcl_precision.
0539:
0540: Util.setupPrecisionTrace(this );
0541:
0542: // Create the built-in commands.
0543:
0544: createCommands();
0545:
0546: try {
0547: // Set up tcl_platform, tcl_version, tcl_library and other
0548: // global variables.
0549:
0550: setVar("tcl_platform", "platform", "java", TCL.GLOBAL_ONLY);
0551: setVar("tcl_platform", "byteOrder", "bigEndian",
0552: TCL.GLOBAL_ONLY);
0553:
0554: setVar("tcl_platform", "os", Util.tryGetSystemProperty(
0555: "os.name", "?"), TCL.GLOBAL_ONLY);
0556: setVar("tcl_platform", "osVersion", Util
0557: .tryGetSystemProperty("os.version", "?"),
0558: TCL.GLOBAL_ONLY);
0559: setVar("tcl_platform", "machine", Util
0560: .tryGetSystemProperty("os.arch", "?"),
0561: TCL.GLOBAL_ONLY);
0562:
0563: setVar("tcl_version", TCL_VERSION, TCL.GLOBAL_ONLY);
0564: setVar("tcl_patchLevel", TCL_PATCH_LEVEL, TCL.GLOBAL_ONLY);
0565: setVar("tcl_library", "resource:/tcl/lang/library",
0566: TCL.GLOBAL_ONLY);
0567: if (Util.isWindows()) {
0568: setVar("tcl_platform", "host_platform", "windows",
0569: TCL.GLOBAL_ONLY);
0570: } else if (Util.isMac()) {
0571: setVar("tcl_platform", "host_platform", "macintosh",
0572: TCL.GLOBAL_ONLY);
0573: } else {
0574: setVar("tcl_platform", "host_platform", "unix",
0575: TCL.GLOBAL_ONLY);
0576: }
0577:
0578: // Create the env array an populated it with proper
0579: // values.
0580:
0581: Env.initialize(this );
0582:
0583: // Register Tcl's version number. Note: This MUST be
0584: // done before the call to evalResource, otherwise
0585: // calls to "package require tcl" will fail.
0586:
0587: pkgProvide("Tcl", TCL_VERSION);
0588:
0589: // Source the init.tcl script to initialize auto-loading.
0590:
0591: evalResource("/tcl/lang/library/init.tcl");
0592:
0593: } catch (TclException e) {
0594: System.out.println(getResult());
0595: e.printStackTrace();
0596: throw new TclRuntimeError("unexpected TclException: " + e);
0597: }
0598:
0599: // Debug print interp info, this is handy when tracking
0600: // down where an Interp that was not disposed of properly
0601: // was allocated.
0602:
0603: if (false) {
0604: try {
0605: throw new Exception();
0606: } catch (Exception e) {
0607: System.err.println("Interp() : " + this );
0608: e.printStackTrace(System.err);
0609: }
0610: }
0611: }
0612:
0613: /*
0614: *----------------------------------------------------------------------
0615: *
0616: * Tcl_DeleteInterp -> dispose
0617: *
0618: * Invoked to indicate that the interp should be disposed of.
0619: * If there are no Tcl_Preserve calls in effect for this
0620: * interpreter, it is deleted immediately, otherwise the
0621: * interpreter is deleted when the last Tcl_Preserve is
0622: * matched by a call to Tcl_Release.
0623: *
0624: * Results:
0625: * None.
0626: *
0627: * Side effects:
0628: * Cleans up the interpreter.
0629: *
0630: *----------------------------------------------------------------------
0631: */
0632:
0633: public void dispose() {
0634: final boolean debug = false;
0635:
0636: if (debug) {
0637: System.out.println("Invoked Interp.dispose() for " + this );
0638: }
0639:
0640: // Interp.dispose() must be invoked from thread that invoked Interp()
0641:
0642: if (Thread.currentThread() != cThread) {
0643: throw new TclRuntimeError(
0644: "Interp.dispose() invoked in thread other than the one it was created in");
0645: }
0646:
0647: // Mark the interpreter as deleted. No further evals will be allowed.
0648: // Note that EventuallyFreed.dispose() is invoked below even if
0649: // this interpreter has already been marked as deleted since
0650: // this method can be invoked via EventuallyFreed.release().
0651:
0652: if (!deleted) {
0653: deleted = true;
0654: }
0655:
0656: super .dispose();
0657: }
0658:
0659: /*
0660: *----------------------------------------------------------------------
0661: *
0662: * DeleteInterpProc -> eventuallyDispose
0663: *
0664: * This method cleans up the state of the interpreter so that
0665: * it can be garbage collected safely. This routine needs to
0666: * break any circular references that might keep the interpreter
0667: * alive indefinitely.
0668: *
0669: * This proc should never be called directly. Instead it is called
0670: * via the EventuallyFreed superclass. This method will only
0671: * ever be invoked once.
0672: *
0673: * Results:
0674: * None.
0675: *
0676: * Side effects:
0677: * Cleans up the interpreter.
0678: *
0679: *----------------------------------------------------------------------
0680: */
0681:
0682: public void eventuallyDispose() {
0683: final boolean debug = false;
0684:
0685: if (debug) {
0686: System.out
0687: .println("Invoked Interp.eventuallyDispose() for "
0688: + this );
0689: }
0690:
0691: // The interpreter should already be marked deleted; otherwise how did we
0692: // get here?
0693:
0694: if (!deleted) {
0695: throw new TclRuntimeError(
0696: "eventuallyDispose called on interpreter not marked deleted");
0697: }
0698:
0699: if (nestLevel > 0) {
0700: throw new TclRuntimeError(
0701: "dispose() called with active evals");
0702: }
0703:
0704: // Remove our association with the notifer (if we had one).
0705:
0706: if (notifier != null) {
0707: notifier.release();
0708: notifier = null;
0709:
0710: if (debug) {
0711: System.out.println("notifier set to null for " + this );
0712: }
0713: } else {
0714: throw new TclRuntimeError(
0715: "eventuallyDispose() already invoked for " + this );
0716: }
0717:
0718: // Dismantle everything in the global namespace except for the
0719: // "errorInfo" and "errorCode" variables. These might be needed
0720: // later on if errors occur while deleting commands. We are careful
0721: // to destroy and recreate the "errorInfo" and "errorCode"
0722: // variables, in case they had any traces on them.
0723: //
0724: // Dismantle the namespace here, before we clear the assocData. If any
0725: // background errors occur here, they will be deleted below.
0726:
0727: Namespace.teardownNamespace(globalNs);
0728:
0729: // Delete all variables.
0730:
0731: TclObject errorInfoObj = null, errorCodeObj = null;
0732:
0733: try {
0734: errorInfoObj = getVar("errorInfo", null, TCL.GLOBAL_ONLY);
0735: } catch (TclException e) {
0736: // Do nothing when var does not exist.
0737: }
0738:
0739: if (errorInfoObj != null) {
0740: errorInfoObj.preserve();
0741: }
0742:
0743: try {
0744: errorCodeObj = getVar("errorCode", null, TCL.GLOBAL_ONLY);
0745: } catch (TclException e) {
0746: // Do nothing when var does not exist.
0747: }
0748:
0749: if (errorCodeObj != null) {
0750: errorCodeObj.preserve();
0751: }
0752:
0753: frame = null;
0754: varFrame = null;
0755:
0756: try {
0757: if (errorInfoObj != null) {
0758: setVar("errorInfo", null, errorInfoObj, TCL.GLOBAL_ONLY);
0759: errorInfoObj.release();
0760: }
0761: if (errorCodeObj != null) {
0762: setVar("errorCode", null, errorCodeObj, TCL.GLOBAL_ONLY);
0763: errorCodeObj.release();
0764: }
0765: } catch (TclException e) {
0766: // Ignore it -- same behavior as Tcl 8.0.
0767: }
0768:
0769: // Tear down the math function table.
0770:
0771: expr = null;
0772:
0773: // Remove all the assoc data tied to this interp and invoke
0774: // deletion callbacks; note that a callback can create new
0775: // callbacks, so we iterate.
0776:
0777: while (assocData != null) {
0778: HashMap table = assocData;
0779: assocData = null;
0780:
0781: for (Iterator iter = table.entrySet().iterator(); iter
0782: .hasNext();) {
0783: Map.Entry entry = (Map.Entry) iter.next();
0784: AssocData data = (AssocData) entry.getValue();
0785: data.disposeAssocData(this );
0786: iter.remove();
0787: }
0788: }
0789:
0790: // Close any remaining channels
0791:
0792: for (Iterator iter = interpChanTable.entrySet().iterator(); iter
0793: .hasNext();) {
0794: Map.Entry entry = (Map.Entry) iter.next();
0795: Channel chan = (Channel) entry.getValue();
0796: try {
0797: chan.close();
0798: } catch (IOException ex) {
0799: // Ignore any IO errors
0800: }
0801: }
0802: interpChanTable.clear();
0803: interpChanTable = null;
0804:
0805: // Finish deleting the global namespace.
0806:
0807: Namespace.deleteNamespace(globalNs);
0808: globalNs = null;
0809:
0810: // Free up the result *after* deleting variables, since variable
0811: // deletion could have transferred ownership of the result string
0812: // to Tcl.
0813:
0814: frame = null;
0815: varFrame = null;
0816: resolvers = null;
0817:
0818: resetResult();
0819: }
0820:
0821: /*
0822: *----------------------------------------------------------------------
0823: *
0824: * finalize --
0825: *
0826: * Interpreter finalization method. We print a message to
0827: * stderr if the user neglected to dispose of an Interp
0828: * properly. The Interp should have been disposed of
0829: * in the thread that created it.
0830: *
0831: * Results:
0832: * Prints to stderr.
0833: *
0834: * Side effects:
0835: * None.
0836: *
0837: *----------------------------------------------------------------------
0838: */
0839:
0840: protected void finalize() throws Throwable {
0841: if (notifier != null) {
0842: System.err
0843: .println("finalized interp has not been disposed : "
0844: + this );
0845: }
0846: super .finalize();
0847: }
0848:
0849: /*
0850: *----------------------------------------------------------------------
0851: *
0852: * TclInterpReady -- ready
0853: *
0854: * Check if an interpreter is ready to eval commands or scripts, i.e., if
0855: * it was not deleted and if the nesting level is not too high.
0856: *
0857: * Results:
0858: * Raises a TclExcetpion is the interp is not ready.
0859: *
0860: * Side effects:
0861: * The interpreters result is cleared.
0862: *
0863: *----------------------------------------------------------------------
0864: */
0865:
0866: void ready() throws TclException {
0867: // Reset the interpreter's result and clear out
0868: // any previous error information.
0869:
0870: resetResult();
0871:
0872: // If the interpreter was deleted, return an error.
0873:
0874: if (deleted) {
0875: setResult("attempt to call eval in deleted interpreter");
0876: setErrorCode(TclString
0877: .newInstance("CORE IDELETE {attempt to call eval in deleted interpreter}"));
0878: throw new TclException(TCL.ERROR);
0879: }
0880:
0881: // Check depth of nested calls to eval: if this gets too large,
0882: // it's probably because of an infinite loop somewhere.
0883:
0884: if (nestLevel >= maxNestingDepth) {
0885: Parser.infiniteLoopException(this );
0886: }
0887: }
0888:
0889: /*
0890: *----------------------------------------------------------------------
0891: *
0892: * createCommands --
0893: *
0894: * Create the build-in commands. These commands are loaded on
0895: * demand -- the class file of a Command class are loaded into
0896: * the JVM the first time the given command is executed.
0897: *
0898: * Results:
0899: * None.
0900: *
0901: * Side effects:
0902: * Commands are registered.
0903: *
0904: *----------------------------------------------------------------------
0905: */
0906:
0907: protected void createCommands() {
0908: Extension.loadOnDemand(this , "after", "tcl.lang.AfterCmd");
0909: Extension.loadOnDemand(this , "append", "tcl.lang.AppendCmd");
0910: Extension.loadOnDemand(this , "array", "tcl.lang.ArrayCmd");
0911: Extension.loadOnDemand(this , "binary", "tcl.lang.BinaryCmd");
0912: Extension.loadOnDemand(this , "break", "tcl.lang.BreakCmd");
0913: Extension.loadOnDemand(this , "case", "tcl.lang.CaseCmd");
0914: Extension.loadOnDemand(this , "catch", "tcl.lang.CatchCmd");
0915: Extension.loadOnDemand(this , "cd", "tcl.lang.CdCmd");
0916: Extension.loadOnDemand(this , "clock", "tcl.lang.ClockCmd");
0917: Extension.loadOnDemand(this , "close", "tcl.lang.CloseCmd");
0918: Extension
0919: .loadOnDemand(this , "continue", "tcl.lang.ContinueCmd");
0920: Extension.loadOnDemand(this , "concat", "tcl.lang.ConcatCmd");
0921: Extension
0922: .loadOnDemand(this , "encoding", "tcl.lang.EncodingCmd");
0923: Extension.loadOnDemand(this , "eof", "tcl.lang.EofCmd");
0924: Extension.loadOnDemand(this , "eval", "tcl.lang.EvalCmd");
0925: Extension.loadOnDemand(this , "error", "tcl.lang.ErrorCmd");
0926: if (!Util.isMac()) {
0927: Extension.loadOnDemand(this , "exec", "tcl.lang.ExecCmd");
0928: }
0929: Extension.loadOnDemand(this , "exit", "tcl.lang.ExitCmd");
0930: Extension.loadOnDemand(this , "expr", "tcl.lang.ExprCmd");
0931: Extension
0932: .loadOnDemand(this , "fblocked", "tcl.lang.FblockedCmd");
0933: Extension.loadOnDemand(this , "fconfigure",
0934: "tcl.lang.FconfigureCmd");
0935: Extension.loadOnDemand(this , "file", "tcl.lang.FileCmd");
0936: Extension.loadOnDemand(this , "flush", "tcl.lang.FlushCmd");
0937: Extension.loadOnDemand(this , "for", "tcl.lang.ForCmd");
0938: Extension.loadOnDemand(this , "foreach", "tcl.lang.ForeachCmd");
0939: Extension.loadOnDemand(this , "format", "tcl.lang.FormatCmd");
0940: Extension.loadOnDemand(this , "gets", "tcl.lang.GetsCmd");
0941: Extension.loadOnDemand(this , "global", "tcl.lang.GlobalCmd");
0942: Extension.loadOnDemand(this , "glob", "tcl.lang.GlobCmd");
0943: Extension.loadOnDemand(this , "if", "tcl.lang.IfCmd");
0944: Extension.loadOnDemand(this , "incr", "tcl.lang.IncrCmd");
0945: Extension.loadOnDemand(this , "info", "tcl.lang.InfoCmd");
0946: Extension.loadOnDemand(this , "interp", "tcl.lang.InterpCmd");
0947: Extension.loadOnDemand(this , "list", "tcl.lang.ListCmd");
0948: Extension.loadOnDemand(this , "join", "tcl.lang.JoinCmd");
0949: Extension.loadOnDemand(this , "lappend", "tcl.lang.LappendCmd");
0950: Extension.loadOnDemand(this , "lindex", "tcl.lang.LindexCmd");
0951: Extension.loadOnDemand(this , "linsert", "tcl.lang.LinsertCmd");
0952: Extension.loadOnDemand(this , "llength", "tcl.lang.LlengthCmd");
0953: Extension.loadOnDemand(this , "lrange", "tcl.lang.LrangeCmd");
0954: Extension
0955: .loadOnDemand(this , "lreplace", "tcl.lang.LreplaceCmd");
0956: Extension.loadOnDemand(this , "lsearch", "tcl.lang.LsearchCmd");
0957: Extension.loadOnDemand(this , "lsort", "tcl.lang.LsortCmd");
0958: Extension.loadOnDemand(this , "namespace",
0959: "tcl.lang.NamespaceCmd");
0960: Extension.loadOnDemand(this , "open", "tcl.lang.OpenCmd");
0961: Extension.loadOnDemand(this , "package", "tcl.lang.PackageCmd");
0962: Extension.loadOnDemand(this , "proc", "tcl.lang.ProcCmd");
0963: Extension.loadOnDemand(this , "puts", "tcl.lang.PutsCmd");
0964: Extension.loadOnDemand(this , "pwd", "tcl.lang.PwdCmd");
0965: Extension.loadOnDemand(this , "read", "tcl.lang.ReadCmd");
0966: Extension.loadOnDemand(this , "regsub", "tcl.lang.RegsubCmd");
0967: Extension.loadOnDemand(this , "rename", "tcl.lang.RenameCmd");
0968: Extension.loadOnDemand(this , "return", "tcl.lang.ReturnCmd");
0969: Extension.loadOnDemand(this , "scan", "tcl.lang.ScanCmd");
0970: Extension.loadOnDemand(this , "seek", "tcl.lang.SeekCmd");
0971: Extension.loadOnDemand(this , "set", "tcl.lang.SetCmd");
0972: Extension.loadOnDemand(this , "socket", "tcl.lang.SocketCmd");
0973: Extension.loadOnDemand(this , "source", "tcl.lang.SourceCmd");
0974: Extension.loadOnDemand(this , "split", "tcl.lang.SplitCmd");
0975: Extension.loadOnDemand(this , "string", "tcl.lang.StringCmd");
0976: Extension.loadOnDemand(this , "subst", "tcl.lang.SubstCmd");
0977: Extension.loadOnDemand(this , "switch", "tcl.lang.SwitchCmd");
0978: Extension.loadOnDemand(this , "tell", "tcl.lang.TellCmd");
0979: Extension.loadOnDemand(this , "time", "tcl.lang.TimeCmd");
0980: Extension.loadOnDemand(this , "trace", "tcl.lang.TraceCmd");
0981: Extension.loadOnDemand(this , "unset", "tcl.lang.UnsetCmd");
0982: Extension.loadOnDemand(this , "update", "tcl.lang.UpdateCmd");
0983: Extension.loadOnDemand(this , "uplevel", "tcl.lang.UplevelCmd");
0984: Extension.loadOnDemand(this , "upvar", "tcl.lang.UpvarCmd");
0985: Extension
0986: .loadOnDemand(this , "variable", "tcl.lang.VariableCmd");
0987: Extension.loadOnDemand(this , "vwait", "tcl.lang.VwaitCmd");
0988: Extension.loadOnDemand(this , "while", "tcl.lang.WhileCmd");
0989:
0990: // Add "regexp" and related commands to this interp.
0991: RegexpCmd.init(this );
0992:
0993: // Load tcltest package as a result of "package require tcltest"
0994:
0995: try {
0996: eval("package ifneeded tcltest 1.0 {source "
0997: + "resource:/tcl/lang/library/tcltest/tcltest.tcl}");
0998: } catch (TclException e) {
0999: System.out.println(getResult());
1000: e.printStackTrace();
1001: throw new TclRuntimeError("unexpected TclException: " + e);
1002: }
1003:
1004: // The Java package is only loaded when the user does a
1005: // "package require java" in the interp. We need to create a small
1006: // command that will load when "package require java" is called.
1007:
1008: Extension.loadOnDemand(this , "jaclloadjava",
1009: "tcl.lang.JaclLoadJavaCmd");
1010:
1011: try {
1012: eval("package ifneeded java 1.4.1 jaclloadjava");
1013: } catch (TclException e) {
1014: System.out.println(getResult());
1015: e.printStackTrace();
1016: throw new TclRuntimeError("unexpected TclException: " + e);
1017: }
1018:
1019: // Load the Itcl package as a result of the user running "package require Itcl".
1020:
1021: Extension.loadOnDemand(this , "jaclloaditcl",
1022: "itcl.lang.ItclExtension");
1023:
1024: try {
1025: eval("package ifneeded Itcl 3.3 {jaclloaditcl ; package provide Itcl 3.3}");
1026: } catch (TclException e) {
1027: System.out.println(getResult());
1028: e.printStackTrace();
1029: throw new TclRuntimeError("unexpected TclException: " + e);
1030: }
1031:
1032: // Load the parser package as a result of the user
1033: // running "package require parser".
1034:
1035: Extension.loadOnDemand(this , "jaclloadparser",
1036: "tcl.lang.TclParserExtension");
1037:
1038: try {
1039: eval("package ifneeded parser 1.4 {jaclloadparser}");
1040: } catch (TclException e) {
1041: System.out.println(getResult());
1042: e.printStackTrace();
1043: throw new TclRuntimeError("unexpected TclException: " + e);
1044: }
1045:
1046: // Load the TJC package as a result of the user running "package require tjc"
1047: Extension.loadOnDemand(this , "jaclloadtjc",
1048: "tcl.lang.JaclLoadTJCCmd");
1049:
1050: try {
1051: eval("package ifneeded TJC 1.0 {jaclloadtjc ; package provide TJC 1.0}");
1052: } catch (TclException e) {
1053: System.out.println(getResult());
1054: e.printStackTrace();
1055: throw new TclRuntimeError("unexpected TclException: " + e);
1056: }
1057:
1058: }
1059:
1060: /*
1061: *----------------------------------------------------------------------
1062: *
1063: * setAssocData --
1064: *
1065: * Creates a named association between user-specified data and
1066: * this interpreter. If the association already exists the data
1067: * is overwritten with the new data. The data.deleteAssocData()
1068: * method will be invoked when the interpreter is deleted.
1069: *
1070: * NOTE: deleteAssocData() is not called when an old data is
1071: * replaced by a new data. Caller of setAssocData() is
1072: * responsible with deleting the old data.
1073: *
1074: * Results:
1075: * None.
1076: *
1077: * Side effects:
1078: * Sets the associated data, creates the association if needed.
1079: *
1080: *----------------------------------------------------------------------
1081: */
1082:
1083: public void setAssocData(String name, // Name for association.
1084: AssocData data) // Object associated with the name.
1085: {
1086: if (assocData == null) {
1087: assocData = new HashMap();
1088: }
1089: assocData.put(name, data);
1090: }
1091:
1092: /*
1093: *----------------------------------------------------------------------
1094: *
1095: * deleteAssocData --
1096: *
1097: * Deletes a named association of user-specified data with
1098: * the specified interpreter.
1099: *
1100: * Results:
1101: * None.
1102: *
1103: * Side effects:
1104: * Deletes the association.
1105: *
1106: *----------------------------------------------------------------------
1107: */
1108:
1109: public void deleteAssocData(String name) // Name of association.
1110: {
1111: if (assocData == null) {
1112: return;
1113: }
1114:
1115: assocData.remove(name);
1116: }
1117:
1118: /*
1119: *----------------------------------------------------------------------
1120: *
1121: * getAssocData --
1122: *
1123: * Returns the AssocData instance associated with this name in
1124: * the specified interpreter.
1125: *
1126: * Results:
1127: * The AssocData instance in the AssocData record denoted by the
1128: * named association, or null.
1129: *
1130: * Side effects:
1131: * None.
1132: *
1133: *----------------------------------------------------------------------
1134: */
1135:
1136: public AssocData getAssocData(String name) // Name of association.
1137: {
1138: if (assocData == null) {
1139: return null;
1140: } else {
1141: return (AssocData) assocData.get(name);
1142: }
1143: }
1144:
1145: /*
1146: *----------------------------------------------------------------------
1147: *
1148: * backgroundError --
1149: *
1150: * This procedure is invoked to handle errors that occur in Tcl
1151: * commands that are invoked in "background" (e.g. from event or
1152: * timer bindings).
1153: *
1154: * Results:
1155: * None.
1156: *
1157: * Side effects:
1158: * The command "bgerror" is invoked later as an idle handler to
1159: * process the error, passing it the error message. If that fails,
1160: * then an error message is output on stderr.
1161: *
1162: *----------------------------------------------------------------------
1163: */
1164:
1165: public void backgroundError() {
1166: BgErrorMgr mgr = (BgErrorMgr) getAssocData("tclBgError");
1167: if (mgr == null) {
1168: mgr = new BgErrorMgr(this );
1169: setAssocData("tclBgError", mgr);
1170: }
1171: mgr.addBgError();
1172: }
1173:
1174: /*-----------------------------------------------------------------
1175: *
1176: * VARIABLES
1177: *
1178: *-----------------------------------------------------------------
1179: */
1180:
1181: /*
1182: *----------------------------------------------------------------------
1183: *
1184: * setVar --
1185: *
1186: * Sets a variable whose name and value are stored in TclObject.
1187: *
1188: * Results:
1189: * The TclObject, as it was set is returned.
1190: *
1191: * Side effects:
1192: * None.
1193: *
1194: *----------------------------------------------------------------------
1195: */
1196:
1197: final TclObject setVar(TclObject nameObj, // Name of variable, array, or array element
1198: // to set.
1199: TclObject value, // New value for variable.
1200: int flags) // Various flags that tell how to set value:
1201: // any of TCL.GLOBAL_ONLY, TCL.NAMESPACE_ONLY,
1202: // TCL.APPEND_VALUE, or TCL.LIST_ELEMENT.
1203: throws TclException {
1204: return Var.setVar(this , nameObj.toString(), null, value,
1205: (flags | TCL.LEAVE_ERR_MSG));
1206: }
1207:
1208: /*
1209: *----------------------------------------------------------------------
1210: *
1211: * setVar --
1212: *
1213: * Set the value of a variable.
1214: *
1215: * Results:
1216: * Returns the new value of the variable.
1217: *
1218: * Side effects:
1219: * May trigger traces.
1220: *
1221: *----------------------------------------------------------------------
1222: */
1223:
1224: public final TclObject setVar(String name, // Name of variable, array, or array element
1225: // to set.
1226: TclObject value, // New value for variable.
1227: int flags) // Various flags that tell how to set value:
1228: // any of TCL.GLOBAL_ONLY, TCL.NAMESPACE_ONLY,
1229: // TCL.APPEND_VALUE, or TCL.LIST_ELEMENT.
1230: throws TclException {
1231: return Var.setVar(this , name, null, value,
1232: (flags | TCL.LEAVE_ERR_MSG));
1233: }
1234:
1235: /*
1236: *----------------------------------------------------------------------
1237: *
1238: * setVar --
1239: *
1240: * Set the value of a variable.
1241: *
1242: * Results:
1243: * Returns the new value of the variable.
1244: *
1245: * Side effects:
1246: * May trigger traces.
1247: *
1248: *----------------------------------------------------------------------
1249: */
1250:
1251: public final TclObject setVar(String name1, // If name2 is null, this is name of a scalar
1252: // variable. Otherwise it is the name of an
1253: // array.
1254: String name2, // Name of an element within an array, or
1255: // null.
1256: TclObject value, // New value for variable.
1257: int flags) // Various flags that tell how to set value:
1258: // any of TCL.GLOBAL_ONLY, TCL.NAMESPACE_ONLY,
1259: // TCL.APPEND_VALUE or TCL.LIST_ELEMENT.
1260: throws TclException {
1261: return Var.setVar(this , name1, name2, value,
1262: (flags | TCL.LEAVE_ERR_MSG));
1263: }
1264:
1265: /*
1266: *----------------------------------------------------------------------
1267: *
1268: * setVar --
1269: *
1270: * Set the value of a variable.
1271: *
1272: * Results:
1273: * Returns the new value of the variable.
1274: *
1275: * Side effects:
1276: * May trigger traces.
1277: *
1278: *----------------------------------------------------------------------
1279: */
1280:
1281: final TclObject setVar(String name, // Name of variable, array, or array element
1282: // to set.
1283: String strValue, // New value for variable.
1284: int flags) // Various flags that tell how to set value:
1285: // any of TCL.GLOBAL_ONLY, TCL.NAMESPACE_ONLY,
1286: // TCL.APPEND_VALUE, or TCL.LIST_ELEMENT.
1287: throws TclException {
1288: return Var.setVar(this , name, null,
1289: checkCommonString(strValue),
1290: (flags | TCL.LEAVE_ERR_MSG));
1291: }
1292:
1293: /*
1294: *----------------------------------------------------------------------
1295: *
1296: * setVar --
1297: *
1298: * Set a variable to the value in a String argument.
1299: *
1300: * Results:
1301: * Returns the new value of the variable.
1302: *
1303: * Side effects:
1304: * May trigger traces.
1305: *
1306: *----------------------------------------------------------------------
1307: */
1308:
1309: public final TclObject setVar(String name1, // If name2 is null, this is name of a scalar
1310: // variable. Otherwise it is the name of an
1311: // array.
1312: String name2, // Name of an element within an array, or
1313: // null.
1314: String strValue, // New value for variable.
1315: int flags) // Various flags that tell how to set value:
1316: // any of TCL.GLOBAL_ONLY, TCL.NAMESPACE_ONLY,
1317: // TCL.APPEND_VALUE, or TCL.LIST_ELEMENT.
1318: throws TclException {
1319: return Var.setVar(this , name1, name2,
1320: checkCommonString(strValue),
1321: (flags | TCL.LEAVE_ERR_MSG));
1322: }
1323:
1324: /*
1325: *----------------------------------------------------------------------
1326: *
1327: * setVar --
1328: *
1329: * Set a variable to the value in an int argument.
1330: *
1331: * Results:
1332: * Returns the new value of the variable.
1333: *
1334: * Side effects:
1335: * May trigger traces.
1336: *
1337: *----------------------------------------------------------------------
1338: */
1339:
1340: public final TclObject setVar(String name1, // If name2 is null, this is name of a scalar
1341: // variable. Otherwise it is the name of an
1342: // array.
1343: String name2, // Name of an element within an array, or
1344: // null.
1345: int intValue, // New value for variable.
1346: int flags) // Various flags that tell how to set value:
1347: // any of TCL.GLOBAL_ONLY, TCL.NAMESPACE_ONLY,
1348: // TCL.APPEND_VALUE, or TCL.LIST_ELEMENT.
1349: throws TclException {
1350: return Var.setVar(this , name1, name2,
1351: checkCommonInteger(intValue),
1352: (flags | TCL.LEAVE_ERR_MSG));
1353: }
1354:
1355: /*
1356: *----------------------------------------------------------------------
1357: *
1358: * setVar --
1359: *
1360: * Set a variable to the value in a double argument.
1361: *
1362: * Results:
1363: * Returns the new value of the variable.
1364: *
1365: * Side effects:
1366: * May trigger traces.
1367: *
1368: *----------------------------------------------------------------------
1369: */
1370:
1371: public final TclObject setVar(String name1, // If name2 is null, this is name of a scalar
1372: // variable. Otherwise it is the name of an
1373: // array.
1374: String name2, // Name of an element within an array, or
1375: // null.
1376: double dValue, // New value for variable.
1377: int flags) // Various flags that tell how to set value:
1378: // any of TCL.GLOBAL_ONLY, TCL.NAMESPACE_ONLY,
1379: // TCL.APPEND_VALUE, or TCL.LIST_ELEMENT.
1380: throws TclException {
1381: return Var.setVar(this , name1, name2,
1382: checkCommonDouble(dValue), (flags | TCL.LEAVE_ERR_MSG));
1383: }
1384:
1385: /*
1386: *----------------------------------------------------------------------
1387: *
1388: * setVar --
1389: *
1390: * Set a variable to the value in a boolean argument.
1391: *
1392: * Results:
1393: * Returns the new value of the variable.
1394: *
1395: * Side effects:
1396: * May trigger traces.
1397: *
1398: *----------------------------------------------------------------------
1399: */
1400:
1401: public final TclObject setVar(String name1, // If name2 is null, this is name of a scalar
1402: // variable. Otherwise it is the name of an
1403: // array.
1404: String name2, // Name of an element within an array, or
1405: // null.
1406: boolean bValue, // New value for variable.
1407: int flags) // Various flags that tell how to set value:
1408: // any of TCL.GLOBAL_ONLY, TCL.NAMESPACE_ONLY,
1409: // TCL.APPEND_VALUE, or TCL.LIST_ELEMENT.
1410: throws TclException {
1411: return Var
1412: .setVar(this , name1, name2, checkCommonBoolean(bValue),
1413: (flags | TCL.LEAVE_ERR_MSG));
1414: }
1415:
1416: /*
1417: *----------------------------------------------------------------------
1418: *
1419: * getVar --
1420: *
1421: * Get the value of a variable.
1422: *
1423: * Results:
1424: * Returns the value of the variable. If the variable is not defined
1425: * a TclException will be raised.
1426: *
1427: * Side effects:
1428: * May trigger traces.
1429: *
1430: *----------------------------------------------------------------------
1431: */
1432:
1433: final TclObject getVar(TclObject nameObj, // The name of a variable, array, or array
1434: // element.
1435: int flags) // Various flags that tell how to get value:
1436: // any of TCL.GLOBAL_ONLY or TCL.NAMESPACE_ONLY.
1437: throws TclException {
1438: return Var.getVar(this , nameObj.toString(), null,
1439: (flags | TCL.LEAVE_ERR_MSG));
1440: }
1441:
1442: /*
1443: *----------------------------------------------------------------------
1444: *
1445: * getVar --
1446: *
1447: * Get the value of a variable.
1448: *
1449: * Results:
1450: * Returns the value of the variable. If the variable is not defined
1451: * a TclException will be raised.
1452: *
1453: * Side effects:
1454: * May trigger traces.
1455: *
1456: *----------------------------------------------------------------------
1457: */
1458:
1459: public final TclObject getVar(String name, // The name of a variable, array, or array
1460: // element.
1461: int flags) // Various flags that tell how to get value:
1462: // any of TCL.GLOBAL_ONLY or TCL.NAMESPACE_ONLY.
1463: throws TclException {
1464: return Var
1465: .getVar(this , name, null, (flags | TCL.LEAVE_ERR_MSG));
1466: }
1467:
1468: /*
1469: *----------------------------------------------------------------------
1470: *
1471: * getVar --
1472: *
1473: * Get the value of a variable.
1474: *
1475: * Results:
1476: * Returns the value of the variable. If the variable is not defined
1477: * a TclException will be raised.
1478: *
1479: * Side effects:
1480: * May trigger traces.
1481: *
1482: *----------------------------------------------------------------------
1483: */
1484:
1485: public final TclObject getVar(String name1, // If name2 is null, this is name of a scalar
1486: // variable. Otherwise it is the name of an
1487: // array.
1488: String name2, // Name of an element within an array, or
1489: // null.
1490: int flags) // Flags that tell how to get value:
1491: // TCL.GLOBAL_ONLY or TCL.NAMESPACE_ONLY.
1492: throws TclException {
1493: return Var.getVar(this , name1, name2,
1494: (flags | TCL.LEAVE_ERR_MSG));
1495: }
1496:
1497: /*
1498: *----------------------------------------------------------------------
1499: *
1500: * unsetVar --
1501: *
1502: * Unset a variable.
1503: *
1504: * Results:
1505: * None.
1506: *
1507: * Side effects:
1508: * May trigger traces.
1509: *
1510: *----------------------------------------------------------------------
1511: */
1512:
1513: final void unsetVar(TclObject nameObj, // The name of a variable, array, or array
1514: // element.
1515: int flags) // Various flags that tell how to get value:
1516: // any of TCL.GLOBAL_ONLY or TCL.NAMESPACE_ONLY.
1517: throws TclException {
1518: Var.unsetVar(this , nameObj.toString(), null,
1519: (flags | TCL.LEAVE_ERR_MSG));
1520: }
1521:
1522: /*
1523: *----------------------------------------------------------------------
1524: *
1525: * unsetVar --
1526: *
1527: * Unset a variable.
1528: *
1529: * Results:
1530: * None.
1531: *
1532: * Side effects:
1533: * May trigger traces.
1534: *
1535: *----------------------------------------------------------------------
1536: */
1537:
1538: public final void unsetVar(String name, // The name of a variable, array, or array
1539: // element.
1540: int flags) // Various flags that tell how to get value:
1541: // any of TCL.GLOBAL_ONLY or TCL.NAMESPACE_ONLY.
1542: throws TclException {
1543: Var.unsetVar(this , name, null, (flags | TCL.LEAVE_ERR_MSG));
1544: }
1545:
1546: /*
1547: *----------------------------------------------------------------------
1548: *
1549: * unsetVar --
1550: *
1551: * Unset a variable.
1552: *
1553: * Results:
1554: * None.
1555: *
1556: * Side effects:
1557: * May trigger traces.
1558: *
1559: *----------------------------------------------------------------------
1560: */
1561:
1562: public final void unsetVar(String name1, // If name2 is null, this is name of a scalar
1563: // variable. Otherwise it is the name of an
1564: // array.
1565: String name2, // Name of an element within an array, or
1566: // null.
1567: int flags) // Flags that tell how to get value:
1568: // TCL.GLOBAL_ONLY or TCL.NAMESPACE_ONLY.
1569: throws TclException {
1570: Var.unsetVar(this , name1, name2, (flags | TCL.LEAVE_ERR_MSG));
1571: }
1572:
1573: /*
1574: *----------------------------------------------------------------------
1575: *
1576: * traceVar --
1577: *
1578: * Add a trace to a variable.
1579: *
1580: * Results:
1581: * None.
1582: *
1583: * Side effects:
1584: * None.
1585: *
1586: *----------------------------------------------------------------------
1587: */
1588:
1589: void traceVar(TclObject nameObj, // Name of variable; may end with "(index)"
1590: // to signify an array reference.
1591: VarTrace trace, // Object to notify when specified ops are
1592: // invoked upon varName.
1593: int flags) // OR-ed collection of bits, including any
1594: // of TCL.TRACE_READS, TCL.TRACE_WRITES,
1595: // TCL.TRACE_UNSETS, TCL.GLOBAL_ONLY,
1596: // TCL.NAMESPACE_ONLY.
1597: throws TclException {
1598: Var.traceVar(this , nameObj.toString(), null, flags, trace);
1599: }
1600:
1601: /*
1602: *----------------------------------------------------------------------
1603: *
1604: * traceVar --
1605: *
1606: * Add a trace to a variable.
1607: *
1608: * Results:
1609: * None.
1610: *
1611: * Side effects:
1612: * None.
1613: *
1614: *----------------------------------------------------------------------
1615: */
1616:
1617: public void traceVar(String name, // Name of variable; may end with "(index)"
1618: // to signify an array reference.
1619: VarTrace trace, // Object to notify when specified ops are
1620: // invoked upon varName.
1621: int flags) // OR-ed collection of bits, including any
1622: // of TCL.TRACE_READS, TCL.TRACE_WRITES,
1623: // TCL.TRACE_UNSETS, TCL.GLOBAL_ONLY,
1624: // TCL.NAMESPACE_ONLY.
1625: throws TclException {
1626: Var.traceVar(this , name, null, flags, trace);
1627: }
1628:
1629: /*
1630: *----------------------------------------------------------------------
1631: *
1632: * traceVar --
1633: *
1634: * Add a trace to a variable.
1635: *
1636: * Results:
1637: * None.
1638: *
1639: * Side effects:
1640: * None.
1641: *
1642: *----------------------------------------------------------------------
1643: */
1644:
1645: public void traceVar(String part1, // Name of scalar variable or array.
1646: String part2, // Name of element within array; null means
1647: // trace applies to scalar variable or array
1648: // as-a-whole.
1649: VarTrace trace, // Object to notify when specified ops are
1650: // invoked upon varName.
1651: int flags) // OR-ed collection of bits, including any
1652: // of TCL.TRACE_READS, TCL.TRACE_WRITES,
1653: // TCL.TRACE_UNSETS, TCL.GLOBAL_ONLY, and
1654: // TCL.NAMESPACE_ONLY.
1655: throws TclException {
1656: Var.traceVar(this , part1, part2, flags, trace);
1657: }
1658:
1659: /*
1660: *----------------------------------------------------------------------
1661: *
1662: * untraceVar --
1663: *
1664: * Remove a trace from a variable.
1665: *
1666: * Results:
1667: * None.
1668: *
1669: * Side effects:
1670: * None.
1671: *
1672: *----------------------------------------------------------------------
1673: */
1674:
1675: void untraceVar(TclObject nameObj, // Name of variable; may end with "(index)"
1676: // to signify an array reference.
1677: VarTrace trace, // Object associated with trace.
1678: int flags) // OR-ed collection of bits describing current
1679: // trace, including any of TCL.TRACE_READS,
1680: // TCL.TRACE_WRITES, TCL.TRACE_UNSETS,
1681: // TCL.GLOBAL_ONLY and TCL.NAMESPACE_ONLY.
1682: {
1683: Var.untraceVar(this , nameObj.toString(), null, flags, trace);
1684: }
1685:
1686: /*
1687: *----------------------------------------------------------------------
1688: *
1689: * untraceVar --
1690: *
1691: * Remove a trace from a variable.
1692: *
1693: * Results:
1694: * None.
1695: *
1696: * Side effects:
1697: * None.
1698: *
1699: *----------------------------------------------------------------------
1700: */
1701:
1702: public void untraceVar(String name, // Name of variable; may end with "(index)"
1703: // to signify an array reference.
1704: VarTrace trace, // Object associated with trace.
1705: int flags) // OR-ed collection of bits describing current
1706: // trace, including any of TCL.TRACE_READS,
1707: // TCL.TRACE_WRITES, TCL.TRACE_UNSETS,
1708: // TCL.GLOBAL_ONLY and TCL.NAMESPACE_ONLY.
1709: {
1710: Var.untraceVar(this , name, null, flags, trace);
1711: }
1712:
1713: /*
1714: *----------------------------------------------------------------------
1715: *
1716: * untraceVar --
1717: *
1718: * Remove a trace from a variable.
1719: *
1720: * Results:
1721: * None.
1722: *
1723: * Side effects:
1724: * None.
1725: *
1726: *----------------------------------------------------------------------
1727: */
1728:
1729: public void untraceVar(String part1, // Name of scalar variable or array.
1730: String part2, // Name of element within array; null means
1731: // trace applies to scalar variable or array
1732: // as-a-whole.
1733: VarTrace trace, // Object associated with trace.
1734: int flags) // OR-ed collection of bits describing current
1735: // trace, including any of TCL.TRACE_READS,
1736: // TCL.TRACE_WRITES, TCL.TRACE_UNSETS,
1737: // TCL.GLOBAL_ONLY and TCL.NAMESPACE_ONLY.
1738: {
1739: Var.untraceVar(this , part1, part2, flags, trace);
1740: }
1741:
1742: /*
1743: *----------------------------------------------------------------------
1744: *
1745: * Tcl_CreateCommand -> createCommand
1746: *
1747: * Define a new command in the interpreter.
1748: *
1749: * Results:
1750: * None.
1751: *
1752: * Side effects:
1753: * If a command named cmdName already exists for interp, it is
1754: * deleted. In the future, when cmdName is seen as the name of a
1755: * command by eval(), cmd will be called. When the command is
1756: * deleted from the table, cmd.disposeCmd() be called if cmd
1757: * implements the CommandWithDispose interface.
1758: *
1759: *----------------------------------------------------------------------
1760: */
1761:
1762: public void createCommand(String cmdName, // Name of command.
1763: Command cmdImpl) // Command object to associate with
1764: // cmdName.
1765: {
1766: ImportRef oldRef = null;
1767: Namespace ns;
1768: WrappedCommand cmd, refCmd;
1769: String tail;
1770: ImportedCmdData data;
1771:
1772: if (deleted) {
1773: // The interpreter is being deleted. Don't create any new
1774: // commands; it's not safe to muck with the interpreter anymore.
1775:
1776: return;
1777: }
1778:
1779: // Determine where the command should reside. If its name contains
1780: // namespace qualifiers, we put it in the specified namespace;
1781: // otherwise, we always put it in the global namespace.
1782:
1783: if (cmdName.indexOf("::") != -1) {
1784: Namespace.GetNamespaceForQualNameResult gnfqnr = this .getnfqnResult;
1785: Namespace.getNamespaceForQualName(this , cmdName, null,
1786: Namespace.CREATE_NS_IF_UNKNOWN, gnfqnr);
1787: ns = gnfqnr.ns;
1788: tail = gnfqnr.simpleName;
1789:
1790: if ((ns == null) || (tail == null)) {
1791: return;
1792: }
1793: } else {
1794: ns = globalNs;
1795: tail = cmdName;
1796: }
1797:
1798: cmd = (WrappedCommand) ns.cmdTable.get(tail);
1799: if (cmd != null) {
1800: // Command already exists. Delete the old one.
1801: // Be careful to preserve any existing import links so we can
1802: // restore them down below. That way, you can redefine a
1803: // command and its import status will remain intact.
1804:
1805: oldRef = cmd.importRef;
1806: cmd.importRef = null;
1807:
1808: deleteCommandFromToken(cmd);
1809:
1810: // FIXME : create a test case for this condition!
1811:
1812: cmd = (WrappedCommand) ns.cmdTable.get(tail);
1813: if (cmd != null) {
1814: // If the deletion callback recreated the command, just throw
1815: // away the new command (if we try to delete it again, we
1816: // could get stuck in an infinite loop).
1817:
1818: cmd.table.remove(cmd.hashKey);
1819: }
1820: }
1821:
1822: cmd = new WrappedCommand();
1823: ns.cmdTable.put(tail, cmd);
1824: cmd.table = ns.cmdTable;
1825: cmd.hashKey = tail;
1826: cmd.ns = ns;
1827: cmd.cmd = cmdImpl;
1828: cmd.deleted = false;
1829: cmd.importRef = null;
1830: cmd.cmdEpoch = 1;
1831:
1832: // Plug in any existing import references found above. Be sure
1833: // to update all of these references to point to the new command.
1834:
1835: if (oldRef != null) {
1836: cmd.importRef = oldRef;
1837: while (oldRef != null) {
1838: refCmd = oldRef.importedCmd;
1839: data = (ImportedCmdData) refCmd.cmd;
1840: data.realCmd = cmd;
1841: oldRef = oldRef.next;
1842: }
1843: }
1844:
1845: // We just created a command, so in its namespace and all of its parent
1846: // namespaces, it may shadow global commands with the same name. If any
1847: // shadowed commands are found, invalidate all cached command references
1848: // in the affected namespaces.
1849:
1850: Namespace.resetShadowedCmdRefs(this , cmd);
1851: return;
1852: }
1853:
1854: /*
1855: *----------------------------------------------------------------------
1856: *
1857: * Tcl_GetCommandFullName -> getCommandFullName
1858: *
1859: * Given a token returned by, e.g., Tcl_CreateCommand or
1860: * Tcl_FindCommand, this procedure returns the command's
1861: * full name, qualified by a sequence of parent namespace names. The
1862: * command's fully-qualified name may have changed due to renaming.
1863: *
1864: * Results:
1865: * None.
1866: *
1867: * Side effects:
1868: * The command's fully-qualified name is returned.
1869: *
1870: *----------------------------------------------------------------------
1871: */
1872:
1873: public String getCommandFullName(WrappedCommand cmd) // Token for the command.
1874: {
1875: Interp interp = this ;
1876: StringBuffer name = new StringBuffer();
1877:
1878: // Add the full name of the containing namespace, followed by the "::"
1879: // separator, and the command name.
1880:
1881: if (cmd != null) {
1882: if (cmd.ns != null) {
1883: name.append(cmd.ns.fullName);
1884: if (cmd.ns != interp.globalNs) {
1885: name.append("::");
1886: }
1887: }
1888: if (cmd.table != null) {
1889: name.append(cmd.hashKey);
1890: }
1891: }
1892:
1893: return name.toString();
1894: }
1895:
1896: /*
1897: *----------------------------------------------------------------------
1898: *
1899: * Tcl_GetCommandName -> getCommandName
1900: *
1901: * Given a token returned by, e.g., Tcl_CreateCommand or
1902: * Tcl_FindCommand, this procedure returns the command's
1903: * name. The command's fully-qualified name may have changed due to renaming.
1904: *
1905: * Results:
1906: * None.
1907: *
1908: * Side effects:
1909: * The command's name is returned.
1910: *
1911: *----------------------------------------------------------------------
1912: */
1913:
1914: public String getCommandName(WrappedCommand cmd) // Token for the command.
1915: {
1916: if ((cmd == null) || (cmd.table == null)) {
1917: // This should only happen if command was "created" after the
1918: // interpreter began to be deleted, so there isn't really any
1919: // command. Just return an empty string.
1920:
1921: return "";
1922: }
1923: return cmd.hashKey;
1924: }
1925:
1926: /*
1927: *----------------------------------------------------------------------
1928: *
1929: * Tcl_DeleteCommand -> deleteCommand
1930: *
1931: * Remove the given command from the given interpreter.
1932: *
1933: * Results:
1934: * 0 is returned if the command was deleted successfully.
1935: * -1 is returned if there didn't exist a command by that
1936: * name.
1937: *
1938: * Side effects:
1939: * CmdName will no longer be recognized as a valid command for
1940: * the interpreter.
1941: *
1942: *----------------------------------------------------------------------
1943: */
1944:
1945: public int deleteCommand(String cmdName) // Name of command to remove.
1946: {
1947: WrappedCommand cmd;
1948:
1949: // Find the desired command and delete it.
1950:
1951: try {
1952: cmd = Namespace.findCommand(this , cmdName, null, 0);
1953: } catch (TclException e) {
1954: // This should never happen
1955: throw new TclRuntimeError("unexpected TclException: " + e);
1956: }
1957: if (cmd == null) {
1958: return -1;
1959: }
1960: return deleteCommandFromToken(cmd);
1961: }
1962:
1963: /*
1964: *----------------------------------------------------------------------
1965: *
1966: * Tcl_DeleteCommandFromToken -> deleteCommandFromToken
1967: *
1968: * Remove the given command from the given interpreter.
1969: *
1970: * Results:
1971: * 0 is returned if the command was deleted successfully.
1972: * -1 is returned if there didn't exist a command by that
1973: * name.
1974: *
1975: * Side effects:
1976: * cmdName will no longer be recognized as a valid command for
1977: * the interpreter.
1978: *
1979: *----------------------------------------------------------------------
1980: */
1981:
1982: public int deleteCommandFromToken(WrappedCommand cmd) // Wrapper Token for command to delete.
1983: {
1984: if (cmd == null) {
1985: return -1;
1986: }
1987:
1988: ImportRef ref, nextRef;
1989: WrappedCommand importCmd;
1990:
1991: // The code here is tricky. We can't delete the hash table entry
1992: // before invoking the deletion callback because there are cases
1993: // where the deletion callback needs to invoke the command (e.g.
1994: // object systems such as OTcl). However, this means that the
1995: // callback could try to delete or rename the command. The deleted
1996: // flag allows us to detect these cases and skip nested deletes.
1997:
1998: if (cmd.deleted) {
1999: // Another deletion is already in progress. Remove the hash
2000: // table entry now, but don't invoke a callback or free the
2001: // command structure.
2002:
2003: if (cmd.hashKey != null && cmd.table != null) {
2004: cmd.table.remove(cmd.hashKey);
2005: cmd.table = null;
2006: cmd.hashKey = null;
2007: }
2008: return 0;
2009: }
2010:
2011: cmd.deleted = true;
2012: if (cmd.cmd instanceof CommandWithDispose) {
2013: ((CommandWithDispose) cmd.cmd).disposeCmd();
2014: }
2015:
2016: // Bump the command epoch counter. This will invalidate all cached
2017: // references that point to this command.
2018:
2019: cmd.incrEpoch();
2020:
2021: // If this command was imported into other namespaces, then imported
2022: // commands were created that refer back to this command. Delete these
2023: // imported commands now.
2024:
2025: for (ref = cmd.importRef; ref != null; ref = nextRef) {
2026: nextRef = ref.next;
2027: importCmd = ref.importedCmd;
2028: deleteCommandFromToken(importCmd);
2029: }
2030:
2031: // FIXME : what does this mean? Is this a mistake in the C comment?
2032:
2033: // Don't use hPtr to delete the hash entry here, because it's
2034: // possible that the deletion callback renamed the command.
2035: // Instead, use cmdPtr->hptr, and make sure that no-one else
2036: // has already deleted the hash entry.
2037:
2038: if (cmd.table != null) {
2039: cmd.table.remove(cmd.hashKey);
2040: cmd.table = null;
2041: cmd.hashKey = null;
2042: }
2043:
2044: // Drop the reference to the Command instance inside the WrappedCommand
2045:
2046: cmd.cmd = null;
2047:
2048: // We do not need to cleanup the WrappedCommand because GC will get it.
2049:
2050: return 0;
2051: }
2052:
2053: /*
2054: *----------------------------------------------------------------------
2055: *
2056: * TclRenameCommand -> renameCommand
2057: *
2058: * Called to give an existing Tcl command a different name. Both the
2059: * old command name and the new command name can have "::" namespace
2060: * qualifiers. If the new command has a different namespace context,
2061: * the command will be moved to that namespace and will execute in
2062: * the context of that new namespace.
2063: *
2064: * If the new command name is null or the empty string, the command is
2065: * deleted.
2066: *
2067: * Results:
2068: * Returns if successful, raises TclException if anything goes wrong.
2069: *
2070: *----------------------------------------------------------------------
2071: */
2072:
2073: protected void renameCommand(String oldName, // Existing command name.
2074: String newName) // New command name.
2075: throws TclException {
2076: Interp interp = this ;
2077: String newTail;
2078: Namespace cmdNs, newNs;
2079: WrappedCommand cmd;
2080: HashMap table, oldTable;
2081: String hashKey, oldHashKey;
2082:
2083: // Find the existing command. An error is returned if cmdName can't
2084: // be found.
2085:
2086: cmd = Namespace.findCommand(interp, oldName, null, 0);
2087: if (cmd == null) {
2088: throw new TclException(
2089: interp,
2090: "can't "
2091: + (((newName == null) || (newName.length() == 0)) ? "delete"
2092: : "rename") + " \"" + oldName
2093: + "\": command doesn't exist");
2094: }
2095: cmdNs = cmd.ns;
2096:
2097: // If the new command name is NULL or empty, delete the command. Do this
2098: // with Tcl_DeleteCommandFromToken, since we already have the command.
2099:
2100: if ((newName == null) || (newName.length() == 0)) {
2101: deleteCommandFromToken(cmd);
2102: return;
2103: }
2104:
2105: // Make sure that the destination command does not already exist.
2106: // The rename operation is like creating a command, so we should
2107: // automatically create the containing namespaces just like
2108: // Tcl_CreateCommand would.
2109:
2110: Namespace.GetNamespaceForQualNameResult gnfqnr = interp.getnfqnResult;
2111: Namespace.getNamespaceForQualName(interp, newName, null,
2112: Namespace.CREATE_NS_IF_UNKNOWN, gnfqnr);
2113: newNs = gnfqnr.ns;
2114: newTail = gnfqnr.simpleName;
2115:
2116: if ((newNs == null) || (newTail == null)) {
2117: throw new TclException(interp, "can't rename to \""
2118: + newName + "\": bad command name");
2119: }
2120: if (newNs.cmdTable.get(newTail) != null) {
2121: throw new TclException(interp, "can't rename to \""
2122: + newName + "\": command already exists");
2123: }
2124:
2125: // Warning: any changes done in the code here are likely
2126: // to be needed in Tcl_HideCommand() code too.
2127: // (until the common parts are extracted out) --dl
2128:
2129: // Put the command in the new namespace so we can check for an alias
2130: // loop. Since we are adding a new command to a namespace, we must
2131: // handle any shadowing of the global commands that this might create.
2132:
2133: oldTable = cmd.table;
2134: oldHashKey = cmd.hashKey;
2135: newNs.cmdTable.put(newTail, cmd);
2136: cmd.table = newNs.cmdTable;
2137: cmd.hashKey = newTail;
2138: cmd.ns = newNs;
2139: Namespace.resetShadowedCmdRefs(this , cmd);
2140:
2141: // Now check for an alias loop. If we detect one, put everything back
2142: // the way it was and report the error.
2143:
2144: try {
2145: interp.preventAliasLoop(interp, cmd);
2146: } catch (TclException e) {
2147: newNs.cmdTable.remove(newTail);
2148: cmd.table = oldTable;
2149: cmd.hashKey = oldHashKey;
2150: cmd.ns = cmdNs;
2151: throw e;
2152: }
2153:
2154: // The new command name is okay, so remove the command from its
2155: // current namespace. This is like deleting the command, so bump
2156: // the cmdEpoch to invalidate any cached references to the command.
2157:
2158: oldTable.remove(oldHashKey);
2159: cmd.incrEpoch();
2160:
2161: return;
2162: }
2163:
2164: /*
2165: *----------------------------------------------------------------------
2166: *
2167: * TclPreventAliasLoop -> preventAliasLoop
2168: *
2169: * When defining an alias or renaming a command, prevent an alias
2170: * loop from being formed.
2171: *
2172: * Results:
2173: * A standard Tcl object result.
2174: *
2175: * Side effects:
2176: * If TCL_ERROR is returned, the function also stores an error message
2177: * in the interpreter's result object.
2178: *
2179: * NOTE:
2180: * This function is public internal (instead of being static to
2181: * this file) because it is also used from TclRenameCommand.
2182: *
2183: *----------------------------------------------------------------------
2184: */
2185:
2186: void preventAliasLoop(Interp cmdInterp, //Interp in which the command is being defined.
2187: WrappedCommand cmd) // Tcl command we are attempting to define.
2188: throws TclException {
2189: // If we are not creating or renaming an alias, then it is
2190: // always OK to create or rename the command.
2191:
2192: if (!(cmd.cmd instanceof InterpAliasCmd)) {
2193: return;
2194: }
2195:
2196: // OK, we are dealing with an alias, so traverse the chain of aliases.
2197: // If we encounter the alias we are defining (or renaming to) any in
2198: // the chain then we have a loop.
2199:
2200: InterpAliasCmd alias = (InterpAliasCmd) cmd.cmd;
2201: InterpAliasCmd nextAlias = alias;
2202: while (true) {
2203:
2204: // If the target of the next alias in the chain is the same as
2205: // the source alias, we have a loop.
2206:
2207: WrappedCommand aliasCmd = nextAlias.getTargetCmd(this );
2208: if (aliasCmd == null) {
2209: return;
2210: }
2211: if (aliasCmd.cmd == cmd.cmd) {
2212: throw new TclException(this ,
2213: "cannot define or rename alias \"" + alias.name
2214: + "\": would create a loop");
2215: }
2216:
2217: // Otherwise, follow the chain one step further. See if the target
2218: // command is an alias - if so, follow the loop to its target
2219: // command. Otherwise we do not have a loop.
2220:
2221: if (!(aliasCmd.cmd instanceof InterpAliasCmd)) {
2222: return;
2223: }
2224: nextAlias = (InterpAliasCmd) aliasCmd.cmd;
2225: }
2226: }
2227:
2228: /*
2229: *----------------------------------------------------------------------
2230: *
2231: * getCommand --
2232: *
2233: * Returns the command procedure of the given command.
2234: *
2235: * Results:
2236: * The command procedure of the given command, or null if
2237: * the command doesn't exist.
2238: *
2239: * Side effects:
2240: * None.
2241: *
2242: *----------------------------------------------------------------------
2243: */
2244:
2245: public Command getCommand(String cmdName) // String name of the command.
2246: {
2247: // Find the desired command and return it.
2248:
2249: WrappedCommand cmd;
2250:
2251: try {
2252: cmd = Namespace.findCommand(this , cmdName, null, 0);
2253: } catch (TclException e) {
2254: // This should never happen
2255: throw new TclRuntimeError("unexpected TclException: " + e);
2256: }
2257:
2258: return ((cmd == null) ? null : cmd.cmd);
2259: }
2260:
2261: /*
2262: *----------------------------------------------------------------------
2263: *
2264: * commandComplete --
2265: *
2266: * Check if the string is a complete Tcl command string.
2267: *
2268: * Result:
2269: * A boolean value indicating whether the string is a complete Tcl
2270: * command string.
2271: *
2272: * Side effects:
2273: * None.
2274: *
2275: *----------------------------------------------------------------------
2276: */
2277:
2278: public static boolean commandComplete(String string) // The string to check.
2279: {
2280: return Parser.commandComplete(string, string.length());
2281: }
2282:
2283: /*-----------------------------------------------------------------
2284: *
2285: * EVAL
2286: *
2287: *-----------------------------------------------------------------
2288: */
2289:
2290: /*
2291: *----------------------------------------------------------------------
2292: *
2293: * getResult --
2294: *
2295: * Queries the value of the result.
2296: *
2297: * Results:
2298: * The current result in the interpreter.
2299: *
2300: * Side effects:
2301: * None.
2302: *
2303: *----------------------------------------------------------------------
2304: */
2305:
2306: public final TclObject getResult() {
2307: return m_result;
2308: }
2309:
2310: /*
2311: *----------------------------------------------------------------------
2312: *
2313: * setResult --
2314: *
2315: * Arrange for the given Tcl Object to be placed as the result
2316: * object for the interpreter. Convenience functions are also
2317: * available to create a Tcl Object out of the most common Java
2318: * types. Note that the ref count for m_nullResult is not changed.
2319: *
2320: * Results:
2321: * None.
2322: *
2323: * Side effects:
2324: * The object result for the interpreter is updated.
2325: *
2326: *----------------------------------------------------------------------
2327: */
2328:
2329: public final void setResult(TclObject newResult) // A Tcl Object to be set as the result.
2330: {
2331: if (newResult == m_result) {
2332: // Setting to current value (including m_nullResult) is a no-op.
2333: return;
2334: }
2335:
2336: if (newResult != m_nullResult) {
2337: newResult.preserve();
2338: }
2339:
2340: TclObject oldResult = m_result;
2341: m_result = newResult;
2342:
2343: if (oldResult != m_nullResult) {
2344: oldResult.release();
2345: }
2346: }
2347:
2348: /*
2349: *----------------------------------------------------------------------
2350: *
2351: * setResult --
2352: *
2353: * Arrange for the given Tcl Object to be placed as the result
2354: * object for the interpreter. Convenience functions are also
2355: * available to create a Tcl Object out of the most common Java
2356: * types.
2357: *
2358: * Results:
2359: * None.
2360: *
2361: * Side effects:
2362: * The object result for the interpreter is updated.
2363: *
2364: *----------------------------------------------------------------------
2365: */
2366:
2367: public final void setResult(String r) // A string result.
2368: {
2369: setResult(checkCommonString(r));
2370: }
2371:
2372: /*
2373: *----------------------------------------------------------------------
2374: *
2375: * setResult --
2376: *
2377: * Arrange for the given Tcl Object to be placed as the result
2378: * object for the interpreter. Convenience functions are also
2379: * available to create a Tcl Object out of the most common Java
2380: * types.
2381: *
2382: * Results:
2383: * None.
2384: *
2385: * Side effects:
2386: * The object result for the interpreter is updated.
2387: *
2388: *----------------------------------------------------------------------
2389: */
2390:
2391: public final void setResult(final int r) // An int result.
2392: {
2393: setResult(checkCommonInteger(r));
2394: }
2395:
2396: /*
2397: *----------------------------------------------------------------------
2398: *
2399: * setResult --
2400: *
2401: * Arrange for the given Tcl Object to be placed as the result
2402: * object for the interpreter. Convenience functions are also
2403: * available to create a Tcl Object out of the most common Java
2404: * types.
2405: *
2406: * Results:
2407: * None.
2408: *
2409: * Side effects:
2410: * The object result for the interpreter is updated.
2411: *
2412: *----------------------------------------------------------------------
2413: */
2414:
2415: public final void setResult(final double r) // A double result.
2416: {
2417: setResult(checkCommonDouble(r));
2418: }
2419:
2420: /*
2421: *----------------------------------------------------------------------
2422: *
2423: * setResult --
2424: *
2425: * Arrange for the given Tcl Object to be placed as the result
2426: * object for the interpreter. Convenience functions are also
2427: * available to create a Tcl Object out of the most common Java
2428: * types.
2429: *
2430: * Results:
2431: * None.
2432: *
2433: * Side effects:
2434: * The object result for the interpreter is updated.
2435: *
2436: *----------------------------------------------------------------------
2437: */
2438:
2439: public final void setResult(final boolean r) // A boolean result.
2440: {
2441: if (VALIDATE_SHARED_RESULTS) {
2442: setResult(checkCommonBoolean(r));
2443: } else {
2444: setResult(r ? m_trueBooleanResult : m_falseBooleanResult);
2445: }
2446: }
2447:
2448: /*
2449: *----------------------------------------------------------------------
2450: *
2451: * resetResult --
2452: *
2453: * This procedure resets the interpreter's result object.
2454: *
2455: * Results:
2456: * None.
2457: *
2458: * Side effects:
2459: * It resets the result object to an unshared empty object. It
2460: * also clears any error information for the interpreter.
2461: *
2462: *----------------------------------------------------------------------
2463: */
2464:
2465: public final void resetResult() {
2466: if (m_result != m_nullResult) {
2467: m_result.release();
2468: m_result = m_nullResult;
2469: if (VALIDATE_SHARED_RESULTS) {
2470: if (!m_nullResult.isShared()) {
2471: throw new TclRuntimeError(
2472: "m_nullResult is not shared");
2473: }
2474: }
2475: }
2476: errAlreadyLogged = false;
2477: errInProgress = false;
2478: errCodeSet = false;
2479: returnCode = TCL.OK;
2480: }
2481:
2482: /*
2483: *----------------------------------------------------------------------
2484: *
2485: * Tcl_AppendElement -> Interp.appendElement()
2486: *
2487: * Convert a string to a valid Tcl list element and append it to the
2488: * result (which is ostensibly a list).
2489: *
2490: * Results:
2491: * None.
2492: *
2493: * Side effects:
2494: * The result in the interpreter given by the first argument is
2495: * extended with a list element converted from string. A separator
2496: * space is added before the converted list element unless the current
2497: * result is empty, contains the single character "{", or ends in " {".
2498: *
2499: * If the string result is empty, the object result is moved to the
2500: * string result, then the object result is reset.
2501: *
2502: *----------------------------------------------------------------------
2503: */
2504:
2505: void appendElement(String string) /* String to convert to list element and
2506: * add to result. */
2507: throws TclException {
2508: TclObject result;
2509:
2510: result = getResult();
2511: if (result.isShared()) {
2512: result = result.duplicate();
2513: }
2514: TclList.append(this , result, TclString.newInstance(string));
2515: setResult(result);
2516: }
2517:
2518: /*
2519: *----------------------------------------------------------------------
2520: *
2521: * eval --
2522: *
2523: * Execute a Tcl command in a string.
2524: *
2525: * Results:
2526: * The return value is void. However, a standard Tcl Exception
2527: * may be generated. The interpreter's result object will contain
2528: * the value of the evaluation but will persist only until the next
2529: * call to one of the eval functions.
2530: *
2531: * Side effects:
2532: * The side effects will be determined by the exact Tcl code to be
2533: * evaluated.
2534: *
2535: *----------------------------------------------------------------------
2536: */
2537:
2538: public void eval(String script) // A script to evaluate.
2539: throws TclException // A standard Tcl exception.
2540: {
2541: eval(script, 0);
2542: }
2543:
2544: public void eval(String string, // A script to evaluate.
2545: int flags) // Flags, either 0 or TCL.EVAL_GLOBAL
2546: throws TclException // A standard Tcl exception.
2547: {
2548: if (string == null) {
2549: throw new NullPointerException(
2550: "passed null String to eval()");
2551: }
2552:
2553: int evalFlags = this .evalFlags;
2554: this .evalFlags &= ~Parser.TCL_ALLOW_EXCEPTIONS;
2555:
2556: CharPointer script = new CharPointer(string);
2557: try {
2558: Parser.eval2(this , script.array, script.index, script
2559: .length(), flags);
2560: } catch (TclException e) {
2561:
2562: if (nestLevel != 0) {
2563: throw e;
2564: }
2565:
2566: // Update the interpreter's evaluation level count. If we are again at
2567: // the top level, process any unusual return code returned by the
2568: // evaluated code. Note that we don't propagate an exception that
2569: // has a TCL.RETURN error code when updateReturnInfo() returns TCL.OK.
2570:
2571: int result = e.getCompletionCode();
2572:
2573: if (result == TCL.RETURN) {
2574: result = updateReturnInfo();
2575: }
2576: if (result != TCL.OK && result != TCL.ERROR
2577: && (evalFlags & Parser.TCL_ALLOW_EXCEPTIONS) == 0) {
2578: processUnexpectedResult(result);
2579: }
2580: if (result != TCL.OK) {
2581: e.setCompletionCode(result);
2582: throw e;
2583: }
2584: } finally {
2585: checkInterrupted();
2586: }
2587: }
2588:
2589: /*
2590: *----------------------------------------------------------------------
2591: *
2592: * Tcl_EvalObjEx -> eval
2593: *
2594: * Execute a Tcl command in a TclObject.
2595: *
2596: * Results:
2597: * The return value is void. However, a standard Tcl Exception
2598: * may be generated. The interpreter's result object will contain
2599: * the value of the evaluation but will persist only until the next
2600: * call to one of the eval functions.
2601: *
2602: * Side effects:
2603: * The side effects will be determined by the exact Tcl code to be
2604: * evaluated.
2605: *
2606: *----------------------------------------------------------------------
2607: */
2608:
2609: public void eval(TclObject tobj, // A Tcl object holding a script to evaluate.
2610: int flags) // Flags, either 0 or TCL.EVAL_GLOBAL
2611: throws TclException // A standard Tcl exception.
2612: {
2613: boolean isPureList = false;
2614:
2615: if (tobj.hasNoStringRep() && tobj.isListType()) {
2616: isPureList = true;
2617: }
2618:
2619: // Non-optimized eval(), used when tobj is not a pure list.
2620:
2621: if (!isPureList) {
2622: tobj.preserve();
2623: try {
2624: eval(tobj.toString(), flags);
2625: } finally {
2626: tobj.release();
2627:
2628: checkInterrupted();
2629: }
2630:
2631: return;
2632: }
2633:
2634: // In the pure list case, use an optimized implementation that
2635: // skips the costly reparse operation. In the pure list case
2636: // the TclObject arguments to the command can be used as is
2637: // by invoking Parse.evalObjv();
2638:
2639: int evalFlags = this .evalFlags;
2640: this .evalFlags &= ~Parser.TCL_ALLOW_EXCEPTIONS;
2641: TclObject[] objv = null;
2642: boolean invokedEval = false;
2643:
2644: tobj.preserve();
2645: try {
2646: // Grab a TclObject[] from the cache and populate
2647: // it with the TclObject refs from the TclList.
2648: // Increment the refs in case tobj loses the
2649: // TclList internal rep during the evaluation.
2650:
2651: final int llength = TclList.getLength(this , tobj);
2652: objv = Parser.grabObjv(this , llength);
2653: for (int i = 0; i < llength; i++) {
2654: objv[i] = TclList.index(this , tobj, i);
2655: objv[i].preserve();
2656: }
2657:
2658: invokedEval = true;
2659: Parser.evalObjv(this , objv, -1, flags);
2660: } catch (StackOverflowError e) {
2661: Parser.infiniteLoopException(this );
2662: } catch (TclException e) {
2663: int result = e.getCompletionCode();
2664:
2665: // Generate various pieces of error information, such
2666: // as the line number where the error occurred and
2667: // information to add to the errorInfo variable. Then
2668: // free resources that had been allocated
2669: // to the command.
2670:
2671: if (invokedEval && result == TCL.ERROR
2672: && !(this .errAlreadyLogged)) {
2673: StringBuffer cmd_strbuf = new StringBuffer(64);
2674:
2675: for (int i = 0; i < objv.length; i++) {
2676: Util.appendElement(this , cmd_strbuf, objv[i]
2677: .toString());
2678: }
2679:
2680: String cmd_str = cmd_strbuf.toString();
2681: char[] script_array = cmd_str.toCharArray();
2682: int script_index = 0;
2683: int command_start = 0;
2684: int command_length = cmd_str.length();
2685: Parser.logCommandInfo(this , script_array, script_index,
2686: command_start, command_length, e);
2687: }
2688:
2689: // Process results when the next level is zero
2690:
2691: if (nestLevel != 0) {
2692: throw e;
2693: }
2694:
2695: // Update the interpreter's evaluation level count. If we are again at
2696: // the top level, process any unusual return code returned by the
2697: // evaluated code. Note that we don't propagate an exception that
2698: // has a TCL.RETURN error code when updateReturnInfo() returns TCL.OK.
2699:
2700: if (result == TCL.RETURN) {
2701: result = updateReturnInfo();
2702: }
2703: if (result != TCL.OK && result != TCL.ERROR
2704: && (evalFlags & Parser.TCL_ALLOW_EXCEPTIONS) == 0) {
2705: processUnexpectedResult(result);
2706: }
2707: if (result != TCL.OK) {
2708: e.setCompletionCode(result);
2709: throw e;
2710: }
2711: } finally {
2712: if (objv != null) {
2713: for (int i = 0; i < objv.length; i++) {
2714: TclObject obj = objv[i];
2715: if (obj != null) {
2716: obj.release();
2717: }
2718: }
2719: Parser.releaseObjv(this , objv, objv.length);
2720: }
2721: tobj.release();
2722:
2723: checkInterrupted();
2724: }
2725: }
2726:
2727: /*
2728: *----------------------------------------------------------------------
2729: *
2730: * Tcl_RecordAndEvalObj -> recordAndEval
2731: *
2732: * This procedure adds its command argument to the current list of
2733: * recorded events and then executes the command by calling eval.
2734: *
2735: * Results:
2736: * The return value is void. However, a standard Tcl Exception
2737: * may be generated. The interpreter's result object will contain
2738: * the value of the evaluation but will persist only until the next
2739: * call to one of the eval functions.
2740: *
2741: * Side effects:
2742: * The side effects will be determined by the exact Tcl code to be
2743: * evaluated.
2744: *
2745: *----------------------------------------------------------------------
2746: */
2747:
2748: public void recordAndEval(TclObject script, // A script to evaluate.
2749: int flags) // Additional flags. TCL.NO_EVAL means
2750: // record only: don't execute the command.
2751: // TCL.EVAL_GLOBAL means evaluate the
2752: // script in global variable context instead
2753: // of the current procedure.
2754: throws TclException // A standard Tcl exception.
2755: {
2756: // Append the script to the event list by calling "history add <script>".
2757: // We call the eval method with the command of type TclObject, so that
2758: // we don't have to deal with funny chars ("{}[]$\) in the script.
2759:
2760: TclObject cmd = null;
2761: try {
2762: cmd = TclList.newInstance();
2763: TclList.append(this , cmd, TclString.newInstance("history"));
2764: TclList.append(this , cmd, TclString.newInstance("add"));
2765: TclList.append(this , cmd, script);
2766: eval(cmd, TCL.EVAL_GLOBAL);
2767: } catch (Exception e) {
2768: // No-op
2769: }
2770:
2771: // Execute the command.
2772:
2773: if ((flags & TCL.NO_EVAL) == 0) {
2774: eval(script, flags & TCL.EVAL_GLOBAL);
2775: }
2776: }
2777:
2778: /*
2779: *----------------------------------------------------------------------
2780: *
2781: * evalFile --
2782: * Loads a Tcl script from a file and evaluates it in the
2783: * current interpreter.
2784: *
2785: * Results:
2786: * None.
2787: *
2788: * Side effects:
2789: * The side effects will be determined by the exact Tcl code to be
2790: * evaluated.
2791: *
2792: *----------------------------------------------------------------------
2793: */
2794:
2795: public void evalFile(String s) // The name of file to evaluate.
2796: throws TclException {
2797: String fileContent; // Contains the content of the file.
2798:
2799: fileContent = readScriptFromFile(s);
2800:
2801: if (fileContent == null) {
2802: throw new TclException(this , "couldn't read file \"" + s
2803: + "\"");
2804: }
2805:
2806: String oldScript = scriptFile;
2807: scriptFile = s;
2808:
2809: try {
2810: pushDebugStack(s, 1);
2811: eval(fileContent, 0);
2812: } catch (TclException e) {
2813: if (e.getCompletionCode() == TCL.ERROR) {
2814: addErrorInfo("\n (file \"" + s + "\" line "
2815: + errorLine + ")");
2816: }
2817: throw e;
2818: } finally {
2819: scriptFile = oldScript;
2820: popDebugStack();
2821: }
2822: }
2823:
2824: /*
2825: *----------------------------------------------------------------------
2826: *
2827: * evalURL --
2828: *
2829: * Loads a Tcl script from a URL and evaluate it in the
2830: * current interpreter.
2831: *
2832: * Results:
2833: * None.
2834: *
2835: * Side effects:
2836: * The side effects will be determined by the exact Tcl code to be
2837: * evaluated.
2838: *
2839: *----------------------------------------------------------------------
2840: */
2841:
2842: void evalURL(URL context, // URL context under which s is interpreted.
2843: String s) // The name of URL.
2844: throws TclException {
2845: String fileContent; // Contains the content of the file.
2846:
2847: fileContent = readScriptFromURL(context, s);
2848: if (fileContent == null) {
2849: throw new TclException(this , "cannot read URL \"" + s
2850: + "\"");
2851: }
2852:
2853: String oldScript = scriptFile;
2854: scriptFile = s;
2855:
2856: try {
2857: eval(fileContent, 0);
2858: } finally {
2859: scriptFile = oldScript;
2860: }
2861: }
2862:
2863: /*
2864: *----------------------------------------------------------------------
2865: *
2866: * readScriptFromFile --
2867: *
2868: * Read the script file into a string.
2869: *
2870: * Results:
2871: * Returns the content of the script file.
2872: *
2873: * Side effects:
2874: * If a new File object cannot be created for s, the result is reset.
2875: *
2876: *----------------------------------------------------------------------
2877: */
2878:
2879: private String readScriptFromFile(String s) // The name of the file.
2880: {
2881: File sourceFile;
2882: FileChannel fchan = new FileChannel();
2883: boolean wasOpened = false;
2884: TclObject result = TclString.newInstance(new StringBuffer(64));
2885:
2886: try {
2887: sourceFile = FileUtil.getNewFileObj(this , s);
2888: fchan.open(this , sourceFile.getPath(), TclIO.RDONLY);
2889: wasOpened = true;
2890: fchan.read(this , result, TclIO.READ_ALL, 0);
2891: return result.toString();
2892: } catch (TclException e) {
2893: resetResult();
2894: return null;
2895: } catch (FileNotFoundException e) {
2896: return null;
2897: } catch (IOException e) {
2898: return null;
2899: } catch (SecurityException e) {
2900: return null;
2901: } finally {
2902: if (wasOpened) {
2903: closeChannel(fchan);
2904: }
2905: }
2906: }
2907:
2908: /*
2909: *----------------------------------------------------------------------
2910: *
2911: * readScriptFromURL --
2912: *
2913: * Read the script file into a string, treating the file as
2914: * an URL.
2915: *
2916: * Results:
2917: * The content of the script file.
2918: *
2919: * Side effects:
2920: * None.
2921: *
2922: *----------------------------------------------------------------------
2923: */
2924:
2925: private String readScriptFromURL(URL context, // Use as the URL context if s is a relative URL.
2926: String s) // ???
2927: {
2928: Object content = null;
2929: URL url;
2930:
2931: try {
2932: url = new URL(context, s);
2933: } catch (MalformedURLException e) {
2934: return null;
2935: }
2936:
2937: try {
2938: content = url.getContent();
2939: } catch (UnknownServiceException e) {
2940: Class jar_class;
2941:
2942: try {
2943: // Load JarURLConnection via the system class loader
2944: jar_class = Class.forName("java.net.JarURLConnection");
2945: } catch (Exception e2) {
2946: return null;
2947: }
2948:
2949: Object jar;
2950: try {
2951: jar = url.openConnection();
2952: } catch (IOException e2) {
2953: return null;
2954: }
2955:
2956: if (jar == null) {
2957: return null;
2958: }
2959:
2960: // We must call JarURLConnection.getInputStream() dynamically
2961: // Because the class JarURLConnection does not exist in JDK1.1
2962:
2963: try {
2964: Method m = jar_class.getMethod("openConnection", null);
2965: content = m.invoke(jar, null);
2966: } catch (Exception e2) {
2967: return null;
2968: }
2969: } catch (IOException e) {
2970: return null;
2971: } catch (SecurityException e) {
2972: return null;
2973: }
2974:
2975: if (content instanceof String) {
2976: return convertStringCRLF((String) content);
2977: } else if (content instanceof InputStream) {
2978: return readScriptFromInputStream((InputStream) content);
2979: } else {
2980: return null;
2981: }
2982: }
2983:
2984: /*
2985: *----------------------------------------------------------------------
2986: *
2987: * convertStringCRLF --
2988: *
2989: * Convert CRLF sequences into LF sequences in a String.
2990: *
2991: * Results:
2992: * A new string with LF instead of CRLF.
2993: *
2994: * Side effects:
2995: * None.
2996: *
2997: *----------------------------------------------------------------------
2998: */
2999: String convertStringCRLF(String inStr) // String that could contain CRLFs
3000: {
3001: String str = inStr;
3002: StringBuffer sb = new StringBuffer(str.length());
3003: char c, prev = '\n';
3004: boolean foundCRLF = false;
3005: final int length = str.length();
3006:
3007: for (int i = 0; i < length; i++) {
3008: c = str.charAt(i);
3009: if (c == '\n' && prev == '\r') {
3010: sb.setCharAt(sb.length() - 1, '\n');
3011: prev = '\n';
3012: foundCRLF = true;
3013: } else {
3014: sb.append(c);
3015: prev = c;
3016: }
3017: }
3018:
3019: if (foundCRLF) {
3020: return sb.toString();
3021: } else {
3022: return str;
3023: }
3024: }
3025:
3026: /*
3027: *----------------------------------------------------------------------
3028: *
3029: * readScriptFromInputStream --
3030: *
3031: * Read a script from a Java InputStream into a string.
3032: *
3033: * Results:
3034: * Returns the content of the script.
3035: *
3036: * Side effects:
3037: * None.
3038: *
3039: *----------------------------------------------------------------------
3040: */
3041:
3042: private String readScriptFromInputStream(InputStream s) // Java InputStream containing script
3043: {
3044: TclObject result = TclString.newInstance(new StringBuffer(64));
3045: ReadInputStreamChannel rc = new ReadInputStreamChannel(this , s);
3046:
3047: try {
3048: rc.read(this , result, TclIO.READ_ALL, 0);
3049: return result.toString();
3050: } catch (TclException e) {
3051: resetResult();
3052: return null;
3053: } catch (FileNotFoundException e) {
3054: return null;
3055: } catch (IOException e) {
3056: return null;
3057: } catch (SecurityException e) {
3058: return null;
3059: } finally {
3060: closeChannel(rc);
3061: // FIXME: Closing the channel should close the stream!
3062: closeInputStream(s);
3063: }
3064: }
3065:
3066: /*
3067: *----------------------------------------------------------------------
3068: *
3069: * closeInputStream --
3070: *
3071: * Close the InputStream; catch any IOExceptions and ignore them.
3072: *
3073: * Results:
3074: * None.
3075: *
3076: * Side effects:
3077: * None.
3078: *
3079: *----------------------------------------------------------------------
3080: */
3081:
3082: private void closeInputStream(InputStream fs) {
3083: try {
3084: fs.close();
3085: } catch (IOException e) {
3086: ;
3087: }
3088: }
3089:
3090: /*
3091: *----------------------------------------------------------------------
3092: *
3093: * closeChannel --
3094: *
3095: * Close the Channel; catch any IOExceptions and ignore them.
3096: *
3097: * Results:
3098: * None.
3099: *
3100: * Side effects:
3101: * None.
3102: *
3103: *----------------------------------------------------------------------
3104: */
3105:
3106: private void closeChannel(Channel chan) {
3107: try {
3108: chan.close();
3109: } catch (IOException e) {
3110: }
3111: }
3112:
3113: /*
3114: *----------------------------------------------------------------------
3115: *
3116: * evalResource --
3117: *
3118: * Execute a Tcl script stored in the given Java resource location.
3119: *
3120: * Results:
3121: * The return value is void. However, a standard Tcl Exception
3122: * may be generated. The interpreter's result object will contain
3123: * the value of the evaluation but will persist only until the next
3124: * call to one of the eval functions.
3125: *
3126: * Side effects:
3127: * The side effects will be determined by the exact Tcl code to be
3128: * evaluated.
3129: *
3130: *----------------------------------------------------------------------
3131: */
3132:
3133: public void evalResource(String resName) // The location of the Java resource. See
3134: // the Java documentation of
3135: // Class.getResourceAsStream()
3136: // for details on resource naming.
3137: throws TclException {
3138: final boolean debug = false;
3139: final boolean USE_SCRIPT_CACHE = true;
3140:
3141: boolean couldBeCached = false;
3142: boolean isCached = false;
3143: InputStream stream;
3144: String script = null;
3145:
3146: if (debug) {
3147: System.out.println("evalResource " + resName);
3148: }
3149:
3150: // Tcl library scripts can be cached since they will not change
3151: // after the JVM has started. A String value for the script is
3152: // cached after it has been read from the filesystem and been
3153: // processed for CRLF by the Tcl IO subsystem.
3154:
3155: if (USE_SCRIPT_CACHE
3156: && resName.startsWith("/tcl/lang/library/")
3157: && (resName.equals("/tcl/lang/library/tclIndex") || resName
3158: .endsWith(".tcl"))) {
3159: if (debug) {
3160: System.out.println("Tcl script could be cached: "
3161: + resName);
3162: }
3163: couldBeCached = true;
3164: }
3165:
3166: // Note, we only want to synchronize to the tclLibraryScripts
3167: // table when dealing with a Tcl library resource. Other
3168: // resource loads should not need to grab a static monitor.
3169:
3170: if (USE_SCRIPT_CACHE && couldBeCached) {
3171: synchronized (tclLibraryScripts) {
3172: if ((script = (String) tclLibraryScripts.get(resName)) == null) {
3173: isCached = false;
3174: } else {
3175: isCached = true;
3176: }
3177:
3178: if (!isCached) {
3179: if (debug) {
3180: System.out.println("Tcl script is not cached");
3181: }
3182:
3183: // When not cached, attempt to load via
3184: // getResourceAsStream and then add to the cache.
3185:
3186: stream = getResourceAsStream(resName);
3187: if (stream == null) {
3188: throw new TclException(this ,
3189: "cannot read resource \"" + resName
3190: + "\"");
3191: }
3192: script = readScriptFromInputStream(stream);
3193: if (script == null) {
3194: throw new TclException(this ,
3195: "cannot read resource \"" + resName
3196: + "\"");
3197: }
3198:
3199: tclLibraryScripts.put(resName, script);
3200: } else {
3201: if (debug) {
3202: System.out.println("Tcl script is cached");
3203: }
3204:
3205: // No-op, just use script that was set above
3206: }
3207: }
3208: } else {
3209: if (debug) {
3210: System.out
3211: .println("Not a Tcl library script, loading normally");
3212: }
3213:
3214: stream = getResourceAsStream(resName);
3215: if (stream == null) {
3216: throw new TclException(this , "cannot read resource \""
3217: + resName + "\"");
3218: }
3219: script = readScriptFromInputStream(stream);
3220: if (script == null) {
3221: throw new TclException(this , "cannot read resource \""
3222: + resName + "\"");
3223: }
3224: }
3225:
3226: // Define Interp.scriptFile as a resource so that [info script]
3227: // can be used to construct names of other resources in the
3228: // same resource directory.
3229:
3230: String oldScript = scriptFile;
3231: scriptFile = "resource:" + resName;
3232:
3233: try {
3234: eval(script, 0);
3235: } finally {
3236: scriptFile = oldScript;
3237: }
3238: }
3239:
3240: /*
3241: *----------------------------------------------------------------------
3242: *
3243: * backslash --
3244: *
3245: * Figure out how to handle a backslash sequence. The index
3246: * of the ChapPointer must be pointing to the first /.
3247: *
3248: * Results:
3249: * The return value is an instance of BackSlashResult that
3250: * contains the character that should be substituted in place
3251: * of the backslash sequence that starts at src.index, and
3252: * an index to the next character after the backslash sequence.
3253: *
3254: * Side effects:
3255: * None.
3256: *
3257: *----------------------------------------------------------------------
3258: */
3259:
3260: static BackSlashResult backslash(String s, int i, int len) {
3261: CharPointer script = new CharPointer(s.substring(0, len));
3262: script.index = i;
3263: return Parser.backslash(script.array, script.index);
3264: }
3265:
3266: /*
3267: *----------------------------------------------------------------------
3268: *
3269: * setErrorCode --
3270: *
3271: * This procedure is called to record machine-readable information
3272: * about an error that is about to be returned. The caller should
3273: * build a list object up and pass it to this routine.
3274: *
3275: * Results:
3276: * None.
3277: *
3278: * Side effects:
3279: * The errorCode global variable is modified to be the new value.
3280: * A flag is set internally to remember that errorCode has been
3281: * set, so the variable doesn't get set automatically when the
3282: * error is returned.
3283: *
3284: * If the errorCode variable have write traces, any arbitrary side
3285: * effects may happen in those traces. TclException's caused by the
3286: * traces, however, are ignored and not passed back to the caller
3287: * of this function.
3288: *
3289: *----------------------------------------------------------------------
3290: */
3291: public void setErrorCode(TclObject code) // The errorCode object.
3292: {
3293: try {
3294: setVar("errorCode", null, code, TCL.GLOBAL_ONLY);
3295: errCodeSet = true;
3296: } catch (TclException excp) {
3297: // Ignore any TclException's, possibly caused by variable traces on
3298: // the errorCode variable. This is compatible with the behavior of
3299: // the Tcl C API.
3300: }
3301: }
3302:
3303: /*
3304: *----------------------------------------------------------------------
3305: *
3306: * addErrorInfo --
3307: *
3308: * Add information to the "errorInfo" variable that describes the
3309: * current error.
3310: *
3311: * Results:
3312: * None.
3313: *
3314: * Side effects:
3315: * The contents of message are added to the "errorInfo" variable.
3316: * If eval() has been called since the current value of errorInfo
3317: * was set, errorInfo is cleared before adding the new message.
3318: * If we are just starting to log an error, errorInfo is initialized
3319: * from the error message in the interpreter's result.
3320: *
3321: * If the errorInfo variable have write traces, any arbitrary side
3322: * effects may happen in those traces. TclException's caused by the
3323: * traces, however, are ignored and not passed back to the caller
3324: * of this function.
3325: *
3326: *----------------------------------------------------------------------
3327: */
3328:
3329: public void addErrorInfo(String message) // The message to record.
3330: {
3331: if (!errInProgress) {
3332: errInProgress = true;
3333:
3334: try {
3335: setVar("errorInfo", null, getResult().toString(),
3336: TCL.GLOBAL_ONLY);
3337: } catch (TclException e1) {
3338: // Ignore (see try-block above).
3339: }
3340:
3341: // If the errorCode variable wasn't set by the code
3342: // that generated the error, set it to "NONE".
3343:
3344: if (!errCodeSet) {
3345: try {
3346: setVar("errorCode", null, "NONE", TCL.GLOBAL_ONLY);
3347: } catch (TclException e1) {
3348: // Ignore (see try-block above).
3349: }
3350: }
3351: }
3352:
3353: try {
3354: setVar("errorInfo", null, message, TCL.APPEND_VALUE
3355: | TCL.GLOBAL_ONLY);
3356: } catch (TclException e1) {
3357: // Ignore (see try-block above).
3358: }
3359: }
3360:
3361: /*
3362: *----------------------------------------------------------------------
3363: *
3364: * ProcessUnexpectedResult -> processUnexpectedResult
3365: *
3366: * Procedure called by Tcl_EvalObj to set the interpreter's result
3367: * value to an appropriate error message when the code it evaluates
3368: * returns an unexpected result code (not TCL_OK and not TCL_ERROR) to
3369: * the topmost evaluation level.
3370: *
3371: * Results:
3372: * None.
3373: *
3374: * Side effects:
3375: * The interpreter result is set to an error message appropriate to
3376: * the result code.
3377: *
3378: *----------------------------------------------------------------------
3379: */
3380:
3381: public void processUnexpectedResult(int returnCode) // The unexpected result code.
3382: throws TclException // A standard Tcl exception.
3383: {
3384: resetResult();
3385: if (returnCode == TCL.BREAK) {
3386: throw new TclException(this ,
3387: "invoked \"break\" outside of a loop");
3388: } else if (returnCode == TCL.CONTINUE) {
3389: throw new TclException(this ,
3390: "invoked \"continue\" outside of a loop");
3391: } else {
3392: throw new TclException(this , "command returned bad code: "
3393: + returnCode);
3394: }
3395: }
3396:
3397: /*
3398: *----------------------------------------------------------------------
3399: *
3400: * TclUpdateReturnInfo -> updateReturnInfo
3401: *
3402: * This method is used by various parts of the Jacl and external packages.
3403: * interpreter when a TclException of TCL.RETURN is received. The
3404: * most common case is when the "return" command is executed
3405: * inside a Tcl procedure. This method examines fields such as
3406: * interp.returnCode and interp.errorCode and determines the real
3407: * return status of the Tcl procedure accordingly.
3408: *
3409: * Results:
3410: * The return value is the true completion code to use for
3411: * the Tcl procedure, instead of TCL.RETURN. It's the same
3412: * value that was given to the "return -code" option.
3413: *
3414: * If TCL.OK is returned, it means than the caller of this method should
3415: * ignore any TclException that it has received.
3416: *
3417: * Side effects:
3418: * The errorInfo and errorCode variables may get modified.
3419: *
3420: *----------------------------------------------------------------------
3421: */
3422:
3423: public int updateReturnInfo() {
3424: int code;
3425:
3426: code = returnCode;
3427: returnCode = TCL.OK;
3428:
3429: if (code == TCL.ERROR) {
3430: try {
3431: setVar("errorCode", null,
3432: (errorCode != null) ? errorCode : "NONE",
3433: TCL.GLOBAL_ONLY);
3434: } catch (TclException e) {
3435: // An error may happen during a trace to errorCode. We ignore it.
3436: // This may leave error messages inside Interp.result (which
3437: // is compatible with Tcl 8.0 behavior.
3438: }
3439: errCodeSet = true;
3440:
3441: if (errorInfo != null) {
3442: try {
3443: setVar("errorInfo", null, errorInfo,
3444: TCL.GLOBAL_ONLY);
3445: } catch (TclException e) {
3446: // An error may happen during a trace to errorInfo. We
3447: // ignore it. This may leave error messages inside
3448: // Interp.result (which is compatible with Tcl 8.0
3449: // behavior.
3450: }
3451: errInProgress = true;
3452: }
3453: }
3454:
3455: return code;
3456: }
3457:
3458: /*
3459: *----------------------------------------------------------------------
3460: *
3461: * newCallFrame --
3462: *
3463: * Creates a new callframe. This method can be overrided to
3464: * provide debugging support.
3465: *
3466: * Results:
3467: * A new CallFrame.
3468: *
3469: * Side effects:
3470: * None.
3471: *
3472: *----------------------------------------------------------------------
3473: */
3474:
3475: protected CallFrame newCallFrame(Procedure proc, // The procedure which will later be
3476: // execute inside the new callframe.
3477: TclObject[] objv) // The arguments to pass to the procedure.
3478: throws TclException // Incorrect number of arguments passed.
3479: {
3480: return new CallFrame(this , proc, objv);
3481: }
3482:
3483: /*
3484: *----------------------------------------------------------------------
3485: *
3486: * newCallFrame --
3487: *
3488: * Creates a new callframe. This method can be overrided to
3489: * provide debugging support.
3490: *
3491: * Results:
3492: * A new CallFrame.
3493: *
3494: * Side effects:
3495: * None.
3496: *
3497: *----------------------------------------------------------------------
3498: */
3499:
3500: protected CallFrame newCallFrame() {
3501: return new CallFrame(this );
3502: }
3503:
3504: /*
3505: *----------------------------------------------------------------------
3506: *
3507: * getWorkingDir --
3508: *
3509: * Retrieve the current working directory for this interpreter.
3510: *
3511: * Results:
3512: * Returns the File for the directory.
3513: *
3514: * Side effects:
3515: * If the working dir is null, set it.
3516: *
3517: *----------------------------------------------------------------------
3518: */
3519:
3520: File getWorkingDir() {
3521: if (workingDir == null) {
3522: try {
3523: String dirName = getVar("env", "HOME", 0).toString();
3524: workingDir = FileUtil.getNewFileObj(this , dirName);
3525: } catch (TclException e) {
3526: resetResult();
3527: }
3528: workingDir = new File(Util.tryGetSystemProperty(
3529: "user.home", "."));
3530: }
3531: return workingDir;
3532: }
3533:
3534: /*
3535: *----------------------------------------------------------------------
3536: *
3537: * setWorkingDir --
3538: *
3539: * Set the current working directory for this interpreter.
3540: *
3541: * Results:
3542: * None.
3543: *
3544: * Side effects:
3545: * Set the working directory or throw a TclException.
3546: *
3547: *----------------------------------------------------------------------
3548: */
3549:
3550: void setWorkingDir(String dirName) throws TclException {
3551: File dirObj = FileUtil.getNewFileObj(this , dirName);
3552:
3553: // Use the canonical name of the path, if possible.
3554:
3555: try {
3556: dirObj = new File(dirObj.getCanonicalPath());
3557: } catch (IOException e) {
3558: }
3559:
3560: if (dirObj.isDirectory()) {
3561: workingDir = dirObj;
3562: } else {
3563: String dname = FileUtil.translateFileName(this , dirName);
3564: if (FileUtil.getPathType(dname) == FileUtil.PATH_RELATIVE) {
3565: dname = dirName;
3566: } else {
3567: dname = dirObj.getPath();
3568: }
3569: throw new TclException(this ,
3570: "couldn't change working directory to \"" + dname
3571: + "\": no such file or directory");
3572: }
3573: }
3574:
3575: /*
3576: *----------------------------------------------------------------------
3577: *
3578: * getNotifier --
3579: *
3580: * Retrieve the Notifier associated with this Interp.
3581: * This method can safely be invoked from a thread
3582: * other than the thread the Interp was created in.
3583: * If this method is invoked after the Interp object
3584: * has been disposed of then null will be returned.
3585: *
3586: * Results:
3587: * Returns the Notifier for the thread the interp was
3588: * created in.
3589: *
3590: * Side effects:
3591: * None.
3592: *
3593: *----------------------------------------------------------------------
3594: */
3595:
3596: public Notifier getNotifier() {
3597: return notifier;
3598: }
3599:
3600: /*
3601: *----------------------------------------------------------------------
3602: *
3603: * pkgProvide --
3604: *
3605: * This procedure is invoked to declare that a particular version
3606: * of a particular package is now present in an interpreter. There
3607: * must not be any other version of this package already
3608: * provided in the interpreter.
3609: *
3610: * Results:
3611: * Normally does nothing; if there is already another version
3612: * of the package loaded then an error is raised.
3613: *
3614: * Side effects:
3615: * The interpreter remembers that this package is available,
3616: * so that no other version of the package may be provided for
3617: * the interpreter.
3618: *
3619: *----------------------------------------------------------------------
3620: */
3621:
3622: public final void pkgProvide(String name, String version)
3623: throws TclException {
3624: PackageCmd.pkgProvide(this , name, version);
3625: }
3626:
3627: /*
3628: *----------------------------------------------------------------------
3629: *
3630: * pkgRequire --
3631: *
3632: * This procedure is called by code that depends on a particular
3633: * version of a particular package. If the package is not already
3634: * provided in the interpreter, this procedure invokes a Tcl script
3635: * to provide it. If the package is already provided, this
3636: * procedure makes sure that the caller's needs don't conflict with
3637: * the version that is present.
3638: *
3639: * Results:
3640: * If successful, returns the version string for the currently
3641: * provided version of the package, which may be different from
3642: * the "version" argument. If the caller's requirements
3643: * cannot be met (e.g. the version requested conflicts with
3644: * a currently provided version, or the required version cannot
3645: * be found, or the script to provide the required version
3646: * generates an error), a TclException is raised.
3647: *
3648: * Side effects:
3649: * The script from some previous "package ifneeded" command may
3650: * be invoked to provide the package.
3651: *
3652: *----------------------------------------------------------------------
3653: */
3654:
3655: public final String pkgRequire(String pkgname, String version,
3656: boolean exact) throws TclException {
3657: return PackageCmd.pkgRequire(this , pkgname, version, exact);
3658: }
3659:
3660: /*
3661: * Debugging API.
3662: *
3663: * The following section defines two debugging API functions for
3664: * logging information about the point of execution of Tcl scripts:
3665: *
3666: * - pushDebugStack() is called when a procedure body is
3667: * executed, or when a file is source'd.
3668: * - popDebugStack() is called when the flow of control is about
3669: * to return from a procedure body, or from a source'd file.
3670: *
3671: * Two other API functions are used to determine the current point of
3672: * execution:
3673: *
3674: * - getScriptFile() returns the script file current being executed.
3675: * - getArgLineNumber(i) returns the line number of the i-th argument
3676: * of the current command.
3677: *
3678: * Note: The point of execution is automatically maintained for
3679: * control structures such as while, if, for and foreach,
3680: * as long as they use Interp.eval(argv[?]) to evaluate control
3681: * blocks.
3682: *
3683: * The case and switch commands need to set dbg.cmdLine explicitly
3684: * because they may evaluate control blocks that are not elements
3685: * inside the argv[] array. ** This feature not yet implemented. **
3686: *
3687: * The proc command needs to call getScriptFile() and
3688: * getArgLineNumber(3) to find out the location of the proc
3689: * body.
3690: *
3691: * The debugging API functions in the Interp class are just dummy stub
3692: * functions. These functions are usually implemented in a subclass of
3693: * Interp (e.g. DbgInterp) that has real debugging support.
3694: *
3695: */
3696:
3697: protected DebugInfo dbg;
3698:
3699: /**
3700: * Initialize the debugging information.
3701: * @return a DebugInfo object used by Interp in non-debugging mode.
3702: */
3703: protected DebugInfo initDebugInfo() {
3704: return new DebugInfo(null, 1);
3705: }
3706:
3707: /**
3708: * Add more more level at the top of the debug stack.
3709: *
3710: * @param fileName the filename for the new stack level
3711: * @param lineNumber the line number at which the execution of the
3712: * new stack level begins.
3713: */
3714: void pushDebugStack(String fileName, int lineNumber) {
3715: // do nothing.
3716: }
3717:
3718: /**
3719: * Remove the top-most level of the debug stack.
3720: */
3721: void popDebugStack() throws TclRuntimeError {
3722: // do nothing
3723: }
3724:
3725: /**
3726: * Returns the name of the script file currently under execution.
3727: *
3728: * @return the name of the script file currently under execution.
3729: */
3730: String getScriptFile() {
3731: return dbg.fileName;
3732: }
3733:
3734: /**
3735: * Returns the line number where the given command argument begins. E.g, if
3736: * the following command is at line 10:
3737: *
3738: * foo {a
3739: * b } c
3740: *
3741: * getArgLine(0) = 10
3742: * getArgLine(1) = 10
3743: * getArgLine(2) = 11
3744: *
3745: * @param index specifies an argument.
3746: * @return the line number of the given argument.
3747: */
3748: int getArgLineNumber(int index) {
3749: return 0;
3750: }
3751:
3752: /*
3753: *-------------------------------------------------------------------------
3754: *
3755: * TclTransferResult -> transferResult
3756: *
3757: * Copy the result (and error information) from one interp to
3758: * another. Used when one interp has caused another interp to
3759: * evaluate a script and then wants to transfer the results back
3760: * to itself.
3761: *
3762: * This routine copies the string reps of the result and error
3763: * information. It does not simply increment the refcounts of the
3764: * result and error information objects themselves.
3765: * It is not legal to exchange objects between interps, because an
3766: * object may be kept alive by one interp, but have an internal rep
3767: * that is only valid while some other interp is alive.
3768: *
3769: * Results:
3770: * The target interp's result is set to a copy of the source interp's
3771: * result. The source's error information "$errorInfo" may be
3772: * appended to the target's error information and the source's error
3773: * code "$errorCode" may be stored in the target's error code.
3774: *
3775: * Side effects:
3776: * None.
3777: *
3778: *-------------------------------------------------------------------------
3779: */
3780:
3781: void transferResult(Interp sourceInterp, // Interp whose result and error information
3782: // should be moved to the target interp.
3783: // After moving result, this interp's result
3784: // is reset.
3785: int result) // TCL.OK if just the result should be copied,
3786: // TCL.ERROR if both the result and error
3787: // information should be copied.
3788: throws TclException {
3789: if (sourceInterp == this ) {
3790: return;
3791: }
3792:
3793: if (result == TCL.ERROR) {
3794: TclObject obj;
3795:
3796: // An error occurred, so transfer error information from the source
3797: // interpreter to the target interpreter. Setting the flags tells
3798: // the target interp that it has inherited a partial traceback
3799: // chain, not just a simple error message.
3800:
3801: if (!sourceInterp.errAlreadyLogged) {
3802: sourceInterp.addErrorInfo("");
3803: }
3804: sourceInterp.errAlreadyLogged = true;
3805:
3806: resetResult();
3807:
3808: obj = sourceInterp.getVar("errorInfo", TCL.GLOBAL_ONLY);
3809: setVar("errorInfo", obj, TCL.GLOBAL_ONLY);
3810:
3811: obj = sourceInterp.getVar("errorCode", TCL.GLOBAL_ONLY);
3812: setVar("errorCode", obj, TCL.GLOBAL_ONLY);
3813:
3814: errInProgress = true;
3815: errCodeSet = true;
3816: }
3817:
3818: returnCode = result;
3819: setResult(sourceInterp.getResult());
3820: sourceInterp.resetResult();
3821:
3822: if (result != TCL.OK) {
3823: throw new TclException(this , getResult().toString(), result);
3824: }
3825: }
3826:
3827: /*
3828: *---------------------------------------------------------------------------
3829: *
3830: * Tcl_HideCommand -> hideCommand
3831: *
3832: * Makes a command hidden so that it cannot be invoked from within
3833: * an interpreter, only from within an ancestor.
3834: *
3835: * Results:
3836: * A standard Tcl result; also leaves a message in the interp's result
3837: * if an error occurs.
3838: *
3839: * Side effects:
3840: * Removes a command from the command table and create an entry
3841: * into the hidden command table under the specified token name.
3842: *
3843: *---------------------------------------------------------------------------
3844: */
3845:
3846: void hideCommand(String cmdName, // Name of command to hide.
3847: String hiddenCmdToken) // Token name of the to-be-hidden command.
3848: throws TclException {
3849: WrappedCommand cmd;
3850:
3851: if (deleted) {
3852: // The interpreter is being deleted. Do not create any new
3853: // structures, because it is not safe to modify the interpreter.
3854: return;
3855: }
3856:
3857: // Disallow hiding of commands that are currently in a namespace or
3858: // renaming (as part of hiding) into a namespace.
3859: //
3860: // (because the current implementation with a single global table
3861: // and the needed uniqueness of names cause problems with namespaces)
3862: //
3863: // we don't need to check for "::" in cmdName because the real check is
3864: // on the nsPtr below.
3865: //
3866: // hiddenCmdToken is just a string which is not interpreted in any way.
3867: // It may contain :: but the string is not interpreted as a namespace
3868: // qualifier command name. Thus, hiding foo::bar to foo::bar and then
3869: // trying to expose or invoke ::foo::bar will NOT work; but if the
3870: // application always uses the same strings it will get consistent
3871: // behaviour.
3872: //
3873: // But as we currently limit ourselves to the global namespace only
3874: // for the source, in order to avoid potential confusion,
3875: // lets prevent "::" in the token too. --dl
3876:
3877: if (hiddenCmdToken.indexOf("::") >= 0) {
3878: throw new TclException(this ,
3879: "cannot use namespace qualifiers as "
3880: + "hidden commandtoken (rename)");
3881: }
3882:
3883: // Find the command to hide. An error is returned if cmdName can't
3884: // be found. Look up the command only from the global namespace.
3885: // Full path of the command must be given if using namespaces.
3886:
3887: cmd = Namespace.findCommand(this , cmdName, null,
3888: /*flags*/TCL.LEAVE_ERR_MSG | TCL.GLOBAL_ONLY);
3889:
3890: // Check that the command is really in global namespace
3891:
3892: if (cmd.ns != globalNs) {
3893: throw new TclException(this ,
3894: "can only hide global namespace commands"
3895: + " (use rename then hide)");
3896: }
3897:
3898: // Initialize the hidden command table if necessary.
3899:
3900: if (hiddenCmdTable == null) {
3901: hiddenCmdTable = new HashMap();
3902: }
3903:
3904: // It is an error to move an exposed command to a hidden command with
3905: // hiddenCmdToken if a hidden command with the name hiddenCmdToken already
3906: // exists.
3907:
3908: if (hiddenCmdTable.containsKey(hiddenCmdToken)) {
3909: throw new TclException(this , "hidden command named \""
3910: + hiddenCmdToken + "\" already exists");
3911: }
3912:
3913: // Nb : This code is currently 'like' a rename to a specialy set apart
3914: // name table. Changes here and in TclRenameCommand must
3915: // be kept in synch untill the common parts are actually
3916: // factorized out.
3917:
3918: // Remove the hash entry for the command from the interpreter command
3919: // table. This is like deleting the command, so bump its command epoch;
3920: // this invalidates any cached references that point to the command.
3921:
3922: if (cmd.table.containsKey(cmd.hashKey)) {
3923: cmd.table.remove(cmd.hashKey);
3924: cmd.incrEpoch();
3925: }
3926:
3927: // Now link the hash table entry with the command structure.
3928: // We ensured above that the nsPtr was right.
3929:
3930: cmd.table = hiddenCmdTable;
3931: cmd.hashKey = hiddenCmdToken;
3932: hiddenCmdTable.put(hiddenCmdToken, cmd);
3933: }
3934:
3935: /*
3936: *----------------------------------------------------------------------
3937: *
3938: * Tcl_ExposeCommand -> exposeCommand
3939: *
3940: * Makes a previously hidden command callable from inside the
3941: * interpreter instead of only by its ancestors.
3942: *
3943: * Results:
3944: * A standard Tcl result. If an error occurs, a message is left
3945: * in the interp's result.
3946: *
3947: * Side effects:
3948: * Moves commands from one hash table to another.
3949: *
3950: *----------------------------------------------------------------------
3951: */
3952:
3953: void exposeCommand(String hiddenCmdToken, // Token name of the to-be-hidden command.
3954: String cmdName) // Name of command to hide.
3955: throws TclException {
3956: WrappedCommand cmd;
3957:
3958: if (deleted) {
3959: // The interpreter is being deleted. Do not create any new
3960: // structures, because it is not safe to modify the interpreter.
3961: return;
3962: }
3963:
3964: // Check that we have a regular name for the command
3965: // (that the user is not trying to do an expose and a rename
3966: // (to another namespace) at the same time)
3967:
3968: if (cmdName.indexOf("::") >= 0) {
3969: throw new TclException(this ,
3970: "can not expose to a namespace "
3971: + "(use expose to toplevel, then rename)");
3972: }
3973:
3974: // Get the command from the hidden command table:
3975:
3976: if (hiddenCmdTable == null
3977: || !hiddenCmdTable.containsKey(hiddenCmdToken)) {
3978: throw new TclException(this , "unknown hidden command \""
3979: + hiddenCmdToken + "\"");
3980: }
3981: cmd = (WrappedCommand) hiddenCmdTable.get(hiddenCmdToken);
3982:
3983: // Check that we have a true global namespace
3984: // command (enforced by Tcl_HideCommand() but let's double
3985: // check. (If it was not, we would not really know how to
3986: // handle it).
3987:
3988: if (cmd.ns != globalNs) {
3989:
3990: // This case is theoritically impossible,
3991: // we might rather panic() than 'nicely' erroring out ?
3992:
3993: throw new TclException(this , "trying to expose "
3994: + "a non global command name space command");
3995: }
3996:
3997: // This is the global table
3998: Namespace ns = cmd.ns;
3999:
4000: // It is an error to overwrite an existing exposed command as a result
4001: // of exposing a previously hidden command.
4002:
4003: if (ns.cmdTable.containsKey(cmdName)) {
4004: throw new TclException(this , "exposed command \"" + cmdName
4005: + "\" already exists");
4006: }
4007:
4008: // Remove the hash entry for the command from the interpreter hidden
4009: // command table.
4010:
4011: if (cmd.hashKey != null) {
4012: cmd.table.remove(cmd.hashKey);
4013: cmd.table = ns.cmdTable;
4014: cmd.hashKey = cmdName;
4015: }
4016:
4017: // Now link the hash table entry with the command structure.
4018: // This is like creating a new command, so deal with any shadowing
4019: // of commands in the global namespace.
4020:
4021: ns.cmdTable.put(cmdName, cmd);
4022:
4023: // Not needed as we are only in the global namespace
4024: // (but would be needed again if we supported namespace command hiding)
4025:
4026: // TclResetShadowedCmdRefs(interp, cmdPtr);
4027: }
4028:
4029: /**
4030: *----------------------------------------------------------------------
4031: *
4032: * TclHideUnsafeCommands -> hideUnsafeCommands
4033: *
4034: * Hides base commands that are not marked as safe from this
4035: * interpreter.
4036: *
4037: * Results:
4038: * None
4039: *
4040: * Side effects:
4041: * Hides functionality in an interpreter.
4042: *
4043: *----------------------------------------------------------------------
4044: */
4045:
4046: void hideUnsafeCommands() throws TclException {
4047: for (int ix = 0; ix < unsafeCmds.length; ix++) {
4048: try {
4049: hideCommand(unsafeCmds[ix], unsafeCmds[ix]);
4050: } catch (TclException e) {
4051: if (!e.getMessage().startsWith("unknown command")) {
4052: throw e;
4053: }
4054: }
4055: }
4056: }
4057:
4058: /*
4059: *----------------------------------------------------------------------
4060: *
4061: * TclObjInvokeGlobal -> invokeGlobal
4062: *
4063: * Invokes a Tcl command, given an objv/objc, from either the
4064: * exposed or hidden set of commands in the given interpreter.
4065: * NOTE: The command is invoked in the global stack frame of the
4066: * interpreter, thus it cannot see any current state on the
4067: * stack of that interpreter.
4068: *
4069: * Results:
4070: * A standard Tcl result.
4071: *
4072: * Side effects:
4073: * Whatever the command does.
4074: *
4075: *----------------------------------------------------------------------
4076: */
4077:
4078: int invokeGlobal(TclObject[] objv, // Argument objects; objv[0] points to the
4079: // name of the command to invoke.
4080: int flags) // Combination of flags controlling the call:
4081: // INVOKE_HIDDEN,_INVOKE_NO_UNKNOWN,
4082: // or INVOKE_NO_TRACEBACK.
4083: throws TclException {
4084: CallFrame savedVarFrame = varFrame;
4085:
4086: try {
4087: varFrame = null;
4088: return invoke(objv, flags);
4089: } finally {
4090: varFrame = savedVarFrame;
4091: }
4092: }
4093:
4094: /*
4095: *----------------------------------------------------------------------
4096: *
4097: * TclObjInvoke -> invoke
4098: *
4099: * Invokes a Tcl command, given an objv/objc, from either the
4100: * exposed or the hidden sets of commands in the given interpreter.
4101: *
4102: * Results:
4103: * A standard Tcl object result.
4104: *
4105: * Side effects:
4106: * Whatever the command does.
4107: *
4108: *----------------------------------------------------------------------
4109: */
4110:
4111: int invoke(TclObject[] objv, // Argument objects; objv[0] points to the
4112: // name of the command to invoke.
4113: int flags) // Combination of flags controlling the call:
4114: // INVOKE_HIDDEN,_INVOKE_NO_UNKNOWN,
4115: // or INVOKE_NO_TRACEBACK.
4116: throws TclException {
4117: if ((objv.length < 1) || (objv == null)) {
4118: throw new TclException(this , "illegal argument vector");
4119: }
4120:
4121: ready();
4122:
4123: String cmdName = objv[0].toString();
4124: WrappedCommand cmd;
4125: TclObject localObjv[] = null;
4126:
4127: if ((flags & INVOKE_HIDDEN) != 0) {
4128:
4129: // We never invoke "unknown" for hidden commands.
4130:
4131: if (hiddenCmdTable == null
4132: || !hiddenCmdTable.containsKey(cmdName)) {
4133: throw new TclException(this ,
4134: "invalid hidden command name \"" + cmdName
4135: + "\"");
4136: }
4137: cmd = (WrappedCommand) hiddenCmdTable.get(cmdName);
4138: } else {
4139: cmd = Namespace.findCommand(this , cmdName, null,
4140: TCL.GLOBAL_ONLY);
4141: if (cmd == null) {
4142: if ((flags & INVOKE_NO_UNKNOWN) == 0) {
4143: cmd = Namespace.findCommand(this , "unknown", null,
4144: TCL.GLOBAL_ONLY);
4145: if (cmd != null) {
4146: localObjv = new TclObject[objv.length + 1];
4147: localObjv[0] = TclString.newInstance("unknown");
4148: localObjv[0].preserve();
4149: for (int i = 0; i < objv.length; i++) {
4150: localObjv[i + 1] = objv[i];
4151: }
4152: objv = localObjv;
4153: }
4154: }
4155:
4156: // Check again if we found the command. If not, "unknown" is
4157: // not present and we cannot help, or the caller said not to
4158: // call "unknown" (they specified TCL_INVOKE_NO_UNKNOWN).
4159:
4160: if (cmd == null) {
4161: throw new TclException(this ,
4162: "invalid command name \"" + cmdName + "\"");
4163: }
4164: }
4165: }
4166:
4167: // Invoke the command procedure. First reset the interpreter's string
4168: // and object results to their default empty values since they could
4169: // have gotten changed by earlier invocations.
4170:
4171: resetResult();
4172: cmdCount++;
4173:
4174: int result = TCL.OK;
4175: try {
4176: cmd.cmd.cmdProc(this , objv);
4177: } catch (TclException e) {
4178: result = e.getCompletionCode();
4179: }
4180:
4181: // If we invoke a procedure, which was implemented as AutoloadStub,
4182: // it was entered into the ordinary cmdTable. But here we know
4183: // for sure, that this command belongs into the hiddenCmdTable.
4184: // So if we can find an entry in cmdTable with the cmdName, just
4185: // move it into the hiddenCmdTable.
4186:
4187: if ((flags & INVOKE_HIDDEN) != 0) {
4188: cmd = Namespace.findCommand(this , cmdName, null,
4189: TCL.GLOBAL_ONLY);
4190: if (cmd != null) {
4191: // Basically just do the same as in hideCommand...
4192: cmd.table.remove(cmd.hashKey);
4193: cmd.table = hiddenCmdTable;
4194: cmd.hashKey = cmdName;
4195: hiddenCmdTable.put(cmdName, cmd);
4196: }
4197: }
4198:
4199: // If an error occurred, record information about what was being
4200: // executed when the error occurred.
4201:
4202: if ((result == TCL.ERROR)
4203: && ((flags & INVOKE_NO_TRACEBACK) == 0)
4204: && !errAlreadyLogged) {
4205: StringBuffer ds;
4206:
4207: if (errInProgress) {
4208: ds = new StringBuffer("\n while invoking\n\"");
4209: } else {
4210: ds = new StringBuffer("\n invoked from within\n\"");
4211: }
4212: for (int i = 0; i < objv.length; i++) {
4213: ds.append(objv[i].toString());
4214: if (i < (objv.length - 1)) {
4215: ds.append(" ");
4216: } else if (ds.length() > 100) {
4217: ds.append("...");
4218: break;
4219: }
4220: }
4221: ds.append("\"");
4222: addErrorInfo(ds.toString());
4223: errInProgress = true;
4224: }
4225:
4226: // Free any locally allocated storage used to call "unknown".
4227:
4228: if (localObjv != null) {
4229: localObjv[0].release();
4230: }
4231:
4232: return result;
4233: }
4234:
4235: /*
4236: *----------------------------------------------------------------------
4237: *
4238: * Tcl_AllowExceptions -> allowExceptions
4239: *
4240: * Sets a flag in an interpreter so that exceptions can occur
4241: * in the next call to Tcl_Eval without them being turned into
4242: * errors.
4243: *
4244: * Results:
4245: * None.
4246: *
4247: * Side effects:
4248: * The TCL_ALLOW_EXCEPTIONS flag gets set in the interpreter's
4249: * evalFlags structure. See the reference documentation for
4250: * more details.
4251: *
4252: *----------------------------------------------------------------------
4253: */
4254:
4255: void allowExceptions() {
4256: evalFlags |= Parser.TCL_ALLOW_EXCEPTIONS;
4257: }
4258:
4259: class ResolverScheme {
4260: String name; // Name identifying this scheme.
4261: Resolver resolver;
4262:
4263: ResolverScheme(String name, Resolver resolver) {
4264: this .name = name;
4265: this .resolver = resolver;
4266: }
4267: }
4268:
4269: /**
4270: *----------------------------------------------------------------------
4271: *
4272: * Tcl_AddInterpResolvers -> addInterpResolver
4273: *
4274: * Adds a set of command/variable resolution procedures to an
4275: * interpreter. These procedures are consulted when commands
4276: * are resolved in Namespace.findCommand, and when variables are
4277: * resolved in Namespace.findNamespaceVar and thus Var.lookupVar.
4278: * Each namespace may also have its own resolution object
4279: * which take precedence over those for the interpreter.
4280: *
4281: * When a name is resolved, it is handled as follows. First,
4282: * the name is passed to the resolution objects for the
4283: * namespace. If not resolved, the name is passed to each of
4284: * the resolution procedures added to the interpreter. Finally,
4285: * if still not resolved, the name is handled using the default
4286: * Tcl rules for name resolution.
4287: *
4288: * Results:
4289: * None.
4290: *
4291: * Side effects:
4292: * The list of resolvers of the given interpreter is modified.
4293: *
4294: *----------------------------------------------------------------------
4295: */
4296:
4297: public void addInterpResolver(String name, // Name of this resolution scheme.
4298: Resolver resolver) // Object to resolve commands/variables.
4299: {
4300: ResolverScheme res;
4301:
4302: // Look for an existing scheme with the given name.
4303: // If found, then replace its rules.
4304:
4305: if (resolvers != null) {
4306: for (ListIterator iter = resolvers.listIterator(); iter
4307: .hasNext();) {
4308: res = (ResolverScheme) iter.next();
4309: if (name.equals(res.name)) {
4310: res.resolver = resolver;
4311: return;
4312: }
4313: }
4314: }
4315:
4316: if (resolvers == null) {
4317: resolvers = new ArrayList();
4318: }
4319:
4320: // Otherwise, this is a new scheme. Add it to the FRONT
4321: // of the linked list, so that it overrides existing schemes.
4322:
4323: res = new ResolverScheme(name, resolver);
4324:
4325: resolvers.add(0, res);
4326: }
4327:
4328: /**
4329: *----------------------------------------------------------------------
4330: *
4331: * Tcl_GetInterpResolvers -> getInterpResolver
4332: *
4333: * Looks for a set of command/variable resolution procedures with
4334: * the given name in an interpreter. These procedures are
4335: * registered by calling addInterpResolver.
4336: *
4337: * Results:
4338: * If the name is recognized, this procedure returns the object
4339: * implementing the name resolution procedures.
4340: * If the name is not recognized, this procedure returns null.
4341: *
4342: * Side effects:
4343: * None.
4344: *
4345: *----------------------------------------------------------------------
4346: */
4347:
4348: public Resolver getInterpResolver(String name) // Look for a scheme with this name.
4349: {
4350: ResolverScheme res;
4351: Enumeration e;
4352:
4353: // Look for an existing scheme with the given name. If found,
4354: // then return pointers to its procedures.
4355:
4356: if (resolvers != null) {
4357: for (ListIterator iter = resolvers.listIterator(); iter
4358: .hasNext();) {
4359: res = (ResolverScheme) iter.next();
4360: if (name.equals(res.name)) {
4361: return res.resolver;
4362: }
4363: }
4364: }
4365:
4366: return null;
4367: }
4368:
4369: /**
4370: *----------------------------------------------------------------------
4371: *
4372: * Tcl_RemoveInterpResolvers -> removeInterpResolver
4373: *
4374: * Removes a set of command/variable resolution procedures
4375: * previously added by addInterpResolver. The next time
4376: * a command/variable name is resolved, these procedures
4377: * won't be consulted.
4378: *
4379: * Results:
4380: * Returns true if the name was recognized and the
4381: * resolution scheme was deleted. Returns false otherwise.
4382: *
4383: * Side effects:
4384: * The list of resolvers of the given interpreter may be modified.
4385: *
4386: *----------------------------------------------------------------------
4387: */
4388:
4389: public boolean removeInterpResolver(String name) // Name of the scheme to be removed.
4390: {
4391: ResolverScheme res;
4392: boolean found = false;
4393:
4394: // Look for an existing scheme with the given name.
4395:
4396: if (resolvers != null) {
4397: for (ListIterator iter = resolvers.listIterator(); iter
4398: .hasNext();) {
4399: res = (ResolverScheme) iter.next();
4400: if (name.equals(res.name)) {
4401: found = true;
4402: break;
4403: }
4404: }
4405: }
4406:
4407: // If we found the scheme, delete it.
4408:
4409: if (found) {
4410: int index = resolvers.indexOf(name);
4411: if (index == -1) {
4412: throw new TclRuntimeError("name " + name
4413: + " not found in resolvers");
4414: }
4415: resolvers.remove(index);
4416: }
4417:
4418: return found;
4419: }
4420:
4421: /**
4422: *----------------------------------------------------------------------
4423: *
4424: * checkCommonInteger()
4425: *
4426: * If a given integer value is in the common value pool
4427: * then return a shared object for that integer. If the
4428: * integer value is not in the common pool then use to
4429: * use the recycled int value or a new TclObject.
4430: *
4431: *----------------------------------------------------------------------
4432: */
4433:
4434: final TclObject checkCommonInteger(int value) {
4435: if (VALIDATE_SHARED_RESULTS) {
4436: TclObject[] objv = { m_minusoneIntegerResult,
4437: m_zeroIntegerResult, m_oneIntegerResult,
4438: m_twoIntegerResult };
4439: for (int i = 0; i < objv.length; i++) {
4440: TclObject obj = objv[i];
4441: if (!obj.isShared()) {
4442: throw new TclRuntimeError("ref count error: "
4443: + "integer constant for " + obj.toString()
4444: + " should be shared but refCount was "
4445: + obj.getRefCount());
4446: }
4447: }
4448: }
4449:
4450: switch (value) {
4451: case -1: {
4452: return m_minusoneIntegerResult;
4453: }
4454: case 0: {
4455: return m_zeroIntegerResult;
4456: }
4457: case 1: {
4458: return m_oneIntegerResult;
4459: }
4460: case 2: {
4461: return m_twoIntegerResult;
4462: }
4463: default: {
4464: if ((recycledI.getRefCount() == 1)
4465: || ((recycledI.getRefCount() == 2) && (recycledI == m_result))) {
4466: // If (refCount == 1) then interp result
4467: // is not recycledI and nobody else holds a ref,
4468: // so we can modify recycledI.
4469:
4470: // If (refCount == 2) and this object is the
4471: // interp result then we can modify recycledI.
4472:
4473: recycledI.setRecycledIntValue(value);
4474: } else {
4475: // This logic is executed when some other
4476: // code holds a ref to recycledI. This
4477: // can happen when recycledI's refCount
4478: // is (refCount > 2) or (refCount == 2)
4479: // but the result is not recycledI.
4480: // If (refCount == 0) then release()
4481: // will raise an exception.
4482:
4483: recycledI.release();
4484: recycledI = TclInteger.newInstance(value);
4485: recycledI.preserve();
4486: }
4487:
4488: if (VALIDATE_SHARED_RESULTS) {
4489: if (!((recycledI.getRefCount() == 1) || (recycledI
4490: .getRefCount() == 2))) {
4491: throw new TclRuntimeError(
4492: "ref count error: "
4493: + "recycledI refCount should be 1 or 2, it was "
4494: + recycledI.getRefCount());
4495: }
4496: }
4497:
4498: return recycledI;
4499: }
4500: }
4501: }
4502:
4503: /**
4504: *----------------------------------------------------------------------
4505: *
4506: * checkCommonDouble()
4507: *
4508: * If a given double value is in the common value pool
4509: * the return a shared object for that double. If the
4510: * double value is not in the common pool then a new
4511: * TclDouble wrapped in a TclObject will be created.
4512: *
4513: *----------------------------------------------------------------------
4514: */
4515:
4516: final TclObject checkCommonDouble(double value) {
4517: if (VALIDATE_SHARED_RESULTS) {
4518: TclObject[] objv = { m_zeroDoubleResult,
4519: m_onehalfDoubleResult, m_oneDoubleResult,
4520: m_twoDoubleResult };
4521: for (int i = 0; i < objv.length; i++) {
4522: TclObject obj = objv[i];
4523: if (!obj.isShared()) {
4524: throw new TclRuntimeError("ref count error: "
4525: + "double constant for " + obj.toString()
4526: + " should be shared but refCount was "
4527: + obj.getRefCount());
4528: }
4529: }
4530: }
4531:
4532: if (value == 0.0) {
4533: return m_zeroDoubleResult;
4534: } else if (value == 0.5) {
4535: return m_onehalfDoubleResult;
4536: } else if (value == 1.0) {
4537: return m_oneDoubleResult;
4538: } else if (value == 2.0) {
4539: return m_twoDoubleResult;
4540: } else {
4541: if ((recycledD.getRefCount() == 1)
4542: || ((recycledD.getRefCount() == 2) && (recycledD == m_result))) {
4543: // If (refCount == 1) then interp result
4544: // is not recycledD and nobody else holds a ref,
4545: // so we can modify recycledD.
4546:
4547: // If (refCount == 2) and this object is the
4548: // interp result then we can modify recycledD.
4549:
4550: recycledD.setRecycledDoubleValue(value);
4551: } else {
4552: // This logic is executed when some other
4553: // code holds a ref to recycledD. This
4554: // can happen when recycledD's refCount
4555: // is (refCount > 2) or (refCount == 2)
4556: // but the result is not recycledD.
4557: // If (refCount == 0) then release()
4558: // will raise an exception.
4559:
4560: recycledD.release();
4561: recycledD = TclDouble.newInstance(value);
4562: recycledD.preserve();
4563: }
4564:
4565: if (VALIDATE_SHARED_RESULTS) {
4566: if (!((recycledD.getRefCount() == 1) || (recycledD
4567: .getRefCount() == 2))) {
4568: throw new TclRuntimeError(
4569: "ref count error: "
4570: + "recycledD refCount should be 1 or 2, it was "
4571: + recycledD.getRefCount());
4572: }
4573: }
4574:
4575: return recycledD;
4576: }
4577: }
4578:
4579: /**
4580: *----------------------------------------------------------------------
4581: *
4582: * checkCommonBoolean()
4583: *
4584: * Always return a shared boolean TclObject.
4585: *
4586: *----------------------------------------------------------------------
4587: */
4588:
4589: final TclObject checkCommonBoolean(boolean value) {
4590: if (VALIDATE_SHARED_RESULTS) {
4591: TclObject[] objv = { m_trueBooleanResult,
4592: m_falseBooleanResult };
4593: for (int i = 0; i < objv.length; i++) {
4594: TclObject obj = objv[i];
4595: if (!obj.isShared()) {
4596: throw new TclRuntimeError("ref count error: "
4597: + "boolean constant for " + obj.toString()
4598: + " should be shared but refCount was "
4599: + obj.getRefCount());
4600: }
4601: }
4602: }
4603:
4604: return (value ? m_trueBooleanResult : m_falseBooleanResult);
4605: }
4606:
4607: /**
4608: *----------------------------------------------------------------------
4609: *
4610: * checkCommonString()
4611: *
4612: * If a given String value is in the common value pool
4613: * the return a shared object for that String. If the
4614: * String value is not in the common pool then a new
4615: * TclString wrapped in a TclObject will be created.
4616: *
4617: *----------------------------------------------------------------------
4618: */
4619:
4620: final TclObject checkCommonString(String value) {
4621: if (value == null || value == "" || value.length() == 0) {
4622: if (VALIDATE_SHARED_RESULTS) {
4623: if (!m_nullResult.isShared()) {
4624: throw new TclRuntimeError(
4625: "ref count error: "
4626: + "empty string constant should be shared but refCount was "
4627: + m_nullResult.getRefCount());
4628: }
4629: }
4630: return m_nullResult;
4631: } else {
4632: return TclString.newInstance(value);
4633: }
4634: }
4635:
4636: /**
4637: *----------------------------------------------------------------------
4638: *
4639: * checkCommonCharacter()
4640: *
4641: * It is very common to create a TclObject that contains
4642: * a single character. It can be costly to allocate a
4643: * TclObject, a TclString internal rep, and a String
4644: * to represent a character. This method avoids that
4645: * overhead for the most common characters. This method
4646: * will return null if a character does not have a
4647: * cached value.
4648: *
4649: *----------------------------------------------------------------------
4650: */
4651:
4652: final TclObject checkCommonCharacter(int c) {
4653: if ((c <= 0) || (c >= m_charCommonMax)) {
4654: return null;
4655: }
4656: if (VALIDATE_SHARED_RESULTS) {
4657: if ((m_charCommon[c] != null)
4658: && !m_charCommon[c].isShared()) {
4659: throw new TclRuntimeError("ref count error: "
4660: + "common character for '" + c
4661: + "' is not shared");
4662: }
4663: }
4664: return m_charCommon[c];
4665: }
4666:
4667: /*
4668: *----------------------------------------------------------------------
4669: *
4670: * getErrorLine --
4671: *
4672: * Query the interp.errorLine member. This is like accessing
4673: * the public Tcl_Interp.errorLine field in the C impl.
4674: * this method should be used by classes outside the
4675: * tcl.lang package.
4676: *
4677: * Results:
4678: * None.
4679: *
4680: * Side effects:
4681: * None.
4682: *
4683: *----------------------------------------------------------------------
4684: */
4685:
4686: public int getErrorLine() {
4687: return errorLine;
4688: }
4689:
4690: /*
4691: *----------------------------------------------------------------------
4692: *
4693: * getClassLoader --
4694: *
4695: * Get the TclClassLoader used for the interp. This
4696: * class loader delagates to the context class loader
4697: * which delagates to the system class loader.
4698: * The TclClassLoader will read classes and resources
4699: * from the env(TCL_CLASSPATH).
4700: *
4701: * Results:
4702: * This method will return the classloader in use,
4703: * it will never return null.
4704: *
4705: * Side effects:
4706: * None.
4707: *
4708: *----------------------------------------------------------------------
4709: */
4710:
4711: public ClassLoader getClassLoader() {
4712: // Allocate a TclClassLoader that will delagate to the
4713: // context class loader and then search on the
4714: // env(TCL_CLASSPATH) for classes.
4715:
4716: if (classLoader == null) {
4717: classLoader = new TclClassLoader(this , null, Thread
4718: .currentThread().getContextClassLoader()
4719: //Interp.class.getClassLoader()
4720: );
4721: }
4722: return classLoader;
4723: }
4724:
4725: /*
4726: *----------------------------------------------------------------------
4727: *
4728: * getResourceAsStream --
4729: *
4730: * Resolve a resource name into an InputStream. This method
4731: * will search for a resource using the TclClassLoader.
4732: * This method will return null if a resource can't be found.
4733: *
4734: * Results:
4735: * None.
4736: *
4737: * Side effects:
4738: * None.
4739: *
4740: *----------------------------------------------------------------------
4741: */
4742:
4743: InputStream getResourceAsStream(String resName) {
4744: if (classLoader == null) {
4745: getClassLoader();
4746: }
4747:
4748: try {
4749: // Search for resource using TclClassLoader. This
4750: // will search on the CLASSPATH, then with the
4751: // context loader (if there is one), and then on
4752: // the env(TCL_CLASSPATH).
4753:
4754: return classLoader.getResourceAsStream(resName);
4755: } catch (PackageNameException e) {
4756: // Failed attempt to load resource with java or tcl prefix.
4757:
4758: return null;
4759: } catch (SecurityException e) {
4760: // Resource loading does not work in an applet, and Jacl
4761: // has never really worked as an applet anyway.
4762:
4763: return null;
4764: }
4765: }
4766:
4767: /*
4768: *----------------------------------------------------------------------
4769: *
4770: * setInterrupted --
4771: *
4772: * Invoke this method to indicate that an executing interp
4773: * should be interrupted at the next safe moment. Interrupting
4774: * a running interpreter will unwind the stack by throwing
4775: * an exception. This method can safely be called from a
4776: * thread other than the one processsing events. No explicit
4777: * synchronization is needed. Once a thread has been interrupted
4778: * or disposed of, setInterrupted() calls will do nothing.
4779: *
4780: * Results:
4781: * Stops execution of the Interp via an Exception.
4782: *
4783: * Side effects:
4784: * None.
4785: *
4786: *----------------------------------------------------------------------
4787: */
4788:
4789: public void setInterrupted() {
4790: if (deleted || (interruptedEvent != null)) {
4791: // This interpreter was interrupted already. Do nothing and
4792: // return right away. This logic handles the case of an
4793: // interpreter that was already disposed of because of a
4794: // previous interrupted event.
4795: //
4796: // The disposed check avoids a race condition between a
4797: // timeout thread that will interrupt an interp and the
4798: // main thread that could interrupt and then dispose
4799: // of the interp. The caller of this method has no way
4800: // to check if the interp has been disposed of, so this
4801: // method needs to no-op on an already deleted interp.
4802:
4803: return;
4804: }
4805:
4806: TclInterruptedExceptionEvent ie = new TclInterruptedExceptionEvent(
4807: this );
4808:
4809: // Set the interruptedEvent field in the Interp. It is possible
4810: // that a race condition between two threads could cause
4811: // multiple assignments of the interruptedEvent field to
4812: // overwrite each other. Give up if the assignment was overwritten
4813: // so that only one thread continues to execute.
4814:
4815: interruptedEvent = ie;
4816:
4817: if (interruptedEvent != ie) {
4818: return;
4819: }
4820:
4821: // Queue up an event that will generate a TclInterruptedException
4822: // the next time events from the Tcl event queue are processed.
4823: // If an eval returns and invokes checkInterrupted() before
4824: // the event loop is entered, then this event will be canceled.
4825: // The getNotifier() method should never return null since
4826: // the deleted flag was already checked above.
4827:
4828: getNotifier().queueEvent(interruptedEvent, TCL.QUEUE_TAIL);
4829: }
4830:
4831: /*
4832: *----------------------------------------------------------------------
4833: *
4834: * checkInterrupted --
4835: *
4836: * This method is invoked after an eval operation to check
4837: * if a running interp has been marked as interrupted.
4838: * This method is not public since it should only be
4839: * used by the Jacl internal implementation.
4840: *
4841: * Results:
4842: * This method will raise a TclInterruptedException if
4843: * the Interp.setInterrupted() method was invoked for
4844: * this interp. This method will only raise a
4845: * TclInterruptedException once.
4846: *
4847: * Side effects:
4848: * None.
4849: *
4850: *----------------------------------------------------------------------
4851: */
4852:
4853: final void checkInterrupted() {
4854: if ((interruptedEvent != null)
4855: && (!interruptedEvent.exceptionRaised)) {
4856: // Note that the interruptedEvent in not removed from the
4857: // event queue since all queued events should be removed
4858: // from the queue in the disposeInterrupted() method.
4859:
4860: interruptedEvent.exceptionRaised = true;
4861:
4862: throw new TclInterruptedException(this );
4863: }
4864: }
4865:
4866: /*
4867: *----------------------------------------------------------------------
4868: *
4869: * disposeInterrupted --
4870: *
4871: * This method is invoked to cleanup an Interp object that
4872: * has been interrupted and had its stack unwound. This method
4873: * will remove any pending events from the Tcl event queue and
4874: * then invoke the dispose() method for this interp. The interp
4875: * object should not be used after this method has finished.
4876: * This method must only ever be invoked after catching
4877: * a TclInterrupted exception at the outermost level of
4878: * the Tcl event processing loop.
4879: *
4880: *----------------------------------------------------------------------
4881: */
4882:
4883: final void disposeInterrupted() {
4884: final boolean debug = false;
4885:
4886: if (deleted) {
4887: final String msg = "Interp.disposeInterrupted() invoked for "
4888: + "a deleted interp";
4889:
4890: if (debug) {
4891: System.out.println(msg);
4892: }
4893:
4894: throw new TclRuntimeError(msg);
4895: }
4896:
4897: if (interruptedEvent == null) {
4898: final String msg = "Interp.disposeInterrupted() invoked for "
4899: + "an interp that was not interrupted via setInterrupted()";
4900:
4901: if (debug) {
4902: System.out.println(msg);
4903: }
4904:
4905: throw new TclRuntimeError(msg);
4906: }
4907:
4908: // If the interruptedEvent has not been processed yet,
4909: // then remove it from the Tcl event queue.
4910:
4911: if ((interruptedEvent != null)
4912: && !interruptedEvent.wasProcessed) {
4913: getNotifier().deleteEvents(interruptedEvent);
4914: }
4915:
4916: if (debug) {
4917: if (interruptedEvent == null) {
4918: System.out.println("interruptedEvent was null");
4919: } else if (interruptedEvent.wasProcessed) {
4920: System.out
4921: .println("interruptedEvent was processed already");
4922: } else {
4923: System.out
4924: .println("interruptedEvent has not been processed, removed from queue");
4925: }
4926: }
4927:
4928: // Remove each after event from the Tcl event queue.
4929: // It is not possible to remove events from the Tcl
4930: // event queue directly since an event does not
4931: // know which interp it was registered for. This
4932: // logic loops of pending after events and deletes
4933: // each one from the Tcl event queue. Note that
4934: // an interrupted interp only raises the interrupted
4935: // exception once, so it is legal to execute Tcl code
4936: // here to cleanup after events.
4937:
4938: try {
4939: if (debug) {
4940: System.out.println("eval: after info");
4941: }
4942:
4943: eval("after info", 0);
4944: TclObject tobj = getResult();
4945: tobj.preserve();
4946: int len = TclList.getLength(this , tobj);
4947: for (int i = 0; i < len; i++) {
4948: TclObject evt = TclList.index(this , tobj, i);
4949: String cmd = "after cancel " + evt;
4950: if (debug) {
4951: System.out.println("eval: " + cmd);
4952: }
4953: eval(cmd, 0);
4954: }
4955: tobj.release();
4956: } catch (TclException te) {
4957: if (debug) {
4958: te.printStackTrace(System.err);
4959: }
4960: }
4961:
4962: // Actually dispose of the interp. After this dispose
4963: // call is invoked, it should not be possible to invoke
4964: // commands in this interp.
4965:
4966: if (debug) {
4967: System.out.println("Invoking Interp.dispose()");
4968: }
4969:
4970: dispose();
4971: }
4972:
4973: /*
4974: *----------------------------------------------------------------------
4975: *
4976: * toString --
4977: *
4978: * Debug print info about the interpreter.
4979: *
4980: *----------------------------------------------------------------------
4981: */
4982:
4983: public String toString() {
4984: StringBuffer buffer = new StringBuffer();
4985:
4986: String info = super .toString();
4987:
4988: // Trim "tcl.lang.Interp@9b688e" to "Interp@9b688e"
4989:
4990: if (info.startsWith("tcl.lang.Interp")) {
4991: info = info.substring(9);
4992: }
4993:
4994: buffer.append(info);
4995: buffer.append(' ');
4996: buffer.append("allocated in \"" + cThreadName + "\"");
4997:
4998: return buffer.toString();
4999: }
5000:
5001: } // end Interp
|