diff options
Diffstat (limited to 'generic/tclCompile.c')
| -rw-r--r-- | generic/tclCompile.c | 724 |
1 files changed, 11 insertions, 713 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 45a74d7..2f6b166 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -563,16 +563,6 @@ static int FormatInstruction(ByteCode *codePtr, 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 @@ -600,18 +590,6 @@ static const Tcl_ObjType substCodeType = { NULL, /* setFromAnyProc */ }; -/* - * The structure below defines an instruction name Tcl object to allow - * reporting of inner contexts in errorstack without string allocation. - */ - -static const Tcl_ObjType tclInstNameType = { - "instname", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - UpdateStringOfInstName, /* updateStringProc */ - NULL, /* setFromAnyProc */ -}; /* *---------------------------------------------------------------------- @@ -647,7 +625,6 @@ TclSetByteCodeFromAny( 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; @@ -655,7 +632,6 @@ TclSetByteCodeFromAny( register int i; int length, result = TCL_OK; const char *stringPtr; - ContLineLoc *clLocPtr; #ifdef TCL_COMPILE_DEBUG if (!traceInitialized) { @@ -669,14 +645,7 @@ TclSetByteCodeFromAny( 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 @@ -690,13 +659,6 @@ TclSetByteCodeFromAny( * "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); /* @@ -741,7 +703,7 @@ TclSetByteCodeFromAny( entryPtr++; } #ifdef TCL_COMPILE_DEBUG - TclVerifyGlobalLiteralTable(iPtr); + TclVerifyGlobalLiteralTable((Interp *)interp); #endif /*TCL_COMPILE_DEBUG*/ auxDataPtr = compEnv.auxDataArrayPtr; @@ -879,7 +841,6 @@ 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; @@ -892,7 +853,7 @@ TclCleanupByteCode( Tcl_Time destroyTime; int lifetimeSec, lifetimeMicroSec, log2; - statsPtr = &iPtr->stats; + statsPtr = &((Interp *)interp)->stats; statsPtr->numByteCodesFreed++; statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes; @@ -979,39 +940,6 @@ TclCleanupByteCode( 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 ; i<eclPtr->nuloc ; 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); } @@ -1044,10 +972,9 @@ Tcl_SubstObj( Tcl_Obj *objPtr, /* The value to be substituted. */ int flags) /* What substitutions to do. */ { - NRE_callback *rootPtr = TOP_CB(interp); - - if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags), - rootPtr) != TCL_OK) { + TclNRSetRoot(interp); + if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags)) + != TCL_OK) { return NULL; } return Tcl_GetObjResult(interp); @@ -1134,10 +1061,9 @@ CompileSubstObj( 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); @@ -1214,10 +1140,7 @@ TclInitCompileEnv( 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; @@ -1253,138 +1176,6 @@ TclInitCompileEnv( 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; @@ -1437,19 +1228,6 @@ TclFreeCompileEnv( 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); - } } /* @@ -1575,9 +1353,6 @@ TclCompileScript( 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); @@ -1601,8 +1376,6 @@ TclCompileScript( p = script; bytesLeft = numBytes; - cmdLine = envPtr->line; - clNext = envPtr->clNext; do { if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { /* @@ -1618,18 +1391,6 @@ TclCompileScript( 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 */ @@ -1707,20 +1468,6 @@ TclCompileScript( } /* - * 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. */ @@ -1729,8 +1476,6 @@ TclCompileScript( 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. @@ -1907,13 +1652,6 @@ TclCompileScript( 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 */ @@ -1943,16 +1681,6 @@ TclCompileScript( 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 { @@ -1970,15 +1698,6 @@ TclCompileScript( (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 */ /* @@ -1988,25 +1707,10 @@ TclCompileScript( 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. */ @@ -2088,9 +1792,6 @@ TclCompileVarSubst( * 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); @@ -2123,42 +1824,8 @@ TclCompileTokens( 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; @@ -2166,8 +1833,6 @@ TclCompileTokens( switch (tokenPtr->type) { case TCL_TOKEN_TEXT: TclDStringAppendToken(&textBuffer, tokenPtr); - TclAdvanceLines(&envPtr->line, tokenPtr->start, - tokenPtr->start + tokenPtr->size); break; case TCL_TOKEN_BS: @@ -2175,34 +1840,8 @@ TclCompileTokens( 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; @@ -2217,13 +1856,6 @@ TclCompileTokens( TclEmitPush(literal, envPtr); numObjsToConcat++; Tcl_DStringFree(&textBuffer); - - if (numCL) { - TclContinuationsEnter( - envPtr->literalArrayPtr[literal].objPtr, numCL, - clPosition); - } - numCL = 0; } TclCompileScript(interp, tokenPtr->start+1, @@ -2266,11 +1898,6 @@ TclCompileTokens( TclEmitPush(literal, envPtr); numObjsToConcat++; - if (numCL) { - TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr, - numCL, clPosition); - } - numCL = 0; } /* @@ -2293,15 +1920,6 @@ TclCompileTokens( 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); - } } /* @@ -2511,7 +2129,7 @@ TclInitByteCodeObj( #endif int numLitObjects = envPtr->literalArrayNext; Namespace *namespacePtr; - int i, isNew; + int i; Interp *iPtr; iPtr = envPtr->iPtr; @@ -2642,15 +2260,6 @@ TclInitByteCodeObj( 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; } @@ -2960,86 +2569,6 @@ EnterCmdExtentData( /* *---------------------------------------------------------------------- - * 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 ; wordIdx<numWords; - wordIdx++, tokenPtr += tokenPtr->numComponents + 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 -- * @@ -3468,70 +2997,6 @@ TclFixupForwardJump( rangePtr->type); } } - - /* - * TIP #280: Adjust the mapping from PC values to the per-command - * information about arguments and their line numbers. - * - * Note: We cannot simply remove an out-of-date entry and then reinsert - * with the proper PC, because then we might overwrite another entry which - * was at that location. Therefore we pull (copy + delete) all effected - * entries (beyond the fixed PC) into an array, update them there, and at - * last reinsert them all. - */ - - { - ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr; - - /* A helper structure */ - - typedef struct { - int pc; - int cmd; - } MAP; - - /* - * And the helper array. At most the whole hashtable is placed into - * this. - */ - - MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries); - - Tcl_HashSearch hSearch; - Tcl_HashEntry* hPtr; - int n, k, isnew; - - /* - * Phase I: Locate the affected entries, and save them in adjusted - * form to the array. This removes them from the hash. - */ - - for (n = 0, hPtr = Tcl_FirstHashEntry(&eclPtr->litInfo, &hSearch); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&hSearch)) { - - map [n].cmd = PTR2INT(Tcl_GetHashValue(hPtr)); - map [n].pc = PTR2INT(Tcl_GetHashKey (&eclPtr->litInfo,hPtr)); - - if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) { - Tcl_DeleteHashEntry(hPtr); - map [n].pc += 3; - n++; - } - } - - /* - * Phase II: Re-insert the modified entries into the hash. - */ - - for (k=0;k<n;k++) { - hPtr = Tcl_CreateHashEntry(&eclPtr->litInfo, INT2PTR(map[k].pc), &isnew); - Tcl_SetHashValue(hPtr, INT2PTR(map[k].cmd)); - } - - ckfree (map); - } - return 1; /* the jump was grown */ } @@ -4462,173 +3927,6 @@ FormatInstruction( /* *---------------------------------------------------------------------- * - * TclGetInnerContext -- - * - * If possible, returns a list capturing the inner context. Otherwise - * return NULL. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclGetInnerContext( - Tcl_Interp *interp, - const unsigned char *pc, - Tcl_Obj **tosPtr) -{ - int objc = 0, off = 0; - Tcl_Obj *result; - Interp *iPtr = (Interp *) interp; - - switch (*pc) { - case INST_STR_LEN: - case INST_LNOT: - case INST_BITNOT: - case INST_UMINUS: - case INST_UPLUS: - case INST_TRY_CVT_TO_NUMERIC: - case INST_EXPAND_STKTOP: - case INST_EXPR_STK: - objc = 1; - break; - - case INST_LIST_IN: - case INST_LIST_NOT_IN: /* Basic list containment operators. */ - case INST_STR_EQ: - case INST_STR_NEQ: /* String (in)equality check */ - case INST_STR_CMP: /* String compare. */ - case INST_STR_INDEX: - case INST_STR_MATCH: - case INST_REGEXP: - case INST_EQ: - case INST_NEQ: - case INST_LT: - case INST_GT: - case INST_LE: - case INST_GE: - case INST_MOD: - case INST_LSHIFT: - case INST_RSHIFT: - case INST_BITOR: - case INST_BITXOR: - case INST_BITAND: - case INST_EXPON: - case INST_ADD: - case INST_SUB: - case INST_DIV: - case INST_MULT: - objc = 2; - break; - - case INST_RETURN_STK: - /* early pop. TODO: dig out opt dict too :/ */ - objc = 1; - break; - - case INST_SYNTAX: - case INST_RETURN_IMM: - objc = 2; - break; - - case INST_INVOKE_STK4: - objc = TclGetUInt4AtPtr(pc+1); - break; - - case INST_INVOKE_STK1: - objc = TclGetUInt1AtPtr(pc+1); - break; - } - - result = iPtr->innerContext; - if (Tcl_IsShared(result)) { - Tcl_DecrRefCount(result); - iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); - Tcl_IncrRefCount(result); - } else { - int len; - - /* - * Reset while keeping the list intrep as much as possible. - */ - - Tcl_ListObjLength(interp, result, &len); - Tcl_ListObjReplace(interp, result, 0, len, 0, NULL); - } - Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc)); - - for (; objc>0 ; objc--) { - Tcl_Obj *objPtr; - - objPtr = tosPtr[1 - objc + off]; - if (!objPtr) { - Tcl_Panic("InnerContext: bad tos -- appending null object"); - } - if (objPtr->refCount<=0 || objPtr->refCount==0x61616161) { - Tcl_Panic("InnerContext: bad tos -- appending freed object %p", - objPtr); - } - Tcl_ListObjAppendElement(NULL, result, objPtr); - } - - return result; -} - -/* - *---------------------------------------------------------------------- - * - * TclNewInstNameObj -- - * - * Creates a new InstName Tcl_Obj based on the given instruction - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclNewInstNameObj( - unsigned char inst) -{ - Tcl_Obj *objPtr = Tcl_NewObj(); - - objPtr->typePtr = &tclInstNameType; - objPtr->internalRep.longValue = (long) inst; - objPtr->bytes = NULL; - - return objPtr; -} - -/* - *---------------------------------------------------------------------- - * - * UpdateStringOfInstName -- - * - * Update the string representation for an instruction name object. - * - *---------------------------------------------------------------------- - */ - -static void -UpdateStringOfInstName( - Tcl_Obj *objPtr) -{ - int inst = objPtr->internalRep.longValue; - char *s, buf[20]; - int len; - - if ((inst < 0) || (inst > LAST_INST_OPCODE)) { - sprintf(buf, "inst_%d", inst); - s = buf; - } else { - s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name; - } - len = strlen(s); - objPtr->bytes = ckalloc(len + 1); - memcpy(objPtr->bytes, s, len + 1); - objPtr->length = len; -} - -/* - *---------------------------------------------------------------------- - * * PrintSourceToObj -- * * Appends a quoted representation of a string to a Tcl_Obj. |