new ICL mechanism (TIP 280+530 replacement) v3, partial string segments back-port

generic/tcl.h

@@ -469,6 +469,10 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 #else
     typedef struct stat Tcl_StatBuf;
 #endif
+
+#ifndef TCL_HASH_TYPE
+#  define TCL_HASH_TYPE unsigned
+#endif
 
 /*
  *----------------------------------------------------------------------------

generic/tclAssembly.c

@@ -279,7 +279,6 @@ static int		CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
 static int		FindLocalVar(AssemblyEnv* envPtr,
 			    Tcl_Token** tokenPtrPtr);
 static int		FinishAssembly(AssemblyEnv*);
-static void		FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
 static void		FreeAssemblyEnv(AssemblyEnv*);
 static int		GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
 static int		GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
@@ -319,7 +318,7 @@ static void		UnstackExpiredCatches(CompileEnv*, BasicBlock*, int,
 
 static const Tcl_ObjType assembleCodeType = {
     "assemblecode",
-    FreeAssembleCodeInternalRep, /* freeIntRepProc */
+    TclFreeByteCodeInternalRep,  /* freeIntRepProc */
     DupAssembleCodeInternalRep,	 /* dupIntRepProc */
     NULL,			 /* updateStringProc */
     NULL			 /* setFromAnyProc */
@@ -847,8 +846,11 @@ CompileAssembleObj(
     int status;			/* Status return from Tcl_AssembleCode */
     const char* source;		/* String representation of the source code */
     int sourceLen;		/* Length of the source code in bytes */
+    StringSegment *strSegPtr;
 
 
+    source = Tcl_GetUtfFromObj(objPtr, &sourceLen);
+
     /*
      * Get the expression ByteCode from the object. If it exists, make sure it
      * is valid in the current context.
@@ -867,18 +869,23 @@ CompileAssembleObj(
 	}
 
 	/*
-	 * Not valid, so free it and regenerate.
+	 * Not valid, so obtain string segment, free code and regenerate.
 	 */
 
-	FreeAssembleCodeInternalRep(objPtr);
+	strSegPtr = codePtr->strSegPtr;
+	strSegPtr->refCount++;
+	TclInvalidateByteCodeInternalRep(objPtr);
+    } else {
+	strSegPtr = TclGetStringSegmentFromObj(objPtr, 0);
+	strSegPtr->refCount++;
     }
 
     /*
      * Set up the compilation environment, and assemble the code.
      */
 
-    source = TclGetStringFromObj(objPtr, &sourceLen);
     TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
+    compEnv.strSegPtr = strSegPtr;
     status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
     if (status != TCL_OK) {
 	/*
@@ -4312,37 +4319,6 @@ DupAssembleCodeInternalRep(
     return;
 }
 
-/*
- *-----------------------------------------------------------------------------
- *
- * FreeAssembleCodeInternalRep --
- *
- *	Part of the Tcl object type implementation for Tcl expression
- *	bytecode. Frees the storage allocated to hold the internal rep, unless
- *	ref counts indicate bytecode execution is still in progress.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	May free allocated memory. Leaves objPtr untyped.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-FreeAssembleCodeInternalRep(
-    Tcl_Obj *objPtr)
-{
-    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
-
-    codePtr->refCount--;
-    if (codePtr->refCount <= 0) {
-	TclCleanupByteCode(codePtr);
-    }
-    objPtr->typePtr = NULL;
-}
-
 /*
  * Local Variables:
  * mode: c

generic/tclBasic.c

@@ -540,12 +540,8 @@ Tcl_CreateInterp(void)
      */
 
     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;
@@ -1388,7 +1384,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,
@@ -1587,58 +1582,6 @@ 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);
-	}
-
-	ckfree(eclPtr);
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    Tcl_DeleteHashTable(iPtr->lineBCPtr);
-    ckfree(iPtr->lineBCPtr);
-    iPtr->lineBCPtr = NULL;
-
     /*
      * Location stack for uplevel/eval/... scripts which were passed through
      * proc arguments. Actually we track all arguments as we do not and cannot
@@ -5719,19 +5662,17 @@ TclArgumentBCEnter(
     int cmd,
     int pc)
 {
-    ExtCmdLoc *eclPtr;
+    BCExtLineInfo *bcLI;
     int word;
     ECL *ePtr;
     CFWordBC *lastPtr = NULL;
     Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hePtr =
-	    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
 
-    if (!hePtr) {
+    bcLI = TclByteCodeGetELI((ByteCode *)codePtr);
+    if (!bcLI || !bcLI->eclPtr) {
 	return;
     }
-    eclPtr = Tcl_GetHashValue(hePtr);
-    ePtr = &eclPtr->loc[cmd];
+    ePtr = &bcLI->eclPtr->loc[cmd];
 
     /*
      * ePtr->nline is the number of words originally parsed.
@@ -5887,7 +5828,7 @@ TclArgumentGet(
      * up by the caller. It knows better than us.
      */
 
-    if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) {
+    if (!Tcl_ObjHasBytes(obj) || TclListObjIsCanonical(obj)) {
 	return;
     }
 

generic/tclCmdMZ.c

@@ -5455,27 +5455,28 @@ TclNRWhileObjCmd(
  *
  * TclListLines --
  *
- *	???
+ *	Retrieve line(s) inside of given listObj from its source considering
+ *	continuations.
  *
  * Results:
- *	Filled in array of line numbers?
+ *	Last line found, filled in array of line numbers if not NULL.
  *
  * Side effects:
  *	None.
  *
  *----------------------------------------------------------------------
  */
 
-void
+int
 TclListLines(
     Tcl_Obj *listObj,		/* Pointer to obj holding a string with list
 				 * structure. Assumed to be valid. Assumed to
 				 * contain n elements. */
     int line,			/* Line the list as a whole starts on. */
     int n,			/* #elements in lines */
-    int *lines,			/* Array of line numbers, to fill. */
+    int *lines,			/* Array of line numbers, to fill (or NULL). */
     Tcl_Obj *const *elems)      /* The list elems as Tcl_Obj*, in need of
-				 * derived continuation data */
+				 * derived continuation data (or NULL) */
 {
     const char *listStr = Tcl_GetString(listObj);
     const char *listHead = listStr;
@@ -5484,26 +5485,27 @@ TclListLines(
     ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
     int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
 
-    for (i = 0; i < n; i++) {
+    n--;
+    for (i = 0; i <= n; i++) {
 	TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
 
-	TclAdvanceLines(&line, listStr, element);
-				/* Leading whitespace */
+	TclAdvanceLines(&line, listStr, element);    /* Leading whitespace */
 	TclAdvanceContinuations(&line, &clNext, element - listHead);
 	if (elems && clNext) {
 	    TclContinuationsEnterDerived(elems[i], element-listHead, clNext);
 	}
-	lines[i] = line;
-	length -= (next - listStr);
-	TclAdvanceLines(&line, element, next);
-				/* Element */
-	listStr = next;
-
-	if (*element == 0) {
+	if (lines) {
+	    lines[i] = line;
+	}
+	if (*element == 0 || i == n) {
 	    /* ASSERT i == n */
 	    break;
 	}
+	length -= (next - listStr);
+	TclAdvanceLines(&line, element, next);	    /* Element */
+	listStr = next;
     }
+    return line;
 }
 
 /*