summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2009-09-11 20:13:27 (GMT)
committerdgp <dgp@users.sourceforge.net>2009-09-11 20:13:27 (GMT)
commitc30ce8dcf495febef9d5111ae53ac2a614e593c1 (patch)
tree3752be5dcbdff1a044daf4602cb5e78552c4d52d /generic/tclCompile.c
parent8bfbb0cd8dbc0d85beef1db77403d7c60a39df65 (diff)
downloadtcl-c30ce8dcf495febef9d5111ae53ac2a614e593c1.zip
tcl-c30ce8dcf495febef9d5111ae53ac2a614e593c1.tar.gz
tcl-c30ce8dcf495febef9d5111ae53ac2a614e593c1.tar.bz2
* generic/tclBasic.c: Completed the NR-enabling of [subst].
* generic/tclCmdMZ.c: [Bug 2314561]. * generic/tclCompCmds.c: * generic/tclCompile.c: * generic/tclInt.h: * tests/coroutine.test: * tests/parse.test:
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r--generic/tclCompile.c156
1 files changed, 155 insertions, 1 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index b6b270b..3fa57db 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,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.173 2009/09/04 17:33:11 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.174 2009/09/11 20:13:27 dgp Exp $
*/
#include "tclInt.h"
@@ -413,6 +413,8 @@ InstructionDesc const tclInstructionTable[] = {
* Prototypes for procedures defined later in this file:
*/
+static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int flags);
static void DupByteCodeInternalRep(Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr);
static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr,
@@ -422,6 +424,7 @@ static void EnterCmdExtentData(CompileEnv *envPtr,
static void EnterCmdStartData(CompileEnv *envPtr,
int cmdNumber, int srcOffset, int codeOffset);
static void FreeByteCodeInternalRep(Tcl_Obj *objPtr);
+static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int GetCmdLocEncodingSize(CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void RecordByteCodeStats(ByteCode *codePtr);
@@ -453,6 +456,19 @@ const Tcl_ObjType tclByteCodeType = {
NULL, /* updateStringProc */
SetByteCodeFromAny /* setFromAnyProc */
};
+
+/*
+ * The structure below defines a bytecode Tcl object type to hold the
+ * compiled bytecode for the [subst]itution of Tcl values.
+ */
+
+static const Tcl_ObjType substCodeType = {
+ "substcode", /* name */
+ FreeSubstCodeInternalRep, /* freeIntRepProc */
+ DupByteCodeInternalRep, /* dupIntRepProc - shared with bytecode */
+ NULL, /* updateStringProc */
+ NULL, /* setFromAnyProc */
+};
/*
*----------------------------------------------------------------------
@@ -859,6 +875,144 @@ TclCleanupByteCode(
/*
*----------------------------------------------------------------------
*
+ * TclNRSubstObj --
+ *
+ * Request substitution of a Tcl value by the NR stack.
+ *
+ * Results:
+ * Returns TCL_OK.
+ *
+ * Side effects:
+ * Compiles objPtr into bytecode that performs the substitutions as
+ * governed by flags and places callbacks on the NR stack to execute
+ * the bytecode and store the result in the interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNRSubstObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ int flags)
+{
+ ByteCode *codePtr = CompileSubstObj(interp, objPtr, flags);
+
+ /* TODO: Confirm we do not need this. */
+ /* Tcl_ResetResult(interp); */
+ Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
+ NULL, NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileSubstObj --
+ *
+ * Compile a Tcl value into ByteCode implementing its substitution,
+ * as governed by flags.
+ *
+ * Results:
+ * A (ByteCode *) is returned pointing to the resulting ByteCode.
+ * The caller must manage its refCount and arrange for a call to
+ * TclCleanupByteCode() when the last reference disappears.
+ *
+ * Side effects:
+ * The Tcl_ObjType of objPtr is changed to the "substcode" type,
+ * and the ByteCode and governing flags value are kept in the internal
+ * rep for faster operations the next time CompileSubstObj is called
+ * on the same value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ByteCode *
+CompileSubstObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ int flags)
+{
+ Interp *iPtr = (Interp *) interp;
+ ByteCode *codePtr = NULL;
+
+ if (objPtr->typePtr == &substCodeType) {
+ Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
+
+ codePtr = (ByteCode *) objPtr->internalRep.ptrAndLongRep.ptr;
+ if (flags != objPtr->internalRep.ptrAndLongRep.value
+ || ((Interp *) *codePtr->interpHandle != iPtr)
+ || (codePtr->compileEpoch != iPtr->compileEpoch)
+ || (codePtr->nsPtr != nsPtr)
+ || (codePtr->nsEpoch != nsPtr->resolverEpoch)
+ || (codePtr->localCachePtr !=
+ iPtr->varFramePtr->localCachePtr)) {
+ FreeSubstCodeInternalRep(objPtr);
+ }
+ }
+ if (objPtr->typePtr != &substCodeType) {
+ CompileEnv compEnv;
+ int numBytes;
+ const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
+
+ /* TODO: Check for more TIP 280 */
+ TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);
+
+ TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);
+
+ TclEmitOpcode(INST_DONE, &compEnv);
+ TclInitByteCodeObj(objPtr, &compEnv);
+ objPtr->typePtr = &substCodeType;
+ TclFreeCompileEnv(&compEnv);
+ codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ objPtr->internalRep.ptrAndLongRep.ptr = codePtr;
+ objPtr->internalRep.ptrAndLongRep.value = flags;
+ if (iPtr->varFramePtr->localCachePtr) {
+ codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+ codePtr->localCachePtr->refCount++;
+ }
+ /* TODO: Debug printing? */
+ }
+ return codePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeSubstCodeInternalRep --
+ *
+ * Part of the substcode Tcl object type implementation. Frees the storage
+ * associated with a substcode object's internal representation unless its
+ * code is actively being executed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The substcode object's internal rep is marked invalid and its code gets
+ * freed unless the code is actively being executed. In that case the
+ * cleanup is delayed until the last execution of the code completes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeSubstCodeInternalRep(
+ register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
+{
+ register ByteCode *codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
+
+ codePtr->refCount--;
+ if (codePtr->refCount <= 0) {
+ TclCleanupByteCode(codePtr);
+ }
+ objPtr->typePtr = NULL;
+ objPtr->internalRep.otherValuePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclInitCompileEnv --
*
* Initializes a CompileEnv compilation environment structure for the