diff options
Diffstat (limited to 'generic/tclNamesp.c')
| -rw-r--r-- | generic/tclNamesp.c | 183 |
1 files changed, 8 insertions, 175 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index aed623a..0a2e6de 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -3235,8 +3235,6 @@ NRNamespaceEvalCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; - CmdFrame *invoker; - int word; Tcl_Namespace *namespacePtr; CallFrame *framePtr, **framePtrPtr; Tcl_Obj *objPtr; @@ -3290,14 +3288,7 @@ NRNamespaceEvalCmd( } if (objc == 3) { - /* - * TIP #280: Make actual argument location available to eval'd script. - */ - objPtr = objv[2]; - invoker = iPtr->cmdFramePtr; - word = 3; - TclArgumentGet(interp, objPtr, &invoker, &word); } else { /* * More than one argument: concatenate them together with spaces @@ -3306,17 +3297,11 @@ NRNamespaceEvalCmd( */ objPtr = Tcl_ConcatObj(objc-2, objv+2); - invoker = NULL; - word = 0; } - /* - * TIP #280: Make invoking context available to eval'd script. - */ - TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval", NULL, NULL); - return TclNREvalObjEx(interp, objPtr, 0, invoker, word); + return TclNREvalObjEx(interp, objPtr, 0); } static int @@ -3761,7 +3746,7 @@ NRNamespaceInscopeCmd( TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope", NULL, NULL); - return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0); + return TclNREvalObjEx(interp, cmdObjPtr, 0); } /* @@ -4790,37 +4775,31 @@ TclGetNamespaceChildTable( /* *---------------------------------------------------------------------- * - * TclLogCommandInfo -- + * Tcl_LogCommandInfo -- * * This function is invoked after an error occurs in an interpreter. It - * adds information to iPtr->errorInfo/errorStack fields to describe the - * command that was being executed when the error occurred. When pc and - * tosPtr are non-NULL, conveying a bytecode execution "inner context", - * and the offending instruction is suitable, that inner context is - * recorded in errorStack. + * adds information to iPtr->errorInfo fields to describe the + * command that was being executed when the error occurred. * * Results: * None. * * Side effects: - * Information about the command is added to errorInfo/errorStack and the + * Information about the command is added to errorInfo and the * line number stored internally in the interpreter is set. * *---------------------------------------------------------------------- */ void -TclLogCommandInfo( +Tcl_LogCommandInfo( Tcl_Interp *interp, /* Interpreter in which to log information. */ const char *script, /* First character in script containing * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ - int length, /* Number of bytes in command (-1 means use + int length) /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ - const unsigned char *pc, /* Current pc of bytecode execution context */ - Tcl_Obj **tosPtr) /* Current stack of bytecode execution - * context */ { register const char *p; Interp *iPtr = (Interp *) interp; @@ -4887,155 +4866,9 @@ TclLogCommandInfo( } } } - - /* - * TIP #348 - */ - - if (Tcl_IsShared(iPtr->errorStack)) { - Tcl_Obj *newObj; - - newObj = Tcl_DuplicateObj(iPtr->errorStack); - Tcl_DecrRefCount(iPtr->errorStack); - Tcl_IncrRefCount(newObj); - iPtr->errorStack = newObj; - } - if (iPtr->resetErrorStack) { - int len; - - iPtr->resetErrorStack = 0; - Tcl_ListObjLength(interp, iPtr->errorStack, &len); - - /* - * Reset while keeping the list intrep as much as possible. - */ - - Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL); - if (pc != NULL) { - Tcl_Obj *innerContext; - - innerContext = TclGetInnerContext(interp, pc, tosPtr); - if (innerContext != NULL) { - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, - iPtr->innerLiteral); - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, innerContext); - } - } else if (command != NULL) { - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, - iPtr->innerLiteral); - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, - Tcl_NewStringObj(command, length)); - } - } - - if (!iPtr->framePtr->objc) { - /* - * Special frame, nothing to report. - */ - } else if (iPtr->varFramePtr != iPtr->framePtr) { - /* - * uplevel case, [lappend errorstack UP $relativelevel] - */ - - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral); - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj( - iPtr->framePtr->level - iPtr->varFramePtr->level)); - } else if (iPtr->framePtr != iPtr->rootFramePtr) { - /* - * normal case, [lappend errorstack CALL [info level 0]] - */ - - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral); - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj( - iPtr->framePtr->objc, iPtr->framePtr->objv)); - } } /* - *---------------------------------------------------------------------- - * - * TclErrorStackResetIf -- - * - * The TIP 348 reset/no-bc part of TLCI, for specific use by - * TclCompileSyntaxError. - * - * Results: - * None. - * - * Side effects: - * Reset errorstack if it needs be, and in that case remember the - * passed-in error message as inner context. - * - *---------------------------------------------------------------------- - */ - -void -TclErrorStackResetIf( - Tcl_Interp *interp, - const char *msg, - int length) -{ - Interp *iPtr = (Interp *) interp; - - if (Tcl_IsShared(iPtr->errorStack)) { - Tcl_Obj *newObj; - - newObj = Tcl_DuplicateObj(iPtr->errorStack); - Tcl_DecrRefCount(iPtr->errorStack); - Tcl_IncrRefCount(newObj); - iPtr->errorStack = newObj; - } - if (iPtr->resetErrorStack) { - int len; - - iPtr->resetErrorStack = 0; - Tcl_ListObjLength(interp, iPtr->errorStack, &len); - - /* - * Reset while keeping the list intrep as much as possible. - */ - - Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL); - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral); - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, - Tcl_NewStringObj(msg, length)); - } -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_LogCommandInfo -- - * - * This function is invoked after an error occurs in an interpreter. It - * adds information to iPtr->errorInfo/errorStack fields to describe the - * command that was being executed when the error occurred. - * - * Results: - * None. - * - * Side effects: - * Information about the command is added to errorInfo/errorStack and the - * line number stored internally in the interpreter is set. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_LogCommandInfo( - Tcl_Interp *interp, /* Interpreter in which to log information. */ - const char *script, /* First character in script containing - * command (must be <= command). */ - const char *command, /* First character in command that generated - * the error. */ - int length) /* Number of bytes in command (-1 means use - * all bytes up to first null byte). */ -{ - TclLogCommandInfo(interp, script, command, length, NULL, NULL); -} - - -/* * Local Variables: * mode: c * c-basic-offset: 4 |