summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2008-08-09 22:20:52 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2008-08-09 22:20:52 (GMT)
commit872dbedfd8d5080ae12fb1f69f6e112c6f3ecc2b (patch)
treed8c8b5f5473a42f971f3e829b6b1c19c37f987f4 /generic
parent7d8ba3fe1315d64a484a885d7678e384fec71811 (diff)
downloadtcl-872dbedfd8d5080ae12fb1f69f6e112c6f3ecc2b.zip
tcl-872dbedfd8d5080ae12fb1f69f6e112c6f3ecc2b.tar.gz
tcl-872dbedfd8d5080ae12fb1f69f6e112c6f3ecc2b.tar.bz2
* generic/tclBasic.c: slight cleanup
* generic/tclCompile.h: * generic/tclExecute.c:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c13
-rw-r--r--generic/tclCompile.h3
-rw-r--r--generic/tclExecute.c99
3 files changed, 64 insertions, 51 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 1133c4c..b1ceab7 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.351 2008/08/07 04:13:50 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.352 2008/08/09 22:20:56 msofer Exp $
*/
#include "tclInt.h"
@@ -777,9 +777,11 @@ Tcl_CreateInterp(void)
*/
Tcl_NRCreateCommand(interp, "::tcl::unsupported::atProcExit",
- /*objProc*/ NULL, TclNRAtProcExitObjCmd, INT2PTR(0), NULL);
+ /*objProc*/ NULL, TclNRAtProcExitObjCmd, INT2PTR(TCL_NR_ATEXIT_TYPE),
+ NULL);
Tcl_NRCreateCommand(interp, "::tcl::unsupported::tailcall",
- /*objProc*/ NULL, TclNRAtProcExitObjCmd, INT2PTR(1), NULL);
+ /*objProc*/ NULL, TclNRAtProcExitObjCmd, INT2PTR(TCL_NR_TAILCALL_TYPE),
+ NULL);
#ifdef USE_DTRACE
/*
@@ -4274,6 +4276,7 @@ NRCallTEBC(
case TCL_NR_BC_TYPE:
return TclExecuteByteCode(interp, data[1]);
case TCL_NR_ATEXIT_TYPE:
+ case TCL_NR_TAILCALL_TYPE:
/* For atProcExit and tailcalls */
Tcl_SetResult(interp,
"atProcExit/tailcall can only be called from a proc or lambda", TCL_STATIC);
@@ -7880,9 +7883,7 @@ TclNRAtProcExitObjCmd(
*/
TclNRAddCallback(interp, NRAtProcExitEval, listPtr, nsPtr, NULL, NULL);
- TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_ATEXIT_TYPE), clientData,
- NULL, NULL);
-
+ TclNRAddCallback(interp, NRCallTEBC, clientData, NULL, NULL, NULL);
return TCL_OK;
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 1653ea5..53a2c95 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.101 2008/08/04 14:09:31 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.102 2008/08/09 22:20:56 msofer Exp $
*/
#ifndef _TCLCOMPILATION
@@ -841,6 +841,7 @@ MODULE_SCOPE Tcl_NRPostProc NRCallTEBC;
#define TCL_NR_BC_TYPE 0
#define TCL_NR_ATEXIT_TYPE 1
+#define TCL_NR_TAILCALL_TYPE 2
/*
*----------------------------------------------------------------
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f9d8bae..d2c656e 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.402 2008/08/09 00:13:36 das Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.403 2008/08/09 22:20:57 msofer Exp $
*/
#include "tclInt.h"
@@ -1844,27 +1844,26 @@ TclExecuteByteCode(
NR_DATA_BURY();
- 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 = 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
- * this is a tailcall.
- */
-
- TEOV_callback *newPtr = TOP_CB(interp);
-
- TOP_CB(interp) = newPtr->nextPtr;
+ switch (type) {
+ case 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 = param;
+ break;
+ case TCL_NR_ATEXIT_TYPE: {
+ /*
+ * A request to perform a command at exit: put it in the stack
+ * and continue eexec'ing the current bytecode
+ */
+
+ TEOV_callback *newPtr = TOP_CB(interp);
- isTailcall = PTR2INT(param);
- if (!isTailcall) {
+ TOP_CB(interp) = newPtr->nextPtr;
+
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " atProcExit request received\n");
@@ -1877,8 +1876,17 @@ TclExecuteByteCode(
Tcl_DecrRefCount(objPtr);
}
goto nonRecursiveCallReturn;
- } else {
-
+ }
+ case TCL_NR_TAILCALL_TYPE: {
+ /*
+ * A request to perform a tailcall: put it at the front of the
+ * atExit stack and abandon the current bytecode.
+ */
+
+ TEOV_callback *newPtr = TOP_CB(interp);
+
+ TOP_CB(interp) = newPtr->nextPtr;
+ isTailcall = 1;
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " Tailcall request received\n");
@@ -1891,7 +1899,7 @@ TclExecuteByteCode(
TCL_STATIC);
goto checkForCatch;
}
-
+
newPtr->nextPtr = NULL;
if (!bottomPtr->atExitPtr) {
newPtr->nextPtr = NULL;
@@ -1900,9 +1908,9 @@ TclExecuteByteCode(
/*
* There are already atExit callbacks: run last.
*/
-
+
TEOV_callback *tmpPtr = bottomPtr->atExitPtr;
-
+
while (tmpPtr->nextPtr) {
tmpPtr = tmpPtr->nextPtr;
}
@@ -1910,8 +1918,8 @@ TclExecuteByteCode(
}
goto abnormalReturn;
}
- } else {
- Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
+ default:
+ Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
}
}
nested = 1;
@@ -7800,24 +7808,27 @@ TclExecuteByteCode(
NRE_ASSERT(TOP_CB(interp)->procPtr == NRCallTEBC);
NRE_ASSERT(result == TCL_OK);
- 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;
+ switch (type) {
+ case TCL_NR_BC_TYPE:
+ /*
+ * One of the callbacks requested a new execution: a tailcall!
+ * Start the new bytecode.
+ */
+
+ goto nonRecursiveCallStart;
+ case TCL_NR_ATEXIT_TYPE:
+ case TCL_NR_TAILCALL_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;
+ default:
+ Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
}
}
- Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
}