diff options
| author | donal.k.fellows@manchester.ac.uk <dkf> | 2012-11-01 18:06:09 (GMT) |
|---|---|---|
| committer | donal.k.fellows@manchester.ac.uk <dkf> | 2012-11-01 18:06:09 (GMT) |
| commit | d72c1c681d561ca1b22fb51b56d06856c12e8b4e (patch) | |
| tree | 73c6e63a58a37fcfd2efd533ae233d19a6aa0f0b /generic/tclExecute.c | |
| parent | 64be38de51614d0fb9a2bf6b5d905022cb556c15 (diff) | |
| download | tcl-d72c1c681d561ca1b22fb51b56d06856c12e8b4e.zip tcl-d72c1c681d561ca1b22fb51b56d06856c12e8b4e.tar.gz tcl-d72c1c681d561ca1b22fb51b56d06856c12e8b4e.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) { /* |
