summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog14
-rw-r--r--generic/tclInt.decls18
-rw-r--r--generic/tclIntDecls.h30
-rw-r--r--generic/tclProc.c130
-rw-r--r--generic/tclStubInit.c6
-rw-r--r--generic/tclTestProcBodyObj.c18
6 files changed, 42 insertions, 174 deletions
diff --git a/ChangeLog b/ChangeLog
index 43a556c..31bdb1d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2004-08-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclProc.c: The routine TclProcInterpProc was a specific
+ * generic/tclTestProcBodyObj.c: instance of the general service already provided
+ by TclObjInvokeProc. Removed TclProcInterpProc and TclGetInterpProc from the
+ code...
+
+ * generic/tclInt.decls ...and from the internal stubs table.
+ * generic/tclIntDecls.h
+ * generic/tclStubInit.c
+
2004-08-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* doc/string.n: Added clarifying note.
@@ -5,7 +16,8 @@
2004-08-23 Don Porter <dgp@users.sourceforge.net>
* library/auto.tcl: Updated [tcl_findLibrary] search path
- to include any [<pkg>::pkgconfig get scriptdir,runtime] directory, as well as the $::auto_path. [RFE 695441]
+ to include any [<pkg>::pkgconfig get scriptdir,runtime] directory,
+ as well as the $::auto_path. [RFE 695441]
2004-08-21 Kevin B. Kenny <kennykb@acm.org>
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index d8e3e1f..9e45d90 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.76 2004/07/03 02:03:37 msofer Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.77 2004/08/25 01:11:03 dgp Exp $
library tcl
@@ -147,9 +147,10 @@ declare 32 generic {
int TclGetFrame(Tcl_Interp *interp, CONST char *str,
CallFrame **framePtrPtr)
}
-declare 33 generic {
- TclCmdProcType TclGetInterpProc(void)
-}
+# Removed in Tcl 8.5
+#declare 33 generic {
+# TclCmdProcType TclGetInterpProc(void)
+#}
declare 34 generic {
int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
int endValue, int *indexPtr)
@@ -374,10 +375,11 @@ declare 92 generic {
declare 93 generic {
void TclProcDeleteProc(ClientData clientData)
}
-declare 94 generic {
- int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
- int argc, CONST84 char **argv)
-}
+# Removed in Tcl 8.5:
+#declare 94 generic {
+# int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
+# int argc, CONST84 char **argv)
+#}
# Replaced by Tcl_FSStat in 8.4:
#declare 95 generic {
# int TclpStat(CONST char *path, Tcl_StatBuf *buf)
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 796b790..f9675a2 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.66 2004/07/03 02:03:37 msofer Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.67 2004/08/25 01:11:04 dgp Exp $
*/
#ifndef _TCLINTDECLS
@@ -199,11 +199,7 @@ EXTERN CONST char * TclGetExtension _ANSI_ARGS_((CONST char * name));
EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * str, CallFrame ** framePtrPtr));
#endif
-#ifndef TclGetInterpProc_TCL_DECLARED
-#define TclGetInterpProc_TCL_DECLARED
-/* 33 */
-EXTERN TclCmdProcType TclGetInterpProc _ANSI_ARGS_((void));
-#endif
+/* Slot 33 is reserved */
#ifndef TclGetIntForIndex_TCL_DECLARED
#define TclGetIntForIndex_TCL_DECLARED
/* 34 */
@@ -466,13 +462,7 @@ EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp * interp,
/* 93 */
EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
#endif
-#ifndef TclProcInterpProc_TCL_DECLARED
-#define TclProcInterpProc_TCL_DECLARED
-/* 94 */
-EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp * interp, int argc,
- CONST84 char ** argv));
-#endif
+/* Slot 94 is reserved */
/* Slot 95 is reserved */
#ifndef TclRenameCommand_TCL_DECLARED
#define TclRenameCommand_TCL_DECLARED
@@ -1097,7 +1087,7 @@ typedef struct TclIntStubs {
void *reserved30;
CONST char * (*tclGetExtension) _ANSI_ARGS_((CONST char * name)); /* 31 */
int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CallFrame ** framePtrPtr)); /* 32 */
- TclCmdProcType (*tclGetInterpProc) _ANSI_ARGS_((void)); /* 33 */
+ void *reserved33;
int (*tclGetIntForIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr)); /* 34 */
void *reserved35;
int (*tclGetLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, long * longPtr)); /* 36 */
@@ -1158,7 +1148,7 @@ typedef struct TclIntStubs {
void (*tclProcCleanupProc) _ANSI_ARGS_((Proc * procPtr)); /* 91 */
int (*tclProcCompileProc) _ANSI_ARGS_((Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName)); /* 92 */
void (*tclProcDeleteProc) _ANSI_ARGS_((ClientData clientData)); /* 93 */
- int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv)); /* 94 */
+ void *reserved94;
void *reserved95;
int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); /* 96 */
void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp * interp, Command * newCmdPtr)); /* 97 */
@@ -1395,10 +1385,7 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclGetFrame \
(tclIntStubsPtr->tclGetFrame) /* 32 */
#endif
-#ifndef TclGetInterpProc
-#define TclGetInterpProc \
- (tclIntStubsPtr->tclGetInterpProc) /* 33 */
-#endif
+/* Slot 33 is reserved */
#ifndef TclGetIntForIndex
#define TclGetIntForIndex \
(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
@@ -1579,10 +1566,7 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclProcDeleteProc \
(tclIntStubsPtr->tclProcDeleteProc) /* 93 */
#endif
-#ifndef TclProcInterpProc
-#define TclProcInterpProc \
- (tclIntStubsPtr->tclProcInterpProc) /* 94 */
-#endif
+/* Slot 94 is reserved */
/* Slot 95 is reserved */
#ifndef TclRenameCommand
#define TclRenameCommand \
diff --git a/generic/tclProc.c b/generic/tclProc.c
index d7d4fe7..53e7633 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.53 2004/08/24 23:25:04 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.54 2004/08/25 01:11:20 dgp Exp $
*/
#include "tclInt.h"
@@ -133,8 +133,6 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
}
Tcl_DStringAppend(&ds, procName, -1);
- Tcl_CreateCommand(interp, Tcl_DStringValue(&ds), TclProcInterpProc,
- (ClientData) procPtr, TclProcDeleteProc);
cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);
@@ -731,10 +729,10 @@ TclFindProc(iPtr, procName)
if (origCmd != NULL) {
cmdPtr = (Command *) origCmd;
}
- if (cmdPtr->proc != TclProcInterpProc) {
+ if (cmdPtr->objProc != TclObjInterpProc) {
return NULL;
}
- return (Proc *) cmdPtr->clientData;
+ return (Proc *) cmdPtr->objClientData;
}
/*
@@ -765,8 +763,8 @@ TclIsProc(cmdPtr)
if (origCmd != NULL) {
cmdPtr = (Command *) origCmd;
}
- if (cmdPtr->proc == TclProcInterpProc) {
- return (Proc *) cmdPtr->clientData;
+ if (cmdPtr->objProc == TclObjInterpProc) {
+ return (Proc *) cmdPtr->objClientData;
}
return (Proc *) 0;
}
@@ -774,99 +772,6 @@ TclIsProc(cmdPtr)
/*
*----------------------------------------------------------------------
*
- * TclProcInterpProc --
- *
- * When a Tcl procedure gets invoked with an argc/argv array of
- * strings, this routine gets invoked to interpret the procedure.
- *
- * Results:
- * A standard Tcl result value, usually TCL_OK.
- *
- * Side effects:
- * Depends on the commands in the procedure.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclProcInterpProc(clientData, interp, argc, argv)
- ClientData clientData; /* Record describing procedure to be
- * interpreted. */
- Tcl_Interp *interp; /* Interpreter in which procedure was
- * invoked. */
- int argc; /* Count of number of arguments to this
- * procedure. */
- register CONST char **argv; /* Argument values. */
-{
- register Tcl_Obj *objPtr;
- register int i;
- int 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++) {
- objv[i] = Tcl_NewStringObj(argv[i], -1);
- Tcl_IncrRefCount(objv[i]);
- }
- objv[argc] = 0;
-
- /*
- * Use TclObjInterpProc to actually interpret the procedure.
- */
-
- result = TclObjInterpProc(clientData, interp, argc, objv);
-
- /*
- * 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];
- TclDecrRefCount(objPtr);
- }
-
- /*
- * Free the objv array if malloc'ed storage was used.
- */
-
- if (objv != objStorage) {
- ckfree((char *) objv);
- }
- return result;
-#undef NUM_ARGS
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclObjInterpProc --
*
* When a Tcl procedure gets invoked during bytecode evaluation, this
@@ -1478,31 +1383,6 @@ TclUpdateReturnInfo(iPtr)
/*
*----------------------------------------------------------------------
*
- * TclGetInterpProc --
- *
- * Returns a pointer to the TclProcInterpProc procedure; this is different
- * from the value obtained from the TclProcInterpProc reference on systems
- * like Windows where import and export versions of a procedure exported
- * by a DLL exist.
- *
- * Results:
- * Returns the internal address of the TclProcInterpProc procedure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-TclCmdProcType
-TclGetInterpProc()
-{
- return (TclCmdProcType) TclProcInterpProc;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclGetObjInterpProc --
*
* Returns a pointer to the TclObjInterpProc procedure; this is different
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index c6c9232..4983996 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.100 2004/07/03 02:03:38 msofer Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.101 2004/08/25 01:11:20 dgp Exp $
*/
#include "tclInt.h"
@@ -112,7 +112,7 @@ TclIntStubs tclIntStubs = {
NULL, /* 30 */
TclGetExtension, /* 31 */
TclGetFrame, /* 32 */
- TclGetInterpProc, /* 33 */
+ NULL, /* 33 */
TclGetIntForIndex, /* 34 */
NULL, /* 35 */
TclGetLong, /* 36 */
@@ -173,7 +173,7 @@ TclIntStubs tclIntStubs = {
TclProcCleanupProc, /* 91 */
TclProcCompileProc, /* 92 */
TclProcDeleteProc, /* 93 */
- TclProcInterpProc, /* 94 */
+ NULL, /* 94 */
NULL, /* 95 */
TclRenameCommand, /* 96 */
TclResetShadowedCmdRefs, /* 97 */
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index 7d66e75..5d8084d 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTestProcBodyObj.c,v 1.2 1998/11/10 06:54:44 jingham Exp $
+ * RCS: @(#) $Id: tclTestProcBodyObj.c,v 1.3 2004/08/25 01:11:20 dgp Exp $
*/
#include "tclInt.h"
@@ -261,15 +261,10 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
/*
* check that this is a procedure and not a builtin command:
- * If a procedure, cmdPtr->objProc is either 0 or TclObjInterpProc,
- * and cmdPtr->proc is either 0 or TclProcInterpProc.
- * Also, the compile proc should be 0, but we don't check for that.
+ * If a procedure, cmdPtr->objProc is TclObjInterpProc.
*/
- if (((cmdPtr->objProc != NULL)
- && (cmdPtr->objProc != TclGetObjInterpProc()))
- || ((cmdPtr->proc != NULL)
- && (cmdPtr->proc != TclGetInterpProc()))) {
+ if (cmdPtr->objProc != TclGetObjInterpProc()) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"command \"", fullName,
"\" is not a Tcl procedure", (char *) NULL);
@@ -280,12 +275,7 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
* it is a Tcl procedure: the client data is the Proc structure
*/
- if (cmdPtr->objProc != NULL) {
- procPtr = (Proc *) cmdPtr->objClientData;
- } else if (cmdPtr->proc != NULL) {
- procPtr = (Proc *) cmdPtr->clientData;
- }
-
+ procPtr = (Proc *) cmdPtr->objClientData;
if (procPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"procedure \"", fullName,
generated by cgit v0.12 at 2024-11-15 13:07:07 (GMT)