diff options
Diffstat (limited to 'generic/tclExecute.c')
| -rw-r--r-- | generic/tclExecute.c | 88 |
1 files changed, 88 insertions, 0 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 3c0b472..0ec16e9 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -17,6 +17,7 @@ #include "tclInt.h" #include "tclCompile.h" +#include "tclOOInt.h" #include "tommath.h" #include <math.h> @@ -4045,6 +4046,93 @@ TEBCresume( /* * ----------------------------------------------------------------- + * Start of general introspector instructions. + */ + + case INST_NS_CURRENT: { + Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); + + if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { + TclNewLiteralStringObj(objResultPtr, "::"); + } else { + TclNewStringObj(objResultPtr, currNsPtr->fullName, + strlen(currNsPtr->fullName)); + } + TRACE_WITH_OBJ(("=> "), objResultPtr); + NEXT_INST_F(1, 0, 1); + } + case INST_COROUTINE_NAME: { + CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; + + TclNewObj(objResultPtr); + if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) { + Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr, + objResultPtr); + } + TRACE_WITH_OBJ(("=> "), objResultPtr); + NEXT_INST_F(1, 0, 1); + } + case INST_INFO_LEVEL_NUM: + TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); + TRACE_WITH_OBJ(("=> "), objResultPtr); + NEXT_INST_F(1, 0, 1); + case INST_INFO_LEVEL_ARGS: { + int level; + register CallFrame *framePtr = iPtr->varFramePtr; + register CallFrame *rootFramePtr = iPtr->rootFramePtr; + + valuePtr = OBJ_AT_TOS; + if (TclGetIntFromObj(interp, valuePtr, &level) != TCL_OK) { + TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)), + Tcl_GetObjResult(interp)); + goto gotError; + } + TRACE(("%d => ", level)); + if (level <= 0) { + level += framePtr->level; + } + for (; (framePtr->level!=level) && (framePtr!=rootFramePtr) ; + framePtr = framePtr->callerVarPtr) { + /* Empty loop body */ + } + if (framePtr == rootFramePtr) { + Tcl_AppendResult(interp, "bad level \"", TclGetString(valuePtr), + "\"", NULL); + TRACE_APPEND(("ERROR: bad level\n")); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL", + TclGetString(valuePtr), NULL); + goto gotError; + } + objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv); + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } + case INST_TCLOO_SELF: { + CallFrame *framePtr = iPtr->varFramePtr; + CallContext *contextPtr; + + if (framePtr == NULL || + !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { + TRACE(("=> ERROR: no TclOO call context\n")); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "self may only be called from inside a method", + -1)); + Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); + goto gotError; + } + contextPtr = framePtr->clientData; + + /* + * Call out to get the name; it's expensive to compute but cached. + */ + + objResultPtr = TclOOObjectName(interp, contextPtr->oPtr); + TRACE_WITH_OBJ(("=> "), objResultPtr); + NEXT_INST_F(1, 0, 1); + } + + /* + * ----------------------------------------------------------------- * Start of INST_LIST and related instructions. */ |