summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBasic.c71
-rw-r--r--generic/tclCompile.h8
-rw-r--r--generic/tclExecute.c60
-rw-r--r--generic/tclProc.c5
4 files changed, 77 insertions, 67 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 98d2944..4a4c240 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.349 2008/08/03 18:00:46 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.350 2008/08/04 14:09:28 msofer Exp $
*/
#include "tclInt.h"
@@ -4152,7 +4152,8 @@ TclNRRunCallbacks(
* returns. */
{
Interp *iPtr = (Interp *) interp;
- TEOV_callback *callbackPtr = TOP_CB(interp);
+ TEOV_callback *callbackPtr;
+ Tcl_NRPostProc *procPtr;
/*
* If the interpreter has a non-empty string result, the result object is
@@ -4170,23 +4171,11 @@ TclNRRunCallbacks(
while (TOP_CB(interp) != rootPtr) {
callbackPtr = TOP_CB(interp);
+ procPtr = callbackPtr->procPtr;
- if (tebcCall && (callbackPtr->procPtr == NRRunBytecode)) {
- return TCL_OK;
- } else if (callbackPtr->procPtr == NRAtProcExit) {
- if (tebcCall == 1) {
- return TCL_OK;
- } else if (tebcCall == 2) {
- Tcl_SetResult(interp,
- "atProcExit/tailcall cannot be invoked recursively", TCL_STATIC);
- } else {
- Tcl_SetResult(interp,
- "atProcExit/tailcall can only be called from a proc or lambda", TCL_STATIC);
- }
- TOP_CB(interp) = callbackPtr->nextPtr;
- result = TCL_ERROR;
- TCLNR_FREE(interp, callbackPtr);
- continue;
+ if (tebcCall && (procPtr == NRCallTEBC)) {
+ NRE_ASSERT(result==TCL_OK);
+ return TCL_OK;
}
/*
@@ -4199,7 +4188,7 @@ TclNRRunCallbacks(
*/
TOP_CB(interp) = callbackPtr->nextPtr;
- result = callbackPtr->procPtr(callbackPtr->data, interp, result);
+ result = (procPtr)(callbackPtr->data, interp, result);
TCLNR_FREE(interp, callbackPtr);
}
return result;
@@ -4258,31 +4247,29 @@ NRRunObjProc(
}
int
-NRRunBytecode(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- ByteCode *codePtr = data[0];
-
- if (result == TCL_OK) {
- return TclExecuteByteCode(interp, codePtr);
- }
- return result;
-}
-
-int
-NRAtProcExit(
+NRCallTEBC(
ClientData data[],
Tcl_Interp *interp,
int result)
{
- /* For tailcalls!
- * drop all callbacks until the last command start: nothing to do here,
- * just need this to be able to pass it up to tebc.
+ /*
+ * This is not run normally, the callback is passed up to tebc. This
+ function is only called when no tebc is above.
*/
-
- return result;
+ int type = PTR2INT(data[0]);
+
+ switch (type) {
+ case TCL_NR_BC_TYPE:
+ return TclExecuteByteCode(interp, data[1]);
+ case TCL_NR_ATEXIT_TYPE:
+ /* For atProcExit and tailcalls */
+ Tcl_SetResult(interp,
+ "atProcExit/tailcall can only be called from a proc or lambda", TCL_STATIC);
+ return TCL_ERROR;
+ default:
+ Tcl_Panic("unknown call type to TEBC");
+ }
+ return result; /* not reached */
}
/*
@@ -5771,7 +5758,8 @@ TclNREvalObjEx(
TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
objPtr, INT2PTR(allowExceptions), NULL);
- TclNRAddCallback(interp, NRRunBytecode, codePtr, NULL, NULL, NULL);
+ TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
+ NULL, NULL);
return TCL_OK;
}
@@ -7880,7 +7868,8 @@ TclNRAtProcExitObjCmd(
*/
TclNRAddCallback(interp, NRAtProcExitEval, listPtr, nsPtr, NULL, NULL);
- TclNRAddCallback(interp, NRAtProcExit, clientData, NULL, NULL, NULL);
+ TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_ATEXIT_TYPE), clientData,
+ NULL, NULL);
return TCL_OK;
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 68e6afe..1653ea5 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,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.h,v 1.100 2008/08/03 18:00:49 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.101 2008/08/04 14:09:31 msofer Exp $
*/
#ifndef _TCLCOMPILATION
@@ -837,8 +837,10 @@ typedef struct {
*----------------------------------------------------------------
*/
-MODULE_SCOPE Tcl_NRPostProc NRRunBytecode;
-MODULE_SCOPE Tcl_NRPostProc NRAtProcExit;
+MODULE_SCOPE Tcl_NRPostProc NRCallTEBC;
+
+#define TCL_NR_BC_TYPE 0
+#define TCL_NR_ATEXIT_TYPE 1
/*
*----------------------------------------------------------------
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 360525e..0c77b9e 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.395 2008/08/04 04:49:24 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.396 2008/08/04 14:09:31 msofer Exp $
*/
#include "tclInt.h"
@@ -1831,27 +1831,27 @@ TclExecuteByteCode(
nonRecursiveCallStart:
if (nested) {
TEOV_callback *callbackPtr = TOP_CB(interp);
- Tcl_NRPostProc *procPtr = callbackPtr->procPtr;
- ByteCode *newCodePtr = callbackPtr->data[0];
-
- isTailcall = PTR2INT(callbackPtr->data[0]);
+ int type = PTR2INT(callbackPtr->data[0]);
+ ClientData param = callbackPtr->data[1];
NRE_ASSERT(result==TCL_OK);
NRE_ASSERT(callbackPtr != bottomPtr->rootPtr);
-
+ NRE_ASSERT(callbackPtr->procPtr == NRCallTEBC);
+
TOP_CB(interp) = callbackPtr->nextPtr;
TCLNR_FREE(interp, callbackPtr);
NR_DATA_BURY();
- if (procPtr == NRRunBytecode) {
+
+ if (type == TCL_NR_BC_TYPE) {
/*
* A request to run a bytecode: record this level's state
* variables, swap codePtr and start running the new one.
*/
NR_DATA_BURY();
- codePtr = newCodePtr;
- } else if (procPtr == NRAtProcExit) {
+ codePtr = param;
+ } else if (type == TCL_NR_ATEXIT_TYPE) {
/*
* A request to perform a command at exit: schedule the command at
* its proper place, then continue or just drop the present bytecode if
@@ -1862,6 +1862,7 @@ TclExecuteByteCode(
TOP_CB(interp) = newPtr->nextPtr;
+ isTailcall = PTR2INT(param);
if (!isTailcall) {
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
@@ -1905,7 +1906,7 @@ TclExecuteByteCode(
goto abnormalReturn;
}
} else {
- Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle! (1)");
+ Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
}
}
nested = 1;
@@ -2570,7 +2571,8 @@ TclExecuteByteCode(
CACHE_STACK_INFO();
cleanup = 1;
pc++;
- Tcl_NRAddCallback(interp, NRRunBytecode, newCodePtr, NULL, NULL, NULL);
+ Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), newCodePtr,
+ NULL, NULL);
goto nonRecursiveCallStart;
}
@@ -2628,7 +2630,8 @@ TclExecuteByteCode(
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
pc++;
- Tcl_NRAddCallback(interp, NRRunBytecode, newCodePtr, NULL, NULL, NULL);
+ Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), newCodePtr,
+ NULL, NULL);
goto nonRecursiveCallStart;
}
@@ -7738,7 +7741,7 @@ TclExecuteByteCode(
bottomPtr = oldBottomPtr; /* back to old bc */
rerunCallbacks:
- result = TclNRRunCallbacks(interp, result, bottomPtr->rootPtr, 2);
+ result = TclNRRunCallbacks(interp, result, bottomPtr->rootPtr, 1);
NR_DATA_DIG();
DECACHE_STACK_INFO();
@@ -7784,16 +7787,31 @@ TclExecuteByteCode(
Tcl_DecrRefCount(objPtr);
}
goto nonRecursiveCallReturn;
- } else if (TOP_CB(interp)->procPtr == NRRunBytecode) {
- /*
- * One of the callbacks requested a new execution: a tailcall!
- * Start the new bytecode.
- */
-
+ } else {
+ TEOV_callback *callbackPtr = TOP_CB(iPtr);
+ int type = PTR2INT(callbackPtr->data[0]);
+
+ NRE_ASSERT(TOP_CB(interp)->procPtr == NRCallTEBC);
NRE_ASSERT(result == TCL_OK);
- goto nonRecursiveCallStart;
+
+ if (type == TCL_NR_BC_TYPE) {
+ /*
+ * One of the callbacks requested a new execution: a tailcall!
+ * Start the new bytecode.
+ */
+
+ goto nonRecursiveCallStart;
+ } else if (type == TCL_NR_ATEXIT_TYPE) {
+ TOP_CB(iPtr) = callbackPtr->nextPtr;
+ TCLNR_FREE(interp, callbackPtr);
+
+ Tcl_SetResult(interp,
+ "atProcExit/tailcall cannot be invoked recursively", TCL_STATIC);
+ result = TCL_ERROR;
+ goto rerunCallbacks;
+ }
}
- Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle! (2)");
+ Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 0cc9ae4..1fe9b39 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.154 2008/07/31 14:43:47 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.155 2008/08/04 14:09:32 msofer Exp $
*/
#include "tclInt.h"
@@ -1772,7 +1772,8 @@ TclNRInterpProcCore(
TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
NULL, NULL);
- TclNRAddCallback(interp, NRRunBytecode, codePtr, NULL, NULL, NULL);
+ TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
+ NULL, NULL);
return TCL_OK;
}
generated by cgit v0.12 at 2024-11-05 08:07:41 (GMT)