diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2012-11-01 18:06:09 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2012-11-01 18:06:09 (GMT) |
commit | a7dc229d16889c9f6f66d197d4e0bf1afbec5578 (patch) | |
tree | 73c6e63a58a37fcfd2efd533ae233d19a6aa0f0b /generic/tclExecute.c | |
parent | 08ba0e902fe194be25319468633409bc90daaf87 (diff) | |
download | tcl-a7dc229d16889c9f6f66d197d4e0bf1afbec5578.zip tcl-a7dc229d16889c9f6f66d197d4e0bf1afbec5578.tar.gz tcl-a7dc229d16889c9f6f66d197d4e0bf1afbec5578.tar.bz2 |
Added compilation of [tailcall]. Not a particularly efficient compilation though; it does not detect tailcall-of-self as a special case.
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r-- | generic/tclExecute.c | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index bbee81d..1e24cb3 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2374,6 +2374,55 @@ TEBCresume( return TCL_OK; } + case INST_TAILCALL: { + Tcl_Obj *listPtr, *nsObjPtr; + NRE_callback *tailcallPtr; + + opnd = TclGetUInt1AtPtr(pc+1); + + if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { + TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "tailcall can only be called from a proc or lambda", -1)); + Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); + goto gotError; + } + +#ifdef TCL_COMPILE_DEBUG + TRACE(("%d [", opnd)); + for (i=opnd-1 ; i>=0 ; i++) { + TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i)))); + if (i > 0) { + TRACE_APPEND((" ")); + } + } + TRACE_APPEND(("] => RETURN...")); +#endif + + /* + * Push the evaluation of the called command into the NR callback + * stack. + */ + + listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); + nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1); + Tcl_IncrRefCount(listPtr); + Tcl_IncrRefCount(nsObjPtr); + TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr, + NULL, NULL); + + /* + * Unstitch ourselves and do a [return]. + */ + + tailcallPtr = TOP_CB(interp); + TOP_CB(interp) = tailcallPtr->nextPtr; + iPtr->varFramePtr->tailcallPtr = tailcallPtr; + result = TCL_RETURN; + cleanup = opnd; + goto processExceptionReturn; + } + case INST_DONE: if (tosPtr > initTosPtr) { /* |