Cleaning up some of the internals of TIP #280.novem_ak_iframe_direct

Replaced the hashtables keyed by pointers to Proc and ByteCode
structures and providing associated information with fields in the
structures, direct pointers to the information. The change makes the
information accessible through a single pointer dereference instead of
a hashtable search.

Some information (Tcl_Obj* related) could not be inlined in this way
and likely requires a larger reworking of parser and script
structures.

8 files changed, 66 insertions, 163 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7202184..d41f38e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -504,17 +504,12 @@ Tcl_CreateInterp(void)
     iPtr->varFramePtr = NULL;	/* Initialise as soon as :: is available */
 
     /*
-     * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc
-     * structures.
+     * TIP #280 - Initialize the arrays used to track argument locations.
      */
 
     iPtr->cmdFramePtr = NULL;
-    iPtr->linePBodyPtr = ckalloc(sizeof(Tcl_HashTable));
-    iPtr->lineBCPtr = ckalloc(sizeof(Tcl_HashTable));
     iPtr->lineLAPtr = ckalloc(sizeof(Tcl_HashTable));
     iPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable));
-    Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
-    Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
     Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
     Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
     iPtr->scriptCLLocPtr = NULL;
@@ -1323,7 +1318,6 @@ DeleteInterpProc(
     Tcl_HashSearch search;
     Tcl_HashTable *hTablePtr;
     ResolverScheme *resPtr, *nextResPtr;
-    int i;
 
     /*
      * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup,
@@ -1518,60 +1512,7 @@ DeleteInterpProc(
     TclDeleteLiteralTable(interp, &iPtr->literalTable);
 
     /*
-     * TIP #280 - Release the arrays for ByteCode/Proc extension, and
-     * contents.
-     */
-
-    for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search);
-	    hPtr != NULL;
-	    hPtr = Tcl_NextHashEntry(&search)) {
-	CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
-	Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);
-
-	procPtr->iPtr = NULL;
-	if (cfPtr) {
-	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
-		Tcl_DecrRefCount(cfPtr->data.eval.path);
-	    }
-	    ckfree(cfPtr->line);
-	    ckfree(cfPtr);
-	}
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    Tcl_DeleteHashTable(iPtr->linePBodyPtr);
-    ckfree(iPtr->linePBodyPtr);
-    iPtr->linePBodyPtr = NULL;
-
-    /*
-     * See also tclCompile.c, TclCleanupByteCode
-     */
-
-    for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
-	    hPtr != NULL;
-	    hPtr = Tcl_NextHashEntry(&search)) {
-	ExtCmdLoc *eclPtr = Tcl_GetHashValue(hPtr);
-
-	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);
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    Tcl_DeleteHashTable(iPtr->lineBCPtr);
-    ckfree(iPtr->lineBCPtr);
-    iPtr->lineBCPtr = NULL;
-
-    /*
+     * TIP #280.
      * Location stack for uplevel/eval/... scripts which were passed through
      * proc arguments. Actually we track all arguments as we do not and cannot
      * know which arguments will be used as scripts and which will not.
@@ -5141,19 +5082,20 @@ TclArgumentBCEnter(
     Tcl_Interp *interp,
     Tcl_Obj *objv[],
     int objc,
-    void *codePtr,
+    void *codePtr, /* XXX Should be ByteCode*, would invoke cyclic dependency
+                    * XXX on tclCompile.h in tclInt.h
+                    */
     CmdFrame *cfPtr,
     int pc)
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hePtr =
-	    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
+    Tcl_HashEntry* hePtr;
     ExtCmdLoc *eclPtr;
 
-    if (!hePtr) {
-	return;
+    eclPtr = ((ByteCode*) codePtr)->loc;
+    if (!eclPtr) {
+        return;
     }
-    eclPtr = Tcl_GetHashValue(hePtr);
     hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc));
     if (hePtr) {
 	int word;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 309682d..c2d99ec 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -982,29 +982,24 @@ TclCleanupByteCode(
      * See also tclBasic.c, DeleteInterpProc
      */
 
-    if (iPtr) {
-	Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
-		(char *) codePtr);
+    if (codePtr->loc) {
+	ExtCmdLoc *eclPtr = codePtr->loc;
 
-	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);
-	    }
+	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);
+	Tcl_DeleteHashTable(&eclPtr->litInfo);
 
