diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 600 | ||||
| -rw-r--r-- | generic/tclCompExpr.c | 559 | ||||
| -rw-r--r-- | generic/tclCompile.h | 56 |
3 files changed, 663 insertions, 552 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d22b949..db13fe6 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.230 2006/12/12 17:21:41 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.231 2006/12/13 16:28:06 dkf Exp $ */ #include "tclInt.h" @@ -49,49 +49,46 @@ typedef struct OldMathFuncData { * Static functions in this file: */ -static char * CallCommandTraces (Interp *iPtr, Command *cmdPtr, +static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, CONST char *oldName, CONST char* newName, int flags); -static int CheckDoubleResult (Tcl_Interp *interp, double dResult); -static void DeleteInterpProc (Tcl_Interp *interp); +static int CheckDoubleResult(Tcl_Interp *interp, double dResult); +static void DeleteInterpProc(Tcl_Interp *interp); static void DeleteOpCmdClientData(ClientData clientData); -static void ProcessUnexpectedResult (Tcl_Interp *interp, int returnCode); - -static int OldMathFuncProc (ClientData clientData, Tcl_Interp *interp, +static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); +static int OldMathFuncProc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); - -static void OldMathFuncDeleteProc (ClientData clientData); - -static int ExprAbsFunc (ClientData clientData, Tcl_Interp *interp, +static void OldMathFuncDeleteProc(ClientData clientData); +static int ExprAbsFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprBinaryFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprBinaryFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprBoolFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprBoolFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprCeilFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprCeilFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprDoubleFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprDoubleFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprEntierFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprEntierFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprFloorFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprFloorFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprIntFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprIntFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprIsqrtFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprIsqrtFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprRandFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprRandFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprRoundFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprRoundFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprSqrtFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprSqrtFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprSrandFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprSrandFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprUnaryFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprUnaryFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static int ExprWideFunc (ClientData clientData, Tcl_Interp *interp, +static int ExprWideFunc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv); -static void MathFuncWrongNumArgs (Tcl_Interp* interp, int expected, +static void MathFuncWrongNumArgs(Tcl_Interp* interp, int expected, int actual, Tcl_Obj *CONST *objv); extern TclStubs tclStubs; @@ -127,7 +124,7 @@ static const CmdInfo builtInCmds[] = { */ {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, 1}, - {"apply", Tcl_ApplyObjCmd, NULL, 1}, + {"apply", Tcl_ApplyObjCmd, NULL, 1}, {"array", Tcl_ArrayObjCmd, NULL, 1}, {"binary", Tcl_BinaryObjCmd, NULL, 1}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, 1}, @@ -380,18 +377,19 @@ Tcl_CreateInterp(void) iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; - iPtr->framePtr = NULL; /* initialise as soon as :: is available */ - iPtr->varFramePtr = NULL; /* initialise as soon as :: is available */ + iPtr->framePtr = NULL; /* Initialise as soon as :: is available */ + iPtr->varFramePtr = NULL; /* Initialise as soon as :: is available */ /* * TIP #280 - Initialize the arrays used to extend the ByteCode and * Proc structures. */ - iPtr->cmdFramePtr = NULL; - iPtr->linePBodyPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable)); - iPtr->lineBCPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable)); + + iPtr->cmdFramePtr = NULL; + iPtr->linePBodyPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + iPtr->lineBCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS); - Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); + Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); iPtr->activeVarTracePtr = NULL; @@ -405,7 +403,7 @@ Tcl_CreateInterp(void) iPtr->returnLevel = 1; iPtr->returnCode = TCL_OK; - iPtr->rootFramePtr = NULL; /* initialise as soon as :: is available */ + iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; iPtr->appendResult = NULL; @@ -435,13 +433,13 @@ Tcl_CreateInterp(void) iPtr->activeCmdTracePtr = NULL; iPtr->activeInterpTracePtr = NULL; iPtr->assocData = NULL; - iPtr->execEnvPtr = NULL; /* set after namespaces initialized */ - iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */ + iPtr->execEnvPtr = NULL; /* Set after namespaces initialized */ + iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object */ Tcl_IncrRefCount(iPtr->emptyObjPtr); iPtr->resultSpace[0] = 0; iPtr->threadId = Tcl_GetCurrentThread(); - iPtr->globalNsPtr = NULL; /* force creation of global ns below */ + iPtr->globalNsPtr = NULL; /* Force creation of global ns below */ iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "", (ClientData) NULL, NULL); if (iPtr->globalNsPtr == NULL) { @@ -546,7 +544,7 @@ Tcl_CreateInterp(void) */ for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { - int new; + int isNew; Tcl_HashEntry *hPtr; if ((cmdInfoPtr->objProc == NULL) @@ -555,8 +553,8 @@ Tcl_CreateInterp(void) } hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, - cmdInfoPtr->name, &new); - if (new) { + cmdInfoPtr->name, &isNew); + if (isNew) { cmdPtr = (Command *) ckalloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; @@ -589,19 +587,20 @@ Tcl_CreateInterp(void) Tcl_CreateObjCommand(interp, cmdInfo2Ptr->name2, cmdInfo2Ptr->objProc, NULL, NULL); } + /* TIP #208 */ Tcl_CreateObjCommand(interp, "::tcl::chan::Truncate", - TclChanTruncateObjCmd, (ClientData) NULL, NULL); + TclChanTruncateObjCmd, NULL, NULL); + /* TIP #219 */ Tcl_CreateObjCommand(interp, "::tcl::chan::rCreate", - TclChanCreateObjCmd, (ClientData) NULL, NULL); - + TclChanCreateObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::chan::rPostevent", - TclChanPostEventObjCmd, (ClientData) NULL, NULL); + TclChanPostEventObjCmd, NULL, NULL); /* TIP #287 */ Tcl_CreateObjCommand(interp, "::tcl::chan::Pending", - TclChanPendingObjCmd, (ClientData) NULL, NULL); + TclChanPendingObjCmd, NULL, NULL); /* * Register the built-in functions. This is empty now that they are @@ -645,8 +644,8 @@ Tcl_CreateInterp(void) (void) Tcl_Export(interp, mathopNSPtr, "*", 1); strcpy(mathFuncName, "::tcl::mathop::"); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++) { - TclOpCmdClientData *occdPtr - = (TclOpCmdClientData *) ckalloc(sizeof(TclOpCmdClientData)); + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) + ckalloc(sizeof(TclOpCmdClientData)); occdPtr->operator = opcmdInfoPtr->name; occdPtr->numArgs = opcmdInfoPtr->numArgs; occdPtr->expected = opcmdInfoPtr->expected; @@ -702,7 +701,7 @@ Tcl_CreateInterp(void) Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, "tcl_precision", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - TclPrecTraceProc, (ClientData) NULL); + TclPrecTraceProc, NULL); TclpSetVariables(interp); #ifdef TCL_THREADS @@ -739,7 +738,7 @@ static void DeleteOpCmdClientData( ClientData clientData) { - TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) clientData; ckfree((char *)occdPtr); } @@ -814,7 +813,7 @@ Tcl_CallWhenDeleted( Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; int *assocDataCounterPtr = - Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int)); + Tcl_GetThreadData(&assocDataCounterKey, (int) sizeof(int)); int new; char buffer[32 + TCL_INTEGER_SPACE]; AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData)); @@ -963,7 +962,7 @@ Tcl_DeleteAssocData( } dPtr = (AssocData *) Tcl_GetHashValue(hPtr); if (dPtr->proc != NULL) { - (dPtr->proc) (dPtr->clientData, interp); + (dPtr->proc)(dPtr->clientData, interp); } ckfree((char *) dPtr); Tcl_DeleteHashEntry(hPtr); @@ -1143,7 +1142,7 @@ DeleteInterpProc( */ if (iPtr->chanMsg != NULL) { - Tcl_DecrRefCount (iPtr->chanMsg); + Tcl_DecrRefCount(iPtr->chanMsg); iPtr->chanMsg = NULL; } @@ -1277,57 +1276,57 @@ DeleteInterpProc( TclDeleteLiteralTable(interp, &(iPtr->literalTable)); - /* TIP #280 - Release the arrays for ByteCode/Proc extension, and contents. + /* + * TIP #280 - Release the arrays for ByteCode/Proc extension, and + * contents. */ + { - Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; - CmdFrame* cfPtr; - ExtCmdLoc* eclPtr; - int i; + int i; for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &hSearch); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&hSearch)) { - - cfPtr = (CmdFrame*) Tcl_GetHashValue (hPtr); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&hSearch)) { + CmdFrame *cfPtr = (CmdFrame*) Tcl_GetHashValue(hPtr); if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount (cfPtr->data.eval.path); + Tcl_DecrRefCount(cfPtr->data.eval.path); } - ckfree ((char*) cfPtr->line); - ckfree ((char*) cfPtr); - Tcl_DeleteHashEntry (hPtr); - + ckfree((char *) cfPtr->line); + ckfree((char *) cfPtr); + Tcl_DeleteHashEntry(hPtr); } - Tcl_DeleteHashTable (iPtr->linePBodyPtr); - ckfree ((char*) iPtr->linePBodyPtr); + Tcl_DeleteHashTable(iPtr->linePBodyPtr); + ckfree((char *) iPtr->linePBodyPtr); iPtr->linePBodyPtr = NULL; - /* See also tclCompile.c, TclCleanupByteCode */ + /* + * See also tclCompile.c, TclCleanupByteCode + */ for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &hSearch); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&hSearch)) { - - eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hPtr); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&hSearch)) { + ExtCmdLoc *eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hPtr); if (eclPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount (eclPtr->path); + Tcl_DecrRefCount(eclPtr->path); } for (i=0; i< eclPtr->nuloc; i++) { - ckfree ((char*) eclPtr->loc[i].line); + ckfree((char *) eclPtr->loc[i].line); } - if (eclPtr->loc != NULL) { - ckfree ((char*) eclPtr->loc); + if (eclPtr->loc != NULL) { + ckfree((char *) eclPtr->loc); } - ckfree ((char*) eclPtr); - Tcl_DeleteHashEntry (hPtr); + ckfree((char *) eclPtr); + Tcl_DeleteHashEntry(hPtr); } - Tcl_DeleteHashTable (iPtr->lineBCPtr); - ckfree((char*) iPtr->lineBCPtr); + Tcl_DeleteHashTable(iPtr->lineBCPtr); + ckfree((char *) iPtr->lineBCPtr); iPtr->lineBCPtr = NULL; } ckfree((char *) iPtr); @@ -1786,7 +1785,7 @@ Tcl_CreateCommand( cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { refCmdPtr = oldRefPtr->importedCmdPtr; - dataPtr = (ImportedCmdData*)refCmdPtr->objClientData; + dataPtr = (ImportedCmdData *) refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } @@ -1958,7 +1957,7 @@ Tcl_CreateObjCommand( cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { refCmdPtr = oldRefPtr->importedCmdPtr; - dataPtr = (ImportedCmdData*)refCmdPtr->objClientData; + dataPtr = (ImportedCmdData *) refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } @@ -3025,7 +3024,7 @@ OldMathFuncProc( Tcl_Obj *CONST *objv) /* Parameter vector */ { Tcl_Obj *valuePtr; - OldMathFuncData* dataPtr = (OldMathFuncData*) clientData; + OldMathFuncData *dataPtr = clientData; Tcl_Value args[MAX_MATH_ARGS]; Tcl_Value funcResult; int result; @@ -3212,9 +3211,9 @@ static void OldMathFuncDeleteProc( ClientData clientData) { - OldMathFuncData *dataPtr = (OldMathFuncData *) clientData; - Tcl_Free((void *) dataPtr->argTypes); - Tcl_Free((void *) dataPtr); + OldMathFuncData *dataPtr = clientData; + ckfree((void *) dataPtr->argTypes); + ckfree((void *) dataPtr); } /* @@ -3327,7 +3326,7 @@ Tcl_ListMathFuncs( Tcl_Interp *interp, CONST char *pattern) { - Namespace *globalNsPtr = (Namespace*) Tcl_GetGlobalNamespace(interp); + Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); Namespace *nsPtr; Namespace *dummy1NsPtr; Namespace *dummy2NsPtr; @@ -3523,8 +3522,8 @@ TclEvalObjvInternal( * registered unknown command handler * for the current namespace * (TIP 181). */ - int newObjc, handlerObjc; - Tcl_Obj **handlerObjv; + int newObjc, handlerObjc; + Tcl_Obj **handlerObjv; currNsPtr = varFramePtr->nsPtr; if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) { @@ -3539,10 +3538,10 @@ TclEvalObjvInternal( * handler. If so, reset it to "::unknown". */ - if (currNsPtr->unknownHandlerPtr == NULL) { - currNsPtr->unknownHandlerPtr = Tcl_NewStringObj("::unknown", -1); - Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr); - } + if (currNsPtr->unknownHandlerPtr == NULL) { + currNsPtr->unknownHandlerPtr = Tcl_NewStringObj("::unknown", -1); + Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr); + } /* * Get the list of words for the unknown handler and allocate enough @@ -3550,23 +3549,23 @@ TclEvalObjvInternal( * invokation itself. */ - Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, + Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); - newObjc = objc + handlerObjc; + newObjc = objc + handlerObjc; newObjv = (Tcl_Obj **) TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * newObjc); - /* + /* * Copy command prefix from unknown handler and add on the real * command's full argument list. Note that we only use memcpy() once * because we have to increment the reference count of all the handler * arguments anyway. */ - for (i = 0; i < handlerObjc; ++i) { - newObjv[i] = handlerObjv[i]; + for (i = 0; i < handlerObjc; ++i) { + newObjv[i] = handlerObjv[i]; Tcl_IncrRefCount(newObjv[i]); - } + } memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc); /* @@ -3593,9 +3592,9 @@ TclEvalObjvInternal( * call. */ - for (i = 0; i < handlerObjc; ++i) { + for (i = 0; i < handlerObjc; ++i) { Tcl_DecrRefCount(newObjv[i]); - } + } TclStackFree(interp); if (savedNsPtr) { varFramePtr->nsPtr = savedNsPtr; @@ -3746,7 +3745,7 @@ Tcl_EvalObjv( * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are * currently supported. */ { - Interp *iPtr = (Interp *)interp; + Interp *iPtr = (Interp *) interp; Trace *tracePtr; Tcl_DString cmdBuf; char *cmdString = ""; /* A command string is only necessary for @@ -3932,55 +3931,51 @@ Tcl_EvalEx( * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ { - return TclEvalEx (interp, script, numBytes, flags, 1); + return TclEvalEx(interp, script, numBytes, flags, 1); } int -TclEvalEx(interp, script, numBytes, flags, line) - Tcl_Interp *interp; /* Interpreter in which to evaluate the - * script. Also used for error reporting. */ - CONST char *script; /* First character of script to evaluate. */ - int numBytes; /* Number of bytes in script. If < 0, the +TclEvalEx( + Tcl_Interp *interp, /* Interpreter in which to evaluate the + * script. Also used for error reporting. */ + CONST char *script, /* First character of script to evaluate. */ + int numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the - * first null character. */ - int flags; /* Collection of OR-ed bits that control - * the evaluation of the script. Only - * TCL_EVAL_GLOBAL is currently - * supported. */ - int line; /* The line the script starts on. */ + * first NUL character. */ + int flags, /* Collection of OR-ed bits that control the + * evaluation of the script. Only + * TCL_EVAL_GLOBAL is currently supported. */ + int line) /* The line the script starts on. */ { Interp *iPtr = (Interp *) interp; CONST char *p, *next; Tcl_Parse parse; #define NUM_STATIC_OBJS 20 Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv, **objvSpace; - int expandStatic [NUM_STATIC_OBJS], *expand; - int linesStatic [NUM_STATIC_OBJS], *lines, *lineSpace; + int expandStatic[NUM_STATIC_OBJS], *expand; + int linesStatic[NUM_STATIC_OBJS], *lines, *lineSpace; Tcl_Token *tokenPtr; int code = TCL_OK; int i, commandLength, bytesLeft, expandRequested; CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); - - /* TIP #280. The array 'expand' has become tri-valued. - * 0 = no expansion - * 1 = expansion, value is dynamically constructed ($var, [cmd]). - * 2 = NEW expansion of a literal value. Here the system determines - * the actual line numbers within the literal. - */ + int gotParse = 0, objectsUsed = 0; + /* These variables keep track of how much + * state has been allocated while evaluating + * the script, so that it can be freed + * properly if an error occurs. */ + CmdFrame eeFrame; /* TIP #280 Structures for tracking of command + * locations. */ /* - * The variables below keep track of how much state has been allocated - * while evaluating the script, so that it can be freed properly if an - * error occurs. + * TIP #280. The array 'expand' has become tri-valued. + * 0 = No expansion + * 1 = Expansion, value is dynamically constructed ($var, [cmd]). + * 2 = NEW Expansion of a literal value. Here the system determines the + * actual line numbers within the literal. */ - int gotParse = 0, objectsUsed = 0; - - /* TIP #280 Structures for tracking of command locations. */ - CmdFrame eeFrame; - if (numBytes < 0) { numBytes = strlen(script); } @@ -3996,13 +3991,14 @@ TclEvalEx(interp, script, numBytes, flags, line) * the script and then executes it. */ - objv = objvSpace = staticObjArray; - lines = lineSpace = linesStatic; - expand = expandStatic; - p = script; + objv = objvSpace = staticObjArray; + lines = lineSpace = linesStatic; + expand = expandStatic; + p = script; bytesLeft = numBytes; - /* TIP #280 Initialize tracking. Do not push on the frame stack yet. + /* + * TIP #280 Initialize tracking. Do not push on the frame stack yet. * * We may cont. counting based on a specific context (CTX), or open a new * context, either for a sourced script, or 'eval'. For sourced files we @@ -4013,47 +4009,54 @@ TclEvalEx(interp, script, numBytes, flags, line) */ if (iPtr->evalFlags & TCL_EVAL_CTX) { - /* Path information comes out of the context. */ + /* + * Path information comes out of the context. + */ - eeFrame.type = TCL_LOCATION_SOURCE; + eeFrame.type = TCL_LOCATION_SOURCE; eeFrame.data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path; - Tcl_IncrRefCount (eeFrame.data.eval.path); + Tcl_IncrRefCount(eeFrame.data.eval.path); } else if (iPtr->evalFlags & TCL_EVAL_FILE) { - /* Set up for a sourced file */ + /* + * Set up for a sourced file. + */ - eeFrame.type = TCL_LOCATION_SOURCE; + eeFrame.type = TCL_LOCATION_SOURCE; if (iPtr->scriptFile) { - /* Normalization here, to have the correct pwd. Should have + /* + * Normalization here, to have the correct pwd. Should have * negligible impact on performance, as the norm should have been * done already by the 'source' invoking us, and it caches the * result. */ - Tcl_Obj* norm = Tcl_FSGetNormalizedPath (interp, iPtr->scriptFile); + Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile); if (!norm) { - /* Error message in the interp result */ + /* + * Error message in the interp result. + */ return TCL_ERROR; } eeFrame.data.eval.path = norm; - Tcl_IncrRefCount (eeFrame.data.eval.path); + Tcl_IncrRefCount(eeFrame.data.eval.path); } else { - eeFrame.data.eval.path = Tcl_NewStringObj ("",-1); + eeFrame.data.eval.path = Tcl_NewStringObj("", -1); } } else { - /* Set up for plain eval */ + /* + * Set up for plain eval. + */ - eeFrame.type = TCL_LOCATION_EVAL; + eeFrame.type = TCL_LOCATION_EVAL; eeFrame.data.eval.path = NULL; } - eeFrame.level = (iPtr->cmdFramePtr == NULL - ? 1 - : iPtr->cmdFramePtr->level + 1); - eeFrame.framePtr = iPtr->framePtr; - eeFrame.nextPtr = iPtr->cmdFramePtr; - eeFrame.nline = 0; - eeFrame.line = NULL; + eeFrame.level = (iPtr->cmdFramePtr==NULL? 1 : iPtr->cmdFramePtr->level+1); + eeFrame.framePtr = iPtr->framePtr; + eeFrame.nextPtr = iPtr->cmdFramePtr; + eeFrame.nline = 0; + eeFrame.line = NULL; iPtr->evalFlags = 0; do { @@ -4068,7 +4071,7 @@ TclEvalEx(interp, script, numBytes, flags, line) * block. */ - TclAdvanceLines (&line, p, parse.commandStart); + TclAdvanceLines(&line, p, parse.commandStart); gotParse = 1; if (parse.numWords > 0) { @@ -4077,8 +4080,8 @@ TclEvalEx(interp, script, numBytes, flags, line) * command. */ - int wordLine = line; - CONST char* wordStart = parse.commandStart; + int wordLine = line; + CONST char *wordStart = parse.commandStart; /* * Generate an array of objects for the words of the command. @@ -4088,37 +4091,36 @@ TclEvalEx(interp, script, numBytes, flags, line) if (parse.numWords > NUM_STATIC_OBJS) { expand = (int *) - ckalloc((unsigned) (parse.numWords * sizeof(int))); + ckalloc((unsigned) parse.numWords * sizeof(int)); objvSpace = (Tcl_Obj **) - ckalloc((unsigned) (parse.numWords * sizeof(Tcl_Obj *))); - lineSpace = (int*) - ckalloc((unsigned) (parse.numWords * sizeof(int))); + ckalloc((unsigned) parse.numWords * sizeof(Tcl_Obj *)); + lineSpace = (int *) + ckalloc((unsigned) parse.numWords * sizeof(int)); } expandRequested = 0; - objv = objvSpace; + objv = objvSpace; lines = lineSpace; for (objectsUsed = 0, tokenPtr = parse.tokenPtr; objectsUsed < parse.numWords; objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) { - - /* - * TIP #280. Track lines to current word. Save the - * information on a per-word basis, signaling dynamic words as - * needed. Make the information available to the recursively - * called evaluator as well, including the type of context - * (source vs. eval). + /* + * TIP #280. Track lines to current word. Save the information + * on a per-word basis, signaling dynamic words as needed. + * Make the information available to the recursively called + * evaluator as well, including the type of context (source + * vs. eval). */ - TclAdvanceLines (&wordLine, wordStart, tokenPtr->start); + TclAdvanceLines(&wordLine, wordStart, tokenPtr->start); wordStart = tokenPtr->start; - lines [objectsUsed] = ((TclWordKnownAtCompileTime (tokenPtr, NULL) || - TclWordSimpleExpansion (tokenPtr)) - ? wordLine - : -1); + lines[objectsUsed] = + (TclWordKnownAtCompileTime(tokenPtr, NULL) + || TclWordSimpleExpansion(tokenPtr)) + ? wordLine : -1; - if (eeFrame.type == TCL_LOCATION_SOURCE) { + if (eeFrame.type == TCL_LOCATION_SOURCE) { iPtr->evalFlags |= TCL_EVAL_FILE; } @@ -4135,8 +4137,8 @@ TclEvalEx(interp, script, numBytes, flags, line) if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { int numElements; - code = Tcl_ListObjLength(interp, - objv[objectsUsed], &numElements); + code = Tcl_ListObjLength(interp, objv[objectsUsed], + &numElements); if (code == TCL_ERROR) { /* * Attempt to expand a non-list. @@ -4148,9 +4150,8 @@ TclEvalEx(interp, script, numBytes, flags, line) goto error; } expandRequested = 1; - expand[objectsUsed] = (TclWordSimpleExpansion (tokenPtr) - ? 2 - : 1); + expand[objectsUsed] = + TclWordSimpleExpansion(tokenPtr) ? 2 : 1; objectsNeeded += (numElements ? numElements : 1); } else { @@ -4163,25 +4164,26 @@ TclEvalEx(interp, script, numBytes, flags, line) * Some word expansion was requested. Check for objv resize. */ - Tcl_Obj **copy = objvSpace; - int *lcopy = lineSpace; + Tcl_Obj **copy = objvSpace; + int *lcopy = lineSpace; int wordIdx = parse.numWords; - int objIdx = objectsNeeded - 1; + int objIdx = objectsNeeded - 1; if ((parse.numWords > NUM_STATIC_OBJS) || (objectsNeeded > NUM_STATIC_OBJS)) { - objv = objvSpace = (Tcl_Obj **) ckalloc((unsigned) - (objectsNeeded * sizeof(Tcl_Obj *))); - lines = lineSpace = (int*) ckalloc((unsigned) - (objectsNeeded * sizeof(int))); + objv = objvSpace = (Tcl_Obj **) + ckalloc((unsigned)objectsNeeded*sizeof(Tcl_Obj*)); + lines = lineSpace = (int*) + ckalloc((unsigned) objectsNeeded * sizeof(int)); } objectsUsed = 0; while (wordIdx--) { if (expand[wordIdx] == 2) { - /* TIP #280. The expansion is for a simple literal. Not only - * crack the list into its elements, determine the - * line numbers within it as well. + /* + * TIP #280. The expansion is for a simple literal. + * Not only crack the list into its elements, + * determine the line numbers within it as well. * * The qualification of 'simple' ensures that the word * does not contain backslash-subst, no way to get @@ -4190,40 +4192,36 @@ TclEvalEx(interp, script, numBytes, flags, line) int numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; - int* eline; + int *eline; - Tcl_ListObjGetElements(NULL, temp, - &numElements, &elements); - - eline = (int*) ckalloc (numElements * sizeof(int)); - TclListLines (TclGetString(temp),lcopy[wordIdx], - numElements, eline); + TclListObjGetElements(temp, &numElements, &elements); + eline = (int *) ckalloc(numElements * sizeof(int)); + TclListLines(TclGetString(temp),lcopy[wordIdx], + numElements, eline); objectsUsed += numElements; while (numElements--) { - lines[objIdx] = eline [numElements]; - objv [objIdx--] = elements[numElements]; + lines[objIdx] = eline[numElements]; + objv[objIdx--] = elements[numElements]; Tcl_IncrRefCount(elements[numElements]); } Tcl_DecrRefCount(temp); - ckfree((char*) eline); - + ckfree((char *) eline); } else if (expand[wordIdx]) { int numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; - Tcl_ListObjGetElements(NULL, temp, - &numElements, &elements); + TclListObjGetElements(temp, &numElements, &elements); objectsUsed += numElements; while (numElements--) { - lines[objIdx] = -1; + lines[objIdx] = -1; objv [objIdx--] = elements[numElements]; Tcl_IncrRefCount(elements[numElements]); } Tcl_DecrRefCount(temp); } else { - lines[objIdx] = lcopy[wordIdx]; - objv [objIdx--] = copy [wordIdx]; + lines[objIdx] = lcopy[wordIdx]; + objv[objIdx--] = copy[wordIdx]; objectsUsed++; } } @@ -4251,11 +4249,11 @@ TclEvalEx(interp, script, numBytes, flags, line) eeFrame.cmd.str.len = parse.commandSize; if (parse.term == parse.commandStart + parse.commandSize - 1) { - eeFrame.cmd.str.len --; + eeFrame.cmd.str.len--; } eeFrame.nline = objectsUsed; - eeFrame.line = lines; + eeFrame.line = lines; iPtr->cmdFramePtr = &eeFrame; iPtr->numLevels++; @@ -4264,7 +4262,7 @@ TclEvalEx(interp, script, numBytes, flags, line) iPtr->numLevels--; iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; - eeFrame.line = NULL; + eeFrame.line = NULL; eeFrame.nline = 0; if (code != TCL_OK) { @@ -4302,7 +4300,7 @@ TclEvalEx(interp, script, numBytes, flags, line) next = parse.commandStart + parse.commandSize; bytesLeft -= next - p; p = next; - TclAdvanceLines (&line, parse.commandStart, p); + TclAdvanceLines(&line, parse.commandStart, p); Tcl_FreeParse(&parse); gotParse = 0; } while (bytesLeft > 0); @@ -4351,20 +4349,23 @@ TclEvalEx(interp, script, numBytes, flags, line) } if (objvSpace != staticObjArray) { ckfree((char *) objvSpace); - ckfree ((char*) lineSpace); + ckfree((char *) lineSpace); } if (expand != expandStatic) { ckfree((char *) expand); } iPtr->varFramePtr = savedVarFramePtr; + cleanup_return: - /* TIP #280. Release the local CmdFrame, and its contents. */ + /* + * TIP #280. Release the local CmdFrame, and its contents. + */ if (eeFrame.line != NULL) { - ckfree ((char*) eeFrame.line); + ckfree((char *) eeFrame.line); } if (eeFrame.type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount (eeFrame.data.eval.path); + Tcl_DecrRefCount(eeFrame.data.eval.path); } return code; } @@ -4374,8 +4375,8 @@ TclEvalEx(interp, script, numBytes, flags, line) * * TclAdvanceLines -- * - * This procedure is a helper which counts the number of lines - * in a block of text and advances an external counter. + * This function is a helper which counts the number of lines in a block + * of text and advances an external counter. * * Results: * None. @@ -4388,15 +4389,16 @@ TclEvalEx(interp, script, numBytes, flags, line) */ void -TclAdvanceLines (line,start,end) - int* line; - CONST char* start; - CONST char* end; +TclAdvanceLines( + int *line, + CONST char *start, + CONST char *end) { - CONST char* p; + CONST char *p; + for (p = start; p < end; p++) { - if (*p == '\n') { - (*line) ++; + if (*p == '\n') { + (*line)++; } } } @@ -4509,23 +4511,20 @@ Tcl_EvalObjEx( * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ { - return TclEvalObjEx (interp, objPtr, flags, NULL, 0); + return TclEvalObjEx(interp, objPtr, flags, NULL, 0); } int -TclEvalObjEx(interp, objPtr, flags, invoker, word) - Tcl_Interp *interp; /* Token for command interpreter - * (returned by a previous call to - * Tcl_CreateInterp). */ - register Tcl_Obj *objPtr; /* Pointer to object containing - * commands to execute. */ - int flags; /* Collection of OR-ed bits that - * control the evaluation of the - * script. Supported values are - * TCL_EVAL_GLOBAL and - * TCL_EVAL_DIRECT. */ - CONST CmdFrame* invoker; /* Frame of the command doing the eval */ - int word; /* Index of the word which is in objPtr */ +TclEvalObjEx( + Tcl_Interp *interp, /* Token for command interpreter (returned by + * a previous call to Tcl_CreateInterp). */ + register Tcl_Obj *objPtr, /* Pointer to object containing commands to + * execute. */ + int flags, /* Collection of OR-ed bits that control the + * evaluation of the script. Supported values + * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ + CONST CmdFrame *invoker, /* Frame of the command doing the eval. */ + int word) /* Index of the word which is in objPtr. */ { register Interp *iPtr = (Interp *) interp; char *script; @@ -4562,27 +4561,27 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) if (objPtr->bytes == NULL || /* ...without a string rep */ listRepPtr->canonicalFlag) {/* ...or that is canonical */ - - /* TIP #280 Structures for tracking lines. - * As we know that this is dynamic execution we ignore the - * invoker, even if known. + /* + * TIP #280 Structures for tracking lines. As we know that + * this is dynamic execution we ignore the invoker, even if + * known. */ - int line, i; - char* w; + + int line, i; + char *w; CmdFrame eoFrame; - Tcl_Obj **elements = &listRepPtr->elements; + Tcl_Obj **elements = &listRepPtr->elements; - eoFrame.type = TCL_LOCATION_EVAL_LIST; - eoFrame.level = (iPtr->cmdFramePtr == NULL ? - 1 : - iPtr->cmdFramePtr->level + 1); + eoFrame.type = TCL_LOCATION_EVAL_LIST; + eoFrame.level = (iPtr->cmdFramePtr == NULL? + 1 : iPtr->cmdFramePtr->level + 1); eoFrame.framePtr = iPtr->framePtr; - eoFrame.nextPtr = iPtr->cmdFramePtr; - eoFrame.nline = listRepPtr->elemCount; - eoFrame.line = (int*) ckalloc (eoFrame.nline * sizeof (int)); + eoFrame.nextPtr = iPtr->cmdFramePtr; + eoFrame.nline = listRepPtr->elemCount; + eoFrame.line = (int *) ckalloc(eoFrame.nline * sizeof(int)); eoFrame.cmd.listPtr = objPtr; - Tcl_IncrRefCount (eoFrame.cmd.listPtr); + Tcl_IncrRefCount(eoFrame.cmd.listPtr); eoFrame.data.eval.path = NULL; /* @@ -4590,8 +4589,8 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) * avoid a segfault if objPtr loses its List internal rep [Bug * 1119369] * - * TIP #280 Computes all the line numbers for the - * words in the command. + * TIP #280 Computes all the line numbers for the words in the + * command. */ listRepPtr->refCount++; @@ -4599,8 +4598,8 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) line = 1; for (i=0; i < eoFrame.nline; i++) { eoFrame.line [i] = line; - w = Tcl_GetString (elements[i]); - TclAdvanceLines (&line, w, w + strlen(w)); + w = Tcl_GetString(elements[i]); + TclAdvanceLines(&line, w, w + strlen(w)); } iPtr->cmdFramePtr = &eoFrame; @@ -4608,7 +4607,7 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) &listRepPtr->elements, flags); iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; - Tcl_DecrRefCount (eoFrame.cmd.listPtr); + Tcl_DecrRefCount(eoFrame.cmd.listPtr); /* * If we are the last users of listRepPtr, free it. @@ -4624,8 +4623,8 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) ckfree((char *) listRepPtr); } - ckfree ((char*) eoFrame.line); - eoFrame.line = NULL; + ckfree((char *) eoFrame.line); + eoFrame.line = NULL; eoFrame.nline = 0; goto done; @@ -4643,11 +4642,15 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) */ if (invoker == NULL) { - /* No context, force opening of our own */ + /* + * No context, force opening of our own. + */ + script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); } else { - /* We have an invoker, describing the command asking for the + /* + * We have an invoker, describing the command asking for the * evaluation of a subordinate script. This script may originate * in a literal word, or from a variable, etc. Using the line * array we now check if we have good line information for the @@ -4660,43 +4663,57 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) */ if ((invoker->nline <= word) || (invoker->line[word] < 0)) { - /* Dynamic script, or dynamic context, force our own - * context */ + /* + * Dynamic script, or dynamic context, force our own + * context. + */ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); - result = Tcl_EvalEx(interp, script, numSrcBytes, flags); + result = Tcl_EvalEx(interp, script, numSrcBytes, flags); } else { - /* Try to get an absolute context for the evaluation + /* + * Try to get an absolute context for the evaluation. */ CmdFrame ctx = *invoker; - int pc = 0; + int pc = 0; if (invoker->type == TCL_LOCATION_BC) { - /* Note: Type BC => ctx.data.eval.path is not used. - * ctx.data.tebc.codePtr is used instead. + /* + * Note: Type BC => ctx.data.eval.path is not used. + * ctx.data.tebc.codePtr is used instead. */ - TclGetSrcInfoForPc (&ctx); + + TclGetSrcInfoForPc(&ctx); pc = 1; } if (ctx.type == TCL_LOCATION_SOURCE) { - /* Absolute context to reuse. */ + /* + * Absolute context to reuse. + */ iPtr->invokeCmdFramePtr = &ctx; iPtr->evalFlags |= TCL_EVAL_CTX; script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); - result = TclEvalEx(interp, script, numSrcBytes, flags, ctx.line [word]); + result = TclEvalEx(interp, script, numSrcBytes, flags, + ctx.line[word]); if (pc) { - /* Death of SrcInfo reference */ - Tcl_DecrRefCount (ctx.data.eval.path); + /* + * Death of SrcInfo reference. + */ + + Tcl_DecrRefCount(ctx.data.eval.path); } } else { - /* Dynamic context or script, easier to make our own as - * well */ + /* + * Dynamic context or script, easier to make our own as + * well. + */ + script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); } @@ -4706,8 +4723,8 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) /* * Let the compiler/engine subsystem do the evaluation. * - * TIP #280 The invoker provides us with the context for the - * script. We transfer this to the byte code compiler. + * TIP #280 The invoker provides us with the context for the script. + * We transfer this to the byte code compiler. */ savedVarFramePtr = iPtr->varFramePtr; @@ -5661,27 +5678,28 @@ ExprIsqrtFunc( * represented in a double as an exact * integer */ - /* Check syntax */ + /* + * Check syntax. + */ + if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } - /* Make sure that the arg is a number */ + /* + * Make sure that the arg is a number. + */ + if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { return TCL_ERROR; } switch (type) { - case TCL_NUMBER_NAN: - { Tcl_GetDoubleFromObj(interp, objv[1], &d); return TCL_ERROR; - } - case TCL_NUMBER_DOUBLE: - { d = *((CONST double *)ptr); if (d < 0) { goto negarg; @@ -5697,9 +5715,7 @@ ExprIsqrtFunc( } } break; - } case TCL_NUMBER_BIG: - { if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) { return TCL_ERROR; } @@ -5708,10 +5724,7 @@ ExprIsqrtFunc( goto negarg; } break; - } - default: - { if (Tcl_GetWideIntFromObj(interp, objv[1], &w) != TCL_OK) { return TCL_ERROR; } @@ -5729,12 +5742,12 @@ ExprIsqrtFunc( } break; } - } if (exact) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d))); } else { mp_int root; + mp_init(&root); mp_sqrt(&big, &root); mp_clear(&big); @@ -5745,7 +5758,7 @@ ExprIsqrtFunc( negarg: Tcl_SetObjResult(interp, - Tcl_NewStringObj("square root of negative argument", -1)); + Tcl_NewStringObj("square root of negative argument", -1)); return TCL_ERROR; } @@ -5778,6 +5791,7 @@ ExprSqrtFunc( if ((d >= 0.0) && TclIsInfinite(d) && (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK)) { mp_int root; + mp_init(&root); mp_sqrt(&big, &root); mp_clear(&big); diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 58ddb3b..d98061c 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -10,28 +10,33 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompExpr.c,v 1.45 2006/12/12 21:45:04 dgp Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.46 2006/12/13 16:28:06 dkf Exp $ */ #include "tclInt.h" #include "tclCompile.h" -#undef USE_EXPR_TOKENS +#undef USE_EXPR_TOKENS #undef PARSE_DIRECT_EXPR_TOKENS #ifdef PARSE_DIRECT_EXPR_TOKENS /* - * The ExprNode structure represents one node of the parse tree produced - * as an interim structure by the expression parser. + * The ExprNode structure represents one node of the parse tree produced as an + * interim structure by the expression parser. */ typedef struct ExprNode { - unsigned char lexeme; /* Code that identifies the type of this node */ - int left; /* Index of the left operand of this operator node */ - int right; /* Index of the right operand of this operator node */ - int parent; /* Index of the operator of this operand node */ - int token; /* Index of the Tcl_Tokens of this leaf node */ + unsigned char lexeme; /* Code that identifies the type of this + * node. */ + int left; /* Index of the left operand of this operator + * node. */ + int right; /* Index of the right operand of this operator + * node. */ + int parent; /* Index of the operator of this operand + * node. */ + int token; /* Index of the Tcl_Tokens of this leaf + * node. */ } ExprNode; #endif @@ -50,23 +55,26 @@ enum OperandTypes { */ typedef struct OpNode { - unsigned char lexeme; /* Code that identifies the operator */ - int left; /* Index of the left operand. Non-negative integer - is an index into the parse tree, pointing to another - operator. Value OT_LITERAL indicates operand is the - next entry in the literal list. Value OT_TOKENS - indicates the operand is the next word in the - Tcl_Parse struct. Value OT_NONE indicates we - haven't yet parsed the operand for this operator. */ - int right; /* Index of the right operand. Same interpretation - as left, with addition of OT_EMPTY meaning zero - arguments. */ - int parent; /* Index of the operator of this operand node */ + unsigned char lexeme; /* Code that identifies the operator. */ + int left; /* Index of the left operand. Non-negative + * integer is an index into the parse tree, + * pointing to another operator. Value + * OT_LITERAL indicates operand is the next + * entry in the literal list. Value OT_TOKENS + * indicates the operand is the next word in + * the Tcl_Parse struct. Value OT_NONE + * indicates we haven't yet parsed the operand + * for this operator. */ + int right; /* Index of the right operand. Same + * interpretation as left, with addition of + * OT_EMPTY meaning zero arguments. */ + int parent; /* Index of the operator of this operand + * node. */ } OpNode; /* - * Set of lexeme codes stored in ExprNode structs to label and categorize - * the lexemes found. + * Set of lexeme codes stored in ExprNode structs to label and categorize the + * lexemes found. */ #define LEAF (1<<7) @@ -131,40 +139,28 @@ typedef struct OpNode { */ static int ParseLexeme(CONST char *start, int numBytes, - unsigned char *lexemePtr, Tcl_Obj **literalPtr); - + unsigned char *lexemePtr, Tcl_Obj **literalPtr); #if (!defined(PARSE_DIRECT_EXPR_TOKENS) || !defined(USE_EXPR_TOKENS)) - static int ParseExpr(Tcl_Interp *interp, CONST char *start, - int numBytes, OpNode **opTreePtr, - Tcl_Obj *litList, Tcl_Obj *funcList, - Tcl_Parse *parsePtr); - + int numBytes, OpNode **opTreePtr, + Tcl_Obj *litList, Tcl_Obj *funcList, + Tcl_Parse *parsePtr); #endif - #ifdef PARSE_DIRECT_EXPR_TOKENS - static void GenerateTokens(ExprNode *nodes, Tcl_Parse *scratchPtr, - Tcl_Parse *parsePtr); - + Tcl_Parse *parsePtr); #else - static void ConvertTreeToTokens(Tcl_Interp *interp, - CONST char *start, int numBytes, - OpNode *nodes, Tcl_Obj *litList, - Tcl_Token *tokenPtr, Tcl_Parse *parsePtr); + CONST char *start, int numBytes, OpNode *nodes, + Tcl_Obj *litList, Tcl_Token *tokenPtr, + Tcl_Parse *parsePtr); static int GenerateTokensForLiteral(CONST char *script, - int numBytes, Tcl_Obj *litList, - int nextLiteral, Tcl_Parse *parsePtr); + int numBytes, Tcl_Obj *litList, int nextLiteral, + Tcl_Parse *parsePtr); static int CopyTokens(Tcl_Token *sourcePtr, Tcl_Parse *parsePtr); - #endif - - - - -#if (!defined(PARSE_DIRECT_EXPR_TOKENS) || !defined(USE_EXPR_TOKENS)) +#if (!defined(PARSE_DIRECT_EXPR_TOKENS) || !defined(USE_EXPR_TOKENS)) /* *---------------------------------------------------------------------- * @@ -176,11 +172,11 @@ static int CopyTokens(Tcl_Token *sourcePtr, Tcl_Parse *parsePtr); * caller. * * Results: - * If the string is successfully parsed as a valid Tcl expression, - * TCL_OK is returned, and data about the expression structure is - * written to *parsePtr. If the string cannot be parsed as a valid - * Tcl expression, TCL_ERROR is returned, and if interp is non-NULL, - * an error message is written to interp. + * If the string is successfully parsed as a valid Tcl expression, TCL_OK + * is returned, and data about the expression structure is written to + * *parsePtr. If the string cannot be parsed as a valid Tcl expression, + * TCL_ERROR is returned, and if interp is non-NULL, an error message is + * written to interp. * * Side effects: * If there is insufficient space in parsePtr to hold all the information @@ -198,10 +194,10 @@ ParseExpr( int numBytes, /* Number of bytes in string. If < 0, the * string consists of all bytes up to the * first null character. */ - OpNode **opTreePtr, /* Points to space where a pointer to - * the allocated OpNode tree should go */ - Tcl_Obj *litList, /* List to append literals to */ - Tcl_Obj *funcList, /* List to append function names to */ + OpNode **opTreePtr, /* Points to space where a pointer to the + * allocated OpNode tree should go. */ + Tcl_Obj *litList, /* List to append literals to. */ + Tcl_Obj *funcList, /* List to append function names to. */ Tcl_Parse *parsePtr) /* Structure to fill with tokens representing * those operands that require run time * substitutions. */ @@ -236,7 +232,10 @@ ParseExpr( "not enough memory to parse expression", -1); code = TCL_ERROR; } else { - /* Initialize the parse tree with the special "START" node */ + /* + * Initialize the parse tree with the special "START" node. + */ + nodes->lexeme = lexeme; nodes->left = OT_NONE; nodes->right = OT_NONE; @@ -251,16 +250,17 @@ ParseExpr( CONST char *lastStart = start - scanned; /* - * Each pass through this loop adds one more ExprNode. - * Allocate space for one if required. + * Each pass through this loop adds one more ExprNode. Allocate space + * for one if required. */ + if (nodesUsed >= nodesAvailable) { int size = nodesUsed * 2; OpNode *newPtr; do { - newPtr = (OpNode *) attemptckrealloc( (char *) nodes, - (unsigned int) (size * sizeof(OpNode)) ); + newPtr = (OpNode *) attemptckrealloc((char *) nodes, + (unsigned int) size * sizeof(OpNode)); } while ((newPtr == NULL) && ((size -= (size - nodesUsed) / 2) > nodesUsed)); if (newPtr == NULL) { @@ -274,7 +274,9 @@ ParseExpr( } nodePtr = nodes + nodesUsed; - /* Skip white space between lexemes */ + /* + * Skip white space between lexemes. + */ scanned = TclParseAllWhiteSpace(start, numBytes); start += scanned; @@ -282,7 +284,9 @@ ParseExpr( scanned = ParseLexeme(start, numBytes, &lexeme, &literal); - /* Use context to categorize the lexemes that are ambiguous */ + /* + * Use context to categorize the lexemes that are ambiguous. + */ if ((NODE_TYPE & lexeme) == 0) { switch (lexeme) { @@ -336,7 +340,9 @@ ParseExpr( } } - /* Add node to parse tree based on category */ + /* + * Add node to parse tree based on category. + */ switch (NODE_TYPE & lexeme) { case LEAF: { @@ -373,7 +379,10 @@ ParseExpr( break; } - /* Make room for at least 2 more tokens */ + /* + * Make room for at least 2 more tokens. + */ + if (parsePtr->numTokens+1 >= parsePtr->tokensAvailable) { TclExpandTokenArray(parsePtr); } @@ -399,7 +408,7 @@ ParseExpr( code = Tcl_ParseBraces(interp, start, numBytes, parsePtr, 1, &end); if (code != TCL_OK) { - continue; + continue; } scanned = end - start; break; @@ -430,8 +439,8 @@ ParseExpr( start++; while (1) { Tcl_Parse nested; - code = Tcl_ParseCommand(interp, - start, (end - start), 1, &nested); + code = Tcl_ParseCommand(interp, start, (end - start), 1, + &nested); if (code != TCL_OK) { parsePtr->term = nested.term; parsePtr->errorType = nested.errorType; @@ -509,12 +518,14 @@ ParseExpr( unsigned char precedence = prec[lexeme]; if (lastWas >= 0) { - if ((lexeme == CLOSE_PAREN) && (nodePtr[-1].lexeme == OPEN_PAREN)) { if (nodePtr[-2].lexeme == FUNCTION) { - /* Normally, "()" is a syntax error, but as a special - * case accept it as an argument list for a function */ + /* + * Normally, "()" is a syntax error, but as a special + * case accept it as an argument list for a function. + */ + scanned = 0; lastWas = OT_EMPTY; nodePtr[-1].left--; @@ -531,7 +542,7 @@ ParseExpr( if (nodePtr[-1].lexeme == OPEN_PAREN) { msg = Tcl_NewStringObj("unbalanced open paren", -1); } else if (nodePtr[-1].lexeme == COMMA) { - msg = Tcl_ObjPrintf( + msg = Tcl_ObjPrintf( "missing function argument at %s", mark); scanned = 0; insertMark = 1; @@ -566,22 +577,30 @@ ParseExpr( otherPtr = nodePtr - 1; } while (1) { - /* lastWas is "index" of item to be linked */ - /* otherPtr points to competing operator */ + /* + * lastWas is "index" of item to be linked. otherPtr points to + * competing operator. + */ if (prec[otherPtr->lexeme] < precedence) { break; } if (prec[otherPtr->lexeme] == precedence) { - /* Right association rules for exponentiation. */ + /* + * Right association rules for exponentiation. + */ + if (lexeme == EXPON) { break; } - /* Special association rules for the ternary operators. + + /* + * Special association rules for the ternary operators. * The "?" and ":" operators have equal precedence, but * must be linked up in sensible pairs. */ + if ((otherPtr->lexeme == QUESTION) && ((lastWas < 0) || (nodes[lastWas].lexeme != COLON))) { break; @@ -591,9 +610,11 @@ ParseExpr( } } - /* We should link the lastWas item to the otherPtr - * as its right operand. First make some syntax checks + /* + * We should link the lastWas item to the otherPtr as its + * right operand. First make some syntax checks. */ + if ((otherPtr->lexeme == OPEN_PAREN) && (lexeme != CLOSE_PAREN)) { msg = Tcl_NewStringObj("unbalanced open paren", -1); @@ -618,7 +639,10 @@ ParseExpr( break; } - /* Link orphan as right operand of otherPtr */ + /* + * Link orphan as right operand of otherPtr. + */ + otherPtr->right = lastWas; if (lastWas >= 0) { nodes[lastWas].parent = otherPtr - nodes; @@ -626,11 +650,17 @@ ParseExpr( lastWas = otherPtr - nodes; if (otherPtr->lexeme == OPEN_PAREN) { - /* CLOSE_PAREN can only close one OPEN_PAREN */ + /* + * CLOSE_PAREN can only close one OPEN_PAREN. + */ + break; } if (otherPtr->lexeme == START) { - /* Don't backtrack beyond the start */ + /* + * Don't backtrack beyond the start. + */ + break; } otherPtr = nodes + otherPtr->parent; @@ -648,7 +678,11 @@ ParseExpr( lastWas = OT_NONE; lastOpen = otherPtr - nodes; otherPtr->left++; - /* Create no node for a CLOSE_PAREN lexeme */ + + /* + * Create no node for a CLOSE_PAREN lexeme. + */ + break; } if (lexeme == COMMA) { @@ -670,7 +704,10 @@ ParseExpr( continue; } - /* Link orphan as left operand of new node */ + /* + * Link orphan as left operand of new node. + */ + nodePtr->lexeme = lexeme; nodePtr->right = -1; nodePtr->left = lastWas; @@ -692,50 +729,44 @@ ParseExpr( if (code == TCL_OK) { *opTreePtr = nodes; + } else if (interp == NULL) { + if (msg) { + Tcl_DecrRefCount(msg); + } } else { - if (interp == NULL) { - if (msg) { - Tcl_DecrRefCount(msg); - } - } else { - if (msg == NULL) { - msg = Tcl_GetObjResult(interp); - } - Tcl_AppendPrintfToObj(msg, - "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", - ((start - limit) < parsePtr->string) ? "" : "...", - ((start - limit) < parsePtr->string) - ? (start - parsePtr->string) : limit - 3, - ((start - limit) < parsePtr->string) - ? parsePtr->string : start - limit + 3, - (scanned < limit) ? scanned : limit - 3, start, - (scanned < limit) ? "" : "...", - insertMark ? mark : "", - (start + scanned + limit > parsePtr->end) - ? parsePtr->end - (start + scanned) : limit-3, - start + scanned, - (start + scanned + limit > parsePtr->end) ? "" : "..." - ); - if (post != NULL) { - Tcl_AppendToObj(msg, ";\n", -1); - Tcl_AppendObjToObj(msg, post); - Tcl_DecrRefCount(post); - } - Tcl_SetObjResult(interp, msg); - numBytes = parsePtr->end - parsePtr->string; - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (parsing expression \"%.*s%s\")", - (numBytes < limit) ? numBytes : limit - 3, - parsePtr->string, (numBytes < limit) ? "" : "...")); + if (msg == NULL) { + msg = Tcl_GetObjResult(interp); + } + Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", + ((start - limit) < parsePtr->string) ? "" : "...", + ((start - limit) < parsePtr->string) + ? (start - parsePtr->string) : limit - 3, + ((start - limit) < parsePtr->string) + ? parsePtr->string : start - limit + 3, + (scanned < limit) ? scanned : limit - 3, start, + (scanned < limit) ? "" : "...", insertMark ? mark : "", + (start + scanned + limit > parsePtr->end) + ? parsePtr->end - (start + scanned) : limit-3, + start + scanned, + (start + scanned + limit > parsePtr->end) ? "" : "..."); + if (post != NULL) { + Tcl_AppendToObj(msg, ";\n", -1); + Tcl_AppendObjToObj(msg, post); + Tcl_DecrRefCount(post); } + Tcl_SetObjResult(interp, msg); + numBytes = parsePtr->end - parsePtr->string; + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (parsing expression \"%.*s%s\")", + (numBytes < limit) ? numBytes : limit - 3, + parsePtr->string, (numBytes < limit) ? "" : "...")); } return code; } #endif - -#ifndef PARSE_DIRECT_EXPR_TOKENS +#ifndef PARSE_DIRECT_EXPR_TOKENS /* *---------------------------------------------------------------------- * @@ -745,8 +776,8 @@ ParseExpr( * Number of bytes scanned. * * Side effects: - * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing - * the literal. + * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the + * literal. * *---------------------------------------------------------------------- */ @@ -764,17 +795,21 @@ GenerateTokensForLiteral( Tcl_Token *destPtr; unsigned char lexeme; - /* Have to reparse to get pointers into source string */ + /* + * Have to reparse to get pointers into source string. + */ + scanned = TclParseAllWhiteSpace(start, numBytes); start +=scanned; scanned = ParseLexeme(start, numBytes-scanned, &lexeme, NULL); if ((lexeme != NUMBER) && (lexeme != BAREWORD)) { Tcl_Obj *literal; CONST char *bytes; + Tcl_ListObjIndex(NULL, litList, nextLiteral, &literal); bytes = Tcl_GetStringFromObj(literal, &scanned); start++; - if (memcmp((VOID *) bytes, (VOID *) start, (size_t) scanned) == 0) { + if (memcmp(bytes, start, (size_t) scanned) == 0) { closer = 1; } else { /* TODO */ @@ -809,8 +844,8 @@ GenerateTokensForLiteral( * Number of bytes scanned. * * Side effects: - * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing - * the literal. + * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the + * literal. * *---------------------------------------------------------------------- */ @@ -828,8 +863,7 @@ CopyTokens( TclExpandTokenArray(parsePtr); } destPtr = parsePtr->tokenPtr + parsePtr->numTokens; - memcpy((VOID *) destPtr, (VOID *) sourcePtr, - (size_t) (toCopy * sizeof(Tcl_Token))); + memcpy(destPtr, sourcePtr, (size_t) toCopy * sizeof(Tcl_Token)); destPtr->type = TCL_TOKEN_SUB_EXPR; parsePtr->numTokens += toCopy; } else { @@ -841,8 +875,7 @@ CopyTokens( destPtr->type = TCL_TOKEN_SUB_EXPR; destPtr->numComponents++; destPtr++; - memcpy((VOID *) destPtr, (VOID *) sourcePtr, - (size_t) (toCopy * sizeof(Tcl_Token))); + memcpy(destPtr, sourcePtr, (size_t) toCopy * sizeof(Tcl_Token)); parsePtr->numTokens += toCopy + 1; } return toCopy; @@ -857,8 +890,8 @@ CopyTokens( * None. * * Side effects: - * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing - * the parsed expression. + * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the + * parsed expression. * *---------------------------------------------------------------------- */ @@ -884,9 +917,13 @@ ConvertTreeToTokens( case UNARY: if (nodePtr->right > OT_NONE) { int right = nodePtr->right; + nodePtr->right = OT_NONE; if (nodePtr->lexeme != START) { - /* Find operator in string */ + /* + * Find operator in string. + */ + scanned = TclParseAllWhiteSpace(start, numBytes); start +=scanned; numBytes -= scanned; @@ -936,11 +973,17 @@ ConvertTreeToTokens( } } else { if (nodePtr->lexeme == START) { - /* We're done */ + /* + * We're done. + */ + return; } if (nodePtr->lexeme == OPEN_PAREN) { - /* Skip past matching close paren */ + /* + * Skip past matching close paren. + */ + scanned = TclParseAllWhiteSpace(start, numBytes); start +=scanned; numBytes -= scanned; @@ -960,6 +1003,7 @@ ConvertTreeToTokens( case BINARY: if (nodePtr->left > OT_NONE) { int left = nodePtr->left; + nodePtr->left = OT_NONE; scanned = TclParseAllWhiteSpace(start, numBytes); start +=scanned; @@ -995,6 +1039,7 @@ ConvertTreeToTokens( } } else if (nodePtr->right > OT_NONE) { int right = nodePtr->right; + nodePtr->right = OT_NONE; scanned = TclParseAllWhiteSpace(start, numBytes); start +=scanned; @@ -1038,7 +1083,7 @@ ConvertTreeToTokens( nodePtr->left = OT_NONE; destPtr = parsePtr->tokenPtr + tokenIdx; destPtr->size = start - destPtr->start; - destPtr->numComponents = parsePtr->numTokens - tokenIdx - 1; + destPtr->numComponents = parsePtr->numTokens-tokenIdx-1; } nodePtr = nodes + nodePtr->parent; } @@ -1047,7 +1092,6 @@ ConvertTreeToTokens( } } #endif - /* *---------------------------------------------------------------------- @@ -1060,11 +1104,11 @@ ConvertTreeToTokens( * caller. * * Results: - * If the string is successfully parsed as a valid Tcl expression, - * TCL_OK is returned, and data about the expression structure is - * written to *parsePtr. If the string cannot be parsed as a valid - * Tcl expression, TCL_ERROR is returned, and if interp is non-NULL, - * an error message is written to interp. + * If the string is successfully parsed as a valid Tcl expression, TCL_OK + * is returned, and data about the expression structure is written to + * *parsePtr. If the string cannot be parsed as a valid Tcl expression, + * TCL_ERROR is returned, and if interp is non-NULL, an error message is + * written to interp. * * Side effects: * If there is insufficient space in parsePtr to hold all the information @@ -1101,8 +1145,8 @@ Tcl_ParseExpr( TclParseInit(interp, start, numBytes, parsePtr); if (code == TCL_OK) { - ConvertTreeToTokens(interp, start, numBytes, opTree, - litList, parse.tokenPtr, parsePtr); + ConvertTreeToTokens(interp, start, numBytes, opTree, litList, + parse.tokenPtr, parsePtr); } else { /* TODO: copy over any error info to *parsePtr */ } @@ -1138,7 +1182,9 @@ Tcl_ParseExpr( TclParseInit(interp, start, numBytes, &scratch); TclParseInit(interp, start, numBytes, parsePtr); - /* Initialize the parse tree with the special "START" node */ + /* + * Initialize the parse tree with the special "START" node. + */ nodes->lexeme = START; nodes->left = -1; @@ -1153,9 +1199,10 @@ Tcl_ParseExpr( Tcl_Token *tokenPtr; /* - * Each pass through this loop adds one more ExprNode. - * Allocate space for one if required. + * Each pass through this loop adds one more ExprNode. Allocate space + * for one if required. */ + if (nodesUsed >= nodesAvailable) { int lastOrphanIdx = lastOrphanPtr - nodes; int size = nodesUsed * 2; @@ -1165,8 +1212,8 @@ Tcl_ParseExpr( nodes = NULL; } do { - newPtr = (ExprNode *) attemptckrealloc( (char *) nodes, - (unsigned int) (size * sizeof(ExprNode)) ); + newPtr = (ExprNode *) attemptckrealloc((char *) nodes, + (unsigned int) size * sizeof(ExprNode)); } while ((newPtr == NULL) && ((size -= (size - nodesUsed) / 2) > nodesUsed)); if (newPtr == NULL) { @@ -1177,8 +1224,8 @@ Tcl_ParseExpr( } nodesAvailable = size; if (nodes == NULL) { - memcpy((VOID *) newPtr, (VOID *) staticNodes, - (size_t) (nodesUsed * sizeof(ExprNode))); + memcpy(newPtr, staticNodes, + (size_t) nodesUsed * sizeof(ExprNode)); } nodes = newPtr; lastOrphanPtr = nodes + lastOrphanIdx; @@ -1186,7 +1233,9 @@ Tcl_ParseExpr( nodePtr = nodes + nodesUsed; lastNodePtr = nodePtr - 1; - /* Skip white space between lexemes */ + /* + * Skip white space between lexemes. + */ scanned = TclParseAllWhiteSpace(start, numBytes); start += scanned; @@ -1194,7 +1243,9 @@ Tcl_ParseExpr( scanned = ParseLexeme(start, numBytes, &(nodePtr->lexeme), NULL); - /* Use context to categorize the lexemes that are ambiguous */ + /* + * Use context to categorize the lexemes that are ambiguous. + */ if ((NODE_TYPE & nodePtr->lexeme) == 0) { switch (nodePtr->lexeme) { @@ -1248,7 +1299,9 @@ Tcl_ParseExpr( } } - /* Add node to parse tree based on category */ + /* + * Add node to parse tree based on category. + */ switch (NODE_TYPE & nodePtr->lexeme) { case LEAF: { @@ -1424,8 +1477,11 @@ Tcl_ParseExpr( if ((nodePtr->lexeme == CLOSE_PAREN) && (lastNodePtr->lexeme == OPEN_PAREN)) { if (lastNodePtr[-1].lexeme == FUNCTION) { - /* Normally, "()" is a syntax error, but as a special - * case accept it as an argument list for a function */ + /* + * Normally, "()" is a syntax error, but as a special case + * accept it as an argument list for a function. + */ + scanned = 0; nodePtr->lexeme = EMPTY; nodePtr->left = -1; @@ -1451,24 +1507,22 @@ Tcl_ParseExpr( if (lastNodePtr->lexeme == OPEN_PAREN) { msg = Tcl_NewStringObj("unbalanced open paren", -1); } else if (lastNodePtr->lexeme == COMMA) { - msg = Tcl_ObjPrintf( + msg = Tcl_ObjPrintf( "missing function argument at %s", mark); scanned = 0; insertMark = 1; } else if (lastNodePtr->lexeme == START) { msg = Tcl_NewStringObj("empty expression", -1); } - } else { - if (nodePtr->lexeme == CLOSE_PAREN) { - msg = Tcl_NewStringObj("unbalanced close paren", -1); - } else if ((nodePtr->lexeme == COMMA) - && (lastNodePtr->lexeme == OPEN_PAREN) - && (lastNodePtr[-1].lexeme == FUNCTION)) { - msg = Tcl_ObjPrintf( - "missing function argument at %s", mark); - scanned = 0; - insertMark = 1; - } + } else if (nodePtr->lexeme == CLOSE_PAREN) { + msg = Tcl_NewStringObj("unbalanced close paren", -1); + } else if ((nodePtr->lexeme == COMMA) + && (lastNodePtr->lexeme == OPEN_PAREN) + && (lastNodePtr[-1].lexeme == FUNCTION)) { + msg = Tcl_ObjPrintf( + "missing function argument at %s", mark); + scanned = 0; + insertMark = 1; } if (msg == NULL) { msg = Tcl_ObjPrintf("missing operand at %s", mark); @@ -1480,7 +1534,6 @@ Tcl_ParseExpr( } while (1) { - if (lastOrphanPtr->parent >= 0) { otherPtr = nodes + lastOrphanPtr->parent; } else if (lastOrphanPtr->left >= 0) { @@ -1496,8 +1549,11 @@ Tcl_ParseExpr( } if (prec[otherPtr->lexeme] == precedence) { - /* Special association rules for the ternary operators. */ - if ((otherPtr->lexeme == QUESTION) + /* + * Special association rules for the ternary operators. + */ + + if ((otherPtr->lexeme == QUESTION) && (lastOrphanPtr->lexeme != COLON)) { break; } @@ -1505,13 +1561,20 @@ Tcl_ParseExpr( && (nodePtr->lexeme == QUESTION)) { break; } - /* Right association rules for exponentiation. */ + + /* + * Right association rules for exponentiation. + */ + if (nodePtr->lexeme == EXPON) { break; } } - /* Some checks before linking */ + /* + * Some checks before linking. + */ + if ((otherPtr->lexeme == OPEN_PAREN) && (nodePtr->lexeme != CLOSE_PAREN)) { lastOrphanPtr = otherPtr; @@ -1537,19 +1600,28 @@ Tcl_ParseExpr( break; } - /* Link orphan as right operand of otherPtr */ + /* + * Link orphan as right operand of otherPtr. + */ + otherPtr->right = lastOrphanPtr - nodes; lastOrphanPtr->parent = otherPtr - nodes; lastOrphanPtr = otherPtr; if (otherPtr->lexeme == OPEN_PAREN) { - /* CLOSE_PAREN can only close one OPEN_PAREN */ + /* + * CLOSE_PAREN can only close one OPEN_PAREN. + */ + tokenPtr = scratch.tokenPtr + otherPtr->token; tokenPtr->size = start + scanned - tokenPtr->start; break; } if (otherPtr->lexeme == START) { - /* Don't backtrack beyond the start */ + /* + * Don't backtrack beyond the start. + */ + break; } } @@ -1563,7 +1635,11 @@ Tcl_ParseExpr( code = TCL_ERROR; continue; } - /* Create no node for a CLOSE_PAREN lexeme */ + + /* + * Create no node for a CLOSE_PAREN lexeme. + */ + break; } @@ -1583,7 +1659,10 @@ Tcl_ParseExpr( continue; } - /* Link orphan as left operand of new node */ + /* + * Link orphan as left operand of new node. + */ + nodePtr->right = -1; if (scratch.numTokens >= scratch.tokensAvailable) { @@ -1611,7 +1690,10 @@ Tcl_ParseExpr( } if (code == TCL_OK) { - /* Shift tokens from scratch space to caller space */ + /* + * Shift tokens from scratch space to caller space. + */ + GenerateTokens(nodes, &scratch, parsePtr); } else { if (parsePtr->errorType == TCL_PARSE_SUCCESS) { @@ -1626,7 +1708,8 @@ Tcl_ParseExpr( if (msg == NULL) { msg = Tcl_GetObjResult(interp); } - Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", + Tcl_AppendPrintfToObj(msg, + "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", ((start - limit) < scratch.string) ? "" : "...", ((start - limit) < scratch.string) ? (start - scratch.string) : limit - 3, @@ -1638,8 +1721,7 @@ Tcl_ParseExpr( (start + scanned + limit > scratch.end) ? scratch.end - (start + scanned) : limit-3, start + scanned, - (start + scanned + limit > scratch.end) ? "" : "..." - ); + (start + scanned + limit > scratch.end) ? "" : "..."); if (post != NULL) { Tcl_AppendToObj(msg, ";\n", -1); Tcl_AppendObjToObj(msg, post); @@ -1661,19 +1743,18 @@ Tcl_ParseExpr( return code; #endif } - -#ifdef PARSE_DIRECT_EXPR_TOKENS +#ifdef PARSE_DIRECT_EXPR_TOKENS /* *---------------------------------------------------------------------- * * GenerateTokens -- * - * Routine that generates Tcl_Tokens that represent a Tcl expression - * and writes them to *parsePtr. The parse tree of the expression - * is in the array of ExprNodes, nodes. Some of the Tcl_Tokens are - * copied from scratch space at *scratchPtr, where the parsing pass - * that constructed the parse tree left them. + * Routine that generates Tcl_Tokens that represent a Tcl expression and + * writes them to *parsePtr. The parse tree of the expression is in the + * array of ExprNodes, nodes. Some of the Tcl_Tokens are copied from + * scratch space at *scratchPtr, where the parsing pass that constructed + * the parse tree left them. * *---------------------------------------------------------------------- */ @@ -1813,15 +1894,14 @@ GenerateTokens( } } #endif - /* *---------------------------------------------------------------------- * * ParseLexeme -- * - * Parse a single lexeme from the start of a string, scanning no - * more than numBytes bytes. + * Parse a single lexeme from the start of a string, scanning no more + * than numBytes bytes. * * Results: * Returns the number of bytes scanned to produce the lexeme. @@ -1838,8 +1918,8 @@ ParseLexeme( int numBytes, /* Number of bytes in string. */ unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ - Tcl_Obj **literalPtr) /* Write corresponding literal value to - this storage, if non-NULL. */ + Tcl_Obj **literalPtr) /* Write corresponding literal value to this + storage, if non-NULL. */ { CONST char *end; int scanned; @@ -2073,10 +2153,10 @@ static int traceExprComp = 0; #endif /* TCL_COMPILE_DEBUG */ /* - * Definitions of numeric codes representing each expression operator. The - * order of these must match the entries in the operatorTable below. Also the + * Definitions of numeric codes representing each expression operator. The + * order of these must match the entries in the operatorTable below. Also the * codes for the relational operators (OP_LESS, OP_GREATER, OP_LE, OP_GE, - * OP_EQ, and OP_NE) must be consecutive and in that order. Note that OP_PLUS + * OP_EQ, and OP_NE) must be consecutive and in that order. Note that OP_PLUS * and OP_MINUS represent both unary and binary operators. */ @@ -2161,14 +2241,13 @@ static OperatorDesc operatorTable[] = { static Tcl_HashTable opHashTable; -#endif +#endif /* USE_EXPR_TOKENS */ /* * Declarations for local procedures to this file: */ #ifdef USE_EXPR_TOKENS - static void CompileCondExpr(Tcl_Interp *interp, Tcl_Token *exprTokenPtr, int *convertPtr, CompileEnv *envPtr); @@ -2181,8 +2260,7 @@ static void CompileMathFuncCall(Tcl_Interp *interp, static void CompileSubExpr(Tcl_Interp *interp, Tcl_Token *exprTokenPtr, int *convertPtr, CompileEnv *envPtr); -#endif - +#endif /* USE_EXPR_TOKENS */ static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, Tcl_Obj *const litObjv[], Tcl_Obj *funcList, Tcl_Token *tokenPtr, int *convertPtr, @@ -2247,10 +2325,13 @@ TclCompileExpr( Tcl_Obj **litObjv; /* TIP #280 : Track Lines within the expression */ - TclAdvanceLines (&envPtr->line, script, - script+TclParseAllWhiteSpace(script, numBytes)); + TclAdvanceLines(&envPtr->line, script, + script + TclParseAllWhiteSpace(script, numBytes)); + + /* + * Valid parse; compile the tree. + */ - /* Valid parse; compile the tree */ Tcl_ListObjGetElements(NULL, litList, &litObjc, &litObjv); CompileExprTree(interp, opTree, litObjv, funcList, parse.tokenPtr, &needsNumConversion, envPtr); @@ -2261,6 +2342,7 @@ TclCompileExpr( * operands if at all possible as first integers, else * floating-point numbers. */ + TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); } } @@ -2286,9 +2368,11 @@ TclCompileExpr( Tcl_MutexLock(&opMutex); if (!opTableInitialized) { int i; + Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS); for (i = 0; operatorTable[i].name != NULL; i++) { int new; + Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&opHashTable, operatorTable[i].name, &new); if (new) { @@ -2315,7 +2399,7 @@ TclCompileExpr( if (needsNumConversion) { /* - * Attempt to convert the primary's object to an int or double. This + * Attempt to convert the primary's object to an int or double. This * is done in order to support Tcl's policy of interpreting operands * if at all possible as first integers, else floating-point numbers. */ @@ -2327,13 +2411,12 @@ TclCompileExpr( return TCL_OK; #endif } - /* *---------------------------------------------------------------------- * * CompileExprTree -- - * + * [???] * * Results: * None. @@ -2354,9 +2437,9 @@ typedef struct JumpList { static void CompileExprTree( - Tcl_Interp *interp, + Tcl_Interp *interp, OpNode *nodes, - Tcl_Obj * const litObjv[], + Tcl_Obj *const litObjv[], Tcl_Obj *funcList, Tcl_Token *tokenPtr, int *convertPtr, @@ -2387,12 +2470,14 @@ CompileExprTree( case UNARY: if (nodePtr->right > OT_NONE) { int right = nodePtr->right; + nodePtr->right = OT_NONE; if (nodePtr->lexeme == FUNCTION) { Tcl_DString cmdName; - Tcl_Obj *funcName; + Tcl_Obj *funcName; CONST char *p; int length; + Tcl_DStringInit(&cmdName); Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1); Tcl_ListObjIndex(NULL, funcList, nextFunc++, &funcName); @@ -2413,7 +2498,8 @@ CompileExprTree( break; case OT_TOKENS: if (tokenPtr->type != TCL_TOKEN_WORD) { - Tcl_Panic("unexpected token type %d\n", tokenPtr->type); + Tcl_Panic("unexpected token type %d\n", + tokenPtr->type); } TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); @@ -2431,7 +2517,7 @@ CompileExprTree( /* do nothing */ } else if (nodePtr->lexeme == FUNCTION) { int numWords = (nodePtr[1].left - OT_NONE) + 1; - if ( numWords < 255) { + if (numWords < 255) { TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr); } else { TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr); @@ -2454,19 +2540,18 @@ CompileExprTree( TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; - newJump = (JumpList *) + newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; jumpPtr->depth = envPtr->currStackDepth; *convertPtr = 1; - } else if ((nodePtr->lexeme == AND) - || (nodePtr->lexeme == OR)) { + } else if (nodePtr->lexeme == AND || nodePtr->lexeme == OR) { JumpList *newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; - newJump = (JumpList *) + newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; @@ -2478,12 +2563,13 @@ CompileExprTree( } switch (left) { case OT_LITERAL: - TclEmitPush( TclAddLiteralObj( - envPtr, *litObjv++, NULL), envPtr); + TclEmitPush(TclAddLiteralObj(envPtr, *litObjv++, NULL), + envPtr); break; case OT_TOKENS: if (tokenPtr->type != TCL_TOKEN_WORD) { - Tcl_Panic("unexpected token type %d\n", tokenPtr->type); + Tcl_Panic("unexpected token type %d\n", + tokenPtr->type); } TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); @@ -2494,6 +2580,7 @@ CompileExprTree( } } else if (nodePtr->right > OT_NONE) { int right = nodePtr->right; + nodePtr->right = OT_NONE; if (nodePtr->lexeme == QUESTION) { TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, @@ -2514,12 +2601,13 @@ CompileExprTree( } switch (right) { case OT_LITERAL: - TclEmitPush( TclAddLiteralObj( - envPtr, *litObjv++, NULL), envPtr); + TclEmitPush(TclAddLiteralObj(envPtr, *litObjv++, NULL), + envPtr); break; case OT_TOKENS: if (tokenPtr->type != TCL_TOKEN_WORD) { - Tcl_Panic("unexpected token type %d\n", tokenPtr->type); + Tcl_Panic("unexpected token type %d\n", + tokenPtr->type); } TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); @@ -2529,8 +2617,7 @@ CompileExprTree( nodePtr = nodes + right; } } else { - if ((nodePtr->lexeme == COMMA) - || (nodePtr->lexeme == QUESTION)) { + if (nodePtr->lexeme == COMMA || nodePtr->lexeme == QUESTION) { /* do nothing */ } else if (nodePtr->lexeme == COLON) { if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump), @@ -2595,9 +2682,12 @@ OpCmd( int code, tmp=1; Tcl_Obj *byteCodeObj = Tcl_NewObj(); - /* Note we are compiling an expression with literal arguments. - * This means there can be no [info frame] calls when we execute - * the resulting bytecode, so there's no need to tend to TIP 280 issues */ + /* + * Note we are compiling an expression with literal arguments. This means + * there can be no [info frame] calls when we execute the resulting + * bytecode, so there's no need to tend to TIP 280 issues. + */ + TclInitCompileEnv(interp, &compEnv, NULL, 0, NULL, 0); CompileExprTree(interp, nodes, litObjv, NULL, NULL, &tmp, &compEnv); TclEmitOpcode(INST_DONE, &compEnv); @@ -2830,9 +2920,8 @@ TclFinalizeCompilation(void) Tcl_MutexUnlock(&opMutex); #endif } - -#ifdef USE_EXPR_TOKENS +#ifdef USE_EXPR_TOKENS /* *---------------------------------------------------------------------- * @@ -2861,7 +2950,10 @@ CompileSubExpr( * not needed */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - /* Switch on the type of the first token after the subexpression token. */ + /* + * Switch on the type of the first token after the subexpression token. + */ + Tcl_Token *tokenPtr = exprTokenPtr+1; TRACE(exprTokenPtr->start, exprTokenPtr->size, tokenPtr->start, tokenPtr->size); @@ -2896,9 +2988,10 @@ CompileSubExpr( case TCL_TOKEN_OPERATOR: { /* - * Look up the operator. If the operator isn't found, treat it as a + * Look up the operator. If the operator isn't found, treat it as a * math function. */ + OperatorDesc *opDescPtr; Tcl_HashEntry *hPtr; CONST char *operator; @@ -3067,7 +3160,7 @@ CompileLandOrLorExpr( TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup); /* - * Fixup the short-circuit jumps and push the shortCircuit value. Note + * Fixup the short-circuit jumps and push the shortCircuit value. Note * that shortCircuitFixup2 is always a short jump. */ @@ -3243,12 +3336,15 @@ CompileMathFuncCall( afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1); while (tokenPtr != afterSubexprPtr) { int convert = 0; + ++argCount; CompileSubExpr(interp, tokenPtr, &convert, envPtr); tokenPtr += (tokenPtr->numComponents + 1); } - /* Invoke the function */ + /* + * Invoke the function. + */ if (argCount < 255) { TclEmitInstInt1(INST_INVOKE_STK1, argCount, envPtr); @@ -3257,7 +3353,6 @@ CompileMathFuncCall( } } #endif - /* * Local Variables: diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 96d1e81..a99f501 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -3,12 +3,12 @@ * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. - * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.66 2006/12/12 17:21:42 dgp Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.67 2006/12/13 16:28:06 dkf Exp $ */ #ifndef _TCLCOMPILATION @@ -115,27 +115,29 @@ typedef struct CmdLocation { /* * TIP #280 - * Structure to record additional location information for byte code. - * This information is internal and not saved. I.e. tbcload'ed code - * will not have this information. It records the lines for all words - * of all commands found in the byte code. The association with a - * ByteCode structure BC is done through the 'lineBCPtr' HashTable in - * Interp, keyed by the address of BC. Also recorded is information - * coming from the context, i.e. type of the frame and associated - * information, like the path of a sourced file. + * Structure to record additional location information for byte code. This + * information is internal and not saved. i.e. tbcload'ed code will not have + * this information. It records the lines for all words of all commands found + * in the byte code. The association with a ByteCode structure BC is done + * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC. + * Also recorded is information coming from the context, i.e. type of the + * frame and associated information, like the path of a sourced file. */ typedef struct ECL { - int srcOffset; /* cmd location to find the entry */ - int nline; - int* line; /* line information for all words in the command */ + int srcOffset; /* Command location to find the entry. */ + int nline; + int *line; /* Line information for all words in the + * command. */ } ECL; + typedef struct ExtCmdLoc { - int type; /* Context type */ - Tcl_Obj* path; /* Path of the sourced file the command is in */ - ECL* loc; /* Command word locations (lines) */ - int nloc; /* Number of allocated entries in 'loc' */ - int nuloc; /* Number of used entries in 'loc' */ + int type; /* Context type. */ + Tcl_Obj *path; /* Path of the sourced file the command is + * in. */ + ECL *loc; /* Command word locations (lines). */ + int nloc; /* Number of allocated entries in 'loc'. */ + int nuloc; /* Number of used entries in 'loc'. */ } ExtCmdLoc; /* @@ -164,7 +166,7 @@ typedef void (AuxDataFreeProc) (ClientData clientData); */ typedef struct AuxDataType { - char *name; /* the name of the type. Types can be + char *name; /* The name of the type. Types can be * registered and found by name */ AuxDataDupProc *dupProc; /* Callback procedure to invoke when the aux * data is duplicated (e.g., when the ByteCode @@ -184,7 +186,7 @@ typedef struct AuxDataType { */ typedef struct AuxData { - AuxDataType *type; /* pointer to the AuxData type associated with + AuxDataType *type; /* Pointer to the AuxData type associated with * this ClientData. */ ClientData clientData; /* The compilation data itself. */ } AuxData; @@ -298,6 +300,7 @@ typedef struct CompileEnv { * A PRECOMPILED bytecode struct is one that was generated from a compiled * image rather than implicitly compiled from source */ + #define TCL_BYTECODE_PRECOMPILED 0x0001 /* @@ -635,8 +638,7 @@ typedef struct InstructionDesc { * instruction, used for stack requirements * computations. The value INT_MIN signals * that the instruction's worst case effect is - * (1-opnd1). - */ + * (1-opnd1). */ int numOperands; /* Number of operands. */ InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS]; /* The type of each operand. */ @@ -750,12 +752,12 @@ MODULE_SCOPE AuxDataType tclJumptableInfoType; /* * ClientData type used by the math operator commands. */ + typedef struct { const char *operator; const char *expected; int numArgs; } TclOpCmdClientData; - /* *---------------------------------------------------------------- @@ -781,8 +783,8 @@ MODULE_SCOPE int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* *---------------------------------------------------------------- - * Procedures shared among Tcl bytecode compilation and execution - * modules but not used outside: + * Procedures shared among Tcl bytecode compilation and execution modules but + * not used outside: *---------------------------------------------------------------- */ |