* generic/tclInt.h:

* generic/tclInt.decls:
* generic/tclCompile.c: Added TclSetByteCodeFromAny that takes a
hook procedure to invoke after compilation but before the byte
codes are emitted.  This makes it possible to do postprocessing on
the compiled byte codes before the ByteCode is generated.

* generic/tclLiteral.c: Added TclHideLiteral and TclAddLiteralObj
to make it possible to create local unshared literal objects.

1 files changed, 80 insertions, 31 deletions

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 12b6cd4..25803a0 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -10,7 +10,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.14 1999/04/16 00:46:44 stanton Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.15 1999/04/22 22:57:06 stanton Exp $
  */
 
 #include "tclInt.h"
@@ -255,13 +255,16 @@ Tcl_ObjType tclByteCodeType = {
 };
 
 /*
- *-----------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
- * SetByteCodeFromAny --
+ * TclSetByteCodeFromAny --
  *
  *	Part of the bytecode Tcl object type implementation. Attempts to
  *	generate an byte code internal form for the Tcl object "objPtr" by
- *	compiling its string representation.
+ *	compiling its string representation.  This function also takes
+ *	a hook procedure that will be invoked to perform any needed post
+ *	processing on the compilation results before generating byte
+ *	codes.
  *
  * Results:
  *	The return value is a standard Tcl object result. If an error occurs
@@ -277,11 +280,13 @@ Tcl_ObjType tclByteCodeType = {
  *----------------------------------------------------------------------
  */
 
-static int
-SetByteCodeFromAny(interp, objPtr)
+int
+TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
     Tcl_Interp *interp;		/* The interpreter for which the code is
 				 * being compiled.  Must not be NULL. */
     Tcl_Obj *objPtr;		/* The object to make a ByteCode object. */
+    CompileHookProc *hookProc;	/* Procedure to invoke after compilation. */
+    ClientData clientData;	/* Hook procedure private data. */
 {
     Interp *iPtr = (Interp *) interp;
     CompileEnv compEnv;		/* Compilation environment structure
@@ -309,6 +314,40 @@ SetByteCodeFromAny(interp, objPtr)
     string = Tcl_GetStringFromObj(objPtr, &length);
     TclInitCompileEnv(interp, &compEnv, string, length);
     result = TclCompileScript(interp, string, length, nested, &compEnv);
+
+    if (result == TCL_OK) {
+	/*
+	 * Successful compilation. Add a "done" instruction at the end.
+	 */
+
+	compEnv.numSrcBytes = iPtr->termOffset;
+	TclEmitOpcode(INST_DONE, &compEnv);
+
+	/*
+	 * Invoke the compilation hook procedure if one exists.
+	 */
+
+	if (hookProc) {
+	    result = (*hookProc)(interp, &compEnv, clientData);
+	}
+
+	/*
+	 * Change the object into a ByteCode object. Ownership of the literal
+	 * objects and aux data items is given to the ByteCode object.
+	 */
+    
+#ifdef TCL_COMPILE_DEBUG
+	TclVerifyLocalLiteralTable(&compEnv);
+#endif /*TCL_COMPILE_DEBUG*/
+
+	TclInitByteCodeObj(objPtr, &compEnv);
+#ifdef TCL_COMPILE_DEBUG
+	if (tclTraceCompile == 2) {
+	    TclPrintByteCodeObj(interp, objPtr);
+	}
+#endif /* TCL_COMPILE_DEBUG */
+    }
+	
     if (result != TCL_OK) {
 	/*
 	 * Compilation errors. 
@@ -330,36 +369,13 @@ SetByteCodeFromAny(interp, objPtr)
 	    }
 	    auxDataPtr++;
 	}
-	goto done;
     }
 
-    /*
-     * Successful compilation. Add a "done" instruction at the end.
-     */
-
-    compEnv.numSrcBytes = iPtr->termOffset;
-    TclEmitOpcode(INST_DONE, &compEnv);
-
-    /*
-     * Change the object into a ByteCode object. Ownership of the literal
-     * objects and aux data items is given to the ByteCode object.
-     */
-    
-#ifdef TCL_COMPILE_DEBUG
-    TclVerifyLocalLiteralTable(&compEnv);
-#endif /*TCL_COMPILE_DEBUG*/    
-    TclInitByteCodeObj(objPtr, &compEnv);
-#ifdef TCL_COMPILE_DEBUG
-    if (tclTraceCompile == 2) {
-	TclPrintByteCodeObj(interp, objPtr);
-    }
-#endif /* TCL_COMPILE_DEBUG */
 
     /*
      * Free storage allocated during compilation.
      */
     
-    done:
     if (localTablePtr->buckets != localTablePtr->staticBuckets) {
 	ckfree((char *) localTablePtr->buckets);
     }
@@ -368,6 +384,39 @@ SetByteCodeFromAny(interp, objPtr)
 }
 
 /*
+ *-----------------------------------------------------------------------
+ *
+ * SetByteCodeFromAny --
+ *
+ *	Part of the bytecode Tcl object type implementation. Attempts to
+ *	generate an byte code internal form for the Tcl object "objPtr" by
+ *	compiling its string representation.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during compilation, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	Frees the old internal representation. If no error occurs, then the
+ *	compiled code is stored as "objPtr"s bytecode representation.
+ *	Also, if debugging, initializes the "tcl_traceCompile" Tcl variable
+ *	used to trace compilations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetByteCodeFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* The interpreter for which the code is
+				 * being compiled.  Must not be NULL. */
+    Tcl_Obj *objPtr;		/* The object to make a ByteCode object. */
+{
+    return TclSetByteCodeFromAny(interp, objPtr,
+	    (CompileHookProc *) NULL, (ClientData) NULL);
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * DupByteCodeInternalRep --
@@ -923,7 +972,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
      */
     
     if (envPtr->codeNext == entryCodeNext) {
-	TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*alreadyAlloced*/ 0),
+	TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
 	        envPtr);
 	maxDepth = 1;
     }
@@ -1185,7 +1234,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
      */
     
     if (envPtr->codeNext == entryCodeNext) {
-	TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*alreadyAlloced*/ 0),
+	TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
 	        envPtr);
 	maxDepth = 1;
     }