Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Make TclObjInterpProc() MODULE_SCOPE |
|---|---|
| Timelines: | family | ancestors | descendants | both | tip-626 |
| Files: | files | file ages | folders |
| SHA3-256: |
f8c96c2ba8cfe7164ebeca8f57f2d177 |
| User & Date: | jan.nijtmans 2022-08-29 21:59:54.999 |
Context
|
2022-08-29
| ||
| 22:07 | Make TclObjInvoke() MODULE_SCOPE too check-in: 883689a334 user: jan.nijtmans tags: tip-626 | |
| 21:59 | Make TclObjInterpProc() MODULE_SCOPE check-in: f8c96c2ba8 user: jan.nijtmans tags: tip-626 | |
| 21:10 | merge-mark check-in: c65b7904a6 user: jan.nijtmans tags: trunk, main | |
| 19:56 | when compiling with TCL_NO_DEPRECATED, remove objProc interfaces check-in: 44af621069 user: jan.nijtmans tags: tip-626 | |
Changes
Changes to generic/tclBasic.c.
| ︙ | ︙ | |||
145 146 147 148 149 150 151 152 153 154 155 156 157 158 | static void DeleteOpCmdClientData(void *clientData); #ifdef USE_DTRACE static Tcl_ObjCmdProc2 DTraceObjCmd; static Tcl_NRPostProc DTraceCmdReturn; #else # define DTraceCmdReturn NULL #endif /* USE_DTRACE */ static Tcl_ObjCmdProc2 ExprAbsFunc; static Tcl_ObjCmdProc2 ExprBinaryFunc; static Tcl_ObjCmdProc2 ExprBoolFunc; static Tcl_ObjCmdProc2 ExprCeilFunc; static Tcl_ObjCmdProc2 ExprDoubleFunc; static Tcl_ObjCmdProc2 ExprFloorFunc; static Tcl_ObjCmdProc2 ExprIntFunc; | > | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | static void DeleteOpCmdClientData(void *clientData); #ifdef USE_DTRACE static Tcl_ObjCmdProc2 DTraceObjCmd; static Tcl_NRPostProc DTraceCmdReturn; #else # define DTraceCmdReturn NULL #endif /* USE_DTRACE */ static Tcl_ObjCmdProc2 InvokeStringCommand; static Tcl_ObjCmdProc2 ExprAbsFunc; static Tcl_ObjCmdProc2 ExprBinaryFunc; static Tcl_ObjCmdProc2 ExprBoolFunc; static Tcl_ObjCmdProc2 ExprCeilFunc; static Tcl_ObjCmdProc2 ExprDoubleFunc; static Tcl_ObjCmdProc2 ExprFloorFunc; static Tcl_ObjCmdProc2 ExprIntFunc; |
| ︙ | ︙ | |||
1022 1023 1024 1025 1026 1027 1028 |
iPtr->deferredCallbacks = NULL;
/*
* Create the core commands. Do it here, rather than calling
* Tcl_CreateCommand, because it's faster (there's no need to check for a
* pre-existing command by the same name). If a command has a Tcl_CmdProc
* but no Tcl_ObjCmdProc2, set the Tcl_ObjCmdProc2 to
| | | 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 |
iPtr->deferredCallbacks = NULL;
/*
* Create the core commands. Do it here, rather than calling
* Tcl_CreateCommand, because it's faster (there's no need to check for a
* pre-existing command by the same name). If a command has a Tcl_CmdProc
* but no Tcl_ObjCmdProc2, set the Tcl_ObjCmdProc2 to
* InvokeStringCommand. This is an object-based wrapper function that
* extracts strings, calls the string function, and creates an object for
* the result. Similarly, if a command has a Tcl_ObjCmdProc2 but no
* Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
*/
for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
if ((cmdInfoPtr->objProc == NULL)
|
| ︙ | ︙ | |||
2438 2439 2440 2441 2442 2443 2444 | * future calls to Tcl_GetCommandName. * * Side effects: * If a command named cmdName already exists for interp, it is deleted. * In the future, when cmdName is seen as the name of a command by * Tcl_Eval, proc will be called. To support the bytecode interpreter, * the command is created with a wrapper Tcl_ObjCmdProc2 | | | 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 | * future calls to Tcl_GetCommandName. * * Side effects: * If a command named cmdName already exists for interp, it is deleted. * In the future, when cmdName is seen as the name of a command by * Tcl_Eval, proc will be called. To support the bytecode interpreter, * the command is created with a wrapper Tcl_ObjCmdProc2 * (InvokeStringCommand) that eventially calls proc. When the command * is deleted from the table, deleteProc will be called. See the manual * entry for details on the calling sequence. * *---------------------------------------------------------------------- */ Tcl_Command |
| ︙ | ︙ | |||
2580 2581 2582 2583 2584 2585 2586 |
cmdPtr = (Command *)Tcl_Alloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = nsPtr;
cmdPtr->refCount = 1;
cmdPtr->cmdEpoch = 0;
cmdPtr->compileProc = NULL;
| | | 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 |
cmdPtr = (Command *)Tcl_Alloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = nsPtr;
cmdPtr->refCount = 1;
cmdPtr->cmdEpoch = 0;
cmdPtr->compileProc = NULL;
cmdPtr->objProc2 = InvokeStringCommand;
cmdPtr->objClientData2 = cmdPtr;
cmdPtr->proc = proc;
cmdPtr->clientData = clientData;
cmdPtr->deleteProc = deleteProc;
cmdPtr->deleteData = clientData;
cmdPtr->flags = 0;
cmdPtr->importRefPtr = NULL;
|
| ︙ | ︙ | |||
2913 2914 2915 2916 2917 2918 2919 |
TclResetShadowedCmdRefs(interp, cmdPtr);
return (Tcl_Command) cmdPtr;
}
/*
*----------------------------------------------------------------------
*
| | | | | 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 |
TclResetShadowedCmdRefs(interp, cmdPtr);
return (Tcl_Command) cmdPtr;
}
/*
*----------------------------------------------------------------------
*
* InvokeStringCommand --
*
* "Wrapper" Tcl_ObjCmdProc2 used to call an existing string-based
* Tcl_CmdProc if no object-based function exists for a command. A
* pointer to this function is stored as the Tcl_ObjCmdProc2 in a Command
* structure. It simply turns around and calls the string Tcl_CmdProc in
* the Command structure.
*
* Results:
* A standard Tcl object result value.
*
* Side effects:
* Besides those side effects of the called Tcl_CmdProc,
* InvokeStringCommand allocates and frees storage.
*
*----------------------------------------------------------------------
*/
int
InvokeStringCommand(
void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Command *cmdPtr = (Command *)clientData;
int i, result;
|
| ︙ | ︙ | |||
3336 3337 3338 3339 3340 3341 3342 |
* The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
*/
cmdPtr = (Command *) cmd;
cmdPtr->proc = infoPtr->proc;
cmdPtr->clientData = infoPtr->clientData;
if (infoPtr->objProc2 == NULL) {
| | | 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 |
* The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
*/
cmdPtr = (Command *) cmd;
cmdPtr->proc = infoPtr->proc;
cmdPtr->clientData = infoPtr->clientData;
if (infoPtr->objProc2 == NULL) {
cmdPtr->objProc2 = InvokeStringCommand;
cmdPtr->objClientData2 = cmdPtr;
cmdPtr->nreProc2 = NULL;
} else {
if (infoPtr->objProc2 != cmdPtr->objProc2) {
cmdPtr->nreProc2 = NULL;
cmdPtr->objProc2 = infoPtr->objProc2;
}
|
| ︙ | ︙ | |||
3451 3452 3453 3454 3455 3456 3457 |
* Set isNativeObjectProc 1 if objProc was registered by a call to
* Tcl_CreateObjCommand. Set isNativeObjectProc 2 if objProc was
* registered by a call to Tcl_CreateObjCommand. Otherwise set it to 0.
*/
cmdPtr = (Command *) cmd;
infoPtr->isNativeObjectProc =
| | | 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 |
* Set isNativeObjectProc 1 if objProc was registered by a call to
* Tcl_CreateObjCommand. Set isNativeObjectProc 2 if objProc was
* registered by a call to Tcl_CreateObjCommand. Otherwise set it to 0.
*/
cmdPtr = (Command *) cmd;
infoPtr->isNativeObjectProc =
(cmdPtr->objProc2 != InvokeStringCommand) ? 2 : 0;
infoPtr->proc = cmdPtr->proc;
infoPtr->clientData = cmdPtr->clientData;
infoPtr->objProc2 = cmdPtr->objProc2;
infoPtr->objClientData2 = cmdPtr->objClientData2;
#ifndef TCL_NO_DEPRECATED
if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
|
| ︙ | ︙ | |||
8544 8545 8546 8547 8548 8549 8550 | * Results: * The return value is a token for the command, which can be used in * future calls to Tcl_GetCommandName. * * Side effects: * If no command named "cmdName" already exists for interp, one is * created. Otherwise, if a command does exist, then if the object-based | | | 8545 8546 8547 8548 8549 8550 8551 8552 8553 8554 8555 8556 8557 8558 8559 | * Results: * The return value is a token for the command, which can be used in * future calls to Tcl_GetCommandName. * * Side effects: * If no command named "cmdName" already exists for interp, one is * created. Otherwise, if a command does exist, then if the object-based * Tcl_ObjCmdProc2 is InvokeStringCommand, we assume Tcl_CreateCommand * was called previously for the same command and just set its * Tcl_ObjCmdProc2 to the argument "proc"; otherwise, we delete the old * command. * * In the future, during bytecode evaluation when "cmdName" is seen as * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based * Tcl_ObjCmdProc2 proc will be called. When the command is deleted from |
| ︙ | ︙ |
Changes to generic/tclInt.decls.
| ︙ | ︙ | |||
87 88 89 90 91 92 93 |
}
declare 38 {
int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,
const char **simpleNamePtr)
}
| | | < > | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 |
}
declare 38 {
int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,
const char **simpleNamePtr)
}
declare 39 {
Tcl_ObjCmdProc2 *TclGetObjInterpProc2(void)
}
declare 40 {
int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
declare 41 {
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
|
| ︙ | ︙ | |||
112 113 114 115 116 117 118 |
declare 51 {
int TclInterpInit(Tcl_Interp *interp)
}
declare 53 {
int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp,
int argc, const char **argv)
}
| > | | | < > > | | | < > | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 |
declare 51 {
int TclInterpInit(Tcl_Interp *interp)
}
declare 53 {
int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp,
int argc, const char **argv)
}
# Removed in 9.0
#declare 54 {
# int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp,
# int objc, Tcl_Obj *const objv[])
#}
declare 55 {
Proc *TclIsProc(Command *cmdPtr)
}
declare 58 {
Var *TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2,
int flags, const char *msg, int createPart1, int createPart2,
Var **arrayPtrPtr)
}
declare 60 {
int TclNeedSpace(const char *start, const char *end)
}
declare 61 {
Tcl_Obj *TclNewProcBodyObj(Proc *procPtr)
}
declare 62 {
int TclObjCommandComplete(Tcl_Obj *cmdPtr)
}
# Removed in 9.0
#declare 63 {
# int TclObjInterpProc(void *clientData, Tcl_Interp *interp,
# size_t objc, Tcl_Obj *const objv[])
#}
declare 64 {
int TclObjInvoke(Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[],
int flags)
}
declare 69 {
void *TclpAlloc(size_t size)
}
|
| ︙ | ︙ | |||
482 483 484 485 486 487 488 |
# TIP #285: Script cancellation support.
declare 237 {
int TclResetCancellation(Tcl_Interp *interp, int force)
}
# NRE functions for "rogue" extensions to exploit NRE; they will need to
# include NRE.h too.
| > | | | < > | 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 |
# TIP #285: Script cancellation support.
declare 237 {
int TclResetCancellation(Tcl_Interp *interp, int force)
}
# NRE functions for "rogue" extensions to exploit NRE; they will need to
# include NRE.h too.
# Removed in 9.0
#declare 238 {
# int TclNRInterpProc(void *clientData, Tcl_Interp *interp,
# size_t objc, Tcl_Obj *const objv[])
#}
declare 239 {
int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
size_t skip, ProcErrorProc *errorProc)
}
declare 240 {
int TclNRRunCallbacks(Tcl_Interp *interp, int result,
struct NRE_callback *rootPtr)
|
| ︙ | ︙ | |||
589 590 591 592 593 594 595 |
Tcl_Obj *TclListTestObj(int length, int leadingSpace, int endSpace)
}
# TIP 625: for unit testing - check list invariants
declare 261 {
void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj)
}
| < < < | 592 593 594 595 596 597 598 599 600 601 602 603 604 605 |
Tcl_Obj *TclListTestObj(int length, int leadingSpace, int endSpace)
}
# TIP 625: for unit testing - check list invariants
declare 261 {
void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj)
}
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.
|
| ︙ | ︙ |
Changes to generic/tclInt.h.
| ︙ | ︙ | |||
3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 | *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- */ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, size_t len); MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); MODULE_SCOPE void TclAdvanceContinuations(size_t *line, int **next, int loc); MODULE_SCOPE void TclAdvanceLines(size_t *line, const char *start, const char *end); MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, | > > > | 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 | *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- */ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, size_t len); MODULE_SCOPE int TclObjInterpProc(void *clientData, Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); MODULE_SCOPE void TclAdvanceContinuations(size_t *line, int **next, int loc); MODULE_SCOPE void TclAdvanceLines(size_t *line, const char *start, const char *end); MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, |
| ︙ | ︙ |
Changes to generic/tclIntDecls.h.
| ︙ | ︙ | |||
116 117 118 119 120 121 122 | /* 38 */ EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); | | > | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | /* 38 */ EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 39 */ EXTERN Tcl_ObjCmdProc2 * TclGetObjInterpProc2(void); /* 40 */ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ EXTERN const char * TclpGetUserHome(const char *name, |
| ︙ | ︙ | |||
142 143 144 145 146 147 148 | /* 51 */ EXTERN int TclInterpInit(Tcl_Interp *interp); /* Slot 52 is reserved */ /* 53 */ EXTERN int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp, int argc, const char **argv); | | < < < | < < < | 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | /* 51 */ EXTERN int TclInterpInit(Tcl_Interp *interp); /* Slot 52 is reserved */ /* 53 */ EXTERN int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp, int argc, const char **argv); /* Slot 54 is reserved */ /* 55 */ EXTERN Proc * TclIsProc(Command *cmdPtr); /* Slot 56 is reserved */ /* Slot 57 is reserved */ /* 58 */ EXTERN Var * TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* Slot 59 is reserved */ /* 60 */ EXTERN int TclNeedSpace(const char *start, const char *end); /* 61 */ EXTERN Tcl_Obj * TclNewProcBodyObj(Proc *procPtr); /* 62 */ EXTERN int TclObjCommandComplete(Tcl_Obj *cmdPtr); /* Slot 63 is reserved */ /* 64 */ EXTERN int TclObjInvoke(Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[], int flags); /* Slot 65 is reserved */ /* Slot 66 is reserved */ /* Slot 67 is reserved */ /* Slot 68 is reserved */ |
| ︙ | ︙ | |||
498 499 500 501 502 503 504 | const char *key, int *newPtr); /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); /* Slot 236 is reserved */ /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); | | < < | 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 | const char *key, int *newPtr); /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); /* Slot 236 is reserved */ /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); /* Slot 238 is reserved */ /* 239 */ EXTERN int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, size_t skip, ProcErrorProc *errorProc); /* 240 */ EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); |
| ︙ | ︙ | |||
578 579 580 581 582 583 584 | /* Slot 259 is reserved */ /* 260 */ EXTERN Tcl_Obj * TclListTestObj(int length, int leadingSpace, int endSpace); /* 261 */ EXTERN void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj); | < < | 571 572 573 574 575 576 577 578 579 580 581 582 583 584 |
/* Slot 259 is reserved */
/* 260 */
EXTERN Tcl_Obj * TclListTestObj(int length, int leadingSpace,
int endSpace);
/* 261 */
EXTERN void TclListObjValidate(Tcl_Interp *interp,
Tcl_Obj *listObj);
typedef struct TclIntStubs {
int magic;
void *hooks;
void (*reserved0)(void);
void (*reserved1)(void);
|
| ︙ | ︙ | |||
624 625 626 627 628 629 630 |
int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */
void (*reserved33)(void);
void (*reserved34)(void);
void (*reserved35)(void);
void (*reserved36)(void);
void (*reserved37)(void);
int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
| | | | | 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 |
int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */
void (*reserved33)(void);
void (*reserved34)(void);
void (*reserved35)(void);
void (*reserved36)(void);
void (*reserved37)(void);
int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
Tcl_ObjCmdProc2 * (*tclGetObjInterpProc2) (void); /* 39 */
int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
void (*reserved43)(void);
void (*reserved44)(void);
int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
int (*tclInExit) (void); /* 46 */
void (*reserved47)(void);
void (*reserved48)(void);
void (*reserved49)(void);
void (*reserved50)(void);
int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
void (*reserved52)(void);
int (*tclInvokeObjectCommand) (void *clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */
void (*reserved54)(void);
Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
void (*reserved56)(void);
void (*reserved57)(void);
Var * (*tclLookupVar) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */
void (*reserved59)(void);
int (*tclNeedSpace) (const char *start, const char *end); /* 60 */
Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */
int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */
void (*reserved63)(void);
int (*tclObjInvoke) (Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[], int flags); /* 64 */
void (*reserved65)(void);
void (*reserved66)(void);
void (*reserved67)(void);
void (*reserved68)(void);
void * (*tclpAlloc) (size_t size); /* 69 */
void (*reserved70)(void);
|
| ︙ | ︙ | |||
823 824 825 826 827 828 829 |
int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
void (*reserved236)(void);
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
| | | 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 |
int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
void (*reserved236)(void);
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
void (*reserved238)(void);
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, size_t skip, ProcErrorProc *errorProc); /* 239 */
int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
int (*tclNREvalObjv) (Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
|
| ︙ | ︙ | |||
847 848 849 850 851 852 853 |
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 256 */
void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
void (*reserved259)(void);
Tcl_Obj * (*tclListTestObj) (int length, int leadingSpace, int endSpace); /* 260 */
void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 261 */
| < | 838 839 840 841 842 843 844 845 846 847 848 849 850 851 |
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 256 */
void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
void (*reserved259)(void);
Tcl_Obj * (*tclListTestObj) (int length, int leadingSpace, int endSpace); /* 260 */
void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 261 */
} TclIntStubs;
extern const TclIntStubs *tclIntStubsPtr;
#ifdef __cplusplus
}
#endif
|
| ︙ | ︙ | |||
919 920 921 922 923 924 925 | /* Slot 33 is reserved */ /* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* Slot 37 is reserved */ #define TclGetNamespaceForQualName \ (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */ | | > | 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 | /* Slot 33 is reserved */ /* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* Slot 37 is reserved */ #define TclGetNamespaceForQualName \ (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */ #define TclGetObjInterpProc2 \ (tclIntStubsPtr->tclGetObjInterpProc2) /* 39 */ #define TclGetOpenMode \ (tclIntStubsPtr->tclGetOpenMode) /* 40 */ #define TclGetOriginalCommand \ (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */ #define TclpGetUserHome \ (tclIntStubsPtr->tclpGetUserHome) /* 42 */ /* Slot 43 is reserved */ |
| ︙ | ︙ | |||
941 942 943 944 945 946 947 | /* Slot 49 is reserved */ /* Slot 50 is reserved */ #define TclInterpInit \ (tclIntStubsPtr->tclInterpInit) /* 51 */ /* Slot 52 is reserved */ #define TclInvokeObjectCommand \ (tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */ | | < | < | 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 | /* Slot 49 is reserved */ /* Slot 50 is reserved */ #define TclInterpInit \ (tclIntStubsPtr->tclInterpInit) /* 51 */ /* Slot 52 is reserved */ #define TclInvokeObjectCommand \ (tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */ /* Slot 54 is reserved */ #define TclIsProc \ (tclIntStubsPtr->tclIsProc) /* 55 */ /* Slot 56 is reserved */ /* Slot 57 is reserved */ #define TclLookupVar \ (tclIntStubsPtr->tclLookupVar) /* 58 */ /* Slot 59 is reserved */ #define TclNeedSpace \ (tclIntStubsPtr->tclNeedSpace) /* 60 */ #define TclNewProcBodyObj \ (tclIntStubsPtr->tclNewProcBodyObj) /* 61 */ #define TclObjCommandComplete \ (tclIntStubsPtr->tclObjCommandComplete) /* 62 */ /* Slot 63 is reserved */ #define TclObjInvoke \ (tclIntStubsPtr->tclObjInvoke) /* 64 */ /* Slot 65 is reserved */ /* Slot 66 is reserved */ /* Slot 67 is reserved */ /* Slot 68 is reserved */ #define TclpAlloc \ |
| ︙ | ︙ | |||
1219 1220 1221 1222 1223 1224 1225 | #define TclVarHashCreateVar \ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ /* Slot 236 is reserved */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ | < | | 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 | #define TclVarHashCreateVar \ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ /* Slot 236 is reserved */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ /* Slot 238 is reserved */ #define TclNRInterpProcCore \ (tclIntStubsPtr->tclNRInterpProcCore) /* 239 */ #define TclNRRunCallbacks \ (tclIntStubsPtr->tclNRRunCallbacks) /* 240 */ #define TclNREvalObjEx \ (tclIntStubsPtr->tclNREvalObjEx) /* 241 */ #define TclNREvalObjv \ |
| ︙ | ︙ | |||
1266 1267 1268 1269 1270 1271 1272 | #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ /* Slot 259 is reserved */ #define TclListTestObj \ (tclIntStubsPtr->tclListTestObj) /* 260 */ #define TclListObjValidate \ (tclIntStubsPtr->tclListObjValidate) /* 261 */ | < < | 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 | #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ /* Slot 259 is reserved */ #define TclListTestObj \ (tclIntStubsPtr->tclListTestObj) /* 260 */ #define TclListObjValidate \ (tclIntStubsPtr->tclListObjValidate) /* 261 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) #undef Tcl_StaticLibrary |
| ︙ | ︙ |
Changes to generic/tclProc.c.
| ︙ | ︙ | |||
43 44 45 46 47 48 49 50 51 52 53 54 55 56 | static void ProcBodyFree(Tcl_Obj *objPtr); static int ProcWrongNumArgs(Tcl_Interp *interp, int skip); static void MakeProcError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void MakeLambdaError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static Tcl_NRPostProc ApplyNR2; static Tcl_NRPostProc InterpProcNR2; static Tcl_NRPostProc Uplevel_Callback; /* * The ProcBodyObjType type | > > | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | static void ProcBodyFree(Tcl_Obj *objPtr); static int ProcWrongNumArgs(Tcl_Interp *interp, int skip); static void MakeProcError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void MakeLambdaError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static Tcl_ObjCmdProc2 NRInterpProc; static Tcl_NRPostProc ApplyNR2; static Tcl_NRPostProc InterpProcNR2; static Tcl_NRPostProc Uplevel_Callback; /* * The ProcBodyObjType type |
| ︙ | ︙ | |||
201 202 203 204 205 206 207 |
Tcl_AddErrorInfo(interp, "\n (creating proc \"");
Tcl_AddErrorInfo(interp, simpleName);
Tcl_AddErrorInfo(interp, "\")");
return TCL_ERROR;
}
cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
| | | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 |
Tcl_AddErrorInfo(interp, "\n (creating proc \"");
Tcl_AddErrorInfo(interp, simpleName);
Tcl_AddErrorInfo(interp, "\")");
return TCL_ERROR;
}
cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
TclObjInterpProc, NRInterpProc, procPtr, TclProcDeleteProc);
/*
* Now initialize the new procedure's cmdPtr field. This will be used
* later when the procedure is called to determine what namespace the
* procedure will run in. This will be different than the current
* namespace if the proc was renamed into a different namespace.
*/
|
| ︙ | ︙ | |||
1604 1605 1606 1607 1608 1609 1610 |
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
/*
* Not used much in the core; external interface for iTcl
*/
| | | | | 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 |
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
/*
* Not used much in the core; external interface for iTcl
*/
return Tcl_NRCallObjProc2(interp, NRInterpProc, clientData, objc, objv);
}
#endif
int
TclObjInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
size_t objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
/*
* Not used much in the core; external interface for iTcl
*/
return Tcl_NRCallObjProc2(interp, NRInterpProc, clientData, objc, objv);
}
int
NRInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
size_t objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
|
| ︙ | ︙ |
Changes to generic/tclStubInit.c.
| ︙ | ︙ | |||
432 433 434 435 436 437 438 |
TclGetFrame, /* 32 */
0, /* 33 */
0, /* 34 */
0, /* 35 */
0, /* 36 */
0, /* 37 */
TclGetNamespaceForQualName, /* 38 */
| | | | | 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 |
TclGetFrame, /* 32 */
0, /* 33 */
0, /* 34 */
0, /* 35 */
0, /* 36 */
0, /* 37 */
TclGetNamespaceForQualName, /* 38 */
TclGetObjInterpProc2, /* 39 */
TclGetOpenMode, /* 40 */
TclGetOriginalCommand, /* 41 */
TclpGetUserHome, /* 42 */
0, /* 43 */
0, /* 44 */
TclHideUnsafeCommands, /* 45 */
TclInExit, /* 46 */
0, /* 47 */
0, /* 48 */
0, /* 49 */
0, /* 50 */
TclInterpInit, /* 51 */
0, /* 52 */
TclInvokeObjectCommand, /* 53 */
0, /* 54 */
TclIsProc, /* 55 */
0, /* 56 */
0, /* 57 */
TclLookupVar, /* 58 */
0, /* 59 */
TclNeedSpace, /* 60 */
TclNewProcBodyObj, /* 61 */
TclObjCommandComplete, /* 62 */
0, /* 63 */
TclObjInvoke, /* 64 */
0, /* 65 */
0, /* 66 */
0, /* 67 */
0, /* 68 */
TclpAlloc, /* 69 */
0, /* 70 */
|
| ︙ | ︙ | |||
631 632 633 634 635 636 637 |
TclGetNamespaceFromObj, /* 231 */
TclEvalObjEx, /* 232 */
TclGetSrcInfoForPc, /* 233 */
TclVarHashCreateVar, /* 234 */
TclInitVarHashTable, /* 235 */
0, /* 236 */
TclResetCancellation, /* 237 */
| | | 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 |
TclGetNamespaceFromObj, /* 231 */
TclEvalObjEx, /* 232 */
TclGetSrcInfoForPc, /* 233 */
TclVarHashCreateVar, /* 234 */
TclInitVarHashTable, /* 235 */
0, /* 236 */
TclResetCancellation, /* 237 */
0, /* 238 */
TclNRInterpProcCore, /* 239 */
TclNRRunCallbacks, /* 240 */
TclNREvalObjEx, /* 241 */
TclNREvalObjv, /* 242 */
TclDbDumpActiveObjects, /* 243 */
TclGetNamespaceChildTable, /* 244 */
TclGetNamespaceCommandTable, /* 245 */
|
| ︙ | ︙ | |||
655 656 657 658 659 660 661 |
TclPtrObjMakeUpvar, /* 255 */
TclPtrUnsetVar, /* 256 */
TclStaticLibrary, /* 257 */
TclpCreateTemporaryDirectory, /* 258 */
0, /* 259 */
TclListTestObj, /* 260 */
TclListObjValidate, /* 261 */
| < | 655 656 657 658 659 660 661 662 663 664 665 666 667 668 |
TclPtrObjMakeUpvar, /* 255 */
TclPtrUnsetVar, /* 256 */
TclStaticLibrary, /* 257 */
TclpCreateTemporaryDirectory, /* 258 */
0, /* 259 */
TclListTestObj, /* 260 */
TclListObjValidate, /* 261 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
TCL_STUB_MAGIC,
0,
0, /* 0 */
TclpCloseFile, /* 1 */
|
| ︙ | ︙ |
Changes to generic/tclTest.c.
| ︙ | ︙ | |||
80 81 82 83 84 85 86 |
char *command; /* Command to invoke when the handler is
* invoked. */
struct TestAsyncHandler *nextPtr;
/* Next is list of handlers. */
} TestAsyncHandler;
#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
| > | | > | | | | 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 |
char *command; /* Command to invoke when the handler is
* invoked. */
struct TestAsyncHandler *nextPtr;
/* Next is list of handlers. */
} TestAsyncHandler;
#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
# undef Tcl_CreateObjCommand2
# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand
# define Tcl_ObjCmdProc2 Tcl_ObjCmdProc
# undef Tcl_CreateObjTrace2
# define Tcl_CreateObjTrace2 Tcl_CreateObjTrace
# define TclSizeT int
#else
# define TclSizeT size_t
#endif
/*
* Start of the socket driver state structure to acces field testFlags
*/
typedef struct TcpState TcpState;
|
| ︙ | ︙ | |||
560 561 562 563 564 565 566 |
}
#endif
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
| | | 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 |
}
#endif
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8 && defined(TCL_NO_DEPRECATED)
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
#else
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
#endif
}
|
| ︙ | ︙ | |||
821 822 823 824 825 826 827 |
{
Tcl_CmdInfo info;
if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
| | | 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 |
{
Tcl_CmdInfo info;
if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8 && defined(TCL_NO_DEPRECATED)
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
#else
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
#endif
}
|
| ︙ | ︙ | |||
6557 6558 6559 6560 6561 6562 6563 |
}
msg = Tcl_GetStringFromObj(objv[2], &length);
if (length == 0) {
msg = NULL;
}
| | | 6559 6560 6561 6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 |
}
msg = Tcl_GetStringFromObj(objv[2], &length);
if (length == 0) {
msg = NULL;
}
if ((TclSizeT)i + 3 > objc) {
/*
* Asked for more arguments than were given.
*/
Tcl_AppendResult(interp, "insufficient arguments", NULL);
return TCL_ERROR;
}
|
| ︙ | ︙ |