Index: generic/tclAssembly.c ================================================================== --- generic/tclAssembly.c +++ generic/tclAssembly.c @@ -232,10 +232,12 @@ * Static functions defined in this file. */ static void AddBasicBlockRangeToErrorInfo(AssemblyEnv*, BasicBlock*); +static void AdvanceLines(int *line, const char *start, + const char *end); static BasicBlock * AllocBB(AssemblyEnv*); static int AssembleOneLine(AssemblyEnv* envPtr); static void BBAdjustStackDepth(BasicBlock* bbPtr, int consumed, int produced); static void BBUpdateStackReqs(BasicBlock* bbPtr, int tblIdx, @@ -496,10 +498,25 @@ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ INST_REVERSE, /* 126 */ INST_NOP /* 132 */ }; + +static void +AdvanceLines( + int *line, + const char *start, + const char *end) +{ + register const char *p; + + for (p = start; p < end; p++) { + if (*p == '\n') { + (*line)++; + } + } +} /* * Helper macros. */ @@ -841,21 +858,18 @@ } else { return codePtr; } } - /* - * Set up the compilation environment, and assemble the code. - */ + /* Set up the compilation environment, and assemble the code */ source = TclGetStringFromObj(objPtr, &sourceLen); - TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0); + TclInitCompileEnv(interp, &compEnv, source, sourceLen); status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT); if (status != TCL_OK) { - /* - * Assembly failed. Clean up and report the error. - */ + + /* Assembly failed. Clean up and report the error */ TclFreeCompileEnv(&compEnv); return NULL; } @@ -1017,14 +1031,12 @@ /* * Advance the pointers around any leading commentary. */ - TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr, + AdvanceLines(&assemEnvPtr->cmdLine, instPtr, parsePtr->commandStart); - TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext, - parsePtr->commandStart - envPtr->source); /* * Process the line of code. */ @@ -1058,14 +1070,12 @@ */ nextPtr = parsePtr->commandStart + parsePtr->commandSize; bytesLeft -= (nextPtr - instPtr); instPtr = nextPtr; - TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart, + AdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart, instPtr); - TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext, - instPtr - envPtr->source); Tcl_FreeParse(parsePtr); } while (bytesLeft > 0); /* * Done with parsing the code. @@ -1102,12 +1112,11 @@ Tcl_Parse* parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Parse of one line of assembly code */ assemEnvPtr->envPtr = envPtr; assemEnvPtr->parsePtr = parsePtr; - assemEnvPtr->cmdLine = envPtr->line; - assemEnvPtr->clNext = envPtr->clNext; + assemEnvPtr->cmdLine = 1; /* * Make the hashtables that store symbol resolution. */ Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -79,23 +79,19 @@ /* * Declarations for managing contexts for non-recursive coroutines. Contexts * are used to save the evaluation state between NR calls to each coro. */ -static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL}; +static const CorContext NULL_CONTEXT = {NULL, NULL}; #define SAVE_CONTEXT(context) \ (context).framePtr = iPtr->framePtr; \ - (context).varFramePtr = iPtr->varFramePtr; \ - (context).cmdFramePtr = iPtr->cmdFramePtr; \ - (context).lineLABCPtr = iPtr->lineLABCPtr + (context).varFramePtr = iPtr->varFramePtr #define RESTORE_CONTEXT(context) \ iPtr->framePtr = (context).framePtr; \ - iPtr->varFramePtr = (context).varFramePtr; \ - iPtr->cmdFramePtr = (context).cmdFramePtr; \ - iPtr->lineLABCPtr = (context).lineLABCPtr + iPtr->varFramePtr = (context).varFramePtr /* * Static functions in this file: */ @@ -167,10 +163,35 @@ static void ClearTailcall(Tcl_Interp *interp, struct NRE_callback *tailcallPtr); static Tcl_ObjCmdProc NRCoroInjectObjCmd; MODULE_SCOPE const TclStubs tclStubs; + +static void UpdateStringOfScriptSource(Tcl_Obj *objPtr); + +static const Tcl_ObjType scriptSourceType = { + "scriptSource", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + UpdateStringOfScriptSource, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + +static void +UpdateStringOfScriptSource( + Tcl_Obj *objPtr) +{ + const char *bytes = objPtr->internalRep.twoPtrValue.ptr1; + int len = PTR2INT(objPtr->internalRep.twoPtrValue.ptr2); + + if (bytes) { + objPtr->bytes = (char *) ckalloc((unsigned) len + 1); + memcpy(objPtr->bytes, bytes, len); + objPtr->bytes[len] = '\0'; + objPtr->length = len; + } +} /* * Magical counts for the number of arguments accepted by a coroutine command * after particular kinds of [yield]. */ @@ -515,26 +536,10 @@ 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 */ - /* - * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc - * structures. - */ - - iPtr->cmdFramePtr = NULL; - iPtr->linePBodyPtr = ckalloc(sizeof(Tcl_HashTable)); - iPtr->lineBCPtr = ckalloc(sizeof(Tcl_HashTable)); - iPtr->lineLAPtr = ckalloc(sizeof(Tcl_HashTable)); - iPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable)); - Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS); - Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); - Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS); - Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); - iPtr->scriptCLLocPtr = NULL; - iPtr->activeVarTracePtr = NULL; iPtr->returnOpts = NULL; iPtr->errorInfo = NULL; TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo"); @@ -734,10 +739,12 @@ iPtr->allocCache = NULL; #endif iPtr->pendingObjDataPtr = NULL; iPtr->asyncReadyPtr = TclGetAsyncReadyPtr(); iPtr->deferredCallbacks = NULL; + + iPtr->cmdSourcePtr = NULL; /* * Create the core commands. Do it here, rather than calling * Tcl_CreateCommand, because it's faster (there's no need to check for a * pre-existing command by the same name). If a command has a Tcl_CmdProc @@ -1350,11 +1357,10 @@ Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_HashTable *hTablePtr; ResolverScheme *resPtr, *nextResPtr; - int i; /* * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup. */ @@ -1545,92 +1551,10 @@ * interpreter. */ TclDeleteLiteralTable(interp, &iPtr->literalTable); - /* - * TIP #280 - Release the arrays for ByteCode/Proc extension, and - * contents. - */ - - for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&search)) { - CmdFrame *cfPtr = Tcl_GetHashValue(hPtr); - - if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfPtr->data.eval.path); - } - ckfree(cfPtr->line); - ckfree(cfPtr); - Tcl_DeleteHashEntry(hPtr); - } - Tcl_DeleteHashTable(iPtr->linePBodyPtr); - ckfree(iPtr->linePBodyPtr); - iPtr->linePBodyPtr = NULL; - - /* - * See also tclCompile.c, TclCleanupByteCode - */ - - for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&search)) { - ExtCmdLoc *eclPtr = Tcl_GetHashValue(hPtr); - - if (eclPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(eclPtr->path); - } - for (i=0; i< eclPtr->nuloc; i++) { - ckfree(eclPtr->loc[i].line); - } - - if (eclPtr->loc != NULL) { - ckfree(eclPtr->loc); - } - - Tcl_DeleteHashTable(&eclPtr->litInfo); - - ckfree(eclPtr); - Tcl_DeleteHashEntry(hPtr); - } - Tcl_DeleteHashTable(iPtr->lineBCPtr); - ckfree(iPtr->lineBCPtr); - iPtr->lineBCPtr = NULL; - - /* - * Location stack for uplevel/eval/... scripts which were passed through - * proc arguments. Actually we track all arguments as we do not and cannot - * know which arguments will be used as scripts and which will not. - */ - - if (iPtr->lineLAPtr->numEntries) { - /* - * When the interp goes away we have nothing on the stack, so there - * are no arguments, so this table has to be empty. - */ - - Tcl_Panic("Argument location tracking table not empty"); - } - - Tcl_DeleteHashTable(iPtr->lineLAPtr); - ckfree(iPtr->lineLAPtr); - iPtr->lineLAPtr = NULL; - - if (iPtr->lineLABCPtr->numEntries) { - /* - * When the interp goes away we have nothing on the stack, so there - * are no arguments, so this table has to be empty. - */ - - Tcl_Panic("Argument location tracking table not empty"); - } - - Tcl_DeleteHashTable(iPtr->lineLABCPtr); - ckfree(iPtr->lineLABCPtr); - iPtr->lineLABCPtr = NULL; - /* * Squelch the tables of traces on variables and searches over arrays in * the in the interpreter. */ @@ -3306,38 +3230,30 @@ Interp *iPtr, int objc, Tcl_Obj *const objv[], int lookup) { - Tcl_Obj *objPtr, *obj2Ptr; - CmdFrame *cfPtr = iPtr->cmdFramePtr; - const char *command = NULL; - int numChars; - - objPtr = Tcl_NewListObj(objc, objv); - if (lookup && cfPtr && (cfPtr->numLevels == iPtr->numLevels-1)) { - switch (cfPtr->type) { - case TCL_LOCATION_EVAL: - case TCL_LOCATION_SOURCE: - command = cfPtr->cmd.str.cmd; - numChars = cfPtr->cmd.str.len; - break; - case TCL_LOCATION_BC: - case TCL_LOCATION_PREBC: - command = TclGetSrcInfoForCmd(iPtr, &numChars); - break; - case TCL_LOCATION_EVAL_LIST: - /* Got it already */ - break; - } - if (command) { - obj2Ptr = Tcl_NewStringObj(command, numChars); - objPtr->bytes = obj2Ptr->bytes; - objPtr->length = numChars; - obj2Ptr->bytes = NULL; - Tcl_DecrRefCount(obj2Ptr); - } + Tcl_Obj *objPtr = Tcl_NewListObj(objc, objv); + + if (iPtr->cmdSourcePtr) { + char *command; + int len; + char *orig = iPtr->cmdSourcePtr->bytes; + + command = Tcl_GetStringFromObj(iPtr->cmdSourcePtr, &len); + objPtr->bytes = (char *) ckalloc((unsigned) len + 1); + strcpy(objPtr->bytes, command); + objPtr->length = len; + + /* + * Avoid leaving a string rep if none was there. + */ + + if (orig == NULL) { + TclInvalidateStringRep(iPtr->cmdSourcePtr); + } + } Tcl_IncrRefCount(objPtr); return objPtr; } @@ -4221,10 +4137,11 @@ } if (result != TCL_OK) { return result; } } + iPtr->cmdSourcePtr = NULL; #ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { const char *a[10]; @@ -4234,18 +4151,10 @@ a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++; } TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9]); } - if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) { - Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr); - const char *a[6]; int i[2]; - - TclDTraceInfo(info, a, i); - TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); - TclDecrRefCount(info); - } if (TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) { TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL); } if (TCL_DTRACE_CMD_ENTRY_ENABLED()) { TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1, @@ -4799,12 +4708,11 @@ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ int count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { - return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, - NULL, NULL); + return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL); } /* *---------------------------------------------------------------------- * @@ -4868,11 +4776,10 @@ * TCL_ERROR. A result or error message is left in interp's result. * * Side effects: * Depends on the script. * - * TIP #280 : Keep public API, internally extended API. *---------------------------------------------------------------------- */ int Tcl_EvalEx( @@ -4884,43 +4791,10 @@ * first null character. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ { - return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script); -} - -int -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 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. */ - int *clNextOuter, /* Information about an outer context for */ - const char *outerScript) /* continuation line data. This is set only in - * TclSubstTokens(), to properly handle - * [...]-nested commands. The 'outerScript' - * refers to the most-outer script containing - * the embedded command, which is refered to - * by 'script'. The 'clNextOuter' refers to - * the current entry in the table of - * continuation lines in this "master script", - * and the character offsets are relative to - * the 'outerScript' as well. - * - * If outerScript == script, then this call is - * for the outer-most script/command. See - * Tcl_EvalEx() and TclEvalObjEx() for places - * generating arguments for which this is - * true. */ -{ Interp *iPtr = (Interp *) interp; const char *p, *next; const unsigned int minObjs = 20; Tcl_Obj **objv, **objvSpace; int *expand, *lines, *lineSpace; @@ -4934,32 +4808,13 @@ /* 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. */ Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); - CmdFrame *eeFramePtr = TclStackAlloc(interp, sizeof(CmdFrame)); Tcl_Obj **stackObjArray = TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); int *expandStack = TclStackAlloc(interp, minObjs * sizeof(int)); - int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int)); - /* TIP #280 Structures for tracking of command - * locations. */ - int *clNext = NULL; /* Pointer for the tracking of invisible - * continuation lines. Initialized only if the - * caller gave us a table of locations to - * track, via scriptCLLocPtr. It always refers - * to the table entry holding the location of - * the next invisible continuation line to - * look for, while parsing the script. */ - - if (iPtr->scriptCLLocPtr) { - if (clNextOuter) { - clNext = clNextOuter; - } else { - clNext = &iPtr->scriptCLLocPtr->loc[0]; - } - } if (numBytes < 0) { numBytes = strlen(script); } Tcl_ResetResult(interp); @@ -4973,110 +4828,23 @@ * Each iteration through the following loop parses the next command from * the script and then executes it. */ objv = objvSpace = stackObjArray; - lines = lineSpace = linesStack; expand = expandStack; p = script; bytesLeft = numBytes; - /* - * TIP #280 Initialize tracking. Do not push on the frame stack yet. - * - * We may continue counting based on a specific context (CTX), or open a - * new context, either for a sourced script, or 'eval'. For sourced files - * we always have a path object, even if nothing was specified in the - * interp itself. That makes code using it simpler as NULL checks can be - * left out. Sourced file without path in the 'scriptFile' is possible - * during Tcl initialization. - */ - - eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1; - eeFramePtr->numLevels = iPtr->numLevels; - eeFramePtr->framePtr = iPtr->framePtr; - eeFramePtr->nextPtr = iPtr->cmdFramePtr; - eeFramePtr->nline = 0; - eeFramePtr->line = NULL; - - iPtr->cmdFramePtr = eeFramePtr; - if (iPtr->evalFlags & TCL_EVAL_CTX) { - /* - * Path information comes out of the context. - */ - - eeFramePtr->type = TCL_LOCATION_SOURCE; - eeFramePtr->data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path; - Tcl_IncrRefCount(eeFramePtr->data.eval.path); - } else if (iPtr->evalFlags & TCL_EVAL_FILE) { - /* - * Set up for a sourced file. - */ - - eeFramePtr->type = TCL_LOCATION_SOURCE; - - if (iPtr->scriptFile) { - /* - * 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); - - if (norm == NULL) { - /* - * Error message in the interp result. - */ - - code = TCL_ERROR; - goto error; - } - eeFramePtr->data.eval.path = norm; - } else { - TclNewLiteralStringObj(eeFramePtr->data.eval.path, ""); - } - Tcl_IncrRefCount(eeFramePtr->data.eval.path); - } else { - /* - * Set up for plain eval. - */ - - eeFramePtr->type = TCL_LOCATION_EVAL; - eeFramePtr->data.eval.path = NULL; - } - iPtr->evalFlags = 0; do { if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { code = TCL_ERROR; goto error; } - /* - * TIP #280 Track lines. The parser may have skipped text till it - * found the command we are now at. We have to count the lines in this - * block, and do not forget invisible continuation lines. - */ - - TclAdvanceLines(&line, p, parsePtr->commandStart); - TclAdvanceContinuations(&line, &clNext, - parsePtr->commandStart - outerScript); - gotParse = 1; if (parsePtr->numWords > 0) { - /* - * TIP #280. Track lines within the words of the current - * command. We use a separate pointer into the table of - * continuation line locations to not lose our position for the - * per-command parsing. - */ - - int wordLine = line; - const char *wordStart = parsePtr->commandStart; - int *wordCLNext = clNext; unsigned int objectsNeeded = 0; unsigned int numWords = parsePtr->numWords; /* * Generate an array of objects for the words of the command. @@ -5083,43 +4851,19 @@ */ if (numWords > minObjs) { expand = ckalloc(numWords * sizeof(int)); objvSpace = ckalloc(numWords * sizeof(Tcl_Obj *)); - lineSpace = ckalloc(numWords * sizeof(int)); } expandRequested = 0; objv = objvSpace; - lines = lineSpace; - iPtr->cmdFramePtr = eeFramePtr->nextPtr; for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr; objectsUsed < 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). - */ - - TclAdvanceLines(&wordLine, wordStart, tokenPtr->start); - TclAdvanceContinuations(&wordLine, &wordCLNext, - tokenPtr->start - outerScript); - wordStart = tokenPtr->start; - - lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL) - ? wordLine : -1; - - if (eeFramePtr->type == TCL_LOCATION_SOURCE) { - iPtr->evalFlags |= TCL_EVAL_FILE; - } - code = TclSubstTokens(interp, tokenPtr+1, - tokenPtr->numComponents, NULL, wordLine, - wordCLNext, outerScript); + tokenPtr->numComponents, NULL); iPtr->evalFlags = 0; if (code != TCL_OK) { break; @@ -5148,26 +4892,20 @@ } else { expand[objectsUsed] = 0; objectsNeeded++; } - if (wordCLNext) { - TclContinuationsEnterDerived(objv[objectsUsed], - wordStart - outerScript, wordCLNext); - } } /* for loop */ - iPtr->cmdFramePtr = eeFramePtr; if (code != TCL_OK) { goto error; } if (expandRequested) { /* * Some word expansion was requested. Check for objv resize. */ Tcl_Obj **copy = objvSpace; - int *lcopy = lineSpace; int wordIdx = numWords; int objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { objv = objvSpace = @@ -5183,58 +4921,43 @@ Tcl_ListObjGetElements(NULL, temp, &numElements, &elements); objectsUsed += numElements; while (numElements--) { - lines[objIdx] = -1; objv[objIdx--] = elements[numElements]; Tcl_IncrRefCount(elements[numElements]); } Tcl_DecrRefCount(temp); } else { - lines[objIdx] = lcopy[wordIdx]; objv[objIdx--] = copy[wordIdx]; objectsUsed++; } } objv += objIdx+1; if (copy != stackObjArray) { ckfree(copy); } - if (lcopy != linesStack) { - ckfree(lcopy); - } } /* * Execute the command and free the objects for its words. - * - * TIP #280: Remember the command itself for 'info frame'. We - * shorten the visible command by one char to exclude the - * termination character, if necessary. Here is where we put our - * frame on the stack of frames too. _After_ the nested commands - * have been executed. */ - eeFramePtr->cmd.str.cmd = parsePtr->commandStart; - eeFramePtr->cmd.str.len = parsePtr->commandSize; - - if (parsePtr->term == - parsePtr->commandStart + parsePtr->commandSize - 1) { - eeFramePtr->cmd.str.len--; - } - - eeFramePtr->nline = objectsUsed; - eeFramePtr->line = lines; - - TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr); - code = Tcl_EvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR); - TclArgumentRelease(interp, objv, objectsUsed); - - eeFramePtr->line = NULL; - eeFramePtr->nline = 0; + { + Tcl_Obj *srcPtr = Tcl_NewObj(); + + srcPtr->bytes = NULL; + srcPtr->typePtr = &scriptSourceType; + srcPtr->internalRep.twoPtrValue.ptr1 = (char *) script; + srcPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(numBytes); + iPtr->cmdSourcePtr = srcPtr; + + code = Tcl_EvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR); + + Tcl_DecrRefCount(srcPtr); + } if (code != TCL_OK) { goto error; } for (i = 0; i < objectsUsed; i++) { @@ -5242,12 +4965,10 @@ } objectsUsed = 0; if (objvSpace != stackObjArray) { ckfree(objvSpace); objvSpace = stackObjArray; - ckfree(lineSpace); - lineSpace = linesStack; } /* * Free expand separately since objvSpace could have been * reallocated above. @@ -5259,19 +4980,15 @@ } } /* * Advance to the next command in the script. - * - * TIP #280 Track Lines. Now we track how many lines were in the - * executed command. */ next = parsePtr->commandStart + parsePtr->commandSize; bytesLeft -= next - p; p = next; - TclAdvanceLines(&line, parsePtr->commandStart, p); Tcl_FreeParse(parsePtr); gotParse = 0; } while (bytesLeft > 0); iPtr->varFramePtr = savedVarFramePtr; code = TCL_OK; @@ -5318,461 +5035,23 @@ if (gotParse) { Tcl_FreeParse(parsePtr); } if (objvSpace != stackObjArray) { ckfree(objvSpace); - ckfree(lineSpace); } if (expand != expandStack) { ckfree(expand); } iPtr->varFramePtr = savedVarFramePtr; cleanup_return: - /* - * TIP #280. Release the local CmdFrame, and its contents. - */ - - iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; - if (eeFramePtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(eeFramePtr->data.eval.path); - } - TclStackFree(interp, linesStack); TclStackFree(interp, expandStack); TclStackFree(interp, stackObjArray); - TclStackFree(interp, eeFramePtr); TclStackFree(interp, parsePtr); return code; } - -/* - *---------------------------------------------------------------------- - * - * TclAdvanceLines -- - * - * This function is a helper which counts the number of lines in a block - * of text and advances an external counter. - * - * Results: - * None. - * - * Side effects: - * The specified counter is advanced per the number of lines found. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -void -TclAdvanceLines( - int *line, - const char *start, - const char *end) -{ - register const char *p; - - for (p = start; p < end; p++) { - if (*p == '\n') { - (*line)++; - } - } -} - -/* - *---------------------------------------------------------------------- - * - * TclAdvanceContinuations -- - * - * This procedure is a helper which counts the number of continuation - * lines (CL) in a block of text using a table of CL locations and - * advances an external counter, and the pointer into the table. - * - * Results: - * None. - * - * Side effects: - * The specified counter is advanced per the number of continuation lines - * found. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -void -TclAdvanceContinuations( - int *line, - int **clNextPtrPtr, - int loc) -{ - /* - * Track the invisible continuation lines embedded in a script, if any. - * Here they are just spaces (already). They were removed by - * TclSubstTokens via TclParseBackslash. - * - * *clNextPtrPtr <=> We have continuation lines to track. - * **clNextPtrPtr >= 0 <=> We are not beyond the last possible location. - * loc >= **clNextPtrPtr <=> We stepped beyond the current cont. line. - */ - - while (*clNextPtrPtr && (**clNextPtrPtr >= 0) - && (loc >= **clNextPtrPtr)) { - /* - * We just stepped over an invisible continuation line. Adjust the - * line counter and step to the table entry holding the location of - * the next continuation line to track. - */ - - (*line)++; - (*clNextPtrPtr)++; - } -} - -/* - *---------------------------------------------------------------------- - * Note: The whole data structure access for argument location tracking is - * hidden behind these three functions. The only parts open are the lineLAPtr - * field in the Interp structure. The CFWord definition is internal to here. - * Should make it easier to redo the data structures if we find something more - * space/time efficient. - */ - -/* - *---------------------------------------------------------------------- - * - * TclArgumentEnter -- - * - * This procedure is a helper for the TIP #280 uplevel extension. It - * enters location references for the arguments of a command to be - * invoked. Only the first entry has the actual data, further entries - * simply count the usage up. - * - * Results: - * None. - * - * Side effects: - * May allocate memory. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -void -TclArgumentEnter( - Tcl_Interp *interp, - Tcl_Obj **objv, - int objc, - CmdFrame *cfPtr) -{ - Interp *iPtr = (Interp *) interp; - int new, i; - Tcl_HashEntry *hPtr; - CFWord *cfwPtr; - - for (i = 1; i < objc; i++) { - /* - * Ignore argument words without line information (= dynamic). If they - * are variables they may have location information associated with - * that, either through globally recorded 'set' invokations, or - * literals in bytecode. Eitehr way there is no need to record - * something here. - */ - - if (cfPtr->line[i] < 0) { - continue; - } - hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &new); - if (new) { - /* - * The word is not on the stack yet, remember the current location - * and initialize references. - */ - - cfwPtr = ckalloc(sizeof(CFWord)); - cfwPtr->framePtr = cfPtr; - cfwPtr->word = i; - cfwPtr->refCount = 1; - Tcl_SetHashValue(hPtr, cfwPtr); - } else { - /* - * The word is already on the stack, its current location is not - * relevant. Just remember the reference to prevent early removal. - */ - - cfwPtr = Tcl_GetHashValue(hPtr); - cfwPtr->refCount++; - } - } -} - -/* - *---------------------------------------------------------------------- - * - * TclArgumentRelease -- - * - * This procedure is a helper for the TIP #280 uplevel extension. It - * removes the location references for the arguments of a command just - * done. Usage is counted down, the data is removed only when no user is - * left over. - * - * Results: - * None. - * - * Side effects: - * May release memory. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -void -TclArgumentRelease( - Tcl_Interp *interp, - Tcl_Obj **objv, - int objc) -{ - Interp *iPtr = (Interp *) interp; - int i; - - for (i = 1; i < objc; i++) { - CFWord *cfwPtr; - Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]); - - if (!hPtr) { - continue; - } - cfwPtr = Tcl_GetHashValue(hPtr); - - cfwPtr->refCount--; - if (cfwPtr->refCount > 0) { - continue; - } - - ckfree(cfwPtr); - Tcl_DeleteHashEntry(hPtr); - } -} - -/* - *---------------------------------------------------------------------- - * - * TclArgumentBCEnter -- - * - * This procedure is a helper for the TIP #280 uplevel extension. It - * enters location references for the literal arguments of commands in - * bytecode about to be invoked. Only the first entry has the actual - * data, further entries simply count the usage up. - * - * Results: - * None. - * - * Side effects: - * May allocate memory. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -void -TclArgumentBCEnter( - Tcl_Interp *interp, - Tcl_Obj *objv[], - int objc, - void *codePtr, - CmdFrame *cfPtr, - int pc) -{ - Interp *iPtr = (Interp *) interp; - Tcl_HashEntry *hePtr = - Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr); - ExtCmdLoc *eclPtr; - - if (!hePtr) { - return; - } - eclPtr = Tcl_GetHashValue(hePtr); - hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc)); - if (hePtr) { - int word; - int cmd = PTR2INT(Tcl_GetHashValue(hePtr)); - ECL *ePtr = &eclPtr->loc[cmd]; - CFWordBC *lastPtr = NULL; - - /* - * A few truths ... - * (1) ePtr->nline == objc - * (2) (ePtr->line[word] < 0) => !literal, for all words - * (3) (word == 0) => !literal - * - * Item (2) is why we can use objv to get the literals, and do not - * have to save them at compile time. - */ - - for (word = 1; word < objc; word++) { - if (ePtr->line[word] >= 0) { - int isnew; - Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, - objv[word], &isnew); - CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC)); - - cfwPtr->framePtr = cfPtr; - cfwPtr->obj = objv[word]; - cfwPtr->pc = pc; - cfwPtr->word = word; - cfwPtr->nextPtr = lastPtr; - lastPtr = cfwPtr; - - if (isnew) { - /* - * The word is not on the stack yet, remember the current - * location and initialize references. - */ - - cfwPtr->prevPtr = NULL; - } else { - /* - * The object is already on the stack, however it may have - * a different location now (literal sharing may map - * multiple location to a single Tcl_Obj*. Save the old - * information in the new structure. - */ - - cfwPtr->prevPtr = Tcl_GetHashValue(hPtr); - } - - Tcl_SetHashValue(hPtr, cfwPtr); - } - } /* for */ - - cfPtr->litarg = lastPtr; - } /* if */ -} - -/* - *---------------------------------------------------------------------- - * - * TclArgumentBCRelease -- - * - * This procedure is a helper for the TIP #280 uplevel extension. It - * removes the location references for the literal arguments of commands - * in bytecode just done. Usage is counted down, the data is removed only - * when no user is left over. - * - * Results: - * None. - * - * Side effects: - * May release memory. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -void -TclArgumentBCRelease( - Tcl_Interp *interp, - CmdFrame *cfPtr) -{ - Interp *iPtr = (Interp *) interp; - CFWordBC *cfwPtr = (CFWordBC *) cfPtr->litarg; - - while (cfwPtr) { - CFWordBC *nextPtr = cfwPtr->nextPtr; - Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj); - CFWordBC *xPtr = Tcl_GetHashValue(hPtr); - - if (xPtr != cfwPtr) { - Tcl_Panic("TclArgumentBC Enter/Release Mismatch"); - } - - if (cfwPtr->prevPtr) { - Tcl_SetHashValue(hPtr, cfwPtr->prevPtr); - } else { - Tcl_DeleteHashEntry(hPtr); - } - - ckfree(cfwPtr); - cfwPtr = nextPtr; - } - - cfPtr->litarg = NULL; -} - -/* - *---------------------------------------------------------------------- - * - * TclArgumentGet -- - * - * This procedure is a helper for the TIP #280 uplevel extension. It - * finds the location references for a Tcl_Obj, if any. - * - * Results: - * None. - * - * Side effects: - * Writes found location information into the result arguments. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -void -TclArgumentGet( - Tcl_Interp *interp, - Tcl_Obj *obj, - CmdFrame **cfPtrPtr, - int *wordPtr) -{ - Interp *iPtr = (Interp *) interp; - Tcl_HashEntry *hPtr; - CmdFrame *framePtr; - - /* - * An object which either has no string rep or else is a canonical list is - * guaranteed to have been generated dynamically: bail out, this cannot - * have a usable absolute location. _Do not touch_ the information the set - * up by the caller. It knows better than us. - */ - - if ((!obj->bytes) || ((obj->typePtr == &tclListType) && - ((List *) obj->internalRep.twoPtrValue.ptr1)->canonicalFlag)) { - return; - } - - /* - * First look for location information recorded in the argument - * stack. That is nearest. - */ - - hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) obj); - if (hPtr) { - CFWord *cfwPtr = Tcl_GetHashValue(hPtr); - - *wordPtr = cfwPtr->word; - *cfPtrPtr = cfwPtr->framePtr; - return; - } - - /* - * Check if the Tcl_Obj has location information as a bytecode literal, in - * that stack. - */ - - hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj); - if (hPtr) { - CFWordBC *cfwPtr = Tcl_GetHashValue(hPtr); - - framePtr = cfwPtr->framePtr; - framePtr->data.tebc.pc = (char *) (((ByteCode *) - framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc); - *cfPtrPtr = cfwPtr->framePtr; - *wordPtr = cfwPtr->word; - return; - } -} /* *---------------------------------------------------------------------- * * Tcl_Eval -- @@ -5863,11 +5142,10 @@ * Side effects: * The object is converted, if necessary, to a ByteCode object that holds * the bytecode instructions for the commands. Executing the commands * will almost certainly have side effects that depend on those commands. * - * TIP #280 : Keep public API, internally extended API. *---------------------------------------------------------------------- */ int Tcl_EvalObjEx( @@ -5877,43 +5155,26 @@ * 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. */ { - return TclEvalObjEx(interp, objPtr, flags, NULL, 0); -} - -int -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. */ -{ int result = TCL_OK; NRE_callback *rootPtr = TOP_CB(interp); - result = TclNREvalObjEx(interp, objPtr, flags, invoker, word); + result = TclNREvalObjEx(interp, objPtr, flags); return TclNRRunCallbacks(interp, result, rootPtr); } int TclNREvalObjEx( 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 + 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. */ { Interp *iPtr = (Interp *) interp; int result; List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1; @@ -5925,11 +5186,10 @@ if ((objPtr->typePtr == &tclListType) && /* is a list */ ((objPtr->bytes == NULL || /* no string rep */ listRepPtr->canonicalFlag))) { /* or is canonical */ Tcl_Obj *listPtr = objPtr; - CmdFrame *eoFramePtr = NULL; int objc; Tcl_Obj **objv; /* * Pure List Optimization (no string representation). In this case, we @@ -5959,57 +5219,20 @@ Tcl_IncrRefCount(objPtr); listPtr = TclListObjCopy(interp, objPtr); Tcl_IncrRefCount(listPtr); TclDecrRefCount(objPtr); - if (word != INT_MIN) { - /* - * TIP #280 Structures for tracking lines. As we know that this is - * dynamic execution we ignore the invoker, even if known. - * - * TIP #280. We do _not_ compute all the line numbers for the - * words in the command. For the eval of a pure list the most - * sensible choice is to put all words on line 1. Given that we - * neither need memory for them nor compute anything. 'line' is - * left NULL. The two places using this information (TclInfoFrame, - * and TclInitCompileEnv), are special-cased to use the proper - * line number directly instead of accessing the 'line' array. - * - * Note that we use (word==INTMIN) to signal that no command frame - * should be pushed, as needed by alias and ensemble redirections. - */ - - eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame)); - eoFramePtr->nline = 0; - eoFramePtr->line = NULL; - - eoFramePtr->type = TCL_LOCATION_EVAL_LIST; - eoFramePtr->level = (iPtr->cmdFramePtr == NULL? - 1 : iPtr->cmdFramePtr->level + 1); - eoFramePtr->numLevels = iPtr->numLevels; - eoFramePtr->framePtr = iPtr->framePtr; - eoFramePtr->nextPtr = iPtr->cmdFramePtr; - - eoFramePtr->cmd.listPtr = listPtr; - eoFramePtr->data.eval.path = NULL; - - iPtr->cmdFramePtr = eoFramePtr; - } - - TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, + TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, NULL, NULL, NULL); ListObjGetElements(listPtr, objc, objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); } if (!(flags & TCL_EVAL_DIRECT)) { /* * 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. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); ByteCode *codePtr; CallFrame *savedVarFramePtr = NULL; /* Saves old copy of @@ -6022,11 +5245,11 @@ if (flags & TCL_EVAL_GLOBAL) { savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; } Tcl_IncrRefCount(objPtr); - codePtr = TclCompileObj(interp, objPtr, invoker, word); + codePtr = TclCompileObj(interp, objPtr); TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, objPtr, INT2PTR(allowExceptions), NULL); return TclNRExecuteByteCode(interp, codePtr); } @@ -6035,125 +5258,18 @@ /* * We're not supposed to use the compiler or byte-code * interpreter. Let Tcl_EvalEx evaluate the command directly (and * probably more slowly). * - * TIP #280. Propagate context as much as we can. Especially if the - * script to evaluate is a single literal it makes sense to look if - * our context is one with absolute line numbers we can then track - * into the literal itself too. - * - * See also tclCompile.c, TclInitCompileEnv, for the equivalent code - * in the bytecode compiler. */ const char *script; int numSrcBytes; - /* - * Now we check if we have data about invisible continuation lines for - * the script, and make it available to the direct script parser and - * evaluator we are about to call, if so. - * - * It may be possible that the script Tcl_Obj* can be free'd while the - * evaluator is using it, leading to the release of the associated - * ContLineLoc structure as well. To ensure that the latter doesn't - * happen we set a lock on it. We release this lock later in this - * function, after the evaluator is done. The relevant "lineCLPtr" - * hashtable is managed in the file "tclObj.c". - * - * Another important action is to save (and later restore) the - * continuation line information of the caller, in case we are - * executing nested commands in the eval/direct path. - */ - - ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr; - ContLineLoc *clLocPtr = TclContinuationsGet(objPtr); - - if (clLocPtr) { - iPtr->scriptCLLocPtr = clLocPtr; - Tcl_Preserve(iPtr->scriptCLLocPtr); - } else { - iPtr->scriptCLLocPtr = NULL; - } - Tcl_IncrRefCount(objPtr); - if (invoker == NULL) { - /* - * 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 - * 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 - * relevant word. The type of context is relevant as well. In a - * non-'source' context we don't have to try tracking lines. - * - * First see if the word exists and is a literal. If not we go - * through the easy dynamic branch. No need to perform more - * complex invokations. - */ - - int pc = 0; - CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); - - *ctxPtr = *invoker; - if (invoker->type == TCL_LOCATION_BC) { - /* - * Note: Type BC => ctxPtr->data.eval.path is not used. - * ctxPtr->data.tebc.codePtr is used instead. - */ - - TclGetSrcInfoForPc(ctxPtr); - pc = 1; - } - - script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); - - if ((invoker->nline <= word) || - (invoker->line[word] < 0) || - (ctxPtr->type != TCL_LOCATION_SOURCE)) { - /* - * Dynamic script, or dynamic context, force our own context. - */ - - result = Tcl_EvalEx(interp, script, numSrcBytes, flags); - } else { - /* - * Absolute context to reuse. - */ - - iPtr->invokeCmdFramePtr = ctxPtr; - iPtr->evalFlags |= TCL_EVAL_CTX; - - result = TclEvalEx(interp, script, numSrcBytes, flags, - ctxPtr->line[word], NULL, script); - } - if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { - /* - * Death of SrcInfo reference. - */ - - Tcl_DecrRefCount(ctxPtr->data.eval.path); - } - TclStackFree(interp, ctxPtr); - } - - /* - * Now release the lock on the continuation line information, if any, - * and restore the caller's settings. - */ - - if (iPtr->scriptCLLocPtr) { - Tcl_Release(iPtr->scriptCLLocPtr); - } - iPtr->scriptCLLocPtr = saveCLLocPtr; + script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); + result = Tcl_EvalEx(interp, script, numSrcBytes, flags); TclDecrRefCount(objPtr); return result; } } @@ -6207,24 +5323,13 @@ TEOEx_ListCallback( ClientData data[], Tcl_Interp *interp, int result) { - Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = data[0]; - CmdFrame *eoFramePtr = data[1]; - - /* - * Remove the cmdFrame - */ - - if (eoFramePtr) { - iPtr->cmdFramePtr = eoFramePtr->nextPtr; - TclStackFree(interp, eoFramePtr); - } - TclDecrRefCount(listPtr); - + + TclDecrRefCount(listPtr); return result; } /* *---------------------------------------------------------------------- @@ -7972,69 +7077,10 @@ } /* *---------------------------------------------------------------------- * - * TclDTraceInfo -- - * - * Extract information from a TIP280 dict for use by DTrace probes. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -void -TclDTraceInfo( - Tcl_Obj *info, - const char **args, - int *argsi) -{ - static Tcl_Obj *keys[10] = { NULL }; - Tcl_Obj **k = keys, *val; - int i = 0; - - if (!*k) { -#define kini(s) TclNewLiteralStringObj(keys[i], s); i++ - kini("cmd"); kini("type"); kini("proc"); kini("file"); - kini("method"); kini("class"); kini("lambda"); kini("object"); - kini("line"); kini("level"); -#undef kini - } - for (i = 0; i < 6; i++) { - Tcl_DictObjGet(NULL, info, *k++, &val); - args[i] = val ? TclGetString(val) : NULL; - } - /* no "proc" -> use "lambda" */ - if (!args[2]) { - Tcl_DictObjGet(NULL, info, *k, &val); - args[2] = val ? TclGetString(val) : NULL; - } - k++; - /* no "class" -> use "object" */ - if (!args[5]) { - Tcl_DictObjGet(NULL, info, *k, &val); - args[5] = val ? TclGetString(val) : NULL; - } - k++; - for (i = 0; i < 2; i++) { - Tcl_DictObjGet(NULL, info, *k++, &val); - if (val) { - TclGetIntFromObj(NULL, val, &argsi[i]); - } else { - argsi[i] = 0; - } - } -} - -/* - *---------------------------------------------------------------------- - * * DTraceCmdReturn -- * * NR callback for DTrace command return probes. * * Results: @@ -8109,18 +7155,10 @@ a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++; } TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9]); } - if (TCL_DTRACE_CMD_INFO_ENABLED() && ((Interp *) interp)->cmdFramePtr) { - Tcl_Obj *info = TclInfoFrame(interp, ((Interp *) interp)->cmdFramePtr); - const char *a[6]; int i[2]; - - TclDTraceInfo(info, a, i); - TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); - TclDecrRefCount(info); - } if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) && objc) { TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL); } if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) { @@ -8194,11 +7232,11 @@ Tcl_NREvalObj( Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) { - return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN); + return TclNREvalObjEx(interp, objPtr, flags); } int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the @@ -8602,11 +7640,10 @@ * the job here. The caller context has already been restored. */ NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr); NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr); - NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr); ckfree(corPtr); return result; } NRE_ASSERT(COR_IS_SUSPENDED(corPtr)); @@ -8655,20 +7692,10 @@ TclDeleteExecEnv(corPtr->eePtr); corPtr->eePtr = NULL; corPtr->stackLevel = NULL; - /* - * #280. - * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal - * command arguments in bytecode. - */ - - Tcl_DeleteHashTable(corPtr->lineLABCPtr); - ckfree(corPtr->lineLABCPtr); - corPtr->lineLABCPtr = NULL; - RESTORE_CONTEXT(corPtr->caller); iPtr->execEnvPtr = corPtr->callerEEPtr; iPtr->numLevels++; return result; @@ -8921,46 +7948,16 @@ Tcl_DStringFree(&ds); corPtr->cmdPtr = cmdPtr; cmdPtr->refCount++; - /* - * #280. - * Provide the new coroutine with its own copy of the lineLABCPtr - * hashtable for literal command arguments in bytecode. Note that that - * CFWordBC chains are not duplicated, only the entrypoints to them. This - * means that in the presence of coroutines each chain is potentially a - * tree. Like the chain -> tree conversion of the CmdFrame stack. - */ - - { - Tcl_HashSearch hSearch; - Tcl_HashEntry *hePtr; - - corPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable)); - Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); - - for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); - hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) { - int isNew; - Tcl_HashEntry *newPtr = - Tcl_CreateHashEntry(corPtr->lineLABCPtr, - Tcl_GetHashKey(iPtr->lineLABCPtr, hePtr), - &isNew); - - Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr)); - } - } - /* * Save the base context. */ corPtr->running.framePtr = iPtr->rootFramePtr; corPtr->running.varFramePtr = iPtr->rootFramePtr; - corPtr->running.cmdFramePtr = NULL; - corPtr->running.lineLABCPtr = corPtr->lineLABCPtr; corPtr->stackLevel = NULL; corPtr->auxNumLevels = 0; iPtr->numLevels--; /* Index: generic/tclCmdAH.c ================================================================== --- generic/tclCmdAH.c +++ generic/tclCmdAH.c @@ -294,11 +294,10 @@ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *varNamePtr = NULL; Tcl_Obj *optionVarNamePtr = NULL; - Interp *iPtr = (Interp *) interp; if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "script ?resultVarName? ?optionVarName?"); return TCL_ERROR; @@ -312,15 +311,11 @@ } TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc), varNamePtr, optionVarNamePtr, NULL); - /* - * TIP #280. Make invoking context available to caught script. - */ - - return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1); + return TclNREvalObjEx(interp, objv[1], 0); } static int CatchObjCmdCallback( ClientData data[], @@ -736,42 +731,29 @@ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { register Tcl_Obj *objPtr; - Interp *iPtr = (Interp *) interp; - CmdFrame *invoker = NULL; - int word = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); return TCL_ERROR; } if (objc == 2) { - /* - * TIP #280. Make argument location available to eval'd script. - */ - - invoker = iPtr->cmdFramePtr; - word = 1; objPtr = objv[1]; - TclArgumentGet(interp, objPtr, &invoker, &word); } else { /* * More than one argument: concatenate them together with spaces * between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. - * - * TIP #280. Make invoking context available to eval'd script, done - * with the default values. */ objPtr = Tcl_ConcatObj(objc-1, objv+1); } TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL); - return TclNREvalObjEx(interp, objPtr, 0, invoker, word); + return TclNREvalObjEx(interp, objPtr, 0); } /* *---------------------------------------------------------------------- * @@ -2340,32 +2322,25 @@ ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Interp *iPtr = (Interp *) interp; ForIterData *iterPtr; if (objc != 5) { - Tcl_WrongNumArgs(interp, 1, objv, "start test next command"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, "start test next command"); + return TCL_ERROR; } TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr); iterPtr->cond = objv[2]; iterPtr->body = objv[4]; iterPtr->next = objv[3]; iterPtr->msg = "\n (\"for\" body line %d)"; - iterPtr->word = 4; TclNRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL); - - /* - * TIP #280. Make invoking context available to initial script. - */ - - return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1); + return TclNREvalObjEx(interp, objv[1], 0); } static int ForSetupCallback( ClientData data[], @@ -2424,11 +2399,10 @@ ForCondCallback( ClientData data[], Tcl_Interp *interp, int result) { - Interp *iPtr = (Interp *) interp; ForIterData *iterPtr = data[0]; Tcl_Obj *boolObj = data[1]; int value; if (result != TCL_OK) { @@ -2441,20 +2415,18 @@ return TCL_ERROR; } Tcl_DecrRefCount(boolObj); if (value) { - /* TIP #280. */ if (iterPtr->next) { TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL, NULL); } else { TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); } - return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr, - iterPtr->word); + return TclNREvalObjEx(interp, iterPtr->body, 0); } TclSmallFreeEx(interp, iterPtr); return result; } @@ -2462,23 +2434,17 @@ ForNextCallback( ClientData data[], Tcl_Interp *interp, int result) { - Interp *iPtr = (Interp *) interp; ForIterData *iterPtr = data[0]; Tcl_Obj *next = iterPtr->next; if ((result == TCL_OK) || (result == TCL_CONTINUE)) { TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL, NULL); - - /* - * TIP #280. Make invoking context available to next script. - */ - - return TclNREvalObjEx(interp, next, 0, iPtr->cmdFramePtr, 3); + return TclNREvalObjEx(interp, next, 0); } TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return result; } @@ -2627,12 +2593,11 @@ if (result == TCL_ERROR) { goto done; } TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL); - return TclNREvalObjEx(interp, objv[objc-1], 0, - ((Interp *) interp)->cmdFramePtr, objc-1); + return TclNREvalObjEx(interp, objv[objc-1], 0); } /* * This cleanup stage is only used when an error occurs during setup or if * there is no work to do. @@ -2686,12 +2651,11 @@ if (result == TCL_ERROR) { goto done; } TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL); - return TclNREvalObjEx(interp, statePtr->bodyPtr, 0, - ((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx); + return TclNREvalObjEx(interp, statePtr->bodyPtr, 0); } /* * We're done. Tidy up our work space and finish off. */ Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -120,13 +120,10 @@ static int InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* TIP #348 - New 'info' subcommand 'errorstack' */ static int InfoErrorStackCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -/* TIP #280 - New 'info' subcommand 'frame' */ -static int InfoFrameCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); static int InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoLevelCmd(ClientData dummy, Tcl_Interp *interp, @@ -159,35 +156,34 @@ * Array of values describing how to implement each standard subcommand of the * "info" command. */ static const EnsembleImplMap defaultInfoMap[] = { - {"args", InfoArgsCmd, NULL, NULL, NULL, 0}, - {"body", InfoBodyCmd, NULL, NULL, NULL, 0}, - {"cmdcount", InfoCmdCountCmd, NULL, NULL, NULL, 0}, - {"commands", InfoCommandsCmd, NULL, NULL, NULL, 0}, - {"complete", InfoCompleteCmd, NULL, NULL, NULL, 0}, - {"coroutine", TclInfoCoroutineCmd, NULL, NULL, NULL, 0}, - {"default", InfoDefaultCmd, NULL, NULL, NULL, 0}, - {"errorstack", InfoErrorStackCmd, NULL, NULL, NULL, 0}, - {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL, 0}, - {"frame", InfoFrameCmd, NULL, NULL, NULL, 0}, - {"functions", InfoFunctionsCmd, NULL, NULL, NULL, 0}, - {"globals", TclInfoGlobalsCmd, NULL, NULL, NULL, 0}, - {"hostname", InfoHostnameCmd, NULL, NULL, NULL, 0}, - {"level", InfoLevelCmd, NULL, NULL, NULL, 0}, - {"library", InfoLibraryCmd, NULL, NULL, NULL, 0}, - {"loaded", InfoLoadedCmd, NULL, NULL, NULL, 0}, - {"locals", TclInfoLocalsCmd, NULL, NULL, NULL, 0}, - {"nameofexecutable", InfoNameOfExecutableCmd, NULL, NULL, NULL, 0}, - {"patchlevel", InfoPatchLevelCmd, NULL, NULL, NULL, 0}, - {"procs", InfoProcsCmd, NULL, NULL, NULL, 0}, - {"script", InfoScriptCmd, NULL, NULL, NULL, 0}, - {"sharedlibextension", InfoSharedlibCmd, NULL, NULL, NULL, 0}, - {"tclversion", InfoTclVersionCmd, NULL, NULL, NULL, 0}, - {"vars", TclInfoVarsCmd, NULL, NULL, NULL, 0}, - {NULL, NULL, NULL, NULL, NULL, 0} + {"args", InfoArgsCmd, NULL, NULL, NULL}, + {"body", InfoBodyCmd, NULL, NULL, NULL}, + {"cmdcount", InfoCmdCountCmd, NULL, NULL, NULL}, + {"commands", InfoCommandsCmd, NULL, NULL, NULL}, + {"complete", InfoCompleteCmd, NULL, NULL, NULL}, + {"coroutine", TclInfoCoroutineCmd, NULL, NULL, NULL}, + {"default", InfoDefaultCmd, NULL, NULL, NULL}, + {"errorstack", InfoErrorStackCmd, NULL, NULL, NULL}, + {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL}, + {"functions", InfoFunctionsCmd, NULL, NULL, NULL}, + {"globals", TclInfoGlobalsCmd, NULL, NULL, NULL}, + {"hostname", InfoHostnameCmd, NULL, NULL, NULL}, + {"level", InfoLevelCmd, NULL, NULL, NULL}, + {"library", InfoLibraryCmd, NULL, NULL, NULL}, + {"loaded", InfoLoadedCmd, NULL, NULL, NULL}, + {"locals", TclInfoLocalsCmd, NULL, NULL, NULL}, + {"nameofexecutable", InfoNameOfExecutableCmd, NULL, NULL, NULL}, + {"patchlevel", InfoPatchLevelCmd, NULL, NULL, NULL}, + {"procs", InfoProcsCmd, NULL, NULL, NULL}, + {"script", InfoScriptCmd, NULL, NULL, NULL}, + {"sharedlibextension", InfoSharedlibCmd, NULL, NULL, NULL}, + {"tclversion", InfoTclVersionCmd, NULL, NULL, NULL}, + {"vars", TclInfoVarsCmd, NULL, NULL, NULL}, + {NULL, NULL, NULL, NULL, NULL} }; /* *---------------------------------------------------------------------- * @@ -251,11 +247,10 @@ IfConditionCallback( ClientData data[], Tcl_Interp *interp, int result) { - Interp *iPtr = (Interp *) interp; int objc = PTR2INT(data[0]); Tcl_Obj *const *objv = data[1]; int i = PTR2INT(data[2]); Tcl_Obj *boolObj = data[3]; int value, thenScriptIndex = 0; @@ -294,16 +289,11 @@ */ i++; if (i >= objc) { if (thenScriptIndex) { - /* - * TIP #280. Make invoking context available to branch. - */ - - return TclNREvalObjEx(interp, objv[thenScriptIndex], 0, - iPtr->cmdFramePtr, thenScriptIndex); + return TclNREvalObjEx(interp, objv[thenScriptIndex], 0); } return TCL_OK; } clause = TclGetString(objv[i]); if ((clause[0] != 'e') || (strcmp(clause, "elseif") != 0)) { @@ -349,18 +339,13 @@ "extra words after \"else\" clause in \"if\" command", NULL); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } if (thenScriptIndex) { - /* - * TIP #280. Make invoking context available to branch/else. - */ - - return TclNREvalObjEx(interp, objv[thenScriptIndex], 0, - iPtr->cmdFramePtr, thenScriptIndex); - } - return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i); + return TclNREvalObjEx(interp, objv[thenScriptIndex], 0); + } + return TclNREvalObjEx(interp, objv[i], 0); missingScript: clause = TclGetString(objv[i-1]); Tcl_AppendResult(interp, "wrong # args: no script following \"", clause, "\" argument", NULL); @@ -1107,332 +1092,10 @@ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(varPtr && varPtr->value.objPtr)); return TCL_OK; } - -/* - *---------------------------------------------------------------------- - * - * InfoFrameCmd -- - * TIP #280 - * - * Called to implement the "info frame" command that returns the location - * of either the currently executing command, or its caller. Handles the - * following syntax: - * - * info frame ?number? - * - * Results: - * Returns TCL_OK if successful and TCL_ERROR if there is an error. - * - * Side effects: - * Returns a result in the interpreter's result object. If there is an - * error, the result is an error message. - * - *---------------------------------------------------------------------- - */ - -static int -InfoFrameCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - Interp *iPtr = (Interp *) interp; - int level, topLevel; - CmdFrame *framePtr; - - topLevel = ((iPtr->cmdFramePtr == NULL) - ? 0 - : iPtr->cmdFramePtr->level); - - - if (iPtr->execEnvPtr->corPtr) { - /* - * A coroutine: must fix the level computations AND the cmdFrame chain, - * which is interrupted at the base. - */ - - CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; - CmdFrame *runPtr = iPtr->cmdFramePtr; - CmdFrame *lastPtr = NULL; - - topLevel += corPtr->caller.cmdFramePtr->level; - while (runPtr && (runPtr != corPtr->caller.cmdFramePtr)) { - lastPtr = runPtr; - runPtr = runPtr->nextPtr; - } - if (lastPtr && !runPtr) { - lastPtr->nextPtr = corPtr->caller.cmdFramePtr; - } - } - - if (objc == 1) { - /* - * Just "info frame". - */ - - Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel)); - return TCL_OK; - } else if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?number?"); - return TCL_ERROR; - } - - /* - * We've got "info frame level" and must parse the level first. - */ - - if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) { - return TCL_ERROR; - } - - if ((level > topLevel) || (level <= - topLevel)) { - levelError: - Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"", - NULL); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME", - TclGetString(objv[1]), NULL); - return TCL_ERROR; - } - - /* - * Let us convert to relative so that we know how many levels to go back - */ - - if (level > 0) { - level -= topLevel; - } - - framePtr = iPtr->cmdFramePtr; - while (++level <= 0) { - framePtr = framePtr->nextPtr; - if (!framePtr) { - goto levelError; - } - } - - Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr)); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclInfoFrame -- - * - * Core of InfoFrameCmd, returns TIP280 dict for a given frame. - * - * Results: - * Returns TIP280 dict. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclInfoFrame( - Tcl_Interp *interp, /* Current interpreter. */ - CmdFrame *framePtr) /* Frame to get info for. */ -{ - Interp *iPtr = (Interp *) interp; - Tcl_Obj *tmpObj; - Tcl_Obj *lv[20]; /* Keep uptodate when more keys are added to - * the dict. */ - int lc = 0; - /* - * This array is indexed by the TCL_LOCATION_... values, except - * for _LAST. - */ - static const char *const typeString[TCL_LOCATION_LAST] = { - "eval", "eval", "eval", "precompiled", "source", "proc" - }; - Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL; - - /* - * Pull the information and construct the dictionary to return, as list. - * Regarding use of the CmdFrame fields see tclInt.h, and its definition. - */ - -#define ADD_PAIR(name, value) \ - TclNewLiteralStringObj(tmpObj, name); \ - lv[lc++] = tmpObj; \ - lv[lc++] = (value) - - switch (framePtr->type) { - case TCL_LOCATION_EVAL: - /* - * Evaluation, dynamic script. Type, line, cmd, the latter through - * str. - */ - - ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); - ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); - ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd, - framePtr->cmd.str.len)); - break; - - case TCL_LOCATION_EVAL_LIST: - /* - * List optimized evaluation. Type, line, cmd, the latter through - * listPtr, possibly a frame. - */ - - ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); - ADD_PAIR("line", Tcl_NewIntObj(1)); - - /* - * We put a duplicate of the command list obj into the result to - * ensure that the 'pure List'-property of the command itself is not - * destroyed. Otherwise the query here would disable the list - * optimization path in Tcl_EvalObjEx. - */ - - ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr)); - break; - - case TCL_LOCATION_PREBC: - /* - * Precompiled. Result contains the type as signal, nothing else. - */ - - ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); - break; - - case TCL_LOCATION_BC: { - /* - * Execution of bytecode. Talk to the BC engine to fill out the frame. - */ - - CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame)); - - *fPtr = *framePtr; - - /* - * Note: - * Type BC => f.data.eval.path is not used. - * f.data.tebc.codePtr is used instead. - */ - - TclGetSrcInfoForPc(fPtr); - - /* - * Now filled: cmd.str.(cmd,len), line - * Possibly modified: type, path! - */ - - ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1)); - if (fPtr->line) { - ADD_PAIR("line", Tcl_NewIntObj(fPtr->line[0])); - } - - if (fPtr->type == TCL_LOCATION_SOURCE) { - ADD_PAIR("file", fPtr->data.eval.path); - - /* - * Death of reference by TclGetSrcInfoForPc. - */ - - Tcl_DecrRefCount(fPtr->data.eval.path); - } - - ADD_PAIR("cmd", - Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len)); - TclStackFree(interp, fPtr); - break; - } - - case TCL_LOCATION_SOURCE: - /* - * Evaluation of a script file. - */ - - ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); - ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); - ADD_PAIR("file", framePtr->data.eval.path); - - /* - * Refcount framePtr->data.eval.path goes up when lv is converted into - * the result list object. - */ - - ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd, - framePtr->cmd.str.len)); - break; - - case TCL_LOCATION_PROC: - Tcl_Panic("TCL_LOCATION_PROC found in standard frame"); - break; - } - - /* - * 'proc'. Common to all frame types. Conditional on having an associated - * Procedure CallFrame. - */ - - if (procPtr != NULL) { - Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; - - if (namePtr) { - Tcl_Obj *procNameObj; - - /* - * This is a regular command. - */ - - TclNewObj(procNameObj); - Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr, - procNameObj); - ADD_PAIR("proc", procNameObj); - } else if (procPtr->cmdPtr->clientData) { - ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData; - int i; - - /* - * This is a non-standard command. Luckily, it's told us how to - * render extra information about its frame. - */ - - for (i=0 ; ilength ; i++) { - lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1); - if (efiPtr->fields[i].proc) { - lv[lc++] = - efiPtr->fields[i].proc(efiPtr->fields[i].clientData); - } else { - lv[lc++] = efiPtr->fields[i].clientData; - } - } - } - } - - /* - * 'level'. Common to all frame types. Conditional on having an associated - * _visible_ CallFrame. - */ - - if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) { - CallFrame *current = framePtr->framePtr; - CallFrame *top = iPtr->varFramePtr; - CallFrame *idx; - - for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) { - if (idx == current) { - int c = framePtr->framePtr->level; - int t = iPtr->varFramePtr->level; - - ADD_PAIR("level", Tcl_NewIntObj(t - c)); - break; - } - } - } - - return Tcl_NewListObj(lc, lv); -} /* *---------------------------------------------------------------------- * * InfoFunctionsCmd -- Index: generic/tclCmdMZ.c ================================================================== --- generic/tclCmdMZ.c +++ generic/tclCmdMZ.c @@ -3505,16 +3505,12 @@ int noCase, patternLength; const char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *const *savedObjv = objv; Tcl_RegExp regExpr = NULL; - Interp *iPtr = (Interp *) interp; - int pc = 0; int bidx = 0; /* Index of body argument. */ Tcl_Obj *blist = NULL; /* List obj which is the body */ - CmdFrame *ctxPtr; /* Copy of the topmost cmdframe, to allow us - * to mess with the line information */ /* * If you add options that make -e and -g not unique prefixes of -exact or * -glob, you *must* fix TclCompileSwitchCmd's option parser as well. */ @@ -3637,14 +3633,10 @@ bidx = i + 1; /* First after the match string. */ /* * If all of the pattern/command pairs are lumped into a single argument, * split them out again. - * - * TIP #280: Determine the lines the words in the list start at, based on - * the same data for the list word itself. The cmdFramePtr line - * information is manipulated directly. */ splitObjs = 0; if (objc == 1) { Tcl_Obj **listv; @@ -3870,62 +3862,10 @@ * We've got a match. Find a body to execute, skipping bodies that are * "-". */ matchFound: - ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); - *ctxPtr = *iPtr->cmdFramePtr; - - if (splitObjs) { - /* - * We have to perform the GetSrc and other type dependent handling of - * the frame here because we are munging with the line numbers, - * something the other commands like if, etc. are not doing. Them are - * fine with simply passing the CmdFrame through and having the - * special handling done in 'info frame', or the bc compiler - */ - - if (ctxPtr->type == TCL_LOCATION_BC) { - /* - * Type BC => ctxPtr->data.eval.path is not used. - * ctxPtr->data.tebc.codePtr is used instead. - */ - - TclGetSrcInfoForPc(ctxPtr); - pc = 1; - - /* - * The line information in the cmdFrame is now a copy we do not - * own. - */ - } - - if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) { - int bline = ctxPtr->line[bidx]; - - ctxPtr->line = ckalloc(objc * sizeof(int)); - ctxPtr->nline = objc; - TclListLines(blist, bline, objc, ctxPtr->line, objv); - } else { - /* - * This is either a dynamic code word, when all elements are - * relative to themselves, or something else less expected and - * where we have no information. The result is the same in both - * cases; tell the code to come that it doesn't know where it is, - * which triggers reversion to the old behavior. - */ - - int k; - - ctxPtr->line = ckalloc(objc * sizeof(int)); - ctxPtr->nline = objc; - for (k=0; k < objc; k++) { - ctxPtr->line[k] = -1; - } - } - } - for (j = i + 1; ; j += 2) { if (j >= objc) { /* * This shouldn't happen since we've checked that the last body is * not a continuation... @@ -3936,17 +3876,12 @@ if (strcmp(TclGetString(objv[j]), "-") != 0) { break; } } - /* - * TIP #280: Make invoking context available to switch branch. - */ - - Tcl_NRAddCallback(interp, SwitchPostProc, INT2PTR(splitObjs), ctxPtr, - INT2PTR(pc), (ClientData) pattern); - return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j); + Tcl_NRAddCallback(interp, SwitchPostProc, (ClientData) pattern, NULL, NULL, NULL); + return TclNREvalObjEx(interp, objv[j], 0); } static int SwitchPostProc( ClientData data[], /* Data passed from Tcl_NRAddCallback above */ @@ -3953,31 +3888,13 @@ Tcl_Interp *interp, /* Tcl interpreter */ int result) /* Result to return*/ { /* Unpack the preserved data */ - int splitObjs = PTR2INT(data[0]); - CmdFrame *ctxPtr = data[1]; - int pc = PTR2INT(data[2]); - const char *pattern = data[3]; + const char *pattern = data[0]; int patternLength = strlen(pattern); - /* - * Clean up TIP 280 context information - */ - - if (splitObjs) { - ckfree(ctxPtr->line); - if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { - /* - * Death of SrcInfo reference. - */ - - Tcl_DecrRefCount(ctxPtr->data.eval.path); - } - } - /* * Generate an error message if necessary. */ if (result == TCL_ERROR) { @@ -3987,11 +3904,10 @@ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s%s\" arm line %d)", (overflow ? limit : patternLength), pattern, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } - TclStackFree(interp, ctxPtr); return result; } /* *---------------------------------------------------------------------- @@ -4313,12 +4229,11 @@ * Execute the body. */ Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj, (ClientData)objv, INT2PTR(objc)); - return TclNREvalObjEx(interp, bodyObj, 0, - ((Interp *) interp)->cmdFramePtr, 1); + return TclNREvalObjEx(interp, bodyObj, 0); } /* *---------------------------------------------------------------------- * @@ -4529,12 +4444,11 @@ handlerBodyObj = info[4]; Tcl_NRAddCallback(interp, TryPostHandler, objv, options, info[0], INT2PTR((finallyObj == NULL) ? 0 : objc - 1)); Tcl_DecrRefCount(handlersObj); - return TclNREvalObjEx(interp, handlerBodyObj, 0, - ((Interp *) interp)->cmdFramePtr, 4*i + 5); + return TclNREvalObjEx(interp, handlerBodyObj, 0); handlerFailed: resultObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultObj); options = During(interp, result, options, NULL); @@ -4556,12 +4470,11 @@ */ if (finallyObj != NULL) { Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj, NULL); - return TclNREvalObjEx(interp, finallyObj, 0, - ((Interp *) interp)->cmdFramePtr, objc - 1); + return TclNREvalObjEx(interp, finallyObj, 0); } /* * Install the correct result/options into the interpreter and clean up * any temporary storage. @@ -4636,18 +4549,15 @@ /* * Process the finally clause if it is present. */ if (finallyObj != NULL) { - Interp *iPtr = (Interp *) interp; - Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj, NULL); /* The 'finally' script is always the last argument word. */ - return TclNREvalObjEx(interp, finallyObj, 0, iPtr->cmdFramePtr, - finally); + return TclNREvalObjEx(interp, finallyObj, 0); } /* * Install the correct result/options into the interpreter and clean up * any temporary storage. @@ -4769,75 +4679,18 @@ TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr); iterPtr->cond = objv[1]; iterPtr->body = objv[2]; iterPtr->next = NULL; iterPtr->msg = "\n (\"while\" body line %d)"; - iterPtr->word = 2; TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return TCL_OK; } - -/* - *---------------------------------------------------------------------- - * - * TclListLines -- - * - * ??? - * - * Results: - * Filled in array of line numbers? - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -void -TclListLines( - Tcl_Obj *listObj, /* Pointer to obj holding a string with list - * structure. Assumed to be valid. Assumed to - * contain n elements. */ - int line, /* Line the list as a whole starts on. */ - int n, /* #elements in lines */ - int *lines, /* Array of line numbers, to fill. */ - Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of - * derived continuation data */ -{ - const char *listStr = Tcl_GetString(listObj); - const char *listHead = listStr; - int i, length = strlen(listStr); - const char *element = NULL, *next = NULL; - ContLineLoc *clLocPtr = TclContinuationsGet(listObj); - int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL); - - for (i = 0; i < n; i++) { - TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL); - - TclAdvanceLines(&line, listStr, element); - /* Leading whitespace */ - TclAdvanceContinuations(&line, &clNext, element - listHead); - if (elems && clNext) { - TclContinuationsEnterDerived(elems[i], element-listHead, clNext); - } - lines[i] = line; - length -= (next - listStr); - TclAdvanceLines(&line, element, next); - /* Element */ - listStr = next; - - if (*element == 0) { - /* ASSERT i == n */ - break; - } - } -} /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclCompCmds.c ================================================================== --- generic/tclCompCmds.c +++ generic/tclCompCmds.c @@ -36,54 +36,29 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr); static int PushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, - int *simpleVarNamePtr, int *isScalarPtr, - int line, int *clNext); + int *simpleVarNamePtr, int *isScalarPtr); /* * Macro that encapsulates an efficiency trick that avoids a function call for * the simplest of compiles. The ANSI C "prototype" for this macro is: * * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr, * Tcl_Interp *interp, int word); */ -#define CompileWord(envPtr, tokenPtr, interp, word) \ +#define CompileWord(envPtr, tokenPtr, interp) \ if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \ (tokenPtr)[1].size), (envPtr)); \ } else { \ - envPtr->line = mapPtr->loc[eclIndex].line[word]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \ TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ (envPtr)); \ } -/* - * TIP #280: Remember the per-word line information of the current command. An - * index is used instead of a pointer as recursive compilation may reallocate, - * i.e. move, the array. This is also the reason to save the nuloc now, it may - * change during the course of the function. - * - * Macro to encapsulate the variable definition and setup. - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 - -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] - -#define PushVarNameWord(i,v,e,f,l,s,sc,word) \ - PushVarName(i,v,e,f,l,s,sc, \ - mapPtr->loc[eclIndex].line[(word)], \ - mapPtr->loc[eclIndex].next[(word)]) - /* * Flags bits used by PushVarName. */ #define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ @@ -133,11 +108,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; int simpleVarName, isScalar, localIndex, numWords; - DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; if (numWords == 1) { return TCL_ERROR; } else if (numWords == 2) { @@ -162,22 +136,22 @@ * qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PushVarName(interp, varTokenPtr, envPtr, 0, + &localIndex, &simpleVarName, &isScalar); /* * We are doing an assignment, otherwise TclCompileSetCmd was called, so * push the new value. This will need to be extended to push a value for * each argument. */ if (numWords > 2) { valueTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, valueTokenPtr, interp, 2); + CompileWord(envPtr, valueTokenPtr, interp); } /* * Emit instructions to set/get the variable. */ @@ -277,11 +251,10 @@ Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr; const char *name; int resultIndex, optsIndex, nameChars, range; int initStackDepth = envPtr->currStackDepth; int savedStackDepth; - DefineLineInformation; /* TIP #280 */ /* * If syntax does not match what we expect for [catch], do not compile. * Let runtime checks determine if syntax has changed. */ @@ -361,11 +334,10 @@ * [Bug 219184] * The reason for duplicating the script is that EVAL_STK would otherwise * begin by undeflowing the stack below the mark set by BEGIN_CATCH4. */ - SetLineInformation(1); if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { savedStackDepth = envPtr->currStackDepth; TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, cmdTokenPtr, interp); @@ -578,11 +550,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; int numWords, i; - DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; int dictVarIndex, nameChars; const char *name; /* @@ -618,11 +589,11 @@ */ tokenPtr = TokenAfter(varTokenPtr); numWords = parsePtr->numWords-1; for (i=1 ; icurrStackDepth; @@ -841,11 +809,11 @@ * * First up, get the dictionary and start the iteration. No catching of * errors at this point. */ - CompileWord(envPtr, dictTokenPtr, interp, 3); + CompileWord(envPtr, dictTokenPtr, interp); TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); emptyTargetOffset = CurrentOffset(envPtr); TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr); /* @@ -876,11 +844,10 @@ /* * Compile the loop body itself. It should be stack-neutral. */ - SetLineInformation(4); CompileBody(envPtr, bodyTokenPtr, interp); TclEmitOpcode( INST_POP, envPtr); /* * Both exception target ranges (error and loop) end here. @@ -965,11 +932,10 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - DefineLineInformation; /* TIP #280 */ const char *name; int i, nameChars, dictIndex, numVars, range, infoIndex; Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr; int savedStackDepth = envPtr->currStackDepth; DictUpdateInfo *duiPtr; @@ -1071,11 +1037,11 @@ */ infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr); for (i=0 ; inumWords ; i++) { - CompileWord(envPtr, tokenPtr, interp, i); + CompileWord(envPtr, tokenPtr, interp); tokenPtr = TokenAfter(tokenPtr); } if (parsePtr->numWords > 4) { TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr); } @@ -1199,11 +1164,10 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr; int dictVarIndex, nameChars; const char *name; /* @@ -1227,12 +1191,12 @@ } dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); if (dictVarIndex < 0) { return TCL_ERROR; } - CompileWord(envPtr, keyTokenPtr, interp, 3); - CompileWord(envPtr, valueTokenPtr, interp, 4); + CompileWord(envPtr, keyTokenPtr, interp); + CompileWord(envPtr, valueTokenPtr, interp); TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr); return TCL_OK; } /* @@ -1325,19 +1289,18 @@ /* * General syntax: [error message ?errorInfo? ?errorCode?] * However, we only deal with the case where there is just a message. */ Tcl_Token *messageTokenPtr; - DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 2) { return TCL_ERROR; } messageTokenPtr = TokenAfter(parsePtr->tokenPtr); PushLiteral(envPtr, "-code error -level 0", 20); - CompileWord(envPtr, messageTokenPtr, interp, 1); + CompileWord(envPtr, messageTokenPtr, interp); TclEmitOpcode(INST_RETURN_STK, envPtr); return TCL_OK; } /* @@ -1371,17 +1334,10 @@ if (parsePtr->numWords == 1) { return TCL_ERROR; } - /* - * TIP #280: Use the per-word line information of the current command. - */ - - envPtr->line = envPtr->extCmdMapPtr->loc[ - envPtr->extCmdMapPtr->nuloc-1].line[1]; - firstWordPtr = TokenAfter(parsePtr->tokenPtr); TclCompileExprWords(interp, firstWordPtr, parsePtr->numWords-1, envPtr); return TCL_OK; } @@ -1415,11 +1371,10 @@ Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr; JumpFixup jumpEvalCondFixup; int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist; int bodyRange, nextRange; int savedStackDepth = envPtr->currStackDepth; - DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 5) { return TCL_ERROR; } @@ -1458,11 +1413,10 @@ /* * Inline compile the initial command. */ - SetLineInformation(1); CompileBody(envPtr, startTokenPtr, interp); TclEmitOpcode(INST_POP, envPtr); /* * Jump to the evaluation of the condition. This code uses the "loop @@ -1481,11 +1435,10 @@ /* * Compile the loop body. */ bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange); - SetLineInformation(4); CompileBody(envPtr, bodyTokenPtr, interp); ExceptionRangeEnds(envPtr, bodyRange); envPtr->currStackDepth = savedStackDepth + 1; TclEmitOpcode(INST_POP, envPtr); @@ -1493,11 +1446,10 @@ * Compile the "next" subcommand. */ envPtr->currStackDepth = savedStackDepth; nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange); - SetLineInformation(3); CompileBody(envPtr, nextTokenPtr, interp); ExceptionRangeEnds(envPtr, nextRange); envPtr->currStackDepth = savedStackDepth + 1; TclEmitOpcode(INST_POP, envPtr); envPtr->currStackDepth = savedStackDepth; @@ -1514,11 +1466,10 @@ bodyCodeOffset += 3; nextCodeOffset += 3; testCodeOffset += 3; } - SetLineInformation(2); envPtr->currStackDepth = savedStackDepth; TclCompileExprWords(interp, testTokenPtr, 1, envPtr); envPtr->currStackDepth = savedStackDepth + 1; jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; @@ -1590,11 +1541,10 @@ unsigned char *jumpPc; JumpFixup jumpFalseFixup; int jumpBackDist, jumpBackOffset, infoIndex, range, bodyIndex; int numWords, numLists, numVars, loopIndex, tempVar, i, j, code; int savedStackDepth = envPtr->currStackDepth; - DefineLineInformation; /* TIP #280 */ /* * We parse the variable list argument words and create two arrays: * varcList[i] is number of variables in i-th var list. * varvList[i] points to array of var names in i-th var list. @@ -1765,11 +1715,10 @@ loopIndex = 0; for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { if ((i%2 == 0) && (i > 0)) { - SetLineInformation(i); CompileTokens(envPtr, tokenPtr, interp); tempVar = (firstValueTemp + loopIndex); if (tempVar <= 255) { TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr); } else { @@ -1797,11 +1746,10 @@ /* * Inline compile the loop body. */ - SetLineInformation(bodyIndex); ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, bodyTokenPtr, interp); ExceptionRangeEnds(envPtr, range); envPtr->currStackDepth = savedStackDepth + 1; TclEmitOpcode(INST_POP, envPtr); @@ -2043,11 +1991,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; int localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; if (numWords < 2) { return TCL_ERROR; } @@ -2076,11 +2023,11 @@ if (localIndex < 0) { return TCL_ERROR; } - CompileWord(envPtr, varTokenPtr, interp, 1); + CompileWord(envPtr, varTokenPtr, interp); TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr); } /* * Pop the namespace, and set the result to empty @@ -2135,11 +2082,10 @@ * to this value at the start of each test. */ int realCond = 1; /* Set to 0 for static conditions: * "if 0 {..}" */ int boolVal; /* Value of static condition. */ int compileScripts = 1; - DefineLineInformation; /* TIP #280 */ /* * Only compile the "if" command if all arguments are simple words, in * order to insure correct substitution [Bug 219166] */ @@ -2212,11 +2158,10 @@ realCond = 0; if (!boolVal) { compileScripts = 0; } } else { - SetLineInformation(wordIdx); Tcl_ResetResult(interp); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) { TclExpandJumpFixupArray(&jumpFalseFixupArray); } @@ -2254,11 +2199,10 @@ /* * Compile the "then" command body. */ if (compileScripts) { - SetLineInformation(wordIdx); envPtr->currStackDepth = savedStackDepth; CompileBody(envPtr, tokenPtr, interp); } if (realCond) { @@ -2342,11 +2286,10 @@ if (compileScripts) { /* * Compile the else command body. */ - SetLineInformation(wordIdx); CompileBody(envPtr, tokenPtr, interp); } /* * Make sure there are no words after the else clause. @@ -2436,20 +2379,19 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *incrTokenPtr; int simpleVarName, isScalar, localIndex, haveImmValue, immValue; - DefineLineInformation; /* TIP #280 */ if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX, - &localIndex, &simpleVarName, &isScalar, 1); + PushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX, + &localIndex, &simpleVarName, &isScalar); /* * If an increment is given, push it, but see first if it's a small * integer. */ @@ -2472,11 +2414,10 @@ } if (!haveImmValue) { PushLiteral(envPtr, word, numBytes); } } else { - SetLineInformation(2); CompileTokens(envPtr, incrTokenPtr, interp); } } else { /* No incr amount given so use 1. */ haveImmValue = 1; } @@ -2555,11 +2496,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; int isScalar, simpleVarName, localIndex; - DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 2) { return TCL_ERROR; } @@ -2570,12 +2510,12 @@ * body and if the name is simple text that does not include namespace * qualifiers. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, - &simpleVarName, &isScalar, 1); + PushVarName(interp, tokenPtr, envPtr, 0, &localIndex, + &simpleVarName, &isScalar); /* * Emit instruction to check the variable for existence. */ @@ -2627,11 +2567,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; int simpleVarName, isScalar, localIndex, numWords; - DefineLineInformation; /* TIP #280 */ /* * If we're not in a procedure, don't compile. */ @@ -2659,22 +2598,22 @@ * namespace qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PushVarName(interp, varTokenPtr, envPtr, 0, + &localIndex, &simpleVarName, &isScalar); /* * If we are doing an assignment, push the new value. In the no values * case, create an empty object. */ if (numWords > 2) { Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, valueTokenPtr, interp, 2); + CompileWord(envPtr, valueTokenPtr, interp); } /* * Emit instructions to set/get the variable. */ @@ -2736,11 +2675,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; int simpleVarName, isScalar, localIndex, numWords, idx; - DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; /* * Check for command syntax error, but we'll punt that to runtime. @@ -2753,11 +2691,11 @@ /* * Generate code to push list being taken apart by [lassign]. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + CompileWord(envPtr, tokenPtr, interp); /* * Generate code to assign values from the list to variables. */ @@ -2766,12 +2704,12 @@ /* * Generate the next variable name. */ - PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, - &simpleVarName, &isScalar, idx+2); + PushVarName(interp, tokenPtr, envPtr, 0, &localIndex, + &simpleVarName, &isScalar); /* * Emit instructions to get the idx'th item out of the list value on * the stack and assign it to the variable. */ @@ -2851,11 +2789,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *idxTokenPtr, *valTokenPtr; int i, numWords = parsePtr->numWords; - DefineLineInformation; /* TIP #280 */ /* * Quit if too few args. */ @@ -2884,11 +2821,11 @@ * lindex * This is best compiled as a push of the arbitrary value followed * by an "immediate lindex" which is the most efficient variety. */ - CompileWord(envPtr, valTokenPtr, interp, 1); + CompileWord(envPtr, valTokenPtr, interp); TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); return TCL_OK; } /* @@ -2901,11 +2838,11 @@ * Push the operands onto the stack. */ emitComplexLindex: for (i=1 ; iprocPtr == NULL) { @@ -2974,11 +2909,11 @@ numWords = parsePtr->numWords; valueTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i++) { - CompileWord(envPtr, valueTokenPtr, interp, i); + CompileWord(envPtr, valueTokenPtr, interp); valueTokenPtr = TokenAfter(valueTokenPtr); } TclEmitInstInt4(INST_LIST, numWords - 1, envPtr); } @@ -3011,18 +2946,17 @@ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; - DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 2) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, varTokenPtr, interp, 1); + CompileWord(envPtr, varTokenPtr, interp); TclEmitOpcode(INST_LIST_LENGTH, envPtr); return TCL_OK; } /* @@ -3080,11 +3014,10 @@ * parse of the variable name. */ int localIndex; /* Index of var in local var table. */ int simpleVarName; /* Flag == 1 if var name is simple. */ int isScalar; /* Flag == 1 if scalar, 0 if array. */ int i; - DefineLineInformation; /* TIP #280 */ /* * Check argument count. */ @@ -3103,20 +3036,20 @@ * body and if the name is simple text that does not include namespace * qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PushVarName(interp, varTokenPtr, envPtr, 0, + &localIndex, &simpleVarName, &isScalar); /* * Push the "index" args and the new element value. */ for (i=2 ; inumWords ; ++i) { varTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, varTokenPtr, interp, i); + CompileWord(envPtr, varTokenPtr, interp); } /* * Duplicate the variable name if it's been pushed. */ @@ -3233,11 +3166,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; int simpleVarName, isScalar, localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ if (envPtr->procPtr == NULL) { return TCL_ERROR; } @@ -3253,11 +3185,11 @@ /* * Push the namespace */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + CompileWord(envPtr, tokenPtr, interp); /* * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a * local variable, return an error so that the non-compiled command will * be called at runtime. @@ -3266,13 +3198,13 @@ localTokenPtr = tokenPtr; for (i=3; i<=numWords; i+=2) { otherTokenPtr = TokenAfter(localTokenPtr); localTokenPtr = TokenAfter(otherTokenPtr); - CompileWord(envPtr, otherTokenPtr, interp, 1); - PushVarNameWord(interp, localTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + CompileWord(envPtr, otherTokenPtr, interp); + PushVarName(interp, localTokenPtr, envPtr, 0, + &localIndex, &simpleVarName, &isScalar); if ((localIndex < 0) || !isScalar) { return TCL_ERROR; } TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr); @@ -3316,11 +3248,10 @@ { Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the RE or string. */ int i, len, nocase, exact, sawLast, simple; const char *str; - DefineLineInformation; /* TIP #280 */ /* * We are only interested in compiling simple regexp cases. Currently * supported compile cases are: * regexp ?-nocase? ?--? staticString $var @@ -3419,19 +3350,19 @@ Tcl_DStringFree(&ds); } } if (!simple) { - CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2); + CompileWord(envPtr, varTokenPtr, interp); } /* * Push the string arg. */ varTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1); + CompileWord(envPtr, varTokenPtr, interp); if (simple) { if (exact && !nocase) { TclEmitOpcode(INST_STR_EQ, envPtr); } else { @@ -3487,11 +3418,10 @@ int numWords = parsePtr->numWords; int explicitResult = (0 == (numWords % 2)); int numOptionWords = numWords - 1 - explicitResult; Tcl_Obj *returnOpts, **objv; Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); - DefineLineInformation; /* TIP #280 */ /* * Check for special case which can always be compiled: * return -options * Unlike the normal [return] compilation, this version does everything at @@ -3504,12 +3434,12 @@ && (wordTokenPtr[1].size == 8) && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) { Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr); Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr); - CompileWord(envPtr, optsTokenPtr, interp, 2); - CompileWord(envPtr, msgTokenPtr, interp, 3); + CompileWord(envPtr, optsTokenPtr, interp); + CompileWord(envPtr, msgTokenPtr, interp); TclEmitOpcode(INST_RETURN_STK, envPtr); return TCL_OK; } /* @@ -3556,11 +3486,11 @@ * All options are known at compile time, so we're going to bytecompile. * Emit instructions to push the result on the stack. */ if (explicitResult) { - CompileWord(envPtr, wordTokenPtr, interp, numWords-1); + CompileWord(envPtr, wordTokenPtr, interp); } else { /* * No explict result argument, so default result is empty string. */ @@ -3674,11 +3604,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; int simpleVarName, isScalar, localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ Tcl_Obj *objPtr = Tcl_NewObj(); if (envPtr->procPtr == NULL) { Tcl_DecrRefCount(objPtr); return TCL_ERROR; @@ -3710,11 +3639,11 @@ if (newTypePtr != typePtr) { if (numWords%2) { return TCL_ERROR; } - CompileWord(envPtr, tokenPtr, interp, 1); + CompileWord(envPtr, tokenPtr, interp); otherTokenPtr = TokenAfter(tokenPtr); i = 4; } else { if (!(numWords%2)) { return TCL_ERROR; @@ -3735,13 +3664,13 @@ */ for (; i<=numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) { localTokenPtr = TokenAfter(otherTokenPtr); - CompileWord(envPtr, otherTokenPtr, interp, 1); - PushVarNameWord(interp, localTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + CompileWord(envPtr, otherTokenPtr, interp); + PushVarName(interp, localTokenPtr, envPtr, 0, + &localIndex, &simpleVarName, &isScalar); if ((localIndex < 0) || !isScalar) { return TCL_ERROR; } TclEmitInstInt4(INST_UPVAR, localIndex, envPtr); @@ -3783,11 +3712,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; int localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; if (numWords < 2) { return TCL_ERROR; } @@ -3813,19 +3741,19 @@ if (localIndex < 0) { return TCL_ERROR; } - CompileWord(envPtr, varTokenPtr, interp, 1); + CompileWord(envPtr, varTokenPtr, interp); TclEmitInstInt4(INST_VARIABLE, localIndex, envPtr); if (i != numWords) { /* * A value has been given: set the variable, pop the value */ - CompileWord(envPtr, valueTokenPtr, interp, 1); + CompileWord(envPtr, valueTokenPtr, interp); if (localIndex < 0x100) { TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr); } else { TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr); } @@ -3962,14 +3890,11 @@ Tcl_Token *varTokenPtr, /* Points to a variable token. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int flags, /* TCL_NO_LARGE_INDEX. */ int *localIndexPtr, /* Must not be NULL. */ int *simpleVarNamePtr, /* Must not be NULL. */ - int *isScalarPtr, /* Must not be NULL. */ - int line, /* Line the token starts on. */ - int *clNext) /* Reference to offset of next hidden cont. - * line. */ + int *isScalarPtr) /* Must not be NULL. */ { register const char *p; const char *name, *elName; register int i, n; Tcl_Token *elemTokenPtr = NULL; @@ -4145,12 +4070,10 @@ * Compile the element script, if any. */ if (elName != NULL) { if (elNameChars) { - envPtr->line = line; - envPtr->clNext = clNext; TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr); } else { PushLiteral(envPtr, "", 0); } @@ -4158,12 +4081,10 @@ } else { /* * The var name isn't simple: compile and push it. */ - envPtr->line = line; - envPtr->clNext = clNext; CompileTokens(envPtr, varTokenPtr, interp); } if (removedParen) { varTokenPtr[removedParen].size++; Index: generic/tclCompCmdsSZ.c ================================================================== --- generic/tclCompCmdsSZ.c +++ generic/tclCompCmdsSZ.c @@ -28,12 +28,11 @@ Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset); static int PushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, - int *simpleVarNamePtr, int *isScalarPtr, - int line, int *clNext); + int *simpleVarNamePtr, int *isScalarPtr); static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr); static int CompileComparisonOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, @@ -43,18 +42,16 @@ CompileEnv *envPtr); static int CompileUnaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr); static void IssueSwitchChainedTests(Tcl_Interp *interp, - CompileEnv *envPtr, ExtCmdLoc *mapPtr, - int eclIndex, int mode, int noCase, + CompileEnv *envPtr, int mode, int noCase, int valueIndex, Tcl_Token *valueTokenPtr, int numWords, Tcl_Token **bodyToken, int *bodyLines, int **bodyNext); static void IssueSwitchJumpTable(Tcl_Interp *interp, - CompileEnv *envPtr, ExtCmdLoc *mapPtr, - int eclIndex, int valueIndex, + CompileEnv *envPtr, int valueIndex, Tcl_Token *valueTokenPtr, int numWords, Tcl_Token **bodyToken, int *bodyLines, int **bodyContLines); static int IssueTryFinallyInstructions(Tcl_Interp *interp, CompileEnv *envPtr, Tcl_Token *bodyToken, @@ -79,38 +76,14 @@ #define CompileWord(envPtr, tokenPtr, interp, word) \ if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \ (tokenPtr)[1].size), (envPtr)); \ } else { \ - envPtr->line = mapPtr->loc[eclIndex].line[word]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \ TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ (envPtr)); \ } -/* - * TIP #280: Remember the per-word line information of the current command. An - * index is used instead of a pointer as recursive compilation may reallocate, - * i.e. move, the array. This is also the reason to save the nuloc now, it may - * change during the course of the function. - * - * Macro to encapsulate the variable definition and setup. - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 - -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] - -#define PushVarNameWord(i,v,e,f,l,s,sc,word) \ - PushVarName(i,v,e,f,l,s,sc, \ - mapPtr->loc[eclIndex].line[(word)], \ - mapPtr->loc[eclIndex].next[(word)]) - /* * Flags bits used by PushVarName. */ #define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ @@ -134,11 +107,11 @@ #define OP1(name,val) TclEmitInstInt1(INST_##name,(val),envPtr) #define OP4(name,val) TclEmitInstInt4(INST_##name,(val),envPtr) #define OP44(name,val1,val2) \ TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr) #define BODY(token,index) \ - SetLineInformation((index));CompileBody(envPtr,(token),interp) + CompileBody(envPtr,(token),interp) #define PUSH(str) \ PushLiteral(envPtr,(str),strlen(str)) #define JUMP(var,name) \ (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name,0,envPtr) #define FIXJUMP(var) \ @@ -175,11 +148,10 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; int isAssignment, isScalar, simpleVarName, localIndex, numWords; - DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; if ((numWords != 2) && (numWords != 3)) { return TCL_ERROR; } @@ -192,12 +164,12 @@ * body and if the name is simple text that does not include namespace * qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PushVarName(interp, varTokenPtr, envPtr, 0, + &localIndex, &simpleVarName, &isScalar); /* * If we are doing an assignment, push the new value. */ @@ -272,11 +244,10 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* * We don't support any flags; the bytecode isn't that sophisticated. */ @@ -323,11 +294,10 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* * We don't support any flags; the bytecode isn't that sophisticated. */ @@ -374,11 +344,10 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; if (parsePtr->numWords != 3) { return TCL_ERROR; } @@ -421,11 +390,10 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i, length, exactMatch = 0, nocase = 0; const char *str; if (parsePtr->numWords < 3 || parsePtr->numWords > 4) { @@ -475,11 +443,10 @@ exactMatch = TclMatchIsTrivial(TclGetString(copy)); TclDecrRefCount(copy); } PushLiteral(envPtr, str, length); } else { - SetLineInformation(i+1+nocase); CompileTokens(envPtr, tokenPtr, interp); } tokenPtr = TokenAfter(tokenPtr); } @@ -521,11 +488,10 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; Tcl_Obj *objPtr; if (parsePtr->numWords != 2) { return TCL_ERROR; @@ -544,11 +510,10 @@ int len = Tcl_GetCharLength(objPtr); len = sprintf(buf, "%d", len); PushLiteral(envPtr, buf, len); } else { - SetLineInformation(1); CompileTokens(envPtr, tokenPtr, interp); TclEmitOpcode(INST_STR_LEN, envPtr); } TclDecrRefCount(objPtr); return TCL_OK; @@ -587,11 +552,10 @@ int numOpts = numArgs - 1; int objc, flags = TCL_SUBST_ALL; Tcl_Obj **objv/*, *toSubst = NULL*/; Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); int code = TCL_ERROR; - DefineLineInformation; /* TIP #280 */ if (numArgs == 0) { return TCL_ERROR; } @@ -631,13 +595,12 @@ TclStackFree(interp, objv); if (/*toSubst == NULL*/ code != TCL_OK) { return TCL_ERROR; } - SetLineInformation(numArgs); TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size, - flags, mapPtr->loc[eclIndex].line[numArgs], envPtr); + flags, envPtr); /* TclDecrRefCount(toSubst);*/ return TCL_OK; } @@ -645,15 +608,14 @@ TclSubstCompile( Tcl_Interp *interp, const char *bytes, int numBytes, int flags, - int line, CompileEnv *envPtr) { Tcl_Token *endTokenPtr, *tokenPtr; - int breakOffset = 0, count = 0, bline = line; + int breakOffset = 0, count = 0; Tcl_Parse parse; Tcl_InterpState state = NULL; TclSubstParse(interp, bytes, numBytes, flags, &parse, &state); @@ -681,12 +643,10 @@ switch (tokenPtr->type) { case TCL_TOKEN_TEXT: literal = TclRegisterNewLiteral(envPtr, tokenPtr->start, tokenPtr->size); TclEmitPush(literal, envPtr); - TclAdvanceLines(&bline, tokenPtr->start, - tokenPtr->start + tokenPtr->size); count++; continue; case TCL_TOKEN_BS: length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, buf); @@ -718,11 +678,10 @@ Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d", (int) (CurrentOffset(envPtr) - startFixup.codeOffset)); } } - envPtr->line = bline; catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); TclEmitInstInt4(INST_BEGIN_CATCH4, catchRange, envPtr); ExceptionRangeStarts(envPtr, catchRange); switch (tokenPtr->type) { @@ -835,11 +794,10 @@ /* CONTINUE jump to here */ if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d", (int) (CurrentOffset(envPtr) - endFixup.codeOffset)); } - bline = envPtr->line; } while (count > 255) { TclEmitInstInt1(INST_CONCAT1, 255, envPtr); @@ -908,12 +866,10 @@ int noCase; /* Has the -nocase flag been given? */ int foundMode = 0; /* Have we seen a mode flag yet? */ int isListedArms = 0; int i, valueIndex; int result = TCL_ERROR; - DefineLineInformation; /* TIP #280 */ - int *clNext = envPtr->clNext; /* * Only handle the following versions: * switch ?--? word {pattern body ...} * switch -exact ?--? word {pattern body ...} @@ -1048,14 +1004,10 @@ */ if (numWords == 1) { Tcl_DString bodyList; const char **argv = NULL, *tokenStartPtr, *p; - int bline; /* TIP #280: line of the pattern/action list, - * and start of list for when tracking the - * location. This list comes immediately after - * the value we switch on. */ int isTokenBraced; /* * Test that we've got a suitable body list as a simple (i.e. braced) * word, and that the elements of the body are simple words too. This @@ -1094,11 +1046,10 @@ /* * Locate the start of the arms within the overall word. */ - bline = mapPtr->loc[eclIndex].line[valueIndex+1]; p = tokenStartPtr = tokenPtr[1].start; while (isspace(UCHAR(*tokenStartPtr))) { tokenStartPtr++; } if (*tokenStartPtr == '{') { @@ -1106,14 +1057,10 @@ isTokenBraced = 1; } else { isTokenBraced = 0; } - /* - * TIP #280: Count lines within the literal list. - */ - for (i=0 ; isource); - bodyLines[i] = bline; - bodyContLines[i] = clNext; p = bodyTokenArray[i].start; while (isspace(UCHAR(*tokenStartPtr))) { tokenStartPtr++; if (tokenStartPtr >= tokenPtr[1].start+tokenPtr[1].size) { @@ -1202,16 +1138,10 @@ tokenPtr->numComponents != 1) { goto freeTemporaries; } bodyToken[i] = tokenPtr+1; - /* - * TIP #280: Copy line information from regular cmd info. - */ - - bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i]; - bodyContLines[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i]; tokenPtr = TokenAfter(tokenPtr); } } /* @@ -1231,14 +1161,14 @@ * over-conservative with determining whether we can do the jump table, * but it handles the most common case well enough. */ if ((isListedArms) && (mode == Switch_Exact) && (!noCase)) { - IssueSwitchJumpTable(interp, envPtr, mapPtr, eclIndex, valueIndex, + IssueSwitchJumpTable(interp, envPtr, valueIndex, valueTokenPtr, numWords, bodyToken, bodyLines, bodyContLines); } else { - IssueSwitchChainedTests(interp, envPtr, mapPtr, eclIndex, mode,noCase, + IssueSwitchChainedTests(interp, envPtr, mode,noCase, valueIndex, valueTokenPtr, numWords, bodyToken, bodyLines, bodyContLines); } result = TCL_OK; @@ -1274,13 +1204,10 @@ static void IssueSwitchChainedTests( Tcl_Interp *interp, /* Context for compiling script bodies. */ CompileEnv *envPtr, /* Holds resulting instructions. */ - ExtCmdLoc *mapPtr, /* For mapping tokens to their source code - * location. */ - int eclIndex, int mode, /* Exact, Glob or Regexp */ int noCase, /* Case-insensitivity flag. */ int valueIndex, /* The value to match against. */ Tcl_Token *valueTokenPtr, int numBodyTokens, /* Number of tokens describing things the @@ -1309,11 +1236,10 @@ /* * First, we push the value we're matching against on the stack. */ - SetLineInformation(valueIndex); CompileTokens(envPtr, valueTokenPtr, interp); /* * Generate a test for each arm. */ @@ -1463,12 +1389,10 @@ * pattern. */ TclEmitOpcode(INST_POP, envPtr); envPtr->currStackDepth = savedStackDepth + 1; - envPtr->line = bodyLines[i+1]; /* TIP #280 */ - envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); if (!foundDefault) { TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &fixupArray[fixupCount]); @@ -1541,13 +1465,10 @@ static void IssueSwitchJumpTable( Tcl_Interp *interp, /* Context for compiling script bodies. */ CompileEnv *envPtr, /* Holds resulting instructions. */ - ExtCmdLoc *mapPtr, /* For mapping tokens to their source code - * location. */ - int eclIndex, int valueIndex, /* The value to match against. */ Tcl_Token *valueTokenPtr, int numBodyTokens, /* Number of tokens describing things the * switch can match against and bodies to * execute when the match succeeds. */ @@ -1564,11 +1485,10 @@ /* * First, we push the value we're matching against on the stack. */ - SetLineInformation(valueIndex); CompileTokens(envPtr, valueTokenPtr, interp); /* * Compile the switch by using a jump table, which is basically a * hashtable that maps from literal values to match against to the offset @@ -1668,12 +1588,10 @@ /* * Compile the body of the arm. */ - envPtr->line = bodyLines[i+1]; /* TIP #280 */ - envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); /* * Compile a jump in to the end of the command if this body is * anything other than a user-supplied default arm (to either skip @@ -1828,11 +1746,10 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - DefineLineInformation; /* TIP #280 */ int numWords = parsePtr->numWords; Tcl_Token *codeToken, *msgToken; Tcl_Obj *objPtr; if (numWords != 3) { @@ -1957,12 +1874,10 @@ if (numWords == 2) { /* * No handlers or finally; do nothing beyond evaluating the body. */ - DefineLineInformation; /* TIP #280 */ - SetLineInformation(1); CompileBody(envPtr, bodyToken, interp); return TCL_OK; } numWords -= 2; @@ -2173,11 +2088,10 @@ Tcl_Obj **matchClauses, int *resultVars, int *optionVars, Tcl_Token **handlerTokens) { - DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; int i, j, len, forwardsNeedFixing = 0; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; @@ -2323,11 +2237,10 @@ int *resultVars, int *optionVars, Tcl_Token **handlerTokens, Tcl_Token *finallyToken) /* Not NULL */ { - DefineLineInformation; /* TIP #280 */ int savedStackDepth = envPtr->currStackDepth; int range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; @@ -2559,11 +2472,10 @@ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; int isScalar, simpleVarName, localIndex, numWords, flags, i; Tcl_Obj *leadingWord; - DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords-1; flags = 1; varTokenPtr = TokenAfter(parsePtr->tokenPtr); leadingWord = Tcl_NewObj(); @@ -2597,12 +2509,12 @@ * frame slot (entry in the array of local vars) if we are compiling a * procedure body and if the name is simple text that does not include * namespace qualifiers. */ - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PushVarName(interp, varTokenPtr, envPtr, 0, + &localIndex, &simpleVarName, &isScalar); /* * Emit instructions to unset the variable. */ @@ -2662,11 +2574,10 @@ int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal; int savedStackDepth = envPtr->currStackDepth; int loopMayEnd = 1; /* This is set to 0 if it is recognized as an * infinite loop. */ Tcl_Obj *boolObj; - DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 3) { return TCL_ERROR; } @@ -2750,11 +2661,10 @@ /* * Compile the loop body. */ - SetLineInformation(2); bodyCodeOffset = ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, bodyTokenPtr, interp); ExceptionRangeEnds(envPtr, range); envPtr->currStackDepth = savedStackDepth + 1; TclEmitOpcode(INST_POP, envPtr); @@ -2770,11 +2680,10 @@ if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { bodyCodeOffset += 3; testCodeOffset += 3; } envPtr->currStackDepth = savedStackDepth; - SetLineInformation(1); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); envPtr->currStackDepth = savedStackDepth + 1; jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { @@ -2834,14 +2743,11 @@ Tcl_Token *varTokenPtr, /* Points to a variable token. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int flags, /* TCL_NO_LARGE_INDEX. */ int *localIndexPtr, /* Must not be NULL. */ int *simpleVarNamePtr, /* Must not be NULL. */ - int *isScalarPtr, /* Must not be NULL. */ - int line, /* Line the token starts on. */ - int *clNext) /* Reference to offset of next hidden cont. - * line. */ + int *isScalarPtr) /* Must not be NULL. */ { register const char *p; const char *name, *elName; register int i, n; Tcl_Token *elemTokenPtr = NULL; @@ -3017,12 +2923,10 @@ * Compile the element script, if any. */ if (elName != NULL) { if (elNameChars) { - envPtr->line = line; - envPtr->clNext = clNext; TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr); } else { PushLiteral(envPtr, "", 0); } @@ -3030,12 +2934,10 @@ } else { /* * The var name isn't simple: compile and push it. */ - envPtr->line = line; - envPtr->clNext = clNext; CompileTokens(envPtr, varTokenPtr, interp); } if (removedParen) { varTokenPtr[removedParen].size++; @@ -3073,11 +2975,10 @@ Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr) { Tcl_Token *tokenPtr; - DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -3115,11 +3016,10 @@ const char *identity, int instruction, CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; - DefineLineInformation; /* TIP #280 */ int words; for (words=1 ; wordsnumWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); @@ -3199,11 +3099,10 @@ Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr) { Tcl_Token *tokenPtr; - DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords < 3) { PushLiteral(envPtr, "1", 1); } else if (parsePtr->numWords == 3) { tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -3383,11 +3282,10 @@ * This one has its own implementation because the ** operator is the only * one with right associativity. */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; - DefineLineInformation; /* TIP #280 */ int words; for (words=1 ; wordsnumWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); @@ -3553,11 +3451,10 @@ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; - DefineLineInformation; /* TIP #280 */ int words; if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. @@ -3598,11 +3495,10 @@ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; - DefineLineInformation; /* TIP #280 */ int words; if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. Index: generic/tclCompExpr.c ================================================================== --- generic/tclCompExpr.c +++ generic/tclCompExpr.c @@ -2085,14 +2085,10 @@ int objc; Tcl_Obj *const *litObjv; Tcl_Obj **funcObjv; - /* TIP #280 : Track Lines within the expression */ - TclAdvanceLines(&envPtr->line, script, - script + TclParseAllWhiteSpace(script, numBytes)); - TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv); TclListObjGetElements(NULL, funcList, &objc, &funcObjv); CompileExprTree(interp, opTree, 0, &litObjv, funcObjv, parsePtr->tokenPtr, envPtr, optimize); } else { @@ -2142,11 +2138,11 @@ * there can be no [info frame] calls when we execute the resulting * bytecode, so there's no need to tend to TIP 280 issues. */ envPtr = TclStackAlloc(interp, sizeof(CompileEnv)); - TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0); + TclInitCompileEnv(interp, envPtr, NULL, 0); CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr, 0 /* optimize */); TclEmitOpcode(INST_DONE, envPtr); Tcl_IncrRefCount(byteCodeObj); TclInitByteCodeObj(byteCodeObj, envPtr); Index: generic/tclCompile.c ================================================================== --- generic/tclCompile.c +++ generic/tclCompile.c @@ -450,19 +450,10 @@ const unsigned char *pc, Tcl_Obj *bufferObj); static void PrintSourceToObj(Tcl_Obj *appendObj, const char *stringPtr, int maxChars); static void UpdateStringOfInstName(Tcl_Obj *objPtr); -/* - * TIP #280: Helper for building the per-word line information of all compiled - * commands. - */ -static void EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset, - Tcl_Token *tokenPtr, const char *cmd, int len, - int numWords, int line, int *clNext, int **lines, - CompileEnv *envPtr); - /* * The structure below defines the bytecode Tcl object type by means of * procedures that can be invoked by generic object code. */ @@ -531,19 +522,17 @@ * compiled. Must not be NULL. */ Tcl_Obj *objPtr, /* The object to make a ByteCode object. */ CompileHookProc *hookProc, /* Procedure to invoke after compilation. */ ClientData clientData) /* Hook procedure private data. */ { - Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ register const AuxData *auxDataPtr; LiteralEntry *entryPtr; register int i; int length, result = TCL_OK; const char *stringPtr; - ContLineLoc *clLocPtr; #ifdef TCL_COMPILE_DEBUG if (!traceInitialized) { if (Tcl_LinkVar(interp, "tcl_traceCompile", (char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) { @@ -553,18 +542,11 @@ } #endif stringPtr = TclGetStringFromObj(objPtr, &length); - /* - * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and - * use to initialize the tracking in the compiler. This information was - * stored by TclCompEvalObj and ProcCompileProc. - */ - - TclInitCompileEnv(interp, &compEnv, stringPtr, length, - iPtr->invokeCmdFramePtr, iPtr->invokeWord); + TclInitCompileEnv(interp, &compEnv, stringPtr, length); /* * Now we check if we have data about invisible continuation lines for the * script, and make it available to the compile environment, if so. * @@ -574,17 +556,10 @@ * lock on it. We release this lock in the function TclFreeCompileEnv(), * found in this file. The "lineCLPtr" hashtable is managed in the file * "tclObj.c". */ - clLocPtr = TclContinuationsGet(objPtr); - if (clLocPtr) { - compEnv.clLoc = clLocPtr; - compEnv.clNext = &compEnv.clLoc->loc[0]; - Tcl_Preserve(compEnv.clLoc); - } - TclCompileScript(interp, stringPtr, length, &compEnv); /* * Successful compilation. Add a "done" instruction at the end. */ @@ -760,11 +735,10 @@ void TclCleanupByteCode( register ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; - Interp *iPtr = (Interp *) interp; int numLitObjects = codePtr->numLitObjects; int numAuxDataItems = codePtr->numAuxDataItems; register Tcl_Obj **objArrayPtr, *objPtr; register const AuxData *auxDataPtr; int i; @@ -858,43 +832,10 @@ for (i = 0; i < numAuxDataItems; i++) { if (auxDataPtr->type->freeProc != NULL) { auxDataPtr->type->freeProc(auxDataPtr->clientData); } auxDataPtr++; - } - - /* - * TIP #280. Release the location data associated with this byte code - * structure, if any. NOTE: The interp we belong to may be gone already, - * and the data with it. - * - * See also tclBasic.c, DeleteInterpProc - */ - - if (iPtr) { - Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, - (char *) codePtr); - - if (hePtr) { - ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr); - - if (eclPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(eclPtr->path); - } - for (i=0 ; inuloc ; i++) { - ckfree(eclPtr->loc[i].line); - } - - if (eclPtr->loc != NULL) { - ckfree(eclPtr->loc); - } - - Tcl_DeleteHashTable(&eclPtr->litInfo); - - ckfree(eclPtr); - Tcl_DeleteHashEntry(hePtr); - } } if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) { TclFreeLocalCache(interp, codePtr->localCachePtr); } @@ -1015,14 +956,13 @@ if (objPtr->typePtr != &substCodeType) { CompileEnv compEnv; int numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); - /* TODO: Check for more TIP 280 */ - TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0); + TclInitCompileEnv(interp, &compEnv, bytes, numBytes); - TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv); + TclSubstCompile(interp, bytes, numBytes, flags, &compEnv); TclEmitOpcode(INST_DONE, &compEnv); TclInitByteCodeObj(objPtr, &compEnv); objPtr->typePtr = &substCodeType; TclFreeCompileEnv(&compEnv); @@ -1095,14 +1035,11 @@ Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ register CompileEnv *envPtr,/* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ - int numBytes, /* Number of bytes in source string. */ - const CmdFrame *invoker, /* Location context invoking the bcc */ - int word) /* Index of the word in that context getting - * compiled */ + int numBytes) /* Number of bytes in source string. */ { Interp *iPtr = (Interp *) interp; envPtr->iPtr = iPtr; envPtr->source = stringPtr; @@ -1134,142 +1071,10 @@ envPtr->cmdMapPtr = envPtr->staticCmdMapSpace; envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE; envPtr->mallocedCmdMap = 0; envPtr->atCmdStart = 1; - /* - * TIP #280: Set up the extended command location information, based on - * the context invoking the byte code compiler. This structure is used to - * keep the per-word line information for all compiled commands. - * - * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the - * non-compiling evaluator - */ - - envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc)); - envPtr->extCmdMapPtr->loc = NULL; - envPtr->extCmdMapPtr->nloc = 0; - envPtr->extCmdMapPtr->nuloc = 0; - envPtr->extCmdMapPtr->path = NULL; - Tcl_InitHashTable(&envPtr->extCmdMapPtr->litInfo, TCL_ONE_WORD_KEYS); - - if ((invoker == NULL) || (invoker->type == TCL_LOCATION_EVAL_LIST)) { - /* - * Initialize the compiler for relative counting in case of a - * dynamic context. - */ - - envPtr->line = 1; - if (iPtr->evalFlags & TCL_EVAL_FILE) { - iPtr->evalFlags &= ~TCL_EVAL_FILE; - envPtr->extCmdMapPtr->type = TCL_LOCATION_SOURCE; - - if (iPtr->scriptFile) { - /* - * 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); - - if (norm == NULL) { - /* - * Error message in the interp result. No place to put it. - * And no place to serve the error itself to either. Fake - * a path, empty string. - */ - - TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, ""); - } else { - envPtr->extCmdMapPtr->path = norm; - } - } else { - TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, ""); - } - - Tcl_IncrRefCount(envPtr->extCmdMapPtr->path); - } else { - envPtr->extCmdMapPtr->type = - (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC); - } - } else { - /* - * Initialize the compiler using the context, making counting absolute - * to that context. Note that the context can be byte code execution. - * In that case we have to fill out the missing pieces (line, path, - * ...) which may make change the type as well. - */ - - CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); - int pc = 0; - - *ctxPtr = *invoker; - if (invoker->type == TCL_LOCATION_BC) { - /* - * Note: Type BC => ctx.data.eval.path is not used. - * ctx.data.tebc.codePtr is used instead. - */ - - TclGetSrcInfoForPc(ctxPtr); - pc = 1; - } - - if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) { - /* - * Word is not a literal, relative counting. - */ - - envPtr->line = 1; - envPtr->extCmdMapPtr->type = - (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC); - - if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { - /* - * The reference made by 'TclGetSrcInfoForPc' is dead. - */ - - Tcl_DecrRefCount(ctxPtr->data.eval.path); - } - } else { - envPtr->line = ctxPtr->line[word]; - envPtr->extCmdMapPtr->type = ctxPtr->type; - - if (ctxPtr->type == TCL_LOCATION_SOURCE) { - envPtr->extCmdMapPtr->path = ctxPtr->data.eval.path; - - if (pc) { - /* - * The reference 'TclGetSrcInfoForPc' made is transfered. - */ - - ctxPtr->data.eval.path = NULL; - } else { - /* - * We have a new reference here. - */ - - Tcl_IncrRefCount(envPtr->extCmdMapPtr->path); - } - } - } - - TclStackFree(interp, ctxPtr); - } - - envPtr->extCmdMapPtr->start = envPtr->line; - - /* - * Initialize the data about invisible continuation lines as empty, i.e. - * not used. The caller (TclSetByteCodeFromAny) will set this up, if such - * data is available. - */ - - envPtr->clLoc = NULL; - envPtr->clNext = NULL; envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace; envPtr->auxDataArrayNext = 0; envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE; envPtr->mallocedAuxDataArray = 0; @@ -1318,23 +1123,10 @@ ckfree(envPtr->cmdMapPtr); } if (envPtr->mallocedAuxDataArray) { ckfree(envPtr->auxDataArrayPtr); } - if (envPtr->extCmdMapPtr) { - ckfree(envPtr->extCmdMapPtr); - } - - /* - * If we used data about invisible continuation lines, then now is the - * time to release on our hold on it. The lock was set in function - * TclSetByteCodeFromAny(), found in this file. - */ - - if (envPtr->clLoc) { - Tcl_Release(envPtr->clLoc); - } } /* *---------------------------------------------------------------------- * @@ -1456,13 +1248,10 @@ Namespace *cmdNsPtr; Command *cmdPtr; Tcl_Token *tokenPtr; int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex; Tcl_DString ds; - /* TIP #280 */ - ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; - int *wlines, wlineat, cmdLine, *clNext; Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); Tcl_DStringInit(&ds); if (numBytes < 0) { @@ -1482,12 +1271,10 @@ * from the script. */ p = script; bytesLeft = numBytes; - cmdLine = envPtr->line; - clNext = envPtr->clNext; do { if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { /* * Compile bytecodes to report the parse error at runtime. */ @@ -1499,22 +1286,10 @@ parsePtr->commandSize - 1 : parsePtr->commandSize); TclCompileSyntaxError(interp, envPtr); break; } - /* - * TIP #280: We have to count newlines before the command even in the - * degenerate case when the command has no words. (See test - * info-30.33). - * So make that counting here, and not in the (numWords > 0) branch - * below. - */ - - TclAdvanceLines(&cmdLine, p, parsePtr->commandStart); - TclAdvanceContinuations(&cmdLine, &clNext, - parsePtr->commandStart - envPtr->source); - if (parsePtr->numWords > 0) { int expand = 0; /* Set if there are dynamic expansions to * handle */ /* @@ -1587,35 +1362,19 @@ if (expand) { TclEmitOpcode(INST_EXPAND_START, envPtr); } - /* - * TIP #280. Scan the words and compute the extended location - * information. The map first contain full per-word line - * information for use by the compiler. This is later replaced by - * a reduced form which signals non-literal words, stored in - * 'wlines'. - */ - - EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source, - parsePtr->tokenPtr, parsePtr->commandStart, - parsePtr->commandSize, parsePtr->numWords, cmdLine, - clNext, &wlines, envPtr); - wlineat = eclPtr->nuloc - 1; - /* * Each iteration of the following loop compiles one word from the * command. */ for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr; wordIdx < parsePtr->numWords; wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { - envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; - envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx]; if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * The word is not a simple string of characters. */ @@ -1766,17 +1525,10 @@ * which already allows absolute counting. */ objIndex = TclRegisterNewLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size); - - if (envPtr->clNext) { - TclContinuationsEnterDerived( - envPtr->literalArrayPtr[objIndex].objPtr, - tokenPtr[1].start - envPtr->source, - eclPtr->loc[wlineat].next[wordIdx]); - } } TclEmitPush(objIndex, envPtr); } /* for loop */ /* @@ -1802,20 +1554,10 @@ */ TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); TclAdjustStackDepth((1-wordIdx), envPtr); } else if (wordIdx > 0) { - /* - * Save PC -> command map for the TclArgumentBC* functions. - */ - - int isnew; - Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo, - INT2PTR(envPtr->codeNext - envPtr->codeStart), - &isnew); - - Tcl_SetHashValue(hePtr, INT2PTR(wlineat)); if (wordIdx <= 255) { TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); } else { TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr); } @@ -1829,46 +1571,22 @@ finishCommand: EnterCmdExtentData(envPtr, currCmdIndex, commandLength, (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); isFirstCmd = 0; - /* - * TIP #280: Free full form of per-word line data and insert the - * reduced form now - */ - - ckfree(eclPtr->loc[wlineat].line); - ckfree(eclPtr->loc[wlineat].next); - eclPtr->loc[wlineat].line = wlines; - eclPtr->loc[wlineat].next = NULL; } /* end if parsePtr->numWords > 0 */ /* * Advance to the next command in the script. */ next = parsePtr->commandStart + parsePtr->commandSize; bytesLeft -= next - p; p = next; - - /* - * TIP #280: Track lines in the just compiled command. - */ - - TclAdvanceLines(&cmdLine, parsePtr->commandStart, p); - TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source); Tcl_FreeParse(parsePtr); } while (bytesLeft > 0); - /* - * TIP #280: Bring the line counts in the CompEnv up to date. - * See tests info-30.33,34,35 . - */ - - envPtr->line = cmdLine; - envPtr->clNext = clNext; - /* * If the source script yielded no instructions (e.g., if it was empty), * push an empty string as the command's result. */ @@ -1947,13 +1665,10 @@ /* * Emit instructions to load the variable. */ - TclAdvanceLines(&envPtr->line, tokenPtr[1].start, - tokenPtr[1].start + tokenPtr[1].size); - if (tokenPtr->numComponents == 1) { if (localVar < 0) { TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr); } else if (localVar <= 255) { TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr); @@ -1982,90 +1697,28 @@ CompileEnv *envPtr) /* Holds the resulting instructions. */ { Tcl_DString textBuffer; /* Holds concatenated chars from adjacent * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ char buffer[TCL_UTF_MAX]; - int i, numObjsToConcat, length; + int numObjsToConcat, length; unsigned char *entryCodeNext = envPtr->codeNext; -#define NUM_STATIC_POS 20 - int isLiteral, maxNumCL, numCL; - int *clPosition = NULL; - - /* - * For the handling of continuation lines in literals we first check if - * this is actually a literal. For if not we can forego the additional - * processing. Otherwise we pre-allocate a small table to store the - * locations of all continuation lines we find in this literal, if any. - * The table is extended if needed. - * - * Note: Different to the equivalent code in function 'TclSubstTokens()' - * (see file "tclParse.c") we do not seem to need the 'adjust' variable. - * We also do not seem to need code which merges continuation line - * information of multiple words which concat'd at runtime. Either that or - * I have not managed to find a test case for these two possibilities yet. - * It might be a difference between compile- versus run-time processing. - */ - - numCL = 0; - maxNumCL = 0; - isLiteral = 1; - for (i=0 ; i < count; i++) { - if ((tokenPtr[i].type != TCL_TOKEN_TEXT) - && (tokenPtr[i].type != TCL_TOKEN_BS)) { - isLiteral = 0; - break; - } - } - - if (isLiteral) { - maxNumCL = NUM_STATIC_POS; - clPosition = ckalloc(maxNumCL * sizeof(int)); - } Tcl_DStringInit(&textBuffer); numObjsToConcat = 0; for ( ; count > 0; count--, tokenPtr++) { switch (tokenPtr->type) { case TCL_TOKEN_TEXT: Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size); - TclAdvanceLines(&envPtr->line, tokenPtr->start, - tokenPtr->start + tokenPtr->size); break; case TCL_TOKEN_BS: length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, buffer); Tcl_DStringAppend(&textBuffer, buffer, length); - /* - * If the backslash sequence we found is in a literal, and - * represented a continuation line, we compute and store its - * location (as char offset to the beginning of the _result_ - * script). We may have to extend the table of locations. - * - * Note that the continuation line information is relevant even if - * the word we are processing is not a literal, as it can affect - * nested commands. See the branch for TCL_TOKEN_COMMAND below, - * where the adjustment we are tracking here is taken into - * account. The good thing is that we do not need a table of - * everything, just the number of lines we have to add as - * correction. - */ - if ((length == 1) && (buffer[0] == ' ') && (tokenPtr->start[1] == '\n')) { - if (isLiteral) { - int clPos = Tcl_DStringLength(&textBuffer); - - if (numCL >= maxNumCL) { - maxNumCL *= 2; - clPosition = ckrealloc(clPosition, - maxNumCL * sizeof(int)); - } - clPosition[numCL] = clPos; - numCL ++; - } } break; case TCL_TOKEN_COMMAND: /* @@ -2078,17 +1731,10 @@ Tcl_DStringLength(&textBuffer)); TclEmitPush(literal, envPtr); numObjsToConcat++; Tcl_DStringFree(&textBuffer); - - if (numCL) { - TclContinuationsEnter( - envPtr->literalArrayPtr[literal].objPtr, numCL, - clPosition); - } - numCL = 0; } TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, envPtr); numObjsToConcat++; @@ -2131,16 +1777,10 @@ literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer), Tcl_DStringLength(&textBuffer)); TclEmitPush(literal, envPtr); numObjsToConcat++; - - if (numCL) { - TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr, - numCL, clPosition); - } - numCL = 0; } /* * If necessary, concatenate the parts of the word. */ @@ -2159,19 +1799,10 @@ if (envPtr->codeNext == entryCodeNext) { TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } Tcl_DStringFree(&textBuffer); - - /* - * Release the temp table we used to collect the locations of continuation - * lines, if any. - */ - - if (maxNumCL) { - ckfree(clPosition); - } } /* *---------------------------------------------------------------------- * @@ -2377,11 +2008,11 @@ #ifdef TCL_COMPILE_DEBUG unsigned char *nextPtr; #endif int numLitObjects = envPtr->literalArrayNext; Namespace *namespacePtr; - int i, isNew; + int i; Interp *iPtr; iPtr = envPtr->iPtr; codeBytes = envPtr->codeNext - envPtr->codeStart; @@ -2488,19 +2119,10 @@ TclFreeIntRep(objPtr); objPtr->internalRep.otherValuePtr = codePtr; objPtr->typePtr = &tclByteCodeType; - /* - * TIP #280. Associate the extended per-word line information with the - * byte code object (internal rep), for use with the bc compiler. - */ - - Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr, - &isNew), envPtr->extCmdMapPtr); - envPtr->extCmdMapPtr = NULL; - codePtr->localCachePtr = NULL; } /* *---------------------------------------------------------------------- @@ -2803,90 +2425,10 @@ cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex]; cmdLocPtr->numSrcBytes = numSrcBytes; cmdLocPtr->numCodeBytes = numCodeBytes; } - -/* - *---------------------------------------------------------------------- - * TIP #280 - * - * EnterCmdWordData -- - * - * Registers the lines for the words of a command. This information is - * used at runtime by 'info frame'. - * - * Results: - * None. - * - * Side effects: - * Inserts word location information into the compilation environment - * envPtr for the command at index cmdIndex. The compilation - * environment's ExtCmdLoc.ECL array is grown if necessary. - * - *---------------------------------------------------------------------- - */ - -static void -EnterCmdWordData( - ExtCmdLoc *eclPtr, /* Points to the map environment structure in - * which to enter command location - * information. */ - int srcOffset, /* Offset of first char of the command. */ - Tcl_Token *tokenPtr, - const char *cmd, - int len, - int numWords, - int line, - int *clNext, - int **wlines, - CompileEnv *envPtr) -{ - ECL *ePtr; - const char *last; - int wordIdx, wordLine, *wwlines, *wordNext; - - if (eclPtr->nuloc >= eclPtr->nloc) { - /* - * Expand the ECL array by allocating more storage from the heap. The - * currently allocated ECL entries are stored from eclPtr->loc[0] up - * to eclPtr->loc[eclPtr->nuloc-1] (inclusive). - */ - - size_t currElems = eclPtr->nloc; - size_t newElems = (currElems ? 2*currElems : 1); - size_t newBytes = newElems * sizeof(ECL); - - eclPtr->loc = ckrealloc(eclPtr->loc, newBytes); - eclPtr->nloc = newElems; - } - - ePtr = &eclPtr->loc[eclPtr->nuloc]; - ePtr->srcOffset = srcOffset; - ePtr->line = ckalloc(numWords * sizeof(int)); - ePtr->next = ckalloc(numWords * sizeof(int *)); - ePtr->nline = numWords; - wwlines = ckalloc(numWords * sizeof(int)); - - last = cmd; - wordLine = line; - wordNext = clNext; - for (wordIdx=0 ; wordIdxnumComponents + 1) { - TclAdvanceLines(&wordLine, last, tokenPtr->start); - TclAdvanceContinuations(&wordLine, &wordNext, - tokenPtr->start - envPtr->source); - wwlines[wordIdx] = - (TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1); - ePtr->line[wordIdx] = wordLine; - ePtr->next[wordIdx] = wordNext; - last = tokenPtr->start; - } - - *wlines = wwlines; - eclPtr->nuloc ++; -} /* *---------------------------------------------------------------------- * * TclCreateExceptRange -- Index: generic/tclCompile.h ================================================================== --- generic/tclCompile.h +++ generic/tclCompile.h @@ -112,50 +112,10 @@ int numCodeBytes; /* Number of bytes for command's code. */ int srcOffset; /* Offset of first char of the command. */ int numSrcBytes; /* Number of command source chars. */ } 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. - */ - -typedef struct ECL { - int srcOffset; /* Command location to find the entry. */ - int nline; /* Number of words in the command */ - int *line; /* Line information for all words in the - * command. */ - int **next; /* Transient information used by the compiler - * for tracking of hidden continuation - * lines. */ -} ECL; - -typedef struct ExtCmdLoc { - int type; /* Context type. */ - int start; /* Starting line for compiled script. Needed - * for the extended recompile check in - * tclCompileObj. */ - 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'. */ - Tcl_HashTable litInfo; /* Indexed by bytecode 'PC', to have the - * information accessible per command and - * argument, not per whole bytecode. Value is - * index of command in 'loc', giving us the - * literals to associate with line information - * as command argument, see - * TclArgumentBCEnter() */ -} ExtCmdLoc; - /* * CompileProcs need the ability to record information during compilation that * can be used by bytecode instructions during execution. The AuxData * structure provides this "auxiliary data" mechanism. An arbitrary number of * these structures can be stored in the ByteCode record (during compilation @@ -298,27 +258,14 @@ /* Initial ExceptionRange array storage. */ CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE]; /* Initial storage for cmd location map. */ AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE]; /* Initial storage for aux data array. */ - /* TIP #280 */ - ExtCmdLoc *extCmdMapPtr; /* Extended command location information for - * 'info frame'. */ - int line; /* First line of the script, based on the - * invoking context, then the line of the - * command currently compiled. */ int atCmdStart; /* Flag to say whether an INST_START_CMD * should be issued; they should never be * issued repeatedly, as that is significantly * inefficient. */ - ContLineLoc *clLoc; /* If not NULL, the table holding the - * locations of the invisible continuation - * lines in the input script, to adjust the - * line counter. */ - int *clNext; /* If not NULL, it refers to the next slot in - * clLoc to check for an invisible - * continuation line. */ } CompileEnv; /* * The structure defining the bytecode instructions resulting from compiling a * Tcl script. Note that this structure is variable length: a single heap @@ -868,12 +815,11 @@ *---------------------------------------------------------------- * Procedures exported by the engine to be used by tclBasic.c *---------------------------------------------------------------- */ -MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - const CmdFrame *invoker, int word); +MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* *---------------------------------------------------------------- * Procedures shared among Tcl bytecode compilation and execution modules but * not used outside: @@ -932,11 +878,11 @@ MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr, CompileEnv *envPtr); MODULE_SCOPE void TclInitCompilation(void); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr, const char *string, - int numBytes, const CmdFrame *invoker, int word); + int numBytes); MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr); #ifdef TCL_COMPILE_STATS MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); Index: generic/tclDictObj.c ================================================================== --- generic/tclDictObj.c +++ generic/tclDictObj.c @@ -2399,11 +2399,10 @@ ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { - Interp *iPtr = (Interp *) interp; Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj, *valueObj; Tcl_DictSearch *searchPtr; int varc, done; @@ -2469,11 +2468,11 @@ * Run the script. */ TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj, valueVarObj, scriptObj); - return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3); + return TclNREvalObjEx(interp, scriptObj, 0); /* * For unwinding everything on error. */ @@ -2490,11 +2489,10 @@ DictForLoopCallback( ClientData data[], Tcl_Interp *interp, int result) { - Interp *iPtr = (Interp *) interp; Tcl_DictSearch *searchPtr = data[0]; Tcl_Obj *keyVarObj = data[1]; Tcl_Obj *valueVarObj = data[2]; Tcl_Obj *scriptObj = data[3]; Tcl_Obj *keyObj, *valueObj; @@ -2549,11 +2547,11 @@ * Run the script. */ TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj, valueVarObj, scriptObj); - return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3); + return TclNREvalObjEx(interp, scriptObj, 0); /* * For unwinding everything once the iterating is done. */ @@ -2708,11 +2706,10 @@ ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { - Interp *iPtr = (Interp *) interp; static const char *const filters[] = { "key", "script", "value", NULL }; enum FilterTypes { FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES @@ -2889,15 +2886,11 @@ Tcl_AppendResult(interp, "couldn't set value variable: \"", TclGetString(valueVarObj), "\"", NULL); goto abnormalResult; } - /* - * TIP #280. Make invoking context available to loop body. - */ - - result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 4); + result = Tcl_EvalObjEx(interp, scriptObj, 0); switch (result) { case TCL_OK: boolObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(boolObj); Tcl_ResetResult(interp); @@ -2992,11 +2985,10 @@ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { - Interp *iPtr = (Interp *) interp; Tcl_Obj *dictPtr, *objPtr; int i, dummy; if (objc < 5 || !(objc & 1)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -3036,11 +3028,11 @@ objPtr = Tcl_NewListObj(objc-3, objv+2); Tcl_IncrRefCount(objPtr); Tcl_IncrRefCount(objv[1]); TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL); - return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1); + return TclNREvalObjEx(interp, objv[objc-1], 0); } static int FinalizeDictUpdate( ClientData data[], @@ -3151,11 +3143,10 @@ ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { - Interp *iPtr = (Interp *) interp; Tcl_Obj *dictPtr, *keysPtr, *keyPtr = NULL, *valPtr = NULL, *pathPtr; Tcl_DictSearch s; int done; if (objc < 3) { @@ -3203,12 +3194,11 @@ return TCL_ERROR; } } /* - * Execute the body, while making the invoking context available to the - * loop body (TIP#280) and postponing the cleanup until later (NRE). + * Execute the body, while postponing the cleanup until later (NRE). */ pathPtr = NULL; if (objc > 3) { pathPtr = Tcl_NewListObj(objc-3, objv+2); @@ -3216,11 +3206,11 @@ } Tcl_IncrRefCount(objv[1]); TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr, NULL); - return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1); + return TclNREvalObjEx(interp, objv[objc-1], 0); } static int FinalizeDictWith( ClientData data[], Index: generic/tclExecute.c ================================================================== --- generic/tclExecute.c +++ generic/tclExecute.c @@ -174,11 +174,10 @@ const unsigned char *pc; /* These fields are used on return TO this */ ptrdiff_t *catchTop; /* this level: they record the state when a */ int cleanup; /* new codePtr was received for NR */ Tcl_Obj *auxObjList; /* execution. */ int checkInterp; - CmdFrame cmdFrame; void * stack[1]; /* Start of the actual combined catch and obj * stacks; the struct will be expanded as * necessary */ } TEBCdata; @@ -774,10 +773,39 @@ dictPtr = objPtr->internalRep.twoPtrValue.ptr2; TclDecrRefCount(dictPtr); objPtr->typePtr = NULL; } + +static void UpdateStringOfBcSource(Tcl_Obj *objPtr); + +static const Tcl_ObjType bcSourceType = { + "bcSource", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + UpdateStringOfBcSource, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + +static void +UpdateStringOfBcSource( + Tcl_Obj *objPtr) +{ + int len; + const char *bytes; + unsigned char *pc = objPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr2; + + bytes = GetSrcInfoForPc(pc, codePtr, &len, NULL); + objPtr->bytes = (char *) ckalloc((unsigned) len + 1); + memcpy(objPtr->bytes, bytes, len); + objPtr->bytes[len] = '\0'; + objPtr->length = len; +} + + + /* *---------------------------------------------------------------------- * * InitByteCodeExecution -- @@ -1468,18 +1496,14 @@ || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) { FreeExprCodeInternalRep(objPtr); } } if (objPtr->typePtr != &exprCodeType) { - /* - * TIP #280: No invoker (yet) - Expression compilation. - */ - int length; const char *string = TclGetStringFromObj(objPtr, &length); - TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); + TclInitCompileEnv(interp, &compEnv, string, length); TclCompileExpr(interp, string, length, &compEnv, 0); /* * Successful compilation. If the expression yielded no instructions, * push an zero object as the expression's result. @@ -1599,13 +1623,11 @@ */ ByteCode * TclCompileObj( Tcl_Interp *interp, - Tcl_Obj *objPtr, - const CmdFrame *invoker, - int word) + Tcl_Obj *objPtr) { register Interp *iPtr = (Interp *) interp; register ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; @@ -1657,111 +1679,17 @@ if (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr) { goto recompileObj; } } - /* - * #280. - * Literal sharing fix. This part of the fix is not required by 8.4 - * nor 8.5, because they eval-direct any literals, so just saving the - * argument locations per command in bytecode is enough, embedded - * 'eval' commands, etc. get the correct information. - * - * But in 8.6 all the embedded script are compiled, and the resulting - * bytecode stored in the literal. Now the shared literal has bytecode - * with location data for _one_ particular location this literal is - * found at. If we get executed from a different location the bytecode - * has to be recompiled to get the correct locations. Not doing this - * will execute the saved bytecode with data for a different location, - * causing 'info frame' to point to the wrong place in the sources. - * - * Future optimizations ... - * (1) Save the location data (ExtCmdLoc) keyed by start line. In that - * case we recompile once per location of the literal, but not - * continously, because the moment we have all locations we do not - * need to recompile any longer. - * - * (2) Alternative: Do not recompile, tell the execution engine the - * offset between saved starting line and actual one. Then modify - * the users to adjust the locations they have by this offset. - * - * (3) Alternative 2: Do not fully recompile, adjust just the location - * information. - */ - - { - Tcl_HashEntry *hePtr = - Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); - ExtCmdLoc *eclPtr; - CmdFrame *ctxPtr; - int redo; - - if (!hePtr || !invoker) { - return codePtr; - } - - eclPtr = Tcl_GetHashValue(hePtr); - redo = 0; - ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); - *ctxPtr = *invoker; - - if (invoker->type == TCL_LOCATION_BC) { - /* - * Note: Type BC => ctx.data.eval.path is not used. - * ctx.data.tebc.codePtr used instead - */ - - TclGetSrcInfoForPc(ctxPtr); - if (ctxPtr->type == TCL_LOCATION_SOURCE) { - /* - * The reference made by 'TclGetSrcInfoForPc' is dead. - */ - - Tcl_DecrRefCount(ctxPtr->data.eval.path); - ctxPtr->data.eval.path = NULL; - } - } - - if (word < ctxPtr->nline) { - /* - * Note: We do not care if the line[word] is -1. This is a - * difference and requires a recompile (location changed from - * absolute to relative, literal is used fixed and through - * variable) - * - * Example: - * test info-32.0 using literal of info-24.8 - * (dict with ... vs set body ...). - */ - - redo = ((eclPtr->type == TCL_LOCATION_SOURCE) - && (eclPtr->start != ctxPtr->line[word])) - || ((eclPtr->type == TCL_LOCATION_BC) - && (ctxPtr->type == TCL_LOCATION_SOURCE)); - } - - TclStackFree(interp, ctxPtr); - if (!redo) { - return codePtr; - } - } + return codePtr; } recompileObj: iPtr->errorLine = 1; - /* - * TIP #280. Remember the invoker for a moment in the interpreter - * structures so that the byte code compiler can pick it up when - * initializing the compilation environment, i.e. the extended location - * information. - */ - - iPtr->invokeCmdFramePtr = invoker; - iPtr->invokeWord = word; tclByteCodeType.setFromAnyProc(interp, objPtr); - iPtr->invokeCmdFramePtr = NULL; codePtr = objPtr->internalRep.otherValuePtr; if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; } @@ -1910,11 +1838,10 @@ * Side effects: * Almost certainly, depending on the ByteCode's instructions. * *---------------------------------------------------------------------- */ -#define bcFramePtr (&TD->cmdFrame) #define initCatchTop ((ptrdiff_t *) (&TD->stack[-1])) #define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth)) #define esPtr (iPtr->execEnvPtr->execStackPtr) int @@ -1937,11 +1864,11 @@ /* * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame * * The execution uses a unified stack: first a TEBCdata, immediately - * above it a CmdFrame, then the catch stack, then the execution stack. + * above it the catch stack, then the execution stack. * * Make sure the catch stack is large enough to hold the maximum number of * catch commands that could ever be executing at the same time (this will * be no more than the exception range array's depth). Make sure the * execution stack is large enough to execute this ByteCode. @@ -1954,29 +1881,10 @@ TD->pc = codePtr->codeStart; TD->catchTop = initCatchTop; TD->cleanup = 0; TD->auxObjList = NULL; TD->checkInterp = 0; - - /* - * TIP #280: Initialize the frame. Do not push it yet: it will be pushed - * every time that we call out from this TD, popped when we return to it. - */ - - bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) - ? TCL_LOCATION_PREBC : TCL_LOCATION_BC); - bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1); - bcFramePtr->numLevels = iPtr->numLevels; - bcFramePtr->framePtr = iPtr->framePtr; - bcFramePtr->nextPtr = iPtr->cmdFramePtr; - bcFramePtr->nline = 0; - bcFramePtr->line = NULL; - bcFramePtr->litarg = NULL; - bcFramePtr->data.tebc.codePtr = codePtr; - bcFramePtr->data.tebc.pc = NULL; - bcFramePtr->cmd.str.cmd = NULL; - bcFramePtr->cmd.str.len = 0; #ifdef TCL_COMPILE_STATS iPtr->stats.numExecutions++; #endif @@ -2078,10 +1986,13 @@ #endif #ifdef TCL_COMPILE_DEBUG traceInstructions = (tclTraceExec == 3); #endif + Tcl_Obj *srcPtr = Tcl_NewObj(); + srcPtr->typePtr = &bcSourceType; + TclInvalidateStringRep(srcPtr); TEBC_DATA_DIG(); #ifdef TCL_COMPILE_DEBUG if (!data[1] && (tclTraceExec >= 2)) { @@ -2093,15 +2004,10 @@ if (data[1] /* resume from invocation */) { if (iPtr->execEnvPtr->rewind) { result = TCL_ERROR; } - NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); - iPtr->cmdFramePtr = bcFramePtr->nextPtr; - if (iPtr->flags & INTERP_DEBUG_FRAME) { - TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr); - } if (codePtr->flags & TCL_BYTECODE_RECOMPILE) { iPtr->flags |= ERR_ALREADY_LOGGED; codePtr->flags &= ~TCL_BYTECODE_RECOMPILE; } @@ -2688,12 +2594,10 @@ } case INST_EXPR_STK: { ByteCode *newCodePtr; - bcFramePtr->data.tebc.pc = (char *) pc; - iPtr->cmdFramePtr = bcFramePtr; DECACHE_STACK_INFO(); newCodePtr = CompileExprObj(interp, OBJ_AT_TOS); CACHE_STACK_INFO(); cleanup = 1; pc++; @@ -2705,17 +2609,14 @@ * INVOCATION BLOCK */ instEvalStk: case INST_EVAL_STK: - bcFramePtr->data.tebc.pc = (char *) pc; - iPtr->cmdFramePtr = bcFramePtr; - cleanup = 1; pc += 1; TEBC_YIELD(); - return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0); + return TclNREvalObjEx(interp, OBJ_AT_TOS, 0); case INST_INVOKE_EXPANDED: CLANG_ASSERT(auxObjList); objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value; POP_TAUX_OBJ(); @@ -2764,24 +2665,17 @@ } #endif /*TCL_COMPILE_DEBUG*/ /* * Finally, let TclEvalObjv handle the command. - * - * TIP #280: Record the last piece of info needed by - * 'TclGetSrcInfoForPc', and push the frame. */ - bcFramePtr->data.tebc.pc = (char *) pc; - iPtr->cmdFramePtr = bcFramePtr; - - if (iPtr->flags & INTERP_DEBUG_FRAME) { - TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, - codePtr, bcFramePtr, pc - codePtr->codeStart); - } - - DECACHE_STACK_INFO(); + if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { + srcPtr->internalRep.twoPtrValue.ptr1 = (unsigned char *) pc; + srcPtr->internalRep.twoPtrValue.ptr2 = codePtr; + iPtr->cmdSourcePtr = srcPtr; + } pc += pcAdjustment; TEBC_YIELD(); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, NULL); @@ -6386,14 +6280,13 @@ "stack top %d < entry stack top %d\n", (unsigned)(pc - codePtr->codeStart), (unsigned) CURR_DEPTH, (unsigned) 0); Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top"); } - CLANG_ASSERT(bcFramePtr); } - iPtr->cmdFramePtr = bcFramePtr->nextPtr; + TclDecrRefCount(srcPtr); if (--codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); } TclStackFree(interp, TD); /* free my stack */ @@ -6400,12 +6293,10 @@ return result; } #undef codePtr #undef iPtr -#undef bcFramePtr -#undef initCatchTop #undef initTosPtr #undef auxObjList #undef catchTop #undef TCONST @@ -7986,80 +7877,10 @@ * The CmdFrame at *cfPtr is updated. * *---------------------------------------------------------------------- */ -const char * -TclGetSrcInfoForCmd( - Interp *iPtr, - int *lenPtr) -{ - CmdFrame *cfPtr = iPtr->cmdFramePtr; - ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; - - return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, - codePtr, lenPtr, NULL); -} - -void -TclGetSrcInfoForPc( - CmdFrame *cfPtr) -{ - ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; - - if (cfPtr->cmd.str.cmd == NULL) { - cfPtr->cmd.str.cmd = GetSrcInfoForPc( - (unsigned char *) cfPtr->data.tebc.pc, codePtr, - &cfPtr->cmd.str.len, NULL); - } - - if (cfPtr->cmd.str.cmd != NULL) { - /* - * We now have the command. We can get the srcOffset back and from - * there find the list of word locations for this command. - */ - - ExtCmdLoc *eclPtr; - ECL *locPtr = NULL; - int srcOffset, i; - Interp *iPtr = (Interp *) *codePtr->interpHandle; - Tcl_HashEntry *hePtr = - Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); - - if (!hePtr) { - return; - } - - srcOffset = cfPtr->cmd.str.cmd - codePtr->source; - eclPtr = Tcl_GetHashValue(hePtr); - - for (i=0; i < eclPtr->nuloc; i++) { - if (eclPtr->loc[i].srcOffset == srcOffset) { - locPtr = eclPtr->loc+i; - break; - } - } - if (locPtr == NULL) { - Tcl_Panic("LocSearch failure"); - } - - cfPtr->line = locPtr->line; - cfPtr->nline = locPtr->nline; - cfPtr->type = eclPtr->type; - - if (eclPtr->type == TCL_LOCATION_SOURCE) { - cfPtr->data.eval.path = eclPtr->path; - Tcl_IncrRefCount(cfPtr->data.eval.path); - } - - /* - * Do not set cfPtr->data.eval.path NULL for non-SOURCE. Needed for - * cfPtr->data.tebc.codePtr. - */ - } -} - static const char * GetSrcInfoForPc( const unsigned char *pc, /* The program counter value for which to * return the closest command's source info. * This points within a bytecode instruction in Index: generic/tclIOUtil.c ================================================================== --- generic/tclIOUtil.c +++ generic/tclIOUtil.c @@ -1741,14 +1741,10 @@ oldScriptFile = iPtr->scriptFile; iPtr->scriptFile = pathPtr; Tcl_IncrRefCount(iPtr->scriptFile); string = Tcl_GetStringFromObj(objPtr, &length); - /* - * TIP #280 Force the evaluator to open a frame for a sourced file. - */ - iPtr->evalFlags |= TCL_EVAL_FILE; result = Tcl_EvalEx(interp, string, length, 0); /* * Now we have to be careful; the script may have changed the @@ -1852,18 +1848,14 @@ iPtr = (Interp *) interp; oldScriptFile = iPtr->scriptFile; iPtr->scriptFile = pathPtr; Tcl_IncrRefCount(iPtr->scriptFile); - /* - * TIP #280: Force the evaluator to open a frame for a sourced file. - */ - iPtr->evalFlags |= TCL_EVAL_FILE; TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr, NULL); - return TclNREvalObjEx(interp, objPtr, 0, NULL, INT_MIN); + return TclNREvalObjEx(interp, objPtr, 0); } static int EvalFileCallback( ClientData data[], Index: generic/tclInt.decls ================================================================== --- generic/tclInt.decls +++ generic/tclInt.decls @@ -917,17 +917,17 @@ int TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr) } # Bits and pieces of TIP#280's guts -declare 232 { - int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, - const CmdFrame *invoker, int word) -} -declare 233 { - void TclGetSrcInfoForPc(CmdFrame *contextPtr) -} +#declare 232 { +# int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, +# const CmdFrame *invoker, int word) +#} +#declare 233 { +# void TclGetSrcInfoForPc(CmdFrame *contextPtr) +#} # Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :( declare 234 { Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr) @@ -960,12 +960,11 @@ declare 240 { int TclNRRunCallbacks(Tcl_Interp *interp, int result, struct NRE_callback *rootPtr) } declare 241 { - int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, - const CmdFrame *invoker, int word) + int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } declare 242 { int TclNREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr) } Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -17,10 +17,15 @@ */ #ifndef _TCLINT #define _TCLINT +#ifdef MODULE_SCOPE +#undef MODULE_SCOPE +#define MODULE_SCOPE +#endif + /* * Some numerics configuration options. */ #undef NO_WIDE_TYPE @@ -1163,196 +1168,10 @@ * the [oo::define] command; the clientData * field contains an Object reference that has * been confirmed to refer to a class. Part of * TIP#257. */ -/* - * TIP #280 - * The structure below defines a command frame. A command frame provides - * location information for all commands executing a tcl script (source, eval, - * uplevel, procedure bodies, ...). The runtime structure essentially contains - * the stack trace as it would be if the currently executing command were to - * throw an error. - * - * For commands where it makes sense it refers to the associated CallFrame as - * well. - * - * The structures are chained in a single list, with the top of the stack - * anchored in the Interp structure. - * - * Instances can be allocated on the C stack, or the heap, the former making - * cleanup a bit simpler. - */ - -typedef struct CmdFrame { - /* - * General data. Always available. - */ - - int type; /* Values see below. */ - int level; /* Number of frames in stack, prevent O(n) - * scan of list. */ - int *line; /* Lines the words of the command start on. */ - int nline; - CallFrame *framePtr; /* Procedure activation record, may be - * NULL. */ - struct CmdFrame *nextPtr; /* Link to calling frame. */ - /* - * Data needed for Eval vs TEBC - * - * EXECUTION CONTEXTS and usage of CmdFrame - * - * Field TEBC EvalEx EvalObjEx - * ======= ==== ====== ========= - * level yes yes yes - * type BC/PREBC SRC/EVAL EVAL_LIST - * line0 yes yes yes - * framePtr yes yes yes - * ======= ==== ====== ========= - * - * ======= ==== ====== ========= union data - * line1 - yes - - * line3 - yes - - * path - yes - - * ------- ---- ------ --------- - * codePtr yes - - - * pc yes - - - * ======= ==== ====== ========= - * - * ======= ==== ====== ========= | union cmd - * listPtr - - yes | - * ------- ---- ------ --------- | - * cmd yes yes - | - * cmdlen yes yes - | - * ------- ---- ------ --------- | - */ - - union { - struct { - Tcl_Obj *path; /* Path of the sourced file the command is - * in. */ - } eval; - struct { - const void *codePtr;/* Byte code currently executed... */ - const char *pc; /* ... and instruction pointer. */ - } tebc; - } data; - union { - struct { - const char *cmd; /* The executed command, if possible... */ - int len; /* ... and its length. */ - } str; - Tcl_Obj *listPtr; /* Tcl_EvalObjEx, cmd list. */ - } cmd; - int numLevels; /* Value of interp's numLevels when the frame - * was pushed. */ - const struct CFWordBC *litarg; - /* Link to set of literal arguments which have - * ben pushed on the lineLABCPtr stack by - * TclArgumentBCEnter(). These will be removed - * by TclArgumentBCRelease. */ -} CmdFrame; - -typedef struct CFWord { - CmdFrame *framePtr; /* CmdFrame to access. */ - int word; /* Index of the word in the command. */ - int refCount; /* Number of times the word is on the - * stack. */ -} CFWord; - -typedef struct CFWordBC { - CmdFrame *framePtr; /* CmdFrame to access. */ - int pc; /* Instruction pointer of a command in - * ExtCmdLoc.loc[.] */ - int word; /* Index of word in - * ExtCmdLoc.loc[cmd]->line[.] */ - struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */ - struct CFWordBC *nextPtr; /* Next entry for same command call. See - * CmdFrame litarg field for the list start. */ - Tcl_Obj *obj; /* Back reference to hashtable key */ -} CFWordBC; - -/* - * Structure to record the locations of invisible continuation lines in - * literal scripts, as character offset from the beginning of the script. Both - * compiler and direct evaluator use this information to adjust their line - * counters when tracking through the script, because when it is invoked the - * continuation line marker as a whole has been removed already, meaning that - * the \n which was part of it is gone as well, breaking regular line - * tracking. - * - * These structures are allocated and filled by both the function - * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the - * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in - * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and - * TclCompileScript(), both found in the file "tclCompile.c". Their memory is - * released by the function TclFreeObj(), in the file "tclObj.c", and also by - * the function TclThreadFinalizeObjects(), in the same file. - */ - -#define CLL_END (-1) - -typedef struct ContLineLoc { - int num; /* Number of entries in loc, not counting the - * final -1 marker entry. */ - int loc[1]; /* Table of locations, as character offsets. - * The table is allocated as part of the - * structure, extending behind the nominal end - * of the structure. An entry containing the - * value -1 is put after the last location, as - * end-marker/sentinel. */ -} ContLineLoc; - -/* - * The following macros define the allowed values for the type field of the - * CmdFrame structure above. Some of the values occur only in the extended - * location data referenced via the 'baseLocPtr'. - * - * TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx. - * TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list - * optimization path of EvalObjEx. - * TCL_LOCATION_BC : Frame is for bytecode. - * TCL_LOCATION_PREBC : Frame is for precompiled bytecode. - * TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, from a - * sourced file. - * TCL_LOCATION_PROC : Frame is for bytecode of a procedure. - * - * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC - * types, per the context of the byte code in execution. - */ - -#define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script. */ -#define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script, - * list-path. */ -#define TCL_LOCATION_BC (2) /* Location in byte code. */ -#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no - * location. */ -#define TCL_LOCATION_SOURCE (4) /* Location in a file. */ -#define TCL_LOCATION_PROC (5) /* Location in a dynamic proc. */ -#define TCL_LOCATION_LAST (6) /* Number of values in the enum. */ - -/* - * Structure passed to describe procedure-like "procedures" that are not - * procedures (e.g. a lambda) so that their details can be reported correctly - * by [info frame]. Contains a sub-structure for each extra field. - */ - -typedef Tcl_Obj * (GetFrameInfoValueProc)(ClientData clientData); -typedef struct { - const char *name; /* Name of this field. */ - GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the - * clientData, or just use the clientData - * directly (after casting) if NULL. */ - ClientData clientData; /* Context for above function, or Tcl_Obj* if - * proc field is NULL. */ -} ExtraFrameInfoField; -typedef struct { - int length; /* Length of array. */ - ExtraFrameInfoField fields[2]; - /* Really as long as necessary, but this is - * long enough for nearly anything. */ -} ExtraFrameInfo; /* *---------------------------------------------------------------- * Data structures and procedures related to TclHandles, which are a very * lightweight method of preserving enough information to determine if an @@ -1459,12 +1278,10 @@ */ typedef struct CorContext { struct CallFrame *framePtr; struct CallFrame *varFramePtr; - struct CmdFrame *cmdFramePtr; /* See Interp.cmdFramePtr */ - Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ } CorContext; typedef struct CoroutineData { struct Command *cmdPtr; /* The command handle for the coroutine. */ struct ExecEnv *eePtr; /* The special execution environment (stacks, @@ -2041,58 +1858,10 @@ * This information, if present (chanMsg not * NULL), takes precedence over a POSIX error * code returned by a channel operation. */ /* - * Source code origin information (TIP #280). - */ - - CmdFrame *cmdFramePtr; /* Points to the command frame containing the - * location information for the current - * command. */ - const CmdFrame *invokeCmdFramePtr; - /* Points to the command frame which is the - * invoking context of the bytecode compiler. - * NULL when the byte code compiler is not - * active. */ - int invokeWord; /* Index of the word in the command which - * is getting compiled. */ - Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically - * defined procedure the location information - * for its body. It is keyed by the address of - * the Proc structure for a procedure. The - * values are "struct CmdFrame*". */ - Tcl_HashTable *lineBCPtr; /* This table remembers for each ByteCode - * object the location information for its - * body. It is keyed by the address of the - * Proc structure for a procedure. The values - * are "struct ExtCmdLoc*". (See - * tclCompile.h) */ - Tcl_HashTable *lineLABCPtr; - Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a - * command on the execution stack the index of - * the argument in the command, and the - * location data of the command. It is keyed - * by the address of the Tcl_Obj containing - * the argument. The values are "struct - * CFWord*" (See tclBasic.c). This allows - * commands like uplevel, eval, etc. to find - * location information for their arguments, - * if they are a proper literal argument to an - * invoking command. Alt view: An index to the - * CmdFrame stack keyed by command argument - * holders. */ - ContLineLoc *scriptCLLocPtr;/* This table points to the location data for - * invisible continuation lines in the script, - * if any. This pointer is set by the function - * TclEvalObjEx() in file "tclBasic.c", and - * used by function ...() in the same file. - * It does for the eval/direct path of script - * execution what CompileEnv.clLoc does for - * the bytecode compiler. - */ - /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. */ int packagePrefer; /* Current package selection mode. */ @@ -2170,10 +1939,11 @@ */ ByteCodeStats stats; /* Holds compilation and execution statistics * for this interpreter. */ #endif /* TCL_COMPILE_STATS */ + Tcl_Obj *cmdSourcePtr; /* Command source obj, used for command traces */ } Interp; /* * Macros that use the TSD-ekeko. */ @@ -2771,11 +2541,11 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE void TclSpliceTailcall(Tcl_Interp *interp, struct NRE_callback *tailcallPtr); -/* +/* // * This structure holds the data for the various iteration callbacks used to * NRE the 'for' and 'while' commands. We need a separate structure because we * have more than the 4 client data entries we can provide directly thorugh * the callback API. It is the 'word' information which puts us over the * limit. It is needed because the loop body is argument 4 of 'for' and @@ -2786,11 +2556,10 @@ typedef struct ForIterData { Tcl_Obj *cond; /* Loop condition expression. */ Tcl_Obj *body; /* Loop body. */ Tcl_Obj *next; /* Loop step script, NULL for 'while'. */ const char *msg; /* Error message part. */ - int word; /* Index of the body script in the command */ } ForIterData; /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile * and Tcl_FindSymbol. This structure corresponds to an opaque * typedef in tcl.h */ @@ -2845,25 +2614,10 @@ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, int len); MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); -MODULE_SCOPE void TclAdvanceContinuations(int *line, int **next, - int loc); -MODULE_SCOPE void TclAdvanceLines(int *line, const char *start, - const char *end); -MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, - Tcl_Obj *objv[], int objc, CmdFrame *cf); -MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, - Tcl_Obj *objv[], int objc); -MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, - Tcl_Obj *objv[], int objc, - void *codePtr, CmdFrame *cfPtr, int pc); -MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, - CmdFrame *cfPtr); -MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, - CmdFrame **cfPtrPtr, int *wordPtr); MODULE_SCOPE int TclArraySet(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj); MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, @@ -2876,22 +2630,11 @@ MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE int TclClearRootEnsemble(ClientData data[], Tcl_Interp *interp, int result); MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); -MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num, - int *loc); -MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, - int start, int *clNext); -MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); -MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, - Tcl_Obj *originObjPtr); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); -/* TIP #280 - Modified token based evulation, with line information. */ -MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, - int numBytes, int flags, int line, - int *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd; @@ -2941,11 +2684,10 @@ int *typePtr); MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); -MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr); MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types); MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); @@ -2953,11 +2695,10 @@ Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, @@ -3103,20 +2844,18 @@ const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, Tcl_Obj *patternObj, int flags); MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr); MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes, - int numBytes, int flags, int line, - struct CompileEnv *envPtr); + int numBytes, int flags, struct CompileEnv *envPtr); MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts, Tcl_Obj *const opts[], int *flagPtr); MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, int numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr); MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count, int *tokensLeftPtr, int line, - int *clNextOuter, const char *outerScript); + int count, int *tokensLeftPtr); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr); Index: generic/tclIntDecls.h ================================================================== --- generic/tclIntDecls.h +++ generic/tclIntDecls.h @@ -544,15 +544,12 @@ const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 231 */ EXTERN int TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); -/* 232 */ -EXTERN int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, - int flags, const CmdFrame *invoker, int word); -/* 233 */ -EXTERN void TclGetSrcInfoForPc(CmdFrame *contextPtr); +/* Slot 232 is reserved */ +/* Slot 233 is reserved */ /* 234 */ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, @@ -571,11 +568,11 @@ /* 240 */ EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 241 */ EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, - int flags, const CmdFrame *invoker, int word); + int flags); /* 242 */ EXTERN int TclNREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 243 */ @@ -836,20 +833,20 @@ void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */ void (*reserved228)(void); int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */ Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */ int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */ - int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */ - void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ + void (*reserved232)(void); + void (*reserved233)(void); Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ void (*reserved236)(void); int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */ int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */ - int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */ + int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 241 */ int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */ void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */ Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */ Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */ int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */ @@ -1242,14 +1239,12 @@ (tclIntStubsPtr->tclPtrMakeUpvar) /* 229 */ #define TclObjLookupVar \ (tclIntStubsPtr->tclObjLookupVar) /* 230 */ #define TclGetNamespaceFromObj \ (tclIntStubsPtr->tclGetNamespaceFromObj) /* 231 */ -#define TclEvalObjEx \ - (tclIntStubsPtr->tclEvalObjEx) /* 232 */ -#define TclGetSrcInfoForPc \ - (tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */ +/* Slot 232 is reserved */ +/* Slot 233 is reserved */ #define TclVarHashCreateVar \ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ /* Slot 236 is reserved */ Index: generic/tclInterp.c ================================================================== --- generic/tclInterp.c +++ generic/tclInterp.c @@ -2762,21 +2762,11 @@ Tcl_Preserve(slaveInterp); Tcl_AllowExceptions(slaveInterp); if (objc == 1) { - /* - * TIP #280: Make actual argument location available to eval'd script. - */ - - Interp *iPtr = (Interp *) interp; - CmdFrame *invoker = iPtr->cmdFramePtr; - int word = 0; - - TclArgumentGet(interp, objv[0], &invoker, &word); - - result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word); + result = Tcl_EvalObjEx(slaveInterp, objv[0], 0); } else { Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv); Tcl_IncrRefCount(objPtr); result = Tcl_EvalObjEx(slaveInterp, objPtr, 0); Tcl_DecrRefCount(objPtr); Index: generic/tclNamesp.c ================================================================== --- generic/tclNamesp.c +++ generic/tclNamesp.c @@ -3238,12 +3238,10 @@ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; - CmdFrame *invoker; - int word; Tcl_Namespace *namespacePtr; CallFrame *framePtr, **framePtrPtr; Tcl_Obj *objPtr; int result; @@ -3293,37 +3291,24 @@ - iPtr->ensembleRewrite.numInsertedObjs; framePtr->objv = iPtr->ensembleRewrite.sourceObjs; } if (objc == 3) { - /* - * TIP #280: Make actual argument location available to eval'd script. - */ - objPtr = objv[2]; - invoker = iPtr->cmdFramePtr; - word = 3; - TclArgumentGet(interp, objPtr, &invoker, &word); } else { /* * More than one argument: concatenate them together with spaces * between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. */ objPtr = Tcl_ConcatObj(objc-2, objv+2); - invoker = NULL; - word = 0; } - /* - * TIP #280: Make invoking context available to eval'd script. - */ - TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval", NULL, NULL); - return TclNREvalObjEx(interp, objPtr, 0, invoker, word); + return TclNREvalObjEx(interp, objPtr, 0); } static int NsEval_Callback( ClientData data[], @@ -3784,11 +3769,11 @@ Tcl_DecrRefCount(listPtr); /* We're done with the list object. */ } TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope", NULL, NULL); - return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0); + return TclNREvalObjEx(interp, cmdObjPtr, 0); } /* *---------------------------------------------------------------------- * Index: generic/tclOOBasic.c ================================================================== --- generic/tclOOBasic.c +++ generic/tclOOBasic.c @@ -328,11 +328,10 @@ Tcl_Object object = Tcl_ObjectContextObject(context); register const int skip = Tcl_ObjectContextSkippedArgs(context); CallFrame *framePtr, **framePtrPtr = &framePtr; Tcl_Obj *scriptPtr; int result; - CmdFrame *invoker; if (objc-1 < skip) { Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?"); return TCL_ERROR; } @@ -363,23 +362,21 @@ * object when it decrements its refcount after eval'ing it. */ if (objc != skip+1) { scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip); - invoker = NULL; } else { scriptPtr = objv[skip]; - invoker = ((Interp *) interp)->cmdFramePtr; } /* * Evaluate the script now, with FinalizeEval to do the processing after * the script completes. */ TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL); - return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip); + return TclNREvalObjEx(interp, scriptPtr, 0); } static int FinalizeEval( ClientData data[], @@ -1097,16 +1094,15 @@ if (iPtr->varFramePtr->callerVarPtr != NULL) { iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr; } Tcl_NRAddCallback(interp, UpcatchCallback, savedFramePtr, NULL,NULL,NULL); - return TclNREvalObjEx(interp, objv[1], TCL_EVAL_NOERR, - iPtr->cmdFramePtr, 1); + return TclNREvalObjEx(interp, objv[1], TCL_EVAL_NOERR); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclOODefineCmds.c ================================================================== --- generic/tclOODefineCmds.c +++ generic/tclOODefineCmds.c @@ -703,12 +703,11 @@ return TCL_ERROR; } AddRef(oPtr); if (objc == 3) { - result = TclEvalObjEx(interp, objv[2], 0, - ((Interp *)interp)->cmdFramePtr, 2); + result = Tcl_EvalObjEx(interp, objv[2], 0); if (result == TCL_ERROR) { int length; const char *objName = Tcl_GetStringFromObj(objv[1], &length); int limit = 60; @@ -822,12 +821,11 @@ return TCL_ERROR; } AddRef(oPtr); if (objc == 3) { - result = TclEvalObjEx(interp, objv[2], 0, - ((Interp *)interp)->cmdFramePtr, 2); + result = Tcl_EvalObjEx(interp, objv[2], 0); if (result == TCL_ERROR) { int length; const char *objName = Tcl_GetStringFromObj(objv[1], &length); int limit = 60; @@ -941,12 +939,11 @@ return TCL_ERROR; } AddRef(oPtr); if (objc == 2) { - result = TclEvalObjEx(interp, objv[1], 0, - ((Interp *)interp)->cmdFramePtr, 2); + result = Tcl_EvalObjEx(interp, objv[1], 0); if (result == TCL_ERROR) { int length; const char *objName = Tcl_GetStringFromObj( TclOOObjectName(interp, oPtr), &length); Index: generic/tclOOInt.h ================================================================== --- generic/tclOOInt.h +++ generic/tclOOInt.h @@ -92,13 +92,10 @@ /* Callback to allow for additional setup * before the method executes. */ TclOO_PostCallProc *postCallProc; /* Callback to allow for additional cleanup * after the method executes. */ - GetFrameInfoValueProc *gfivProc; - /* Callback to allow for fine tuning of how - * the method reports itself. */ } ProcedureMethod; #define TCLOO_PROCEDURE_METHOD_VERSION 0 /* Index: generic/tclOOMethod.c ================================================================== --- generic/tclOOMethod.c +++ generic/tclOOMethod.c @@ -14,21 +14,10 @@ #endif #include "tclInt.h" #include "tclOOInt.h" #include "tclCompile.h" -/* - * Structure used to help delay computing names of objects or classes for - * [info frame] until needed, making invokation faster in the normal case. - */ - -struct PNI { - Tcl_Interp *interp; /* Interpreter in which to compute the name of - * a method. */ - Tcl_Method method; /* Method to compute the name of. */ -}; - /* * Structure used to contain all the information needed about a call frame * used in a procedure-like method. */ @@ -36,15 +25,12 @@ CallFrame *framePtr; /* Reference to the call frame itself (it's * actually allocated on the Tcl stack). */ ProcErrorProc *errProc; /* The error handler for the body. */ Tcl_Obj *nameObj; /* The "name" of the command. */ Command cmd; /* The command structure. Mostly bogus. */ - ExtraFrameInfo efi; /* Extra information used for [info frame]. */ Command *oldCmdPtr; /* Saved cmdPtr so that we can be safe after a * recursive call returns. */ - struct PNI pni; /* Specialist information used in the efi - * field for this type of call. */ } PMFrameData; /* * Structure used to pass information about variable resolution to the * on-the-ground resolvers used when working with resolved compiled variables. @@ -86,11 +72,10 @@ Tcl_Obj *procNameObj); static void ConstructorErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void DestructorErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); -static Tcl_Obj * RenderDeclarerName(ClientData clientData); static int InvokeForwardMethod(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static void DeleteForwardMethod(ClientData clientData); static int CloneForwardMethod(Tcl_Interp *interp, @@ -456,83 +441,19 @@ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the * pointer in clientData. */ { - Interp *iPtr = (Interp *) interp; Proc *procPtr; if (TclCreateProc(interp, NULL, TclGetString(nameObj), argsObj, bodyObj, procPtrPtr) != TCL_OK) { return NULL; } procPtr = *procPtrPtr; procPtr->cmdPtr = NULL; - if (iPtr->cmdFramePtr) { - CmdFrame context = *iPtr->cmdFramePtr; - - if (context.type == TCL_LOCATION_BC) { - /* - * Retrieve source information from the bytecode, if possible. If - * the information is retrieved successfully, context.type will be - * TCL_LOCATION_SOURCE and the reference held by - * context.data.eval.path will be counted. - */ - - TclGetSrcInfoForPc(&context); - } else if (context.type == TCL_LOCATION_SOURCE) { - /* - * The copy into 'context' up above has created another reference - * to 'context.data.eval.path'; account for it. - */ - - Tcl_IncrRefCount(context.data.eval.path); - } - - if (context.type == TCL_LOCATION_SOURCE) { - /* - * We can account for source location within a proc only if the - * proc body was not created by substitution. - * (FIXME: check that this is sane and correct!) - */ - - if (context.line - && (context.nline >= 4) && (context.line[3] >= 0)) { - int isNew; - CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); - Tcl_HashEntry *hPtr; - - cfPtr->level = -1; - cfPtr->type = context.type; - cfPtr->line = ckalloc(sizeof(int)); - cfPtr->line[0] = context.line[3]; - cfPtr->nline = 1; - cfPtr->framePtr = NULL; - cfPtr->nextPtr = NULL; - - cfPtr->data.eval.path = context.data.eval.path; - Tcl_IncrRefCount(cfPtr->data.eval.path); - - cfPtr->cmd.str.cmd = NULL; - cfPtr->cmd.str.len = 0; - - hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, - (char *) procPtr, &isNew); - Tcl_SetHashValue(hPtr, cfPtr); - } - - /* - * 'context' is going out of scope; account for the reference that - * it's holding to the path name. - */ - - Tcl_DecrRefCount(context.data.eval.path); - context.data.eval.path = NULL; - } - } - return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, typePtr, clientData); } /* @@ -569,83 +490,19 @@ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the * pointer in clientData. */ { - Interp *iPtr = (Interp *) interp; Proc *procPtr; if (TclCreateProc(interp, NULL, namePtr, argsObj, bodyObj, procPtrPtr) != TCL_OK) { return NULL; } procPtr = *procPtrPtr; procPtr->cmdPtr = NULL; - if (iPtr->cmdFramePtr) { - CmdFrame context = *iPtr->cmdFramePtr; - - if (context.type == TCL_LOCATION_BC) { - /* - * Retrieve source information from the bytecode, if possible. If - * the information is retrieved successfully, context.type will be - * TCL_LOCATION_SOURCE and the reference held by - * context.data.eval.path will be counted. - */ - - TclGetSrcInfoForPc(&context); - } else if (context.type == TCL_LOCATION_SOURCE) { - /* - * The copy into 'context' up above has created another reference - * to 'context.data.eval.path'; account for it. - */ - - Tcl_IncrRefCount(context.data.eval.path); - } - - if (context.type == TCL_LOCATION_SOURCE) { - /* - * We can account for source location within a proc only if the - * proc body was not created by substitution. - * (FIXME: check that this is sane and correct!) - */ - - if (context.line - && (context.nline >= 4) && (context.line[3] >= 0)) { - int isNew; - CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); - Tcl_HashEntry *hPtr; - - cfPtr->level = -1; - cfPtr->type = context.type; - cfPtr->line = ckalloc(sizeof(int)); - cfPtr->line[0] = context.line[3]; - cfPtr->nline = 1; - cfPtr->framePtr = NULL; - cfPtr->nextPtr = NULL; - - cfPtr->data.eval.path = context.data.eval.path; - Tcl_IncrRefCount(cfPtr->data.eval.path); - - cfPtr->cmd.str.cmd = NULL; - cfPtr->cmd.str.len = 0; - - hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, - (char *) procPtr, &isNew); - Tcl_SetHashValue(hPtr, cfPtr); - } - - /* - * 'context' is going out of scope; account for the reference that - * it's holding to the path name. - */ - - Tcl_DecrRefCount(context.data.eval.path); - context.data.eval.path = NULL; - } - } - return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr, clientData); } /* @@ -843,14 +700,12 @@ /* * Compile the body. This operation may fail. */ - fdPtr->efi.length = 2; memset(&fdPtr->cmd, 0, sizeof(Command)); fdPtr->cmd.nsPtr = nsPtr; - fdPtr->cmd.clientData = &fdPtr->efi; pmPtr->procPtr->cmdPtr = &fdPtr->cmd; /* * [Bug 2037727] Always call TclProcCompileProc so that we check not only * that we have bytecode, but also that it remains valid. Note that we set @@ -884,36 +739,10 @@ fdPtr->framePtr->clientData = contextPtr; fdPtr->framePtr->objc = objc; fdPtr->framePtr->objv = objv; fdPtr->framePtr->procPtr = pmPtr->procPtr; - /* - * Finish filling out the extra frame info so that [info frame] works. - */ - - fdPtr->efi.fields[0].name = "method"; - fdPtr->efi.fields[0].proc = NULL; - fdPtr->efi.fields[0].clientData = fdPtr->nameObj; - if (pmPtr->gfivProc != NULL) { - fdPtr->efi.fields[1].name = ""; - fdPtr->efi.fields[1].proc = pmPtr->gfivProc; - fdPtr->efi.fields[1].clientData = pmPtr; - } else { - register Tcl_Method method = - Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr); - - if (Tcl_MethodDeclarerObject(method) != NULL) { - fdPtr->efi.fields[1].name = "object"; - } else { - fdPtr->efi.fields[1].name = "class"; - } - fdPtr->efi.fields[1].proc = RenderDeclarerName; - fdPtr->efi.fields[1].clientData = &fdPtr->pni; - fdPtr->pni.interp = interp; - fdPtr->pni.method = method; - } - return TCL_OK; /* * Restore the old cmdPtr so that a subsequent use of [info frame] won't * crash on us. [Bug 3001438] @@ -1114,36 +943,10 @@ infoPtr->variableObj = variableObj; Tcl_IncrRefCount(variableObj); *rPtrPtr = &infoPtr->info; return TCL_OK; } - -/* - * ---------------------------------------------------------------------- - * - * RenderDeclarerName -- - * - * Returns the name of the entity (object or class) which declared a - * method. Used for producing information for [info frame] in such a way - * that the expensive part of this (generating the object or class name - * itself) isn't done until it is needed. - * - * ---------------------------------------------------------------------- - */ - -static Tcl_Obj * -RenderDeclarerName( - ClientData clientData) -{ - struct PNI *pni = clientData; - Tcl_Object object = Tcl_MethodDeclarerObject(pni->method); - - if (object == NULL) { - object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method)); - } - return TclOOObjectName(pni->interp, (Object *) object); -} /* * ---------------------------------------------------------------------- * * MethodErrorHandler, ConstructorErrorHandler, DestructorErrorHandler -- Index: generic/tclObj.c ================================================================== --- generic/tclObj.c +++ generic/tclObj.c @@ -75,34 +75,17 @@ * Notice that different structures with the same name appear in other files. * The structure defined below is used in this file only. */ typedef struct ThreadSpecificData { - Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj - * generated by a call to the function - * TclSubstTokens() from a literal text - * where bs+nl sequences occured in it, if - * any. I.e. this table keeps track of - * invisible and stripped continuation lines. - * Its keys are Tcl_Obj pointers, the values - * are ContLineLoc pointers. See the file - * tclCompile.h for the definition of this - * structure, and for references to all - * related places in the core. */ #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) Tcl_HashTable *objThreadMap;/* Thread local table that is used to check * that a Tcl_Obj was not allocated by some * other thread. */ #endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; - -static void ContLineLocFree(char *clientData); -static void TclThreadFinalizeContLines(ClientData clientData); -static ThreadSpecificData *TclGetContLineTable(void); - /* * Nested Tcl_Obj deletion management support * * All context references used in the object freeing code are pointers to this * structure; every thread will have its own structure instance. The purpose @@ -507,345 +490,10 @@ */ Tcl_MutexLock(&tclObjMutex); tclFreeObjList = NULL; Tcl_MutexUnlock(&tclObjMutex); } - -/* - *---------------------------------------------------------------------- - * - * TclGetContLineTable -- - * - * This procedure is a helper which returns the thread-specific - * hash-table used to track continuation line information associated with - * Tcl_Obj*, and the objThreadMap, etc. - * - * Results: - * A reference to the thread-data. - * - * Side effects: - * May allocate memory for the thread-data. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -static ThreadSpecificData * -TclGetContLineTable(void) -{ - /* - * Initialize the hashtable tracking invisible continuation lines. For - * the release we use a thread exit handler to ensure that this is done - * before TSD blocks are made invalid. The TclFinalizeObjects() which - * would be the natural place for this is invoked afterwards, meaning that - * we try to operate on a data structure already gone. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - if (!tsdPtr->lineCLPtr) { - tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable)); - Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS); - Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL); - } - return tsdPtr; -} - -/* - *---------------------------------------------------------------------- - * - * TclContinuationsEnter -- - * - * This procedure is a helper which saves the continuation line - * information associated with a Tcl_Obj*. - * - * Results: - * A reference to the newly created continuation line location table. - * - * Side effects: - * Allocates memory for the table of continuation line locations. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -ContLineLoc * -TclContinuationsEnter( - Tcl_Obj *objPtr, - int num, - int *loc) -{ - int newEntry; - ThreadSpecificData *tsdPtr = TclGetContLineTable(); - Tcl_HashEntry *hPtr = - Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry); - ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int)); - - if (!newEntry) { - /* - * We're entering ContLineLoc data for the same value more than one - * time. Taking care not to leak the old entry. - * - * This can happen when literals in a proc body are shared. See for - * example test info-30.19 where the action (code) for all branches of - * the switch command is identical, mapping them all to the same - * literal. An interesting result of this is that the number and - * locations (offset) of invisible continuation lines in the literal - * are the same for all occurences. - * - * Note that while reusing the existing entry is possible it requires - * the same actions as for a new entry because we have to copy the - * incoming num/loc data even so. Because we are called from - * TclContinuationsEnterDerived for this case, which modified the - * stored locations (Rebased to the proper relative offset). Just - * returning the stored entry would rebase them a second time, or - * more, hosing the data. It is easier to simply replace, as we are - * doing. - */ - - ckfree(Tcl_GetHashValue(hPtr)); - } - - clLocPtr->num = num; - memcpy(&clLocPtr->loc, loc, num*sizeof(int)); - clLocPtr->loc[num] = CLL_END; /* Sentinel */ - Tcl_SetHashValue(hPtr, clLocPtr); - - return clLocPtr; -} - -/* - *---------------------------------------------------------------------- - * - * TclContinuationsEnterDerived -- - * - * This procedure is a helper which computes the continuation line - * information associated with a Tcl_Obj* cut from the middle of a - * script. - * - * Results: - * None. - * - * Side effects: - * Allocates memory for the table of continuation line locations. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -void -TclContinuationsEnterDerived( - Tcl_Obj *objPtr, - int start, - int *clNext) -{ - int length, end, num; - int *wordCLLast = clNext; - - /* - * We have to handle invisible continuations lines here as well, despite - * the code we have in TclSubstTokens (TST) for that. Why ? Nesting. If - * our script is the sole argument to an 'eval' command, for example, the - * scriptCLLocPtr we are using was generated by a previous call to TST, - * and while the words we have here may contain continuation lines they - * are invisible already, and the inner call to TST had no bs+nl sequences - * to trigger its code. - * - * Luckily for us, the table we have to create here for the current word - * has to be a slice of the table currently in use, with the locations - * suitably modified to be relative to the start of the word instead of - * relative to the script. - * - * That is what we are doing now. Determine the slice we need, and if not - * empty, wrap it into a new table, and save the result into our - * thread-global hashtable, as usual. - */ - - /* - * First compute the range of the word within the script. (Is there a - * better way which doesn't shimmer?) - */ - - Tcl_GetStringFromObj(objPtr, &length); - end = start + length; /* First char after the word */ - - /* - * Then compute the table slice covering the range of the word. - */ - - while (*wordCLLast >= 0 && *wordCLLast < end) { - wordCLLast++; - } - - /* - * And generate the table from the slice, if it was not empty. - */ - - num = wordCLLast - clNext; - if (num) { - int i; - ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext); - - /* - * Re-base the locations. - */ - - for (i=0 ; iloc[i] -= start; - - /* - * Continuation lines coming before the string and affecting us - * should not happen, due to the proper maintenance of clNext - * during compilation. - */ - - if (clLocPtr->loc[i] < 0) { - Tcl_Panic("Derived ICL data for object using offsets from before the script"); - } - } - } -} - -/* - *---------------------------------------------------------------------- - * - * TclContinuationsCopy -- - * - * This procedure is a helper which copies the continuation line - * information associated with a Tcl_Obj* to another Tcl_Obj*. It is - * assumed that both contain the same string/script. Use this when a - * script is duplicated because it was shared. - * - * Results: - * None. - * - * Side effects: - * Allocates memory for the table of continuation line locations. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -void -TclContinuationsCopy( - Tcl_Obj *objPtr, - Tcl_Obj *originObjPtr) -{ - ThreadSpecificData *tsdPtr = TclGetContLineTable(); - Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr); - - if (hPtr) { - ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr); - - TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc); - } -} - -/* - *---------------------------------------------------------------------- - * - * TclContinuationsGet -- - * - * This procedure is a helper which retrieves the continuation line - * information associated with a Tcl_Obj*, if it has any. - * - * Results: - * A reference to the continuation line location table, or NULL if the - * Tcl_Obj* has no such information associated with it. - * - * Side effects: - * None. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -ContLineLoc * -TclContinuationsGet( - Tcl_Obj *objPtr) -{ - ThreadSpecificData *tsdPtr = TclGetContLineTable(); - Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); - - if (!hPtr) { - return NULL; - } - return Tcl_GetHashValue(hPtr); -} - -/* - *---------------------------------------------------------------------- - * - * TclThreadFinalizeContLines -- - * - * This procedure is a helper which releases all continuation line - * information currently known. It is run as a thread exit handler. - * - * Results: - * None. - * - * Side effects: - * Releases memory. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -static void -TclThreadFinalizeContLines( - ClientData clientData) -{ - /* - * Release the hashtable tracking invisible continuation lines. - */ - - ThreadSpecificData *tsdPtr = TclGetContLineTable(); - Tcl_HashEntry *hPtr; - Tcl_HashSearch hSearch; - - for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - /* - * We are not using Tcl_EventuallyFree (as in TclFreeObj()) because - * here we can be sure that the compiler will not hold references to - * the data in the hashtable, and using TEF might bork the - * finalization sequence. - */ - - ContLineLocFree(Tcl_GetHashValue(hPtr)); - Tcl_DeleteHashEntry(hPtr); - } - Tcl_DeleteHashTable(tsdPtr->lineCLPtr); - ckfree(tsdPtr->lineCLPtr); - tsdPtr->lineCLPtr = NULL; -} - -/* - *---------------------------------------------------------------------- - * - * ContLineLocFree -- - * - * The freProc for continuation line location tables. - * - * Results: - * None. - * - * Side effects: - * Releases memory. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -static void -ContLineLocFree( - char *clientData) -{ - ckfree(clientData); -} /* *-------------------------------------------------------------- * * Tcl_RegisterObjType -- @@ -1370,32 +1018,10 @@ TclIncrObjsFreed(); } ObjDeletionUnlock(context); } - /* - * We cannot use TclGetContinuationTable() here, because that may - * re-initialize the thread-data for calls coming after the finalization. - * We have to access it using the low-level call and then check for - * validity. This function can be called after TclFinalizeThreadData() has - * already killed the thread-global data structures. Performing - * TCL_TSD_INIT will leave us with an un-initialized memory block upon - * which we crash (if we where to access the uninitialized hashtable). - */ - - { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_HashEntry *hPtr; - - if (tsdPtr->lineCLPtr) { - hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); - if (hPtr) { - Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree); - Tcl_DeleteHashEntry(hPtr); - } - } - } } #else /* TCL_MEM_DEBUG */ void TclFreeObj( @@ -1461,32 +1087,10 @@ } ObjDeletionUnlock(context); } } - /* - * We cannot use TclGetContinuationTable() here, because that may - * re-initialize the thread-data for calls coming after the finalization. - * We have to access it using the low-level call and then check for - * validity. This function can be called after TclFinalizeThreadData() has - * already killed the thread-global data structures. Performing - * TCL_TSD_INIT will leave us with an un-initialized memory block upon - * which we crash (if we where to access the uninitialized hashtable). - */ - - { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_HashEntry *hPtr; - - if (tsdPtr->lineCLPtr) { - hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); - if (hPtr) { - Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree); - Tcl_DeleteHashEntry(hPtr); - } - } - } } #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- Index: generic/tclParse.c ================================================================== --- generic/tclParse.c +++ generic/tclParse.c @@ -1544,11 +1544,11 @@ TclStackFree(interp, parsePtr); return "$"; } code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, - NULL, 1, NULL, NULL); + NULL); TclStackFree(interp, parsePtr); if (code != TCL_OK) { return NULL; } objPtr = Tcl_GetObjResult(interp); @@ -2086,37 +2086,17 @@ * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ int count, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ - int *tokensLeftPtr, /* If not NULL, points to memory where an + int *tokensLeftPtr) /* If not NULL, points to memory where an * integer representing the number of tokens * left to be substituted will be written */ - int line, /* The line the script starts on. */ - int *clNextOuter, /* Information about an outer context for */ - const char *outerScript) /* continuation line data. This is set by - * EvalEx() to properly handle [...]-nested - * commands. The 'outerScript' refers to the - * most-outer script containing the embedded - * command, which is refered to by 'script'. - * The 'clNextOuter' refers to the current - * entry in the table of continuation lines in - * this "master script", and the character - * offsets are relative to the 'outerScript' - * as well. - * - * If outerScript == script, then this call is - * for words in the outer-most script or - * command. See Tcl_EvalEx and TclEvalObjEx - * for the places generating arguments for - * which this is true. */ { Tcl_Obj *result; int code = TCL_OK; #define NUM_STATIC_POS 20 - int isLiteral, maxNumCL, numCL, i, adjust; - int *clPosition = NULL; Interp *iPtr = (Interp *) interp; int inFile = iPtr->evalFlags & TCL_EVAL_FILE; /* * Each pass through this loop will substitute one token, and its @@ -2126,35 +2106,10 @@ * * Further optimization opportunities might be to check for the equivalent * of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them. */ - /* - * For the handling of continuation lines in literals we first check if - * this is actually a literal. For if not we can forego the additional - * processing. Otherwise we pre-allocate a small table to store the - * locations of all continuation lines we find in this literal, if any. - * The table is extended if needed. - */ - - numCL = 0; - maxNumCL = 0; - isLiteral = 1; - for (i=0 ; i < count; i++) { - if ((tokenPtr[i].type != TCL_TOKEN_TEXT) - && (tokenPtr[i].type != TCL_TOKEN_BS)) { - isLiteral = 0; - break; - } - } - - if (isLiteral) { - maxNumCL = NUM_STATIC_POS; - clPosition = ckalloc(maxNumCL * sizeof(int)); - } - - adjust = 0; result = NULL; for (; count>0 && code==TCL_OK ; count--, tokenPtr++) { Tcl_Obj *appendObj = NULL; const char *append = NULL; int appendByteLength = 0; @@ -2168,68 +2123,22 @@ case TCL_TOKEN_BS: appendByteLength = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, utfCharBytes); append = utfCharBytes; - - /* - * If the backslash sequence we found is in a literal, and - * represented a continuation line, we compute and store its - * location (as char offset to the beginning of the _result_ - * script). We may have to extend the table of locations. - * - * Note that the continuation line information is relevant even if - * the word we are processing is not a literal, as it can affect - * nested commands. See the branch for TCL_TOKEN_COMMAND below, - * where the adjustment we are tracking here is taken into - * account. The good thing is that we do not need a table of - * everything, just the number of lines we have to add as - * correction. - */ - - if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') - && (tokenPtr->start[1] == '\n')) { - if (isLiteral) { - int clPos; - - if (result == 0) { - clPos = 0; - } else { - Tcl_GetStringFromObj(result, &clPos); - } - - if (numCL >= maxNumCL) { - maxNumCL *= 2; - clPosition = ckrealloc(clPosition, - maxNumCL * sizeof(int)); - } - clPosition[numCL] = clPos; - numCL++; - } - adjust++; - } break; case TCL_TOKEN_COMMAND: { - /* TIP #280: Transfer line information to nested command */ iPtr->numLevels++; code = TclInterpReady(interp); if (code == TCL_OK) { /* * Test cases: info-30.{6,8,9} */ - int theline; - - TclAdvanceContinuations(&line, &clNextOuter, - tokenPtr->start - outerScript); - theline = line + adjust; - code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, - 0, theline, clNextOuter, outerScript); - - TclAdvanceLines(&line, tokenPtr->start+1, - tokenPtr->start + tokenPtr->size - 1); + code = Tcl_EvalEx(interp, tokenPtr->start+1, + tokenPtr->size-2, 0); /* * Restore flag reset by nested eval for future bracketed * commands and their cmdframe setup */ @@ -2252,11 +2161,11 @@ /* * Subst the index part of an array variable reference. */ code = TclSubstTokens(interp, tokenPtr+2, - tokenPtr->numComponents - 1, NULL, line, NULL, NULL); + tokenPtr->numComponents - 1, NULL); arrayIndex = Tcl_GetObjResult(interp); Tcl_IncrRefCount(arrayIndex); } if (code == TCL_OK) { @@ -2336,31 +2245,10 @@ } if (code != TCL_ERROR) { /* Keep error message in result! */ if (result != NULL) { Tcl_SetObjResult(interp, result); - - /* - * If the code found continuation lines (which implies that this - * word is a literal), then we store the accumulated table of - * locations in the thread-global data structure for the bytecode - * compiler to find later, assuming that the literal is a script - * which will be compiled. - */ - - if (numCL) { - TclContinuationsEnter(result, numCL, clPosition); - } - - /* - * Release the temp table we used to collect the locations of - * continuation lines, if any. - */ - - if (maxNumCL) { - ckfree(clPosition); - } } else { Tcl_ResetResult(interp); } } if (tokensLeftPtr != NULL) { Index: generic/tclProc.c ================================================================== --- generic/tclProc.c +++ generic/tclProc.c @@ -23,11 +23,10 @@ */ typedef struct { int isRootEnsemble; Command cmd; - ExtraFrameInfo efi; } ApplyExtraData; /* * Prototypes for static functions in this file */ @@ -209,105 +208,10 @@ * namespace if the proc was renamed into a different namespace. */ procPtr->cmdPtr = (Command *) cmd; - /* - * TIP #280: Remember the line the procedure body is starting on. In a - * bytecode context we ask the engine to provide us with the necessary - * information. This is for the initialization of the byte code compiler - * when the body is used for the first time. - * - * This code is nearly identical to the #280 code in SetLambdaFromAny, see - * this file. The differences are the different index of the body in the - * line array of the context, and the lamdba code requires some special - * processing. Find a way to factor the common elements into a single - * function. - */ - - if (iPtr->cmdFramePtr) { - CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame)); - - *contextPtr = *iPtr->cmdFramePtr; - if (contextPtr->type == TCL_LOCATION_BC) { - /* - * Retrieve source information from the bytecode, if possible. If - * the information is retrieved successfully, context.type will be - * TCL_LOCATION_SOURCE and the reference held by - * context.data.eval.path will be counted. - */ - - TclGetSrcInfoForPc(contextPtr); - } else if (contextPtr->type == TCL_LOCATION_SOURCE) { - /* - * The copy into 'context' up above has created another reference - * to 'context.data.eval.path'; account for it. - */ - - Tcl_IncrRefCount(contextPtr->data.eval.path); - } - - if (contextPtr->type == TCL_LOCATION_SOURCE) { - /* - * We can account for source location within a proc only if the - * proc body was not created by substitution. - */ - - if (contextPtr->line - && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) { - int isNew; - Tcl_HashEntry *hePtr; - CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); - - cfPtr->level = -1; - cfPtr->type = contextPtr->type; - cfPtr->line = ckalloc(sizeof(int)); - cfPtr->line[0] = contextPtr->line[3]; - cfPtr->nline = 1; - cfPtr->framePtr = NULL; - cfPtr->nextPtr = NULL; - - cfPtr->data.eval.path = contextPtr->data.eval.path; - Tcl_IncrRefCount(cfPtr->data.eval.path); - - cfPtr->cmd.str.cmd = NULL; - cfPtr->cmd.str.len = 0; - - hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, - procPtr, &isNew); - if (!isNew) { - /* - * Get the old command frame and release it. See also - * TclProcCleanupProc in this file. Currently it seems as - * if only the procbodytest::proc command of the testsuite - * is able to trigger this situation. - */ - - CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr); - - if (cfOldPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfOldPtr->data.eval.path); - cfOldPtr->data.eval.path = NULL; - } - ckfree(cfOldPtr->line); - cfOldPtr->line = NULL; - ckfree(cfOldPtr); - } - Tcl_SetHashValue(hePtr, cfPtr); - } - - /* - * 'contextPtr' is going out of scope; account for the reference - * that it's holding to the path name. - */ - - Tcl_DecrRefCount(contextPtr->data.eval.path); - contextPtr->data.eval.path = NULL; - } - TclStackFree(interp, contextPtr); - } - /* * Optimize for no-op procs: if the body is not precompiled (like a TclPro * procbody), and the argument list is just "args" and the body is empty, * define a compileProc to compile a no-op. * @@ -438,22 +342,12 @@ * identical. Note that we don't use Tcl_DuplicateObj since we would * not want any bytecode internal representation. */ if (Tcl_IsShared(bodyPtr)) { - Tcl_Obj *sharedBodyPtr = bodyPtr; - bytes = TclGetStringFromObj(bodyPtr, &length); bodyPtr = Tcl_NewStringObj(bytes, length); - - /* - * TIP #280. - * Ensure that the continuation line data for the original body is - * not lost and applies to the new body as well. - */ - - TclContinuationsCopy(bodyPtr, sharedBodyPtr); } /* * Create and initialize a Proc structure for the procedure. We * increment the ref count of the procedure's body object since there @@ -962,12 +856,10 @@ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { register Interp *iPtr = (Interp *) interp; - CmdFrame *invoker = NULL; - int word = 0; int result; CallFrame *savedVarFramePtr, *framePtr; Tcl_Obj *objPtr; if (objc < 2) { @@ -1000,17 +892,11 @@ /* * Execute the residual arguments as a command. */ if (objc == 1) { - /* - * TIP #280. Make actual argument location available to eval'd script - */ - - TclArgumentGet(interp, objv[0], &invoker, &word); objPtr = objv[0]; - } else { /* * More than one argument: concatenate them together with spaces * between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. @@ -1019,11 +905,11 @@ objPtr = Tcl_ConcatObj(objc, objv); } TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL, NULL); - return TclNREvalObjEx(interp, objPtr, 0, invoker, word); + return TclNREvalObjEx(interp, objPtr, 0); } /* *---------------------------------------------------------------------- * @@ -1795,18 +1681,10 @@ l++; } TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9]); } - if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) { - Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr); - const char *a[6]; int i[2]; - - TclDTraceInfo(info, a, i); - TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); - TclDecrRefCount(info); - } if (TCL_DTRACE_PROC_ENTRY_ENABLED()) { int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0; TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ? TclGetString(iPtr->varFramePtr->objv[l]) : NULL, @@ -2010,12 +1888,10 @@ bodyPtr->typePtr = NULL; } } if (bodyPtr->typePtr != &tclByteCodeType) { - Tcl_HashEntry *hePtr; - #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile >= 1) { /* * Display a line summarizing the top level command we are about * to compile. @@ -2070,25 +1946,11 @@ } TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr, /* isProcCallFrame */ 0); - /* - * TIP #280: We get the invoking context from the cmdFrame which - * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr). - */ - - hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr); - - /* - * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd. - */ - - iPtr->invokeWord = 0; - iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL); tclByteCodeType.setFromAnyProc(interp, bodyPtr); - iPtr->invokeCmdFramePtr = NULL; TclPopStackFrame(interp); } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) { /* * The resolver epoch has changed, but we only need to invalidate the * resolver cache. @@ -2190,13 +2052,10 @@ { register CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; - Tcl_HashEntry *hePtr = NULL; - CmdFrame *cfPtr = NULL; - Interp *iPtr = procPtr->iPtr; if (bodyPtr != NULL) { Tcl_DecrRefCount(bodyPtr); } for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; ) { @@ -2217,36 +2076,10 @@ } ckfree(localPtr); localPtr = nextPtr; } ckfree(procPtr); - - /* - * TIP #280: Release the location data associated with this Proc - * structure, if any. The interpreter may not exist (For example for - * procbody structures created by tbcload. - */ - - if (!iPtr) { - return; - } - - hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr); - if (!hePtr) { - return; - } - - cfPtr = Tcl_GetHashValue(hePtr); - - if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfPtr->data.eval.path); - cfPtr->data.eval.path = NULL; - } - ckfree(cfPtr->line); - cfPtr->line = NULL; - ckfree(cfPtr); - Tcl_DeleteHashEntry(hePtr); } /* *---------------------------------------------------------------------- * @@ -2470,11 +2303,10 @@ static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { - Interp *iPtr = (Interp *) interp; const char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr; int objc, result; Proc *procPtr; @@ -2515,98 +2347,10 @@ * procPtr->refCount = 1; */ procPtr->cmdPtr = NULL; - /* - * TIP #280: Remember the line the apply body is starting on. In a Byte - * code context we ask the engine to provide us with the necessary - * information. This is for the initialization of the byte code compiler - * when the body is used for the first time. - * - * NOTE: The body is the second word in the 'objPtr'. Its location, - * accessible through 'context.line[1]' (see below) is therefore only the - * first approximation of the actual line the body is on. We have to use - * the string rep of the 'objPtr' to determine the exact line. This is - * available already through 'name'. Use 'TclListLines', see 'switch' - * (tclCmdMZ.c). - * - * This code is nearly identical to the #280 code in Tcl_ProcObjCmd, see - * this file. The differences are the different index of the body in the - * line array of the context, and the special processing mentioned in the - * previous paragraph to track into the list. Find a way to factor the - * common elements into a single function. - */ - - if (iPtr->cmdFramePtr) { - CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame)); - - *contextPtr = *iPtr->cmdFramePtr; - if (contextPtr->type == TCL_LOCATION_BC) { - /* - * Retrieve the source context from the bytecode. This call - * accounts for the reference to the source file, if any, held in - * 'context.data.eval.path'. - */ - - TclGetSrcInfoForPc(contextPtr); - } else if (contextPtr->type == TCL_LOCATION_SOURCE) { - /* - * We created a new reference to the source file path name when we - * created 'context' above. Account for the reference. - */ - - Tcl_IncrRefCount(contextPtr->data.eval.path); - - } - - if (contextPtr->type == TCL_LOCATION_SOURCE) { - /* - * We can record source location within a lambda only if the body - * was not created by substitution. - */ - - if (contextPtr->line - && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) { - int isNew, buf[2]; - CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); - - /* - * Move from approximation (line of list cmd word) to actual - * location (line of 2nd list element). - */ - - TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); - - cfPtr->level = -1; - cfPtr->type = contextPtr->type; - cfPtr->line = ckalloc(sizeof(int)); - cfPtr->line[0] = buf[1]; - cfPtr->nline = 1; - cfPtr->framePtr = NULL; - cfPtr->nextPtr = NULL; - - cfPtr->data.eval.path = contextPtr->data.eval.path; - Tcl_IncrRefCount(cfPtr->data.eval.path); - - cfPtr->cmd.str.cmd = NULL; - cfPtr->cmd.str.len = 0; - - Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, - procPtr, &isNew), cfPtr); - } - - /* - * 'contextPtr' is going out of scope. Release the reference that - * it's holding to the source file path - */ - - Tcl_DecrRefCount(contextPtr->data.eval.path); - } - TclStackFree(interp, contextPtr); - } - /* * Set the namespace for this lambda: given by objv[2] understood as a * global reference, or else global per default. */ @@ -2742,26 +2486,10 @@ extraPtr = TclStackAlloc(interp, sizeof(ApplyExtraData)); memset(&extraPtr->cmd, 0, sizeof(Command)); procPtr->cmdPtr = &extraPtr->cmd; extraPtr->cmd.nsPtr = (Namespace *) nsPtr; - /* - * TIP#280 (semi-)HACK! - * - * Using cmd.clientData to tell [info frame] how to render the lambdaPtr. - * The InfoFrameCmd will detect this case by testing cmd.hPtr for NULL. - * This condition holds here because of the memset() above, and nowhere - * else (in the core). Regular commands always have a valid hPtr, and - * lambda's never. - */ - - extraPtr->efi.length = 1; - extraPtr->efi.fields[0].name = "lambda"; - extraPtr->efi.fields[0].proc = NULL; - extraPtr->efi.fields[0].clientData = lambdaPtr; - extraPtr->cmd.clientData = &extraPtr->efi; - isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); if (isRootEnsemble) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = 1; iPtr->ensembleRewrite.numInsertedObjs = 0; Index: generic/tclStubInit.c ================================================================== --- generic/tclStubInit.c +++ generic/tclStubInit.c @@ -286,12 +286,12 @@ TclSetNsPath, /* 227 */ 0, /* 228 */ TclPtrMakeUpvar, /* 229 */ TclObjLookupVar, /* 230 */ TclGetNamespaceFromObj, /* 231 */ - TclEvalObjEx, /* 232 */ - TclGetSrcInfoForPc, /* 233 */ + 0, /* 232 */ + 0, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ 0, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ Index: generic/tclTest.c ================================================================== --- generic/tclTest.c +++ generic/tclTest.c @@ -6716,11 +6716,11 @@ Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; static ptrdiff_t *refDepth = NULL; ptrdiff_t depth; - Tcl_Obj *levels[6]; + Tcl_Obj *levels[5]; int i = 0; NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr; if (refDepth == NULL) { refDepth = &depth; @@ -6728,22 +6728,21 @@ depth = (refDepth - &depth); levels[0] = Tcl_NewIntObj(depth); levels[1] = Tcl_NewIntObj(iPtr->numLevels); - levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level); - levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level); - levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr + levels[2] = Tcl_NewIntObj(iPtr->varFramePtr->level); + levels[3] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr - iPtr->execEnvPtr->execStackPtr->stackWords); while (cbPtr) { i++; cbPtr = cbPtr->nextPtr; } - levels[5] = Tcl_NewIntObj(i); + levels[4] = Tcl_NewIntObj(i); - Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels)); + Tcl_SetObjResult(interp, Tcl_NewListObj(5, levels)); return TCL_OK; } /* *---------------------------------------------------------------------- Index: generic/tclVar.c ================================================================== --- generic/tclVar.c +++ generic/tclVar.c @@ -1928,13 +1928,10 @@ varPtr->value.objPtr = newValuePtr; Tcl_IncrRefCount(newValuePtr); } else { if (Tcl_IsShared(oldValuePtr)) { /* Append to copy. */ varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); - - TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr); - TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; Tcl_IncrRefCount(oldValuePtr); /* Since var is ref */ } Tcl_AppendObjToObj(oldValuePtr, newValuePtr); Index: tests/coroutine.test ================================================================== --- tests/coroutine.test +++ tests/coroutine.test @@ -14,10 +14,11 @@ namespace import -force ::tcltest::* } testConstraint testnrelevels [llength [info commands testnrelevels]] testConstraint memory [llength [info commands memory]] +testConstraint infoframe [expr ![catch {info frame 0}]] set lambda [list {{start 0} {stop 10}} { # init set i $start set imax $stop @@ -291,11 +292,11 @@ set l2 [b] expr {$l2 - $l1} } -cleanup { rename a {} rename b {} -} -result 1 +} -result 1 -constraints infoframe test coroutine-3.3 {info coroutine} -setup { proc a {} {info coroutine} proc b {} a } -body { b @@ -336,11 +337,11 @@ } -body { coroutine aa a } -cleanup { rename stack {} rename a {} -} -result {} +} -result {} -constraints infoframe test coroutine-4.1 {bug #2093188} -setup { proc foo {} { set v 1 trace add variable v {write unset} bar @@ -453,11 +454,11 @@ nestedYield } } set res {} } -body { - set base [getNumLevel] + set base [relativeLevel 0] lappend res [relativeLevel $base] eval {coroutine a foo} # back to base level lappend res [relativeLevel $base] a Index: tests/info.test ================================================================== --- tests/info.test +++ tests/info.test @@ -674,20 +674,28 @@ test info-21.1 {miscellaneous error conditions} -returnCodes error -body { info } -result {wrong # args: should be "info subcommand ?arg ...?"} test info-21.2 {miscellaneous error conditions} -returnCodes error -body { info gorp -} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.3 {miscellaneous error conditions} -returnCodes error -body { info c -} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.4 {miscellaneous error conditions} -returnCodes error -body { info l -} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.5 {miscellaneous error conditions} -returnCodes error -body { info s -} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} + +## DONE!! The rest is [info frame] + +# cleanup +catch {namespace delete test_ns_info1 test_ns_info2} +::tcltest::cleanupTests +return + ## # ### ### ### ######### ######### ######### ## info frame ## Helper Index: tests/nre.test ================================================================== --- tests/nre.test +++ tests/nre.test @@ -23,12 +23,12 @@ if {[testConstraint testnrelevels]} { namespace eval testnre { namespace path ::tcl::mathop # - # [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels, - # cmdFrame level, callFrame level, tosPtr and callback depth + # [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels, + # callFrame level, tosPtr and callback depth # variable last [testnrelevels] proc depthDiff {} { variable last set depth [testnrelevels] @@ -47,11 +47,11 @@ set x [depthDiff] if {[incr i] > 10} { namespace upvar [namespace qualifiers \ [namespace origin depthDiff]] abs abs incr abs [lindex [testnrelevels] 0] - return [list [lrange $x 0 3] $abs] + return [list [lrange $x 0 2] $abs] } } proc makebody txt { variable body0 return "$body0; $txt" @@ -58,21 +58,21 @@ } namespace export * } namespace import testnre::* } - + test nre-1.1 {self-recursive procs} -setup { proc a i [makebody {a $i}] } -body { setabs a 0 } -cleanup { rename a {} } -constraints { testnrelevels -} -result {{0 1 1 1} 0} +} -result {{0 1 1} 0} test nre-1.2 {self-recursive lambdas} -setup { set a [list i [makebody {apply $::a $i}]] } -body { setabs @@ -79,11 +79,11 @@ apply $a 0 } -cleanup { unset a } -constraints { testnrelevels -} -result {{0 1 1 1} 0} +} -result {{0 1 1} 0} test nre-1.3 {mutually recursive procs and lambdas} -setup { proc a i { apply $::b [incr i] } @@ -94,11 +94,11 @@ } -cleanup { rename a {} unset b } -constraints { testnrelevels -} -result {{0 2 2 2} 0} +} -result {{0 2 2} 0} # # Test that aliases are non-recursive # @@ -111,11 +111,11 @@ } -cleanup { rename a {} rename b {} } -constraints { testnrelevels -} -result {{0 2 1 1} 0} +} -result {{0 2 1} 0} # # Test that imports are non-recursive # @@ -131,11 +131,11 @@ } -cleanup { rename a {} namespace delete ::foo } -constraints { testnrelevels -} -result {{0 2 1 1} 0} +} -result {{0 2 1} 0} test nre-4.1 {ensembles are not recursive} -setup { proc a i [makebody {b foo $i}] namespace ensemble create \ -command b \ @@ -146,11 +146,11 @@ } -cleanup { rename a {} rename b {} } -constraints { testnrelevels -} -result {{0 2 1 1} 0} +} -result {{0 2 1} 0} test nre-5.1 {[namespace eval] is not recursive} -setup { namespace eval ::foo { setabs } @@ -159,11 +159,11 @@ ::foo::a 0 } -cleanup { namespace delete ::foo } -constraints { testnrelevels -} -result {{0 3 2 2} 0} +} -result {{0 3 2} 0} test nre-5.2 {[namespace eval] is not recursive} -setup { namespace eval ::foo { setabs } @@ -172,11 +172,11 @@ foo::a 0 } -cleanup { namespace delete ::foo } -constraints { testnrelevels -} -result {{0 3 2 2} 0} +} -result {{0 3 2} 0} test nre-6.1 {[uplevel] is not recursive} -setup { proc a i [makebody {uplevel 1 [list a $i]}] } -body { setabs @@ -183,11 +183,11 @@ a 0 } -cleanup { rename a {} } -constraints { testnrelevels -} -result {{0 2 2 0} 0} +} -result {{0 2 0} 0} test nre-6.2 {[uplevel] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "set x $i; a $i"}] } -body { @@ -194,11 +194,11 @@ a 0 } -cleanup { rename a {} } -constraints { testnrelevels -} -result {{0 2 2 0} 0} +} -result {{0 2 0} 0} test nre-7.1 {[catch] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "catch {a $i} msg; set msg"}] } -body { @@ -205,11 +205,11 @@ a 0 } -cleanup { rename a {} } -constraints { testnrelevels -} -result {{0 3 3 0} 0} +} -result {{0 3 0} 0} test nre-7.2 {[if] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "if 1 {a $i}"}] } -body { @@ -216,11 +216,11 @@ a 0 } -cleanup { rename a {} } -constraints { testnrelevels -} -result {{0 2 2 0} 0} +} -result {{0 2 0} 0} test nre-7.3 {[while] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}] } -body { @@ -227,11 +227,11 @@ a 0 } -cleanup { rename a {} } -constraints { testnrelevels -} -result {{0 2 2 0} 0} +} -result {{0 2 0} 0} test nre-7.4 {[for] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}] } -body { @@ -238,11 +238,11 @@ a 0 } -cleanup { rename a {} } -constraints { testnrelevels -} -result {{0 2 2 0} 0} +} -result {{0 2 0} 0} test nre-7.5 {[foreach] is not recursive} -setup { # # Enable once [foreach] is NR-enabled # @@ -252,11 +252,11 @@ a 0 } -cleanup { rename a {} } -constraints { testnrelevels -} -result {{0 3 3 0} 0} +} -result {{0 3 0} 0} test nre-7.6 {[eval] is not recursive} -setup { proc a i [makebody {eval [list a $i]}] } -body { setabs @@ -263,11 +263,11 @@ a 0 } -cleanup { rename a {} } -constraints { testnrelevels -} -result {{0 2 2 1} 0} +} -result {{0 2 1} 0} test nre-7.7 {[eval] is not recursive} -setup { proc a i [makebody {eval "a $i"}] } -body { setabs @@ -274,11 +274,11 @@ a 0 } -cleanup { rename a {} } -constraints { testnrelevels -} -result {{0 2 2 1} 0} +} -result {{0 2 1} 0} test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup { proc foo args {} foo coroutine bar apply {{} { @@ -345,11 +345,11 @@ foo bar 0 } -cleanup { foo destroy } -constraints { testnrelevels -} -result {{0 1 1 1} 0} +} -result {{0 1 1} 0} test nre-oo.2 {really deep calls in oo - call via [self]} -setup { oo::object create foo oo::objdefine foo method bar i [makebody {[self] bar $i}] } -body { @@ -357,11 +357,11 @@ foo bar 0 } -cleanup { foo destroy } -constraints { testnrelevels -} -result {{0 1 1 1} 0} +} -result {{0 1 1} 0} test nre-oo.3 {really deep calls in oo - private calls} -setup { oo::object create foo oo::objdefine foo method bar i [makebody {my bar $i}] } -body { @@ -369,11 +369,11 @@ foo bar 0 } -cleanup { foo destroy } -constraints { testnrelevels -} -result {{0 1 1 1} 0} +} -result {{0 1 1} 0} test nre-oo.4 {really deep calls in oo - overriding} -setup { oo::class create foo { method bar i [makebody {my bar $i}] } @@ -386,11 +386,11 @@ [boo new] bar 0 } -cleanup { foo destroy } -constraints { testnrelevels -} -result {{0 1 1 1} 0} +} -result {{0 1 1} 0} test nre-oo.5 {really deep calls in oo - forwards} -setup { oo::object create foo set body [makebody {my boo $i}] oo::objdefine foo " @@ -402,11 +402,11 @@ foo bar 0 } -cleanup { foo destroy } -constraints { testnrelevels -} -result {{0 2 1 1} 0} +} -result {{0 2 1} 0} # # NASTY BUG found by tcllib's interp package # @@ -426,11 +426,11 @@ list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]] } } -cleanup { interp delete $i } -result {::foo ::foo {} {}} - + # cleanup ::tcltest::cleanupTests if {[testConstraint testnrelevels]} { namespace forget testnre::* Index: tests/oo.test ================================================================== --- tests/oo.test +++ tests/oo.test @@ -11,10 +11,12 @@ package require tcltest 2 if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* } +testConstraint infoframe [expr ![catch {info frame 0}]] + testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { set lines [split [memory info] \n] return [lindex $lines 3 3] @@ -2228,11 +2230,11 @@ method level {} { expr {[next] - [info frame]} } } list [i level] [i frames] [dict get [c frame] object] -} -cleanup { +} -constraints infoframe -cleanup { c destroy } -result {1 {{type source line * file * cmd {info frame 0} method frames class ::c level 0} {type source line * file * cmd {info frame 0} method frames object ::i level 0}} ::c} test oo-22.2 {OO and info frame: Bug 3001438} -setup { oo::class create c } -body { @@ -2240,11 +2242,11 @@ if {$x} {my test 0} lsort {q w e r t y u i o p}; # Overwrite the Tcl stack info frame 0 } [c new] test -} -match glob -cleanup { +} -match glob -constraints infoframe -cleanup { c destroy } -result {* cmd {info frame 0} method test class ::c level 0} # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { Index: tests/regexpComp.test ================================================================== --- tests/regexpComp.test +++ tests/regexpComp.test @@ -828,16 +828,16 @@ regexp -nocase FOO dogfod } } 0 test regexpComp-21.6 {regexp command compiling tests} { evalInProc { - regexp -n foo dogfoOd + regexp -nocase foo dogfoOd } } 1 test regexpComp-21.7 {regexp command compiling tests} { evalInProc { - regexp -no -- FoO dogfood + regexp -nocase -- FoO dogfood } } 1 test regexpComp-21.8 {regexp command compiling tests} { evalInProc { regexp -- foo dogfod @@ -943,17 +943,17 @@ } } 0 test regexpComp-24.6 {regexp command compiling tests} { evalInProc { set re foo - regexp -n $re dogfoOd + regexp -nocase $re dogfoOd } } 1 test regexpComp-24.7 {regexp command compiling tests} { evalInProc { set re FoO - regexp -no -- $re dogfood + regexp -nocase -- $re dogfood } } 1 test regexpComp-24.8 {regexp command compiling tests} { evalInProc { set re foo @@ -980,13 +980,13 @@ set text {this is *bold* !} set re {\*bold\*.*!} regexp -- $re $text } } 1 - + # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: Index: tests/tailcall.test ================================================================== --- tests/tailcall.test +++ tests/tailcall.test @@ -22,17 +22,21 @@ # if {[testConstraint testnrelevels]} { namespace eval testnre { # - # [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels, - # cmdFrame level, callFrame level, tosPtr and callback depth + # [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels, + # callFrame level, tosPtr and callback depth # - variable last [testnrelevels] + proc depthDiff {} { variable last set depth [testnrelevels] + if {![info exists last]} { + set last $depth + return $last + } set res {} foreach t $depth l $last { lappend res [expr {$t-$l}] } set last $depth @@ -52,69 +56,61 @@ # # NOTE: there may be a diff in callback depth with the first call # ($i==0) due to the fact that the first is from an eval. Successive # calls should add nothing to any stack depths. # - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } tailcall a $i } } -body { a 0 } -cleanup { rename a {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup { set a { i { - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } upvar 1 a a tailcall apply $a $i }} } -body { apply $a 0 } -cleanup { unset a -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup { proc a i { - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } tailcall b $i } interp alias {} b {} a } -body { b 0 } -cleanup { rename a {} rename b {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup { namespace eval ::ns { namespace export * } proc ::ns::a i { - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } set b [uplevel 1 [list namespace which b]] tailcall $b $i } namespace import ::ns::a @@ -122,40 +118,36 @@ } -body { b 0 } -cleanup { rename b {} namespace delete ::ns -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup { proc b i { - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } tailcall a b $i } namespace ensemble create -command a -map {b b} } -body { a b 0 } -cleanup { rename a {} rename b {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels knownBug} -setup { # # This test fails because ns-unknown is not NR-enabled # proc c i { - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } tailcall a b $i } proc d {ens sub args} { return [list $ens c] @@ -165,21 +157,19 @@ a b 0 } -cleanup { rename a {} rename c {} rename d {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup { catch {rename foo {}} oo::class create foo { method b i { - if {$i == 1} { - depthDiff - } + set x [depthDiff] if {[incr i] > 10} { - return [depthDiff] + return $x } tailcall [self] b $i } } } -body { @@ -186,11 +176,11 @@ foo create a a b 0 } -cleanup { rename a {} rename foo {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-1 {tailcall} -body { namespace eval a { variable x *::a proc xset {} {