summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-02-22 19:05:56 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-02-22 19:05:56 (GMT)
commit69d70d74daaeb3e28f9e6f851396324e7ce383fb (patch)
tree91b412b5cc69b45468c3f3d2e006a10155f2f582 /generic/tclCompile.c
parent7a3b6d780c3e6b3d8f002c499f11daea41cd411a (diff)
parentc321250dcd5875ebaf9503f4278e9c1f6a3ca30c (diff)
downloadtcl-69d70d74daaeb3e28f9e6f851396324e7ce383fb.zip
tcl-69d70d74daaeb3e28f9e6f851396324e7ce383fb.tar.gz
tcl-69d70d74daaeb3e28f9e6f851396324e7ce383fb.tar.bz2
Shift more burden of smart cleanup onto the TclFreeCompileEnv() routine.
Stop crashes when the hookProc raises an error.
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r--generic/tclCompile.c116
1 files changed, 69 insertions, 47 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index dde116f..91eab6e 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -573,6 +573,7 @@ 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);
+static void ReleaseCmdWordData(ExtCmdLoc *eclPtr);
/*
* The structure below defines the bytecode Tcl object type by means of
@@ -650,9 +651,6 @@ TclSetByteCodeFromAny(
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;
@@ -722,35 +720,14 @@ TclSetByteCodeFromAny(
TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/
- TclInitByteCodeObj(objPtr, &compEnv);
+ if (result == TCL_OK) {
+ TclInitByteCodeObj(objPtr, &compEnv);
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
- if (result != TCL_OK) {
- /*
- * Handle any error from the hookProc
- */
-
- entryPtr = compEnv.literalArrayPtr;
- for (i = 0; i < compEnv.literalArrayNext; i++) {
- TclReleaseLiteral(interp, entryPtr->objPtr);
- entryPtr++;
- }
-#ifdef TCL_COMPILE_DEBUG
- TclVerifyGlobalLiteralTable(iPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-
- auxDataPtr = compEnv.auxDataArrayPtr;
- for (i = 0; i < compEnv.auxDataArrayNext; i++) {
- if (auxDataPtr->type->freeProc != NULL) {
- auxDataPtr->type->freeProc(auxDataPtr->clientData);
- }
- auxDataPtr++;
+ if (tclTraceCompile >= 2) {
+ TclPrintByteCodeObj(interp, objPtr);
+ fflush(stdout);
}
+#endif /* TCL_COMPILE_DEBUG */
}
TclFreeCompileEnv(&compEnv);
@@ -989,22 +966,7 @@ TclCleanupByteCode(
(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);
+ ReleaseCmdWordData(Tcl_GetHashValue(hePtr));
Tcl_DeleteHashEntry(hePtr);
}
}
@@ -1185,6 +1147,28 @@ FreeSubstCodeInternalRep(
TclCleanupByteCode(codePtr);
}
}
+
+static void
+ReleaseCmdWordData(
+ ExtCmdLoc *eclPtr)
+{
+ int i;
+
+ if (eclPtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount(eclPtr->path);
+ }
+ for (i=0 ; i<eclPtr->nuloc ; i++) {
+ ckfree((char *) eclPtr->loc[i].line);
+ }
+
+ if (eclPtr->loc != NULL) {
+ ckfree((char *) eclPtr->loc);
+ }
+
+ Tcl_DeleteHashTable (&eclPtr->litInfo);
+
+ ckfree((char *) eclPtr);
+}
/*
*----------------------------------------------------------------------
@@ -1418,6 +1402,32 @@ TclFreeCompileEnv(
ckfree(envPtr->localLitTable.buckets);
envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
}
+ if (envPtr->iPtr) {
+ /*
+ * We never converted to Bytecode, so free the things we would
+ * have transferred to it.
+ */
+
+ int i;
+ LiteralEntry *entryPtr = envPtr->literalArrayPtr;
+ AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
+
+ for (i = 0; i < envPtr->literalArrayNext; i++) {
+ TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr);
+ entryPtr++;
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyGlobalLiteralTable(envPtr->iPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
+ for (i = 0; i < envPtr->auxDataArrayNext; i++) {
+ if (auxDataPtr->type->freeProc != NULL) {
+ auxDataPtr->type->freeProc(auxDataPtr->clientData);
+ }
+ auxDataPtr++;
+ }
+ }
if (envPtr->mallocedCodeArray) {
ckfree(envPtr->codeStart);
}
@@ -1434,7 +1444,8 @@ TclFreeCompileEnv(
ckfree(envPtr->auxDataArrayPtr);
}
if (envPtr->extCmdMapPtr) {
- ckfree(envPtr->extCmdMapPtr);
+ ReleaseCmdWordData(envPtr->extCmdMapPtr);
+ envPtr->extCmdMapPtr = NULL;
}
/*
@@ -1576,6 +1587,10 @@ TclCompileScript(
int *wlines, wlineat, cmdLine, *clNext;
Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+ if (envPtr->iPtr == NULL) {
+ Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
+ }
+
Tcl_DStringInit(&ds);
if (numBytes < 0) {
@@ -2510,6 +2525,10 @@ TclInitByteCodeObj(
int i, isNew;
Interp *iPtr;
+ if (envPtr->iPtr == NULL) {
+ Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv");
+ }
+
iPtr = envPtr->iPtr;
codeBytes = envPtr->codeNext - envPtr->codeStart;
@@ -2647,6 +2666,9 @@ TclInitByteCodeObj(
&isNew), envPtr->extCmdMapPtr);
envPtr->extCmdMapPtr = NULL;
+ /* We've used up the CompileEnv. Mark as uninitialized. */
+ envPtr->iPtr = NULL;
+
codePtr->localCachePtr = NULL;
}