-	    ckfree(eclPtr);
-	    Tcl_DeleteHashEntry(hePtr);
-	}
+	ckfree(eclPtr);
+	codePtr->loc = 0;
     }
 
     if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
@@ -2506,7 +2501,7 @@ TclInitByteCodeObj(
 #endif
     int numLitObjects = envPtr->literalArrayNext;
     Namespace *namespacePtr;
-    int i, isNew;
+    int i;
     Interp *iPtr;
 
     iPtr = envPtr->iPtr;
@@ -2642,8 +2637,7 @@ TclInitByteCodeObj(
      * byte code object (internal rep), for use with the bc compiler.
      */
 
-    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr,
-	    &isNew), envPtr->extCmdMapPtr);
+    codePtr->loc = envPtr->extCmdMapPtr;
     envPtr->extCmdMapPtr = NULL;
 
     codePtr->localCachePtr = NULL;
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 3302f9b..e6350f3 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -119,10 +119,9 @@ typedef struct CmdLocation {
  * Structure to record additional location information for byte code. This
  * information is internal and not saved. i.e. tbcload'ed code will not have
  * this information. It records the lines for all words of all commands found
- * in the byte code. The association with a ByteCode structure BC is done
- * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
- * Also recorded is information coming from the context, i.e. type of the
- * frame and associated information, like the path of a sourced file.
+ * in the byte code. See the ByteCode->loc field. Also recorded is information
+ * coming from the context, i.e. type of the frame and associated information,
+ * like the path of a sourced file.
  */
 
 typedef struct ECL {
@@ -131,8 +130,7 @@ typedef struct ECL {
     int *line;			/* Line information for all words in the
 				 * command. */
     int **next;			/* Transient information used by the compiler
-				 * for tracking of hidden continuation
-				 * lines. */
+				 * to track hidden continuation lines. */
 } ECL;
 
 typedef struct ExtCmdLoc {
@@ -441,6 +439,9 @@ typedef struct ByteCode {
     LocalCache *localCachePtr;	/* Pointer to the start of the cached variable
 				 * names and initialisation data for local
 				 * variables. */
+
+    struct ExtCmdLoc* loc; /* #280 location data */
+
 #ifdef TCL_COMPILE_STATS
     Tcl_Time createTime;	/* Absolute time when the ByteCode was
 				 * created. */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index cb1864c40..9ab7054 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1640,17 +1640,14 @@ TclCompileObj(
 	if (invoker == NULL) {
 	    return codePtr;
 	} else {
-	    Tcl_HashEntry *hePtr =
-		    Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
-	    ExtCmdLoc *eclPtr;
+	    ExtCmdLoc *eclPtr = codePtr->loc;
 	    CmdFrame *ctxCopyPtr;
 	    int redo;
 
-	    if (!hePtr) {
+	    if (!eclPtr) {
 		return codePtr;
 	    }
 
-	    eclPtr = Tcl_GetHashValue(hePtr);
 	    redo = 0;
 	    ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
 	    *ctxCopyPtr = *invoker;
@@ -8505,19 +8502,15 @@ TclGetSrcInfoForPc(
 	 * there find the list of word locations for this command.
 	 */
 
-	ExtCmdLoc *eclPtr;
+	ExtCmdLoc *eclPtr = codePtr->loc;
 	ECL *locPtr = NULL;
 	int srcOffset, i;
-	Interp *iPtr = (Interp *) *codePtr->interpHandle;
-	Tcl_HashEntry *hePtr =
-		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
 
-	if (!hePtr) {
+	if (!eclPtr) {
 	    return;
 	}
 
 	srcOffset = cfPtr->cmd.str.cmd - codePtr->source;
-	eclPtr = Tcl_GetHashValue(hePtr);
 
 	for (i=0; i < eclPtr->nuloc; i++) {
 	    if (eclPtr->loc[i].srcOffset == srcOffset) {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 0efb1b6..f88c53f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -969,6 +969,8 @@ typedef struct CompiledLocal {
  * variables recognized at compile time.
  */
 
+struct CmdFrame; /* Forward declaration for Proc. */
+
 typedef struct Proc {
     struct Interp *iPtr;	/* Interpreter for which this command is
 				 * defined. */
@@ -996,6 +998,8 @@ typedef struct Proc {
     CompiledLocal *lastLocalPtr;/* Pointer to the last allocated local
 				 * variable or NULL if none. This has frame
 				 * index (numCompiledLocals-1). */
+
+    struct CmdFrame* loc; /* #280 location data */
 } Proc;
 
 /*
@@ -1251,7 +1255,7 @@ typedef struct CmdFrame {
 				 * was pushed. */
     const struct CFWordBC *litarg;
 				/* Link to set of literal arguments which have
-				 * ben pushed on the lineLABCPtr stack by
+				 * been pushed on the lineLABCPtr stack by
 				 * TclArgumentBCEnter(). These will be removed
 				 * by TclArgumentBCRelease. */
 } CmdFrame;
@@ -2033,17 +2037,10 @@ typedef struct Interp {
 				 * active. */
     int invokeWord;		/* Index of the word in the command which
 				 * is getting compiled. */
-    Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically
-				 * defined procedure the location information
-				 * for its body. It is keyed by the address of
-				 * the Proc structure for a procedure. The
-				 * values are "struct CmdFrame*". */
-    Tcl_HashTable *lineBCPtr;	/* This table remembers for each ByteCode
-				 * object the location information for its
-				 * body. It is keyed by the address of the
-				 * Proc structure for a procedure. The values
-				 * are "struct ExtCmdLoc*". (See
-				 * tclCompile.h) */
+
+    /* XXX: Adding the line information to Tcl_Obj will blow up the memory used by the system.
+     * XXX: But might be faster. Any other way getting both?
+     */
     Tcl_HashTable *lineLABCPtr;
     Tcl_HashTable *lineLAPtr;	/* This table remembers for each argument of a
 				 * command on the execution stack the index of
@@ -2856,6 +2853,9 @@ MODULE_SCOPE void	TclArgumentRelease(Tcl_Interp *interp,
 MODULE_SCOPE void	TclArgumentBCEnter(Tcl_Interp *interp,
 			    Tcl_Obj *objv[], int objc,
 			    void *codePtr, CmdFrame *cfPtr, int pc);
+/* XXX (void* codePtr) breaks cyclic dependency on tclCompile.h.
+ * XXX Proper type is (ByteCode* codePtr)
+ */
 MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
 			    CmdFrame *cfPtr);
 MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 28820e0..e84e04f 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -498,9 +498,7 @@ TclOOMakeProcInstanceMethod(
 
 	    if (context.line
 		    && (context.nline >= 4) && (context.line[3] >= 0)) {
-		int isNew;
 		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
-		Tcl_HashEntry *hPtr;
 
 		cfPtr->level = -1;
 		cfPtr->type = context.type;
@@ -516,9 +514,7 @@ TclOOMakeProcInstanceMethod(
 		cfPtr->cmd.str.cmd = NULL;
 		cfPtr->cmd.str.len = 0;
 
-		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			(char *) procPtr, &isNew);
-		Tcl_SetHashValue(hPtr, cfPtr);
+		procPtr->loc = cfPtr;
 	    }
 
 	    /*
@@ -611,9 +607,7 @@ TclOOMakeProcMethod(
 
 	    if (context.line
 		    && (context.nline >= 4) && (context.line[3] >= 0)) {
-		int isNew;
 		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
-		Tcl_HashEntry *hPtr;
 
 		cfPtr->level = -1;
 		cfPtr->type = context.type;
@@ -629,9 +623,7 @@ TclOOMakeProcMethod(
 		cfPtr->cmd.str.cmd = NULL;
 		cfPtr->cmd.str.len = 0;
 
-		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			(char *) procPtr, &isNew);
-		Tcl_SetHashValue(hPtr, cfPtr);
+		procPtr->loc = cfPtr;
 	    }
 
 	    /*
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 933e7d2..8c79396 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -256,8 +256,6 @@ Tcl_ProcObjCmd(
 
 	    if (contextPtr->line
 		    && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
-		int isNew;
-		Tcl_HashEntry *hePtr;
 		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
 
 		cfPtr->level = -1;
@@ -274,9 +272,7 @@ Tcl_ProcObjCmd(
 		cfPtr->cmd.str.cmd = NULL;
 		cfPtr->cmd.str.len = 0;
 
-		hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			procPtr, &isNew);
-		if (!isNew) {
+		if (procPtr->loc) {
 		    /*
 		     * Get the old command frame and release it. See also
 		     * TclProcCleanupProc in this file. Currently it seems as
@@ -284,8 +280,7 @@ Tcl_ProcObjCmd(
 		     * is able to trigger this situation.
 		     */
 
-		    CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr);
-
+		    CmdFrame *cfOldPtr = procPtr->loc;
 		    if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
 			Tcl_DecrRefCount(cfOldPtr->data.eval.path);
 			cfOldPtr->data.eval.path = NULL;
@@ -294,7 +289,7 @@ Tcl_ProcObjCmd(
 		    cfOldPtr->line = NULL;
 		    ckfree(cfOldPtr);
 		}
-		Tcl_SetHashValue(hePtr, cfPtr);
+		procPtr->loc = cfPtr;
 	    }
 
 	    /*
@@ -472,6 +467,7 @@ TclCreateProc(
 	procPtr->numCompiledLocals = 0;
 	procPtr->firstLocalPtr = NULL;
 	procPtr->lastLocalPtr = NULL;
+	procPtr->loc = 0;
     }
 
     /*
@@ -2015,8 +2011,6 @@ TclProcCompileProc(
     }
 
     if (bodyPtr->typePtr != &tclByteCodeType) {
-	Tcl_HashEntry *hePtr;
-
 #ifdef TCL_COMPILE_DEBUG
 	if (tclTraceCompile >= 1) {
 	    /*
@@ -2084,17 +2078,15 @@ TclProcCompileProc(
 
 	/*
 	 * TIP #280: We get the invoking context from the cmdFrame which
-	 * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
+	 * was saved by 'Tcl_ProcObjCmd'
 	 */
 
-	hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
-
 	/*
 	 * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
 	 */
 
 	iPtr->invokeWord = 0;
-	iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL);
+	iPtr->invokeCmdFramePtr = (procPtr->loc ? procPtr->loc : NULL);
 	tclByteCodeType.setFromAnyProc(interp, bodyPtr);
 	iPtr->invokeCmdFramePtr = NULL;
 	TclPopStackFrame(interp);
@@ -2202,9 +2194,7 @@ TclProcCleanupProc(
     Tcl_Obj *bodyPtr = procPtr->bodyPtr;
     Tcl_Obj *defPtr;
     Tcl_ResolvedVarInfo *resVarInfo;
-    Tcl_HashEntry *hePtr = NULL;
     CmdFrame *cfPtr = NULL;
-    Interp *iPtr = procPtr->iPtr;
 
     if (bodyPtr != NULL) {
 	Tcl_DecrRefCount(bodyPtr);
@@ -2228,25 +2218,14 @@ TclProcCleanupProc(
 	ckfree(localPtr);
 	localPtr = nextPtr;
     }
-    ckfree(procPtr);
 
     /*
      * TIP #280: Release the location data associated with this Proc
-     * structure, if any. The interpreter may not exist (For example for
-     * procbody structures created by tbcload.
+     * structure, if any. The data may not exist (For example for procbody
+     * structures created by tbcload.
      */
 
-    if (iPtr == NULL) {
-	return;
-    }
-
-    hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
-    if (!hePtr) {
-	return;
-    }
-
-    cfPtr = Tcl_GetHashValue(hePtr);
-
+    cfPtr = procPtr->loc;
     if (cfPtr) {
 	if (cfPtr->type == TCL_LOCATION_SOURCE) {
 	    Tcl_DecrRefCount(cfPtr->data.eval.path);
@@ -2256,7 +2235,8 @@ TclProcCleanupProc(
 	cfPtr->line = NULL;
 	ckfree(cfPtr);
     }
-    Tcl_DeleteHashEntry(hePtr);
+
+    ckfree(procPtr);
 }
 
 /*
@@ -2487,7 +2467,7 @@ SetLambdaFromAny(
     Interp *iPtr = (Interp *) interp;
     const char *name;
     Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
-    int isNew, objc, result;
+    int objc, result;
     CmdFrame *cfPtr = NULL;
     Proc *procPtr;
 
@@ -2617,8 +2597,8 @@ SetLambdaFromAny(
 	}
 	TclStackFree(interp, contextPtr);
     }
-    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr,
-	    &isNew), cfPtr);
+
+    procPtr->loc = cfPtr;
 
     /*
      * Set the namespace for this lambda: given by objv[2] understood as a
diff --git a/tests/proc.test b/tests/proc.test
index e06720e..97f4ab0 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -308,6 +308,7 @@ test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -set
 	set tmp $end
 	set end [getbytes]
     }
+    memory active a-$i
     set leakedBytes [expr {$end - $tmp}]
 } -cleanup {
     rename getbytes {}