summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.c
diff options
context:
space:
mode:
authorstanton <stanton>1999-04-22 22:57:06 (GMT)
committerstanton <stanton>1999-04-22 22:57:06 (GMT)
commit804bb2b478378a4c8bdf5426fc4f01fe8310d1f9 (patch)
tree7d3cbee11446913d235f80af0181bb20588351fc /generic/tclCompile.c
parenteeb2fba346c1470404ea5892db056f44d8decb22 (diff)
downloadtcl-804bb2b478378a4c8bdf5426fc4f01fe8310d1f9.zip
tcl-804bb2b478378a4c8bdf5426fc4f01fe8310d1f9.tar.gz
tcl-804bb2b478378a4c8bdf5426fc4f01fe8310d1f9.tar.bz2
* 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.
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r--generic/tclCompile.c111
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;
}