diff options
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r-- | generic/tclExecute.c | 57 |
1 files changed, 57 insertions, 0 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 2b5f713..3fab3cc 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2972,6 +2972,63 @@ TEBCresume( Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found"); #endif + case INST_INVOKE_REPLACE: + objc = TclGetUInt4AtPtr(pc+1); + objPtr = POP_OBJECT(); + objv = &OBJ_AT_DEPTH(objc-1); + cleanup = objc; +#ifdef TCL_COMPILE_DEBUG + if (tclTraceExec >= 2) { + int i; + + if (traceInstructions) { + strncpy(cmdNameBuf, TclGetString(objv[0]), 20); + TRACE(("%u => call (implementation %s) ", + objc, O2S(objPtr))); + } else { + fprintf(stdout, + "%d: (%u) invoking (using implementation %s) ", + iPtr->numLevels, (unsigned)(pc - codePtr->codeStart), + O2S(objPtr)); + } + for (i = 0; i < objc; i++) { + TclPrintObject(stdout, objv[i], 15); + fprintf(stdout, " "); + } + fprintf(stdout, "\n"); + fflush(stdout); + } +#endif /*TCL_COMPILE_DEBUG*/ + { + Tcl_Obj *copyPtr = Tcl_NewListObj(objc - 1, NULL); + register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1; + Tcl_Obj **copyObjv = &listRepPtr->elements; + int i; + + listRepPtr->elemCount = objc - 1; + copyObjv[0] = objPtr; + memcpy(copyObjv+1, objv+2, sizeof(Tcl_Obj *) * (objc - 2)); + for (i=1 ; i<objc-1 ; i++) { + Tcl_IncrRefCount(copyObjv[i]); + } + objPtr = copyPtr; + } + bcFramePtr->data.tebc.pc = (char *) pc; + iPtr->cmdFramePtr = bcFramePtr; + if (iPtr->flags & INTERP_DEBUG_FRAME) { + TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, + codePtr, bcFramePtr, pc - codePtr->codeStart); + } + iPtr->ensembleRewrite.sourceObjs = objv; + iPtr->ensembleRewrite.numRemovedObjs = 2; + iPtr->ensembleRewrite.numInsertedObjs = 1; + DECACHE_STACK_INFO(); + pc += 5; + TEBC_YIELD(); + TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL); + iPtr->evalFlags |= TCL_EVAL_REDIRECT; + return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN); + /* * ----------------------------------------------------------------- * Start of INST_LOAD instructions. |