summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.c
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2008-07-21 19:37:35 (GMT)
committerandreas_kupries <akupries@shaw.ca>2008-07-21 19:37:35 (GMT)
commitc24d3516daee359922217e9267ba9e0e8aad1ce0 (patch)
treefafc8c6c64f4ad4f3c2dbb31b0e501a392f1f450 /generic/tclCompile.c
parent42ecaf98ac017a8cb5d769f57fd62677cc92ac4f (diff)
downloadtcl-c24d3516daee359922217e9267ba9e0e8aad1ce0.zip
tcl-c24d3516daee359922217e9267ba9e0e8aad1ce0.tar.gz
tcl-c24d3516daee359922217e9267ba9e0e8aad1ce0.tar.bz2
* generic/tclBasic.c: Extended the existing TIP #280 system (info
* generic/tclCmdAH.c: frame), added the ability to track the * generic/tclCompCmds.c: absolute location of literal procedure * generic/tclCompile.c: arguments, and making this information * generic/tclCompile.h: available to uplevel, eval, and * generic/tclInterp.c: siblings. This allows proper tracking of * generic/tclInt.h: absolute location through custom (Tcl-coded) * generic/tclNamesp.c: control structures based on uplevel, etc. * generic/tclProc.c:
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r--generic/tclCompile.c49
1 files changed, 48 insertions, 1 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 59617b0..d8e22e2 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.43.2.8 2007/08/24 11:22:16 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.43.2.9 2008/07/21 19:37:43 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -702,6 +702,8 @@ TclCleanupByteCode(codePtr)
if (hePtr) {
ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
int i;
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry *hlPtr;
if (eclPtr->type == TCL_LOCATION_SOURCE) {
Tcl_DecrRefCount (eclPtr->path);
@@ -714,6 +716,15 @@ TclCleanupByteCode(codePtr)
ckfree ((char*) eclPtr->loc);
}
+ /* Release index of literals as well. */
+ for (hlPtr = Tcl_FirstHashEntry(&eclPtr->litIndex, &hSearch);
+ hlPtr != NULL;
+ hlPtr = Tcl_NextHashEntry(&hSearch)) {
+ ExtIndex* eiPtr = (ExtIndex*) Tcl_GetHashValue (hlPtr);
+ ckfree((char*) eiPtr);
+ Tcl_DeleteHashEntry (hlPtr);
+ }
+ Tcl_DeleteHashTable (&eclPtr->litIndex);
ckfree ((char*) eclPtr);
Tcl_DeleteHashEntry (hePtr);
}
@@ -806,6 +817,7 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
envPtr->extCmdMapPtr->nloc = 0;
envPtr->extCmdMapPtr->nuloc = 0;
envPtr->extCmdMapPtr->path = NULL;
+ Tcl_InitHashTable(&envPtr->extCmdMapPtr->litIndex, TCL_ONE_WORD_KEYS);
if (invoker == NULL) {
/* Initialize the compiler for relative counting */
@@ -1241,8 +1253,25 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
cmdPtr);
}
} else {
+ /* Simple argument word of a command. We reach this if
+ * and only if the command word was not compiled for
+ * whatever reason. Register the literal's location
+ * for use by uplevel, etc. commands, should they
+ * encounter it unmodified. We care only if the we are
+ * in a context which already allows absolute
+ * counting.
+ */
+
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
+#ifdef TCL_TIP280
+ if (eclPtr->type == TCL_LOCATION_SOURCE) {
+ TclEnterCmdWordIndex (eclPtr,
+ envPtr->literalArrayPtr[objIndex].objPtr,
+ envPtr->codeNext - envPtr->codeStart,
+ wordIdx);
+ }
+#endif
}
TclEmitPush(objIndex, envPtr);
} else {
@@ -2459,6 +2488,24 @@ EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, wlines)
*wlines = wwlines;
eclPtr->nuloc ++;
}
+
+void
+TclEnterCmdWordIndex (eclPtr, obj, pc, word)
+ ExtCmdLoc *eclPtr;
+ Tcl_Obj* obj;
+ int pc;
+ int word;
+{
+ int new;
+ ExtIndex* eiPtr = (ExtIndex*) ckalloc (sizeof (ExtIndex));
+
+ eiPtr->pc = pc;
+ eiPtr->word = word;
+
+ Tcl_SetHashValue (Tcl_CreateHashEntry (&eclPtr->litIndex,
+ (char*) obj, &new),
+ eiPtr);
+}
#endif
/*