summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c229
-rw-r--r--generic/tclEvent.c22
-rw-r--r--generic/tclInt.decls27
-rw-r--r--generic/tclIntDecls.h44
-rw-r--r--generic/tclStubInit.c8
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 */