From 272c398b78060d7d8b575bb5aa652f37aa08d666 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 29 Apr 2016 17:52:30 +0000
Subject: Tease apart the bytecode creation machinery from the Tcl_Obj intrep
 machinery.

---
 generic/tclCompile.c | 92 ++++++++++++++++++++++++++++++++--------------------
 1 file changed, 57 insertions(+), 35 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 8665187..8837f06 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -2709,33 +2709,14 @@ TclCompileNoOp(
  *----------------------------------------------------------------------
  */
 
-void
-TclInitByteCodeObj(
-    Tcl_Obj *objPtr,		/* Points object that should be initialized,
-				 * and whose string rep contains the source
-				 * code. */
-    register CompileEnv *envPtr)/* Points to the CompileEnv structure from
-				 * which to create a ByteCode structure. */
+static void
+PreventCycle(
+    Tcl_Obj *objPtr,
+    CompileEnv *envPtr)
 {
-    register ByteCode *codePtr;
-    size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
-    size_t auxDataArrayBytes, structureSize;
-    register unsigned char *p;
-#ifdef TCL_COMPILE_DEBUG
-    unsigned char *nextPtr;
-#endif
-    int numLitObjects = envPtr->literalArrayNext;
-    Namespace *namespacePtr;
-    int i, isNew;
-    Interp *iPtr;
-
-    if (envPtr->iPtr == NULL) {
-	Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv");
-    }
-
-    iPtr = envPtr->iPtr;
+    int i;
 
-    for (i = 0;  i < numLitObjects;  i++) {
+    for (i = 0;  i < envPtr->literalArrayNext; i++) {
 	if (objPtr == TclFetchLiteral(envPtr, i)) {
 	    /*
 	     * Prevent circular reference where the bytecode intrep of
@@ -2753,11 +2734,36 @@ TclInitByteCodeObj(
 	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);
 
 	    Tcl_IncrRefCount(copyPtr);
-	    TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr);
+	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);
 
 	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
 	}
     }
+}
+
+static ByteCode *
+TclInitByteCode(
+    register CompileEnv *envPtr)/* Points to the CompileEnv structure from
+				 * which to create a ByteCode structure. */
+{
+    register ByteCode *codePtr;
+    size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
+    size_t auxDataArrayBytes, structureSize;
+    register unsigned char *p;
+#ifdef TCL_COMPILE_DEBUG
+    unsigned char *nextPtr;
+#endif
+    int numLitObjects = envPtr->literalArrayNext;
+    Namespace *namespacePtr;
+    int i, isNew;
+    Interp *iPtr;
+
+    if (envPtr->iPtr == NULL) {
+	Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv");
+    }
+
+    iPtr = envPtr->iPtr;
+
     codeBytes = envPtr->codeNext - envPtr->codeStart;
     objArrayBytes = envPtr->literalArrayNext * sizeof(Tcl_Obj *);
     exceptArrayBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange);
@@ -2857,15 +2863,6 @@ TclInitByteCodeObj(
 #endif /* TCL_COMPILE_STATS */
 
     /*
-     * Free the old internal rep then convert the object to a bytecode object
-     * by making its internal rep point to the just compiled ByteCode.
-     */
-
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
-    objPtr->typePtr = &tclByteCodeType;
-
-    /*
      * TIP #280. Associate the extended per-word line information with the
      * byte code object (internal rep), for use with the bc compiler.
      */
@@ -2878,6 +2875,31 @@ TclInitByteCodeObj(
     envPtr->iPtr = NULL;
 
     codePtr->localCachePtr = NULL;
+    return codePtr;
+}
+
+void
+TclInitByteCodeObj(
+    Tcl_Obj *objPtr,		/* Points object that should be initialized,
+				 * and whose string rep contains the source
+				 * code. */
+    register CompileEnv *envPtr)/* Points to the CompileEnv structure from
+				 * which to create a ByteCode structure. */
+{
+    ByteCode *codePtr;
+
+    PreventCycle(objPtr, envPtr);
+
+    codePtr = TclInitByteCode(envPtr);
+
+    /*
+     * Free the old internal rep then convert the object to a bytecode object
+     * by making its internal rep point to the just compiled ByteCode.
+     */
+
+    TclFreeIntRep(objPtr);
+    objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
+    objPtr->typePtr = &tclByteCodeType;
 }
 
 /*
-- 
cgit v0.12