From e1d323bc1b41ad79581edc6fe40f4b0f688377ac Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 3 May 2023 14:47:37 +0000 Subject: TIP #666 implementation --- doc/CrtObjCmd.3 | 2 +- doc/CrtTrace.3 | 4 +- generic/tcl.decls | 24 +------ generic/tcl.h | 9 +-- generic/tclBasic.c | 160 ++-------------------------------------------- generic/tclDecls.h | 53 ++++++--------- generic/tclExecute.c | 6 +- generic/tclInt.decls | 3 - generic/tclIntDecls.h | 11 ++-- generic/tclOO.c | 16 ++--- generic/tclOO.decls | 14 ---- generic/tclOO.h | 20 +----- generic/tclOOCall.c | 6 +- generic/tclOODecls.h | 28 ++------ generic/tclOODefineCmds.c | 6 +- generic/tclOOInt.h | 8 --- generic/tclOOMethod.c | 123 ++--------------------------------- generic/tclOOStubInit.c | 3 - generic/tclObj.c | 12 +--- generic/tclProc.c | 48 +------------- generic/tclStubInit.c | 10 +-- generic/tclTrace.c | 51 --------------- tests/tailcall.test | 2 +- unix/dltest/pkgooa.c | 2 + unix/dltest/pkgt.c | 8 +-- 25 files changed, 79 insertions(+), 550 deletions(-) diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index 1481e81..bb63937 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -187,7 +187,7 @@ except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR. typedef int \fBTcl_ObjCmdProc2\fR( ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, - ptrdiff_t \fIobjc\fR, + Tcl_Size \fIobjc\fR, Tcl_Obj *const \fIobjv\fR[]); .CE .PP diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3 index ba5a991..519f348 100644 --- a/doc/CrtTrace.3 +++ b/doc/CrtTrace.3 @@ -88,10 +88,10 @@ typedef int \fBTcl_CmdObjTraceProc\fR( typedef int \fBTcl_CmdObjTraceProc2\fR( \fBvoid *\fR \fIclientData\fR, \fBTcl_Interp\fR* \fIinterp\fR, - ptrdiff_t \fIlevel\fR, + Tcl_Size \fIlevel\fR, const char *\fIcommand\fR, \fBTcl_Command\fR \fIcommandToken\fR, - ptrdiff_t \fIobjc\fR, + Tcl_Size \fIobjc\fR, \fBTcl_Obj\fR *const \fIobjv\fR[]); .CE .PP diff --git a/generic/tcl.decls b/generic/tcl.decls index 2e5d7b4..468f4ac 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2514,35 +2514,13 @@ declare 675 { int Tcl_GetBoolFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr) } -declare 676 { - Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp, - const char *cmdName, - Tcl_ObjCmdProc2 *proc2, void *clientData, - Tcl_CmdDeleteProc *deleteProc) -} -declare 677 { - Tcl_Trace Tcl_CreateObjTrace2(Tcl_Interp *interp, Tcl_Size level, int flags, - Tcl_CmdObjTraceProc2 *objProc2, void *clientData, - Tcl_CmdObjTraceDeleteProc *delProc) -} -declare 678 { - Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, - const char *cmdName, Tcl_ObjCmdProc2 *proc, - Tcl_ObjCmdProc2 *nreProc2, void *clientData, - Tcl_CmdDeleteProc *deleteProc) -} -declare 679 { - int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, - void *clientData, ptrdiff_t objc, Tcl_Obj *const objv[]) -} - # TIP #638. declare 680 { int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr) } declare 681 { - int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, ptrdiff_t numBytes, + int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr) } diff --git a/generic/tcl.h b/generic/tcl.h index 318c7a1..5184177 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -704,9 +704,7 @@ typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); -typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, - ptrdiff_t level, const char *command, Tcl_Command commandInfo, ptrdiff_t objc, - struct Tcl_Obj *const *objv); +#define Tcl_CmdObjTraceProc2 Tcl_CmdObjTraceProc typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); @@ -731,8 +729,7 @@ typedef int (Tcl_MathProc) (void *clientData, Tcl_Interp *interp, typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); -typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, - ptrdiff_t objc, struct Tcl_Obj *const *objv); +#define Tcl_ObjCmdProc2 Tcl_ObjCmdProc typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp); typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); @@ -2176,7 +2173,7 @@ typedef struct Tcl_EncodingType { #define TCL_ENCODING_CHAR_LIMIT 0x10 /* Internal use bits, do not define bits in this space. See above comment */ #define TCL_ENCODING_INTERNAL_USE_MASK 0xFF00 -/* +/* * Reserve top byte for profile values (disjoint, not a mask). In case of * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if * necessary. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 4159cc4..140ea20 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2692,66 +2692,6 @@ Tcl_CreateCommand( *---------------------------------------------------------------------- */ -typedef struct { - Tcl_ObjCmdProc2 *proc; - void *clientData; /* Arbitrary value to pass to proc function. */ - Tcl_CmdDeleteProc *deleteProc; - void *deleteData; /* Arbitrary value to pass to deleteProc function. */ - Tcl_ObjCmdProc2 *nreProc; -} CmdWrapperInfo; - - -static int cmdWrapperProc(void *clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj * const *objv) -{ - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; - if (objc < 0) { - objc = -1; - } - return info->proc(info->clientData, interp, objc, objv); -} - -static void cmdWrapperDeleteProc(void *clientData) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; - - clientData = info->deleteData; - Tcl_CmdDeleteProc *deleteProc = info->deleteProc; - ckfree(info); - if (deleteProc != NULL) { - deleteProc(clientData); - } -} - -Tcl_Command -Tcl_CreateObjCommand2( - Tcl_Interp *interp, /* Token for command interpreter (returned by - * previous call to Tcl_CreateInterp). */ - const char *cmdName, /* Name of command. If it contains namespace - * qualifiers, the new command is put in the - * specified namespace; otherwise it is put in - * the global namespace. */ - Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with - * name. */ - void *clientData, /* Arbitrary value to pass to object - * function. */ - Tcl_CmdDeleteProc *deleteProc - /* If not NULL, gives a function to call when - * this command is deleted. */ -) -{ - CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo)); - info->proc = proc; - info->clientData = clientData; - info->deleteProc = deleteProc; - info->deleteData = clientData; - - return Tcl_CreateObjCommand(interp, cmdName, - (proc ? cmdWrapperProc : NULL), - info, cmdWrapperDeleteProc); -} - Tcl_Command Tcl_CreateObjCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by @@ -3385,14 +3325,8 @@ Tcl_SetCommandInfoFromToken( } cmdPtr->objClientData = infoPtr->objClientData; } - if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { - CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; - info->deleteProc = infoPtr->deleteProc; - info->deleteData = infoPtr->deleteData; - } else { - cmdPtr->deleteProc = infoPtr->deleteProc; - cmdPtr->deleteData = infoPtr->deleteData; - } + cmdPtr->deleteProc = infoPtr->deleteProc; + cmdPtr->deleteData = infoPtr->deleteData; return 1; } @@ -3469,14 +3403,8 @@ Tcl_GetCommandInfoFromToken( infoPtr->objClientData = cmdPtr->objClientData; infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; - if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { - CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; - infoPtr->deleteProc = info->deleteProc; - infoPtr->deleteData = info->deleteData; - } else { - infoPtr->deleteProc = cmdPtr->deleteProc; - infoPtr->deleteData = cmdPtr->deleteData; - } + infoPtr->deleteProc = cmdPtr->deleteProc; + infoPtr->deleteData = cmdPtr->deleteData; infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr; return 1; } @@ -9174,42 +9102,6 @@ Tcl_NRCallObjProc( return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } -int wrapperNRObjProc( - void *clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; - clientData = info->clientData; - Tcl_ObjCmdProc2 *proc = info->proc; - ckfree(info); - return proc(clientData, interp, objc, objv); -} - -int -Tcl_NRCallObjProc2( - Tcl_Interp *interp, - Tcl_ObjCmdProc2 *objProc, - void *clientData, - ptrdiff_t objc, - Tcl_Obj *const objv[]) -{ - if ((size_t)objc > INT_MAX) { - Tcl_WrongNumArgs(interp, 1, objv, "?args?"); - return TCL_ERROR; - } - - NRE_callback *rootPtr = TOP_CB(interp); - CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo)); - info->clientData = clientData; - info->proc = objProc; - - TclNRAddCallback(interp, Dispatch, wrapperNRObjProc, info, - INT2PTR(objc), objv); - return TclNRRunCallbacks(interp, TCL_OK, rootPtr); -} - /* *---------------------------------------------------------------------- * @@ -9238,50 +9130,6 @@ Tcl_NRCallObjProc2( *---------------------------------------------------------------------- */ -static int cmdWrapperNreProc( - void *clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; - if (objc < 0) { - objc = -1; - } - return info->nreProc(info->clientData, interp, objc, objv); -} - -Tcl_Command -Tcl_NRCreateCommand2( - Tcl_Interp *interp, /* Token for command interpreter (returned by - * previous call to Tcl_CreateInterp). */ - const char *cmdName, /* Name of command. If it contains namespace - * qualifiers, the new command is put in the - * specified namespace; otherwise it is put in - * the global namespace. */ - Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with - * name, provides direct access for direct - * calls. */ - Tcl_ObjCmdProc2 *nreProc, /* Object-based function to associate with - * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object - * function. */ - Tcl_CmdDeleteProc *deleteProc) - /* If not NULL, gives a function to call when - * this command is deleted. */ -{ - CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo)); - info->proc = proc; - info->clientData = clientData; - info->nreProc = nreProc; - info->deleteProc = deleteProc; - info->deleteData = clientData; - return Tcl_NRCreateCommand(interp, cmdName, - (proc ? cmdWrapperProc : NULL), - (nreProc ? cmdWrapperNreProc : NULL), - info, cmdWrapperDeleteProc); -} - Tcl_Command Tcl_NRCreateCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by diff --git a/generic/tclDecls.h b/generic/tclDecls.h index f9b36ba..70ab698 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -2009,33 +2009,17 @@ EXTERN int Tcl_GetBool(Tcl_Interp *interp, const char *src, /* 675 */ EXTERN int Tcl_GetBoolFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr); -/* 676 */ -EXTERN Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp, - const char *cmdName, Tcl_ObjCmdProc2 *proc2, - void *clientData, - Tcl_CmdDeleteProc *deleteProc); -/* 677 */ -EXTERN Tcl_Trace Tcl_CreateObjTrace2(Tcl_Interp *interp, - Tcl_Size level, int flags, - Tcl_CmdObjTraceProc2 *objProc2, - void *clientData, - Tcl_CmdObjTraceDeleteProc *delProc); -/* 678 */ -EXTERN Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, - const char *cmdName, Tcl_ObjCmdProc2 *proc, - Tcl_ObjCmdProc2 *nreProc2, void *clientData, - Tcl_CmdDeleteProc *deleteProc); -/* 679 */ -EXTERN int Tcl_NRCallObjProc2(Tcl_Interp *interp, - Tcl_ObjCmdProc2 *objProc2, void *clientData, - ptrdiff_t objc, Tcl_Obj *const objv[]); +/* Slot 676 is reserved */ +/* Slot 677 is reserved */ +/* Slot 678 is reserved */ +/* Slot 679 is reserved */ /* 680 */ EXTERN int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 681 */ EXTERN int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, - ptrdiff_t numBytes, void **clientDataPtr, + Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 682 */ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, @@ -2762,12 +2746,12 @@ typedef struct TclStubs { int (*tclGetUniChar) (Tcl_Obj *objPtr, Tcl_Size index); /* 673 */ int (*tcl_GetBool) (Tcl_Interp *interp, const char *src, int flags, char *charPtr); /* 674 */ int (*tcl_GetBoolFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr); /* 675 */ - Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */ - Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, Tcl_Size level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */ - Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */ - int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, ptrdiff_t objc, Tcl_Obj *const objv[]); /* 679 */ + void (*reserved676)(void); + void (*reserved677)(void); + void (*reserved678)(void); + void (*reserved679)(void); int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */ - int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, ptrdiff_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */ + int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ @@ -4157,14 +4141,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetBool) /* 674 */ #define Tcl_GetBoolFromObj \ (tclStubsPtr->tcl_GetBoolFromObj) /* 675 */ -#define Tcl_CreateObjCommand2 \ - (tclStubsPtr->tcl_CreateObjCommand2) /* 676 */ -#define Tcl_CreateObjTrace2 \ - (tclStubsPtr->tcl_CreateObjTrace2) /* 677 */ -#define Tcl_NRCreateCommand2 \ - (tclStubsPtr->tcl_NRCreateCommand2) /* 678 */ -#define Tcl_NRCallObjProc2 \ - (tclStubsPtr->tcl_NRCallObjProc2) /* 679 */ +/* Slot 676 is reserved */ +/* Slot 677 is reserved */ +/* Slot 678 is reserved */ +/* Slot 679 is reserved */ #define Tcl_GetNumberFromObj \ (tclStubsPtr->tcl_GetNumberFromObj) /* 680 */ #define Tcl_GetNumber \ @@ -4581,6 +4561,11 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GetSlave Tcl_GetChild #define Tcl_GetMaster Tcl_GetParent +#define Tcl_NRCallObjProc2 Tcl_NRCallObjProc +#define Tcl_CreateObjCommand2 Tcl_CreateObjCommand +#define Tcl_CreateObjTrace2 Tcl_CreateObjTrace +#define Tcl_NRCreateCommand2 Tcl_NRCreateCommand + /* TIP #660 */ #define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj diff --git a/generic/tclExecute.c b/generic/tclExecute.c index e3b85b4..f21e0fa 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4789,11 +4789,7 @@ TEBCresume( Method *const mPtr = contextPtr->callPtr->chain[newDepth].mPtr; - if (mPtr->typePtr->version < TCL_OO_METHOD_VERSION_2) { - return mPtr->typePtr->callProc(mPtr->clientData, interp, - (Tcl_ObjectContext) contextPtr, opnd, objv); - } - return ((Tcl_MethodCallProc2 *)(void *)(mPtr->typePtr->callProc))(mPtr->clientData, interp, + return mPtr->typePtr->callProc(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, opnd, objv); } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 1ae651d..d30d56a 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -116,9 +116,6 @@ declare 41 { declare 42 { const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } -declare 43 { - Tcl_ObjCmdProc2 *TclGetObjInterpProc2(void) -} declare 44 { int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr) } diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index e4c0b19..ef76ab2 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -155,8 +155,7 @@ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ EXTERN const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); -/* 43 */ -EXTERN Tcl_ObjCmdProc2 * TclGetObjInterpProc2(void); +/* Slot 43 is reserved */ /* 44 */ EXTERN int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr); @@ -713,7 +712,7 @@ typedef struct TclIntStubs { 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 */ - Tcl_ObjCmdProc2 * (*tclGetObjInterpProc2) (void); /* 43 */ + void (*reserved43)(void); int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */ int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */ int (*tclInExit) (void); /* 46 */ @@ -1014,8 +1013,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */ #define TclpGetUserHome \ (tclIntStubsPtr->tclpGetUserHome) /* 42 */ -#define TclGetObjInterpProc2 \ - (tclIntStubsPtr->tclGetObjInterpProc2) /* 43 */ +/* Slot 43 is reserved */ #define TclGuessPackageName \ (tclIntStubsPtr->tclGuessPackageName) /* 44 */ #define TclHideUnsafeCommands \ @@ -1423,7 +1421,8 @@ extern const TclIntStubs *tclIntStubsPtr; #undef TclSetPreInitScript #undef TclObjInterpProc #define TclObjInterpProc TclGetObjInterpProc() -#define TclObjInterpProc2 TclGetObjInterpProc2() +#define TclObjInterpProc2 TclObjInterpProc + #ifndef TCL_NO_DEPRECATED # define TclSetPreInitScript Tcl_SetPreInitScript # define TclGuessPackageName(fileName, pkgName) ((void)fileName,(void)pkgName,0) diff --git a/generic/tclOO.c b/generic/tclOO.c index 46ab3b2..82a0d80 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -391,9 +391,9 @@ InitFoundation( */ TclNewLiteralStringObj(namePtr, "new"); - TclNewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr, + Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr, namePtr /* keeps ref */, 0 /* private */, NULL, NULL); - fPtr->classCls->constructorPtr = (Method *) TclNewMethod(interp, + fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL); /* @@ -2246,7 +2246,7 @@ CloneObjectMethod( Tcl_Obj *namePtr) { if (mPtr->typePtr == NULL) { - TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, + Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL); } else if (mPtr->typePtr->cloneProc) { ClientData newClientData; @@ -2255,10 +2255,10 @@ CloneObjectMethod( &newClientData) != TCL_OK) { return TCL_ERROR; } - TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, + Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData); } else { - TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, + Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData); } return TCL_OK; @@ -2275,7 +2275,7 @@ CloneClassMethod( Method *m2Ptr; if (mPtr->typePtr == NULL) { - m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, + m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL); } else if (mPtr->typePtr->cloneProc) { ClientData newClientData; @@ -2284,11 +2284,11 @@ CloneClassMethod( &newClientData) != TCL_OK) { return TCL_ERROR; } - m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, + m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData); } else { - m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, + m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData); } diff --git a/generic/tclOO.decls b/generic/tclOO.decls index c933872..c6ffccd 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -135,20 +135,6 @@ declare 30 { declare 31 { Tcl_Obj *Tcl_GetObjectClassName(Tcl_Interp *interp, Tcl_Object object) } -declare 32 { - int Tcl_MethodIsType2(Tcl_Method method, const Tcl_MethodType2 *typePtr, - void **clientDataPtr) -} -declare 33 { - Tcl_Method Tcl_NewInstanceMethod2(Tcl_Interp *interp, Tcl_Object object, - Tcl_Obj *nameObj, int flags, const Tcl_MethodType2 *typePtr, - void *clientData) -} -declare 34 { - Tcl_Method Tcl_NewMethod2(Tcl_Interp *interp, Tcl_Class cls, - Tcl_Obj *nameObj, int flags, const Tcl_MethodType2 *typePtr, - void *clientData) -} ###################################################################### # Private API, exposed to support advanced OO systems that plug in on top of diff --git a/generic/tclOO.h b/generic/tclOO.h index 775bd32..19d93f9 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -62,8 +62,7 @@ typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext; typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv); -typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp, - Tcl_ObjectContext objectContext, ptrdiff_t objc, Tcl_Obj *const *objv); +#define Tcl_MethodCallProc2 Tcl_MethodCallProc typedef void (Tcl_MethodDeleteProc)(void *clientData); typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData, void **newClientData); @@ -94,22 +93,7 @@ typedef struct { * be copied directly. */ } Tcl_MethodType; -typedef struct { - int version; /* Structure version field. Always to be equal - * to TCL_OO_METHOD_VERSION_2 in - * declarations. */ - const char *name; /* Name of this type of method, mostly for - * debugging purposes. */ - Tcl_MethodCallProc2 *callProc; - /* How to invoke this method. */ - Tcl_MethodDeleteProc *deleteProc; - /* How to delete this method's type-specific - * data, or NULL if the type-specific data - * does not need deleting. */ - Tcl_CloneProc *cloneProc; /* How to copy this method's type-specific - * data, or NULL if the type-specific data can - * be copied directly. */ -} Tcl_MethodType2; +#define Tcl_MethodType2 Tcl_MethodType /* * The correct value for the version field of the Tcl_MethodType structure. diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 5430a7d..48405bb 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -369,11 +369,7 @@ TclOOInvokeContext( * Run the method implementation. */ - if (mPtr->typePtr->version < TCL_OO_METHOD_VERSION_2) { - return (mPtr->typePtr->callProc)(mPtr->clientData, interp, - (Tcl_ObjectContext) contextPtr, objc, objv); - } - return ((Tcl_MethodCallProc2 *)(void *)(mPtr->typePtr->callProc))(mPtr->clientData, interp, + return (mPtr->typePtr->callProc)(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, objc, objv); } diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 13e07ec..b379fcf 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -123,20 +123,6 @@ TCLAPI Tcl_Class Tcl_GetClassOfObject(Tcl_Object object); /* 31 */ TCLAPI Tcl_Obj * Tcl_GetObjectClassName(Tcl_Interp *interp, Tcl_Object object); -/* 32 */ -TCLAPI int Tcl_MethodIsType2(Tcl_Method method, - const Tcl_MethodType2 *typePtr, - void **clientDataPtr); -/* 33 */ -TCLAPI Tcl_Method Tcl_NewInstanceMethod2(Tcl_Interp *interp, - Tcl_Object object, Tcl_Obj *nameObj, - int flags, const Tcl_MethodType2 *typePtr, - void *clientData); -/* 34 */ -TCLAPI Tcl_Method Tcl_NewMethod2(Tcl_Interp *interp, Tcl_Class cls, - Tcl_Obj *nameObj, int flags, - const Tcl_MethodType2 *typePtr, - void *clientData); typedef struct { const struct TclOOIntStubs *tclOOIntStubs; @@ -178,9 +164,6 @@ typedef struct TclOOStubs { int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */ Tcl_Class (*tcl_GetClassOfObject) (Tcl_Object object); /* 30 */ Tcl_Obj * (*tcl_GetObjectClassName) (Tcl_Interp *interp, Tcl_Object object); /* 31 */ - int (*tcl_MethodIsType2) (Tcl_Method method, const Tcl_MethodType2 *typePtr, void **clientDataPtr); /* 32 */ - Tcl_Method (*tcl_NewInstanceMethod2) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType2 *typePtr, void *clientData); /* 33 */ - Tcl_Method (*tcl_NewMethod2) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType2 *typePtr, void *clientData); /* 34 */ } TclOOStubs; extern const TclOOStubs *tclOOStubsPtr; @@ -259,15 +242,14 @@ extern const TclOOStubs *tclOOStubsPtr; (tclOOStubsPtr->tcl_GetClassOfObject) /* 30 */ #define Tcl_GetObjectClassName \ (tclOOStubsPtr->tcl_GetObjectClassName) /* 31 */ -#define Tcl_MethodIsType2 \ - (tclOOStubsPtr->tcl_MethodIsType2) /* 32 */ -#define Tcl_NewInstanceMethod2 \ - (tclOOStubsPtr->tcl_NewInstanceMethod2) /* 33 */ -#define Tcl_NewMethod2 \ - (tclOOStubsPtr->tcl_NewMethod2) /* 34 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ +#define Tcl_MethodIsType2 Tcl_MethodIsType +#define Tcl_NewInstanceMethod2 Tcl_NewInstanceMethod +#define Tcl_NewMethod2 Tcl_NewMethod + + #endif /* _TCLOODECLS */ diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 686fd00..42c6637 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -2286,12 +2286,12 @@ TclOODefineSlots( if (slotObject == NULL) { continue; } - TclNewInstanceMethod(fPtr->interp, slotObject, getName, 0, + Tcl_NewInstanceMethod(fPtr->interp, slotObject, getName, 0, &slotInfoPtr->getterType, NULL); - TclNewInstanceMethod(fPtr->interp, slotObject, setName, 0, + Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0, &slotInfoPtr->setterType, NULL); if (slotInfoPtr->resolverType.callProc) { - TclNewInstanceMethod(fPtr->interp, slotObject, resolveName, 0, + Tcl_NewInstanceMethod(fPtr->interp, slotObject, resolveName, 0, &slotInfoPtr->resolverType, NULL); } } diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 725c4ce..165d905 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -495,14 +495,6 @@ MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp, MODULE_SCOPE int TclMethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); -MODULE_SCOPE Tcl_Method TclNewInstanceMethod(Tcl_Interp *interp, - Tcl_Object object, Tcl_Obj *nameObj, - int flags, const Tcl_MethodType *typePtr, - void *clientData); -MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls, - Tcl_Obj *nameObj, int flags, - const Tcl_MethodType *typePtr, - void *clientData); MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 2386c15..80e1757 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -126,7 +126,7 @@ static const Tcl_MethodType fwdMethodType = { */ Tcl_Method -TclNewInstanceMethod( +Tcl_NewInstanceMethod( TCL_UNUSED(Tcl_Interp *), Tcl_Object object, /* The object that has the method attached to * it. */ @@ -187,50 +187,6 @@ TclNewInstanceMethod( oPtr->epoch++; return (Tcl_Method) mPtr; } -Tcl_Method -Tcl_NewInstanceMethod( - TCL_UNUSED(Tcl_Interp *), - Tcl_Object object, /* The object that has the method attached to - * it. */ - Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so, - * up to caller to manage storage (e.g., when - * it is a constructor or destructor). */ - int flags, /* Whether this is a public method. */ - const Tcl_MethodType *typePtr, - /* The type of method this is, which defines - * how to invoke, delete and clone the - * method. */ - void *clientData) /* Some data associated with the particular - * method to be created. */ -{ - if (typePtr->version > TCL_OO_METHOD_VERSION_1) { - Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewInstanceMethod"); - } - return TclNewInstanceMethod(NULL, object, nameObj, flags, - (const Tcl_MethodType *)typePtr, clientData); -} -Tcl_Method -Tcl_NewInstanceMethod2( - TCL_UNUSED(Tcl_Interp *), - Tcl_Object object, /* The object that has the method attached to - * it. */ - Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so, - * up to caller to manage storage (e.g., when - * it is a constructor or destructor). */ - int flags, /* Whether this is a public method. */ - const Tcl_MethodType2 *typePtr, - /* The type of method this is, which defines - * how to invoke, delete and clone the - * method. */ - void *clientData) /* Some data associated with the particular - * method to be created. */ -{ - if (typePtr->version < TCL_OO_METHOD_VERSION_2) { - Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_NewInstanceMethod2"); - } - return TclNewInstanceMethod(NULL, object, nameObj, flags, - (const Tcl_MethodType *)typePtr, clientData); -} /* * ---------------------------------------------------------------------- @@ -243,7 +199,7 @@ Tcl_NewInstanceMethod2( */ Tcl_Method -TclNewMethod( +Tcl_NewMethod( TCL_UNUSED(Tcl_Interp *), Tcl_Class cls, /* The class to attach the method to. */ Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g., @@ -299,48 +255,6 @@ TclNewMethod( return (Tcl_Method) mPtr; } - -Tcl_Method -Tcl_NewMethod( - TCL_UNUSED(Tcl_Interp *), - Tcl_Class cls, /* The class to attach the method to. */ - Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g., - * for constructors or destructors); if so, up - * to caller to manage storage. */ - int flags, /* Whether this is a public method. */ - const Tcl_MethodType *typePtr, - /* The type of method this is, which defines - * how to invoke, delete and clone the - * method. */ - void *clientData) /* Some data associated with the particular - * method to be created. */ -{ - if (typePtr->version > TCL_OO_METHOD_VERSION_1) { - Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewMethod"); - } - return TclNewMethod(NULL, cls, nameObj, flags, typePtr, clientData); -} - -Tcl_Method -Tcl_NewMethod2( - TCL_UNUSED(Tcl_Interp *), - Tcl_Class cls, /* The class to attach the method to. */ - Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g., - * for constructors or destructors); if so, up - * to caller to manage storage. */ - int flags, /* Whether this is a public method. */ - const Tcl_MethodType2 *typePtr, - /* The type of method this is, which defines - * how to invoke, delete and clone the - * method. */ - void *clientData) /* Some data associated with the particular - * method to be created. */ -{ - if (typePtr->version < TCL_OO_METHOD_VERSION_2) { - Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_NewMethod2"); - } - return TclNewMethod(NULL, cls, nameObj, flags, (const Tcl_MethodType *)typePtr, clientData); -} /* * ---------------------------------------------------------------------- @@ -390,7 +304,7 @@ TclOONewBasicMethod( Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1); Tcl_IncrRefCount(namePtr); - TclNewMethod(interp, (Tcl_Class) clsPtr, namePtr, + Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, (dcm->isPublic ? PUBLIC_METHOD : 0), &dcm->definition, NULL); Tcl_DecrRefCount(namePtr); } @@ -615,7 +529,7 @@ TclOOMakeProcInstanceMethod( } } - return TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, + return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, typePtr, clientData); } @@ -728,7 +642,7 @@ TclOOMakeProcMethod( } } - return TclNewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr, + return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr, clientData); } @@ -1488,7 +1402,7 @@ TclOONewForwardInstanceMethod( fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); - return (Method *) TclNewInstanceMethod(interp, (Tcl_Object) oPtr, + return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, &fwdMethodType, fmPtr); } @@ -1527,7 +1441,7 @@ TclOONewForwardMethod( fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); - return (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, nameObj, + return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, &fwdMethodType, fmPtr); } @@ -1782,9 +1696,6 @@ Tcl_MethodIsType( { Method *mPtr = (Method *) method; - if (typePtr->version > TCL_OO_METHOD_VERSION_1) { - Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_MethodIsType"); - } if (mPtr->typePtr == typePtr) { if (clientDataPtr != NULL) { *clientDataPtr = mPtr->clientData; @@ -1795,26 +1706,6 @@ Tcl_MethodIsType( } int -Tcl_MethodIsType2( - Tcl_Method method, - const Tcl_MethodType2 *typePtr, - void **clientDataPtr) -{ - Method *mPtr = (Method *) method; - - if (typePtr->version < TCL_OO_METHOD_VERSION_2) { - Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_MethodIsType2"); - } - if (mPtr->typePtr == (const Tcl_MethodType *)typePtr) { - if (clientDataPtr != NULL) { - *clientDataPtr = mPtr->clientData; - } - return 1; - } - return 0; -} - -int Tcl_MethodIsPublic( Tcl_Method method) { diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c index 7b653cb..b9034f0 100644 --- a/generic/tclOOStubInit.c +++ b/generic/tclOOStubInit.c @@ -76,9 +76,6 @@ const TclOOStubs tclOOStubs = { Tcl_MethodIsPrivate, /* 29 */ Tcl_GetClassOfObject, /* 30 */ Tcl_GetObjectClassName, /* 31 */ - Tcl_MethodIsType2, /* 32 */ - Tcl_NewInstanceMethod2, /* 33 */ - Tcl_NewMethod2, /* 34 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 933138c..e1b5bc4 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -4042,7 +4042,7 @@ int Tcl_GetNumber( Tcl_Interp *interp, const char *bytes, - ptrdiff_t numBytes, + int numBytes, void **clientDataPtr, int *typePtr) { @@ -4057,15 +4057,7 @@ Tcl_GetNumber( numBytes = 0; } if (numBytes < 0) { - numBytes = (ptrdiff_t)strlen(bytes); - } - if (numBytes > INT_MAX) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return TCL_ERROR; + numBytes = (int)strlen(bytes); } objPtr->bytes = (char *) bytes; diff --git a/generic/tclProc.c b/generic/tclProc.c index 3abf3c3..f425985 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1684,42 +1684,6 @@ TclNRInterpProc( return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError); } -static int -NRInterpProc2( - void *clientData, /* Record describing procedure to be - * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was - * invoked. */ - ptrdiff_t objc, /* Count of number of arguments to this - * procedure. */ - Tcl_Obj *const objv[]) /* Argument value objects. */ -{ - int result = TclPushProcCallFrame(clientData, interp, objc, objv, - /*isLambda*/ 0); - - if (result != TCL_OK) { - return TCL_ERROR; - } - return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError); -} - -static int -ObjInterpProc2( - void *clientData, /* Record describing procedure to be - * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was - * invoked. */ - ptrdiff_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, NRInterpProc2, clientData, objc, objv); -} - /* *---------------------------------------------------------------------- @@ -2312,15 +2276,15 @@ TclUpdateReturnInfo( /* *---------------------------------------------------------------------- * - * TclGetObjInterpProc/TclGetObjInterpProc2 -- + * TclGetObjInterpProc -- * - * Returns a pointer to the TclObjInterpProc/ObjInterpProc2 functions; + * Returns a pointer to the TclObjInterpProc functions; * this is different from the value obtained from the TclObjInterpProc * reference on systems like Windows where import and export versions * of a function exported by a DLL exist. * * Results: - * Returns the internal address of the TclObjInterpProc/ObjInterpProc2 + * Returns the internal address of the TclObjInterpProc * functions. * * Side effects: @@ -2334,12 +2298,6 @@ TclGetObjInterpProc(void) { return TclObjInterpProc; } - -Tcl_ObjCmdProc2 * -TclGetObjInterpProc2(void) -{ - return ObjInterpProc2; -} /* *---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index e2d52b9..1a545f6 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -911,7 +911,7 @@ static const TclIntStubs tclIntStubs = { TclGetOpenMode, /* 40 */ TclGetOriginalCommand, /* 41 */ TclpGetUserHome, /* 42 */ - TclGetObjInterpProc2, /* 43 */ + 0, /* 43 */ TclGuessPackageName, /* 44 */ TclHideUnsafeCommands, /* 45 */ TclInExit, /* 46 */ @@ -2047,10 +2047,10 @@ const TclStubs tclStubs = { TclGetUniChar, /* 673 */ Tcl_GetBool, /* 674 */ Tcl_GetBoolFromObj, /* 675 */ - Tcl_CreateObjCommand2, /* 676 */ - Tcl_CreateObjTrace2, /* 677 */ - Tcl_NRCreateCommand2, /* 678 */ - Tcl_NRCallObjProc2, /* 679 */ + 0, /* 676 */ + 0, /* 677 */ + 0, /* 678 */ + 0, /* 679 */ Tcl_GetNumberFromObj, /* 680 */ Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 0b1606a..586c4e9 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -2137,57 +2137,6 @@ TraceVarProc( *---------------------------------------------------------------------- */ -typedef struct { - Tcl_CmdObjTraceProc2 *proc; - Tcl_CmdObjTraceDeleteProc *delProc; - void *clientData; -} TraceWrapperInfo; - -static int traceWrapperProc( - void *clientData, - Tcl_Interp *interp, - Tcl_Size level, - const char *command, - Tcl_Command commandInfo, - Tcl_Size objc, - Tcl_Obj *const objv[]) -{ - TraceWrapperInfo *info = (TraceWrapperInfo *)clientData; - if (objc < 0) { - objc = -1; /* Signal Tcl_CmdObjTraceProc that objc is out of range */ - } - return info->proc(info->clientData, interp, level, command, commandInfo, objc, objv); -} - -static void traceWrapperDelProc(void *clientData) -{ - TraceWrapperInfo *info = (TraceWrapperInfo *)clientData; - clientData = info->clientData; - if (info->delProc) { - info->delProc(clientData); - } - ckfree(info); -} - -Tcl_Trace -Tcl_CreateObjTrace2( - Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Size level, /* Maximum nesting level */ - int flags, /* Flags, see above */ - Tcl_CmdObjTraceProc2 *proc, /* Trace callback */ - void *clientData, /* Client data for the callback */ - Tcl_CmdObjTraceDeleteProc *delProc) - /* Function to call when trace is deleted */ -{ - TraceWrapperInfo *info = (TraceWrapperInfo *)ckalloc(sizeof(TraceWrapperInfo)); - info->proc = proc; - info->delProc = delProc; - info->clientData = clientData; - return Tcl_CreateObjTrace(interp, level, flags, - (proc ? traceWrapperProc : NULL), - info, traceWrapperDelProc); -} - Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp *interp, /* Tcl interpreter */ diff --git a/tests/tailcall.test b/tests/tailcall.test index c9ec674..0016845 100644 --- a/tests/tailcall.test +++ b/tests/tailcall.test @@ -709,7 +709,7 @@ test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body { } -returnCodes 1 -result {namespace "::ns" not found} test tailcall-bug-784befb0ba {tailcall crash with 254 args} -body { - proc tccrash args {llength $args} + proc tccrash args {llength $args} # Must be EXACTLY 254 for crash proc p {} [list tailcall tccrash {*}[lrepeat 254 x]] p diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c index 444bb81..d82b5fa 100644 --- a/unix/dltest/pkgooa.c +++ b/unix/dltest/pkgooa.c @@ -94,6 +94,7 @@ static TclOOStubs stubsCopy = { #ifdef Tcl_GetObjectClassName ,NULL #endif +#if TCL_MAJOR_VERSION > 8 #ifdef Tcl_MethodIsType2 ,NULL #endif @@ -103,6 +104,7 @@ static TclOOStubs stubsCopy = { #ifdef Tcl_NewMethod2 ,NULL #endif +#endif }; DLLEXPORT int diff --git a/unix/dltest/pkgt.c b/unix/dltest/pkgt.c index 0c4b3d7..522f4db 100644 --- a/unix/dltest/pkgt.c +++ b/unix/dltest/pkgt.c @@ -16,10 +16,10 @@ static int TraceProc2 ( void *clientData, Tcl_Interp *interp, - ptrdiff_t level, + Tcl_Size level, const char *command, Tcl_Command commandInfo, - ptrdiff_t objc, + Tcl_Size objc, struct Tcl_Obj *const *objv) { (void)clientData; @@ -55,12 +55,12 @@ static int Pkgt_EqObjCmd2( void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - ptrdiff_t objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_WideInt result; const char *str1, *str2; - ptrdiff_t len1, len2; + Tcl_Size len1, len2; (void)dummy; if (objc != 3) { -- cgit v0.12 From 66f0b0940aa515b94ac3f7cf735146f58a8f337e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 3 May 2023 14:56:13 +0000 Subject: Remove unused TclMethodIsType() --- generic/tclOOInt.h | 3 --- generic/tclOOMethod.c | 17 ----------------- 2 files changed, 20 deletions(-) diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 165d905..6430046 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -492,9 +492,6 @@ MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr); MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr); MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp, Object *useThisObj); -MODULE_SCOPE int TclMethodIsType(Tcl_Method method, - const Tcl_MethodType *typePtr, - void **clientDataPtr); MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 80e1757..feaeb23 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -1672,23 +1672,6 @@ Tcl_MethodName( } int -TclMethodIsType( - Tcl_Method method, - const Tcl_MethodType *typePtr, - void **clientDataPtr) -{ - Method *mPtr = (Method *) method; - - if (mPtr->typePtr == typePtr) { - if (clientDataPtr != NULL) { - *clientDataPtr = mPtr->clientData; - } - return 1; - } - return 0; -} - -int Tcl_MethodIsType( Tcl_Method method, const Tcl_MethodType *typePtr, -- cgit v0.12