diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 229 | ||||
| -rw-r--r-- | generic/tclEvent.c | 22 | ||||
| -rw-r--r-- | generic/tclInt.decls | 27 | ||||
| -rw-r--r-- | generic/tclIntDecls.h | 44 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 8 |
5 files changed, 46 insertions, 284 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e83da4f..34f3356 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.116 2004/09/24 01:14:41 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.117 2004/09/27 16:24:23 dgp Exp $ */ #include "tclInt.h" @@ -4166,191 +4166,6 @@ Tcl_ExprBooleanObj(interp, objPtr, ptr) /* *---------------------------------------------------------------------- * - * TclInvoke -- - * - * Invokes a Tcl command, given an argv/argc, from either the - * exposed or the hidden sets of commands in the given interpreter. - * NOTE: The command is invoked in the current stack frame of - * the interpreter, thus it can modify local variables. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Whatever the command does. - * - *---------------------------------------------------------------------- - */ - -int -TclInvoke(interp, argc, argv, flags) - Tcl_Interp *interp; /* Where to invoke the command. */ - int argc; /* Count of args. */ - register CONST char **argv; /* The arg strings; argv[0] is the name of - * the command to invoke. */ - int flags; /* Combination of flags controlling the - * call: TCL_INVOKE_HIDDEN and - * TCL_INVOKE_NO_UNKNOWN. */ -{ - register Tcl_Obj *objPtr; - register int i; - int length, result; - - /* - * This procedure generates an objv array for object arguments that hold - * the argv strings. It starts out with stack-allocated space but uses - * dynamically-allocated storage if needed. - */ - -#define NUM_ARGS 20 - Tcl_Obj *(objStorage[NUM_ARGS]); - register Tcl_Obj **objv = objStorage; - - /* - * Create the object argument array "objv". Make sure objv is large - * enough to hold the objc arguments plus 1 extra for the zero - * end-of-objv word. - */ - - if ((argc + 1) > NUM_ARGS) { - objv = (Tcl_Obj **) - ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *)); - } - - for (i = 0; i < argc; i++) { - length = strlen(argv[i]); - objv[i] = Tcl_NewStringObj(argv[i], length); - Tcl_IncrRefCount(objv[i]); - } - objv[argc] = 0; - - /* - * Use TclObjInterpProc to actually invoke the command. - */ - - result = TclObjInvoke(interp, argc, objv, flags); - - /* - * Move the interpreter's object result to the string result, - * then reset the object result. - */ - - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), - TCL_VOLATILE); - - /* - * Decrement the ref counts on the objv elements since we are done - * with them. - */ - - for (i = 0; i < argc; i++) { - objPtr = objv[i]; - Tcl_DecrRefCount(objPtr); - } - - /* - * Free the objv array if malloc'ed storage was used. - */ - - if (objv != objStorage) { - ckfree((char *) objv); - } - return result; -#undef NUM_ARGS -} - -/* - *---------------------------------------------------------------------- - * - * TclGlobalInvoke -- - * - * Invokes a Tcl command, given an argv/argc, from either the - * exposed or hidden sets of commands in the given interpreter. - * NOTE: The command is invoked in the global stack frame of - * the interpreter, thus it cannot see any current state on - * the stack for that interpreter. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Whatever the command does. - * - *---------------------------------------------------------------------- - */ - -int -TclGlobalInvoke(interp, argc, argv, flags) - Tcl_Interp *interp; /* Where to invoke the command. */ - int argc; /* Count of args. */ - register CONST char **argv; /* The arg strings; argv[0] is the name of - * the command to invoke. */ - int flags; /* Combination of flags controlling the - * call: TCL_INVOKE_HIDDEN and - * TCL_INVOKE_NO_UNKNOWN. */ -{ - register Interp *iPtr = (Interp *) interp; - int result; - CallFrame *savedVarFramePtr; - - savedVarFramePtr = iPtr->varFramePtr; - iPtr->varFramePtr = NULL; - result = TclInvoke(interp, argc, argv, flags); - iPtr->varFramePtr = savedVarFramePtr; - return result; -} - -/* - *---------------------------------------------------------------------- - * - * TclObjInvokeGlobal -- - * - * Object version: Invokes a Tcl command, given an objv/objc, from - * either the exposed or hidden set of commands in the given - * interpreter. - * NOTE: The command is invoked in the global stack frame of the - * interpreter, thus it cannot see any current state on the - * stack of that interpreter. - * - * NOTE: This routine is no longer used at all by Tcl itself. - * It is kept only because it appears in the internal stub table, - * for the sake of any extensions that might be calling it. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Whatever the command does. - * - *---------------------------------------------------------------------- - */ - -int -TclObjInvokeGlobal(interp, objc, objv, flags) - Tcl_Interp *interp; /* Interpreter in which command is to be - * invoked. */ - int objc; /* Count of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects; objv[0] points to the - * name of the command to invoke. */ - int flags; /* Combination of flags controlling the - * call: TCL_INVOKE_HIDDEN, - * TCL_INVOKE_NO_UNKNOWN, or - * TCL_INVOKE_NO_TRACEBACK. */ -{ - register Interp *iPtr = (Interp *) interp; - int result; - CallFrame *savedVarFramePtr; - - savedVarFramePtr = iPtr->varFramePtr; - iPtr->varFramePtr = NULL; - result = TclObjInvoke(interp, objc, objv, flags); - iPtr->varFramePtr = savedVarFramePtr; - return result; -} - -/* - *---------------------------------------------------------------------- - * * TclObjInvokeNamespace -- * * Object version: Invokes a Tcl command, given an objv/objc, from @@ -4471,47 +4286,7 @@ TclObjInvoke(interp, objc, objv, flags) } cmdPtr = (Command *) Tcl_GetHashValue(hPtr); } else { - cmdPtr = NULL; - cmd = Tcl_FindCommand(interp, cmdName, - (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY); - if (cmd != (Tcl_Command) NULL) { - cmdPtr = (Command *) cmd; - } - if (cmdPtr == NULL) { - if (!(flags & TCL_INVOKE_NO_UNKNOWN)) { - cmd = Tcl_FindCommand(interp, "unknown", - (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY); - if (cmd != (Tcl_Command) NULL) { - cmdPtr = (Command *) cmd; - } - if (cmdPtr != NULL) { - localObjc = (objc + 1); - localObjv = (Tcl_Obj **) - ckalloc((unsigned) (sizeof(Tcl_Obj *) * localObjc)); - localObjv[0] = Tcl_NewStringObj("unknown", -1); - Tcl_IncrRefCount(localObjv[0]); - for (i = 0; i < objc; i++) { - localObjv[i+1] = objv[i]; - } - objc = localObjc; - objv = localObjv; - } - } - - /* - * Check again if we found the command. If not, "unknown" is - * not present and we cannot help, or the caller said not to - * call "unknown" (they specified TCL_INVOKE_NO_UNKNOWN). - */ - - if (cmdPtr == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "invalid command name \"", cmdName, "\"", - (char *) NULL); - return TCL_ERROR; - } - } + Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN"); } /* diff --git a/generic/tclEvent.c b/generic/tclEvent.c index bd4bfae..292e09b 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.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: tclEvent.c,v 1.45 2004/07/30 15:16:16 dgp Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.46 2004/09/27 16:24:24 dgp Exp $ */ #include "tclInt.h" @@ -242,14 +242,17 @@ HandleBgErrors(clientData) ClientData clientData; /* Pointer to ErrAssocData structure. */ { Tcl_Interp *interp; - CONST char *argv[2]; int code; BgError *errPtr; ErrAssocData *assocPtr = (ErrAssocData *) clientData; Tcl_Channel errChannel; + Tcl_Obj *objv[2]; + + objv[0] = Tcl_NewStringObj("bgerror", -1); + Tcl_IncrRefCount(objv[0]); + objv[1] = NULL; Tcl_Preserve((ClientData) assocPtr); - while (assocPtr->firstBgPtr != NULL) { interp = assocPtr->firstBgPtr->interp; if (interp == NULL) { @@ -270,12 +273,12 @@ HandleBgErrors(clientData) * Create and invoke the bgerror command. */ - argv[0] = "bgerror"; - argv[1] = assocPtr->firstBgPtr->errorMsg; + objv[1] = Tcl_NewStringObj(assocPtr->firstBgPtr->errorMsg, -1); + Tcl_IncrRefCount(objv[1]); Tcl_AllowExceptions(interp); Tcl_Preserve((ClientData) interp); - code = TclGlobalInvoke(interp, 2, argv, 0); + code = Tcl_EvalObjv(interp, 2, objv, TCL_EVAL_GLOBAL); if (code == TCL_ERROR) { /* @@ -293,7 +296,7 @@ HandleBgErrors(clientData) Tcl_SavedResult save; Tcl_SaveResult(interp, &save); - TclGlobalInvoke(interp, 2, argv, TCL_INVOKE_HIDDEN); + TclObjInvoke(interp, 2, objv, TCL_INVOKE_HIDDEN); Tcl_RestoreResult(interp, &save); goto doneWithInterp; @@ -347,6 +350,10 @@ HandleBgErrors(clientData) */ doneWithInterp: + if (objv[1]) { + Tcl_DecrRefCount(objv[1]); + objv[1] = NULL; + } if (assocPtr->firstBgPtr) { ckfree(assocPtr->firstBgPtr->errorMsg); @@ -362,6 +369,7 @@ doneWithInterp: } } assocPtr->lastBgPtr = NULL; + Tcl_DecrRefCount(objv[0]); Tcl_Release((ClientData) assocPtr); } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 6019d66..32b43e0 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -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: tclInt.decls,v 1.78 2004/09/27 14:31:17 kennykb Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.79 2004/09/27 16:24:24 dgp Exp $ library tcl @@ -185,10 +185,11 @@ declare 41 generic { declare 42 generic { char *TclpGetUserHome(CONST char *name, Tcl_DString *bufferPtr) } -declare 43 generic { - int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, - int flags) -} +# Removed in Tcl 8.5a2 +#declare 43 generic { +# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, +# int flags) +#} declare 44 generic { int TclGuessPackageName(CONST char *fileName, Tcl_DString *bufPtr) } @@ -219,9 +220,10 @@ declare 50 generic { declare 51 generic { int TclInterpInit(Tcl_Interp *interp) } -declare 52 generic { - int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags) -} +# Removed in Tcl 8.5a2 +#declare 52 generic { +# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags) +#} declare 53 generic { int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv) @@ -270,10 +272,11 @@ declare 64 generic { int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags) } -declare 65 generic { - int TclObjInvokeGlobal(Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[], int flags) -} +# Removed in Tcl 8.5a2 +#declare 65 generic { +# int TclObjInvokeGlobal(Tcl_Interp *interp, int objc, +# Tcl_Obj *CONST objv[], int flags) +#} declare 66 generic { int TclOpenFileChannelDeleteProc(TclOpenFileChannelProc_ *proc) } diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 42c8f62..6979c88 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.68 2004/09/27 14:31:18 kennykb Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.69 2004/09/27 16:24:24 dgp Exp $ */ #ifndef _TCLINTDECLS @@ -249,12 +249,7 @@ EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_(( EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char * name, Tcl_DString * bufferPtr)); #endif -#ifndef TclGlobalInvoke_TCL_DECLARED -#define TclGlobalInvoke_TCL_DECLARED -/* 43 */ -EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp * interp, - int argc, CONST84 char ** argv, int flags)); -#endif +/* Slot 43 is reserved */ #ifndef TclGuessPackageName_TCL_DECLARED #define TclGuessPackageName_TCL_DECLARED /* 44 */ @@ -293,12 +288,7 @@ EXTERN void TclInitCompiledLocals _ANSI_ARGS_(( /* 51 */ EXTERN int TclInterpInit _ANSI_ARGS_((Tcl_Interp * interp)); #endif -#ifndef TclInvoke_TCL_DECLARED -#define TclInvoke_TCL_DECLARED -/* 52 */ -EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp * interp, int argc, - CONST84 char ** argv, int flags)); -#endif +/* Slot 52 is reserved */ #ifndef TclInvokeObjectCommand_TCL_DECLARED #define TclInvokeObjectCommand_TCL_DECLARED /* 53 */ @@ -358,12 +348,7 @@ EXTERN int TclObjInterpProc _ANSI_ARGS_((ClientData clientData, EXTERN int TclObjInvoke _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); #endif -#ifndef TclObjInvokeGlobal_TCL_DECLARED -#define TclObjInvokeGlobal_TCL_DECLARED -/* 65 */ -EXTERN int TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[], int flags)); -#endif +/* Slot 65 is reserved */ #ifndef TclOpenFileChannelDeleteProc_TCL_DECLARED #define TclOpenFileChannelDeleteProc_TCL_DECLARED /* 66 */ @@ -1086,7 +1071,7 @@ typedef struct TclIntStubs { int (*tclGetOpenMode) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * seekFlagPtr)); /* 40 */ Tcl_Command (*tclGetOriginalCommand) _ANSI_ARGS_((Tcl_Command command)); /* 41 */ char * (*tclpGetUserHome) _ANSI_ARGS_((CONST char * name, Tcl_DString * bufferPtr)); /* 42 */ - int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 43 */ + void *reserved43; int (*tclGuessPackageName) _ANSI_ARGS_((CONST char * fileName, Tcl_DString * bufPtr)); /* 44 */ int (*tclHideUnsafeCommands) _ANSI_ARGS_((Tcl_Interp * interp)); /* 45 */ int (*tclInExit) _ANSI_ARGS_((void)); /* 46 */ @@ -1095,7 +1080,7 @@ typedef struct TclIntStubs { Tcl_Obj * (*tclIncrVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, long incrAmount, int part1NotParsed)); /* 49 */ void (*tclInitCompiledLocals) _ANSI_ARGS_((Tcl_Interp * interp, CallFrame * framePtr, Namespace * nsPtr)); /* 50 */ int (*tclInterpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 51 */ - int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 52 */ + void *reserved52; int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv)); /* 53 */ int (*tclInvokeStringCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 54 */ Proc * (*tclIsProc) _ANSI_ARGS_((Command * cmdPtr)); /* 55 */ @@ -1108,7 +1093,7 @@ typedef struct TclIntStubs { int (*tclObjCommandComplete) _ANSI_ARGS_((Tcl_Obj * cmdPtr)); /* 62 */ int (*tclObjInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 63 */ int (*tclObjInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 64 */ - int (*tclObjInvokeGlobal) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 65 */ + void *reserved65; int (*tclOpenFileChannelDeleteProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 66 */ int (*tclOpenFileChannelInsertProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 67 */ void *reserved68; @@ -1405,10 +1390,7 @@ extern TclIntStubs *tclIntStubsPtr; #define TclpGetUserHome \ (tclIntStubsPtr->tclpGetUserHome) /* 42 */ #endif -#ifndef TclGlobalInvoke -#define TclGlobalInvoke \ - (tclIntStubsPtr->tclGlobalInvoke) /* 43 */ -#endif +/* Slot 43 is reserved */ #ifndef TclGuessPackageName #define TclGuessPackageName \ (tclIntStubsPtr->tclGuessPackageName) /* 44 */ @@ -1435,10 +1417,7 @@ extern TclIntStubs *tclIntStubsPtr; #define TclInterpInit \ (tclIntStubsPtr->tclInterpInit) /* 51 */ #endif -#ifndef TclInvoke -#define TclInvoke \ - (tclIntStubsPtr->tclInvoke) /* 52 */ -#endif +/* Slot 52 is reserved */ #ifndef TclInvokeObjectCommand #define TclInvokeObjectCommand \ (tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */ @@ -1478,10 +1457,7 @@ extern TclIntStubs *tclIntStubsPtr; #define TclObjInvoke \ (tclIntStubsPtr->tclObjInvoke) /* 64 */ #endif -#ifndef TclObjInvokeGlobal -#define TclObjInvokeGlobal \ - (tclIntStubsPtr->tclObjInvokeGlobal) /* 65 */ -#endif +/* Slot 65 is reserved */ #ifndef TclOpenFileChannelDeleteProc #define TclOpenFileChannelDeleteProc \ (tclIntStubsPtr->tclOpenFileChannelDeleteProc) /* 66 */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index af99c25..ea17c3c 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.102 2004/09/27 14:31:19 kennykb Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.103 2004/09/27 16:24:26 dgp Exp $ */ #include "tclInt.h" @@ -122,7 +122,7 @@ TclIntStubs tclIntStubs = { TclGetOpenMode, /* 40 */ TclGetOriginalCommand, /* 41 */ TclpGetUserHome, /* 42 */ - TclGlobalInvoke, /* 43 */ + NULL, /* 43 */ TclGuessPackageName, /* 44 */ TclHideUnsafeCommands, /* 45 */ TclInExit, /* 46 */ @@ -131,7 +131,7 @@ TclIntStubs tclIntStubs = { TclIncrVar2, /* 49 */ TclInitCompiledLocals, /* 50 */ TclInterpInit, /* 51 */ - TclInvoke, /* 52 */ + NULL, /* 52 */ TclInvokeObjectCommand, /* 53 */ TclInvokeStringCommand, /* 54 */ TclIsProc, /* 55 */ @@ -144,7 +144,7 @@ TclIntStubs tclIntStubs = { TclObjCommandComplete, /* 62 */ TclObjInterpProc, /* 63 */ TclObjInvoke, /* 64 */ - TclObjInvokeGlobal, /* 65 */ + NULL, /* 65 */ TclOpenFileChannelDeleteProc, /* 66 */ TclOpenFileChannelInsertProc, /* 67 */ NULL, /* 68 */ |