diff options
Diffstat (limited to 'generic/tclCompile.c')
| -rw-r--r-- | generic/tclCompile.c | 176 |
1 files changed, 68 insertions, 108 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index b5de230..f716195 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -666,7 +666,6 @@ InstructionDesc const tclInstructionTable[] = { * Prototypes for procedures defined later in this file: */ -static void CleanupByteCode(ByteCode *codePtr); static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); static void DupByteCodeInternalRep(Tcl_Obj *srcPtr, @@ -682,7 +681,6 @@ static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); static int IsCompactibleCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr); -static void PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats(ByteCode *codePtr); #endif /* TCL_COMPILE_STATS */ @@ -770,8 +768,7 @@ TclSetByteCodeFromAny( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - size_t length; - int result = TCL_OK; + int length, result = TCL_OK; const char *stringPtr; Proc *procPtr = iPtr->compiledProcPtr; ContLineLoc *clLocPtr; @@ -786,8 +783,7 @@ TclSetByteCodeFromAny( } #endif - stringPtr = TclGetString(objPtr); - length = objPtr->length; + stringPtr = TclGetStringFromObj(objPtr, &length); /* * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and @@ -875,7 +871,7 @@ TclSetByteCodeFromAny( #endif /*TCL_COMPILE_DEBUG*/ if (result == TCL_OK) { - (void) TclInitByteCodeObj(objPtr, &tclByteCodeType, &compEnv); + TclInitByteCodeObj(objPtr, &compEnv); #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile >= 2) { TclPrintByteCodeObj(interp, objPtr); @@ -976,13 +972,16 @@ FreeByteCodeInternalRep( { register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; - TclReleaseByteCode(codePtr); + objPtr->typePtr = NULL; + if (codePtr->refCount-- <= 1) { + TclCleanupByteCode(codePtr); + } } /* *---------------------------------------------------------------------- * - * TclReleaseByteCode -- + * TclCleanupByteCode -- * * This procedure does all the real work of freeing up a bytecode * object's ByteCode structure. It's called only when the structure's @@ -999,26 +998,7 @@ FreeByteCodeInternalRep( */ void -TclPreserveByteCode( - register ByteCode *codePtr) -{ - codePtr->refCount++; -} - -void -TclReleaseByteCode( - register ByteCode *codePtr) -{ - if (codePtr->refCount-- > 1) { - return; - } - - /* Just dropped to refcount==0. Clean up. */ - CleanupByteCode(codePtr); -} - -static void -CleanupByteCode( +TclCleanupByteCode( register ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; @@ -1285,6 +1265,8 @@ Tcl_NRSubstObj( * * Results: * A (ByteCode *) is returned pointing to the resulting ByteCode. + * The caller must manage its refCount and arrange for a call to + * TclCleanupByteCode() when the last reference disappears. * * Side effects: * The Tcl_ObjType of objPtr is changed to the "substcode" type, and the @@ -1315,13 +1297,13 @@ CompileSubstObj( || (codePtr->nsEpoch != nsPtr->resolverEpoch) || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) { - TclFreeIntRep(objPtr); + FreeSubstCodeInternalRep(objPtr); } } if (objPtr->typePtr != &substCodeType) { CompileEnv compEnv; int numBytes; - const char *bytes = TclGetStringFromObj(objPtr, &numBytes); + const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); /* TODO: Check for more TIP 280 */ TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0); @@ -1329,9 +1311,11 @@ CompileSubstObj( TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv); TclEmitOpcode(INST_DONE, &compEnv); - codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv); + TclInitByteCodeObj(objPtr, &compEnv); + objPtr->typePtr = &substCodeType; TclFreeCompileEnv(&compEnv); + codePtr = objPtr->internalRep.twoPtrValue.ptr1; objPtr->internalRep.twoPtrValue.ptr1 = codePtr; objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags); if (iPtr->varFramePtr->localCachePtr) { @@ -1374,7 +1358,10 @@ FreeSubstCodeInternalRep( { register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; - TclReleaseByteCode(codePtr); + objPtr->typePtr = NULL; + if (codePtr->refCount-- <= 1) { + TclCleanupByteCode(codePtr); + } } static void @@ -1387,14 +1374,14 @@ ReleaseCmdWordData( Tcl_DecrRefCount(eclPtr->path); } for (i=0 ; i<eclPtr->nuloc ; i++) { - ckfree(eclPtr->loc[i].line); + ckfree((char *) eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { - ckfree(eclPtr->loc); + ckfree((char *) eclPtr->loc); } - ckfree(eclPtr); + ckfree((char *) eclPtr); } /* @@ -1808,8 +1795,8 @@ CompileCmdLiteral( extraLiteralFlags |= LITERAL_UNSHARED; } - bytes = TclGetStringFromObj(cmdObj, &numBytes); - cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags); + bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); + cmdLitIdx = TclRegisterLiteral(envPtr, (char *)bytes, numBytes, extraLiteralFlags); if (cmdPtr) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); @@ -1844,8 +1831,8 @@ TclCompileInvocation( continue; } - objIdx = TclRegisterLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size, 0); + objIdx = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), tokenPtr[1].start - envPtr->source, envPtr->clNext); @@ -1894,8 +1881,8 @@ CompileExpanded( continue; } - objIdx = TclRegisterLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size, 0); + objIdx = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), tokenPtr[1].start - envPtr->source, envPtr->clNext); @@ -2723,40 +2710,11 @@ TclCompileNoOp( *---------------------------------------------------------------------- */ -static void -PreventCycle( - Tcl_Obj *objPtr, - CompileEnv *envPtr) -{ - int i; - - for (i = 0; i < envPtr->literalArrayNext; i++) { - if (objPtr == TclFetchLiteral(envPtr, i)) { - /* - * Prevent circular reference where the bytecode intrep of - * a value contains a literal which is that same value. - * If this is allowed to happen, refcount decrements may not - * reach zero, and memory may leak. Bugs 467523, 3357771 - * - * NOTE: [Bugs 3392070, 3389764] We make a copy based completely - * on the string value, and do not call Tcl_DuplicateObj() so we - * can be sure we do not have any lingering cycles hiding in - * the intrep. - */ - int numBytes; - const char *bytes = TclGetStringFromObj(objPtr, &numBytes); - Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes); - - Tcl_IncrRefCount(copyPtr); - TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr); - - envPtr->literalArrayPtr[i].objPtr = copyPtr; - } - } -} - -ByteCode * -TclInitByteCode( +void +TclInitByteCodeObj( + Tcl_Obj *objPtr, /* Points object that should be initialized, + * and whose string rep contains the source + * code. */ register CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { @@ -2807,8 +2765,7 @@ TclInitByteCode( codePtr->compileEpoch = iPtr->compileEpoch; codePtr->nsPtr = namespacePtr; codePtr->nsEpoch = namespacePtr->resolverEpoch; - codePtr->refCount = 0; - TclPreserveByteCode(codePtr); + codePtr->refCount = 1; if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) { codePtr->flags = TCL_BYTECODE_RESOLVE_VARS; } else { @@ -2834,7 +2791,29 @@ TclInitByteCode( p += TCL_ALIGN(codeBytes); /* align object array */ codePtr->objArrayPtr = (Tcl_Obj **) p; for (i = 0; i < numLitObjects; i++) { - codePtr->objArrayPtr[i] = TclFetchLiteral(envPtr, i); + Tcl_Obj *fetched = TclFetchLiteral(envPtr, i); + + if (objPtr == fetched) { + /* + * Prevent circular reference where the bytecode intrep of + * a value contains a literal which is that same value. + * If this is allowed to happen, refcount decrements may not + * reach zero, and memory may leak. Bugs 467523, 3357771 + * + * NOTE: [Bugs 3392070, 3389764] We make a copy based completely + * on the string value, and do not call Tcl_DuplicateObj() so we + * can be sure we do not have any lingering cycles hiding in + * the intrep. + */ + int numBytes; + const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); + + codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes); + Tcl_IncrRefCount(codePtr->objArrayPtr[i]); + TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr); + } else { + codePtr->objArrayPtr[i] = fetched; + } } p += TCL_ALIGN(objArrayBytes); /* align exception range array */ @@ -2877,6 +2856,15 @@ TclInitByteCode( #endif /* TCL_COMPILE_STATS */ /* + * Free the old internal rep then convert the object to a bytecode object + * by making its internal rep point to the just compiled ByteCode. + */ + + TclFreeIntRep(objPtr); + objPtr->internalRep.twoPtrValue.ptr1 = 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. */ @@ -2889,33 +2877,6 @@ TclInitByteCode( envPtr->iPtr = NULL; codePtr->localCachePtr = NULL; - return codePtr; -} - -ByteCode * -TclInitByteCodeObj( - Tcl_Obj *objPtr, /* Points object that should be initialized, - * and whose string rep contains the source - * code. */ - const Tcl_ObjType *typePtr, - register CompileEnv *envPtr)/* Points to the CompileEnv structure from - * which to create a ByteCode structure. */ -{ - ByteCode *codePtr; - - PreventCycle(objPtr, envPtr); - - codePtr = TclInitByteCode(envPtr); - - /* - * Free the old internal rep then convert the object to a bytecode object - * by making its internal rep point to the just compiled ByteCode. - */ - - TclFreeIntRep(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = codePtr; - objPtr->typePtr = typePtr; - return codePtr; } /* @@ -2983,8 +2944,7 @@ TclFindCompiledLocal( varNamePtr = &cachePtr->varName0; for (i=0; i < cachePtr->numVars; varNamePtr++, i++) { if (*varNamePtr) { - localName = TclGetString(*varNamePtr); - len = (*varNamePtr)->length; + localName = Tcl_GetStringFromObj(*varNamePtr, &len); if ((len == nameBytes) && !strncmp(name, localName, len)) { return i; } |