summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c239
1 files changed, 113 insertions, 126 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 7b9ae49..6243266 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.382 2008/07/18 23:29:43 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.383 2008/07/21 03:43:30 msofer Exp $
*/
#include "tclInt.h"
@@ -25,9 +25,6 @@
#include <math.h>
#include <float.h>
-static Tcl_NRPostProc TailcallFromTebc;
-
-
/*
* Hack to determine whether we may expect IEEE floating point. The hack is
* formally incorrect in that non-IEEE platforms might have the same precision
@@ -1757,10 +1754,6 @@ TclExecuteByteCode(
BottomData *bottomPtr;
#if USE_NR_TEBC
BottomData *oldBottomPtr = NULL;
-
- /* for tailcall support */
- Namespace *lookupNsPtr = NULL;
- Tcl_Obj *tailObjPtr = NULL;
#endif
/*
@@ -1800,7 +1793,10 @@ TclExecuteByteCode(
register int cleanup;
Tcl_Obj *objResultPtr;
-
+ int evalFlags = TCL_EVAL_NOERR;
+#if (USE_NR_TEBC)
+ int tailcall = 0;
+#endif
/*
* Result variable - needed only when going to checkForcatch or other
* error handlers; also used as local in some opcodes.
@@ -1880,24 +1876,9 @@ TclExecuteByteCode(
bcFramePtr->data.tebc.pc = NULL;
bcFramePtr->cmd.str.cmd = NULL;
bcFramePtr->cmd.str.len = 0;
-#if USE_NR_TEBC
- } else if (tailObjPtr) {
- /*
- * A request to perform a tailcall; a frame has already been dropped,
- * so we just have to ...
- * (Note that we already have a refcount for tailObjPtr!)
- */
-
- *++tosPtr = tailObjPtr;
- tailObjPtr = NULL;
- iPtr->lookupNsPtr = lookupNsPtr;
- lookupNsPtr = NULL;
-
- /*
- * Fake pc, INST_EVAL STK will fix this and resume properly
- */
- pc--;
- goto tailCallEntryPoint;
+#if (USE_NR_TEBC)
+ } else if (tailcall) {
+ goto tailcallEntry;
#endif
} else {
/*
@@ -2497,7 +2478,11 @@ TclExecuteByteCode(
int objc, pcAdjustment;
Tcl_Obj **objv;
-
+#if (USE_NR_TEBC)
+ TEOV_record *recordPtr;
+ ByteCode *newCodePtr;
+#endif
+
case INST_EXPR_STK: {
/*
* Moved here to support transforming the eval of an expression to
@@ -2505,13 +2490,12 @@ TclExecuteByteCode(
*/
#if (USE_NR_TEBC)
-
pcAdjustment = 1;
cleanup = 1;
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
DECACHE_STACK_INFO();
- TEBC_DATA(iPtr) = CompileExprObj(interp, OBJ_AT_TOS);
+ newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
CACHE_STACK_INFO();
goto tebc_do_exec;
#else
@@ -2536,8 +2520,28 @@ TclExecuteByteCode(
#endif
}
+#if (USE_NR_TEBC)
+ tailcallEntry: {
+ TEOV_record *recordPtr = TOP_RECORD(iPtr);
- tailCallEntryPoint:
+ /*
+ * We take over the record's object, with its refCount. Clear the
+ * record type so that it is not freed again when popping the
+ * record.
+ */
+
+ recordPtr->type = TCL_NR_NO_TYPE;
+ *++tosPtr = recordPtr->data.obj.objPtr;
+ evalFlags = recordPtr->data.obj.flags;
+ recordPtr->type = TCL_NR_NO_TYPE;
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ fprintf(stdout, " Tailcall: pushing obj with refCount %i\n",
+ (OBJ_AT_TOS)->refCount);
+ }
+#endif
+ }
+#endif
case INST_EVAL_STK: {
/*
* Moved here to support transforming the eval of objects to a
@@ -2546,16 +2550,25 @@ TclExecuteByteCode(
*/
Tcl_Obj *objPtr = OBJ_AT_TOS;
- ByteCode *newCodePtr;
- pcAdjustment = 1;
cleanup = 1;
-
+ pcAdjustment = !tailcall;
+ tailcall = 0;
+
if (objPtr->typePtr == &tclListType) { /* is a list... */
List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_Obj *copyPtr;
if (objPtr->bytes == NULL || /* ...without a string rep */
- listRepPtr->canonicalFlag) {/* ...or that is canonical */
+ listRepPtr->canonicalFlag) {/* ...or that is canonical
+ * */
+ if (Tcl_IsShared(objPtr)) {
+ copyPtr = TclListObjCopy(interp, objPtr);
+ Tcl_IncrRefCount(copyPtr);
+ OBJ_AT_TOS = copyPtr;
+ listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_DecrRefCount(objPtr);
+ }
objc = listRepPtr->elemCount;
objv = &listRepPtr->elements;
goto doInvocationFromEval;
@@ -2576,8 +2589,7 @@ TclExecuteByteCode(
*/
#if (USE_NR_TEBC)
bcFramePtr->data.tebc.pc = (char *) pc;
- iPtr->cmdFramePtr = bcFramePtr;
- TEBC_DATA(iPtr) = newCodePtr;
+ iPtr->cmdFramePtr = bcFramePtr;
goto tebc_do_exec;
#else
result = TclExecuteByteCode(interp, newCodePtr);
@@ -2692,49 +2704,50 @@ TclExecuteByteCode(
DECACHE_STACK_INFO();
+#if (USE_NR_TEBC)
TEBC_CALL(iPtr) = 1;
- result = Tcl_EvalObjv(interp, objc, objv, TCL_EVAL_NOERR);
+ recordPtr = TOP_RECORD(iPtr);
+#endif
+ result = Tcl_EvalObjv(interp, objc, objv, evalFlags);
CACHE_STACK_INFO();
#if (USE_NR_TEBC)
- switch (TEBC_CALL(iPtr)) {
- case TEBC_DO_EXEC: {
+ evalFlags = TCL_EVAL_NOERR;
+ if (TOP_RECORD(iPtr) != recordPtr) {
+ assert((result == TCL_OK));
+ recordPtr = TOP_RECORD(iPtr);
+ switch(recordPtr->type) {
+ case TCL_NR_BC_TYPE:
+ newCodePtr = recordPtr->data.codePtr;
tebc_do_exec:
/*
* A request to execute a bytecode came back. We save
* the current state and restart at the top.
*/
- assert((result == TCL_OK));
- TEBC_CALL(iPtr) = 0;
+
pc += pcAdjustment;
NR_DATA_BURY(); /* this level's state variables */
- codePtr = TEBC_DATA(iPtr);
- result = TCL_OK;
+ codePtr = newCodePtr;
goto nonRecursiveCallStart;
- }
- case TEBC_DO_TAILCALL: {
+ case TCL_NR_TAILCALL_TYPE:
/*
- * A request to perform a tailcall: save the current
- * namespace, drop a frame and eval the passed listObj
- * in the previous frame while looking up the command
- * in the current namespace. Read it again.
- *
- * We take over tailObjPtr's refcount!
+ * A request to perform a tailcall: just drop this
+ * bytecode as it is; the tailCall has been scheduled in
+ * the callbacks.
*/
-
- assert((result == TCL_OK));
- TEBC_CALL(iPtr) = 0;
- tailObjPtr = TEBC_DATA(iPtr);
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ fprintf(stdout, " Tailcall: request received\n");
+ }
+#endif
if (catchTop != initCatchTop) {
result = TCL_ERROR;
Tcl_SetResult(interp,"Tailcall called from within a catch environment",
TCL_STATIC);
- Tcl_DecrRefCount(tailObjPtr);
- tailObjPtr = NULL;
goto checkForCatch;
}
- lookupNsPtr = iPtr->varFramePtr->nsPtr;
- result = TCL_OK;
goto abnormalReturn; /* drop a level */
+ default:
+ Tcl_Panic("TEBC: TEOV sent us a record we cannot handle!");
}
}
#endif
@@ -2742,7 +2755,6 @@ TclExecuteByteCode(
if (result == TCL_OK) {
Tcl_Obj *objPtr;
-
#ifndef TCL_COMPILE_DEBUG
if (*(pc+pcAdjustment) == INST_POP) {
NEXT_INST_V((pcAdjustment+1), cleanup, 0);
@@ -7760,14 +7772,49 @@ TclExecuteByteCode(
*
* NR_TEBC
*/
-
bottomPtr = oldBottomPtr; /* back to old bc */
/* Please free anything that might still be on my new stack */
- result = TclEvalObjv_NR2(interp, result, bottomPtr->recordPtr);
- assert((TOP_RECORD(iPtr) == bottomPtr->recordPtr));
-
- /* restore state variables */
+ if (TOP_RECORD(iPtr) != bottomPtr->recordPtr) {
+ CACHE_STACK_INFO();
+ result = TclEvalObjv_NR2(interp, result, bottomPtr->recordPtr);
+ if (TOP_RECORD(iPtr) != bottomPtr->recordPtr) {
+ TEOV_record *recordPtr = TOP_RECORD(iPtr);
+
+ assert((result == TCL_OK));
+
+ /*
+ * A callback scheduled a new evaluation: process it.
+ */
+
+ switch(recordPtr->type) {
+ case TCL_NR_BC_TYPE:
+ codePtr = recordPtr->data.codePtr;
+ goto nonRecursiveCallStart;
+ case TCL_NR_TAILCALL_TYPE:
+ /* FIXME NRE tailcall*/
+ Tcl_Panic("Tailcall called from a callback!");
+ NR_DATA_DIG();
+ esPtr = iPtr->execEnvPtr->execStackPtr;
+ goto abnormalReturn; /* drop a level */
+ case TCL_NR_CMD_TYPE:
+ case TCL_NR_SCRIPT_TYPE:
+ /*
+ * FIXME NRE tailcall: error messages will be all wrong?
+ */
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ fprintf(stdout, " Tailcall: eval request received from callback\n");
+ }
+#endif
+ tailcall = 1;
+ goto restoreStateVariables;
+ default:
+ Tcl_Panic("TEBC: TEOV_NR2 sent us a record we cannot handle!");
+ }
+ }
+ }
+ restoreStateVariables:
NR_DATA_DIG();
esPtr = iPtr->execEnvPtr->execStackPtr;
tosPtr = esPtr->tosPtr;
@@ -7778,69 +7825,9 @@ TclExecuteByteCode(
CACHE_STACK_INFO();
goto nonRecursiveCallReturn;
}
-
- if (tailObjPtr && result == TCL_OK) {
- /*
- * The best we can do here is to add the tailcall at the FRONT of the
- * callback list. This will be a real tailcall if we're lucky to have
- * been called from TEOV (or similar), and not-quite-but-almost if
- * called from eg TclOO (I think).
- * The simplest way to add to the front is:
- * (a) push a new record
- * (b) add the tailcall as callback to the newly-created 2nd record
- * (c) swap the two top records: old top is still top, newly created
- * record is second
- */
-
- TEOV_record *rootPtr, *recordPtr;
-
- rootPtr = TOP_RECORD(iPtr);
- PUSH_RECORD(iPtr, recordPtr);
- TclNRAddCallback(interp, TailcallFromTebc, tailObjPtr, lookupNsPtr, NULL, NULL);
-
- /* Now swap them! */
- recordPtr->nextPtr = rootPtr->nextPtr;
- rootPtr->nextPtr = recordPtr;
- TOP_RECORD(iPtr) = rootPtr;
- }
#endif
return result;
}
-
-static int
-TailcallFromTebc(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Tcl_Obj *tailObjPtr = data[0];
- Namespace *lookupNsPtr = data[1];
- int objc;
- Tcl_Obj **objv;
-
- Tcl_IncrRefCount(tailObjPtr); /* unshared per construction! */
- if (result != TCL_OK) {
- goto done;
- }
- result = Tcl_ListObjGetElements(NULL, tailObjPtr, &objc, &objv);
- if (result != TCL_OK) {
- /* shouldn't happen */
- goto done;
- }
-
- /*
- * Note that by this time the proc's frame SHOULD BE ALREADY POPPED! We do
- * as if it was (don't know what happens with eg TclOO), ie, assume that
- * are already in [uplevel 1] from the proc's callFrame..
- */
-
- iPtr->lookupNsPtr = lookupNsPtr;
- result = Tcl_EvalObjv(interp, objc, objv, TCL_EVAL_INVOKE);
-
- done:
- Tcl_DecrRefCount(tailObjPtr);
- return result;
-}
#undef iPtr
#ifdef TCL_COMPILE_DEBUG