diff options
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r-- | generic/tclProc.c | 97 |
1 files changed, 9 insertions, 88 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index 63aa7d5..ea5f617 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.152 2008/07/25 22:11:21 andreas_kupries Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.153 2008/07/29 05:30:37 msofer Exp $ */ #include "tclInt.h" @@ -1618,23 +1618,6 @@ PushProcCallFrame( return TCL_OK; } -static int -Tcl_NRBC( - Tcl_Interp *interp, - ByteCode *codePtr, - Tcl_NRPostProc *postProcPtr, - Tcl_Obj *procNameObj, - ProcErrorProc errorProc) -{ - TEOV_record *recordPtr = TOP_RECORD(interp); - - recordPtr->type = TCL_NR_BC_TYPE; - recordPtr->data.codePtr = codePtr; - TclNRAddCallback(interp, postProcPtr, procNameObj, errorProc, NULL, - NULL); - return TCL_OK; -} - /* *---------------------------------------------------------------------- * @@ -1663,16 +1646,10 @@ TclObjInterpProc( Tcl_Obj *const objv[]) /* Argument value objects. */ { /* - * Not used in the core; external interface for iTcl and XOTcl + * Not used much in the core; external interface for iTcl */ - int result = PushProcCallFrame(clientData, interp, objc, objv, - /*isLambda*/ 0); - - if (result != TCL_OK) { - return TCL_ERROR; - } - return TclObjInterpProcCore(interp, objv[0], 1, &MakeProcError); + return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv); } int @@ -1697,7 +1674,7 @@ TclNRInterpProc( /* *---------------------------------------------------------------------- * - * TclObjInterpProcCore -- + * TclNRInterpProcCore -- * * When a Tcl procedure, lambda term or anything else that works like a * procedure gets invoked during bytecode evaluation, this object-based @@ -1713,49 +1690,6 @@ TclNRInterpProc( */ int -TclObjInterpProcCore( - register Tcl_Interp *interp,/* Interpreter in which procedure was - * invoked. */ - Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ - int skip, /* Number of initial arguments to be skipped, - * i.e., words in the "command name". */ - ProcErrorProc errorProc) /* How to convert results from the script into - * results of the overall procedure. */ -{ - /* - * Not used in the core; external interface for TclOO - */ - - Interp *iPtr = (Interp *) interp; - TEOV_record record, *rootPtr; - int result; - - /* - * Put a top record NOT ON THE TCL STACK! Note that TclNRInterpProcCore - * assumes it can free the CallFrame in the error case, there cannot be - * anything else on top of that. We use a C-stack record, it could also be - * ckalloc'ed or anything else, just NOT TclStackAlloc. - */ - - rootPtr = TOP_RECORD(iPtr); - TOP_RECORD(iPtr) = &record; - result = TclNRInterpProcCore(interp, procNameObj, skip, errorProc); - TOP_RECORD(iPtr) = rootPtr; - - if (result == TCL_OK) { - result = TclExecuteByteCode(interp, record.data.codePtr); - result = TclEvalObjv_NR2(interp, result, rootPtr); - if (TOP_RECORD(iPtr) != rootPtr) { - /* FIXME NRE & tailcalls */ - Tcl_Panic("TclObjInterpProcCore not yet prepared to deal with evals in callbacks!"); - } - result = InterpProcNR2(record.callbackPtr->data, interp, result); - TclSmallFree(record.callbackPtr); - } - return result; -} - -int TclNRInterpProcCore( register Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ @@ -1837,7 +1771,9 @@ TclNRInterpProcCore( (Tcl_Obj **)(iPtr->varFramePtr->objv + l)); } - Tcl_NRBC(interp, codePtr, InterpProcNR2, procNameObj, errorProc); + TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc, + NULL, NULL); + TclNRAddCallback(interp, NRRunBytecode, codePtr, NULL, NULL, NULL); return TCL_OK; } @@ -2825,21 +2761,8 @@ TclNRApplyObjCmd( result = PushProcCallFrame((ClientData) procPtr, interp, objc, objv, 1); if (result == TCL_OK) { + TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL); result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError); - if (result == TCL_OK) { - /* Fix the recordPtr! */ - - TEOV_record *recordPtr = TOP_RECORD(iPtr); - - recordPtr->callbackPtr->procPtr = ApplyNR2; - recordPtr->callbackPtr->data[2] = extraPtr; - } - } - if (result != TCL_OK) { - if (isRootEnsemble) { - iPtr->ensembleRewrite.sourceObjs = NULL; - } - TclStackFree(interp, extraPtr); } return result; } @@ -2850,10 +2773,8 @@ ApplyNR2( Tcl_Interp *interp, int result) { - ApplyExtraData *extraPtr = data[2]; + ApplyExtraData *extraPtr = data[0]; - result = InterpProcNR2(data, interp, result); - if (extraPtr->isRootEnsemble) { ((Interp *) interp)->ensembleRewrite.sourceObjs = NULL; } |