summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAssembly.c12
-rw-r--r--generic/tclCompExpr.c7
-rw-r--r--generic/tclCompile.c147
-rw-r--r--generic/tclCompile.h8
-rw-r--r--generic/tclExecute.c21
5 files changed, 108 insertions, 87 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 6d5676b..4ad31d2 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -866,7 +866,7 @@ CompileAssembleObj(
* Not valid, so free it and regenerate.
*/
- FreeAssembleCodeInternalRep(objPtr);
+ TclFreeIntRep(objPtr);
}
/*
@@ -891,15 +891,13 @@ CompileAssembleObj(
*/
TclEmitOpcode(INST_DONE, &compEnv);
- TclInitByteCodeObj(objPtr, &compEnv);
- objPtr->typePtr = &assembleCodeType;
+ codePtr = TclInitByteCodeObj(objPtr, &assembleCodeType, &compEnv);
TclFreeCompileEnv(&compEnv);
/*
* Record the local variable context to which the bytecode pertains
*/
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -4313,11 +4311,7 @@ FreeAssembleCodeInternalRep(
{
ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
- TclCleanupByteCode(codePtr);
- }
- objPtr->typePtr = NULL;
+ TclReleaseByteCode(codePtr);
}
/*
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 4390282..654666a 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2181,7 +2181,6 @@ ExecConstantExprTree(
CompileEnv *envPtr;
ByteCode *byteCodePtr;
int code;
- Tcl_Obj *byteCodeObj = Tcl_NewObj();
NRE_callback *rootPtr = TOP_CB(interp);
/*
@@ -2195,14 +2194,12 @@ ExecConstantExprTree(
CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
0 /* optimize */);
TclEmitOpcode(INST_DONE, envPtr);
- Tcl_IncrRefCount(byteCodeObj);
- TclInitByteCodeObj(byteCodeObj, envPtr);
+ byteCodePtr = TclInitByteCode(envPtr);
TclFreeCompileEnv(envPtr);
TclStackFree(interp, envPtr);
- byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1;
TclNRExecuteByteCode(interp, byteCodePtr);
code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
- Tcl_DecrRefCount(byteCodeObj);
+ TclReleaseByteCode(byteCodePtr);
return code;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c0b5dcc..96b418c 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -661,6 +661,7 @@ 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,
@@ -676,6 +677,7 @@ 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 */
@@ -866,7 +868,7 @@ TclSetByteCodeFromAny(
#endif /*TCL_COMPILE_DEBUG*/
if (result == TCL_OK) {
- TclInitByteCodeObj(objPtr, &compEnv);
+ (void) TclInitByteCodeObj(objPtr, &tclByteCodeType, &compEnv);
#ifdef TCL_COMPILE_DEBUG
if (tclTraceCompile >= 2) {
TclPrintByteCodeObj(interp, objPtr);
@@ -967,16 +969,13 @@ FreeByteCodeInternalRep(
{
register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- objPtr->typePtr = NULL;
- if (codePtr->refCount-- <= 1) {
- TclCleanupByteCode(codePtr);
- }
+ TclReleaseByteCode(codePtr);
}
/*
*----------------------------------------------------------------------
*
- * TclCleanupByteCode --
+ * TclReleaseByteCode --
*
* This procedure does all the real work of freeing up a bytecode
* object's ByteCode structure. It's called only when the structure's
@@ -993,7 +992,26 @@ FreeByteCodeInternalRep(
*/
void
-TclCleanupByteCode(
+TclPreserveByteCode(
+ register ByteCode *codePtr)
+{
+ codePtr->refCount++;
+}
+
+void
+TclReleaseByteCode(
+ register ByteCode *codePtr)
+{
+ if (--codePtr->refCount) {
+ return;
+ }
+
+ /* Just dropped to refcount==0. Clean up. */
+ CleanupByteCode(codePtr);
+}
+
+static void
+CleanupByteCode(
register ByteCode *codePtr) /* Points to the ByteCode to free. */
{
Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
@@ -1260,8 +1278,6 @@ 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
@@ -1292,7 +1308,7 @@ CompileSubstObj(
|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
|| (codePtr->localCachePtr !=
iPtr->varFramePtr->localCachePtr)) {
- FreeSubstCodeInternalRep(objPtr);
+ TclFreeIntRep(objPtr);
}
}
if (objPtr->typePtr != &substCodeType) {
@@ -1306,11 +1322,9 @@ CompileSubstObj(
TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);
TclEmitOpcode(INST_DONE, &compEnv);
- TclInitByteCodeObj(objPtr, &compEnv);
- objPtr->typePtr = &substCodeType;
+ codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv);
TclFreeCompileEnv(&compEnv);
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags);
if (iPtr->varFramePtr->localCachePtr) {
@@ -1353,10 +1367,7 @@ FreeSubstCodeInternalRep(
{
register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- objPtr->typePtr = NULL;
- if (codePtr->refCount-- <= 1) {
- TclCleanupByteCode(codePtr);
- }
+ TclReleaseByteCode(codePtr);
}
static void
@@ -2697,11 +2708,40 @@ TclCompileNoOp(
*----------------------------------------------------------------------
*/
-void
-TclInitByteCodeObj(
- Tcl_Obj *objPtr, /* Points object that should be initialized,
- * and whose string rep contains the source
- * code. */
+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 = Tcl_GetStringFromObj(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(
register CompileEnv *envPtr)/* Points to the CompileEnv structure from
* which to create a ByteCode structure. */
{
@@ -2752,7 +2792,8 @@ TclInitByteCodeObj(
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = namespacePtr;
codePtr->nsEpoch = namespacePtr->resolverEpoch;
- codePtr->refCount = 1;
+ codePtr->refCount = 0;
+ TclPreserveByteCode(codePtr);
if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
} else {
@@ -2778,29 +2819,7 @@ TclInitByteCodeObj(
p += TCL_ALIGN(codeBytes); /* align object array */
codePtr->objArrayPtr = (Tcl_Obj **) p;
for (i = 0; i < numLitObjects; 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;
- }
+ codePtr->objArrayPtr[i] = TclFetchLiteral(envPtr, i);
}
p += TCL_ALIGN(objArrayBytes); /* align exception range array */
@@ -2843,15 +2862,6 @@ TclInitByteCodeObj(
#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.
*/
@@ -2864,6 +2874,33 @@ TclInitByteCodeObj(
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;
}
/*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index d5bc86b..f99c07c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1067,7 +1067,6 @@ MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp,
Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
CompileEnv *envPtr);
-MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr);
MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr,
ExceptionAux *auxPtr);
MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp,
@@ -1119,8 +1118,9 @@ MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
int distThreshold);
MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
-MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
- CompileEnv *envPtr);
+MODULE_SCOPE ByteCode * TclInitByteCode(CompileEnv *envPtr);
+MODULE_SCOPE ByteCode * TclInitByteCodeObj(Tcl_Obj *objPtr,
+ const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
CompileEnv *envPtr, const char *string,
int numBytes, const CmdFrame *invoker, int word);
@@ -1157,6 +1157,8 @@ MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
int flags, int *localIndexPtr,
int *isScalarPtr);
+MODULE_SCOPE void TclPreserveByteCode(ByteCode *codePtr);
+MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
const char *name, Namespace *nsPtr);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 823f619..cd28a92 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1499,11 +1499,9 @@ ExprObjCallback(
*
* 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 "bytecode" type,
+ * The Tcl_ObjType of objPtr is changed to the "exprcode" type,
* and the ByteCode is kept in the internal rep (along with context
* data for checking validity) for faster operations the next time
* CompileExprObj is called on the same value.
@@ -1536,7 +1534,7 @@ CompileExprObj(
|| (codePtr->nsPtr != namespacePtr)
|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
- FreeExprCodeInternalRep(objPtr);
+ TclFreeIntRep(objPtr);
}
}
if (objPtr->typePtr != &exprCodeType) {
@@ -1567,10 +1565,8 @@ CompileExprObj(
*/
TclEmitOpcode(INST_DONE, &compEnv);
- TclInitByteCodeObj(objPtr, &compEnv);
- objPtr->typePtr = &exprCodeType;
+ codePtr = TclInitByteCodeObj(objPtr, &exprCodeType, &compEnv);
TclFreeCompileEnv(&compEnv);
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1644,10 +1640,7 @@ FreeExprCodeInternalRep(
{
ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- objPtr->typePtr = NULL;
- if (codePtr->refCount-- <= 1) {
- TclCleanupByteCode(codePtr);
- }
+ TclReleaseByteCode(codePtr);
}
/*
@@ -2033,7 +2026,7 @@ TclNRExecuteByteCode(
* sizeof(void *);
int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
- codePtr->refCount++;
+ TclPreserveByteCode(codePtr);
/*
* Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
@@ -8189,9 +8182,7 @@ TEBCresume(
}
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
- if (codePtr->refCount-- <= 1) {
- TclCleanupByteCode(codePtr);
- }
+ TclReleaseByteCode(codePtr);
TclStackFree(interp, TD); /* free my stack */
return result;
generated by cgit v0.12 at 2024-10-27 14:50:20 (GMT)