diff options
Diffstat (limited to 'generic/tclCompile.c')
| -rw-r--r-- | generic/tclCompile.c | 111 |
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; } |