summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-02-21 21:14:55 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-02-21 21:14:55 (GMT)
commit6bd81a4dac7ec52c342aeb40e59ff6ea2387669a (patch)
tree852cecdeef1aa1640ac54aaa1a5e1a7e2c25f5c5
parent7c09879dbba02a4c3b86b6fbc4b9f1a05dba7b5b (diff)
downloadtcl-6bd81a4dac7ec52c342aeb40e59ff6ea2387669a.zip
tcl-6bd81a4dac7ec52c342aeb40e59ff6ea2387669a.tar.gz
tcl-6bd81a4dac7ec52c342aeb40e59ff6ea2387669a.tar.bz2
Protect against multiple uses of a CompileEnv with only one initialization.
Make TclFreeCompileEnv smarter about cleanup so all callers do not have to be. Revise TclSetByteCodeFromAny() so that when hookProc raises an error, bytecode is not generated. This was rumored to cause crashes.
-rw-r--r--generic/tclCompile.c74
-rw-r--r--generic/tclExecute.c19
2 files changed, 44 insertions, 49 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 1ec7c58..d27c9b6 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -361,9 +361,6 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
CompileEnv compEnv; /* Compilation environment structure
* allocated in frame. */
LiteralTable *localTablePtr = &(compEnv.localLitTable);
- register AuxData *auxDataPtr;
- LiteralEntry *entryPtr;
- register int i;
int length, nested, result;
char *string;
#ifdef TCL_TIP280
@@ -443,38 +440,16 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
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);
- }
-#endif /* TCL_COMPILE_DEBUG */
- }
-
- if (result != TCL_OK) {
- /*
- * Compilation errors.
- */
-
- 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);
+ if (tclTraceCompile >= 2) {
+ TclPrintByteCodeObj(interp, objPtr);
}
- auxDataPtr++;
+#endif /* TCL_COMPILE_DEBUG */
}
}
-
-
+
/*
* Free storage allocated during compilation.
*/
@@ -947,6 +922,32 @@ void
TclFreeCompileEnv(envPtr)
register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
{
+ if (envPtr->source) {
+ /*
+ * 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((char *) envPtr->codeStart);
}
@@ -1088,6 +1089,10 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
int* clNext;
#endif
+ if (envPtr->source == NULL) {
+ Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
+ }
+
Tcl_DStringInit(&ds);
if (numBytes < 0) {
@@ -1991,6 +1996,10 @@ TclInitByteCodeObj(objPtr, envPtr)
#endif
Interp *iPtr;
+ if (envPtr->source == NULL) {
+ Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv");
+ }
+
iPtr = envPtr->iPtr;
codeBytes = (envPtr->codeNext - envPtr->codeStart);
@@ -2110,6 +2119,9 @@ TclInitByteCodeObj(objPtr, envPtr)
envPtr->extCmdMapPtr);
envPtr->extCmdMapPtr = NULL;
#endif
+
+ /* We've used up the CompileEnv. Mark as uninitialized. */
+ envPtr->source = NULL;
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c09b73e..1ae182c 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -724,11 +724,9 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
register ByteCode *codePtr = NULL;
/* Tcl Internal type of bytecode.
* Initialized to avoid compiler warning. */
- AuxData *auxDataPtr;
- LiteralEntry *entryPtr;
Tcl_Obj *saveObjPtr;
char *string;
- int length, i, result;
+ int length, result;
/*
* First handle some common expressions specially.
@@ -808,22 +806,7 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
#ifdef TCL_COMPILE_DEBUG
TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/
- 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++;
- }
TclFreeCompileEnv(&compEnv);
goto done;
}