diff options
Diffstat (limited to 'generic')
109 files changed, 5729 insertions, 9786 deletions
diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 002b264..d6d4cf3 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -828,7 +828,7 @@ element( */ Tcl_DStringInit(&ds); - np = Tcl_UniCharToUtfDString(startp, (int)len, &ds); + np = Tcl_UniCharToUtfDString(startp, len, &ds); for (cn=cnames; cn->name!=NULL; cn++) { if (strlen(cn->name)==len && strncmp(cn->name, np, len)==0) { break; /* NOTE BREAK OUT */ @@ -1000,7 +1000,7 @@ cclass( len = endp - startp; Tcl_DStringInit(&ds); - np = Tcl_UniCharToUtfDString(startp, (int)len, &ds); + np = Tcl_UniCharToUtfDString(startp, len, &ds); /* * Map the name to the corresponding enumerated value. diff --git a/generic/regcustom.h b/generic/regcustom.h index 095385d..64985a6 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -36,9 +36,9 @@ * Overrides for regguts.h definitions, if any. */ -#define MALLOC(n) (void*)(attemptckalloc(n)) -#define FREE(p) ckfree((void*)(p)) -#define REALLOC(p,n) (void*)(attemptckrealloc((void*)(p),n)) +#define MALLOC(n) Tcl_AttemptAlloc(n) +#define FREE(p) Tcl_Free(p) +#define REALLOC(p,n) Tcl_AttemptRealloc(p,n) /* * Do not insert extras between the "begin" and "end" lines - this chunk is diff --git a/generic/regerror.c b/generic/regerror.c index 49d93ed..14f92f6 100644 --- a/generic/regerror.c +++ b/generic/regerror.c @@ -88,7 +88,7 @@ regerror( if (r->code >= 0) { msg = r->name; } else { /* Unknown; tell him the number */ - sprintf(convbuf, "REG_%u", (unsigned)icode); + sprintf(convbuf, "REG_%u", icode); msg = convbuf; } break; diff --git a/generic/tcl.decls b/generic/tcl.decls index 367372d..7af8cea 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -40,22 +40,22 @@ declare 2 { TCL_NORETURN void Tcl_Panic(const char *format, ...) } declare 3 { - char *Tcl_Alloc(unsigned int size) + void *Tcl_Alloc(size_t size) } declare 4 { - void Tcl_Free(char *ptr) + void Tcl_Free(void *ptr) } declare 5 { - char *Tcl_Realloc(char *ptr, unsigned int size) + void *Tcl_Realloc(void *ptr, size_t size) } declare 6 { - char *Tcl_DbCkalloc(unsigned int size, const char *file, int line) + void *Tcl_DbCkalloc(size_t size, const char *file, int line) } declare 7 { - void Tcl_DbCkfree(char *ptr, const char *file, int line) + void Tcl_DbCkfree(void *ptr, const char *file, int line) } declare 8 { - char *Tcl_DbCkrealloc(char *ptr, unsigned int size, + void *Tcl_DbCkrealloc(void *ptr, size_t size, const char *file, int line) } @@ -65,7 +65,7 @@ declare 8 { declare 9 unix { void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, - ClientData clientData) + void *clientData) } declare 10 unix { void Tcl_DeleteFileHandler(int fd) @@ -86,7 +86,7 @@ declare 15 { void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...) } declare 16 { - void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, int length) + void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, size_t length) } declare 17 { Tcl_Obj *Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]) @@ -104,11 +104,12 @@ declare 20 { declare 21 { int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line) } -declare 22 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line) -} +# Removed in 9.0 (changed to macro): +#declare 22 { +# Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line) +#} declare 23 { - Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, + Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, size_t length, const char *file, int line) } declare 24 { @@ -119,23 +120,24 @@ declare 25 { Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv, const char *file, int line) } -declare 26 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line) -} +# Removed in 9.0 (changed to macro): +#declare 26 { +# Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line) +#} declare 27 { Tcl_Obj *Tcl_DbNewObj(const char *file, int line) } declare 28 { - Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, int length, + Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, size_t length, const char *file, int line) } declare 29 { Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr) } -# Only available as stub-entry, for backwards-compatible stub-enabled extensions -declare 30 { - void TclOldFreeObj(Tcl_Obj *objPtr) -} +# Removed in 9.0 +#declare 30 { +# void TclFreeObj(Tcl_Obj *objPtr) +#} declare 31 { int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr) } @@ -153,10 +155,11 @@ declare 35 { int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr) } -declare 36 {deprecated {No longer in use, changed to macro}} { - int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - const char *const *tablePtr, const char *msg, int flags, int *indexPtr) -} +# Removed in 9.0, replaced by macro. +#declare 36 {deprecated {No longer in use, changed to macro}} { +# int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +# const char *const *tablePtr, const char *msg, int flags, int *indexPtr) +#} declare 37 { int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr) } @@ -167,7 +170,7 @@ declare 39 { int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr) } declare 40 { - CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName) + const Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) @@ -199,65 +202,73 @@ declare 48 { int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]) } -declare 49 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_NewBooleanObj(int boolValue) -} +# Removed in 9.0 (changed to macro): +#declare 49 { +# Tcl_Obj *Tcl_NewBooleanObj(int boolValue) +#} declare 50 { - Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length) + Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, size_t length) } declare 51 { Tcl_Obj *Tcl_NewDoubleObj(double doubleValue) } -declare 52 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_NewIntObj(int intValue) -} +# Removed in 9.0 (changed to macro): +#declare 52 { +# Tcl_Obj *Tcl_NewIntObj(int intValue) +#} declare 53 { Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[]) } -declare 54 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_NewLongObj(long longValue) -} +# Removed in 9.0 (changed to macro): +#declare 54 { +# Tcl_Obj *Tcl_NewLongObj(long longValue) +#} declare 55 { Tcl_Obj *Tcl_NewObj(void) } declare 56 { - Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length) -} -declare 57 {deprecated {No longer in use, changed to macro}} { - void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) + Tcl_Obj *Tcl_NewStringObj(const char *bytes, size_t length) } +# Removed in 9.0 (changed to macro): +#declare 57 { +# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) +#} declare 58 { - unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length) + unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, size_t length) } declare 59 { void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes, - int length) + size_t length) } declare 60 { void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue) } -declare 61 {deprecated {No longer in use, changed to macro}} { - void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) -} +# Removed in 9.0 (changed to macro): +#declare 61 { +# void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) +#} declare 62 { void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]) } -declare 63 {deprecated {No longer in use, changed to macro}} { - void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue) -} +# Removed in 9.0 (changed to macro): +#declare 63 { +# void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue) +#} declare 64 { - void Tcl_SetObjLength(Tcl_Obj *objPtr, int length) + void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length) } declare 65 { - void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length) -} -declare 66 {deprecated {No longer in use, changed to macro}} { - void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) -} -declare 67 {deprecated {No longer in use, changed to macro}} { - void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, - int length) -} + void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, size_t length) +} +# Removed in 9.0, replaced by macro. +#declare 66 {deprecated {No longer in use, changed to macro}} { +# void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) +#} +# Removed in 9.0, replaced by macro. +#declare 67 {deprecated {No longer in use, changed to macro}} { +# void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, +# int length) +#} declare 68 { void Tcl_AllowExceptions(Tcl_Interp *interp) } @@ -269,7 +280,7 @@ declare 70 { } declare 71 { Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, - ClientData clientData) + void *clientData) } declare 72 { void Tcl_AsyncDelete(Tcl_AsyncHandler async) @@ -286,19 +297,20 @@ declare 75 { declare 76 { void Tcl_BackgroundError(Tcl_Interp *interp) } -declare 77 {deprecated {Use Tcl_UtfBackslash}} { - char Tcl_Backslash(const char *src, int *readPtr) -} +# Removed in 9.0: +#declare 77 {deprecated {Use Tcl_UtfBackslash}} { +# char Tcl_Backslash(const char *src, int *readPtr) +#} declare 78 { int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList) } declare 79 { void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, - ClientData clientData) + void *clientData) } declare 80 { - void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData) + void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, void *clientData) } declare 81 { int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan) @@ -310,10 +322,10 @@ declare 83 { char *Tcl_Concat(int argc, const char *const *argv) } declare 84 { - int Tcl_ConvertElement(const char *src, char *dst, int flags) + size_t Tcl_ConvertElement(const char *src, char *dst, int flags) } declare 85 { - int Tcl_ConvertCountedElement(const char *src, int length, char *dst, + size_t Tcl_ConvertCountedElement(const char *src, size_t length, char *dst, int flags) } declare 86 { @@ -328,40 +340,41 @@ declare 87 { } declare 88 { Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, - const char *chanName, ClientData instanceData, int mask) + const char *chanName, void *instanceData, int mask) } declare 89 { void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, - Tcl_ChannelProc *proc, ClientData clientData) + Tcl_ChannelProc *proc, void *clientData) } declare 90 { void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, - ClientData clientData) + void *clientData) } declare 91 { Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, - Tcl_CmdProc *proc, ClientData clientData, + Tcl_CmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 92 { void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, - Tcl_EventCheckProc *checkProc, ClientData clientData) + Tcl_EventCheckProc *checkProc, void *clientData) } declare 93 { - void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData) + void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } -declare 95 {deprecated {}} { - void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, - int numArgs, Tcl_ValueType *argTypes, - Tcl_MathProc *proc, ClientData clientData) -} +# Removed in 9.0: +#declare 95 {deprecated {}} { +# void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, +# int numArgs, Tcl_ValueType *argTypes, +# Tcl_MathProc *proc, void *clientData) +#} declare 96 { Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, - Tcl_ObjCmdProc *proc, ClientData clientData, + Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 97 { @@ -370,22 +383,22 @@ declare 97 { } declare 98 { Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, - Tcl_TimerProc *proc, ClientData clientData) + Tcl_TimerProc *proc, void *clientData) } declare 99 { Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, - Tcl_CmdTraceProc *proc, ClientData clientData) + Tcl_CmdTraceProc *proc, void *clientData) } declare 100 { void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name) } declare 101 { void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, - ClientData clientData) + void *clientData) } declare 102 { void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, - ClientData clientData) + void *clientData) } declare 103 { int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName) @@ -394,14 +407,14 @@ declare 104 { int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command) } declare 105 { - void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData) + void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, void *clientData) } declare 106 { void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, - Tcl_EventCheckProc *checkProc, ClientData clientData) + Tcl_EventCheckProc *checkProc, void *clientData) } declare 107 { - void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData) + void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 108 { void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr) @@ -423,16 +436,16 @@ declare 113 { } declare 114 { void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, ClientData clientData) + Tcl_InterpDeleteProc *proc, void *clientData) } declare 115 { int Tcl_DoOneEvent(int flags) } declare 116 { - void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData) + void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData) } declare 117 { - char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, int length) + char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, size_t length) } declare 118 { char *Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element) @@ -453,7 +466,7 @@ declare 123 { void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr) } declare 124 { - void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length) + void Tcl_DStringSetLength(Tcl_DString *dsPtr, size_t length) } declare 125 { void Tcl_DStringStartSublist(Tcl_DString *dsPtr) @@ -467,17 +480,19 @@ declare 127 { declare 128 { const char *Tcl_ErrnoMsg(int err) } -declare 129 { - int Tcl_Eval(Tcl_Interp *interp, const char *script) -} +# Removed in 9.0, replaced by macro. +#declare 129 { +# int Tcl_Eval(Tcl_Interp *interp, const char *script) +#} declare 130 { int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) } -declare 131 {deprecated {No longer in use, changed to macro}} { - int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} +# Removed in 9.0, replaced by macro. +#declare 131 { +# int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} declare 132 { - void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc) + void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc) } declare 133 { TCL_NORETURN void Tcl_Exit(int status) @@ -514,9 +529,10 @@ declare 142 { declare 143 { void Tcl_Finalize(void) } -declare 144 {nostub {Don't use this function in a stub-enabled extension}} { - void Tcl_FindExecutable(const char *argv0) -} +# Removed in 9.0 (stub entry only) +#declare 144 { +# void Tcl_FindExecutable(const char *argv0) +#} declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) @@ -538,7 +554,7 @@ declare 149 { int *objcPtr, Tcl_Obj ***objv) } declare 150 { - ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name, + void *Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr) } declare 151 { @@ -550,10 +566,10 @@ declare 152 { } declare 153 { int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, - ClientData *handlePtr) + void **handlePtr) } declare 154 { - ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan) + void *Tcl_GetChannelInstanceData(Tcl_Channel chan) } declare 155 { int Tcl_GetChannelMode(Tcl_Channel chan) @@ -566,7 +582,7 @@ declare 157 { const char *optionName, Tcl_DString *dsPtr) } declare 158 { - CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) + const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) } declare 159 { int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, @@ -600,7 +616,7 @@ declare 166 { declare 167 unix { int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, ClientData *filePtr) + int checkUsage, void **filePtr) } # Obsolete. Should now use Tcl_FSGetPathType which is objectified # and therefore usually faster. @@ -608,10 +624,10 @@ declare 168 { Tcl_PathType Tcl_GetPathType(const char *path) } declare 169 { - int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr) + size_t Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr) } declare 170 { - int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr) + size_t Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr) } declare 171 { int Tcl_GetServiceMode(void) @@ -625,20 +641,23 @@ declare 173 { declare 174 { const char *Tcl_GetStringResult(Tcl_Interp *interp) } -declare 175 {deprecated {No longer in use, changed to macro}} { - const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, - int flags) -} +# Removed in 9.0, replaced by macro. +#declare 175 {deprecated {No longer in use, changed to macro}} { +# const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, +# int flags) +#} declare 176 { const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } -declare 177 { - int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) -} -declare 178 {deprecated {No longer in use, changed to macro}} { - int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} +# Removed in 9.0, replaced by macro. +#declare 177 { +# int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) +#} +# Removed in 9.0, replaced by macro. +#declare 178 { +# int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} declare 179 { int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken) @@ -677,13 +696,13 @@ declare 187 { # } declare 189 { - Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode) + Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode) } declare 190 { int Tcl_MakeSafe(Tcl_Interp *interp) } declare 191 { - Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket) + Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket) } declare 192 { char *Tcl_Merge(int argc, const char *const *argv) @@ -718,10 +737,10 @@ declare 199 { declare 200 { Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData) + void *callbackData) } declare 201 { - void Tcl_Preserve(ClientData data) + void Tcl_Preserve(void *data) } declare 202 { void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst) @@ -736,7 +755,7 @@ declare 205 { void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position) } declare 206 { - int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead) + size_t Tcl_Read(Tcl_Channel chan, char *bufPtr, size_t toRead) } declare 207 { void Tcl_ReapDetachedProcs(void) @@ -765,24 +784,25 @@ declare 214 { const char *pattern) } declare 215 { - void Tcl_RegExpRange(Tcl_RegExp regexp, int index, + void Tcl_RegExpRange(Tcl_RegExp regexp, size_t index, const char **startPtr, const char **endPtr) } declare 216 { - void Tcl_Release(ClientData clientData) + void Tcl_Release(void *clientData) } declare 217 { void Tcl_ResetResult(Tcl_Interp *interp) } declare 218 { - int Tcl_ScanElement(const char *src, int *flagPtr) + size_t Tcl_ScanElement(const char *src, int *flagPtr) } declare 219 { - int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) -} -declare 220 {deprecated {}} { - int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) + size_t Tcl_ScanCountedElement(const char *src, size_t length, int *flagPtr) } +# Removed in 9.0: +#declare 220 { +# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) +#} declare 221 { int Tcl_ServiceAll(void) } @@ -791,7 +811,7 @@ declare 222 { } declare 223 { void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, - Tcl_InterpDeleteProc *proc, ClientData clientData) + Tcl_InterpDeleteProc *proc, void *clientData) } declare 224 { void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz) @@ -813,16 +833,18 @@ declare 228 { declare 229 { void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr) } -declare 230 {nostub {Don't use this function in a stub-enabled extension}} { - void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) -} +# Removed in 9.0 (stub entry only) +#declare 230 { +# void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) +#} declare 231 { int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth) } -declare 232 { - void Tcl_SetResult(Tcl_Interp *interp, char *result, - Tcl_FreeProc *freeProc) -} +# Removed in 9.0, replaced by macro. +#declare 232 { +# void Tcl_SetResult(Tcl_Interp *interp, char *result, +# Tcl_FreeProc *freeProc) +#} declare 233 { int Tcl_SetServiceMode(int mode) } @@ -835,10 +857,11 @@ declare 235 { declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } -declare 237 {deprecated {No longer in use, changed to macro}} { - const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, - const char *newValue, int flags) -} +# Removed in 9.0, replaced by macro. +#declare 237 {deprecated {No longer in use, changed to macro}} { +# const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, +# const char *newValue, int flags) +#} declare 238 { const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags) @@ -860,30 +883,33 @@ declare 242 { declare 243 { void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr) } -declare 244 {nostub {Don't use this function in a stub-enabled extension}} { - void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, - Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) -} +# Removed in 9.0 (stub entry only) +#declare 244 { +# void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, +# Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) +#} declare 245 { int Tcl_StringMatch(const char *str, const char *pattern) } -declare 246 {deprecated {}} { - int Tcl_TellOld(Tcl_Channel chan) -} -declare 247 {deprecated {No longer in use, changed to macro}} { - int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, - Tcl_VarTraceProc *proc, ClientData clientData) -} +# Removed in 9.0: +#declare 246 { +# int Tcl_TellOld(Tcl_Channel chan) +#} +# Removed in 9.0, replaced by macro. +#declare 247 {deprecated {No longer in use, changed to macro}} { +# int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, +# Tcl_VarTraceProc *proc, ClientData clientData) +#} declare 248 { int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, - int flags, Tcl_VarTraceProc *proc, ClientData clientData) + int flags, Tcl_VarTraceProc *proc, void *clientData) } declare 249 { char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr) } declare 250 { - int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead) + size_t Tcl_Ungets(Tcl_Channel chan, const char *str, size_t len, int atHead) } declare 251 { void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName) @@ -891,29 +917,32 @@ declare 251 { declare 252 { int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } -declare 253 {deprecated {No longer in use, changed to macro}} { - int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) -} +# Removed in 9.0, replaced by macro. +#declare 253 {deprecated {No longer in use, changed to macro}} { +# int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) +#} declare 254 { int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } -declare 255 {deprecated {No longer in use, changed to macro}} { - void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, - Tcl_VarTraceProc *proc, ClientData clientData) -} +# Removed in 9.0, replaced by macro. +#declare 255 {deprecated {No longer in use, changed to macro}} { +# void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, +# Tcl_VarTraceProc *proc, ClientData clientData) +#} declare 256 { void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, - ClientData clientData) + void *clientData) } declare 257 { void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName) } -declare 258 {deprecated {No longer in use, changed to macro}} { - int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, - const char *varName, const char *localName, int flags) -} +# Removed in 9.0, replaced by macro. +#declare 258 {deprecated {No longer in use, changed to macro}} { +# int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, +# const char *varName, const char *localName, int flags) +#} declare 259 { int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags) @@ -921,17 +950,18 @@ declare 259 { declare 260 { int Tcl_VarEval(Tcl_Interp *interp, ...) } -declare 261 {deprecated {No longer in use, changed to macro}} { - ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, - int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) -} +# Removed in 9.0, replaced by macro. +#declare 261 {deprecated {No longer in use, changed to macro}} { +# ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, +# int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) +#} declare 262 { - ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, + void *Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, - ClientData prevClientData) + void *prevClientData) } declare 263 { - int Tcl_Write(Tcl_Channel chan, const char *s, int slen) + size_t Tcl_Write(Tcl_Channel chan, const char *s, size_t slen) } declare 264 { void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, @@ -943,12 +973,14 @@ declare 265 { declare 266 { void Tcl_ValidateAllMemory(const char *file, int line) } -declare 267 {deprecated {see TIP #422}} { - void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList) -} -declare 268 {deprecated {see TIP #422}} { - void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) -} +# Removed in 9.0: +#declare 267 { +# void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList) +#} +# Removed in 9.0: +#declare 268 { +# void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) +#} declare 269 { char *Tcl_HashStats(Tcl_HashTable *tablePtr) } @@ -956,36 +988,42 @@ declare 270 { const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr) } -declare 271 {deprecated {No longer in use, changed to macro}} { - const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, - const char *version, int exact) -} +# Removed in 9.0, replaced by macro. +#declare 271 {deprecated {No longer in use, changed to macro}} { +# const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, +# const char *version, int exact) +#} declare 272 { const char *Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } -declare 273 {deprecated {No longer in use, changed to macro}} { - int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, - const char *version) -} +# Removed in 9.0, replaced by macro. +#declare 273 {deprecated {No longer in use, changed to macro}} { +# int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, +# const char *version) +#} # TIP #268: The internally used new Require function is in slot 573. -declare 274 {deprecated {No longer in use, changed to macro}} { - const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, - const char *version, int exact) -} -declare 275 {deprecated {see TIP #422}} { - void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) -} -declare 276 {deprecated {see TIP #422}} { - int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) -} +# Removed in 9.0, replaced by macro. +#declare 274 {deprecated {No longer in use, changed to macro}} { +# const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, +# const char *version, int exact) +#} +# Removed in 9.0: +#declare 275 { +# void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) +#} +# Removed in 9.0: +#declare 276 { +# int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) +#} declare 277 { Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options) } -declare 278 {deprecated {see TIP #422}} { - TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList) -} +# Removed in 9.0: +#declare 278 { +# TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList) +#} declare 279 { void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type) } @@ -1009,7 +1047,7 @@ declare 280 { declare 281 { Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, - const Tcl_ChannelType *typePtr, ClientData instanceData, + const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan) } declare 282 { @@ -1037,16 +1075,17 @@ declare 287 { Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr) } declare 288 { - void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) + void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 289 { - void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) -} -declare 290 { - void Tcl_DiscardResult(Tcl_SavedResult *statePtr) + void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, void *clientData) } +# Removed in 9.0, replaced by macro. +#declare 290 { +# void Tcl_DiscardResult(Tcl_SavedResult *statePtr) +#} declare 291 { - int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes, + int Tcl_EvalEx(Tcl_Interp *interp, const char *script, size_t numBytes, int flags) } declare 292 { @@ -1061,19 +1100,19 @@ declare 294 { } declare 295 { int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, + const char *src, size_t srcLen, int flags, + Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } declare 296 { char *Tcl_ExternalToUtfDString(Tcl_Encoding encoding, - const char *src, int srcLen, Tcl_DString *dsPtr) + const char *src, size_t srcLen, Tcl_DString *dsPtr) } declare 297 { void Tcl_FinalizeThread(void) } declare 298 { - void Tcl_FinalizeNotifier(ClientData clientData) + void Tcl_FinalizeNotifier(void *clientData) } declare 299 { void Tcl_FreeEncoding(Tcl_Encoding encoding) @@ -1092,18 +1131,18 @@ declare 303 { } declare 304 { int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, - const void *tablePtr, int offset, const char *msg, int flags, + const void *tablePtr, size_t offset, const char *msg, int flags, int *indexPtr) } declare 305 { - void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size) + void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, size_t size) } declare 306 { Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } declare 307 { - ClientData Tcl_InitNotifier(void) + void *Tcl_InitNotifier(void) } declare 308 { void Tcl_MutexLock(Tcl_Mutex *mutexPtr) @@ -1119,18 +1158,20 @@ declare 311 { const Tcl_Time *timePtr) } declare 312 { - int Tcl_NumUtfChars(const char *src, int length) + size_t Tcl_NumUtfChars(const char *src, size_t length) } declare 313 { - int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, - int appendFlag) -} -declare 314 { - void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -} -declare 315 { - void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -} + size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, + size_t charsToRead, int appendFlag) +} +# Removed in 9.0, replaced by macro. +#declare 314 {deprecated {No longer in use, changed to macro}} { +# void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) +#} +# Removed in 9.0, replaced by macro. +#declare 315 {deprecated {No longer in use, changed to macro}} { +# void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) +#} declare 316 { int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name) } @@ -1146,7 +1187,7 @@ declare 319 { Tcl_QueuePosition position) } declare 320 { - int Tcl_UniCharAtIndex(const char *src, int index) + int Tcl_UniCharAtIndex(const char *src, size_t index) } declare 321 { int Tcl_UniCharToLower(int ch) @@ -1161,13 +1202,13 @@ declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { - const char *Tcl_UtfAtIndex(const char *src, int index) + const char *Tcl_UtfAtIndex(const char *src, size_t index) } declare 326 { - int Tcl_UtfCharComplete(const char *src, int length) + int Tcl_UtfCharComplete(const char *src, size_t length) } declare 327 { - int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) + size_t Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) } declare 328 { const char *Tcl_UtfFindFirst(const char *src, int ch) @@ -1183,13 +1224,13 @@ declare 331 { } declare 332 { int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, + const char *src, size_t srcLen, int flags, + Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } declare 333 { char *Tcl_UtfToExternalDString(Tcl_Encoding encoding, - const char *src, int srcLen, Tcl_DString *dsPtr) + const char *src, size_t srcLen, Tcl_DString *dsPtr) } declare 334 { int Tcl_UtfToLower(char *src) @@ -1204,22 +1245,24 @@ declare 337 { int Tcl_UtfToUpper(char *src) } declare 338 { - int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen) + size_t Tcl_WriteChars(Tcl_Channel chan, const char *src, size_t srcLen) } declare 339 { - int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr) + size_t Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr) } declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } -declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} { - const char *Tcl_GetDefaultEncodingDir(void) -} -declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} { - void Tcl_SetDefaultEncodingDir(const char *path) -} +# Removed in 9.0: +#declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} { +# const char *Tcl_GetDefaultEncodingDir(void) +#} +# Removed in 9.0: +#declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} { +# void Tcl_SetDefaultEncodingDir(const char *path) +#} declare 343 { - void Tcl_AlertNotifier(ClientData clientData) + void Tcl_AlertNotifier(void *clientData) } declare 344 { void Tcl_ServiceModeHook(int mode) @@ -1246,55 +1289,57 @@ declare 351 { int Tcl_UniCharIsWordChar(int ch) } declare 352 { - int Tcl_UniCharLen(const Tcl_UniChar *uniStr) + size_t Tcl_UniCharLen(const Tcl_UniChar *uniStr) } declare 353 { int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - unsigned long numChars) + size_t numChars) } declare 354 { char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, - int uniLength, Tcl_DString *dsPtr) + size_t uniLength, Tcl_DString *dsPtr) } declare 355 { Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src, - int length, Tcl_DString *dsPtr) + size_t length, Tcl_DString *dsPtr) } declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } -declare 357 {deprecated {Use Tcl_EvalTokensStandard}} { - Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count) -} +# Removed in 9.0: +#declare 357 {deprecated {Use Tcl_EvalTokensStandard}} { +# Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, +# int count) +#} declare 358 { void Tcl_FreeParse(Tcl_Parse *parsePtr) } declare 359 { void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script, - const char *command, int length) + const char *command, size_t length) } declare 360 { - int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, - Tcl_Parse *parsePtr, int append, const char **termPtr) + int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, + size_t numBytes, Tcl_Parse *parsePtr, int append, + const char **termPtr) } declare 361 { - int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, - int nested, Tcl_Parse *parsePtr) + int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, + size_t numBytes, int nested, Tcl_Parse *parsePtr) } declare 362 { - int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes, + int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr) } declare 363 { int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, - int numBytes, Tcl_Parse *parsePtr, int append, + size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr) } declare 364 { - int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, - Tcl_Parse *parsePtr, int append) + int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, + size_t numBytes, Tcl_Parse *parsePtr, int append) } # These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir, # Tcl_FSAccess and Tcl_FSStat @@ -1311,10 +1356,10 @@ declare 368 { int Tcl_Stat(const char *path, struct stat *bufPtr) } declare 369 { - int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n) + int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) } declare 370 { - int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n) + int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) } declare 371 { int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase) @@ -1333,33 +1378,34 @@ declare 375 { } declare 376 { int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, - Tcl_Obj *textObj, int offset, int nmatches, int flags) + Tcl_Obj *textObj, size_t offset, size_t nmatches, int flags) } declare 377 { void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr) } declare 378 { - Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars) + Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, size_t numChars) } declare 379 { void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - int numChars) + size_t numChars) } declare 380 { - int Tcl_GetCharLength(Tcl_Obj *objPtr) + size_t Tcl_GetCharLength(Tcl_Obj *objPtr) } declare 381 { - int Tcl_GetUniChar(Tcl_Obj *objPtr, int index) -} -declare 382 {deprecated {No longer in use, changed to macro}} { - Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) + int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index) } +# Removed in 9.0, replaced by macro. +#declare 382 {deprecated {No longer in use, changed to macro}} { +# Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) +#} declare 383 { - Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last) + Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last) } declare 384 { void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - int length) + size_t length) } declare 385 { int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, @@ -1378,7 +1424,7 @@ declare 389 { int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern) } declare 390 { - int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, + int Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 391 { @@ -1389,15 +1435,15 @@ declare 392 { } declare 393 { int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, - ClientData clientData, int stackSize, int flags) + void *clientData, size_t stackSize, int flags) } # Introduced in 8.3.2 declare 394 { - int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead) + size_t Tcl_ReadRaw(Tcl_Channel chan, char *dst, size_t bytesToRead) } declare 395 { - int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen) + size_t Tcl_WriteRaw(Tcl_Channel chan, const char *src, size_t srcLen) } declare 396 { Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan) @@ -1485,19 +1531,21 @@ declare 418 { } declare 419 { int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - unsigned long numChars) + size_t numChars) } declare 420 { int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase) } -declare 421 { - Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) -} -declare 422 { - Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, - const void *key, int *newPtr) -} +# Removed in 9.0, as it is actually a macro: +#declare 421 { +# Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) +#} +# Removed in 9.0, as it is actually a macro: +#declare 422 { +# Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, +# const void *key, int *newPtr) +#} declare 423 { void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr) @@ -1506,33 +1554,33 @@ declare 424 { void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr) } declare 425 { - ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, + void *Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, - ClientData prevClientData) + void *prevClientData) } declare 426 { int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, ClientData clientData) + Tcl_CommandTraceProc *proc, void *clientData) } declare 427 { void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, - int flags, Tcl_CommandTraceProc *proc, ClientData clientData) + int flags, Tcl_CommandTraceProc *proc, void *clientData) } declare 428 { - char *Tcl_AttemptAlloc(unsigned int size) + void *Tcl_AttemptAlloc(size_t size) } declare 429 { - char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line) + void *Tcl_AttemptDbCkalloc(size_t size, const char *file, int line) } declare 430 { - char *Tcl_AttemptRealloc(char *ptr, unsigned int size) + void *Tcl_AttemptRealloc(void *ptr, size_t size) } declare 431 { - char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, + void *Tcl_AttemptDbCkrealloc(void *ptr, size_t size, const char *file, int line) } declare 432 { - int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length) + int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, size_t length) } # TIP#10 (thread-aware channels) akupries @@ -1546,14 +1594,16 @@ declare 434 { } # TIP#15 (math function introspection) dkf -declare 435 {deprecated {}} { - int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, - int *numArgsPtr, Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, ClientData *clientDataPtr) -} -declare 436 {deprecated {}} { - Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) -} +# Removed in 9.0: +#declare 435 {deprecated {}} { +# int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, +# int *numArgsPtr, Tcl_ValueType **argTypesPtr, +# Tcl_MathProc **procPtr, void **clientDataPtr) +#} +# Removed in 9.0: +#declare 436 {deprecated {}} { +# Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) +#} # TIP#36 (better access to 'subst') dkf declare 437 { @@ -1615,7 +1665,7 @@ declare 452 { int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr) } declare 453 { - const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, + const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) } declare 454 { @@ -1654,7 +1704,7 @@ declare 464 { Tcl_Obj *const objv[]) } declare 465 { - ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, + void *Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr) } declare 466 { @@ -1665,7 +1715,7 @@ declare 467 { } declare 468 { Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem, - ClientData clientData) + void *clientData) } declare 469 { const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr) @@ -1680,20 +1730,20 @@ declare 472 { Tcl_Obj *Tcl_FSListVolumes(void) } declare 473 { - int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr) + int Tcl_FSRegister(void *clientData, const Tcl_Filesystem *fsPtr) } declare 474 { int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr) } declare 475 { - ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr) + void *Tcl_FSData(const Tcl_Filesystem *fsPtr) } declare 476 { const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr) } declare 477 { - CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) + const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) } declare 478 { Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr) @@ -1710,7 +1760,7 @@ declare 480 { # TIP#56 (evaluate a parsed script) msofer declare 481 { int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count) + size_t count) } # TIP#73 (access to current time) kbk @@ -1721,7 +1771,7 @@ declare 482 { # TIP#32 (object-enabled traces) kbk declare 483 { Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, - Tcl_CmdObjTraceProc *objProc, ClientData clientData, + Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc) } declare 484 { @@ -1819,7 +1869,7 @@ declare 505 { # dkf, API by Brent Welch? declare 506 { Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, - ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) + void *clientData, Tcl_NamespaceDeleteProc *deleteProc) } declare 507 { void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) @@ -1868,20 +1918,20 @@ declare 518 { const char *encodingName) } -# TIP#121 (exit handler) dkf for Joe Mistachkin -declare 519 {nostub {Don't use this function in a stub-enabled extension}} { - Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc) -} +# Removed in 9.0 (stub entry only) +#declare 519 {nostub {Don't use this function in a stub-enabled extension}} { +# Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc) +#} # TIP#143 (resource limits) dkf declare 520 { void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, - Tcl_LimitHandlerProc *handlerProc, ClientData clientData, + Tcl_LimitHandlerProc *handlerProc, void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc) } declare 521 { void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, - Tcl_LimitHandlerProc *handlerProc, ClientData clientData) + Tcl_LimitHandlerProc *handlerProc, void *clientData) } declare 522 { int Tcl_LimitReady(Tcl_Interp *interp) @@ -1994,12 +2044,12 @@ declare 551 { declare 552 { void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) } declare 553 { void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) } # TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4 @@ -2090,8 +2140,8 @@ declare 574 { void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 575 { - void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length, - int limit, const char *ellipsis) + void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, + size_t length, size_t limit, const char *ellipsis) } declare 576 { Tcl_Obj *Tcl_Format(Tcl_Interp *interp, const char *format, int objc, @@ -2113,7 +2163,7 @@ declare 579 { # TIP #285 (script cancellation support) jmistachkin declare 580 { int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr, - ClientData clientData, int flags) + void *clientData, int flags) } declare 581 { int Tcl_Canceled(Tcl_Interp *interp, int flags) @@ -2129,15 +2179,15 @@ declare 582 { declare 583 { Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - Tcl_ObjCmdProc *nreProc, ClientData clientData, + Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 584 { int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } declare 585 { - int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], - int flags) + int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], int flags) } declare 586 { int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, @@ -2145,14 +2195,14 @@ declare 586 { } declare 587 { void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, - ClientData data0, ClientData data1, ClientData data2, - ClientData data3) + void *data0, void *data1, void *data2, + void *data3) } # For use by NR extenders, to have a simple way to also provide a (required!) # classic objProc declare 588 { int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, - ClientData clientData, int objc, Tcl_Obj *const objv[]) + void *clientData, int objc, Tcl_Obj *const objv[]) } # TIP#316 (Tcl_StatBuf reader functions) dkf @@ -2243,15 +2293,15 @@ declare 610 { } declare 611 { int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data, - int buffersize, Tcl_Obj *gzipHeaderDictObj) + size_t buffersize, Tcl_Obj *gzipHeaderDictObj) } declare 612 { unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf, - int len) + size_t len) } declare 613 { unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf, - int len) + size_t len) } declare 614 { int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format, @@ -2270,7 +2320,8 @@ declare 618 { int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush) } declare 619 { - int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count) + int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, + size_t count) } declare 620 { int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle) @@ -2328,7 +2379,7 @@ declare 630 { declare 631 { Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData) + void *callbackData) } # TIP #430 @@ -2353,7 +2404,7 @@ declare 636 { } declare 637 { char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, - unsigned int numBytes) + size_t numBytes) } declare 638 { Tcl_ObjIntRep *Tcl_FetchIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr) @@ -2398,10 +2449,10 @@ interface tclPlat # Added in Tcl 8.1 declare 0 win { - TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr) + TCHAR *Tcl_WinUtfToTChar(const char *str, size_t len, Tcl_DString *dsPtr) } declare 1 win { - char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr) + char *Tcl_WinTCharToUtf(const TCHAR *str, size_t len, Tcl_DString *dsPtr) } ################################ @@ -2410,12 +2461,12 @@ declare 1 win { declare 0 macosx { int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, - int maxPathLen, char *libraryPath) + size_t maxPathLen, char *libraryPath) } declare 1 macosx { int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, - int hasResourceFile, int maxPathLen, char *libraryPath) + int hasResourceFile, size_t maxPathLen, char *libraryPath) } ############################################################################## @@ -2423,9 +2474,6 @@ declare 1 macosx { # Public functions that are not accessible via the stubs table. export { - void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) -} -export { void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp) } diff --git a/generic/tcl.h b/generic/tcl.h index c287a84..a0fd3b3 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -48,30 +48,15 @@ extern "C" { * tools/tcl.hpj.in (not patchlevel, for windows installer) */ -#define TCL_MAJOR_VERSION 8 -#define TCL_MINOR_VERSION 7 +#define TCL_MAJOR_VERSION 9 +#define TCL_MINOR_VERSION 0 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE -#define TCL_RELEASE_SERIAL 2 +#define TCL_RELEASE_SERIAL 0 -#define TCL_VERSION "8.7" -#define TCL_PATCH_LEVEL "8.7a2" +#define TCL_VERSION "9.0" +#define TCL_PATCH_LEVEL "9.0a0" -#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED) -/* - *---------------------------------------------------------------------------- - * The following definitions set up the proper options for Windows compilers. - * We use this method because there is no autoconf equivalent. - */ - -#ifdef _WIN32 -# ifndef __WIN32__ -# define __WIN32__ -# endif -# ifndef WIN32 -# define WIN32 -# endif -#endif - +#if defined(RC_INVOKED) /* * Utility macros: STRINGIFY takes an argument and wraps it in "" (double * quotation marks), JOIN joins two arguments. @@ -85,11 +70,7 @@ extern "C" { # define JOIN(a,b) JOIN1(a,b) # define JOIN1(a,b) a##b #endif - -#ifndef TCL_THREADS -# define TCL_THREADS 1 -#endif -#endif /* !TCL_NO_DEPRECATED */ +#endif /* RC_INVOKED */ /* * A special definition used to allow this header file to be included from @@ -120,32 +101,11 @@ extern "C" { #include <stdio.h> -/* - *---------------------------------------------------------------------------- - * Support for functions with a variable number of arguments. - * - * The following TCL_VARARGS* macros are to support old extensions - * written for older versions of Tcl where the macros permitted - * support for the varargs.h system as well as stdarg.h . - * - * New code should just directly be written to use stdarg.h conventions. - */ - -#include <stdarg.h> -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# define TCL_VARARGS(type, name) (type name, ...) -# define TCL_VARARGS_DEF(type, name) (type name, ...) -# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) -#endif /* !TCL_NO_DEPRECATED */ #if defined(__GNUC__) && (__GNUC__ > 2) # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) # define TCL_NORETURN __attribute__ ((noreturn)) # define TCL_NOINLINE __attribute__ ((noinline)) -# if defined(BUILD_tcl) || defined(BUILD_tk) -# define TCL_NORETURN1 __attribute__ ((noreturn)) -# else -# define TCL_NORETURN1 /* nothing */ -# endif +# define TCL_NORETURN1 __attribute__ ((noreturn)) #else # define TCL_FORMAT_PRINTF(a,b) # if defined(_MSC_VER) && (_MSC_VER >= 1310) @@ -241,33 +201,7 @@ extern "C" { # endif #endif -/* - * The following _ANSI_ARGS_ macro is to support old extensions - * written for older versions of Tcl where it permitted support - * for compilers written in the pre-prototype era of C. - * - * New code should use prototypes. - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# undef _ANSI_ARGS_ -# define _ANSI_ARGS_(x) x - -/* - * Definitions that allow this header file to be used either with or without - * ANSI C features. - */ - -#ifndef INLINE -# define INLINE -#endif -#ifndef CONST -# define CONST const -#endif - -#endif /* !TCL_NO_DEPRECATED */ - -#ifndef CONST86 +#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED) # define CONST86 const #endif @@ -286,40 +220,10 @@ extern "C" { #endif /* - *---------------------------------------------------------------------------- - * The following code is copied from winnt.h. If we don't replicate it here, - * then <windows.h> can't be included after tcl.h, since tcl.h also defines - * VOID. This block is skipped under Cygwin and Mingw. - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID) -#ifndef VOID -#define VOID void -typedef char CHAR; -typedef short SHORT; -typedef long LONG; -#endif -#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */ - -/* - * Macro to use instead of "void" for arguments that must have type "void *" - * in ANSI C; maps them to type "char *" in non-ANSI systems. - */ - -#ifndef __VXWORKS__ -# define VOID void -#endif -#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */ - -/* * Miscellaneous declarations. */ -#ifndef _CLIENTDATA - typedef void *ClientData; -# define _CLIENTDATA -#endif +typedef void *ClientData; /* * Darwin specific configure overrides (to support fat compiles, where @@ -456,17 +360,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ -typedef struct Tcl_Interp -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -{ - /* TIP #330: Strongly discourage extensions from using the string - * result. */ - char *resultDontUse; /* Don't use in extensions! */ - void (*freeProcDontUse) (char *); /* Don't use in extensions! */ - int errorLineDontUse; /* Don't use in extensions! */ -} -#endif /* !TCL_NO_DEPRECATED */ -Tcl_Interp; +typedef struct Tcl_Interp Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; @@ -497,9 +391,9 @@ typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream; */ #if defined _WIN32 -typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData); +typedef unsigned (__stdcall Tcl_ThreadCreateProc) (void *clientData); #else -typedef void (Tcl_ThreadCreateProc) (ClientData clientData); +typedef void (Tcl_ThreadCreateProc) (void *clientData); #endif /* @@ -615,10 +509,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_BREAK 3 #define TCL_CONTINUE 4 -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#define TCL_RESULT_SIZE 200 -#endif - /* *---------------------------------------------------------------------------- * Flags to control what substitutions are performed by Tcl_SubstObj(): @@ -630,27 +520,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_SUBST_ALL 007 /* - * Argument descriptors for math function callbacks in expressions: - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -typedef enum { - TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT -} Tcl_ValueType; - -typedef struct Tcl_Value { - Tcl_ValueType type; /* Indicates intValue or doubleValue is valid, - * or both. */ - long intValue; /* Integer value. */ - double doubleValue; /* Double-precision floating value. */ - Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */ -} Tcl_Value; -#else -#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */ -#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */ -#endif - -/* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the function types declared below. */ @@ -663,62 +532,60 @@ struct Tcl_Obj; */ typedef int (Tcl_AppInitProc) (Tcl_Interp *interp); -typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp, +typedef int (Tcl_AsyncProc) (void *clientData, Tcl_Interp *interp, int code); -typedef void (Tcl_ChannelProc) (ClientData clientData, int mask); -typedef void (Tcl_CloseProc) (ClientData data); -typedef void (Tcl_CmdDeleteProc) (ClientData clientData); -typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_ChannelProc) (void *clientData, int mask); +typedef void (Tcl_CloseProc) (void *data); +typedef void (Tcl_CmdDeleteProc) (void *clientData); +typedef int (Tcl_CmdProc) (void *clientData, Tcl_Interp *interp, int argc, const char *argv[]); -typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, - ClientData cmdClientData, int argc, const char *argv[]); -typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp, + void *cmdClientData, int argc, const char *argv[]); +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 void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData); +typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); -typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src, +typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); -typedef void (Tcl_EncodingFreeProc) (ClientData clientData); +#define Tcl_EncodingFreeProc Tcl_FreeProc typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags); -typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags); -typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData); -typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags); -typedef void (Tcl_ExitProc) (ClientData clientData); -typedef void (Tcl_FileProc) (ClientData clientData, int mask); -typedef void (Tcl_FileFreeProc) (ClientData clientData); +typedef void (Tcl_EventCheckProc) (void *clientData, int flags); +typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, void *clientData); +typedef void (Tcl_EventSetupProc) (void *clientData, int flags); +#define Tcl_ExitProc Tcl_FreeProc +typedef void (Tcl_FileProc) (void *clientData, int mask); +#define Tcl_FileFreeProc Tcl_FreeProc typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); -typedef void (Tcl_FreeProc) (char *blockPtr); -typedef void (Tcl_IdleProc) (ClientData clientData); -typedef void (Tcl_InterpDeleteProc) (ClientData clientData, +typedef void (Tcl_FreeProc) (void *blockPtr); +typedef void (Tcl_IdleProc) (void *clientData); +typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); -typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, - Tcl_Value *args, Tcl_Value *resultPtr); -typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); -typedef int (Tcl_ObjCmdProc) (ClientData 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_PackageInitProc) (Tcl_Interp *interp); typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); -typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan, +typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); -typedef void (Tcl_TimerProc) (ClientData clientData); +typedef void (Tcl_TimerProc) (void *clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); -typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, +typedef char * (Tcl_VarTraceProc) (void *clientData, Tcl_Interp *interp, const char *part1, const char *part2, int flags); -typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_CommandTraceProc) (void *clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, - ClientData clientData); + void *clientData); typedef void (Tcl_DeleteFileHandlerProc) (int fd); -typedef void (Tcl_AlertNotifierProc) (ClientData clientData); +typedef void (Tcl_AlertNotifierProc) (void *clientData); typedef void (Tcl_ServiceModeHookProc) (int mode); -typedef ClientData (Tcl_InitNotifierProc) (void); -typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData); +typedef void *(Tcl_InitNotifierProc) (void); +typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); /* @@ -776,19 +643,19 @@ typedef union Tcl_ObjIntRep { /* The internal representation: */ */ typedef struct Tcl_Obj { - int refCount; /* When 0 the object will be freed. */ + size_t refCount; /* When 0 the object will be freed. */ char *bytes; /* This points to the first byte of the * object's string representation. The array * must be followed by a null byte (i.e., at * offset length) but may also contain * embedded null characters. The array's - * storage is allocated by ckalloc. NULL means + * storage is allocated by Tcl_Alloc. NULL means * the string rep is invalid and must be * regenerated from the internal rep. Clients * should use Tcl_GetStringFromObj or * Tcl_GetString to get a pointer to the byte * array as a readonly value. */ - int length; /* The number of bytes at *bytes, not + size_t length; /* The number of bytes at *bytes, not * including the terminating null. */ const Tcl_ObjType *typePtr; /* Denotes the object's type. Always * corresponds to the type of the object's @@ -800,20 +667,11 @@ typedef struct Tcl_Obj { /* *---------------------------------------------------------------------------- - * The following structure contains the state needed by Tcl_SaveResult. No-one - * outside of Tcl should access any of these fields. This structure is - * typically allocated on the stack. + * The following type contains the state needed by Tcl_SaveResult. It + * is typically allocated on the stack. */ -typedef struct Tcl_SavedResult { - char *result; - Tcl_FreeProc *freeProc; - Tcl_Obj *objResultPtr; - char *appendResult; - int appendAvl; - int appendUsed; - char resultSpace[200+1]; -} Tcl_SavedResult; +typedef Tcl_Obj *Tcl_SavedResult; /* *---------------------------------------------------------------------------- @@ -829,7 +687,7 @@ typedef struct Tcl_Namespace { * is an synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - ClientData clientData; /* Arbitrary value associated with this + void *clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Function invoked when deleting the @@ -901,13 +759,13 @@ typedef struct Tcl_CmdInfo { * Tcl_SetCmdInfo does not modify this * field. */ Tcl_ObjCmdProc *objProc; /* Command's object-based function. */ - ClientData objClientData; /* ClientData for object proc. */ + void *objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based function. */ - ClientData clientData; /* ClientData for string proc. */ + void *clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Function to call when command is * deleted. */ - ClientData deleteData; /* Value to pass to deleteProc (usually the + void *deleteData; /* Value to pass to deleteProc (usually the * same as clientData). */ Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this * command. Note that Tcl_SetCmdInfo will not @@ -927,9 +785,9 @@ typedef struct Tcl_CmdInfo { typedef struct Tcl_DString { char *string; /* Points to beginning of string: either * staticSpace below or a malloced array. */ - int length; /* Number of non-NULL characters in the + size_t length; /* Number of non-NULL characters in the * string. */ - int spaceAvl; /* Total number of bytes available for the + size_t spaceAvl; /* Total number of bytes available for the * string and its terminating NULL char. */ char staticSpace[TCL_DSTRING_STATIC_SIZE]; /* Space to use in common case where string is @@ -938,14 +796,11 @@ typedef struct Tcl_DString { #define Tcl_DStringLength(dsPtr) ((dsPtr)->length) #define Tcl_DStringValue(dsPtr) ((dsPtr)->string) -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# define Tcl_DStringTrunc Tcl_DStringSetLength -#endif /* !TCL_NO_DEPRECATED */ /* * Definitions for the maximum number of digits of precision that may be - * specified in the "tcl_precision" variable, and the number of bytes of - * buffer space required by Tcl_PrintDouble. + * produced by Tcl_PrintDouble, and the number of bytes of buffer space + * required by Tcl_PrintDouble. */ #define TCL_MAX_PREC 17 @@ -1060,17 +915,6 @@ typedef struct Tcl_DString { #define TCL_ALLOW_INLINE_COMPILATION 0x20000 /* - * The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now - * always parsed whenever the part2 is NULL. (This is to avoid a common error - * when converting code to use the new object based APIs and forgetting to - * give the flag) - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# define TCL_PARSE_PART1 0x400 -#endif /* !TCL_NO_DEPRECATED */ - -/* * Types for linked variables: */ @@ -1101,7 +945,7 @@ typedef struct Tcl_DString { */ #ifndef TCL_HASH_TYPE -# define TCL_HASH_TYPE unsigned +# define TCL_HASH_TYPE size_t #endif typedef struct Tcl_HashKeyType Tcl_HashKeyType; @@ -1123,10 +967,8 @@ struct Tcl_HashEntry { Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket, * or NULL for end of chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ - void *hash; /* Hash value, stored as pointer to ensure - * that the offsets of the fields in this - * structure are not changed. */ - ClientData clientData; /* Application stores something here with + size_t hash; /* Hash value. */ + void *clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ @@ -1214,16 +1056,16 @@ struct Tcl_HashTable { Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - int numBuckets; /* Total number of buckets allocated at + size_t numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - int numEntries; /* Total number of entries present in + size_t numEntries; /* Total number of entries present in * table. */ - int rebuildSize; /* Enlarge table when numEntries gets to be + size_t rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ + size_t mask; /* Mask value used in hashing function. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ - int mask; /* Mask value used in hashing function. */ int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, * TCL_ONE_WORD_KEYS, or an integer giving the @@ -1244,7 +1086,7 @@ struct Tcl_HashTable { typedef struct Tcl_HashSearch { Tcl_HashTable *tablePtr; /* Table being searched. */ - int nextIndex; /* Index of next bucket to be enumerated after + size_t nextIndex; /* Index of next bucket to be enumerated after * present one. */ Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current * bucket. */ @@ -1285,7 +1127,7 @@ typedef struct Tcl_HashSearch { typedef struct { void *next; /* Search position for underlying hash * table. */ - unsigned int epoch; /* Epoch marker for dictionary being searched, + size_t epoch; /* Epoch marker for dictionary being searched, * or 0 if search has terminated. */ Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */ } Tcl_DictSearch; @@ -1344,15 +1186,15 @@ typedef struct Tcl_Time { long usec; /* Microseconds. */ } Tcl_Time; -typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr); -typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr); +typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr); +typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr); /* * TIP #233 (Virtualized Time) */ -typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, ClientData clientData); -typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData); +typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, void *clientData); +typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData); /* *---------------------------------------------------------------------------- @@ -1411,40 +1253,40 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData); * Typedefs for the various operations in a channel type: */ -typedef int (Tcl_DriverBlockModeProc) (ClientData instanceData, int mode); -typedef int (Tcl_DriverCloseProc) (ClientData instanceData, +typedef int (Tcl_DriverBlockModeProc) (void *instanceData, int mode); +typedef int (Tcl_DriverCloseProc) (void *instanceData, Tcl_Interp *interp); -typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, +typedef int (Tcl_DriverClose2Proc) (void *instanceData, Tcl_Interp *interp, int flags); -typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, +typedef int (Tcl_DriverInputProc) (void *instanceData, char *buf, int toRead, int *errorCodePtr); -typedef int (Tcl_DriverOutputProc) (ClientData instanceData, +typedef int (Tcl_DriverOutputProc) (void *instanceData, const char *buf, int toWrite, int *errorCodePtr); -typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset, +typedef int (Tcl_DriverSeekProc) (void *instanceData, long offset, int mode, int *errorCodePtr); -typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData, +typedef int (Tcl_DriverSetOptionProc) (void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value); -typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData, +typedef int (Tcl_DriverGetOptionProc) (void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask); -typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData, - int direction, ClientData *handlePtr); -typedef int (Tcl_DriverFlushProc) (ClientData instanceData); -typedef int (Tcl_DriverHandlerProc) (ClientData instanceData, +typedef void (Tcl_DriverWatchProc) (void *instanceData, int mask); +typedef int (Tcl_DriverGetHandleProc) (void *instanceData, + int direction, void **handlePtr); +typedef int (Tcl_DriverFlushProc) (void *instanceData); +typedef int (Tcl_DriverHandlerProc) (void *instanceData, int interestMask); -typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (ClientData instanceData, +typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (void *instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr); /* * TIP #218, Channel Thread Actions */ -typedef void (Tcl_DriverThreadActionProc) (ClientData instanceData, +typedef void (Tcl_DriverThreadActionProc) (void *instanceData, int action); /* * TIP #208, File Truncation (etc.) */ -typedef int (Tcl_DriverTruncateProc) (ClientData instanceData, +typedef int (Tcl_DriverTruncateProc) (void *instanceData, Tcl_WideInt length); /* @@ -1617,7 +1459,7 @@ typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint); typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); -typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, +typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); @@ -1626,13 +1468,13 @@ typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr, - ClientData *clientDataPtr); + void **clientDataPtr); typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr); typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr); -typedef void (Tcl_FSFreeInternalRepProc) (ClientData clientData); -typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData); -typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData); -typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); +#define Tcl_FSFreeInternalRepProc Tcl_FreeProc +typedef void *(Tcl_FSDupInternalRepProc) (void *clientData); +typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (void *clientData); +typedef void *(Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); typedef struct Tcl_FSVersion_ *Tcl_FSVersion; @@ -1662,7 +1504,7 @@ typedef struct Tcl_FSVersion_ *Tcl_FSVersion; typedef struct Tcl_Filesystem { const char *typeName; /* The name of the filesystem. */ - int structureLength; /* Length of this structure, so future binary + size_t structureLength; /* Length of this structure, so future binary * compatibility can be assured. */ Tcl_FSVersion version; /* Version of the filesystem type. */ Tcl_FSPathInFilesystemProc *pathInFilesystemProc; @@ -1852,8 +1694,8 @@ typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; see * below for valid types. */ const char *start; /* First character in token. */ - int size; /* Number of bytes in token. */ - int numComponents; /* If this token is composed of other tokens, + size_t size; /* Number of bytes in token. */ + size_t numComponents; /* If this token is composed of other tokens, * this field tells how many of them there are * (including components of components, etc.). * The component tokens immediately follow @@ -1919,7 +1761,7 @@ typedef struct Tcl_Token { * TCL_TOKEN_OPERATOR - The token describes one expression operator. * An operator might be the name of a math * function such as "abs". A TCL_TOKEN_OPERATOR - * token is always preceded by one + * token is always preceeded by one * TCL_TOKEN_SUB_EXPR token for the operator's * subexpression, and is followed by zero or more * TCL_TOKEN_SUB_EXPR tokens for the operator's @@ -1967,7 +1809,7 @@ typedef struct Tcl_Token { typedef struct Tcl_Parse { const char *commentStart; /* Pointer to # that begins the first of one * or more comments preceding the command. */ - int commentSize; /* Number of bytes in comments (up through + size_t commentSize; /* Number of bytes in comments (up through * newline character that terminates the last * comment). If there were no comments, this * field is 0. */ @@ -2035,10 +1877,10 @@ typedef struct Tcl_EncodingType { Tcl_EncodingConvertProc *fromUtfProc; /* Function to convert from UTF-8 into * external encoding. */ - Tcl_EncodingFreeProc *freeProc; + Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - ClientData clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ int nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This number @@ -2192,8 +2034,8 @@ typedef struct Tcl_Config { * command- or time-limit is exceeded by an interpreter. */ -typedef void (Tcl_LimitHandlerProc) (ClientData clientData, Tcl_Interp *interp); -typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData); +typedef void (Tcl_LimitHandlerProc) (void *clientData, Tcl_Interp *interp); +typedef void (Tcl_LimitHandlerDeleteProc) (void *clientData); /* *---------------------------------------------------------------------------- @@ -2224,7 +2066,7 @@ typedef struct { * depends on type.*/ const char *helpStr; /* Documentation message describing this * option. */ - ClientData clientData; /* Word to pass to function callbacks. */ + void *clientData; /* Word to pass to function callbacks. */ } Tcl_ArgvInfo; /* @@ -2247,9 +2089,9 @@ typedef struct { * argument types: */ -typedef int (Tcl_ArgvFuncProc)(ClientData clientData, Tcl_Obj *objPtr, +typedef int (Tcl_ArgvFuncProc)(void *clientData, Tcl_Obj *objPtr, void *dstPtr); -typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, void *dstPtr); /* @@ -2322,18 +2164,18 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp, #define TCL_TCPSERVER_REUSEPORT (1<<1) /* - * Constants for special int-typed values, see TIP #494 + * Constants for special size_t-typed values, see TIP #494 */ -#define TCL_IO_FAILURE (-1) -#define TCL_AUTO_LENGTH (-1) +#define TCL_IO_FAILURE ((size_t)-1) +#define TCL_AUTO_LENGTH ((size_t)-1) /* *---------------------------------------------------------------------------- * Single public declaration for NRE. */ -typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, +typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, int result); /* @@ -2342,7 +2184,7 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, * stubs tables. If TCL_UTF_MAX>4 use a different value. */ -#define TCL_STUB_MAGIC ((int) 0xFCA3BACF + (TCL_UTF_MAX>4)) +#define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *) + (TCL_UTF_MAX>4)) /* * The following function is required to be defined in all stubs aware @@ -2356,9 +2198,9 @@ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); #if defined(_WIN32) - TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); + TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...); #else -# define Tcl_ConsolePanic ((Tcl_PanicProc *)0) +# define Tcl_ConsolePanic NULL #endif #ifdef USE_TCL_STUBS @@ -2392,11 +2234,19 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)())) -EXTERN void Tcl_MainEx(int argc, char **argv, +EXTERN TCL_NORETURN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact); EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); +EXTERN void Tcl_FindExecutable(const char *argv0); +EXTERN void Tcl_SetPanicProc( + TCL_NORETURN1 Tcl_PanicProc *panicProc); +EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, + const char *pkgName, + Tcl_PackageInitProc *initProc, + Tcl_PackageInitProc *safeInitProc); +EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); #ifndef _WIN32 EXTERN int TclZipfs_AppHook(int *argc, char ***argv); #endif @@ -2424,25 +2274,17 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); /* *---------------------------------------------------------------------------- - * The following declarations either map ckalloc and ckfree to malloc and - * free, or they map them to functions with all sorts of debugging hooks - * defined in tclCkalloc.c. + * The following declarations map ckalloc and ckfree to Tcl_Alloc and + * Tcl_Free. */ -#ifdef TCL_MEM_DEBUG - -# define ckalloc(x) \ - ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) -# define ckfree(x) \ - Tcl_DbCkfree((char *)(x), __FILE__, __LINE__) -# define ckrealloc(x,y) \ - ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) -# define attemptckalloc(x) \ - ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) -# define attemptckrealloc(x,y) \ - ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) +#define ckalloc Tcl_Alloc +#define ckfree Tcl_Free +#define ckrealloc Tcl_Realloc +#define attemptckalloc Tcl_AttemptAlloc +#define attemptckrealloc Tcl_AttemptRealloc -#else /* !TCL_MEM_DEBUG */ +#ifndef TCL_MEM_DEBUG /* * If we are not using the debugging allocator, we should call the Tcl_Alloc, @@ -2450,16 +2292,6 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); * memory allocator both inside and outside of the Tcl library. */ -# define ckalloc(x) \ - ((void *) Tcl_Alloc((unsigned)(x))) -# define ckfree(x) \ - Tcl_Free((char *)(x)) -# define ckrealloc(x,y) \ - ((void *) Tcl_Realloc((char *)(x), (unsigned)(y))) -# define attemptckalloc(x) \ - ((void *) Tcl_AttemptAlloc((unsigned)(x))) -# define attemptckrealloc(x,y) \ - ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory @@ -2479,32 +2311,6 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ Tcl_DbIsShared(objPtr, __FILE__, __LINE__) -#elif (!defined(TCL_NO_DEPRECATED) && defined(USE_TCL_STUBS)) -/* - * When compiling stub-enabled extensions without -DTCL_NO_DEPRECATED, - * those extensions are expected to run fine with Tcl 8.6 as well. - * This means we must continue to use macro's for the above 3 functions, - * and the old stub entry for TclFreeObj. All other usage of TclFreeObj() - * is forbidden now, therefore it is changed to be MODULE_SCOPE internal. - */ -# undef Tcl_IncrRefCount -# define Tcl_IncrRefCount(objPtr) \ - ++(objPtr)->refCount - /* - * Use do/while0 idiom for optimum correctness without compiler warnings. - * http://c2.com/cgi/wiki?TrivialDoWhileLoop - */ -# undef Tcl_DecrRefCount -# define Tcl_DecrRefCount(objPtr) \ - do { \ - Tcl_Obj *_objPtr = (objPtr); \ - if ((_objPtr)->refCount-- <= 1) { \ - TclOldFreeObj(_objPtr); \ - } \ - } while(0) -# undef Tcl_IsShared -# define Tcl_IsShared(objPtr) \ - ((objPtr)->refCount > 1) #endif /* @@ -2546,7 +2352,7 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); */ #define Tcl_GetHashValue(h) ((h)->clientData) -#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value)) +#define Tcl_SetHashValue(h, value) ((h)->clientData = (void *) (value)) #define Tcl_GetHashKey(tablePtr, h) \ ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ @@ -2558,45 +2364,11 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); * hash tables: */ -#undef Tcl_FindHashEntry #define Tcl_FindHashEntry(tablePtr, key) \ (*((tablePtr)->findProc))(tablePtr, (const char *)(key)) -#undef Tcl_CreateHashEntry #define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr) -/* - *---------------------------------------------------------------------------- - * Deprecated Tcl functions: - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -/* - * These function have been renamed. The old names are deprecated, but we - * define these macros for backwards compatibility. - */ - -# define Tcl_Ckalloc Tcl_Alloc -# define Tcl_Ckfree Tcl_Free -# define Tcl_Ckrealloc Tcl_Realloc -# define Tcl_Return Tcl_SetResult -# define Tcl_TildeSubst Tcl_TranslateFileName -#if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */ -# define panic Tcl_Panic -#endif -# define panicVA Tcl_PanicVA - -/* - *---------------------------------------------------------------------------- - * Convenience declaration of Tcl_AppInit for backwards compatibility. This - * function is not *implemented* by the tcl library, so the storage class is - * neither DLLEXPORT nor DLLIMPORT. - */ - -extern Tcl_AppInitProc Tcl_AppInit; - -#endif /* !TCL_NO_DEPRECATED */ - #endif /* RC_INVOKED */ /* diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index df1718b..9dcb431 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -249,9 +249,9 @@ TclFinalizeAllocSubsystem(void) *---------------------------------------------------------------------- */ -char * +void * TclpAlloc( - unsigned int numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { register union overhead *overPtr; register size_t bucket; @@ -274,8 +274,8 @@ TclpAlloc( if (numBytes >= MAXMALLOC - OVERHEAD) { if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) { - bigBlockPtr = (struct block *) TclpSysAlloc((unsigned) - (sizeof(struct block) + OVERHEAD + numBytes), 0); + bigBlockPtr = TclpSysAlloc( + sizeof(struct block) + OVERHEAD + numBytes); } if (bigBlockPtr == NULL) { Tcl_MutexUnlock(allocMutexPtr); @@ -405,8 +405,7 @@ MoreCore( numBlocks = amount / size; ASSERT(numBlocks*size == amount); - blockPtr = (struct block *) TclpSysAlloc( - (sizeof(struct block) + amount), 1); + blockPtr = TclpSysAlloc(sizeof(struct block) + amount); /* no more room! */ if (blockPtr == NULL) { return; @@ -446,7 +445,7 @@ MoreCore( void TclpFree( - char *oldPtr) /* Pointer to memory to free. */ + void *oldPtr) /* Pointer to memory to free. */ { register size_t size; register union overhead *overPtr; @@ -509,10 +508,10 @@ TclpFree( *---------------------------------------------------------------------- */ -char * +void * TclpRealloc( - char *oldPtr, /* Pointer to alloced block. */ - unsigned int numBytes) /* New size of memory. */ + void *oldPtr, /* Pointer to alloced block. */ + size_t numBytes) /* New size of memory. */ { int i; union overhead *overPtr; @@ -692,11 +691,12 @@ mstats( *---------------------------------------------------------------------- */ -char * +#undef TclpAlloc +void * TclpAlloc( - unsigned int numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { - return (char *) malloc(numBytes); + return malloc(numBytes); } /* @@ -715,9 +715,10 @@ TclpAlloc( *---------------------------------------------------------------------- */ +#undef TclpFree void TclpFree( - char *oldPtr) /* Pointer to memory to free. */ + void *oldPtr) /* Pointer to memory to free. */ { free(oldPtr); return; @@ -739,12 +740,12 @@ TclpFree( *---------------------------------------------------------------------- */ -char * +void * TclpRealloc( - char *oldPtr, /* Pointer to alloced block. */ - unsigned int numBytes) /* New size of memory. */ + void *oldPtr, /* Pointer to alloced block. */ + size_t numBytes) /* New size of memory. */ { - return (char *) realloc(oldPtr, numBytes); + return realloc(oldPtr, numBytes); } #endif /* !USE_TCLALLOC */ diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 5db2676..b311552 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -407,7 +407,6 @@ static const TalInstDesc TalInstructionTable[] = { {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0}, {"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0}, {"label", ASSEM_LABEL, 0, 0, 0}, - {"land", ASSEM_1BYTE, INST_LAND, 2, 1}, {"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8 | INST_LAPPEND_SCALAR4), 1, 1}, @@ -435,7 +434,6 @@ static const TalInstDesc TalInstructionTable[] = { | INST_LOAD_ARRAY4), 1, 1}, {"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1}, {"loadStk", ASSEM_1BYTE, INST_LOAD_STK, 1, 1}, - {"lor", ASSEM_1BYTE, INST_LOR, 2, 1}, {"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1}, {"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1}, {"lshift", ASSEM_1BYTE, INST_LSHIFT, 2, 1}, @@ -846,7 +844,7 @@ CompileAssembleObj( * names in the bytecode resolve */ int status; /* Status return from Tcl_AssembleCode */ const char* source; /* String representation of the source code */ - int sourceLen; /* Length of the source code in bytes */ + size_t sourceLen; /* Length of the source code in bytes */ /* * Get the expression ByteCode from the object. If it exists, make sure it @@ -980,7 +978,7 @@ TclCompileAssembleCmd( Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s\" body, line %d)", - parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, + (int)parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, Tcl_GetErrorLine(interp))); envPtr->numCommands = numCommands; envPtr->codeNext = envPtr->codeStart + offset; @@ -1080,8 +1078,8 @@ TclAssembleCode( #ifdef TCL_COMPILE_DEBUG if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) { - printf(" %4ld Assembling: ", - (long)(envPtr->codeNext - envPtr->codeStart)); + printf(" %4" TCL_Z_MODIFIER "d Assembling: ", + envPtr->codeNext - envPtr->codeStart); TclPrintSource(stdout, parsePtr->commandStart, TclMin(instLen, 55)); printf("\n"); @@ -1207,14 +1205,14 @@ FreeAssemblyEnv( Tcl_DecrRefCount(thisBB->jumpTarget); } if (thisBB->foreignExceptions != NULL) { - ckfree(thisBB->foreignExceptions); + Tcl_Free(thisBB->foreignExceptions); } nextBB = thisBB->successor1; if (thisBB->jtPtr != NULL) { DeleteMirrorJumpTable(thisBB->jtPtr); thisBB->jtPtr = NULL; } - ckfree(thisBB); + Tcl_Free(thisBB); } /* @@ -1260,7 +1258,7 @@ AssembleOneLine( Tcl_Obj* operand1Obj = NULL; /* First operand to the instruction */ const char* operand1; /* String rep of the operand */ - int operand1Len; /* String length of the operand */ + size_t operand1Len; /* String length of the operand */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ int localVar; /* LVT index of a local variable */ @@ -1532,7 +1530,7 @@ AssembleOneLine( goto cleanup; } - jtPtr = ckalloc(sizeof(JumptableInfo)); + jtPtr = Tcl_Alloc(sizeof(JumptableInfo)); Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; @@ -1931,7 +1929,7 @@ MoveExceptionRangesToBasicBlock( curr_bb->foreignExceptionBase = savedExceptArrayNext; curr_bb->foreignExceptionCount = exceptionCount; curr_bb->foreignExceptions = - ckalloc(exceptionCount * sizeof(ExceptionRange)); + Tcl_Alloc(exceptionCount * sizeof(ExceptionRange)); memcpy(curr_bb->foreignExceptions, envPtr->exceptArrayPtr + savedExceptArrayNext, exceptionCount * sizeof(ExceptionRange)); @@ -1996,7 +1994,7 @@ CreateMirrorJumpTable( * Allocate the jumptable. */ - jtPtr = ckalloc(sizeof(JumptableInfo)); + jtPtr = Tcl_Alloc(sizeof(JumptableInfo)); jtHashPtr = &jtPtr->hashTable; Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS); @@ -2061,7 +2059,7 @@ DeleteMirrorJumpTable( Tcl_SetHashValue(entry, NULL); } Tcl_DeleteHashTable(jtHashPtr); - ckfree(jtPtr); + Tcl_Free(jtPtr); } /* @@ -2304,7 +2302,7 @@ FindLocalVar( * source code. */ Tcl_Obj* varNameObj; /* Name of the variable */ const char* varNameStr; - int varNameLen; + size_t varNameLen; int localVar; /* Index of the variable in the LVT */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) { @@ -2644,7 +2642,7 @@ AllocBB( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; - BasicBlock *bb = ckalloc(sizeof(BasicBlock)); + BasicBlock *bb = Tcl_Alloc(sizeof(BasicBlock)); bb->originalStartOffset = bb->startOffset = envPtr->codeNext - envPtr->codeStart; @@ -3922,8 +3920,8 @@ BuildExceptionRanges( * Allocate memory for a stack of active catches. */ - catches = ckalloc(maxCatchDepth * sizeof(BasicBlock*)); - catchIndices = ckalloc(maxCatchDepth * sizeof(int)); + catches = Tcl_Alloc(maxCatchDepth * sizeof(BasicBlock*)); + catchIndices = Tcl_Alloc(maxCatchDepth * sizeof(int)); for (i = 0; i < maxCatchDepth; ++i) { catches[i] = NULL; catchIndices[i] = -1; @@ -3962,8 +3960,8 @@ BuildExceptionRanges( /* Free temp storage */ - ckfree(catchIndices); - ckfree(catches); + Tcl_Free(catchIndices); + Tcl_Free(catches); return TCL_OK; } diff --git a/generic/tclAsync.c b/generic/tclAsync.c index 14804e4..44f6a14 100644 --- a/generic/tclAsync.c +++ b/generic/tclAsync.c @@ -118,7 +118,7 @@ Tcl_AsyncCreate( AsyncHandler *asyncPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - asyncPtr = ckalloc(sizeof(AsyncHandler)); + asyncPtr = Tcl_Alloc(sizeof(AsyncHandler)); asyncPtr->ready = 0; asyncPtr->nextPtr = NULL; asyncPtr->proc = proc; @@ -310,7 +310,7 @@ Tcl_AsyncDelete( } } Tcl_MutexUnlock(&tsdPtr->asyncMutex); - ckfree(asyncPtr); + Tcl_Free(asyncPtr); } /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 44acac8..5c51291 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -38,18 +38,6 @@ #endif /* - * The following structure defines the client data for a math function - * registered with Tcl_CreateMathFunc - */ - -typedef struct OldMathFuncData { - Tcl_MathProc *proc; /* Handler function */ - int numArgs; /* Number of args expected */ - Tcl_ValueType *argTypes; /* Types of the args */ - ClientData clientData; /* Client data for the handler function */ -} OldMathFuncData; - -/* * This is the script cancellation struct and hash table. The hash table is * used to keep track of the information necessary to process script * cancellation requests, including the original interp, asynchronous handler @@ -65,7 +53,7 @@ typedef struct { * cancellation. */ char *result; /* The script cancellation result or NULL for * a default result. */ - int length; /* Length of the above error message. */ + size_t length; /* Length of the above error message. */ ClientData clientData; /* Ignored */ int flags; /* Additional flags */ } CancelInfo; @@ -143,10 +131,6 @@ static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static Tcl_NRPostProc NRCommand; -#if !defined(TCL_NO_DEPRECATED) -static Tcl_ObjCmdProc OldMathFuncProc; -static void OldMathFuncDeleteProc(ClientData clientData); -#endif /* !defined(TCL_NO_DEPRECATED) */ static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); @@ -236,9 +220,6 @@ static const CmdInfo builtInCmds[] = { {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, -#endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, @@ -626,16 +607,15 @@ Tcl_CreateInterp(void) * object type table and other object management code. */ - iPtr = ckalloc(sizeof(Interp)); + iPtr = Tcl_Alloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; -#ifdef TCL_NO_DEPRECATED - iPtr->result = &tclEmptyString; -#else - iPtr->result = iPtr->resultSpace; -#endif - iPtr->freeProc = NULL; + iPtr->legacyResult = NULL; + /* Special invalid value: Any attempt to free the legacy result + * will cause a crash. */ + iPtr->legacyFreeProc = (void (*) (void))-1; iPtr->errorLine = 0; + iPtr->stubTable = &tclStubs; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); @@ -643,8 +623,7 @@ Tcl_CreateInterp(void) iPtr->hiddenCmdTablePtr = NULL; iPtr->interpInfo = NULL; - TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable)); - iPtr->extra.optimizer = TclOptimizeBytecode; + iPtr->optimizer = TclOptimizeBytecode; iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; @@ -657,10 +636,10 @@ Tcl_CreateInterp(void) */ iPtr->cmdFramePtr = NULL; - iPtr->linePBodyPtr = ckalloc(sizeof(Tcl_HashTable)); - iPtr->lineBCPtr = ckalloc(sizeof(Tcl_HashTable)); - iPtr->lineLAPtr = ckalloc(sizeof(Tcl_HashTable)); - iPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable)); + iPtr->linePBodyPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->lineBCPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->lineLAPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->lineLABCPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS); @@ -693,12 +672,6 @@ Tcl_CreateInterp(void) iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; -#ifndef TCL_NO_DEPRECATED - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; -#endif - Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; @@ -727,9 +700,6 @@ Tcl_CreateInterp(void) iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); -#ifndef TCL_NO_DEPRECATED - iPtr->resultSpace[0] = 0; -#endif iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ @@ -763,7 +733,7 @@ Tcl_CreateInterp(void) */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ - framePtr = ckalloc(sizeof(CallFrame)); + framePtr = Tcl_Alloc(sizeof(CallFrame)); (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0); framePtr->objc = 0; @@ -793,7 +763,7 @@ Tcl_CreateInterp(void) iPtr->asyncCancelMsg = Tcl_NewObj(); - cancelInfo = ckalloc(sizeof(CancelInfo)); + cancelInfo = Tcl_Alloc(sizeof(CancelInfo)); cancelInfo->interp = interp; iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo); @@ -840,12 +810,6 @@ Tcl_CreateInterp(void) #endif /* TCL_COMPILE_STATS */ /* - * Initialise the stub table pointer. - */ - - iPtr->stubTable = &tclStubs; - - /* * Initialize the ensemble error message rewriting support. */ @@ -892,7 +856,7 @@ Tcl_CreateInterp(void) hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { - cmdPtr = ckalloc(sizeof(Command)); + cmdPtr = Tcl_Alloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; @@ -1012,7 +976,7 @@ Tcl_CreateInterp(void) #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ - TclOpCmdClientData *occdPtr = ckalloc(sizeof(TclOpCmdClientData)); + TclOpCmdClientData *occdPtr = Tcl_Alloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; @@ -1070,11 +1034,6 @@ Tcl_CreateInterp(void) Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY); -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - Tcl_TraceVar2(interp, "tcl_precision", NULL, - TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - TclPrecTraceProc, NULL); -#endif /* !TCL_NO_DEPRECATED */ TclpSetVariables(interp); #if TCL_THREADS @@ -1127,7 +1086,7 @@ DeleteOpCmdClientData( { TclOpCmdClientData *occdPtr = clientData; - ckfree(occdPtr); + Tcl_Free(occdPtr); } /* @@ -1336,14 +1295,14 @@ Tcl_CallWhenDeleted( Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; - AssocData *dPtr = ckalloc(sizeof(AssocData)); + AssocData *dPtr = Tcl_Alloc(sizeof(AssocData)); Tcl_HashEntry *hPtr; sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr); (*assocDataCounterPtr)++; if (iPtr->assocData == NULL) { - iPtr->assocData = ckalloc(sizeof(Tcl_HashTable)); + iPtr->assocData = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew); @@ -1392,7 +1351,7 @@ Tcl_DontCallWhenDeleted( hPtr = Tcl_NextHashEntry(&hSearch)) { dPtr = Tcl_GetHashValue(hPtr); if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) { - ckfree(dPtr); + Tcl_Free(dPtr); Tcl_DeleteHashEntry(hPtr); return; } @@ -1432,14 +1391,14 @@ Tcl_SetAssocData( int isNew; if (iPtr->assocData == NULL) { - iPtr->assocData = ckalloc(sizeof(Tcl_HashTable)); + iPtr->assocData = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew); if (isNew == 0) { dPtr = Tcl_GetHashValue(hPtr); } else { - dPtr = ckalloc(sizeof(AssocData)); + dPtr = Tcl_Alloc(sizeof(AssocData)); } dPtr->proc = proc; dPtr->clientData = clientData; @@ -1484,7 +1443,7 @@ Tcl_DeleteAssocData( if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } - ckfree(dPtr); + Tcl_Free(dPtr); Tcl_DeleteHashEntry(hPtr); } @@ -1680,9 +1639,9 @@ DeleteInterpProc( if (cancelInfo != NULL) { if (cancelInfo->result != NULL) { - ckfree(cancelInfo->result); + Tcl_Free(cancelInfo->result); } - ckfree(cancelInfo); + Tcl_Free(cancelInfo); } Tcl_DeleteHashEntry(hPtr); @@ -1737,7 +1696,7 @@ DeleteInterpProc( Tcl_DeleteCommandFromToken(interp, Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(hTablePtr); - ckfree(hTablePtr); + Tcl_Free(hTablePtr); } /* @@ -1758,10 +1717,10 @@ DeleteInterpProc( if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } - ckfree(dPtr); + Tcl_Free(dPtr); } Tcl_DeleteHashTable(hTablePtr); - ckfree(hTablePtr); + Tcl_Free(hTablePtr); } /* @@ -1773,7 +1732,7 @@ DeleteInterpProc( Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top"); } Tcl_PopCallFrame(interp); - ckfree(iPtr->rootFramePtr); + Tcl_Free(iPtr->rootFramePtr); iPtr->rootFramePtr = NULL; Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr); @@ -1783,7 +1742,6 @@ DeleteInterpProc( */ Tcl_FreeResult(interp); - iPtr->result = NULL; Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); @@ -1805,12 +1763,6 @@ DeleteInterpProc( if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } -#ifndef TCL_NO_DEPRECATED - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - } -#endif TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); @@ -1828,8 +1780,8 @@ DeleteInterpProc( resPtr = iPtr->resolverPtr; while (resPtr) { nextResPtr = resPtr->nextPtr; - ckfree(resPtr->name); - ckfree(resPtr); + Tcl_Free(resPtr->name); + Tcl_Free(resPtr); resPtr = nextResPtr; } @@ -1856,13 +1808,13 @@ DeleteInterpProc( if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfPtr->data.eval.path); } - ckfree(cfPtr->line); - ckfree(cfPtr); + Tcl_Free(cfPtr->line); + Tcl_Free(cfPtr); } Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->linePBodyPtr); - ckfree(iPtr->linePBodyPtr); + Tcl_Free(iPtr->linePBodyPtr); iPtr->linePBodyPtr = NULL; /* @@ -1878,18 +1830,18 @@ DeleteInterpProc( Tcl_DecrRefCount(eclPtr->path); } for (i=0; i< eclPtr->nuloc; i++) { - ckfree(eclPtr->loc[i].line); + Tcl_Free(eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { - ckfree(eclPtr->loc); + Tcl_Free(eclPtr->loc); } - ckfree(eclPtr); + Tcl_Free(eclPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->lineBCPtr); - ckfree(iPtr->lineBCPtr); + Tcl_Free(iPtr->lineBCPtr); iPtr->lineBCPtr = NULL; /* @@ -1908,7 +1860,7 @@ DeleteInterpProc( } Tcl_DeleteHashTable(iPtr->lineLAPtr); - ckfree(iPtr->lineLAPtr); + Tcl_Free(iPtr->lineLAPtr); iPtr->lineLAPtr = NULL; if (iPtr->lineLABCPtr->numEntries && !TclInExit()) { @@ -1921,7 +1873,7 @@ DeleteInterpProc( } Tcl_DeleteHashTable(iPtr->lineLABCPtr); - ckfree(iPtr->lineLABCPtr); + Tcl_Free(iPtr->lineLABCPtr); iPtr->lineLABCPtr = NULL; /* @@ -1932,7 +1884,7 @@ DeleteInterpProc( Tcl_DeleteHashTable(&iPtr->varTraces); Tcl_DeleteHashTable(&iPtr->varSearches); - ckfree(iPtr); + Tcl_Free(iPtr); } /* @@ -2036,7 +1988,7 @@ Tcl_HideCommand( hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr == NULL) { - hiddenCmdTablePtr = ckalloc(sizeof(Tcl_HashTable)); + hiddenCmdTablePtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS); iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr; } @@ -2400,7 +2352,7 @@ Tcl_CreateCommand( * stuck in an infinite loop). */ - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); } if (!deleted) { @@ -2426,7 +2378,7 @@ Tcl_CreateCommand( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = ckalloc(sizeof(Command)); + cmdPtr = Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; @@ -2646,7 +2598,7 @@ TclCreateObjCommandInNs( * infinite loop). */ - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); } if (!deleted) { @@ -2671,7 +2623,7 @@ TclCreateObjCommandInNs( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = ckalloc(sizeof(Command)); + cmdPtr = Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; @@ -2817,13 +2769,6 @@ TclInvokeObjectCommand( } /* - * Move the interpreter's object result to the string result, then reset - * the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* * Decrement the ref counts for the argument objects created above, then * free the objv array if malloc'ed storage was used. */ @@ -3433,7 +3378,7 @@ Tcl_DeleteCommandFromToken( CommandTrace *nextPtr = tracePtr->nextPtr; if (tracePtr->refCount-- <= 1) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } tracePtr = nextPtr; } @@ -3472,10 +3417,10 @@ Tcl_DeleteCommandFromToken( * If you are getting a crash during the call to deleteProc and * cmdPtr->deleteProc is a pointer to the function free(), the most * likely cause is that your extension allocated memory for the - * clientData argument to Tcl_CreateObjCommand with the ckalloc() + * clientData argument to Tcl_CreateObjCommand with the Tcl_Alloc() * macro and you are now trying to deallocate this memory with free() - * instead of ckfree(). You should pass a pointer to your own method - * that calls ckfree(). + * instead of Tcl_Free(). You should pass a pointer to your own method + * that calls Tcl_Free(). */ cmdPtr->deleteProc(cmdPtr->deleteData); @@ -3627,7 +3572,7 @@ CallCommandTraces( oldName, newName, flags); cmdPtr->flags &= ~tracePtr->flags; if (tracePtr->refCount-- <= 1) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } } @@ -3759,370 +3704,9 @@ TclCleanupCommand( * be freed. */ { if (cmdPtr->refCount-- <= 1) { - ckfree(cmdPtr); - } -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_CreateMathFunc -- - * - * Creates a new math function for expressions in a given interpreter. - * - * Results: - * None. - * - * Side effects: - * The Tcl function defined by "name" is created or redefined. If the - * function already exists then its definition is replaced; this includes - * the builtin functions. Redefining a builtin function forces all - * existing code to be invalidated since that code may be compiled using - * an instruction specific to the replaced function. In addition, - * redefioning a non-builtin function will force existing code to be - * invalidated if the number of arguments has changed. - * - *---------------------------------------------------------------------- - */ - -#if !defined(TCL_NO_DEPRECATED) -void -Tcl_CreateMathFunc( - Tcl_Interp *interp, /* Interpreter in which function is to be - * available. */ - const char *name, /* Name of function (e.g. "sin"). */ - int numArgs, /* Nnumber of arguments required by - * function. */ - Tcl_ValueType *argTypes, /* Array of types acceptable for each - * argument. */ - Tcl_MathProc *proc, /* C function that implements the math - * function. */ - ClientData clientData) /* Additional value to pass to the - * function. */ -{ - Tcl_DString bigName; - OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData)); - - data->proc = proc; - data->numArgs = numArgs; - data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType)); - memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType)); - data->clientData = clientData; - - Tcl_DStringInit(&bigName); - TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::"); - Tcl_DStringAppend(&bigName, name, -1); - - Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName), - OldMathFuncProc, data, OldMathFuncDeleteProc); - Tcl_DStringFree(&bigName); -} - -/* - *---------------------------------------------------------------------- - * - * OldMathFuncProc -- - * - * Dispatch to a math function created with Tcl_CreateMathFunc - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * Whatever the math function does. - * - *---------------------------------------------------------------------- - */ - -static int -OldMathFuncProc( - ClientData clientData, /* Pointer to OldMathFuncData describing the - * function being called */ - Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Actual parameter count */ - Tcl_Obj *const *objv) /* Parameter vector */ -{ - Tcl_Obj *valuePtr; - OldMathFuncData *dataPtr = clientData; - Tcl_Value funcResult, *args; - int result; - int j, k; - double d; - - /* - * Check argument count. - */ - - if (objc != dataPtr->numArgs + 1) { - MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv); - return TCL_ERROR; - } - - /* - * Convert arguments from Tcl_Obj's to Tcl_Value's. - */ - - args = ckalloc(dataPtr->numArgs * sizeof(Tcl_Value)); - for (j = 1, k = 0; j < objc; ++j, ++k) { - /* TODO: Convert to TclGetNumberFromObj? */ - valuePtr = objv[j]; - result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d); -#ifdef ACCEPT_NAN - if (result != TCL_OK) { - const Tcl_ObjIntRep *irPtr - = TclFetchIntRep(valuePtr, &tclDoubleType); - - if (irPtr) { - d = irPtr->doubleValue; - result = TCL_OK; - } - } -#endif - if (result != TCL_OK) { - /* - * We have a non-numeric argument. - */ - - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "argument to math function didn't have numeric value", - -1)); - TclCheckBadOctal(interp, TclGetString(valuePtr)); - ckfree(args); - return TCL_ERROR; - } - - /* - * Copy the object's numeric value to the argument record, converting - * it if necessary. - * - * NOTE: no bignum support; use the new mathfunc interface for that. - */ - - args[k].type = dataPtr->argTypes[k]; - switch (args[k].type) { - case TCL_EITHER: - if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue) - == TCL_OK) { - args[k].type = TCL_INT; - break; - } - if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue) - == TCL_OK) { - args[k].type = TCL_WIDE_INT; - break; - } - args[k].type = TCL_DOUBLE; - /* FALLTHROUGH */ - - case TCL_DOUBLE: - args[k].doubleValue = d; - break; - case TCL_INT: - if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { - ckfree(args); - return TCL_ERROR; - } - valuePtr = Tcl_GetObjResult(interp); - Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue); - Tcl_ResetResult(interp); - break; - case TCL_WIDE_INT: - if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { - ckfree(args); - return TCL_ERROR; - } - valuePtr = Tcl_GetObjResult(interp); - TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue); - Tcl_ResetResult(interp); - break; - } + Tcl_Free(cmdPtr); } - - /* - * Call the function. - */ - - errno = 0; - result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult); - ckfree(args); - if (result != TCL_OK) { - return result; - } - - /* - * Return the result of the call. - */ - - if (funcResult.type == TCL_INT) { - TclNewIntObj(valuePtr, funcResult.intValue); - } else if (funcResult.type == TCL_WIDE_INT) { - valuePtr = Tcl_NewWideIntObj(funcResult.wideValue); - } else { - return CheckDoubleResult(interp, funcResult.doubleValue); - } - Tcl_SetObjResult(interp, valuePtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * OldMathFuncDeleteProc -- - * - * Cleans up after deleting a math function registered with - * Tcl_CreateMathFunc - * - * Results: - * None. - * - * Side effects: - * Frees allocated memory. - * - *---------------------------------------------------------------------- - */ - -static void -OldMathFuncDeleteProc( - ClientData clientData) -{ - OldMathFuncData *dataPtr = clientData; - - ckfree(dataPtr->argTypes); - ckfree(dataPtr); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetMathFuncInfo -- - * - * Discovers how a particular math function was created in a given - * interpreter. - * - * Results: - * TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the - * interpreter result if that happens.) - * - * Side effects: - * If this function succeeds, the variables pointed to by the numArgsPtr - * and argTypePtr arguments will be updated to detail the arguments - * allowed by the function. The variable pointed to by the procPtr - * argument will be set to NULL if the function is a builtin function, - * and will be set to the address of the C function used to implement the - * math function otherwise (in which case the variable pointed to by the - * clientDataPtr argument will also be updated.) - * - *---------------------------------------------------------------------- - */ - -int -Tcl_GetMathFuncInfo( - Tcl_Interp *interp, - const char *name, - int *numArgsPtr, - Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, - ClientData *clientDataPtr) -{ - Tcl_Obj *cmdNameObj; - Command *cmdPtr; - - /* - * Get the command that implements the math function. - */ - - TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::"); - Tcl_AppendToObj(cmdNameObj, name, -1); - Tcl_IncrRefCount(cmdNameObj); - cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj); - Tcl_DecrRefCount(cmdNameObj); - - /* - * Report unknown functions. - */ - - if (cmdPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown math function \"%s\"", name)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL); - *numArgsPtr = -1; - *argTypesPtr = NULL; - *procPtr = NULL; - *clientDataPtr = NULL; - return TCL_ERROR; - } - - /* - * Retrieve function info for user defined functions; return dummy - * information for builtins. - */ - - if (cmdPtr->objProc == &OldMathFuncProc) { - OldMathFuncData *dataPtr = cmdPtr->clientData; - - *procPtr = dataPtr->proc; - *numArgsPtr = dataPtr->numArgs; - *argTypesPtr = dataPtr->argTypes; - *clientDataPtr = dataPtr->clientData; - } else { - *procPtr = NULL; - *numArgsPtr = -1; - *argTypesPtr = NULL; - *procPtr = NULL; - *clientDataPtr = NULL; - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ListMathFuncs -- - * - * Produces a list of all the math functions defined in a given - * interpreter. - * - * Results: - * A pointer to a Tcl_Obj structure with a reference count of zero, or - * NULL in the case of an error (in which case a suitable error message - * will be left in the interpreter result.) - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -Tcl_ListMathFuncs( - Tcl_Interp *interp, - const char *pattern) -{ - Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1); - Tcl_Obj *result; - Tcl_InterpState state; - - if (pattern) { - Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1); - Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj); - - Tcl_AppendObjToObj(script, arg); - Tcl_DecrRefCount(arg); /* Should tear down patternObj too */ - } - - state = Tcl_SaveInterpState(interp, TCL_OK); - Tcl_IncrRefCount(script); - if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) { - result = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); - } else { - result = Tcl_NewObj(); - } - Tcl_DecrRefCount(script); - Tcl_RestoreInterpState(interp, state); - - return result; } -#endif /* !defined(TCL_NO_DEPRECATED) */ /* *---------------------------------------------------------------------- @@ -4137,7 +3721,7 @@ Tcl_ListMathFuncs( * otherwise. * * Side effects: - * The interpreters object and string results are cleared. + * The interpreter's result is cleared. * *---------------------------------------------------------------------- */ @@ -4149,8 +3733,8 @@ TclInterpReady( register Interp *iPtr = (Interp *) interp; /* - * Reset both the interpreter's string and object results and clear out - * any previous error information. + * Reset the interpreter's result and clear out any previous error + * information. */ Tcl_ResetResult(interp); @@ -4299,7 +3883,7 @@ Tcl_Canceled( if (flags & TCL_LEAVE_ERR_MSG) { const char *id, *message = NULL; - int length; + size_t length; /* * Setup errorCode variables so that we can differentiate between @@ -4407,7 +3991,7 @@ Tcl_CancelEval( if (resultObjPtr != NULL) { result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); - cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length); + cancelInfo->result = Tcl_Realloc(cancelInfo->result,cancelInfo->length); memcpy(cancelInfo->result, result, (size_t) cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { @@ -4730,30 +4314,9 @@ TclNRRunCallbacks( /* All callbacks down to rootPtr not inclusive * are to be run. */ { -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - Interp *iPtr = (Interp *) interp; -#endif /* !defined(TCL_NO_DEPRECATED) */ NRE_callback *callbackPtr; Tcl_NRPostProc *procPtr; - /* - * If the interpreter has a non-empty string result, the result object is - * either empty or stale because some function set interp->result - * directly. If so, move the string result to the result object, then - * reset the string result. - * - * This only needs to be done for the first item in the list: all other - * are for NR function calls, and those are Tcl_Obj based. - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - if (*(iPtr->result) != 0) { - (void) Tcl_GetObjResult(interp); - } -#endif /* !defined(TCL_NO_DEPRECATED) */ - - /* This is the trampoline. */ - while (TOP_CB(interp) != rootPtr) { callbackPtr = TOP_CB(interp); procPtr = callbackPtr->procPtr; @@ -4912,7 +4475,7 @@ TEOV_Error( Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr; const char *cmdString; - int cmdLen; + size_t cmdLen; int objc = PTR2INT(data[0]); Tcl_Obj **objv = data[1]; @@ -5068,8 +4631,8 @@ TEOV_RunEnterTraces( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; - int length, traceCode = TCL_OK; + size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + int traceCode = TCL_OK; const char *command = TclGetStringFromObj(commandPtr, &length); /* @@ -5121,7 +4684,7 @@ TEOV_RunLeaveTraces( Tcl_Obj *commandPtr = data[1]; Command *cmdPtr = data[2]; Tcl_Obj **objv = data[3]; - int length; + size_t length; const char *command = TclGetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_IS_DELETED)) { @@ -5204,63 +4767,13 @@ Tcl_EvalTokensStandard( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - int count) /* Number of tokens to consider at tokenPtr. + size_t count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, NULL, NULL); } -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -/* - *---------------------------------------------------------------------- - * - * Tcl_EvalTokens -- - * - * Given an array of tokens parsed from a Tcl command (e.g., the tokens - * that make up a word or the index for an array variable) this function - * evaluates the tokens and concatenates their values to form a single - * result value. - * - * Results: - * The return value is a pointer to a newly allocated Tcl_Obj containing - * the value of the array of tokens. The reference count of the returned - * object has been incremented. If an error occurs in evaluating the - * tokens then a NULL value is returned and an error message is left in - * interp's result. - * - * Side effects: - * A new object is allocated to hold the result. - * - *---------------------------------------------------------------------- - * - * This uses a non-standard return convention; its use is now deprecated. It - * is a wrapper for the new function Tcl_EvalTokensStandard, and is not used - * in the core any longer. It is only kept for backward compatibility. - */ - -Tcl_Obj * -Tcl_EvalTokens( - Tcl_Interp *interp, /* Interpreter in which to lookup variables, - * execute nested commands, and report - * errors. */ - Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to - * evaluate and concatenate. */ - int count) /* Number of tokens to consider at tokenPtr. - * Must be at least 1. */ -{ - Tcl_Obj *resPtr; - - if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) { - return NULL; - } - resPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(resPtr); - Tcl_ResetResult(interp); - return resPtr; -} -#endif /* !TCL_NO_DEPRECATED */ - /* *---------------------------------------------------------------------- * @@ -5287,7 +4800,7 @@ Tcl_EvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ - int numBytes, /* Number of bytes in script. If < 0, the + size_t numBytes, /* Number of bytes in script. If -1, the * script consists of all bytes up to the * first null character. */ int flags) /* Collection of OR-ed bits that control the @@ -5302,7 +4815,7 @@ TclEvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ - int numBytes, /* Number of bytes in script. If < 0, the + size_t numBytes, /* Number of bytes in script. If -1, the * script consists of all bytes up to the * first NUL character. */ int flags, /* Collection of OR-ed bits that control the @@ -5367,7 +4880,7 @@ TclEvalEx( } } - if (numBytes < 0) { + if (numBytes == TCL_AUTO_LENGTH) { numBytes = strlen(script); } Tcl_ResetResult(interp); @@ -5484,9 +4997,9 @@ TclEvalEx( */ if (numWords > minObjs) { - expand = ckalloc(numWords * sizeof(int)); - objvSpace = ckalloc(numWords * sizeof(Tcl_Obj *)); - lineSpace = ckalloc(numWords * sizeof(int)); + expand = Tcl_Alloc(numWords * sizeof(int)); + objvSpace = Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); + lineSpace = Tcl_Alloc(numWords * sizeof(int)); } expandRequested = 0; objv = objvSpace; @@ -5572,8 +5085,8 @@ TclEvalEx( if ((numWords > minObjs) || (objectsNeeded > minObjs)) { objv = objvSpace = - ckalloc(objectsNeeded * sizeof(Tcl_Obj *)); - lines = lineSpace = ckalloc(objectsNeeded * sizeof(int)); + Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); + lines = lineSpace = Tcl_Alloc(objectsNeeded * sizeof(int)); } objectsUsed = 0; @@ -5600,10 +5113,10 @@ TclEvalEx( objv += objIdx+1; if (copy != stackObjArray) { - ckfree(copy); + Tcl_Free(copy); } if (lcopy != linesStack) { - ckfree(lcopy); + Tcl_Free(lcopy); } } @@ -5648,9 +5161,9 @@ TclEvalEx( } objectsUsed = 0; if (objvSpace != stackObjArray) { - ckfree(objvSpace); + Tcl_Free(objvSpace); objvSpace = stackObjArray; - ckfree(lineSpace); + Tcl_Free(lineSpace); lineSpace = linesStack; } @@ -5660,7 +5173,7 @@ TclEvalEx( */ if (expand != expandStack) { - ckfree(expand); + Tcl_Free(expand); expand = expandStack; } } @@ -5726,11 +5239,11 @@ TclEvalEx( Tcl_FreeParse(parsePtr); } if (objvSpace != stackObjArray) { - ckfree(objvSpace); - ckfree(lineSpace); + Tcl_Free(objvSpace); + Tcl_Free(lineSpace); } if (expand != expandStack) { - ckfree(expand); + Tcl_Free(expand); } iPtr->varFramePtr = savedVarFramePtr; @@ -5894,7 +5407,7 @@ TclArgumentEnter( * and initialize references. */ - cfwPtr = ckalloc(sizeof(CFWord)); + cfwPtr = Tcl_Alloc(sizeof(CFWord)); cfwPtr->framePtr = cfPtr; cfwPtr->word = i; cfwPtr->refCount = 1; @@ -5954,7 +5467,7 @@ TclArgumentRelease( continue; } - ckfree(cfwPtr); + Tcl_Free(cfwPtr); Tcl_DeleteHashEntry(hPtr); } } @@ -5987,7 +5500,7 @@ TclArgumentBCEnter( void *codePtr, CmdFrame *cfPtr, int cmd, - int pc) + size_t pc) { ExtCmdLoc *eclPtr; int word; @@ -6036,7 +5549,7 @@ TclArgumentBCEnter( int isnew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, objv[word], &isnew); - CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC)); + CFWordBC *cfwPtr = Tcl_Alloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; cfwPtr->obj = objv[word]; @@ -6114,7 +5627,7 @@ TclArgumentBCRelease( Tcl_DeleteHashEntry(hPtr); } - ckfree(cfwPtr); + Tcl_Free(cfwPtr); cfwPtr = nextPtr; } @@ -6196,83 +5709,6 @@ TclArgumentGet( /* *---------------------------------------------------------------------- * - * Tcl_Eval -- - * - * Execute a Tcl command in a string. This function executes the script - * directly, rather than compiling it to bytecodes. Before the arrival of - * the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used - * for executing Tcl commands, but nowadays it isn't used much. - * - * Results: - * The return value is one of the return codes defined in tcl.h (such as - * TCL_OK), and interp's result contains a value to supplement the return - * code. The value of the result will persist only until the next call to - * Tcl_Eval or Tcl_EvalObj: you must copy it or lose it! - * - * Side effects: - * Can be almost arbitrary, depending on the commands in the script. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_Eval -int -Tcl_Eval( - Tcl_Interp *interp, /* Token for command interpreter (returned by - * previous call to Tcl_CreateInterp). */ - const char *script) /* Pointer to TCL command to execute. */ -{ - int code = Tcl_EvalEx(interp, script, -1, 0); - - /* - * For backwards compatibility with old C code that predates the object - * system in Tcl 8.0, we have to mirror the object result back into the - * string result (some callers may expect it there). - */ - - (void) Tcl_GetStringResult(interp); - return code; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_EvalObj, Tcl_GlobalEvalObj -- - * - * These functions are deprecated but we keep them around for backwards - * compatibility reasons. - * - * Results: - * See the functions they call. - * - * Side effects: - * See the functions they call. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_EvalObj -int -Tcl_EvalObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr) -{ - return Tcl_EvalObjEx(interp, objPtr, 0); -} -#undef Tcl_GlobalEvalObj -int -Tcl_GlobalEvalObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr) -{ - return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are @@ -6463,7 +5899,7 @@ TclNREvalObjEx( */ const char *script; - int numSrcBytes; + size_t numSrcBytes; /* * Now we check if we have data about invisible continuation lines for @@ -6517,7 +5953,7 @@ TEOEx_ByteCodeCallback( } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { const char *script; - int numSrcBytes; + size_t numSrcBytes; ProcessUnexpectedResult(interp, result); result = TCL_ERROR; @@ -6655,9 +6091,6 @@ Tcl_ExprLong( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -6684,9 +6117,6 @@ Tcl_ExprDouble( result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -6712,14 +6142,6 @@ Tcl_ExprBoolean( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - } return result; } } @@ -7033,12 +6455,6 @@ Tcl_ExprString( Tcl_DecrRefCount(resultPtr); } } - - /* - * Force the string rep of the interp result. - */ - - (void) Tcl_GetStringResult(interp); return code; } @@ -7061,82 +6477,17 @@ Tcl_ExprString( *---------------------------------------------------------------------- */ -#undef Tcl_AddObjErrorInfo void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { - const char *message = TclGetString(objPtr); + size_t length; + const char *message = TclGetStringFromObj(objPtr, &length); + register Interp *iPtr = (Interp *) interp; Tcl_IncrRefCount(objPtr); - Tcl_AddObjErrorInfo(interp, message, objPtr->length); - Tcl_DecrRefCount(objPtr); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_AddErrorInfo -- - * - * Add information to the errorInfo field that describes the current - * error. - * - * Results: - * None. - * - * Side effects: - * The contents of message are appended to the errorInfo field. If we are - * just starting to log an error, errorInfo is initialized from the error - * message in the interpreter's result. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_AddErrorInfo -void -Tcl_AddErrorInfo( - Tcl_Interp *interp, /* Interpreter to which error information - * pertains. */ - const char *message) /* Message to record. */ -{ - Tcl_AddObjErrorInfo(interp, message, -1); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_AddObjErrorInfo -- - * - * Add information to the errorInfo field that describes the current - * error. This routine differs from Tcl_AddErrorInfo by taking a byte - * pointer and length. - * - * Results: - * None. - * - * Side effects: - * "length" bytes from "message" are appended to the errorInfo field. If - * "length" is negative, use bytes up to the first NULL byte. If we are - * just starting to log an error, errorInfo is initialized from the error - * message in the interpreter's result. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AddObjErrorInfo( - Tcl_Interp *interp, /* Interpreter to which error information - * pertains. */ - const char *message, /* Points to the first byte of an array of - * bytes of the message. */ - int length) /* The number of bytes in the message. If < 0, - * then append all bytes up to a NULL byte. */ -{ - register Interp *iPtr = (Interp *) interp; /* * If we are just starting to log an error, errorInfo is initialized from @@ -7145,20 +6496,7 @@ Tcl_AddObjErrorInfo( iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - if (*(iPtr->result) != 0) { - /* - * The interp's string result is set, apparently by some extension - * making a deprecated direct write to it. That extension may - * expect interp->result to continue to be set, so we'll take - * special pains to avoid clearing it, until we drop support for - * interp->result completely. - */ - - iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); - } else -#endif /* !defined(TCL_NO_DEPRECATED) */ - iPtr->errorInfo = iPtr->objResultPtr; + iPtr->errorInfo = iPtr->objResultPtr; Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); @@ -7177,39 +6515,42 @@ Tcl_AddObjErrorInfo( } Tcl_AppendToObj(iPtr->errorInfo, message, length); } + Tcl_DecrRefCount(objPtr); } /* - *--------------------------------------------------------------------------- + *---------------------------------------------------------------------- * - * Tcl_VarEvalVA -- + * Tcl_VarEval -- * * Given a variable number of string arguments, concatenate them all * together and execute the result as a Tcl command. * * Results: * A standard Tcl return result. An error message or other result may be - * left in the interp's result. + * left in the interp. * * Side effects: * Depends on what was done by the command. * - *--------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ - + /* ARGSUSED */ int -Tcl_VarEvalVA( - Tcl_Interp *interp, /* Interpreter in which to evaluate command */ - va_list argList) /* Variable argument list. */ +Tcl_VarEval( + Tcl_Interp *interp, + ...) { + va_list argList; + int result; Tcl_DString buf; char *string; - int result; + va_start(argList, interp); /* * Copy the strings one after the other into a single larger string. Use * stack-allocated space for small commands, but if the command gets too - * large than call ckalloc to create the space. + * large than call Tcl_Alloc to create the space. */ Tcl_DStringInit(&buf); @@ -7229,78 +6570,6 @@ Tcl_VarEvalVA( /* *---------------------------------------------------------------------- * - * Tcl_VarEval -- - * - * Given a variable number of string arguments, concatenate them all - * together and execute the result as a Tcl command. - * - * Results: - * A standard Tcl return result. An error message or other result may be - * left in interp->result. - * - * Side effects: - * Depends on what was done by the command. - * - *---------------------------------------------------------------------- - */ - /* ARGSUSED */ -int -Tcl_VarEval( - Tcl_Interp *interp, - ...) -{ - va_list argList; - int result; - - va_start(argList, interp); - result = Tcl_VarEvalVA(interp, argList); - va_end(argList); - - return result; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_GlobalEval -- - * - * Evaluate a command at global level in an interpreter. - * - * Results: - * A standard Tcl result is returned, and the interp's result is modified - * accordingly. - * - * Side effects: - * The command string is executed in interp, and the execution is carried - * out in the variable context of global level (no functions active), - * just as if an "uplevel #0" command were being executed. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_GlobalEval -int -Tcl_GlobalEval( - Tcl_Interp *interp, /* Interpreter in which to evaluate - * command. */ - const char *command) /* Command to evaluate. */ -{ - register Interp *iPtr = (Interp *) interp; - int result; - CallFrame *savedVarFramePtr; - - savedVarFramePtr = iPtr->varFramePtr; - iPtr->varFramePtr = iPtr->rootFramePtr; - result = Tcl_EvalEx(interp, command, -1, 0); - iPtr->varFramePtr = savedVarFramePtr; - return result; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetRecursionLimit -- * * Set the maximum number of recursive calls that may be active for an @@ -7785,7 +7054,7 @@ ExprAbsFunc( goto unChanged; } else if (l == (Tcl_WideInt)0) { if (TclHasStringRep(objv[1])) { - int numBytes; + size_t numBytes; const char *bytes = TclGetStringFromObj(objv[1], &numBytes); while (numBytes) { @@ -8991,7 +8260,7 @@ NRCoroutineCallerCallback( NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr); NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr); NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr); - ckfree(corPtr); + Tcl_Free(corPtr); return result; } @@ -9050,7 +8319,7 @@ NRCoroutineExitCallback( */ Tcl_DeleteHashTable(corPtr->lineLABCPtr); - ckfree(corPtr->lineLABCPtr); + Tcl_Free(corPtr->lineLABCPtr); corPtr->lineLABCPtr = NULL; RESTORE_CONTEXT(corPtr->caller); @@ -9342,7 +8611,7 @@ TclNRCoroutineObjCmd( * struct and create the corresponding command. */ - corPtr = ckalloc(sizeof(CoroutineData)); + corPtr = Tcl_Alloc(sizeof(CoroutineData)); cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, @@ -9364,7 +8633,7 @@ TclNRCoroutineObjCmd( Tcl_HashSearch hSearch; Tcl_HashEntry *hePtr; - corPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable)); + corPtr->lineLABCPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); diff --git a/generic/tclBinary.c b/generic/tclBinary.c index f069090..6760020 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -271,10 +271,10 @@ const Tcl_ObjType tclByteArrayType = { * fewer mallocs. */ -typedef struct ByteArray { - unsigned int used; /* The number of bytes used in the byte +typedef struct { + size_t used; /* The number of bytes used in the byte * array. */ - unsigned int allocated; /* The amount of space actually allocated + size_t allocated; /* The amount of space actually allocated * minus 1 byte. */ unsigned char bytes[1]; /* The array of bytes. The actual size of this * field depends on the 'allocated' field @@ -282,7 +282,7 @@ typedef struct ByteArray { } ByteArray; #define BYTEARRAY_SIZE(len) \ - ((unsigned) (TclOffset(ByteArray, bytes) + (len))) + ((TclOffset(ByteArray, bytes) + (len))) #define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) #define SET_BYTEARRAY(irPtr, baPtr) \ (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr) @@ -318,8 +318,7 @@ Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - int length) /* Length of the array of bytes, which must be - * >= 0. */ + size_t length) /* Length of the array of bytes */ { #ifdef TCL_MEM_DEBUG return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0); @@ -361,8 +360,7 @@ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - int length, /* Length of the array of bytes, which must be - * >= 0. */ + size_t length, /* Length of the array of bytes. */ const char *file, /* The name of the source file calling this * procedure; used for debugging. */ int line) /* Line number in the source file; used for @@ -402,7 +400,7 @@ Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ const unsigned char *bytes, /* The array of bytes to use as the new value. May be NULL even if length > 0. */ - int length) /* Length of the array of bytes, which must + size_t length) /* Length of the array of bytes, which must be >= 0. */ { ByteArray *byteArrayPtr; @@ -413,15 +411,12 @@ Tcl_SetByteArrayObj( } TclInvalidateStringRep(objPtr); - if (length < 0) { - length = 0; - } - byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); + byteArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); byteArrayPtr->used = length; byteArrayPtr->allocated = length; if ((bytes != NULL) && (length > 0)) { - memcpy(byteArrayPtr->bytes, bytes, (size_t) length); + memcpy(byteArrayPtr->bytes, bytes, length); } SET_BYTEARRAY(&ir, byteArrayPtr); @@ -498,15 +493,11 @@ Tcl_GetByteArrayFromObj( unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ - int length) /* New length for internal byte array. */ + size_t length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; - unsigned newLength; Tcl_ObjIntRep *irPtr; - assert(length >= 0); - newLength = (unsigned int)length; - if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } @@ -524,13 +515,13 @@ Tcl_SetByteArrayLength( } byteArrayPtr = GET_BYTEARRAY(irPtr); - if (newLength > byteArrayPtr->allocated) { - byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength)); - byteArrayPtr->allocated = newLength; + if (length > byteArrayPtr->allocated) { + byteArrayPtr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(length)); + byteArrayPtr->allocated = length; SET_BYTEARRAY(irPtr, byteArrayPtr); } TclInvalidateStringRep(objPtr); - byteArrayPtr->used = newLength; + byteArrayPtr->used = length; return byteArrayPtr->bytes; } @@ -573,7 +564,7 @@ SetByteArrayFromAny( length = objPtr->length; srcEnd = src + length; - byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); + byteArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); for (dst = byteArrayPtr->bytes; src < srcEnd; ) { Tcl_UniChar ch = 0; src += TclUtfToUniChar(src, &ch); @@ -611,14 +602,14 @@ static void FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType))); + Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType))); } static void FreeProperByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType))); + Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType))); } /* @@ -643,17 +634,17 @@ DupByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - unsigned int length; + size_t length; ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjIntRep ir; srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType)); length = srcArrayPtr->used; - copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); + copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; - memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length); + memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); SET_BYTEARRAY(&ir, copyArrayPtr); Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir); @@ -664,17 +655,17 @@ DupProperByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - unsigned int length; + size_t length; ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjIntRep ir; srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType)); length = srcArrayPtr->used; - copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); + copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; - memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length); + memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); SET_BYTEARRAY(&ir, copyArrayPtr); Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir); @@ -705,21 +696,18 @@ UpdateStringOfByteArray( const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType); ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr); unsigned char *src = byteArrayPtr->bytes; - unsigned int i, length = byteArrayPtr->used; - unsigned int size = length; + size_t i, length = byteArrayPtr->used; + size_t size = length; /* * How much space will string rep need? */ - for (i = 0; i < length && size <= INT_MAX; i++) { + for (i = 0; i < length; i++) { if ((src[i] == 0) || (src[i] > 127)) { size++; } } - if (size > INT_MAX) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } if (size == length) { char *dst = Tcl_InitStringRep(objPtr, (char *)src, size); @@ -757,16 +745,16 @@ void TclAppendBytesToByteArray( Tcl_Obj *objPtr, const unsigned char *bytes, - int len) + size_t len) { ByteArray *byteArrayPtr; - unsigned int length, needed; + size_t needed; Tcl_ObjIntRep *irPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); } - if (len < 0) { + if (len == TCL_AUTO_LENGTH) { Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } @@ -775,8 +763,6 @@ TclAppendBytesToByteArray( return; } - length = (unsigned int)len; - irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); @@ -790,37 +776,37 @@ TclAppendBytesToByteArray( } byteArrayPtr = GET_BYTEARRAY(irPtr); - if (length > INT_MAX - byteArrayPtr->used) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + if (len > UINT_MAX - byteArrayPtr->used) { + Tcl_Panic("max size for a Tcl value (%u bytes) exceeded", UINT_MAX); } - needed = byteArrayPtr->used + length; + needed = byteArrayPtr->used + len; /* * If we need to, resize the allocated space in the byte array. */ if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; - unsigned int attempt; + size_t attempt; if (needed <= INT_MAX/2) { /* Try to allocate double the total space that is needed. */ attempt = 2 * needed; - ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* Try to allocate double the increment that is needed (plus). */ - unsigned int limit = INT_MAX - needed; - unsigned int extra = length + TCL_MIN_GROWTH; - int growth = (int) ((extra > limit) ? limit : extra); + size_t limit = UINT_MAX - needed; + size_t extra = len + TCL_MIN_GROWTH; + size_t growth = (extra > limit) ? limit : extra; attempt = needed + growth; - ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* Last chance: Try to allocate exactly what is needed. */ attempt = needed; - ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + ptr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } byteArrayPtr = ptr; byteArrayPtr->allocated = attempt; @@ -828,9 +814,9 @@ TclAppendBytesToByteArray( } if (bytes) { - memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, length); + memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len); } - byteArrayPtr->used += length; + byteArrayPtr->used += len; TclInvalidateStringRep(objPtr); } @@ -941,7 +927,7 @@ BinaryFormatCmd( goto badIndex; } if (count == BINARY_ALL) { - Tcl_GetByteArrayFromObj(objv[arg], &count); + TclGetByteArrayFromObj(objv[arg], &count); } else if (count == BINARY_NOCOUNT) { count = 1; } @@ -1105,8 +1091,8 @@ BinaryFormatCmd( char pad = (char) (cmd == 'a' ? '\0' : ' '); unsigned char *bytes; - bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length); - + bytes = TclGetByteArrayFromObj(objv[arg], &length); + arg++; if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { @@ -1125,7 +1111,7 @@ BinaryFormatCmd( case 'B': { unsigned char *last; - str = TclGetStringFromObj(objv[arg], &length); + str = Tcl_GetStringFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; @@ -1187,7 +1173,7 @@ BinaryFormatCmd( unsigned char *last; int c; - str = TclGetStringFromObj(objv[arg], &length); + str = Tcl_GetStringFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; @@ -1418,7 +1404,7 @@ BinaryScanCmd( } numberCachePtr = &numberCacheHash; Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); - buffer = Tcl_GetByteArrayFromObj(objv[1], &length); + buffer = TclGetByteArrayFromObj(objv[1], &length); format = TclGetString(objv[2]); arg = 3; offset = 0; @@ -2467,7 +2453,7 @@ BinaryEncodeHex( } TclNewObj(resultObj); - data = Tcl_GetByteArrayFromObj(objv[1], &count); + data = TclGetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { *cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)]; @@ -2503,7 +2489,8 @@ BinaryDecodeHex( Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor, c; - int i, index, value, size, count = 0, cut = 0, strict = 0; + int i, index, value, size, cut = 0, strict = 0; + size_t count = 0; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; @@ -2572,8 +2559,8 @@ BinaryDecodeHex( badChar: TclDecrRefCount(resultObj); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid hexadecimal digit \"%c\" at position %d", - c, (int) (data - datastart - 1))); + "invalid hexadecimal digit \"%c\" at position %" TCL_Z_MODIFIER "u", + c, data - datastart - 1)); return TCL_ERROR; } @@ -2623,7 +2610,7 @@ BinaryEncode64( unsigned char *data, *cursor, *limit; int maxlen = 0; const char *wrapchar = "\n"; - int wrapcharlen = 1; + size_t wrapcharlen = 1; int offset, i, index, size, outindex = 0, count = 0; enum {OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; @@ -2661,7 +2648,7 @@ BinaryEncode64( } resultObj = Tcl_NewObj(); - data = Tcl_GetByteArrayFromObj(objv[objc-1], &count); + data = TclGetByteArrayFromObj(objv[objc-1], &count); if (count > 0) { size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ if (maxlen > 0 && size > maxlen) { @@ -2759,7 +2746,7 @@ BinaryEncodeUu( } break; case OPT_WRAPCHAR: - wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen); + wrapchar = TclGetByteArrayFromObj(objv[i+1], &wrapcharlen); break; } } @@ -2771,7 +2758,7 @@ BinaryEncodeUu( resultObj = Tcl_NewObj(); offset = 0; - data = Tcl_GetByteArrayFromObj(objv[objc-1], &count); + data = TclGetByteArrayFromObj(objv[objc-1], &count); rawLength = (lineLength - 1) * 3 / 4; start = cursor = Tcl_SetByteArrayLength(resultObj, (lineLength + wrapcharlen) * @@ -2844,7 +2831,8 @@ BinaryDecodeUu( Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; - int i, index, size, count = 0, strict = 0, lineLen; + int i, index, size, strict = 0, lineLen; + size_t count = 0; unsigned char c; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; @@ -2974,8 +2962,8 @@ BinaryDecodeUu( badUu: Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid uuencode character \"%c\" at position %d", - c, (int) (data - datastart - 1))); + "invalid uuencode character \"%c\" at position %" TCL_Z_MODIFIER "u", + c, data - datastart - 1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); TclDecrRefCount(resultObj); return TCL_ERROR; @@ -3009,7 +2997,8 @@ BinaryDecode64( unsigned char *begin = NULL; unsigned char *cursor = NULL; int strict = 0; - int i, index, size, cut = 0, count = 0; + int i, index, size, cut = 0; + size_t count = 0; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; @@ -3131,8 +3120,8 @@ BinaryDecode64( bad64: Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid base64 character \"%c\" at position %d", - (char) c, (int) (data - datastart - 1))); + "invalid base64 character \"%c\" at position %" TCL_Z_MODIFIER "u", + (char) c, data - datastart - 1)); TclDecrRefCount(resultObj); return TCL_ERROR; } diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index e3fb98e..32d4158 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -20,9 +20,7 @@ #define FALSE 0 #define TRUE 1 -#undef Tcl_Alloc #undef Tcl_Free -#undef Tcl_Realloc #undef Tcl_AttemptAlloc #undef Tcl_AttemptRealloc @@ -33,7 +31,7 @@ * "memory tag" command is invoked, to hold the current tag. */ -typedef struct MemTag { +typedef struct { size_t refCount; /* Number of mem_headers referencing this * tag. */ char string[1]; /* Actual size of string will be as large as @@ -121,7 +119,7 @@ static char dumpFile[100]; /* Records where to dump memory allocation /* * Mutex to serialize allocations. This is a low-level mutex that must be * explicitly initialized. This is necessary because the self initializing - * mutexes use ckalloc... + * mutexes use Tcl_Alloc... */ static Tcl_Mutex *ckallocMutexPtr; @@ -245,7 +243,7 @@ ValidateMemory( guard_failed = TRUE; fflush(stdout); byte &= 0xff; - fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", (int)idx, byte, + fprintf(stderr, "low guard byte %" TCL_Z_MODIFIER "u is 0x%x \t%c\n", idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } @@ -266,7 +264,7 @@ ValidateMemory( guard_failed = TRUE; fflush(stdout); byte &= 0xff; - fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", (int)idx, byte, + fprintf(stderr, "hi guard byte %" TCL_Z_MODIFIER "u is 0x%x \t%c\n", idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } @@ -376,7 +374,7 @@ Tcl_DumpActiveMemory( /* *---------------------------------------------------------------------- * - * Tcl_DbCkalloc - debugging ckalloc + * Tcl_DbCkalloc - debugging Tcl_Alloc * * Allocate the requested amount of space plus some extra for guard bands * at both ends of the request, plus a size, panicing if there isn't @@ -385,15 +383,15 @@ Tcl_DumpActiveMemory( * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent - * by the ckalloc macro; it uses the preprocessor autodefines __FILE__ + * by the Tcl_Alloc macro; it uses the preprocessor autodefines __FILE__ * and __LINE__. * *---------------------------------------------------------------------- */ -char * +void * Tcl_DbCkalloc( - unsigned int size, + size_t size, const char *file, int line) { @@ -405,13 +403,13 @@ Tcl_DbCkalloc( /* Don't let size argument to TclpAlloc overflow */ if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) { - result = (struct mem_header *) TclpAlloc((unsigned)size + + result = (struct mem_header *) TclpAlloc(size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } if (result == NULL) { fflush(stdout); TclDumpMemoryInfo((ClientData) stderr, 0); - Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); + Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d", size, file, line); } /* @@ -457,7 +455,7 @@ Tcl_DbCkalloc( } if (alloc_tracing) { - fprintf(stderr,"ckalloc %p %u %s %d\n", + fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", result->body, size, file, line); } @@ -481,9 +479,9 @@ Tcl_DbCkalloc( return result->body; } -char * +void * Tcl_AttemptDbCkalloc( - unsigned int size, + size_t size, const char *file, int line) { @@ -495,7 +493,7 @@ Tcl_AttemptDbCkalloc( /* Don't let size argument to TclpAlloc overflow */ if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) { - result = (struct mem_header *) TclpAlloc((unsigned)size + + result = (struct mem_header *) TclpAlloc(size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } if (result == NULL) { @@ -546,7 +544,7 @@ Tcl_AttemptDbCkalloc( } if (alloc_tracing) { - fprintf(stderr,"ckalloc %p %u %s %d\n", + fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", result->body, size, file, line); } @@ -573,7 +571,7 @@ Tcl_AttemptDbCkalloc( /* *---------------------------------------------------------------------- * - * Tcl_DbCkfree - debugging ckfree + * Tcl_DbCkfree - debugging Tcl_Free * * Verify that the low and high guards are intact, and if so then free * the buffer else Tcl_Panic. @@ -582,7 +580,7 @@ Tcl_AttemptDbCkalloc( * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent - * by the ckfree macro; it uses the preprocessor autodefines __FILE__ and + * by the Tcl_Free macro; it uses the preprocessor autodefines __FILE__ and * __LINE__. * *---------------------------------------------------------------------- @@ -590,7 +588,7 @@ Tcl_AttemptDbCkalloc( void Tcl_DbCkfree( - char *ptr, + void *ptr, const char *file, int line) { @@ -611,7 +609,7 @@ Tcl_DbCkfree( memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); if (alloc_tracing) { - fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n", + fprintf(stderr, "Tcl_Free %p %" TCL_Z_MODIFIER "u %s %d\n", memp->body, memp->length, file, line); } @@ -655,7 +653,7 @@ Tcl_DbCkfree( /* *-------------------------------------------------------------------- * - * Tcl_DbCkrealloc - debugging ckrealloc + * Tcl_DbCkrealloc - debugging Tcl_Realloc * * Reallocate a chunk of memory by allocating a new one of the right * size, copying the old data to the new location, and then freeing the @@ -665,10 +663,10 @@ Tcl_DbCkfree( *-------------------------------------------------------------------- */ -char * +void * Tcl_DbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { @@ -696,10 +694,10 @@ Tcl_DbCkrealloc( return newPtr; } -char * +void * Tcl_AttemptDbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { @@ -734,59 +732,6 @@ Tcl_AttemptDbCkrealloc( /* *---------------------------------------------------------------------- * - * Tcl_Alloc, et al. -- - * - * These functions are defined in terms of the debugging versions when - * TCL_MEM_DEBUG is set. - * - * Results: - * Same as the debug versions. - * - * Side effects: - * Same as the debug versions. - * - *---------------------------------------------------------------------- - */ - -char * -Tcl_Alloc( - unsigned int size) -{ - return Tcl_DbCkalloc(size, "unknown", 0); -} - -char * -Tcl_AttemptAlloc( - unsigned int size) -{ - return Tcl_AttemptDbCkalloc(size, "unknown", 0); -} - -void -Tcl_Free( - char *ptr) -{ - Tcl_DbCkfree(ptr, "unknown", 0); -} - -char * -Tcl_Realloc( - char *ptr, - unsigned int size) -{ - return Tcl_DbCkrealloc(ptr, size, "unknown", 0); -} -char * -Tcl_AttemptRealloc( - char *ptr, - unsigned int size) -{ - return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0); -} - -/* - *---------------------------------------------------------------------- - * * MemoryCmd -- * * Implements the Tcl "memory" command, which provides Tcl-level control @@ -1052,11 +997,12 @@ Tcl_InitMemory( *---------------------------------------------------------------------- */ -char * +#undef Tcl_Alloc +void * Tcl_Alloc( - unsigned int size) + size_t size) { - char *result; + void *result; result = TclpAlloc(size); @@ -1071,24 +1017,25 @@ Tcl_Alloc( */ if ((result == NULL) && size) { - Tcl_Panic("unable to alloc %u bytes", size); + Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", size); } return result; } -char * +void * Tcl_DbCkalloc( - unsigned int size, + size_t size, const char *file, int line) { - char *result; + void *result; - result = (char *) TclpAlloc(size); + result = TclpAlloc(size); if ((result == NULL) && size) { fflush(stdout); - Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); + Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d", + size, file, line); } return result; } @@ -1104,25 +1051,25 @@ Tcl_DbCkalloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_AttemptAlloc( - unsigned int size) + size_t size) { - char *result; + void *result; result = TclpAlloc(size); return result; } -char * +void * Tcl_AttemptDbCkalloc( - unsigned int size, + size_t size, const char *file, int line) { - char *result; + void *result; - result = (char *) TclpAlloc(size); + result = TclpAlloc(size); return result; } @@ -1137,35 +1084,37 @@ Tcl_AttemptDbCkalloc( *---------------------------------------------------------------------- */ -char * +#undef Tcl_Realloc +void * Tcl_Realloc( - char *ptr, - unsigned int size) + void *ptr, + size_t size) { char *result; result = TclpRealloc(ptr, size); if ((result == NULL) && size) { - Tcl_Panic("unable to realloc %u bytes", size); + Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes", size); } return result; } -char * +void * Tcl_DbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { - char *result; + void *result; - result = (char *) TclpRealloc(ptr, size); + result = TclpRealloc(ptr, size); if ((result == NULL) && size) { fflush(stdout); - Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line); + Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes, %s line %d", + size, file, line); } return result; } @@ -1181,27 +1130,27 @@ Tcl_DbCkrealloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_AttemptRealloc( - char *ptr, - unsigned int size) + void *ptr, + size_t size) { - char *result; + void *result; result = TclpRealloc(ptr, size); return result; } -char * +void * Tcl_AttemptDbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { - char *result; + void *result; - result = (char *) TclpRealloc(ptr, size); + result = TclpRealloc(ptr, size); return result; } @@ -1217,16 +1166,17 @@ Tcl_AttemptDbCkrealloc( *---------------------------------------------------------------------- */ +#undef Tcl_Free void Tcl_Free( - char *ptr) + void *ptr) { TclpFree(ptr); } void Tcl_DbCkfree( - char *ptr, + void *ptr, const char *file, int line) { diff --git a/generic/tclClock.c b/generic/tclClock.c index 2c25f6c..f9a8008 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -100,7 +100,7 @@ typedef struct { * Structure containing the fields used in [clock format] and [clock scan] */ -typedef struct TclDateFields { +typedef struct { Tcl_WideInt seconds; /* Time expressed in seconds from the Posix * epoch */ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds @@ -275,9 +275,9 @@ TclClockInit( * Create the client data, which is a refcounted literal pool. */ - data = ckalloc(sizeof(ClockClientData)); + data = Tcl_Alloc(sizeof(ClockClientData)); data->refCount = 0; - data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*)); + data->literals = Tcl_Alloc(LIT__END * sizeof(Tcl_Obj*)); for (i = 0; i < LIT__END; ++i) { data->literals[i] = Tcl_NewStringObj(literals[i], -1); Tcl_IncrRefCount(data->literals[i]); @@ -2039,13 +2039,13 @@ TzsetIfNecessary(void) || strcmp(tzIsNow, tzWas) != 0)) { tzset(); if (tzWas != NULL && tzWas != INT2PTR(-1)) { - ckfree(tzWas); + Tcl_Free(tzWas); } - tzWas = ckalloc(strlen(tzIsNow) + 1); + tzWas = Tcl_Alloc(strlen(tzIsNow) + 1); strcpy(tzWas, tzIsNow); } else if (tzIsNow == NULL && tzWas != NULL) { tzset(); - if (tzWas != INT2PTR(-1)) ckfree(tzWas); + if (tzWas != INT2PTR(-1)) Tcl_Free(tzWas); tzWas = NULL; } Tcl_MutexUnlock(&clockMutex); @@ -2076,8 +2076,8 @@ ClockDeleteCmdProc( for (i = 0; i < LIT__END; ++i) { Tcl_DecrRefCount(data->literals[i]); } - ckfree(data->literals); - ckfree(data); + Tcl_Free(data->literals); + Tcl_Free(data); } } diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 331f791..bcf5c48 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -146,143 +146,6 @@ Tcl_BreakObjCmd( /* *---------------------------------------------------------------------- * - * Tcl_CaseObjCmd -- - * - * This procedure is invoked to process the "case" Tcl command. See the - * user documentation for details on what it does. THIS COMMAND IS - * OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0. - * - * Results: - * A standard Tcl object result. - * - * Side effects: - * See the user documentation. - * - *---------------------------------------------------------------------- - */ -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - /* ARGSUSED */ -int -Tcl_CaseObjCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - register int i; - int body, result, caseObjc; - const char *stringPtr, *arg; - Tcl_Obj *const *caseObjv; - Tcl_Obj *armPtr; - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, - "string ?in? ?pattern body ...? ?default body?"); - return TCL_ERROR; - } - - stringPtr = TclGetString(objv[1]); - body = -1; - - arg = TclGetString(objv[2]); - if (strcmp(arg, "in") == 0) { - i = 3; - } else { - i = 2; - } - caseObjc = objc - i; - caseObjv = objv + i; - - /* - * If all of the pattern/command pairs are lumped into a single argument, - * split them out again. - */ - - if (caseObjc == 1) { - Tcl_Obj **newObjv; - - TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv); - caseObjv = newObjv; - } - - for (i = 0; i < caseObjc; i += 2) { - int patObjc, j; - const char **patObjv; - const char *pat, *p; - - if (i == caseObjc-1) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra case pattern with no body", -1)); - return TCL_ERROR; - } - - /* - * Check for special case of single pattern (no list) with no - * backslash sequences. - */ - - pat = TclGetString(caseObjv[i]); - for (p = pat; *p != '\0'; p++) { - if (TclIsSpaceProc(*p) || (*p == '\\')) { - break; - } - } - if (*p == '\0') { - if ((*pat == 'd') && (strcmp(pat, "default") == 0)) { - body = i + 1; - } - if (Tcl_StringMatch(stringPtr, pat)) { - body = i + 1; - goto match; - } - continue; - } - - /* - * Break up pattern lists, then check each of the patterns in the - * list. - */ - - result = Tcl_SplitList(interp, pat, &patObjc, &patObjv); - if (result != TCL_OK) { - return result; - } - for (j = 0; j < patObjc; j++) { - if (Tcl_StringMatch(stringPtr, patObjv[j])) { - body = i + 1; - break; - } - } - ckfree(patObjv); - if (j < patObjc) { - break; - } - } - - match: - if (body != -1) { - armPtr = caseObjv[body - 1]; - result = Tcl_EvalObjEx(interp, caseObjv[body], 0); - if (result == TCL_ERROR) { - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (\"%.50s\" arm line %d)", - TclGetString(armPtr), Tcl_GetErrorLine(interp))); - } - return result; - } - - /* - * Nothing matched: return nothing. - */ - - return TCL_OK; -} -#endif /* !TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_CatchObjCmd -- * * This object-based procedure is invoked to process the "catch" Tcl @@ -565,7 +428,7 @@ EncodingConvertfromObjCmd( Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ - int length; /* Length of the byte array being converted */ + size_t length; /* Length of the byte array being converted */ const char *bytesPtr; /* Pointer to the first byte of the array */ if (objc == 2) { @@ -584,7 +447,7 @@ EncodingConvertfromObjCmd( /* * Convert the string into a byte array in 'ds' */ - bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length); + bytesPtr = (char *) TclGetByteArrayFromObj(data, &length); Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds); /* @@ -627,7 +490,7 @@ EncodingConverttoObjCmd( Tcl_Obj *data; /* String to convert */ Tcl_DString ds; /* Buffer to hold the byte array */ Tcl_Encoding encoding; /* Encoding to use */ - int length; /* Length of the string being converted */ + size_t length; /* Length of the string being converted */ const char *stringPtr; /* Pointer to the first byte of the string */ /* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */ diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index a1a7f3e..3fdb890 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -56,7 +56,7 @@ typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t); * The following structure is used to pass this information. */ -typedef struct SortInfo { +typedef struct { int isIncreasing; /* Nonzero means sort in increasing order. */ int sortMode; /* The sort mode. One of SORTMODE_* values * defined below. */ @@ -541,7 +541,7 @@ InfoBodyCmd( register Interp *iPtr = (Interp *) interp; const char *name, *bytes; Proc *procPtr; - int numBytes; + size_t numBytes; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); @@ -566,7 +566,7 @@ InfoBodyCmd( * the object do not invalidate the internal rep. */ - bytes = Tcl_GetStringFromObj(procPtr->bodyPtr, &numBytes); + bytes = TclGetStringFromObj(procPtr->bodyPtr, &numBytes); Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes)); return TCL_OK; } @@ -651,7 +651,7 @@ InfoCommandsCmd( Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; - int i; + size_t i; /* * Get the pattern and find the "effective namespace" in which to list @@ -1396,7 +1396,7 @@ TclInfoFrame( ADD_PAIR("proc", procNameObj); } else if (procPtr->cmdPtr->clientData) { ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData; - int i; + size_t i; /* * This is a non-standard command. Luckily, it's told us how to @@ -2200,7 +2200,8 @@ Tcl_JoinObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - int length, listLen; + size_t length; + int listLen; Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { @@ -2231,7 +2232,7 @@ Tcl_JoinObjCmd( joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); - (void) Tcl_GetStringFromObj(joinObjPtr, &length); + (void) TclGetStringFromObj(joinObjPtr, &length); if (length == 0) { resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { @@ -3015,7 +3016,8 @@ Tcl_LsearchObjCmd( Tcl_Obj *const objv[]) /* Argument values. */ { const char *bytes, *patternBytes; - int i, match, index, result=TCL_OK, listc, length, elemLen, bisect; + int i, match, index, result=TCL_OK, listc, bisect; + size_t length = 0, elemLen; int allocatedIndexVector = 0; int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset; Tcl_WideInt patWide, objWide; @@ -3680,7 +3682,7 @@ Tcl_LsearchObjCmd( itemPtr = Tcl_NewWideIntObj(i+groupOffset); for (j=0 ; j<sortInfo.indexc ; j++) { - Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewWideIntObj( + Tcl_ListObjAppendElement(interp, itemPtr, TclNewWideIntObjFromSize( TclIndexDecode(sortInfo.indexv[j], listc))); } Tcl_ListObjAppendElement(interp, listPtr, itemPtr); @@ -3702,7 +3704,7 @@ Tcl_LsearchObjCmd( itemPtr = Tcl_NewWideIntObj(index+groupOffset); for (j=0 ; j<sortInfo.indexc ; j++) { - Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewWideIntObj( + Tcl_ListObjAppendElement(interp, itemPtr, TclNewWideIntObjFromSize( TclIndexDecode(sortInfo.indexv[j], listc))); } Tcl_SetObjResult(interp, itemPtr); @@ -4180,7 +4182,7 @@ Tcl_LsortObjCmd( * begins sorting it into the sublists as it appears. */ - elementArray = ckalloc(length * sizeof(SortElement)); + elementArray = Tcl_Alloc(length * sizeof(SortElement)); for (i=0; i < length; i++){ idx = groupSize * i + groupOffset; @@ -4313,7 +4315,7 @@ Tcl_LsortObjCmd( TclStackFree(interp, sortInfo.indexv); } if (elementArray) { - ckfree(elementArray); + Tcl_Free(elementArray); } return sortInfo.resultCode; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index dac82b8..75dac00 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -194,7 +194,7 @@ Tcl_RegexpObjCmd( if (++i >= objc) { goto endOfForLoop; } - if (TclGetIntForIndexM(interp, objv[i], 0, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[i], TCL_INDEX_START, &temp) != TCL_OK) { goto optionError; } if (startIndex) { @@ -486,7 +486,8 @@ Tcl_RegsubObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int idx, result, cflags, all, wlen, wsublen, numMatches, offset; + int idx, result, cflags, all, numMatches, offset; + size_t wlen, wsublen = 0; int start, end, subStart, subEnd, match, command, numParts; Tcl_RegExp regExpr; Tcl_RegExpInfo info; @@ -549,7 +550,7 @@ Tcl_RegsubObjCmd( if (++idx >= objc) { goto endOfForLoop; } - if (TclGetIntForIndexM(interp, objv[idx], 0, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[idx], TCL_INDEX_START, &temp) != TCL_OK) { goto optionError; } if (startIndex) { @@ -580,7 +581,7 @@ Tcl_RegsubObjCmd( objv += idx; if (startIndex) { - int stringLength = Tcl_GetCharLength(objv[1]); + size_t stringLength = Tcl_GetCharLength(objv[1]); TclGetIntForIndexM(interp, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); @@ -597,17 +598,18 @@ Tcl_RegsubObjCmd( * slightly modified version of the one pair STR_MAP code. */ - int slen, nocase, wsrclc; - int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long); + size_t slen; + int nocase, wsrclc; + int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); Tcl_UniChar *p; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; - wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen); - wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen); - wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen); + wsrc = TclGetUnicodeFromObj(objv[0], &slen); + wstring = TclGetUnicodeFromObj(objv[1], &wlen); + wsubspec = TclGetUnicodeFromObj(objv[2], &wsublen); wend = wstring + wlen - (slen ? slen - 1 : 0); result = TCL_OK; @@ -633,7 +635,7 @@ Tcl_RegsubObjCmd( if ((*wstring == *wsrc || (nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) && (slen==1 || (strCmpFn(wstring, wsrc, - (unsigned long) slen) == 0))) { + (size_t)slen) == 0))) { if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); @@ -698,14 +700,14 @@ Tcl_RegsubObjCmd( } else { objPtr = objv[1]; } - wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); + wstring = TclGetUnicodeFromObj(objPtr, &wlen); if (objv[2] == objv[0]) { subPtr = Tcl_DuplicateObj(objv[2]); } else { subPtr = objv[2]; } if (!command) { - wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen); + wsubspec = TclGetUnicodeFromObj(subPtr, &wsublen); } result = TCL_OK; @@ -721,7 +723,7 @@ Tcl_RegsubObjCmd( */ numMatches = 0; - for ( ; offset <= wlen; ) { + for ( ; (size_t)offset <= wlen; ) { /* * The flags argument is set if string is part of a larger string, so @@ -777,7 +779,7 @@ Tcl_RegsubObjCmd( Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts); numArgs = numParts + info.nsubs + 1; - args = ckalloc(sizeof(Tcl_Obj*) * numArgs); + args = Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs); memcpy(args, parts, sizeof(Tcl_Obj*) * numParts); for (idx = 0 ; idx <= info.nsubs ; idx++) { @@ -807,7 +809,7 @@ Tcl_RegsubObjCmd( for (idx = 0 ; idx <= info.nsubs ; idx++) { TclDecrRefCount(args[idx + numParts]); } - ckfree(args); + Tcl_Free(args); if (result != TCL_OK) { if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( @@ -825,7 +827,7 @@ Tcl_RegsubObjCmd( * the user code. */ - wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); + wstring = TclGetUnicodeFromObj(objPtr, &wlen); offset += end; if (end == 0 || start == end) { @@ -836,7 +838,7 @@ Tcl_RegsubObjCmd( * again at the same spot. */ - if (offset < wlen) { + if ((size_t)offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; @@ -909,7 +911,7 @@ Tcl_RegsubObjCmd( * order to prevent infinite loops. */ - if (offset < wlen) { + if ((size_t)offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; @@ -921,7 +923,7 @@ Tcl_RegsubObjCmd( * one more step so we don't match again at the same spot. */ - if (offset < wlen) { + if ((size_t)offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; @@ -946,7 +948,7 @@ Tcl_RegsubObjCmd( resultPtr = objv[1]; Tcl_IncrRefCount(resultPtr); - } else if (offset < wlen) { + } else if ((size_t)offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); } if (objc == 4) { @@ -1178,7 +1180,7 @@ Tcl_SplitObjCmd( const char *splitChars; const char *stringPtr; const char *end; - int splitCharLen, stringLen; + size_t splitCharLen, stringLen; Tcl_Obj *listPtr, *objPtr; if (objc == 2) { @@ -1257,7 +1259,7 @@ Tcl_SplitObjCmd( * byte in length. */ - while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) { + while (*stringPtr && (p=strchr(stringPtr,*splitChars)) != NULL) { objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); stringPtr = p + 1; @@ -1330,13 +1332,16 @@ StringFirstCmd( } if (objc == 4) { - int size = Tcl_GetCharLength(objv[2]); + size_t end = Tcl_GetCharLength(objv[2]) - 1; - if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) { + if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) { return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclStringFirst(objv[1], + if (start < -1) { + start = -1; + } + Tcl_SetObjResult(interp, TclNewWideIntObjFromSize(TclStringFirst(objv[1], objv[2], start))); return TCL_OK; } @@ -1375,13 +1380,16 @@ StringLastCmd( } if (objc == 4) { - int size = Tcl_GetCharLength(objv[2]); + size_t end = Tcl_GetCharLength(objv[2]) - 1; - if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) { + if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &last)) { return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclStringLast(objv[1], + if (last < -1) { + last = -1; + } + Tcl_SetObjResult(interp, TclNewWideIntObjFromSize(TclStringLast(objv[1], objv[2], last))); return TCL_OK; } @@ -1411,7 +1419,8 @@ StringIndexCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length, index; + size_t end; + int index; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string charIndex"); @@ -1422,12 +1431,12 @@ StringIndexCmd( * Get the char length to calculate what 'end' means. */ - length = Tcl_GetCharLength(objv[1]); - if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { + end = Tcl_GetCharLength(objv[1]) - 1; + if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) { return TCL_ERROR; } - if ((index >= 0) && (index < length)) { + if ((index >= 0) && (index <= (int)end)) { int ch = Tcl_GetUniChar(objv[1], index); if (ch == -1) { @@ -1446,11 +1455,11 @@ StringIndexCmd( } else { char buf[4]; - length = Tcl_UniCharToUtf(ch, buf); - if (!length) { - length = Tcl_UniCharToUtf(-1, buf); + end = Tcl_UniCharToUtf(ch, buf); + if (!end) { + end = Tcl_UniCharToUtf(-1, buf); } - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end)); } } return TCL_OK; @@ -1484,7 +1493,9 @@ StringIsCmd( const char *string1, *end, *stop; Tcl_UniChar ch = 0; int (*chcomp)(int) = NULL; /* The UniChar comparison function. */ - int i, failat = 0, result = 1, strict = 0, index, length1, length2; + int i, result = 1, strict = 0, index, length3; + size_t failat = 0; + size_t length1, length2; Tcl_Obj *objPtr, *failVarObj = NULL; Tcl_WideInt w; @@ -1579,11 +1590,9 @@ StringIsCmd( string1 = TclGetStringFromObj(objPtr, &length1); result = length1 == 0; } - } else if (index != STR_IS_BOOL) { - TclGetBooleanFromObj(NULL, objPtr, &i); - if ((index == STR_IS_TRUE) ^ i) { - result = 0; - } + } else if ((objPtr->internalRep.wideValue != 0) + ? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) { + result = 0; } break; case STR_IS_CONTROL: @@ -1603,7 +1612,8 @@ StringIsCmd( */ const char *elemStart, *nextElem; - int lenRemain, elemSize; + int lenRemain; + size_t elemSize; register const char *p; string1 = TclGetStringFromObj(objPtr, &length1); @@ -1771,7 +1781,7 @@ StringIsCmd( * well-formed lists. */ - if (TCL_OK == TclListObjLength(NULL, objPtr, &length2)) { + if (TCL_OK == TclListObjLength(NULL, objPtr, &length3)) { break; } @@ -1783,7 +1793,8 @@ StringIsCmd( */ const char *elemStart, *nextElem; - int lenRemain, elemSize; + size_t lenRemain; + size_t elemSize; register const char *p; string1 = TclGetStringFromObj(objPtr, &length1); @@ -1873,7 +1884,7 @@ StringIsCmd( str_is_done: if ((result == 0) && (failVarObj != NULL) && - Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(failat), + Tcl_ObjSetVar2(interp, failVarObj, NULL, TclNewWideIntObjFromSize(failat), TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } @@ -1920,11 +1931,12 @@ StringMapCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2, mapElemc, index; + size_t length1, length2; + int mapElemc, index; int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; - int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long); + int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t); if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); @@ -2022,7 +2034,7 @@ StringMapCmd( } else { sourceObj = objv[objc-1]; } - ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1); + ustring1 = TclGetUnicodeFromObj(sourceObj, &length1); if (length1 == 0) { /* * Empty input string, just stop now. @@ -2048,10 +2060,11 @@ StringMapCmd( * larger strings. */ - int mapLen, u2lc; + size_t mapLen; + int u2lc; Tcl_UniChar *mapString; - ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2); + ustring2 = TclGetUnicodeFromObj(mapElemv[0], &length2); p = ustring1; if ((length2 > length1) || (length2 == 0)) { /* @@ -2060,13 +2073,13 @@ StringMapCmd( ustring1 = end; } else { - mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen); + mapString = TclGetUnicodeFromObj(mapElemv[1], &mapLen); u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0); for (; ustring1 < end; ustring1++) { if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, - (unsigned long) length2) == 0)) { + length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; @@ -2081,7 +2094,8 @@ StringMapCmd( } } else { Tcl_UniChar **mapStrings; - int *mapLens, *u2lc = NULL; + size_t *mapLens; + int *u2lc = 0; /* * Precompute pointers to the unicode string and length. This saves us @@ -2090,13 +2104,13 @@ StringMapCmd( * case. */ - mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *)); - mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int)); + mapStrings = TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2); + mapLens = TclStackAlloc(interp, mapElemc * sizeof(size_t) * 2); if (nocase) { u2lc = TclStackAlloc(interp, mapElemc * sizeof(int)); } for (index = 0; index < mapElemc; index++) { - mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index], + mapStrings[index] = TclGetUnicodeFromObj(mapElemv[index], mapLens+index); if (nocase && ((index % 2) == 0)) { u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]); @@ -2113,8 +2127,8 @@ StringMapCmd( if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ - (end-ustring1 >= length2) && ((length2 == 1) || - !strCmpFn(ustring2, ustring1, (unsigned) length2))) { + ((size_t)(end-ustring1) >= length2) && ((length2 == 1) || + !strCmpFn(ustring2, ustring1, length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. @@ -2199,11 +2213,11 @@ StringMatchCmd( } if (objc == 4) { - int length; + size_t length; const char *string = TclGetStringFromObj(objv[1], &length); if ((length > 1) && - strncmp(string, "-nocase", (size_t) length) == 0) { + strncmp(string, "-nocase", length) == 0) { nocase = TCL_MATCH_NOCASE; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -2243,7 +2257,8 @@ StringRangeCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length, first, last; + size_t end; + int first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "string first last"); @@ -2255,18 +2270,18 @@ StringRangeCmd( * 'end' refers to the last character, not one past it. */ - length = Tcl_GetCharLength(objv[1]) - 1; + end = Tcl_GetCharLength(objv[1]) - 1; - if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK || - TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK || + TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) { return TCL_ERROR; } if (first < 0) { first = 0; } - if (last >= length) { - last = length; + if (last >= (int)end) { + last = end; } if (last >= first) { Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); @@ -2355,15 +2370,15 @@ StringRplcCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int first, last, length, end; + int first, last; + size_t end; if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?"); return TCL_ERROR; } - length = Tcl_GetCharLength(objv[1]); - end = length - 1; + end = Tcl_GetCharLength(objv[1]) - 1; if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK || TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){ @@ -2376,7 +2391,7 @@ StringRplcCmd( * replacement is done, and the result is the original string, */ if ((last < 0) || /* Range ends before start of string */ - (first > end) || /* Range begins after end of string */ + (first > (int)end) || /* Range begins after end of string */ (last < first)) { /* Range begins after it starts */ /* @@ -2391,7 +2406,7 @@ StringRplcCmd( if (first < 0) { first = 0; } - if (last > end) { + if (last > (int)end) { last = end; } @@ -2466,7 +2481,8 @@ StringStartCmd( { Tcl_UniChar ch = 0; const char *p, *string; - int cur, index, length, numChars; + int cur, index; + size_t numChars, length; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); @@ -2474,13 +2490,13 @@ StringStartCmd( } string = TclGetStringFromObj(objv[1], &length); - numChars = Tcl_NumUtfChars(string, length); - if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) { + numChars = Tcl_NumUtfChars(string, length) - 1; + if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) { return TCL_ERROR; } string = TclGetStringFromObj(objv[1], &length); - if (index >= numChars) { - index = numChars - 1; + if (index > (int)numChars) { + index = numChars; } cur = 0; if (index > 0) { @@ -2527,7 +2543,8 @@ StringEndCmd( { Tcl_UniChar ch = 0; const char *p, *end, *string; - int cur, index, length, numChars; + int cur, index; + size_t length, numChars; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); @@ -2535,15 +2552,15 @@ StringEndCmd( } string = TclGetStringFromObj(objv[1], &length); - numChars = Tcl_NumUtfChars(string, length); - if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) { + numChars = Tcl_NumUtfChars(string, length) - 1; + if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) { return TCL_ERROR; } string = TclGetStringFromObj(objv[1], &length); if (index < 0) { index = 0; } - if (index < numChars) { + if (index <= (int) numChars) { p = Tcl_UtfAtIndex(string, index); end = string+length; for (cur = index; p < end; cur++) { @@ -2556,7 +2573,7 @@ StringEndCmd( cur++; } } else { - cur = numChars; + cur = numChars + 1; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(cur)); return TCL_OK; @@ -2594,7 +2611,8 @@ StringEqualCmd( */ const char *string2; - int length, i, match, nocase = 0, reqlength = -1; + int i, match, nocase = 0, reqlength = -1; + size_t length; if (objc < 3 || objc > 6) { str_cmp_args: @@ -2605,10 +2623,10 @@ StringEqualCmd( for (i = 1; i < objc-2; i++) { string2 = TclGetStringFromObj(objv[i], &length); - if ((length > 1) && !strncmp(string2, "-nocase", (size_t)length)) { + if ((length > 1) && !strncmp(string2, "-nocase", length)) { nocase = 1; } else if ((length > 1) - && !strncmp(string2, "-length", (size_t)length)) { + && !strncmp(string2, "-length", length)) { if (i+1 >= objc-2) { goto str_cmp_args; } @@ -2689,7 +2707,8 @@ TclStringCmpOpts( int *nocase, int *reqlength) { - int i, length; + int i; + size_t length; const char *string; *reqlength = -1; @@ -2703,10 +2722,10 @@ TclStringCmpOpts( for (i = 1; i < objc-2; i++) { string = TclGetStringFromObj(objv[i], &length); - if ((length > 1) && !strncmp(string, "-nocase", (size_t)length)) { + if ((length > 1) && !strncmp(string, "-nocase", length)) { *nocase = 1; } else if ((length > 1) - && !strncmp(string, "-length", (size_t)length)) { + && !strncmp(string, "-length", length)) { if (i+1 >= objc-2) { goto str_cmp_args; } @@ -2788,6 +2807,7 @@ StringCatCmd( * *---------------------------------------------------------------------- */ + static int StringBytesCmd( ClientData dummy, /* Not used. */ @@ -2795,7 +2815,7 @@ StringBytesCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length; + size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); @@ -2866,7 +2886,7 @@ StringLowerCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2; + size_t length1, length2; const char *string1; char *string2; @@ -2902,7 +2922,7 @@ StringLowerCmd( return TCL_ERROR; } - if (last >= length1) { + if (last >= (int)length1) { last = length1; } if (last < first) { @@ -2951,7 +2971,7 @@ StringUpperCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2; + size_t length1, length2; const char *string1; char *string2; @@ -2987,7 +3007,7 @@ StringUpperCmd( return TCL_ERROR; } - if (last >= length1) { + if (last >= (int)length1) { last = length1; } if (last < first) { @@ -3036,7 +3056,7 @@ StringTitleCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2; + size_t length1, length2; const char *string1; char *string2; @@ -3072,7 +3092,7 @@ StringTitleCmd( return TCL_ERROR; } - if (last >= length1) { + if (last >= (int)length1) { last = length1; } if (last < first) { @@ -3122,7 +3142,7 @@ StringTrimCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; - int triml, trimr, length1, length2; + size_t triml, trimr, length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); @@ -3169,7 +3189,8 @@ StringTrimLCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; - int trim, length1, length2; + int trim; + size_t length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); @@ -3215,7 +3236,8 @@ StringTrimRCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; - int trim, length1, length2; + int trim; + size_t length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); @@ -3414,7 +3436,8 @@ TclNRSwitchObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int i,j, index, mode, foundmode, splitObjs, numMatchesSaved; - int noCase, patternLength; + int noCase; + size_t patternLength; const char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *const *savedObjv = objv; @@ -3821,7 +3844,7 @@ TclNRSwitchObjCmd( if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) { int bline = ctxPtr->line[bidx]; - ctxPtr->line = ckalloc(objc * sizeof(int)); + ctxPtr->line = Tcl_Alloc(objc * sizeof(int)); ctxPtr->nline = objc; TclListLines(blist, bline, objc, ctxPtr->line, objv); } else { @@ -3835,7 +3858,7 @@ TclNRSwitchObjCmd( int k; - ctxPtr->line = ckalloc(objc * sizeof(int)); + ctxPtr->line = Tcl_Alloc(objc * sizeof(int)); ctxPtr->nline = objc; for (k=0; k < objc; k++) { ctxPtr->line[k] = -1; @@ -3878,14 +3901,14 @@ SwitchPostProc( CmdFrame *ctxPtr = data[1]; int pc = PTR2INT(data[2]); const char *pattern = data[3]; - int patternLength = strlen(pattern); + size_t patternLength = strlen(pattern); /* * Clean up TIP 280 context information */ if (splitObjs) { - ckfree(ctxPtr->line); + Tcl_Free(ctxPtr->line); if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { /* * Death of SrcInfo reference. @@ -3900,12 +3923,12 @@ SwitchPostProc( */ if (result == TCL_ERROR) { - int limit = 50; + unsigned limit = 50; int overflow = (patternLength > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s%s\" arm line %d)", - (overflow ? limit : patternLength), pattern, + (overflow ? limit : (unsigned)patternLength), pattern, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } TclStackFree(interp, ctxPtr); diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 3a162cc..536180d 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -403,9 +403,9 @@ TclCompileArraySetCmd( keyVar = AnonymousLocal(envPtr); valVar = AnonymousLocal(envPtr); - infoPtr = ckalloc(sizeof(ForeachInfo)); + infoPtr = Tcl_Alloc(sizeof(ForeachInfo)); infoPtr->numLists = 1; - infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int)); + infoPtr->varLists[0] = Tcl_Alloc(sizeof(ForeachVarList) + sizeof(int)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; @@ -701,8 +701,8 @@ TclCompileCatchCmd( /* Stack at this point on both branches: result returnCode */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { - Tcl_Panic("TclCompileCatchCmd: bad jump distance %d", - (int)(CurrentOffset(envPtr) - jumpFixup.codeOffset)); + Tcl_Panic("TclCompileCatchCmd: bad jump distance %" TCL_Z_MODIFIER "d", + (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } /* @@ -908,12 +908,13 @@ TclCompileConcatCmd( Tcl_Obj **objs; const char *bytes; int len; + size_t slen; Tcl_ListObjGetElements(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); - bytes = TclGetStringFromObj(objPtr, &len); - PushLiteral(envPtr, bytes, len); + bytes = TclGetStringFromObj(objPtr, &slen); + PushLiteral(envPtr, bytes, slen); Tcl_DecrRefCount(objPtr); return TCL_OK; } @@ -1096,7 +1097,8 @@ TclCompileDictIncrCmd( if (parsePtr->numWords == 4) { const char *word; - int numBytes, code; + size_t numBytes; + int code; Tcl_Token *incrTokenPtr; Tcl_Obj *intObj; @@ -1280,7 +1282,8 @@ TclCompileDictCreateCmd( Tcl_Token *tokenPtr; Tcl_Obj *keyObj, *valueObj, *dictObj; const char *bytes; - int i, len; + int i; + size_t len; if ((parsePtr->numWords & 1) == 0) { return TCL_ERROR; @@ -1563,7 +1566,7 @@ CompileDictEachCmd( } Tcl_DStringFree(&buffer); if (numVars != 2) { - ckfree(argv); + Tcl_Free(argv); return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } @@ -1571,7 +1574,7 @@ CompileDictEachCmd( keyVarIndex = LocalScalar(argv[0], nameChars, envPtr); nameChars = strlen(argv[1]); valueVarIndex = LocalScalar(argv[1], nameChars, envPtr); - ckfree(argv); + Tcl_Free(argv); if ((keyVarIndex < 0) || (valueVarIndex < 0)) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); @@ -1779,7 +1782,7 @@ TclCompileDictUpdateCmd( * that are to be used. */ - duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1)); + duiPtr = Tcl_Alloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1)); duiPtr->length = numVars; keyTokenPtrs = TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars); tokenPtr = TokenAfter(dictVarTokenPtr); @@ -1862,8 +1865,8 @@ TclCompileDictUpdateCmd( TclEmitInvoke(envPtr,INST_RETURN_STK); if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { - Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", - (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); + Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - jumpFixup.codeOffset); } TclStackFree(interp, keyTokenPtrs); return TCL_OK; @@ -1873,7 +1876,7 @@ TclCompileDictUpdateCmd( */ failedUpdateInfoAssembly: - ckfree(duiPtr); + Tcl_Free(duiPtr); TclStackFree(interp, keyTokenPtrs); issueFallback: return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); @@ -2224,8 +2227,8 @@ TclCompileDictWithCmd( */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { - Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", - (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); + Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - jumpFixup.codeOffset); } return TCL_OK; } @@ -2262,7 +2265,7 @@ DupDictUpdateInfo( dui1Ptr = clientData; len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1); - dui2Ptr = ckalloc(len); + dui2Ptr = Tcl_Alloc(len); memcpy(dui2Ptr, dui1Ptr, len); return dui2Ptr; } @@ -2271,7 +2274,7 @@ static void FreeDictUpdateInfo( ClientData clientData) { - ckfree(clientData); + Tcl_Free(clientData); } static void @@ -2282,7 +2285,7 @@ PrintDictUpdateInfo( unsigned int pcOffset) { DictUpdateInfo *duiPtr = clientData; - int i; + size_t i; for (i=0 ; i<duiPtr->length ; i++) { if (i) { @@ -2300,7 +2303,7 @@ DisassembleDictUpdateInfo( unsigned int pcOffset) { DictUpdateInfo *duiPtr = clientData; - int i; + size_t i; Tcl_Obj *variables = Tcl_NewObj(); for (i=0 ; i<duiPtr->length ; i++) { @@ -2715,7 +2718,7 @@ CompileEachloopCmd( */ numLists = (numWords - 2)/2; - infoPtr = ckalloc(sizeof(ForeachInfo) + infoPtr = Tcl_Alloc(sizeof(ForeachInfo) + (numLists - 1) * sizeof(ForeachVarList *)); infoPtr->numLists = 0; /* Count this up as we go */ @@ -2749,7 +2752,7 @@ CompileEachloopCmd( goto done; } - varListPtr = ckalloc(sizeof(ForeachVarList) + varListPtr = Tcl_Alloc(sizeof(ForeachVarList) + (numVars - 1) * sizeof(int)); varListPtr->numVars = numVars; infoPtr->varLists[i/2] = varListPtr; @@ -2758,11 +2761,11 @@ CompileEachloopCmd( for (j = 0; j < numVars; j++) { Tcl_Obj *varNameObj; const char *bytes; - int numBytes, varIndex; + int varIndex; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); - bytes = TclGetStringFromObj(varNameObj, &numBytes); - varIndex = LocalScalar(bytes, numBytes, envPtr); + bytes = TclGetString(varNameObj); + varIndex = LocalScalar(bytes, varNameObj->length, envPtr); if (varIndex < 0) { code = TCL_ERROR; goto done; @@ -2885,7 +2888,7 @@ DupForeachInfo( register ForeachVarList *srcListPtr, *dupListPtr; int numVars, i, j, numLists = srcPtr->numLists; - dupPtr = ckalloc(sizeof(ForeachInfo) + dupPtr = Tcl_Alloc(sizeof(ForeachInfo) + numLists * sizeof(ForeachVarList *)); dupPtr->numLists = numLists; dupPtr->firstValueTemp = srcPtr->firstValueTemp; @@ -2894,7 +2897,7 @@ DupForeachInfo( for (i = 0; i < numLists; i++) { srcListPtr = srcPtr->varLists[i]; numVars = srcListPtr->numVars; - dupListPtr = ckalloc(sizeof(ForeachVarList) + dupListPtr = Tcl_Alloc(sizeof(ForeachVarList) + numVars * sizeof(int)); dupListPtr->numVars = numVars; for (j = 0; j < numVars; j++) { @@ -2936,9 +2939,9 @@ FreeForeachInfo( for (i = 0; i < numLists; i++) { listPtr = infoPtr->varLists[i]; - ckfree(listPtr); + Tcl_Free(listPtr); } - ckfree(infoPtr); + Tcl_Free(infoPtr); } /* @@ -3143,7 +3146,8 @@ TclCompileFormatCmd( Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Obj **objv, *formatObj, *tmpObj; char *bytes, *start; - int i, j, len; + int i, j; + size_t len; /* * Don't handle any guaranteed-error cases. @@ -3166,7 +3170,7 @@ TclCompileFormatCmd( return TCL_ERROR; } - objv = ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); + objv = Tcl_Alloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); for (i=0 ; i+2 < parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); objv[i] = Tcl_NewObj(); @@ -3186,7 +3190,7 @@ TclCompileFormatCmd( for (; --i>=0 ;) { Tcl_DecrRefCount(objv[i]); } - ckfree(objv); + Tcl_Free(objv); Tcl_DecrRefCount(formatObj); if (tmpObj == NULL) { TclCompileSyntaxError(interp, envPtr); @@ -3216,7 +3220,7 @@ TclCompileFormatCmd( for (; i>=0 ; i--) { Tcl_DecrRefCount(objv[i]); } - ckfree(objv); + Tcl_Free(objv); tokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(tokenPtr); i = 0; @@ -3358,7 +3362,7 @@ TclLocalScalarFromToken( int TclLocalScalar( const char *bytes, - int numBytes, + size_t numBytes, CompileEnv *envPtr) { Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, @@ -3409,9 +3413,10 @@ TclPushVarName( { register const char *p; const char *name, *elName; - register int i, n; + register size_t i, n; Tcl_Token *elemTokenPtr = NULL; - int nameChars, elNameChars, simpleVarName, localIndex; + size_t nameChars, elNameChars; + int simpleVarName, localIndex; int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; /* @@ -3483,7 +3488,7 @@ TclPushVarName( } } if (simpleVarName) { - int remainingChars; + size_t remainingChars; /* * Check the last token: if it is just ')', do not count it. diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 26e9c87..3e8bfee 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -181,7 +181,8 @@ TclCompileIfCmd( * determined. */ Tcl_Token *tokenPtr, *testTokenPtr; int jumpIndex = 0; /* Avoid compiler warning. */ - int jumpFalseDist, numWords, wordIdx, numBytes, j, code; + size_t numBytes; + int jumpFalseDist, numWords, wordIdx, j, code; const char *word; int realCond = 1; /* Set to 0 for static conditions: * "if 0 {..}" */ @@ -433,7 +434,7 @@ TclCompileIfCmd( jumpFalseDist += 3; TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1)); } else { - Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode); + Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%u\" updating ifFalse jump", opCode); } } } @@ -499,7 +500,7 @@ TclCompileIncrCmd( incrTokenPtr = TokenAfter(varTokenPtr); if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { const char *word = incrTokenPtr[1].start; - int numBytes = incrTokenPtr[1].size; + size_t numBytes = incrTokenPtr[1].size; int code; Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); @@ -2080,7 +2081,8 @@ TclCompileRegexpCmd( { Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the RE or string. */ - int i, len, nocase, exact, sawLast, simple; + size_t len; + int i, nocase, exact, sawLast, simple; const char *str; DefineLineInformation; /* TIP #280 */ @@ -2121,7 +2123,7 @@ TclCompileRegexpCmd( sawLast++; i++; break; - } else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) { + } else if ((len > 1) && (strncmp(str,"-nocase", len) == 0)) { nocase = 1; } else { /* @@ -2268,7 +2270,8 @@ TclCompileRegsubCmd( Tcl_Obj *patternObj = NULL, *replacementObj = NULL; Tcl_DString pattern; const char *bytes; - int len, exact, quantified, result = TCL_ERROR; + int exact, quantified, result = TCL_ERROR; + size_t len; if (parsePtr->numWords < 5 || parsePtr->numWords > 6) { return TCL_ERROR; @@ -2346,7 +2349,7 @@ TclCompileRegsubCmd( */ len = Tcl_DStringLength(&pattern) - 2; - if (len > 0) { + if (len + 2 > 2) { goto isSimpleGlob; } @@ -2633,8 +2636,8 @@ TclCompileSyntaxError( CompileEnv *envPtr) { Tcl_Obj *msg = Tcl_GetObjResult(interp); - int numBytes; - const char *bytes = TclGetStringFromObj(msg, &numBytes); + const char *bytes = TclGetString(msg); + size_t numBytes = msg->length; TclErrorStackResetIf(interp, bytes, numBytes); TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr); @@ -2861,7 +2864,8 @@ IndexTailVarIfKnown( { Tcl_Obj *tailPtr; const char *tailName, *p; - int len, n = varTokenPtr->numComponents; + int n = varTokenPtr->numComponents; + size_t len; Tcl_Token *lastTokenPtr; int full, localIndex; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index daab0d5..5325099 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -259,7 +259,7 @@ TclCompileStringCatCmd( } else { Tcl_DecrRefCount(obj); if (folded) { - int len; + size_t len; const char *bytes = TclGetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); @@ -277,7 +277,7 @@ TclCompileStringCatCmd( wordTokenPtr = TokenAfter(wordTokenPtr); } if (folded) { - int len; + size_t len; const char *bytes = TclGetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); @@ -746,7 +746,8 @@ TclCompileStringMatchCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; - int i, length, exactMatch = 0, nocase = 0; + size_t length; + int i, exactMatch = 0, nocase = 0; const char *str; if (parsePtr->numWords < 3 || parsePtr->numWords > 4) { @@ -843,9 +844,9 @@ TclCompileStringLenCmd( */ char buf[TCL_INTEGER_SPACE]; - int len = Tcl_GetCharLength(objPtr); + size_t len = Tcl_GetCharLength(objPtr); - len = sprintf(buf, "%d", len); + len = sprintf(buf, "%" TCL_Z_MODIFIER "d", len); PushLiteral(envPtr, buf, len); } else { SetLineInformation(1); @@ -870,6 +871,7 @@ TclCompileStringMapCmd( Tcl_Obj *mapObj, **objv; char *bytes; int len; + size_t slen; /* * We only handle the case: @@ -905,13 +907,13 @@ TclCompileStringMapCmd( * correct semantics for mapping. */ - bytes = TclGetStringFromObj(objv[0], &len); - if (len == 0) { + bytes = TclGetStringFromObj(objv[0], &slen); + if (slen == 0) { CompileWord(envPtr, stringTokenPtr, interp, 2); } else { - PushLiteral(envPtr, bytes, len); - bytes = TclGetStringFromObj(objv[1], &len); - PushLiteral(envPtr, bytes, len); + PushLiteral(envPtr, bytes, slen); + bytes = TclGetStringFromObj(objv[1], &slen); + PushLiteral(envPtr, bytes, slen); CompileWord(envPtr, stringTokenPtr, interp, 2); OP(STR_MAP); } @@ -1470,7 +1472,7 @@ void TclSubstCompile( Tcl_Interp *interp, const char *bytes, - int numBytes, + size_t numBytes, int flags, int line, CompileEnv *envPtr) @@ -1501,7 +1503,8 @@ TclSubstCompile( for (endTokenPtr = tokenPtr + parse.numTokens; tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) { - int length, literal, catchRange, breakJump; + size_t length; + int literal, catchRange, breakJump; char buf[TCL_UTF_MAX]; JumpFixup startFixup, okFixup, returnFixup, breakFixup; JumpFixup continueFixup, otherFixup, endFixup; @@ -1532,7 +1535,8 @@ TclSubstCompile( */ if (tokenPtr->numComponents > 1) { - int i, foundCommand = 0; + size_t i; + int foundCommand = 0; for (i=2 ; i<=tokenPtr->numComponents ; i++) { if (tokenPtr[i].type == TCL_TOKEN_COMMAND) { @@ -1571,8 +1575,8 @@ TclSubstCompile( /* Start */ if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d", - (int) (CurrentOffset(envPtr) - startFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad start jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - startFixup.codeOffset); } } @@ -1630,8 +1634,8 @@ TclSubstCompile( TclAdjustStackDepth(1, envPtr); /* BREAK destination */ if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d", - (int) (CurrentOffset(envPtr) - breakFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad break jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - breakFixup.codeOffset); } OP( POP); OP( POP); @@ -1646,8 +1650,8 @@ TclSubstCompile( TclAdjustStackDepth(2, envPtr); /* CONTINUE destination */ if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d", - (int) (CurrentOffset(envPtr) - continueFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - continueFixup.codeOffset); } OP( POP); OP( POP); @@ -1656,12 +1660,12 @@ TclSubstCompile( TclAdjustStackDepth(2, envPtr); /* RETURN + other destination */ if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d", - (int) (CurrentOffset(envPtr) - returnFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad return jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - returnFixup.codeOffset); } if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d", - (int) (CurrentOffset(envPtr) - otherFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad other jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - otherFixup.codeOffset); } /* @@ -1673,8 +1677,8 @@ TclSubstCompile( /* OK destination */ if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d", - (int) (CurrentOffset(envPtr) - okFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - okFixup.codeOffset); } if (count > 1) { OP1(STR_CONCAT1, count); @@ -1683,8 +1687,8 @@ TclSubstCompile( /* CONTINUE jump to here */ if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d", - (int) (CurrentOffset(envPtr) - endFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad end jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - endFixup.codeOffset); } bline = envPtr->line; } @@ -1805,7 +1809,7 @@ TclCompileSwitchCmd( */ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { - register unsigned size = tokenPtr[1].size; + register size_t size = tokenPtr[1].size; register const char *chrs = tokenPtr[1].start; /* @@ -1896,7 +1900,7 @@ TclCompileSwitchCmd( if (numWords == 1) { const char *bytes; - int maxLen, numBytes; + size_t maxLen, numBytes; int bline; /* TIP #280: line of the pattern/action list, * and start of list for when tracking the * location. This list comes immediately after @@ -1913,10 +1917,10 @@ TclCompileSwitchCmd( if (maxLen < 2) { return TCL_ERROR; } - bodyTokenArray = ckalloc(sizeof(Tcl_Token) * maxLen); - bodyToken = ckalloc(sizeof(Tcl_Token *) * maxLen); - bodyLines = ckalloc(sizeof(int) * maxLen); - bodyContLines = ckalloc(sizeof(int*) * maxLen); + bodyTokenArray = Tcl_Alloc(sizeof(Tcl_Token) * maxLen); + bodyToken = Tcl_Alloc(sizeof(Tcl_Token *) * maxLen); + bodyLines = Tcl_Alloc(sizeof(int) * maxLen); + bodyContLines = Tcl_Alloc(sizeof(int*) * maxLen); bline = mapPtr->loc[eclIndex].line[valueIndex+1]; numWords = 0; @@ -1954,10 +1958,10 @@ TclCompileSwitchCmd( } if (numWords % 2) { abort: - ckfree(bodyToken); - ckfree(bodyTokenArray); - ckfree(bodyLines); - ckfree(bodyContLines); + Tcl_Free(bodyToken); + Tcl_Free(bodyTokenArray); + Tcl_Free(bodyLines); + Tcl_Free(bodyContLines); return TCL_ERROR; } } else if (numWords % 2 || numWords == 0) { @@ -1975,9 +1979,9 @@ TclCompileSwitchCmd( * Multi-word definition of patterns & actions. */ - bodyToken = ckalloc(sizeof(Tcl_Token *) * numWords); - bodyLines = ckalloc(sizeof(int) * numWords); - bodyContLines = ckalloc(sizeof(int*) * numWords); + bodyToken = Tcl_Alloc(sizeof(Tcl_Token *) * numWords); + bodyLines = Tcl_Alloc(sizeof(int) * numWords); + bodyContLines = Tcl_Alloc(sizeof(int*) * numWords); bodyTokenArray = NULL; for (i=0 ; i<numWords ; i++) { /* @@ -2036,11 +2040,11 @@ TclCompileSwitchCmd( */ freeTemporaries: - ckfree(bodyToken); - ckfree(bodyLines); - ckfree(bodyContLines); + Tcl_Free(bodyToken); + Tcl_Free(bodyLines); + Tcl_Free(bodyContLines); if (bodyTokenArray != NULL) { - ckfree(bodyTokenArray); + Tcl_Free(bodyTokenArray); } return result; } @@ -2341,7 +2345,7 @@ IssueSwitchJumpTable( * Start by allocating the jump table itself, plus some workspace. */ - jtPtr = ckalloc(sizeof(JumptableInfo)); + jtPtr = Tcl_Alloc(sizeof(JumptableInfo)); Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr); finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2)); @@ -2513,7 +2517,7 @@ DupJumptableInfo( ClientData clientData) { JumptableInfo *jtPtr = clientData; - JumptableInfo *newJtPtr = ckalloc(sizeof(JumptableInfo)); + JumptableInfo *newJtPtr = Tcl_Alloc(sizeof(JumptableInfo)); Tcl_HashEntry *hPtr, *newHPtr; Tcl_HashSearch search; int isNew; @@ -2535,7 +2539,7 @@ FreeJumptableInfo( JumptableInfo *jtPtr = clientData; Tcl_DeleteHashTable(&jtPtr->hashTable); - ckfree(jtPtr); + Tcl_Free(jtPtr); } static void @@ -2876,7 +2880,7 @@ TclCompileTryCmd( goto failedToCompile; } if (objc > 0) { - int len; + size_t len; const char *varname = TclGetStringFromObj(objv[0], &len); resultVarIndices[i] = LocalScalar(varname, len, envPtr); @@ -2888,7 +2892,7 @@ TclCompileTryCmd( resultVarIndices[i] = -1; } if (objc == 2) { - int len; + size_t len; const char *varname = TclGetStringFromObj(objv[1], &len); optionVarIndices[i] = LocalScalar(varname, len, envPtr); @@ -3007,6 +3011,7 @@ IssueTryClausesInstructions( DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; int i, j, len, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0; + size_t slen; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; int *noError; char buf[TCL_INTEGER_SPACE]; @@ -3092,8 +3097,8 @@ IssueTryClausesInstructions( OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); - p = TclGetStringFromObj(matchClauses[i], &len); - PushLiteral(envPtr, p, len); + p = TclGetStringFromObj(matchClauses[i], &slen); + PushLiteral(envPtr, p, slen); OP( STR_EQ); JUMP4( JUMP_FALSE, notECJumpSource); } else { @@ -3220,6 +3225,7 @@ IssueTryClausesFinallyInstructions( int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; + size_t slen; resultVar = AnonymousLocal(envPtr); optionsVar = AnonymousLocal(envPtr); @@ -3303,8 +3309,8 @@ IssueTryClausesFinallyInstructions( OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); - p = TclGetStringFromObj(matchClauses[i], &len); - PushLiteral(envPtr, p, len); + p = TclGetStringFromObj(matchClauses[i], &slen); + PushLiteral(envPtr, p, slen); OP( STR_EQ); JUMP4( JUMP_FALSE, notECJumpSource); } else { @@ -3629,7 +3635,7 @@ TclCompileUnsetCmd( } if (varCount == 0) { const char *bytes; - int len; + size_t len; bytes = TclGetStringFromObj(leadingWord, &len); if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) { diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index e96e264..06634e2 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -22,7 +22,7 @@ * The tree is composed of OpNodes. */ -typedef struct OpNode { +typedef struct { int left; /* "Pointer" to the left operand. */ int right; /* "Pointer" to the right operand. */ union { @@ -501,16 +501,16 @@ static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj *const **litObjvPtr, Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, CompileEnv *envPtr, int optimize); -static void ConvertTreeToTokens(const char *start, int numBytes, +static void ConvertTreeToTokens(const char *start, size_t numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr); static int ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj * const **litObjvPtr); static int ParseExpr(Tcl_Interp *interp, const char *start, - int numBytes, OpNode **opTreePtr, + size_t numBytes, OpNode **opTreePtr, Tcl_Obj *litList, Tcl_Obj *funcList, Tcl_Parse *parsePtr, int parseOnly); -static int ParseLexeme(const char *start, int numBytes, +static size_t ParseLexeme(const char *start, size_t numBytes, unsigned char *lexemePtr, Tcl_Obj **literalPtr); /* @@ -536,7 +536,7 @@ static int ParseLexeme(const char *start, int numBytes, * Side effects: * Memory will be allocated. If TCL_OK is returned, the caller must clean * up the returned data structures. The (OpNode *) value written to - * opTreePtr should be passed to ckfree() and the parsePtr argument + * opTreePtr should be passed to Tcl_Free() and the parsePtr argument * should be passed to Tcl_FreeParse(). The elements appended to the * litList and funcList will automatically be freed whenever the refcount * on those lists indicates they can be freed. @@ -548,7 +548,7 @@ static int ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ - int numBytes, /* Number of bytes in string. */ + size_t numBytes, /* Number of bytes in string. */ OpNode **opTreePtr, /* Points to space where a pointer to the * allocated OpNode tree should go. */ Tcl_Obj *litList, /* List to append literals to. */ @@ -571,7 +571,7 @@ ParseExpr( * no need for array growth and * reallocation. */ unsigned int nodesUsed = 0; /* Number of OpNodes filled. */ - int scanned = 0; /* Capture number of byte scanned by parsing + size_t scanned = 0; /* Capture number of byte scanned by parsing * routines. */ int lastParsed; /* Stores info about what the lexeme parsed * the previous pass through the parsing loop @@ -615,7 +615,7 @@ ParseExpr( * error in the expression. */ int insertMark = 0; /* A boolean controlling whether the "mark" * should be inserted. */ - const int limit = 25; /* Portions of the error message are + const unsigned limit = 25; /* Portions of the error message are * constructed out of substrings of the * original expression. In order to keep the * error message readable, we impose this @@ -623,7 +623,7 @@ ParseExpr( TclParseInit(interp, start, numBytes, parsePtr); - nodes = attemptckalloc(nodesAvailable * sizeof(OpNode)); + nodes = Tcl_AttemptAlloc(nodesAvailable * sizeof(OpNode)); if (nodes == NULL) { TclNewLiteralStringObj(msg, "not enough memory to parse expression"); errCode = "NOMEM"; @@ -667,7 +667,7 @@ ParseExpr( do { if (size <= UINT_MAX/sizeof(OpNode)) { - newPtr = attemptckrealloc(nodes, size * sizeof(OpNode)); + newPtr = Tcl_AttemptRealloc(nodes, size * sizeof(OpNode)); } } while ((newPtr == NULL) && ((size -= (size - nodesUsed) / 2) > nodesUsed)); @@ -702,12 +702,12 @@ ParseExpr( switch (lexeme) { case INVALID: msg = Tcl_ObjPrintf("invalid character \"%.*s\"", - scanned, start); + (int)scanned, start); errCode = "BADCHAR"; goto error; case INCOMPLETE: msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"", - scanned, start); + (int)scanned, start); errCode = "PARTOP"; goto error; case BAREWORD: @@ -736,16 +736,16 @@ ParseExpr( } else { Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", - (scanned < limit) ? scanned : limit - 3, start, + (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "..."); post = Tcl_ObjPrintf( "should be \"$%.*s%s\" or \"{%.*s%s}\"", - (scanned < limit) ? scanned : limit - 3, + (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "...", - (scanned < limit) ? scanned : limit - 3, + (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "..."); Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...", - (scanned < limit) ? scanned : limit - 3, + (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "..."); errCode = "BAREWORD"; if (start[0] == '0') { @@ -1377,7 +1377,7 @@ ParseExpr( */ if (nodes != NULL) { - ckfree(nodes); + Tcl_Free(nodes); } if (interp == NULL) { @@ -1406,13 +1406,13 @@ ParseExpr( Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", ((start - limit) < parsePtr->string) ? "" : "...", ((start - limit) < parsePtr->string) - ? (int) (start - parsePtr->string) : limit - 3, + ? (int) (start - parsePtr->string) : (int)limit - 3, ((start - limit) < parsePtr->string) ? parsePtr->string : start - limit + 3, - (scanned < limit) ? scanned : limit - 3, start, + (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "...", insertMark ? mark : "", (start + scanned + limit > parsePtr->end) - ? (int) (parsePtr->end - start) - scanned : limit-3, + ? (int) (parsePtr->end - start) - (int)scanned : (int)limit-3, start + scanned, (start + scanned + limit > parsePtr->end) ? "" : "..."); @@ -1434,7 +1434,7 @@ ParseExpr( numBytes = parsePtr->end - parsePtr->string; Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (parsing expression \"%.*s%s\")", - (numBytes < limit) ? numBytes : limit - 3, + (numBytes < limit) ? (int)numBytes : (int)limit - 3, parsePtr->string, (numBytes < limit) ? "" : "...")); if (errCode) { Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode, @@ -1471,7 +1471,7 @@ ParseExpr( static void ConvertTreeToTokens( const char *start, - int numBytes, + size_t numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr) @@ -1819,7 +1819,7 @@ int Tcl_ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ - int numBytes, /* Number of bytes in string. If < 0, the + size_t numBytes, /* Number of bytes in string. If -1, the * string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr) /* Structure to fill with information about @@ -1833,7 +1833,7 @@ Tcl_ParseExpr( Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */ - if (numBytes < 0) { + if (numBytes == TCL_AUTO_LENGTH) { numBytes = (start ? strlen(start) : 0); } @@ -1853,7 +1853,7 @@ Tcl_ParseExpr( Tcl_FreeParse(exprParsePtr); TclStackFree(interp, exprParsePtr); - ckfree(opTree); + Tcl_Free(opTree); return code; } @@ -1874,17 +1874,16 @@ Tcl_ParseExpr( *---------------------------------------------------------------------- */ -static int +static size_t ParseLexeme( const char *start, /* Start of lexeme to parse. */ - int numBytes, /* Number of bytes in string. */ + size_t numBytes, /* Number of bytes in string. */ unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this storage, if non-NULL. */ { const char *end; - int scanned; Tcl_UniChar ch = 0; Tcl_Obj *literal = NULL; unsigned char byte; @@ -2063,12 +2062,13 @@ ParseLexeme( */ if (!TclIsBareword(*start) || *start == '_') { + size_t scanned; if (Tcl_UtfCharComplete(start, numBytes)) { scanned = TclUtfToUniChar(start, &ch); } else { char utfBytes[TCL_UTF_MAX]; - memcpy(utfBytes, start, (size_t) numBytes); + memcpy(utfBytes, start, numBytes); utfBytes[numBytes] = '\0'; scanned = TclUtfToUniChar(utfBytes, &ch); } @@ -2112,7 +2112,7 @@ void TclCompileExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *script, /* The source script to compile. */ - int numBytes, /* Number of bytes in script. */ + size_t numBytes, /* Number of bytes in script. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int optimize) /* 0 for one-off expressions. */ { @@ -2150,7 +2150,7 @@ TclCompileExpr( TclStackFree(interp, parsePtr); Tcl_DecrRefCount(funcList); Tcl_DecrRefCount(litList); - ckfree(opTree); + Tcl_Free(opTree); } /* @@ -2260,7 +2260,7 @@ CompileExprTree( case FUNCTION: { Tcl_DString cmdName; const char *p; - int length; + size_t length; Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); @@ -2419,7 +2419,7 @@ CompileExprTree( Tcl_Obj *literal = *litObjv; if (optimize) { - int length; + size_t length; const char *bytes = TclGetStringFromObj(literal, &length); int index = TclRegisterLiteral(envPtr, bytes, length, 0); Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index); @@ -2478,9 +2478,9 @@ CompileExprTree( if (TclHasStringRep(objPtr)) { Tcl_Obj *tableValue; - int numBytes; + size_t numBytes; const char *bytes - = Tcl_GetStringFromObj(objPtr, &numBytes); + = TclGetStringFromObj(objPtr, &numBytes); index = TclRegisterLiteral(envPtr, bytes, numBytes, 0); tableValue = TclFetchLiteral(envPtr, index); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index f6e6b81..cbdf373 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -129,10 +129,6 @@ InstructionDesc const tclInstructionTable[] = { {"jumpFalse4", 5, -1, 1, {OPERAND_OFFSET4}}, /* Jump relative to (pc + op4) if stktop expr object is false */ - {"lor", 1, -1, 0, {OPERAND_NONE}}, - /* Logical or: push (stknext || stktop) */ - {"land", 1, -1, 0, {OPERAND_NONE}}, - /* Logical and: push (stknext && stktop) */ {"bitor", 1, -1, 0, {OPERAND_NONE}}, /* Bitwise or: push (stknext | stktop) */ {"bitxor", 1, -1, 0, {OPERAND_NONE}}, @@ -173,10 +169,6 @@ InstructionDesc const tclInstructionTable[] = { /* Bitwise not: push ~stktop */ {"not", 1, 0, 0, {OPERAND_NONE}}, /* Logical not: push !stktop */ - {"callBuiltinFunc1", 2, 1, 1, {OPERAND_UINT1}}, - /* Call builtin math function with index op1; any args are on stk */ - {"callFunc1", 2, INT_MIN, 1, {OPERAND_UINT1}}, - /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */ {"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}}, /* Try converting stktop to first int then double if possible. */ @@ -186,13 +178,6 @@ InstructionDesc const tclInstructionTable[] = { /* Skip to next iteration of closest enclosing loop; if none, return * TCL_CONTINUE code. */ - {"foreach_start4", 5, 0, 1, {OPERAND_AUX4}}, - /* Initialize execution of a foreach loop. Operand is aux data index - * of the ForeachInfo structure for the foreach command. */ - {"foreach_step4", 5, +1, 1, {OPERAND_AUX4}}, - /* "Step" or begin next iteration of foreach loop. Push 0 if to - * terminate loop, else push 1. */ - {"beginCatch4", 5, 0, 1, {OPERAND_UINT4}}, /* Record start of catch with the operand's exception index. Push the * current stack depth onto a special catch stack. */ @@ -340,9 +325,6 @@ InstructionDesc const tclInstructionTable[] = { {"dictNext", 5, +3, 1, {OPERAND_LVT4}}, /* Get the next iteration from the iterator in op4's local scalar. * Stack: ... => ... value key doneBool */ - {"dictDone", 5, 0, 1, {OPERAND_LVT4}}, - /* Terminate the iterator in op4's local scalar. Use unsetScalar - * instead (with 0 for flags). */ {"dictUpdateStart", 9, 0, 2, {OPERAND_LVT4, OPERAND_AUX4}}, /* Create the variables (described in the aux data referred to by the * second immediate argument) to mirror the state of the dictionary in @@ -854,8 +836,8 @@ TclSetByteCodeFromAny( * instruction generator boundaries. */ - if (iPtr->extra.optimizer) { - (iPtr->extra.optimizer)(&compEnv); + if (iPtr->optimizer) { + (iPtr->optimizer)(&compEnv); } /* @@ -1136,12 +1118,12 @@ CleanupByteCode( } } - if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) { + if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) { TclFreeLocalCache(interp, codePtr->localCachePtr); } TclHandleRelease(codePtr->interpHandle); - ckfree(codePtr); + Tcl_Free(codePtr); } /* @@ -1326,8 +1308,8 @@ CompileSubstObj( } if (codePtr == NULL) { CompileEnv compEnv; - int numBytes; - const char *bytes = TclGetStringFromObj(objPtr, &numBytes); + const char *bytes = TclGetString(objPtr); + size_t numBytes = objPtr->length; /* TODO: Check for more TIP 280 */ TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0); @@ -1395,14 +1377,14 @@ ReleaseCmdWordData( Tcl_DecrRefCount(eclPtr->path); } for (i=0 ; i<eclPtr->nuloc ; i++) { - ckfree(eclPtr->loc[i].line); + Tcl_Free(eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { - ckfree(eclPtr->loc); + Tcl_Free(eclPtr->loc); } - ckfree(eclPtr); + Tcl_Free(eclPtr); } /* @@ -1429,14 +1411,14 @@ TclInitCompileEnv( register CompileEnv *envPtr,/* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ - int numBytes, /* Number of bytes in source string. */ + size_t numBytes, /* Number of bytes in source string. */ const CmdFrame *invoker, /* Location context invoking the bcc */ int word) /* Index of the word in that context getting * compiled */ { Interp *iPtr = (Interp *) interp; - assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL); + assert(tclInstructionTable[LAST_INST_OPCODE].name == NULL); envPtr->iPtr = iPtr; envPtr->source = stringPtr; @@ -1481,7 +1463,7 @@ TclInitCompileEnv( * non-compiling evaluator */ - envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc)); + envPtr->extCmdMapPtr = Tcl_Alloc(sizeof(ExtCmdLoc)); envPtr->extCmdMapPtr->loc = NULL; envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; @@ -1636,7 +1618,7 @@ TclFreeCompileEnv( register CompileEnv *envPtr)/* Points to the CompileEnv structure. */ { if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){ - ckfree(envPtr->localLitTable.buckets); + Tcl_Free(envPtr->localLitTable.buckets); envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; } if (envPtr->iPtr) { @@ -1666,20 +1648,20 @@ TclFreeCompileEnv( } } if (envPtr->mallocedCodeArray) { - ckfree(envPtr->codeStart); + Tcl_Free(envPtr->codeStart); } if (envPtr->mallocedLiteralArray) { - ckfree(envPtr->literalArrayPtr); + Tcl_Free(envPtr->literalArrayPtr); } if (envPtr->mallocedExceptArray) { - ckfree(envPtr->exceptArrayPtr); - ckfree(envPtr->exceptAuxArrayPtr); + Tcl_Free(envPtr->exceptArrayPtr); + Tcl_Free(envPtr->exceptAuxArrayPtr); } if (envPtr->mallocedCmdMap) { - ckfree(envPtr->cmdMapPtr); + Tcl_Free(envPtr->cmdMapPtr); } if (envPtr->mallocedAuxDataArray) { - ckfree(envPtr->auxDataArrayPtr); + Tcl_Free(envPtr->auxDataArrayPtr); } if (envPtr->extCmdMapPtr) { ReleaseCmdWordData(envPtr->extCmdMapPtr); @@ -1745,7 +1727,7 @@ TclWordKnownAtCompileTime( case TCL_TOKEN_BS: if (tempPtr != NULL) { char utfBuf[TCL_UTF_MAX]; - int length = TclParseBackslash(tokenPtr->start, + size_t length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, utfBuf); Tcl_AppendToObj(tempPtr, utfBuf, length); @@ -1806,7 +1788,6 @@ CompileCmdLiteral( Tcl_Obj *cmdObj, CompileEnv *envPtr) { - int numBytes; const char *bytes; Command *cmdPtr; int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME; @@ -1816,8 +1797,8 @@ CompileCmdLiteral( extraLiteralFlags |= LITERAL_UNSHARED; } - bytes = TclGetStringFromObj(cmdObj, &numBytes); - cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags); + bytes = TclGetString(cmdObj); + cmdLitIdx = TclRegisterLiteral(envPtr, bytes, cmdObj->length, extraLiteralFlags); if (cmdPtr) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); @@ -1998,7 +1979,7 @@ CompileCmdCompileProc( while (mapPtr->nuloc - 1 > eclIndex) { mapPtr->nuloc--; - ckfree(mapPtr->loc[mapPtr->nuloc].line); + Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); mapPtr->loc[mapPtr->nuloc].line = NULL; } @@ -2116,8 +2097,8 @@ CompileCommandTokens( envPtr->line = cmdLine; envPtr->clNext = clNext; - ckfree(eclPtr->loc[wlineat].line); - ckfree(eclPtr->loc[wlineat].next); + Tcl_Free(eclPtr->loc[wlineat].line); + Tcl_Free(eclPtr->loc[wlineat].next); eclPtr->loc[wlineat].line = wlines; eclPtr->loc[wlineat].next = NULL; @@ -2131,7 +2112,7 @@ TclCompileScript( * serves as context for finding and compiling * commands. May not be NULL. */ const char *script, /* The source script to compile. */ - int numBytes, /* Number of bytes in script. If < 0, the + size_t numBytes, /* Number of bytes in script. If -1, the * script consists of all bytes up to the * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ @@ -2149,7 +2130,7 @@ TclCompileScript( /* Each iteration compiles one command from the script. */ - while (numBytes > 0) { + while (numBytes + 1 > 1) { Tcl_Parse parse; const char *next; @@ -2284,8 +2265,8 @@ TclCompileVarSubst( CompileEnv *envPtr) { const char *p, *name = tokenPtr[1].start; - int nameBytes = tokenPtr[1].size; - int i, localVar, localVarName = 1; + size_t i, nameBytes = tokenPtr[1].size; + int localVar, localVarName = 1; /* * Determine how the variable name should be handled: if it contains any @@ -2359,7 +2340,8 @@ TclCompileTokens( Tcl_DString textBuffer; /* Holds concatenated chars from adjacent * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ char buffer[TCL_UTF_MAX]; - int i, numObjsToConcat, length, adjust; + int i, numObjsToConcat, adjust; + size_t length; unsigned char *entryCodeNext = envPtr->codeNext; #define NUM_STATIC_POS 20 int isLiteral, maxNumCL, numCL; @@ -2394,7 +2376,7 @@ TclCompileTokens( if (isLiteral) { maxNumCL = NUM_STATIC_POS; - clPosition = ckalloc(maxNumCL * sizeof(int)); + clPosition = Tcl_Alloc(maxNumCL * sizeof(int)); } adjust = 0; @@ -2435,7 +2417,7 @@ TclCompileTokens( if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = ckrealloc(clPosition, + clPosition = Tcl_Realloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; @@ -2493,7 +2475,7 @@ TclCompileTokens( default: Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s", - tokenPtr->type, tokenPtr->size, tokenPtr->start); + tokenPtr->type, (int)tokenPtr->size, tokenPtr->start); } } @@ -2540,7 +2522,7 @@ TclCompileTokens( */ if (maxNumCL) { - ckfree(clPosition); + Tcl_Free(clPosition); } TclCheckStackDepth(depth+1, envPtr); } @@ -2751,8 +2733,8 @@ PreventCycle( * can be sure we do not have any lingering cycles hiding in * the intrep. */ - int numBytes; - const char *bytes = TclGetStringFromObj(objPtr, &numBytes); + const char *bytes = TclGetString(objPtr); + size_t numBytes = objPtr->length; Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes); Tcl_IncrRefCount(copyPtr); @@ -2809,7 +2791,7 @@ TclInitByteCode( namespacePtr = envPtr->iPtr->globalNsPtr; } - p = ckalloc(structureSize); + p = Tcl_Alloc(structureSize); codePtr = (ByteCode *) p; codePtr->interpHandle = TclHandlePreserve(iPtr->handle); codePtr->compileEpoch = iPtr->compileEpoch; @@ -2954,7 +2936,7 @@ TclFindCompiledLocal( register const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ - int nameBytes, /* Number of bytes in the name. */ + size_t nameBytes, /* Number of bytes in the name. */ int create, /* If 1, allocate a local frame entry for the * variable if it is new. */ CompileEnv *envPtr) /* Points to the current compile environment*/ @@ -2980,7 +2962,7 @@ TclFindCompiledLocal( LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr; const char *localName; Tcl_Obj **varNamePtr; - int len; + size_t len; if (!cachePtr || !name) { return -1; @@ -3007,8 +2989,8 @@ TclFindCompiledLocal( if (!TclIsVarTemporary(localPtr)) { char *localName = localPtr->name; - if ((nameBytes == localPtr->nameLength) && - (strncmp(name,localName,(unsigned)nameBytes) == 0)) { + if ((nameBytes == (size_t)localPtr->nameLength) && + (strncmp(name,localName,nameBytes) == 0)) { return i; } } @@ -3022,7 +3004,7 @@ TclFindCompiledLocal( if (create || (name == NULL)) { localVar = procPtr->numCompiledLocals; - localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameBytes + 1); + localPtr = Tcl_Alloc(TclOffset(CompiledLocal, name) + nameBytes + 1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { @@ -3086,14 +3068,14 @@ TclExpandCodeArray( size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart); if (envPtr->mallocedCodeArray) { - envPtr->codeStart = ckrealloc(envPtr->codeStart, newBytes); + envPtr->codeStart = Tcl_Realloc(envPtr->codeStart, newBytes); } else { /* - * envPtr->codeStart isn't a ckalloc'd pointer, so we must code a - * ckrealloc equivalent for ourselves. + * envPtr->codeStart isn't a Tcl_Alloc'd pointer, so we must code a + * Tcl_Realloc equivalent for ourselves. */ - unsigned char *newPtr = ckalloc(newBytes); + unsigned char *newPtr = Tcl_Alloc(newBytes); memcpy(newPtr, envPtr->codeStart, currBytes); envPtr->codeStart = newPtr; @@ -3153,14 +3135,14 @@ EnterCmdStartData( size_t newBytes = newElems * sizeof(CmdLocation); if (envPtr->mallocedCmdMap) { - envPtr->cmdMapPtr = ckrealloc(envPtr->cmdMapPtr, newBytes); + envPtr->cmdMapPtr = Tcl_Realloc(envPtr->cmdMapPtr, newBytes); } else { /* - * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a - * ckrealloc equivalent for ourselves. + * envPtr->cmdMapPtr isn't a Tcl_Alloc'd pointer, so we must code a + * Tcl_Realloc equivalent for ourselves. */ - CmdLocation *newPtr = ckalloc(newBytes); + CmdLocation *newPtr = Tcl_Alloc(newBytes); memcpy(newPtr, envPtr->cmdMapPtr, currBytes); envPtr->cmdMapPtr = newPtr; @@ -3279,16 +3261,16 @@ EnterCmdWordData( size_t newElems = (currElems ? 2*currElems : 1); size_t newBytes = newElems * sizeof(ECL); - eclPtr->loc = ckrealloc(eclPtr->loc, newBytes); + eclPtr->loc = Tcl_Realloc(eclPtr->loc, newBytes); eclPtr->nloc = newElems; } ePtr = &eclPtr->loc[eclPtr->nuloc]; ePtr->srcOffset = srcOffset; - ePtr->line = ckalloc(numWords * sizeof(int)); - ePtr->next = ckalloc(numWords * sizeof(int *)); + ePtr->line = Tcl_Alloc(numWords * sizeof(int)); + ePtr->next = Tcl_Alloc(numWords * sizeof(int *)); ePtr->nline = numWords; - wwlines = ckalloc(numWords * sizeof(int)); + wwlines = Tcl_Alloc(numWords * sizeof(int)); last = cmd; wordLine = line; @@ -3357,17 +3339,17 @@ TclCreateExceptRange( if (envPtr->mallocedExceptArray) { envPtr->exceptArrayPtr = - ckrealloc(envPtr->exceptArrayPtr, newBytes); + Tcl_Realloc(envPtr->exceptArrayPtr, newBytes); envPtr->exceptAuxArrayPtr = - ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2); + Tcl_Realloc(envPtr->exceptAuxArrayPtr, newBytes2); } else { /* - * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must - * code a ckrealloc equivalent for ourselves. + * envPtr->exceptArrayPtr isn't a Tcl_Alloc'd pointer, so we must + * code a Tcl_Realloc equivalent for ourselves. */ - ExceptionRange *newPtr = ckalloc(newBytes); - ExceptionAux *newPtr2 = ckalloc(newBytes2); + ExceptionRange *newPtr = Tcl_Alloc(newBytes); + ExceptionAux *newPtr2 = Tcl_Alloc(newBytes2); memcpy(newPtr, envPtr->exceptArrayPtr, currBytes); memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2); @@ -3470,11 +3452,11 @@ TclAddLoopBreakFixup( auxPtr->allocBreakTargets *= 2; auxPtr->allocBreakTargets += 2; if (auxPtr->breakTargets) { - auxPtr->breakTargets = ckrealloc(auxPtr->breakTargets, + auxPtr->breakTargets = Tcl_Realloc(auxPtr->breakTargets, sizeof(int) * auxPtr->allocBreakTargets); } else { auxPtr->breakTargets = - ckalloc(sizeof(int) * auxPtr->allocBreakTargets); + Tcl_Alloc(sizeof(int) * auxPtr->allocBreakTargets); } } auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr); @@ -3496,11 +3478,11 @@ TclAddLoopContinueFixup( auxPtr->allocContinueTargets *= 2; auxPtr->allocContinueTargets += 2; if (auxPtr->continueTargets) { - auxPtr->continueTargets = ckrealloc(auxPtr->continueTargets, + auxPtr->continueTargets = Tcl_Realloc(auxPtr->continueTargets, sizeof(int) * auxPtr->allocContinueTargets); } else { auxPtr->continueTargets = - ckalloc(sizeof(int) * auxPtr->allocContinueTargets); + Tcl_Alloc(sizeof(int) * auxPtr->allocContinueTargets); } } auxPtr->continueTargets[auxPtr->numContinueTargets - 1] = @@ -3662,12 +3644,12 @@ TclFinalizeLoopExceptionRange( */ if (auxPtr->breakTargets) { - ckfree(auxPtr->breakTargets); + Tcl_Free(auxPtr->breakTargets); auxPtr->breakTargets = NULL; auxPtr->numBreakTargets = 0; } if (auxPtr->continueTargets) { - ckfree(auxPtr->continueTargets); + Tcl_Free(auxPtr->continueTargets); auxPtr->continueTargets = NULL; auxPtr->numContinueTargets = 0; } @@ -3723,14 +3705,14 @@ TclCreateAuxData( if (envPtr->mallocedAuxDataArray) { envPtr->auxDataArrayPtr = - ckrealloc(envPtr->auxDataArrayPtr, newBytes); + Tcl_Realloc(envPtr->auxDataArrayPtr, newBytes); } else { /* - * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must - * code a ckrealloc equivalent for ourselves. + * envPtr->auxDataArrayPtr isn't a Tcl_Alloc'd pointer, so we must + * code a Tcl_Realloc equivalent for ourselves. */ - AuxData *newPtr = ckalloc(newBytes); + AuxData *newPtr = Tcl_Alloc(newBytes); memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes); envPtr->auxDataArrayPtr = newPtr; @@ -3812,14 +3794,14 @@ TclExpandJumpFixupArray( size_t newBytes = newElems * sizeof(JumpFixup); if (fixupArrayPtr->mallocedArray) { - fixupArrayPtr->fixup = ckrealloc(fixupArrayPtr->fixup, newBytes); + fixupArrayPtr->fixup = Tcl_Realloc(fixupArrayPtr->fixup, newBytes); } else { /* - * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a - * ckrealloc equivalent for ourselves. + * fixupArrayPtr->fixup isn't a Tcl_Alloc'd pointer, so we must code a + * Tcl_Realloc equivalent for ourselves. */ - JumpFixup *newPtr = ckalloc(newBytes); + JumpFixup *newPtr = Tcl_Alloc(newBytes); memcpy(newPtr, fixupArrayPtr->fixup, currBytes); fixupArrayPtr->fixup = newPtr; @@ -3851,7 +3833,7 @@ TclFreeJumpFixupArray( * free. */ { if (fixupArrayPtr->mallocedArray) { - ckfree(fixupArrayPtr->fixup); + Tcl_Free(fixupArrayPtr->fixup); } } @@ -3951,7 +3933,7 @@ TclFixupForwardJump( { unsigned char *jumpPc, *p; int firstCmd, lastCmd, firstRange, lastRange, k; - unsigned numBytes; + size_t numBytes; if (jumpDist <= distThreshold) { jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index cf11e0e..5d77009 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -87,7 +87,7 @@ typedef enum { * to a catch PC offset. */ } ExceptionRangeType; -typedef struct ExceptionRange { +typedef struct { ExceptionRangeType type; /* The kind of ExceptionRange. */ int nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range @@ -162,7 +162,7 @@ typedef struct ExceptionAux { * source offset is not monotonic. */ -typedef struct CmdLocation { +typedef struct { int codeOffset; /* Offset of first byte of command code. */ int numCodeBytes; /* Number of bytes for command's code. */ int srcOffset; /* Offset of first char of the command. */ @@ -180,8 +180,8 @@ typedef struct CmdLocation { * frame and associated information, like the path of a sourced file. */ -typedef struct ECL { - int srcOffset; /* Command location to find the entry. */ +typedef struct { + size_t srcOffset; /* Command location to find the entry. */ int nline; /* Number of words in the command */ int *line; /* Line information for all words in the * command. */ @@ -190,7 +190,7 @@ typedef struct ECL { * lines. */ } ECL; -typedef struct ExtCmdLoc { +typedef struct { int type; /* Context type. */ int start; /* Starting line for compiled script. Needed * for the extended recompile check in @@ -217,9 +217,9 @@ typedef struct ExtCmdLoc { * the AuxData structure. */ -typedef ClientData (AuxDataDupProc) (ClientData clientData); -typedef void (AuxDataFreeProc) (ClientData clientData); -typedef void (AuxDataPrintProc)(ClientData clientData, +typedef void *(AuxDataDupProc) (void *clientData); +typedef void (AuxDataFreeProc) (void *clientData); +typedef void (AuxDataPrintProc)(void *clientData, Tcl_Obj *appendObj, struct ByteCode *codePtr, unsigned int pcOffset); @@ -417,7 +417,7 @@ typedef struct ByteCode { * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ - unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this + size_t compileEpoch; /* Value of iPtr->compileEpoch when this * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ @@ -425,11 +425,11 @@ typedef struct ByteCode { * compiled. If the code is executed if a * different namespace, it must be * recompiled. */ - unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this + size_t nsEpoch; /* Value of nsPtr->resolverEpoch when this * ByteCode was compiled. Used to invalidate * code when new namespace resolution rules * are put into effect. */ - unsigned int refCount; /* Reference count: set 1 when created plus 1 + size_t refCount; /* Reference count: set 1 when created plus 1 * for each execution of the code currently * active. This structure can be freed when * refCount becomes zero. */ @@ -536,312 +536,292 @@ typedef struct ByteCode { * Opcodes for the Tcl bytecode instructions. These must correspond to the * entries in the table of instruction descriptions, tclInstructionTable, in * tclCompile.c. Also, the order and number of the expression opcodes (e.g., - * INST_LOR) must match the entries in the array operatorStrings in + * INST_BITOR) must match the entries in the array operatorStrings in * tclExecute.c. */ -/* Opcodes 0 to 9 */ -#define INST_DONE 0 -#define INST_PUSH1 1 -#define INST_PUSH4 2 -#define INST_POP 3 -#define INST_DUP 4 -#define INST_STR_CONCAT1 5 -#define INST_INVOKE_STK1 6 -#define INST_INVOKE_STK4 7 -#define INST_EVAL_STK 8 -#define INST_EXPR_STK 9 - -/* Opcodes 10 to 23 */ -#define INST_LOAD_SCALAR1 10 -#define INST_LOAD_SCALAR4 11 -#define INST_LOAD_SCALAR_STK 12 -#define INST_LOAD_ARRAY1 13 -#define INST_LOAD_ARRAY4 14 -#define INST_LOAD_ARRAY_STK 15 -#define INST_LOAD_STK 16 -#define INST_STORE_SCALAR1 17 -#define INST_STORE_SCALAR4 18 -#define INST_STORE_SCALAR_STK 19 -#define INST_STORE_ARRAY1 20 -#define INST_STORE_ARRAY4 21 -#define INST_STORE_ARRAY_STK 22 -#define INST_STORE_STK 23 - -/* Opcodes 24 to 33 */ -#define INST_INCR_SCALAR1 24 -#define INST_INCR_SCALAR_STK 25 -#define INST_INCR_ARRAY1 26 -#define INST_INCR_ARRAY_STK 27 -#define INST_INCR_STK 28 -#define INST_INCR_SCALAR1_IMM 29 -#define INST_INCR_SCALAR_STK_IMM 30 -#define INST_INCR_ARRAY1_IMM 31 -#define INST_INCR_ARRAY_STK_IMM 32 -#define INST_INCR_STK_IMM 33 - -/* Opcodes 34 to 39 */ -#define INST_JUMP1 34 -#define INST_JUMP4 35 -#define INST_JUMP_TRUE1 36 -#define INST_JUMP_TRUE4 37 -#define INST_JUMP_FALSE1 38 -#define INST_JUMP_FALSE4 39 - -/* Opcodes 40 to 64 */ -#define INST_LOR 40 -#define INST_LAND 41 -#define INST_BITOR 42 -#define INST_BITXOR 43 -#define INST_BITAND 44 -#define INST_EQ 45 -#define INST_NEQ 46 -#define INST_LT 47 -#define INST_GT 48 -#define INST_LE 49 -#define INST_GE 50 -#define INST_LSHIFT 51 -#define INST_RSHIFT 52 -#define INST_ADD 53 -#define INST_SUB 54 -#define INST_MULT 55 -#define INST_DIV 56 -#define INST_MOD 57 -#define INST_UPLUS 58 -#define INST_UMINUS 59 -#define INST_BITNOT 60 -#define INST_LNOT 61 -#define INST_CALL_BUILTIN_FUNC1 62 -#define INST_CALL_FUNC1 63 -#define INST_TRY_CVT_TO_NUMERIC 64 - -/* Opcodes 65 to 66 */ -#define INST_BREAK 65 -#define INST_CONTINUE 66 - -/* Opcodes 67 to 68 */ -#define INST_FOREACH_START4 67 /* DEPRECATED */ -#define INST_FOREACH_STEP4 68 /* DEPRECATED */ - -/* Opcodes 69 to 72 */ -#define INST_BEGIN_CATCH4 69 -#define INST_END_CATCH 70 -#define INST_PUSH_RESULT 71 -#define INST_PUSH_RETURN_CODE 72 - -/* Opcodes 73 to 78 */ -#define INST_STR_EQ 73 -#define INST_STR_NEQ 74 -#define INST_STR_CMP 75 -#define INST_STR_LEN 76 -#define INST_STR_INDEX 77 -#define INST_STR_MATCH 78 - -/* Opcodes 78 to 81 */ -#define INST_LIST 79 -#define INST_LIST_INDEX 80 -#define INST_LIST_LENGTH 81 - -/* Opcodes 82 to 87 */ -#define INST_APPEND_SCALAR1 82 -#define INST_APPEND_SCALAR4 83 -#define INST_APPEND_ARRAY1 84 -#define INST_APPEND_ARRAY4 85 -#define INST_APPEND_ARRAY_STK 86 -#define INST_APPEND_STK 87 - -/* Opcodes 88 to 93 */ -#define INST_LAPPEND_SCALAR1 88 -#define INST_LAPPEND_SCALAR4 89 -#define INST_LAPPEND_ARRAY1 90 -#define INST_LAPPEND_ARRAY4 91 -#define INST_LAPPEND_ARRAY_STK 92 -#define INST_LAPPEND_STK 93 - -/* TIP #22 - LINDEX operator with flat arg list */ - -#define INST_LIST_INDEX_MULTI 94 - -/* - * TIP #33 - 'lset' command. Code gen also required a Forth-like - * OVER operation. - */ - -#define INST_OVER 95 -#define INST_LSET_LIST 96 -#define INST_LSET_FLAT 97 - -/* TIP#90 - 'return' command. */ - -#define INST_RETURN_IMM 98 - -/* TIP#123 - exponentiation operator. */ - -#define INST_EXPON 99 - -/* TIP #157 - {*}... (word expansion) language syntax support. */ - -#define INST_EXPAND_START 100 -#define INST_EXPAND_STKTOP 101 -#define INST_INVOKE_EXPANDED 102 - -/* - * TIP #57 - 'lassign' command. Code generation requires immediate - * LINDEX and LRANGE operators. - */ - -#define INST_LIST_INDEX_IMM 103 -#define INST_LIST_RANGE_IMM 104 - -#define INST_START_CMD 105 - -#define INST_LIST_IN 106 -#define INST_LIST_NOT_IN 107 - -#define INST_PUSH_RETURN_OPTIONS 108 -#define INST_RETURN_STK 109 - -/* - * Dictionary (TIP#111) related commands. - */ - -#define INST_DICT_GET 110 -#define INST_DICT_SET 111 -#define INST_DICT_UNSET 112 -#define INST_DICT_INCR_IMM 113 -#define INST_DICT_APPEND 114 -#define INST_DICT_LAPPEND 115 -#define INST_DICT_FIRST 116 -#define INST_DICT_NEXT 117 -#define INST_DICT_DONE 118 -#define INST_DICT_UPDATE_START 119 -#define INST_DICT_UPDATE_END 120 - -/* - * Instruction to support jumps defined by tables (instead of the classic - * [switch] technique of chained comparisons). - */ - -#define INST_JUMP_TABLE 121 - -/* - * Instructions to support compilation of global, variable, upvar and - * [namespace upvar]. - */ - -#define INST_UPVAR 122 -#define INST_NSUPVAR 123 -#define INST_VARIABLE 124 - -/* Instruction to support compiling syntax error to bytecode */ - -#define INST_SYNTAX 125 - -/* Instruction to reverse N items on top of stack */ - -#define INST_REVERSE 126 - -/* regexp instruction */ - -#define INST_REGEXP 127 - -/* For [info exists] compilation */ -#define INST_EXIST_SCALAR 128 -#define INST_EXIST_ARRAY 129 -#define INST_EXIST_ARRAY_STK 130 -#define INST_EXIST_STK 131 - -/* For [subst] compilation */ -#define INST_NOP 132 -#define INST_RETURN_CODE_BRANCH 133 - -/* For [unset] compilation */ -#define INST_UNSET_SCALAR 134 -#define INST_UNSET_ARRAY 135 -#define INST_UNSET_ARRAY_STK 136 -#define INST_UNSET_STK 137 - -/* For [dict with], [dict exists], [dict create] and [dict merge] */ -#define INST_DICT_EXPAND 138 -#define INST_DICT_RECOMBINE_STK 139 -#define INST_DICT_RECOMBINE_IMM 140 -#define INST_DICT_EXISTS 141 -#define INST_DICT_VERIFY 142 - -/* For [string map] and [regsub] compilation */ -#define INST_STR_MAP 143 -#define INST_STR_FIND 144 -#define INST_STR_FIND_LAST 145 -#define INST_STR_RANGE_IMM 146 -#define INST_STR_RANGE 147 - -/* For operations to do with coroutines and other NRE-manipulators */ -#define INST_YIELD 148 -#define INST_COROUTINE_NAME 149 -#define INST_TAILCALL 150 - -/* For compilation of basic information operations */ -#define INST_NS_CURRENT 151 -#define INST_INFO_LEVEL_NUM 152 -#define INST_INFO_LEVEL_ARGS 153 -#define INST_RESOLVE_COMMAND 154 - -/* For compilation relating to TclOO */ -#define INST_TCLOO_SELF 155 -#define INST_TCLOO_CLASS 156 -#define INST_TCLOO_NS 157 -#define INST_TCLOO_IS_OBJECT 158 - -/* For compilation of [array] subcommands */ -#define INST_ARRAY_EXISTS_STK 159 -#define INST_ARRAY_EXISTS_IMM 160 -#define INST_ARRAY_MAKE_STK 161 -#define INST_ARRAY_MAKE_IMM 162 - -#define INST_INVOKE_REPLACE 163 - -#define INST_LIST_CONCAT 164 - -#define INST_EXPAND_DROP 165 - -/* New foreach implementation */ -#define INST_FOREACH_START 166 -#define INST_FOREACH_STEP 167 -#define INST_FOREACH_END 168 -#define INST_LMAP_COLLECT 169 - -/* For compilation of [string trim] and related */ -#define INST_STR_TRIM 170 -#define INST_STR_TRIM_LEFT 171 -#define INST_STR_TRIM_RIGHT 172 - -#define INST_CONCAT_STK 173 - -#define INST_STR_UPPER 174 -#define INST_STR_LOWER 175 -#define INST_STR_TITLE 176 -#define INST_STR_REPLACE 177 - -#define INST_ORIGIN_COMMAND 178 - -#define INST_TCLOO_NEXT 179 -#define INST_TCLOO_NEXT_CLASS 180 - -#define INST_YIELD_TO_INVOKE 181 - -#define INST_NUM_TYPE 182 -#define INST_TRY_CVT_TO_BOOLEAN 183 -#define INST_STR_CLASS 184 - -#define INST_LAPPEND_LIST 185 -#define INST_LAPPEND_LIST_ARRAY 186 -#define INST_LAPPEND_LIST_ARRAY_STK 187 -#define INST_LAPPEND_LIST_STK 188 +enum TclInstruction { + + /* Opcodes 0 to 9 */ + INST_DONE = 0, + INST_PUSH1, + INST_PUSH4, + INST_POP, + INST_DUP, + INST_STR_CONCAT1, + INST_INVOKE_STK1, + INST_INVOKE_STK4, + INST_EVAL_STK, + INST_EXPR_STK, + + /* Opcodes 10 to 23 */ + INST_LOAD_SCALAR1, + INST_LOAD_SCALAR4, + INST_LOAD_SCALAR_STK, + INST_LOAD_ARRAY1, + INST_LOAD_ARRAY4, + INST_LOAD_ARRAY_STK, + INST_LOAD_STK, + INST_STORE_SCALAR1, + INST_STORE_SCALAR4, + INST_STORE_SCALAR_STK, + INST_STORE_ARRAY1, + INST_STORE_ARRAY4, + INST_STORE_ARRAY_STK, + INST_STORE_STK, + + /* Opcodes 24 to 33 */ + INST_INCR_SCALAR1, + INST_INCR_SCALAR_STK, + INST_INCR_ARRAY1, + INST_INCR_ARRAY_STK, + INST_INCR_STK, + INST_INCR_SCALAR1_IMM, + INST_INCR_SCALAR_STK_IMM, + INST_INCR_ARRAY1_IMM, + INST_INCR_ARRAY_STK_IMM, + INST_INCR_STK_IMM, + + /* Opcodes 34 to 39 */ + INST_JUMP1, + INST_JUMP4, + INST_JUMP_TRUE1, + INST_JUMP_TRUE4, + INST_JUMP_FALSE1, + INST_JUMP_FALSE4, + + /* Opcodes 42 to 64 */ + INST_BITOR, + INST_BITXOR, + INST_BITAND, + INST_EQ, + INST_NEQ, + INST_LT, + INST_GT, + INST_LE, + INST_GE, + INST_LSHIFT, + INST_RSHIFT, + INST_ADD, + INST_SUB, + INST_MULT, + INST_DIV, + INST_MOD, + INST_UPLUS, + INST_UMINUS, + INST_BITNOT, + INST_LNOT, + INST_TRY_CVT_TO_NUMERIC, + + /* Opcodes 65 to 66 */ + INST_BREAK, + INST_CONTINUE, + + /* Opcodes 69 to 72 */ + INST_BEGIN_CATCH4, + INST_END_CATCH, + INST_PUSH_RESULT, + INST_PUSH_RETURN_CODE, + + /* Opcodes 73 to 78 */ + INST_STR_EQ, + INST_STR_NEQ, + INST_STR_CMP, + INST_STR_LEN, + INST_STR_INDEX, + INST_STR_MATCH, + + /* Opcodes 79 to 81 */ + INST_LIST, + INST_LIST_INDEX, + INST_LIST_LENGTH, + + /* Opcodes 82 to 87 */ + INST_APPEND_SCALAR1, + INST_APPEND_SCALAR4, + INST_APPEND_ARRAY1, + INST_APPEND_ARRAY4, + INST_APPEND_ARRAY_STK, + INST_APPEND_STK, + + /* Opcodes 88 to 93 */ + INST_LAPPEND_SCALAR1, + INST_LAPPEND_SCALAR4, + INST_LAPPEND_ARRAY1, + INST_LAPPEND_ARRAY4, + INST_LAPPEND_ARRAY_STK, + INST_LAPPEND_STK, + + /* TIP #22 - LINDEX operator with flat arg list */ + INST_LIST_INDEX_MULTI, + + /* + * TIP #33 - 'lset' command. Code gen also required a Forth-like + * OVER operation. + */ + INST_OVER, + INST_LSET_LIST, + INST_LSET_FLAT, + + /* TIP#90 - 'return' command. */ + INST_RETURN_IMM, + + /* TIP#123 - exponentiation operator. */ + INST_EXPON, + + /* TIP #157 - {*}... (word expansion) language syntax support. */ + INST_EXPAND_START, + INST_EXPAND_STKTOP, + INST_INVOKE_EXPANDED, + + /* + * TIP #57 - 'lassign' command. Code generation requires immediate + * LINDEX and LRANGE operators. + */ + INST_LIST_INDEX_IMM, + INST_LIST_RANGE_IMM, + INST_START_CMD, + INST_LIST_IN, + INST_LIST_NOT_IN, + INST_PUSH_RETURN_OPTIONS, + INST_RETURN_STK, + + /* + * Dictionary (TIP#111) related commands. + */ + INST_DICT_GET, + INST_DICT_SET, + INST_DICT_UNSET, + INST_DICT_INCR_IMM, + INST_DICT_APPEND, + INST_DICT_LAPPEND, + INST_DICT_FIRST, + INST_DICT_NEXT, + INST_DICT_UPDATE_START, + INST_DICT_UPDATE_END, + + /* + * Instruction to support jumps defined by tables (instead of the classic + * [switch] technique of chained comparisons). + */ + INST_JUMP_TABLE, + + /* + * Instructions to support compilation of global, variable, upvar and + * [namespace upvar]. + */ + INST_UPVAR, + INST_NSUPVAR, + INST_VARIABLE, + + /* Instruction to support compiling syntax error to bytecode */ + INST_SYNTAX, + + /* Instruction to reverse N items on top of stack */ + INST_REVERSE, + + /* regexp instruction */ + INST_REGEXP, + + /* For [info exists] compilation */ + INST_EXIST_SCALAR, + INST_EXIST_ARRAY, + INST_EXIST_ARRAY_STK, + INST_EXIST_STK, + + /* For [subst] compilation */ + INST_NOP, + INST_RETURN_CODE_BRANCH, + + /* For [unset] compilation */ + INST_UNSET_SCALAR, + INST_UNSET_ARRAY, + INST_UNSET_ARRAY_STK, + INST_UNSET_STK, + + /* For [dict with], [dict exists], [dict create] and [dict merge] */ + INST_DICT_EXPAND, + INST_DICT_RECOMBINE_STK, + INST_DICT_RECOMBINE_IMM, + INST_DICT_EXISTS, + INST_DICT_VERIFY, + + /* For [string map] and [regsub] compilation */ + INST_STR_MAP, + INST_STR_FIND, + INST_STR_FIND_LAST, + INST_STR_RANGE_IMM, + INST_STR_RANGE, + + /* For operations to do with coroutines and other NRE-manipulators */ + INST_YIELD, + INST_COROUTINE_NAME, + INST_TAILCALL, + + /* For compilation of basic information operations */ + INST_NS_CURRENT, + INST_INFO_LEVEL_NUM, + INST_INFO_LEVEL_ARGS, + INST_RESOLVE_COMMAND, + + /* For compilation relating to TclOO */ + INST_TCLOO_SELF, + INST_TCLOO_CLASS, + INST_TCLOO_NS, + INST_TCLOO_IS_OBJECT, + + /* For compilation of [array] subcommands */ + INST_ARRAY_EXISTS_STK, + INST_ARRAY_EXISTS_IMM, + INST_ARRAY_MAKE_STK, + INST_ARRAY_MAKE_IMM, + + INST_INVOKE_REPLACE, + + INST_LIST_CONCAT, + + INST_EXPAND_DROP, + + /* New foreach implementation */ + INST_FOREACH_START, + INST_FOREACH_STEP, + INST_FOREACH_END, + INST_LMAP_COLLECT, + + /* For compilation of [string trim] and related */ + INST_STR_TRIM, + INST_STR_TRIM_LEFT, + INST_STR_TRIM_RIGHT, + + INST_CONCAT_STK, + + INST_STR_UPPER, + INST_STR_LOWER, + INST_STR_TITLE, + INST_STR_REPLACE, + + INST_ORIGIN_COMMAND, + + INST_TCLOO_NEXT, + INST_TCLOO_NEXT_CLASS, + + INST_YIELD_TO_INVOKE, + + INST_NUM_TYPE, + INST_TRY_CVT_TO_BOOLEAN, + INST_STR_CLASS, + + INST_LAPPEND_LIST, + INST_LAPPEND_LIST_ARRAY, + INST_LAPPEND_LIST_ARRAY_STK, + INST_LAPPEND_LIST_STK, -#define INST_CLOCK_READ 189 + INST_CLOCK_READ, + + /* The last opcode */ + LAST_INST_OPCODE +}; -/* The last opcode */ -#define LAST_INST_OPCODE 189 /* * Table describing the Tcl bytecode instructions: their name (for displaying @@ -879,7 +859,7 @@ typedef enum InstOperandType { typedef struct InstructionDesc { const char *name; /* Name of instruction. */ - int numBytes; /* Total number of bytes for instruction. */ + size_t numBytes; /* Total number of bytes for instruction. */ int stackEffect; /* The worst-case balance stack effect of the * instruction, used for stack requirements * computations. The value INT_MIN signals @@ -1037,7 +1017,7 @@ MODULE_SCOPE const AuxDataType tclJumptableInfoType; */ typedef struct { - int length; /* Size of array */ + size_t length; /* Size of array */ int varIndices[1]; /* Array of variable indices to manage when * processing the start and end of a [dict * update]. There is really more than one @@ -1092,7 +1072,7 @@ MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script, - int numBytes, CompileEnv *envPtr, int optimize); + size_t numBytes, CompileEnv *envPtr, int optimize); MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr); @@ -1100,7 +1080,7 @@ MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, CompileEnv *envPtr); MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp, - const char *script, int numBytes, + const char *script, size_t numBytes, CompileEnv *envPtr); MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp, CompileEnv *envPtr); @@ -1109,13 +1089,13 @@ MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp, CompileEnv *envPtr); MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr); -MODULE_SCOPE int TclCreateAuxData(ClientData clientData, +MODULE_SCOPE int TclCreateAuxData(void *clientData, const AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); -MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); +MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, size_t size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, - int length, unsigned int hash, int *newPtr, + size_t length, size_t hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); @@ -1129,8 +1109,8 @@ MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp, ByteCode *codePtr); -MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index); -MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars, +MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, size_t index); +MODULE_SCOPE int TclFindCompiledLocal(const char *name, size_t nameChars, int create, CompileEnv *envPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, JumpFixup *jumpFixupPtr, int jumpDist, @@ -1144,7 +1124,7 @@ MODULE_SCOPE ByteCode * TclInitByteCodeObj(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, CompileEnv *envPtr); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr, const char *string, - int numBytes, const CmdFrame *invoker, int word); + size_t numBytes, const CmdFrame *invoker, int word); MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr); MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr, @@ -1159,7 +1139,7 @@ MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr, MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); #endif -MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes, +MODULE_SCOPE int TclLocalScalar(const char *bytes, size_t numBytes, CompileEnv *envPtr); MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr, CompileEnv *envPtr); @@ -1171,9 +1151,9 @@ MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp, MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr, const unsigned char *pc); MODULE_SCOPE void TclPrintObject(FILE *outFile, - Tcl_Obj *objPtr, int maxChars); + Tcl_Obj *objPtr, size_t maxChars); MODULE_SCOPE void TclPrintSource(FILE *outFile, - const char *string, int maxChars); + const char *string, size_t maxChars); MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, @@ -1183,16 +1163,16 @@ MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr); MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); -MODULE_SCOPE int TclSingleOpCmd(ClientData clientData, +MODULE_SCOPE int TclSingleOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclSortingOpCmd(ClientData clientData, +MODULE_SCOPE int TclSortingOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData, +MODULE_SCOPE int TclVariadicOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData, +MODULE_SCOPE int TclNoIdentOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #ifdef TCL_COMPILE_DEBUG @@ -1203,12 +1183,12 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, Tcl_Obj *valuePtr); MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, - int length, const unsigned char *pc, + size_t length, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); -MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, +MODULE_SCOPE int TclPushProcCallFrame(void *clientData, register Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int isLambda); @@ -1223,7 +1203,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, /* * Simplified form to access AuxData. * - * ClientData TclFetchAuxData(CompileEng *envPtr, int index); + * void *TclFetchAuxData(CompileEng *envPtr, int index); */ #define TclFetchAuxData(envPtr, index) \ @@ -1542,7 +1522,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, * these macros are: * * static void PushLiteral(CompileEnv *envPtr, - * const char *string, int length); + * const char *string, size_t length); * static void PushStringLiteral(CompileEnv *envPtr, * const char *string); */ @@ -1550,7 +1530,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, #define PushLiteral(envPtr, string, length) \ TclEmitPush(TclRegisterLiteral(envPtr, string, length, 0), (envPtr)) #define PushStringLiteral(envPtr, string) \ - PushLiteral(envPtr, string, (int) (sizeof(string "") - 1)) + PushLiteral(envPtr, string, sizeof(string "") - 1) /* * Macro to advance to the next token; it is more mnemonic than the address @@ -1566,7 +1546,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, * Macro to get the offset to the next instruction to be issued. The ANSI C * "prototype" for this macro is: * - * static int CurrentOffset(CompileEnv *envPtr); + * static ptrdiff_t CurrentOffset(CompileEnv *envPtr); */ #define CurrentOffset(envPtr) \ @@ -1818,8 +1798,8 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi); FILE *tclDTraceDebugLog = NULL; \ void TclDTraceOpenDebugLog(void) { \ char n[35]; \ - sprintf(n, "/tmp/tclDTraceDebug-%lu.log", \ - (unsigned long) getpid()); \ + sprintf(n, "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \ + (size_t) getpid()); \ tclDTraceDebugLog = fopen(n, "a"); \ } diff --git a/generic/tclConfig.c b/generic/tclConfig.c index eb6807c..3d017ed 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -31,7 +31,7 @@ * the (Tcl_Interp *) in which it is stored, and the encoding. */ -typedef struct QCCD { +typedef struct { Tcl_Obj *pkg; Tcl_Interp *interp; char *encoding; @@ -79,11 +79,11 @@ Tcl_RegisterConfig( Tcl_Obj *pDB, *pkgDict; Tcl_DString cmdName; const Tcl_Config *cfg; - QCCD *cdPtr = ckalloc(sizeof(QCCD)); + QCCD *cdPtr = Tcl_Alloc(sizeof(QCCD)); cdPtr->interp = interp; if (valEncoding) { - cdPtr->encoding = ckalloc(strlen(valEncoding)+1); + cdPtr->encoding = Tcl_Alloc(strlen(valEncoding)+1); strcpy(cdPtr->encoding, valEncoding); } else { cdPtr->encoding = NULL; @@ -261,7 +261,7 @@ QueryConfigObjCmd( * Value is stored as-is in a byte array, see Bug [9b2e636361], * so we have to decode it first. */ - value = (const char *) Tcl_GetByteArrayFromObj(val, &n); + value = (const char *) TclGetByteArrayFromObj(val, &n); value = Tcl_ExternalToUtfDString(venc, value, n, &conv); Tcl_SetObjResult(interp, Tcl_NewStringObj(value, Tcl_DStringLength(&conv))); @@ -333,9 +333,9 @@ QueryConfigDelete( Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); if (cdPtr->encoding) { - ckfree(cdPtr->encoding); + Tcl_Free(cdPtr->encoding); } - ckfree(cdPtr); + Tcl_Free(cdPtr); } /* diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d index 360bdff..711c3d6 100644 --- a/generic/tclDTrace.d +++ b/generic/tclDTrace.d @@ -182,9 +182,9 @@ typedef struct Tcl_ObjType { } Tcl_ObjType; struct Tcl_Obj { - int refCount; + size_t refCount; char *bytes; - int length; + size_t length; Tcl_ObjType *typePtr; union { long longValue; diff --git a/generic/tclDate.c b/generic/tclDate.c index 32c71de..6bc88d9 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -138,8 +138,8 @@ typedef struct DateInfo { int dateDigitCount; } DateInfo; -#define YYMALLOC ckalloc -#define YYFREE(x) (ckfree((void*) (x))) +#define YYMALLOC Tcl_Alloc +#define YYFREE(x) (Tcl_Free((void*) (x))) #define yyDSTmode (info->dateDSTmode) #define yyDayOrdinal (info->dateDayOrdinal) @@ -2848,16 +2848,16 @@ TclClockOldscanObjCmd( resultElement = Tcl_NewObj(); if (yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyYear)); + Tcl_NewIntObj(yyYear)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj(yyMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDay)); + Tcl_NewIntObj(yyDay)); } Tcl_ListObjAppendElement(interp, result, resultElement); if (yyHaveTime) { - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj( ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian))); } else { Tcl_ListObjAppendElement(interp, result, Tcl_NewObj()); @@ -2866,7 +2866,7 @@ TclClockOldscanObjCmd( resultElement = Tcl_NewObj(); if (yyHaveZone) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) -yyTimezone)); + Tcl_NewIntObj(-yyTimezone)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj(1 - yyDSTmode)); } @@ -2875,29 +2875,29 @@ TclClockOldscanObjCmd( resultElement = Tcl_NewObj(); if (yyHaveRel) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelMonth)); + Tcl_NewIntObj(yyRelMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelDay)); + Tcl_NewIntObj(yyRelDay)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelSeconds)); + Tcl_NewIntObj(yyRelSeconds)); } Tcl_ListObjAppendElement(interp, result, resultElement); resultElement = Tcl_NewObj(); if (yyHaveDay && !yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDayOrdinal)); + Tcl_NewIntObj(yyDayOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDayNumber)); + Tcl_NewIntObj(yyDayNumber)); } Tcl_ListObjAppendElement(interp, result, resultElement); resultElement = Tcl_NewObj(); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonthOrdinal)); + Tcl_NewIntObj(yyMonthOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj(yyMonth)); } Tcl_ListObjAppendElement(interp, result, resultElement); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index d323b73..57e467b 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -59,28 +59,28 @@ EXTERN const char * Tcl_PkgRequireEx(Tcl_Interp *interp, /* 2 */ EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 3 */ -EXTERN char * Tcl_Alloc(unsigned int size); +EXTERN void * Tcl_Alloc(size_t size); /* 4 */ -EXTERN void Tcl_Free(char *ptr); +EXTERN void Tcl_Free(void *ptr); /* 5 */ -EXTERN char * Tcl_Realloc(char *ptr, unsigned int size); +EXTERN void * Tcl_Realloc(void *ptr, size_t size); /* 6 */ -EXTERN char * Tcl_DbCkalloc(unsigned int size, const char *file, +EXTERN void * Tcl_DbCkalloc(size_t size, const char *file, int line); /* 7 */ -EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line); +EXTERN void Tcl_DbCkfree(void *ptr, const char *file, int line); /* 8 */ -EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size, +EXTERN void * Tcl_DbCkrealloc(void *ptr, size_t size, const char *file, int line); #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, ClientData clientData); + Tcl_FileProc *proc, void *clientData); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, ClientData clientData); + Tcl_FileProc *proc, void *clientData); #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 10 */ @@ -103,7 +103,7 @@ EXTERN int Tcl_AppendAllObjTypes(Tcl_Interp *interp, EXTERN void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...); /* 16 */ EXTERN void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, - int length); + size_t length); /* 17 */ EXTERN Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]); /* 18 */ @@ -118,32 +118,25 @@ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, /* 21 */ EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line); -/* 22 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file, - int line); +/* Slot 22 is reserved */ /* 23 */ EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, - int length, const char *file, int line); + size_t length, const char *file, int line); /* 24 */ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, const char *file, int line); /* 25 */ EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv, const char *file, int line); -/* 26 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file, - int line); +/* Slot 26 is reserved */ /* 27 */ EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line); /* 28 */ -EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length, +EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, size_t length, const char *file, int line); /* 29 */ EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); -/* 30 */ -EXTERN void TclOldFreeObj(Tcl_Obj *objPtr); +/* Slot 30 is reserved */ /* 31 */ EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr); @@ -159,11 +152,7 @@ EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, /* 35 */ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); -/* 36 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_GetIndexFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, const char *const *tablePtr, - const char *msg, int flags, int *indexPtr); +/* Slot 36 is reserved */ /* 37 */ EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr); @@ -174,7 +163,7 @@ EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp, EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 40 */ -EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName); +EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 42 */ @@ -200,58 +189,41 @@ EXTERN int Tcl_ListObjLength(Tcl_Interp *interp, EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); -/* 49 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_NewBooleanObj(int boolValue); +/* Slot 49 is reserved */ /* 50 */ EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, - int length); + size_t length); /* 51 */ EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue); -/* 52 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_NewIntObj(int intValue); +/* Slot 52 is reserved */ /* 53 */ EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]); -/* 54 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_NewLongObj(long longValue); +/* Slot 54 is reserved */ /* 55 */ EXTERN Tcl_Obj * Tcl_NewObj(void); /* 56 */ -EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length); -/* 57 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue); +EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, size_t length); +/* Slot 57 is reserved */ /* 58 */ -EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length); +EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, + size_t length); /* 59 */ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, - const unsigned char *bytes, int length); + const unsigned char *bytes, size_t length); /* 60 */ EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue); -/* 61 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue); +/* Slot 61 is reserved */ /* 62 */ EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); -/* 63 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue); +/* Slot 63 is reserved */ /* 64 */ -EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, int length); +EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length); /* 65 */ EXTERN void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, - int length); -/* 66 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_AddErrorInfo(Tcl_Interp *interp, - const char *message); -/* 67 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_AddObjErrorInfo(Tcl_Interp *interp, - const char *message, int length); + size_t length); +/* Slot 66 is reserved */ +/* Slot 67 is reserved */ /* 68 */ EXTERN void Tcl_AllowExceptions(Tcl_Interp *interp); /* 69 */ @@ -261,7 +233,7 @@ EXTERN void Tcl_AppendElement(Tcl_Interp *interp, EXTERN void Tcl_AppendResult(Tcl_Interp *interp, ...); /* 71 */ EXTERN Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, - ClientData clientData); + void *clientData); /* 72 */ EXTERN void Tcl_AsyncDelete(Tcl_AsyncHandler async); /* 73 */ @@ -272,20 +244,17 @@ EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async); EXTERN int Tcl_AsyncReady(void); /* 76 */ EXTERN void Tcl_BackgroundError(Tcl_Interp *interp); -/* 77 */ -TCL_DEPRECATED("Use Tcl_UtfBackslash") -char Tcl_Backslash(const char *src, int *readPtr); +/* Slot 77 is reserved */ /* 78 */ EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList); /* 79 */ EXTERN void Tcl_CallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, - ClientData clientData); + Tcl_InterpDeleteProc *proc, void *clientData); /* 80 */ EXTERN void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, - ClientData clientData); + void *clientData); /* 81 */ EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); /* 82 */ @@ -293,11 +262,11 @@ EXTERN int Tcl_CommandComplete(const char *cmd); /* 83 */ EXTERN char * Tcl_Concat(int argc, const char *const *argv); /* 84 */ -EXTERN int Tcl_ConvertElement(const char *src, char *dst, +EXTERN size_t Tcl_ConvertElement(const char *src, char *dst, int flags); /* 85 */ -EXTERN int Tcl_ConvertCountedElement(const char *src, - int length, char *dst, int flags); +EXTERN size_t Tcl_ConvertCountedElement(const char *src, + size_t length, char *dst, int flags); /* 86 */ EXTERN int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, @@ -310,58 +279,52 @@ EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave, Tcl_Obj *const objv[]); /* 88 */ EXTERN Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, - const char *chanName, - ClientData instanceData, int mask); + const char *chanName, void *instanceData, + int mask); /* 89 */ EXTERN void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, - Tcl_ChannelProc *proc, ClientData clientData); + Tcl_ChannelProc *proc, void *clientData); /* 90 */ EXTERN void Tcl_CreateCloseHandler(Tcl_Channel chan, - Tcl_CloseProc *proc, ClientData clientData); + Tcl_CloseProc *proc, void *clientData); /* 91 */ EXTERN Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, - ClientData clientData, + void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 92 */ EXTERN void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, - ClientData clientData); + void *clientData); /* 93 */ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); /* 94 */ EXTERN Tcl_Interp * Tcl_CreateInterp(void); -/* 95 */ -TCL_DEPRECATED("") -void Tcl_CreateMathFunc(Tcl_Interp *interp, - const char *name, int numArgs, - Tcl_ValueType *argTypes, Tcl_MathProc *proc, - ClientData clientData); +/* Slot 95 is reserved */ /* 96 */ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - ClientData clientData, + void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 97 */ EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName, int isSafe); /* 98 */ EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, - Tcl_TimerProc *proc, ClientData clientData); + Tcl_TimerProc *proc, void *clientData); /* 99 */ EXTERN Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, - Tcl_CmdTraceProc *proc, - ClientData clientData); + Tcl_CmdTraceProc *proc, void *clientData); /* 100 */ EXTERN void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name); /* 101 */ EXTERN void Tcl_DeleteChannelHandler(Tcl_Channel chan, - Tcl_ChannelProc *proc, ClientData clientData); + Tcl_ChannelProc *proc, void *clientData); /* 102 */ EXTERN void Tcl_DeleteCloseHandler(Tcl_Channel chan, - Tcl_CloseProc *proc, ClientData clientData); + Tcl_CloseProc *proc, void *clientData); /* 103 */ EXTERN int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName); @@ -370,14 +333,14 @@ EXTERN int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command); /* 105 */ EXTERN void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, - ClientData clientData); + void *clientData); /* 106 */ EXTERN void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, - ClientData clientData); + void *clientData); /* 107 */ EXTERN void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); /* 108 */ EXTERN void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr); /* 109 */ @@ -392,16 +355,14 @@ EXTERN void Tcl_DeleteTimerHandler(Tcl_TimerToken token); EXTERN void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace); /* 114 */ EXTERN void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, - ClientData clientData); + Tcl_InterpDeleteProc *proc, void *clientData); /* 115 */ EXTERN int Tcl_DoOneEvent(int flags); /* 116 */ -EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, - ClientData clientData); +EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData); /* 117 */ EXTERN char * Tcl_DStringAppend(Tcl_DString *dsPtr, - const char *bytes, int length); + const char *bytes, size_t length); /* 118 */ EXTERN char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element); @@ -418,7 +379,8 @@ EXTERN void Tcl_DStringInit(Tcl_DString *dsPtr); EXTERN void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr); /* 124 */ -EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length); +EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, + size_t length); /* 125 */ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr); /* 126 */ @@ -427,16 +389,13 @@ EXTERN int Tcl_Eof(Tcl_Channel chan); EXTERN const char * Tcl_ErrnoId(void); /* 128 */ EXTERN const char * Tcl_ErrnoMsg(int err); -/* 129 */ -EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); +/* Slot 129 is reserved */ /* 130 */ EXTERN int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName); -/* 131 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); +/* Slot 131 is reserved */ /* 132 */ -EXTERN void Tcl_EventuallyFree(ClientData clientData, +EXTERN void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc); /* 133 */ EXTERN TCL_NORETURN void Tcl_Exit(int status); @@ -469,8 +428,7 @@ EXTERN int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr); /* 143 */ EXTERN void Tcl_Finalize(void); -/* 144 */ -EXTERN void Tcl_FindExecutable(const char *argv0); +/* Slot 144 is reserved */ /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); @@ -491,7 +449,7 @@ EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 150 */ -EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp, +EXTERN void * Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 151 */ @@ -501,9 +459,9 @@ EXTERN Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, EXTERN int Tcl_GetChannelBufferSize(Tcl_Channel chan); /* 153 */ EXTERN int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, - ClientData *handlePtr); + void **handlePtr); /* 154 */ -EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); +EXTERN void * Tcl_GetChannelInstanceData(Tcl_Channel chan); /* 155 */ EXTERN int Tcl_GetChannelMode(Tcl_Channel chan); /* 156 */ @@ -513,7 +471,7 @@ EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 158 */ -EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); +EXTERN const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); /* 159 */ EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); @@ -537,20 +495,20 @@ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, ClientData *filePtr); + int checkUsage, void **filePtr); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, ClientData *filePtr); + int checkUsage, void **filePtr); #endif /* MACOSX */ /* 168 */ EXTERN Tcl_PathType Tcl_GetPathType(const char *path); /* 169 */ -EXTERN int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); +EXTERN size_t Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); /* 170 */ -EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); +EXTERN size_t Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 171 */ EXTERN int Tcl_GetServiceMode(void); /* 172 */ @@ -560,20 +518,12 @@ EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, EXTERN Tcl_Channel Tcl_GetStdChannel(int type); /* 174 */ EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp); -/* 175 */ -TCL_DEPRECATED("No longer in use, changed to macro") -const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, - int flags); +/* Slot 175 is reserved */ /* 176 */ EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); -/* 177 */ -EXTERN int Tcl_GlobalEval(Tcl_Interp *interp, - const char *command); -/* 178 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_GlobalEvalObj(Tcl_Interp *interp, - Tcl_Obj *objPtr); +/* Slot 177 is reserved */ +/* Slot 178 is reserved */ /* 179 */ EXTERN int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, @@ -599,11 +549,11 @@ EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr, int type); /* Slot 188 is reserved */ /* 189 */ -EXTERN Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode); +EXTERN Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode); /* 190 */ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp); /* 191 */ -EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); +EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket); /* 192 */ EXTERN char * Tcl_Merge(int argc, const char *const *argv); /* 193 */ @@ -632,9 +582,9 @@ EXTERN Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, EXTERN Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData); + void *callbackData); /* 201 */ -EXTERN void Tcl_Preserve(ClientData data); +EXTERN void Tcl_Preserve(void *data); /* 202 */ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst); @@ -646,7 +596,8 @@ EXTERN const char * Tcl_PosixError(Tcl_Interp *interp); EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position); /* 206 */ -EXTERN int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead); +EXTERN size_t Tcl_Read(Tcl_Channel chan, char *bufPtr, + size_t toRead); /* 207 */ EXTERN void Tcl_ReapDetachedProcs(void); /* 208 */ @@ -670,20 +621,18 @@ EXTERN int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern); /* 215 */ -EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index, +EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, size_t index, const char **startPtr, const char **endPtr); /* 216 */ -EXTERN void Tcl_Release(ClientData clientData); +EXTERN void Tcl_Release(void *clientData); /* 217 */ EXTERN void Tcl_ResetResult(Tcl_Interp *interp); /* 218 */ -EXTERN int Tcl_ScanElement(const char *src, int *flagPtr); +EXTERN size_t Tcl_ScanElement(const char *src, int *flagPtr); /* 219 */ -EXTERN int Tcl_ScanCountedElement(const char *src, int length, - int *flagPtr); -/* 220 */ -TCL_DEPRECATED("") -int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode); +EXTERN size_t Tcl_ScanCountedElement(const char *src, + size_t length, int *flagPtr); +/* Slot 220 is reserved */ /* 221 */ EXTERN int Tcl_ServiceAll(void); /* 222 */ @@ -691,7 +640,7 @@ EXTERN int Tcl_ServiceEvent(int flags); /* 223 */ EXTERN void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, - ClientData clientData); + void *clientData); /* 224 */ EXTERN void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz); /* 225 */ @@ -708,14 +657,10 @@ EXTERN void Tcl_SetErrno(int err); EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); /* 229 */ EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); -/* 230 */ -EXTERN void Tcl_SetPanicProc( - TCL_NORETURN1 Tcl_PanicProc *panicProc); +/* Slot 230 is reserved */ /* 231 */ EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth); -/* 232 */ -EXTERN void Tcl_SetResult(Tcl_Interp *interp, char *result, - Tcl_FreeProc *freeProc); +/* Slot 232 is reserved */ /* 233 */ EXTERN int Tcl_SetServiceMode(int mode); /* 234 */ @@ -726,10 +671,7 @@ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 236 */ EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type); -/* 237 */ -TCL_DEPRECATED("No longer in use, changed to macro") -const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName, - const char *newValue, int flags); +/* Slot 237 is reserved */ /* 238 */ EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, @@ -747,83 +689,56 @@ EXTERN int Tcl_SplitList(Tcl_Interp *interp, /* 243 */ EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr); -/* 244 */ -EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, - const char *pkgName, - Tcl_PackageInitProc *initProc, - Tcl_PackageInitProc *safeInitProc); +/* Slot 244 is reserved */ /* 245 */ EXTERN int Tcl_StringMatch(const char *str, const char *pattern); -/* 246 */ -TCL_DEPRECATED("") -int Tcl_TellOld(Tcl_Channel chan); -/* 247 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, - int flags, Tcl_VarTraceProc *proc, - ClientData clientData); +/* Slot 246 is reserved */ +/* Slot 247 is reserved */ /* 248 */ EXTERN int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, - Tcl_VarTraceProc *proc, - ClientData clientData); + Tcl_VarTraceProc *proc, void *clientData); /* 249 */ EXTERN char * Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 250 */ -EXTERN int Tcl_Ungets(Tcl_Channel chan, const char *str, - int len, int atHead); +EXTERN size_t Tcl_Ungets(Tcl_Channel chan, const char *str, + size_t len, int atHead); /* 251 */ EXTERN void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName); /* 252 */ EXTERN int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan); -/* 253 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, - int flags); +/* Slot 253 is reserved */ /* 254 */ EXTERN int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); -/* 255 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_UntraceVar(Tcl_Interp *interp, - const char *varName, int flags, - Tcl_VarTraceProc *proc, - ClientData clientData); +/* Slot 255 is reserved */ /* 256 */ EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, - ClientData clientData); + void *clientData); /* 257 */ EXTERN void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName); -/* 258 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, - const char *varName, const char *localName, - int flags); +/* Slot 258 is reserved */ /* 259 */ EXTERN int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 260 */ EXTERN int Tcl_VarEval(Tcl_Interp *interp, ...); -/* 261 */ -TCL_DEPRECATED("No longer in use, changed to macro") -ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, - const char *varName, int flags, - Tcl_VarTraceProc *procPtr, - ClientData prevClientData); +/* Slot 261 is reserved */ /* 262 */ -EXTERN ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, +EXTERN void * Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, - ClientData prevClientData); + void *prevClientData); /* 263 */ -EXTERN int Tcl_Write(Tcl_Channel chan, const char *s, int slen); +EXTERN size_t Tcl_Write(Tcl_Channel chan, const char *s, + size_t slen); /* 264 */ EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); @@ -831,47 +746,25 @@ EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, EXTERN int Tcl_DumpActiveMemory(const char *fileName); /* 266 */ EXTERN void Tcl_ValidateAllMemory(const char *file, int line); -/* 267 */ -TCL_DEPRECATED("see TIP #422") -void Tcl_AppendResultVA(Tcl_Interp *interp, - va_list argList); -/* 268 */ -TCL_DEPRECATED("see TIP #422") -void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, - va_list argList); +/* Slot 267 is reserved */ +/* Slot 268 is reserved */ /* 269 */ EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr); /* 270 */ EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr); -/* 271 */ -TCL_DEPRECATED("No longer in use, changed to macro") -const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name, - const char *version, int exact); +/* Slot 271 is reserved */ /* 272 */ EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); -/* 273 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, - const char *version); -/* 274 */ -TCL_DEPRECATED("No longer in use, changed to macro") -const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, - const char *version, int exact); -/* 275 */ -TCL_DEPRECATED("see TIP #422") -void Tcl_SetErrorCodeVA(Tcl_Interp *interp, - va_list argList); -/* 276 */ -TCL_DEPRECATED("see TIP #422") -int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList); +/* Slot 273 is reserved */ +/* Slot 274 is reserved */ +/* Slot 275 is reserved */ +/* Slot 276 is reserved */ /* 277 */ EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options); -/* 278 */ -TCL_DEPRECATED("see TIP #422") -TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList); +/* Slot 278 is reserved */ /* 279 */ EXTERN void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type); @@ -880,7 +773,7 @@ EXTERN void Tcl_InitMemory(Tcl_Interp *interp); /* 281 */ EXTERN Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, const Tcl_ChannelType *typePtr, - ClientData instanceData, int mask, + void *instanceData, int mask, Tcl_Channel prevChan); /* 282 */ EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp, @@ -897,15 +790,14 @@ EXTERN void Tcl_AppendObjToObj(Tcl_Obj *objPtr, EXTERN Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr); /* 288 */ EXTERN void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); /* 289 */ EXTERN void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, - ClientData clientData); -/* 290 */ -EXTERN void Tcl_DiscardResult(Tcl_SavedResult *statePtr); + void *clientData); +/* Slot 290 is reserved */ /* 291 */ EXTERN int Tcl_EvalEx(Tcl_Interp *interp, const char *script, - int numBytes, int flags); + size_t numBytes, int flags); /* 292 */ EXTERN int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); @@ -917,18 +809,18 @@ EXTERN TCL_NORETURN void Tcl_ExitThread(int status); /* 295 */ EXTERN int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, - int srcLen, int flags, + size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, - int dstLen, int *srcReadPtr, + size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 296 */ EXTERN char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, - const char *src, int srcLen, + const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 297 */ EXTERN void Tcl_FinalizeThread(void); /* 298 */ -EXTERN void Tcl_FinalizeNotifier(ClientData clientData); +EXTERN void Tcl_FinalizeNotifier(void *clientData); /* 299 */ EXTERN void Tcl_FreeEncoding(Tcl_Encoding encoding); /* 300 */ @@ -942,16 +834,16 @@ EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, - int offset, const char *msg, int flags, + size_t offset, const char *msg, int flags, int *indexPtr); /* 305 */ EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, - int size); + size_t size); /* 306 */ EXTERN Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 307 */ -EXTERN ClientData Tcl_InitNotifier(void); +EXTERN void * Tcl_InitNotifier(void); /* 308 */ EXTERN void Tcl_MutexLock(Tcl_Mutex *mutexPtr); /* 309 */ @@ -962,16 +854,12 @@ EXTERN void Tcl_ConditionNotify(Tcl_Condition *condPtr); EXTERN void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 312 */ -EXTERN int Tcl_NumUtfChars(const char *src, int length); +EXTERN size_t Tcl_NumUtfChars(const char *src, size_t length); /* 313 */ -EXTERN int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, - int charsToRead, int appendFlag); -/* 314 */ -EXTERN void Tcl_RestoreResult(Tcl_Interp *interp, - Tcl_SavedResult *statePtr); -/* 315 */ -EXTERN void Tcl_SaveResult(Tcl_Interp *interp, - Tcl_SavedResult *statePtr); +EXTERN size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, + size_t charsToRead, int appendFlag); +/* Slot 314 is reserved */ +/* Slot 315 is reserved */ /* 316 */ EXTERN int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name); @@ -985,7 +873,7 @@ EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId); EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 320 */ -EXTERN int Tcl_UniCharAtIndex(const char *src, int index); +EXTERN int Tcl_UniCharAtIndex(const char *src, size_t index); /* 321 */ EXTERN int Tcl_UniCharToLower(int ch); /* 322 */ @@ -995,11 +883,11 @@ EXTERN int Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ -EXTERN const char * Tcl_UtfAtIndex(const char *src, int index); +EXTERN const char * Tcl_UtfAtIndex(const char *src, size_t index); /* 326 */ -EXTERN int Tcl_UtfCharComplete(const char *src, int length); +EXTERN int Tcl_UtfCharComplete(const char *src, size_t length); /* 327 */ -EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr, +EXTERN size_t Tcl_UtfBackslash(const char *src, int *readPtr, char *dst); /* 328 */ EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch); @@ -1012,13 +900,13 @@ EXTERN const char * Tcl_UtfPrev(const char *src, const char *start); /* 332 */ EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, - int srcLen, int flags, + size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, - int dstLen, int *srcReadPtr, + size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 333 */ EXTERN char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, - const char *src, int srcLen, + const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 334 */ EXTERN int Tcl_UtfToLower(char *src); @@ -1029,20 +917,16 @@ EXTERN int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr); /* 337 */ EXTERN int Tcl_UtfToUpper(char *src); /* 338 */ -EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src, - int srcLen); +EXTERN size_t Tcl_WriteChars(Tcl_Channel chan, const char *src, + size_t srcLen); /* 339 */ -EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); +EXTERN size_t Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 340 */ EXTERN char * Tcl_GetString(Tcl_Obj *objPtr); -/* 341 */ -TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath") -const char * Tcl_GetDefaultEncodingDir(void); -/* 342 */ -TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath") -void Tcl_SetDefaultEncodingDir(const char *path); +/* Slot 341 is reserved */ +/* Slot 342 is reserved */ /* 343 */ -EXTERN void Tcl_AlertNotifier(ClientData clientData); +EXTERN void Tcl_AlertNotifier(void *clientData); /* 344 */ EXTERN void Tcl_ServiceModeHook(int mode); /* 345 */ @@ -1060,50 +944,46 @@ EXTERN int Tcl_UniCharIsUpper(int ch); /* 351 */ EXTERN int Tcl_UniCharIsWordChar(int ch); /* 352 */ -EXTERN int Tcl_UniCharLen(const Tcl_UniChar *uniStr); +EXTERN size_t Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ EXTERN int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, - unsigned long numChars); + const Tcl_UniChar *uct, size_t numChars); /* 354 */ EXTERN char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, - int uniLength, Tcl_DString *dsPtr); + size_t uniLength, Tcl_DString *dsPtr); /* 355 */ -EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length, - Tcl_DString *dsPtr); +EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, + size_t length, Tcl_DString *dsPtr); /* 356 */ EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); -/* 357 */ -TCL_DEPRECATED("Use Tcl_EvalTokensStandard") -Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp, - Tcl_Token *tokenPtr, int count); +/* Slot 357 is reserved */ /* 358 */ EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr); /* 359 */ EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, - int length); + size_t length); /* 360 */ EXTERN int Tcl_ParseBraces(Tcl_Interp *interp, - const char *start, int numBytes, + const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 361 */ EXTERN int Tcl_ParseCommand(Tcl_Interp *interp, - const char *start, int numBytes, int nested, - Tcl_Parse *parsePtr); + const char *start, size_t numBytes, + int nested, Tcl_Parse *parsePtr); /* 362 */ EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, - int numBytes, Tcl_Parse *parsePtr); + size_t numBytes, Tcl_Parse *parsePtr); /* 363 */ EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp, - const char *start, int numBytes, + const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 364 */ EXTERN int Tcl_ParseVarName(Tcl_Interp *interp, - const char *start, int numBytes, + const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append); /* 365 */ EXTERN char * Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); @@ -1114,11 +994,10 @@ EXTERN int Tcl_Access(const char *path, int mode); /* 368 */ EXTERN int Tcl_Stat(const char *path, struct stat *bufPtr); /* 369 */ -EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, - unsigned long n); +EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); /* 370 */ EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, - unsigned long n); + size_t n); /* 371 */ EXTERN int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase); @@ -1133,28 +1012,27 @@ EXTERN int Tcl_UniCharIsPunct(int ch); /* 376 */ EXTERN int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, - int offset, int nmatches, int flags); + size_t offset, size_t nmatches, int flags); /* 377 */ EXTERN void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 378 */ EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, - int numChars); + size_t numChars); /* 379 */ EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); + const Tcl_UniChar *unicode, size_t numChars); /* 380 */ -EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr); +EXTERN size_t Tcl_GetCharLength(Tcl_Obj *objPtr); /* 381 */ -EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, int index); -/* 382 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); +EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index); +/* Slot 382 is reserved */ /* 383 */ -EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last); +EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, size_t first, + size_t last); /* 384 */ EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int length); + const Tcl_UniChar *unicode, size_t length); /* 385 */ EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); @@ -1168,24 +1046,22 @@ EXTERN int Tcl_GetChannelNames(Tcl_Interp *interp); EXTERN int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern); /* 390 */ -EXTERN int Tcl_ProcObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +EXTERN int Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* 391 */ EXTERN void Tcl_ConditionFinalize(Tcl_Condition *condPtr); /* 392 */ EXTERN void Tcl_MutexFinalize(Tcl_Mutex *mutex); /* 393 */ EXTERN int Tcl_CreateThread(Tcl_ThreadId *idPtr, - Tcl_ThreadCreateProc *proc, - ClientData clientData, int stackSize, - int flags); + Tcl_ThreadCreateProc *proc, void *clientData, + size_t stackSize, int flags); /* 394 */ -EXTERN int Tcl_ReadRaw(Tcl_Channel chan, char *dst, - int bytesToRead); +EXTERN size_t Tcl_ReadRaw(Tcl_Channel chan, char *dst, + size_t bytesToRead); /* 395 */ -EXTERN int Tcl_WriteRaw(Tcl_Channel chan, const char *src, - int srcLen); +EXTERN size_t Tcl_WriteRaw(Tcl_Channel chan, const char *src, + size_t srcLen); /* 396 */ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); /* 397 */ @@ -1248,65 +1124,50 @@ EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); EXTERN int Tcl_IsChannelExisting(const char *channelName); /* 419 */ EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, - unsigned long numChars); + const Tcl_UniChar *uct, size_t numChars); /* 420 */ EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); -/* 421 */ -EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, - const void *key); -/* 422 */ -EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, - const void *key, int *newPtr); +/* Slot 421 is reserved */ +/* Slot 422 is reserved */ /* 423 */ EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 424 */ EXTERN void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr); /* 425 */ -EXTERN ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, +EXTERN void * Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, - ClientData prevClientData); + void *prevClientData); /* 426 */ EXTERN int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, - ClientData clientData); + Tcl_CommandTraceProc *proc, void *clientData); /* 427 */ EXTERN void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, - ClientData clientData); + Tcl_CommandTraceProc *proc, void *clientData); /* 428 */ -EXTERN char * Tcl_AttemptAlloc(unsigned int size); +EXTERN void * Tcl_AttemptAlloc(size_t size); /* 429 */ -EXTERN char * Tcl_AttemptDbCkalloc(unsigned int size, - const char *file, int line); +EXTERN void * Tcl_AttemptDbCkalloc(size_t size, const char *file, + int line); /* 430 */ -EXTERN char * Tcl_AttemptRealloc(char *ptr, unsigned int size); +EXTERN void * Tcl_AttemptRealloc(void *ptr, size_t size); /* 431 */ -EXTERN char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, +EXTERN void * Tcl_AttemptDbCkrealloc(void *ptr, size_t size, const char *file, int line); /* 432 */ -EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); +EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, + size_t length); /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); -/* 435 */ -TCL_DEPRECATED("") -int Tcl_GetMathFuncInfo(Tcl_Interp *interp, - const char *name, int *numArgsPtr, - Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, - ClientData *clientDataPtr); -/* 436 */ -TCL_DEPRECATED("") -Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, - const char *pattern); +/* Slot 435 is reserved */ +/* Slot 436 is reserved */ /* 437 */ EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); @@ -1356,7 +1217,7 @@ EXTERN int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index, EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 453 */ -EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, +EXTERN const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 454 */ EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); @@ -1387,7 +1248,7 @@ EXTERN Tcl_Obj * Tcl_FSGetNormalizedPath(Tcl_Interp *interp, EXTERN Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 465 */ -EXTERN ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, +EXTERN void * Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 466 */ EXTERN Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp, @@ -1397,7 +1258,7 @@ EXTERN int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName); /* 468 */ EXTERN Tcl_Obj * Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, - ClientData clientData); + void *clientData); /* 469 */ EXTERN const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr); /* 470 */ @@ -1407,17 +1268,17 @@ EXTERN Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr); /* 472 */ EXTERN Tcl_Obj * Tcl_FSListVolumes(void); /* 473 */ -EXTERN int Tcl_FSRegister(ClientData clientData, +EXTERN int Tcl_FSRegister(void *clientData, const Tcl_Filesystem *fsPtr); /* 474 */ EXTERN int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr); /* 475 */ -EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr); +EXTERN void * Tcl_FSData(const Tcl_Filesystem *fsPtr); /* 476 */ EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 477 */ -EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); +EXTERN const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); /* 478 */ EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr); /* 479 */ @@ -1426,13 +1287,13 @@ EXTERN int Tcl_OutputBuffered(Tcl_Channel chan); EXTERN void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr); /* 481 */ EXTERN int Tcl_EvalTokensStandard(Tcl_Interp *interp, - Tcl_Token *tokenPtr, int count); + Tcl_Token *tokenPtr, size_t count); /* 482 */ EXTERN void Tcl_GetTime(Tcl_Time *timeBuf); /* 483 */ EXTERN Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, - ClientData clientData, + void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 484 */ EXTERN int Tcl_GetCommandInfoFromToken(Tcl_Command token, @@ -1503,7 +1364,7 @@ EXTERN void Tcl_RegisterConfig(Tcl_Interp *interp, const char *valEncoding); /* 506 */ EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, - const char *name, ClientData clientData, + const char *name, void *clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 507 */ EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); @@ -1539,17 +1400,16 @@ EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, /* 518 */ EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); -/* 519 */ -EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); +/* Slot 519 is reserved */ /* 520 */ EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, - ClientData clientData, + void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 521 */ EXTERN void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, - ClientData clientData); + void *clientData); /* 522 */ EXTERN int Tcl_LimitReady(Tcl_Interp *interp); /* 523 */ @@ -1632,11 +1492,11 @@ EXTERN int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, /* 552 */ EXTERN void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData); + void *clientData); /* 553 */ EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData); + void **clientData); /* 554 */ EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); @@ -1697,8 +1557,8 @@ EXTERN void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 575 */ EXTERN void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, - const char *bytes, int length, int limit, - const char *ellipsis); + const char *bytes, size_t length, + size_t limit, const char *ellipsis); /* 576 */ EXTERN Tcl_Obj * Tcl_Format(Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); @@ -1713,7 +1573,7 @@ EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 580 */ EXTERN int Tcl_CancelEval(Tcl_Interp *interp, - Tcl_Obj *resultObjPtr, ClientData clientData, + Tcl_Obj *resultObjPtr, void *clientData, int flags); /* 581 */ EXTERN int Tcl_Canceled(Tcl_Interp *interp, int flags); @@ -1724,8 +1584,7 @@ EXTERN int Tcl_CreatePipe(Tcl_Interp *interp, /* 583 */ EXTERN Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - Tcl_ObjCmdProc *nreProc, - ClientData clientData, + Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 584 */ EXTERN int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -1738,14 +1597,12 @@ EXTERN int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 587 */ EXTERN void Tcl_NRAddCallback(Tcl_Interp *interp, - Tcl_NRPostProc *postProcPtr, - ClientData data0, ClientData data1, - ClientData data2, ClientData data3); + Tcl_NRPostProc *postProcPtr, void *data0, + void *data1, void *data2, void *data3); /* 588 */ EXTERN int Tcl_NRCallObjProc(Tcl_Interp *interp, - Tcl_ObjCmdProc *objProc, - ClientData clientData, int objc, - Tcl_Obj *const objv[]); + Tcl_ObjCmdProc *objProc, void *clientData, + int objc, Tcl_Obj *const objv[]); /* 589 */ EXTERN unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr); /* 590 */ @@ -1800,14 +1657,14 @@ EXTERN int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *gzipHeaderDictObj); /* 611 */ EXTERN int Tcl_ZlibInflate(Tcl_Interp *interp, int format, - Tcl_Obj *data, int buffersize, + Tcl_Obj *data, size_t buffersize, Tcl_Obj *gzipHeaderDictObj); /* 612 */ EXTERN unsigned int Tcl_ZlibCRC32(unsigned int crc, - const unsigned char *buf, int len); + const unsigned char *buf, size_t len); /* 613 */ EXTERN unsigned int Tcl_ZlibAdler32(unsigned int adler, - const unsigned char *buf, int len); + const unsigned char *buf, size_t len); /* 614 */ EXTERN int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, @@ -1823,7 +1680,7 @@ EXTERN int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 619 */ EXTERN int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, - Tcl_Obj *data, int count); + Tcl_Obj *data, size_t count); /* 620 */ EXTERN int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle); /* 621 */ @@ -1861,7 +1718,7 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData); + void *callbackData); /* 632 */ EXTERN int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint, const char *zipname, @@ -1879,7 +1736,7 @@ EXTERN int TclZipfs_MountBuffer(Tcl_Interp *interp, EXTERN void Tcl_FreeIntRep(Tcl_Obj *objPtr); /* 637 */ EXTERN char * Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, - unsigned int numBytes); + size_t numBytes); /* 638 */ EXTERN Tcl_ObjIntRep * Tcl_FetchIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); @@ -1909,20 +1766,20 @@ typedef struct TclStubs { int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ - char * (*tcl_Alloc) (unsigned int size); /* 3 */ - void (*tcl_Free) (char *ptr); /* 4 */ - char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */ - char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */ - void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */ - char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */ + void * (*tcl_Alloc) (size_t size); /* 3 */ + void (*tcl_Free) (void *ptr); /* 4 */ + void * (*tcl_Realloc) (void *ptr, size_t size); /* 5 */ + void * (*tcl_DbCkalloc) (size_t size, const char *file, int line); /* 6 */ + void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */ + void * (*tcl_DbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 8 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ + void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ void (*reserved9)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ + void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */ #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ @@ -1938,31 +1795,31 @@ typedef struct TclStubs { int (*tcl_WaitForEvent) (const Tcl_Time *timePtr); /* 13 */ int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 14 */ void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */ - void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 16 */ + void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 16 */ Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */ int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */ void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */ void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */ int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */ - Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */ + void (*reserved22)(void); + Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, size_t length, const char *file, int line); /* 23 */ Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */ Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */ + void (*reserved26)(void); Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */ - Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */ + Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, size_t length, const char *file, int line); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */ - void (*tclOldFreeObj) (Tcl_Obj *objPtr); /* 30 */ + void (*reserved30)(void); int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */ int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */ + void (*reserved36)(void); int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */ int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ - CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ + const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */ void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */ int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */ @@ -1971,90 +1828,90 @@ typedef struct TclStubs { int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */ int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */ - Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */ + void (*reserved49)(void); + Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, size_t length); /* 50 */ Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */ + void (*reserved52)(void); Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */ + void (*reserved54)(void); Tcl_Obj * (*tcl_NewObj) (void); /* 55 */ - Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */ - unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */ - void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */ + Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, size_t length); /* 56 */ + void (*reserved57)(void); + unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, size_t length); /* 58 */ + void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, size_t length); /* 59 */ void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */ + void (*reserved61)(void); void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */ - void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */ - void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */ + void (*reserved63)(void); + void (*tcl_SetObjLength) (Tcl_Obj *objPtr, size_t length); /* 64 */ + void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 65 */ + void (*reserved66)(void); + void (*reserved67)(void); void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */ void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */ void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */ - Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */ + Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, void *clientData); /* 71 */ void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */ int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */ void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ int (*tcl_AsyncReady) (void); /* 75 */ void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ - TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */ + void (*reserved77)(void); int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */ - void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */ - void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ + void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 79 */ + void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, void *clientData); /* 80 */ int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */ int (*tcl_CommandComplete) (const char *cmd); /* 82 */ char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */ - int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ - int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */ + size_t (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ + size_t (*tcl_ConvertCountedElement) (const char *src, size_t length, char *dst, int flags); /* 85 */ int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */ int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */ - Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */ - void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */ - void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */ - Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */ - void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */ - void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */ + Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, void *instanceData, int mask); /* 88 */ + void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, void *clientData); /* 89 */ + void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 90 */ + Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */ + void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 92 */ + void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 93 */ Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */ - TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */ - Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ + void (*reserved95)(void); + Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */ - Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */ - Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */ + Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, void *clientData); /* 98 */ + Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, void *clientData); /* 99 */ void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */ - void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */ - void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */ + void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, void *clientData); /* 101 */ + void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 102 */ int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */ int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */ - void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, ClientData clientData); /* 105 */ - void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 106 */ - void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 107 */ + void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, void *clientData); /* 105 */ + void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 106 */ + void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 107 */ void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr); /* 108 */ void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr); /* 109 */ void (*tcl_DeleteInterp) (Tcl_Interp *interp); /* 110 */ void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr); /* 111 */ void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token); /* 112 */ void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace trace); /* 113 */ - void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 114 */ + void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 114 */ int (*tcl_DoOneEvent) (int flags); /* 115 */ - void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, ClientData clientData); /* 116 */ - char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, int length); /* 117 */ + void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, void *clientData); /* 116 */ + char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, size_t length); /* 117 */ char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, const char *element); /* 118 */ void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr); /* 119 */ void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */ void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */ void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */ void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */ - void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */ + void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, size_t length); /* 124 */ void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */ int (*tcl_Eof) (Tcl_Channel chan); /* 126 */ const char * (*tcl_ErrnoId) (void); /* 127 */ const char * (*tcl_ErrnoMsg) (int err); /* 128 */ - int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ + void (*reserved129)(void); int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ - void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ + void (*reserved131)(void); + void (*tcl_EventuallyFree) (void *clientData, Tcl_FreeProc *freeProc); /* 132 */ TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */ int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */ int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */ @@ -2066,21 +1923,21 @@ typedef struct TclStubs { int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */ void (*tcl_Finalize) (void); /* 143 */ - TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_FindExecutable) (const char *argv0); /* 144 */ + void (*reserved144)(void); Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */ int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ - ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ + void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ - int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */ - ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ + int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, void **handlePtr); /* 153 */ + void * (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */ const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */ - CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ + const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */ const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ int (*tcl_GetErrno) (void); /* 161 */ @@ -2090,25 +1947,25 @@ typedef struct TclStubs { const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ + int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ void (*reserved167)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ + int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */ #endif /* MACOSX */ Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */ - int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */ - int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */ + size_t (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */ + size_t (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */ int (*tcl_GetServiceMode) (void); /* 171 */ Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */ const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ + void (*reserved175)(void); const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ - int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */ + void (*reserved177)(void); + void (*reserved178)(void); int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */ int (*tcl_Init) (Tcl_Interp *interp); /* 180 */ void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */ @@ -2119,9 +1976,9 @@ typedef struct TclStubs { char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */ int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */ void (*reserved188)(void); - Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */ + Tcl_Channel (*tcl_MakeFileChannel) (void *handle, int mode); /* 189 */ int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */ - Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */ + Tcl_Channel (*tcl_MakeTcpClientChannel) (void *tcpSocket); /* 191 */ char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */ void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */ @@ -2130,13 +1987,13 @@ typedef struct TclStubs { Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */ Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */ Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */ - Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */ - void (*tcl_Preserve) (ClientData data); /* 201 */ + Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 200 */ + void (*tcl_Preserve) (void *data); /* 201 */ void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */ int (*tcl_PutEnv) (const char *assignment); /* 203 */ const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */ - int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */ + size_t (*tcl_Read) (Tcl_Channel chan, char *bufPtr, size_t toRead); /* 206 */ void (*tcl_ReapDetachedProcs) (void); /* 207 */ int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */ int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */ @@ -2145,135 +2002,135 @@ typedef struct TclStubs { Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */ int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */ int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */ - void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */ - void (*tcl_Release) (ClientData clientData); /* 216 */ + void (*tcl_RegExpRange) (Tcl_RegExp regexp, size_t index, const char **startPtr, const char **endPtr); /* 215 */ + void (*tcl_Release) (void *clientData); /* 216 */ void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ - int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ - int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */ - TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */ + size_t (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ + size_t (*tcl_ScanCountedElement) (const char *src, size_t length, int *flagPtr); /* 219 */ + void (*reserved220)(void); int (*tcl_ServiceAll) (void); /* 221 */ int (*tcl_ServiceEvent) (int flags); /* 222 */ - void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */ + void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, void *clientData); /* 223 */ void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */ int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */ int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */ void (*tcl_SetErrno) (int err); /* 227 */ void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */ void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */ - TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */ + void (*reserved230)(void); int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */ - void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */ + void (*reserved232)(void); int (*tcl_SetServiceMode) (int mode); /* 233 */ void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */ void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */ void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ + void (*reserved237)(void); const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ const char * (*tcl_SignalId) (int sig); /* 239 */ const char * (*tcl_SignalMsg) (int sig); /* 240 */ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */ int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */ void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */ - TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */ + void (*reserved244)(void); int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ - TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */ - int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ + void (*reserved246)(void); + void (*reserved247)(void); + int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 248 */ char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */ - int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */ + size_t (*tcl_Ungets) (Tcl_Channel chan, const char *str, size_t len, int atHead); /* 250 */ void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */ int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */ + void (*reserved253)(void); int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */ - void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */ + void (*reserved255)(void); + void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 256 */ void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */ + void (*reserved258)(void); int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */ int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */ - ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */ - int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */ + void (*reserved261)(void); + void * (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, void *prevClientData); /* 262 */ + size_t (*tcl_Write) (Tcl_Channel chan, const char *s, size_t slen); /* 263 */ void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */ int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */ void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */ - TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */ - TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */ + void (*reserved267)(void); + void (*reserved268)(void); char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */ const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ + void (*reserved271)(void); const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ - TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ - TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */ + void (*reserved273)(void); + void (*reserved274)(void); + void (*reserved275)(void); + void (*reserved276)(void); Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ - TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */ + void (*reserved278)(void); void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */ void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */ - Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */ + Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan); /* 281 */ int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */ Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */ void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */ void (*reserved285)(void); void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */ Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */ - void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */ - void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */ - void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */ - int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */ + void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 288 */ + void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 289 */ + void (*reserved290)(void); + int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, size_t numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */ int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */ TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */ - int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ - char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */ + int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ + char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 296 */ void (*tcl_FinalizeThread) (void); /* 297 */ - void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */ + void (*tcl_FinalizeNotifier) (void *clientData); /* 298 */ void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */ const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */ - int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */ - void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */ + int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, size_t offset, const char *msg, int flags, int *indexPtr); /* 304 */ + void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, size_t size); /* 305 */ Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */ - ClientData (*tcl_InitNotifier) (void); /* 307 */ + void * (*tcl_InitNotifier) (void); /* 307 */ void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */ void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */ void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */ void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */ - int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */ - int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */ - void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */ - void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */ + size_t (*tcl_NumUtfChars) (const char *src, size_t length); /* 312 */ + size_t (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, size_t charsToRead, int appendFlag); /* 313 */ + void (*reserved314)(void); + void (*reserved315)(void); int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */ Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */ void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */ void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */ - int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */ + int (*tcl_UniCharAtIndex) (const char *src, size_t index); /* 320 */ int (*tcl_UniCharToLower) (int ch); /* 321 */ int (*tcl_UniCharToTitle) (int ch); /* 322 */ int (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ - const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ - int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */ - int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ + const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 325 */ + int (*tcl_UtfCharComplete) (const char *src, size_t length); /* 326 */ + size_t (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ const char * (*tcl_UtfNext) (const char *src); /* 330 */ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ - int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ - char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */ + int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ + char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 333 */ int (*tcl_UtfToLower) (char *src); /* 334 */ int (*tcl_UtfToTitle) (char *src); /* 335 */ int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr); /* 336 */ int (*tcl_UtfToUpper) (char *src); /* 337 */ - int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */ - int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ + size_t (*tcl_WriteChars) (Tcl_Channel chan, const char *src, size_t srcLen); /* 338 */ + size_t (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */ - TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ - TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ - void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */ + void (*reserved341)(void); + void (*reserved342)(void); + void (*tcl_AlertNotifier) (void *clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ int (*tcl_UniCharIsAlpha) (int ch); /* 346 */ @@ -2282,50 +2139,50 @@ typedef struct TclStubs { int (*tcl_UniCharIsSpace) (int ch); /* 349 */ int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ - int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ - int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */ - char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ - Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ + size_t (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ + int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 353 */ + char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 354 */ + Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, size_t length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ - TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ + void (*reserved357)(void); void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */ - void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */ - int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ - int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */ - int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */ - int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */ - int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */ + void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, size_t length); /* 359 */ + int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ + int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, size_t numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */ + int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr); /* 362 */ + int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */ + int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append); /* 364 */ char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */ int (*tcl_Chdir) (const char *dirName); /* 366 */ int (*tcl_Access) (const char *path, int mode); /* 367 */ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */ - int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */ - int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */ + int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */ + int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */ int (*tcl_UniCharIsControl) (int ch); /* 372 */ int (*tcl_UniCharIsGraph) (int ch); /* 373 */ int (*tcl_UniCharIsPrint) (int ch); /* 374 */ int (*tcl_UniCharIsPunct) (int ch); /* 375 */ - int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */ + int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, size_t offset, size_t nmatches, int flags); /* 376 */ void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */ - Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */ - void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */ - int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ - int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */ - Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */ - void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */ + Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, size_t numChars); /* 378 */ + void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); /* 379 */ + size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ + int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */ + void (*reserved382)(void); + Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 383 */ + void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 384 */ int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */ void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */ int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */ int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */ - int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ + int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */ void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */ - int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */ - int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */ - int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */ + int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, size_t stackSize, int flags); /* 393 */ + size_t (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, size_t bytesToRead); /* 394 */ + size_t (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, size_t srcLen); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */ int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */ const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */ @@ -2349,24 +2206,24 @@ typedef struct TclStubs { void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ - int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */ + int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 419 */ int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ - Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ - Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ + void (*reserved421)(void); + void (*reserved422)(void); void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */ void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */ - ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */ - int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */ - void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */ - char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */ - char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */ - char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */ - char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */ - int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */ + void * (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, void *prevClientData); /* 425 */ + int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 426 */ + void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */ + void * (*tcl_AttemptAlloc) (size_t size); /* 428 */ + void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */ + void * (*tcl_AttemptRealloc) (void *ptr, size_t size); /* 430 */ + void * (*tcl_AttemptDbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 431 */ + int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, size_t length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ - TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */ - TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ + void (*reserved435)(void); + void (*reserved436)(void); Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */ int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */ @@ -2383,7 +2240,7 @@ typedef struct TclStubs { int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */ int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */ int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */ - const char *CONST86 * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */ + const char *const * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */ int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */ int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */ Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */ @@ -2395,25 +2252,25 @@ typedef struct TclStubs { int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */ Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */ Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 464 */ - ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */ + void * (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */ Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */ int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */ - Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */ + Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, void *clientData); /* 468 */ const void * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */ Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */ Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */ Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */ - int (*tcl_FSRegister) (ClientData clientData, const Tcl_Filesystem *fsPtr); /* 473 */ + int (*tcl_FSRegister) (void *clientData, const Tcl_Filesystem *fsPtr); /* 473 */ int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */ - ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */ + void * (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */ const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */ - CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ + const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */ int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */ void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */ - int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 481 */ + int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, size_t count); /* 481 */ void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */ - Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */ + Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */ int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */ int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */ Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */ @@ -2436,7 +2293,7 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */ Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */ void (*tcl_RegisterConfig) (Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 505 */ - Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */ + Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, void *clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */ void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 507 */ int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 508 */ int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 509 */ @@ -2449,9 +2306,9 @@ typedef struct TclStubs { Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */ void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */ int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */ - TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */ - void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ - void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */ + void (*reserved519)(void); + void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ + void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData); /* 521 */ int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */ int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */ int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */ @@ -2482,8 +2339,8 @@ typedef struct TclStubs { int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */ int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */ int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */ - void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */ - void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */ + void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, void *clientData); /* 552 */ + void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ Tcl_Obj * (*tcl_NewBignumObj) (mp_int *value); /* 555 */ Tcl_Obj * (*tcl_DbNewBignumObj) (mp_int *value, const char *file, int line); /* 556 */ @@ -2505,20 +2362,20 @@ typedef struct TclStubs { const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */ int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */ void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */ - void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 575 */ + void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length, size_t limit, const char *ellipsis); /* 575 */ Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 576 */ int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */ Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 578 */ void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 579 */ - int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 580 */ + int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, void *clientData, int flags); /* 580 */ int (*tcl_Canceled) (Tcl_Interp *interp, int flags); /* 581 */ int (*tcl_CreatePipe) (Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 582 */ - Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */ + Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */ int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */ int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */ int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */ - void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */ - int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 588 */ + void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, void *data0, void *data1, void *data2, void *data3); /* 587 */ + int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, void *clientData, int objc, Tcl_Obj *const objv[]); /* 588 */ unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */ unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */ unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */ @@ -2541,15 +2398,15 @@ typedef struct TclStubs { int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */ void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */ int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */ - int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */ - unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, int len); /* 612 */ - unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, int len); /* 613 */ + int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, size_t buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */ + unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, size_t len); /* 612 */ + unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, size_t len); /* 613 */ int (*tcl_ZlibStreamInit) (Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 614 */ Tcl_Obj * (*tcl_ZlibStreamGetCommandName) (Tcl_ZlibStream zshandle); /* 615 */ int (*tcl_ZlibStreamEof) (Tcl_ZlibStream zshandle); /* 616 */ int (*tcl_ZlibStreamChecksum) (Tcl_ZlibStream zshandle); /* 617 */ int (*tcl_ZlibStreamPut) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 618 */ - int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int count); /* 619 */ + int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, size_t count); /* 619 */ int (*tcl_ZlibStreamClose) (Tcl_ZlibStream zshandle); /* 620 */ int (*tcl_ZlibStreamReset) (Tcl_ZlibStream zshandle); /* 621 */ void (*tcl_SetStartupScript) (Tcl_Obj *path, const char *encoding); /* 622 */ @@ -2561,13 +2418,13 @@ typedef struct TclStubs { void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ - Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ + Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 631 */ int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */ int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */ Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */ int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */ void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 636 */ - char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */ + char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, size_t numBytes); /* 637 */ Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */ void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */ int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */ @@ -2644,24 +2501,21 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DbIncrRefCount) /* 20 */ #define Tcl_DbIsShared \ (tclStubsPtr->tcl_DbIsShared) /* 21 */ -#define Tcl_DbNewBooleanObj \ - (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */ +/* Slot 22 is reserved */ #define Tcl_DbNewByteArrayObj \ (tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */ #define Tcl_DbNewDoubleObj \ (tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */ #define Tcl_DbNewListObj \ (tclStubsPtr->tcl_DbNewListObj) /* 25 */ -#define Tcl_DbNewLongObj \ - (tclStubsPtr->tcl_DbNewLongObj) /* 26 */ +/* Slot 26 is reserved */ #define Tcl_DbNewObj \ (tclStubsPtr->tcl_DbNewObj) /* 27 */ #define Tcl_DbNewStringObj \ (tclStubsPtr->tcl_DbNewStringObj) /* 28 */ #define Tcl_DuplicateObj \ (tclStubsPtr->tcl_DuplicateObj) /* 29 */ -#define TclOldFreeObj \ - (tclStubsPtr->tclOldFreeObj) /* 30 */ +/* Slot 30 is reserved */ #define Tcl_GetBoolean \ (tclStubsPtr->tcl_GetBoolean) /* 31 */ #define Tcl_GetBooleanFromObj \ @@ -2672,8 +2526,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetDouble) /* 34 */ #define Tcl_GetDoubleFromObj \ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */ -#define Tcl_GetIndexFromObj \ - (tclStubsPtr->tcl_GetIndexFromObj) /* 36 */ +/* Slot 36 is reserved */ #define Tcl_GetInt \ (tclStubsPtr->tcl_GetInt) /* 37 */ #define Tcl_GetIntFromObj \ @@ -2698,44 +2551,36 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ListObjLength) /* 47 */ #define Tcl_ListObjReplace \ (tclStubsPtr->tcl_ListObjReplace) /* 48 */ -#define Tcl_NewBooleanObj \ - (tclStubsPtr->tcl_NewBooleanObj) /* 49 */ +/* Slot 49 is reserved */ #define Tcl_NewByteArrayObj \ (tclStubsPtr->tcl_NewByteArrayObj) /* 50 */ #define Tcl_NewDoubleObj \ (tclStubsPtr->tcl_NewDoubleObj) /* 51 */ -#define Tcl_NewIntObj \ - (tclStubsPtr->tcl_NewIntObj) /* 52 */ +/* Slot 52 is reserved */ #define Tcl_NewListObj \ (tclStubsPtr->tcl_NewListObj) /* 53 */ -#define Tcl_NewLongObj \ - (tclStubsPtr->tcl_NewLongObj) /* 54 */ +/* Slot 54 is reserved */ #define Tcl_NewObj \ (tclStubsPtr->tcl_NewObj) /* 55 */ #define Tcl_NewStringObj \ (tclStubsPtr->tcl_NewStringObj) /* 56 */ -#define Tcl_SetBooleanObj \ - (tclStubsPtr->tcl_SetBooleanObj) /* 57 */ +/* Slot 57 is reserved */ #define Tcl_SetByteArrayLength \ (tclStubsPtr->tcl_SetByteArrayLength) /* 58 */ #define Tcl_SetByteArrayObj \ (tclStubsPtr->tcl_SetByteArrayObj) /* 59 */ #define Tcl_SetDoubleObj \ (tclStubsPtr->tcl_SetDoubleObj) /* 60 */ -#define Tcl_SetIntObj \ - (tclStubsPtr->tcl_SetIntObj) /* 61 */ +/* Slot 61 is reserved */ #define Tcl_SetListObj \ (tclStubsPtr->tcl_SetListObj) /* 62 */ -#define Tcl_SetLongObj \ - (tclStubsPtr->tcl_SetLongObj) /* 63 */ +/* Slot 63 is reserved */ #define Tcl_SetObjLength \ (tclStubsPtr->tcl_SetObjLength) /* 64 */ #define Tcl_SetStringObj \ (tclStubsPtr->tcl_SetStringObj) /* 65 */ -#define Tcl_AddErrorInfo \ - (tclStubsPtr->tcl_AddErrorInfo) /* 66 */ -#define Tcl_AddObjErrorInfo \ - (tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */ +/* Slot 66 is reserved */ +/* Slot 67 is reserved */ #define Tcl_AllowExceptions \ (tclStubsPtr->tcl_AllowExceptions) /* 68 */ #define Tcl_AppendElement \ @@ -2754,8 +2599,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_AsyncReady) /* 75 */ #define Tcl_BackgroundError \ (tclStubsPtr->tcl_BackgroundError) /* 76 */ -#define Tcl_Backslash \ - (tclStubsPtr->tcl_Backslash) /* 77 */ +/* Slot 77 is reserved */ #define Tcl_BadChannelOption \ (tclStubsPtr->tcl_BadChannelOption) /* 78 */ #define Tcl_CallWhenDeleted \ @@ -2790,8 +2634,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_CreateExitHandler) /* 93 */ #define Tcl_CreateInterp \ (tclStubsPtr->tcl_CreateInterp) /* 94 */ -#define Tcl_CreateMathFunc \ - (tclStubsPtr->tcl_CreateMathFunc) /* 95 */ +/* Slot 95 is reserved */ #define Tcl_CreateObjCommand \ (tclStubsPtr->tcl_CreateObjCommand) /* 96 */ #define Tcl_CreateSlave \ @@ -2858,12 +2701,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ErrnoId) /* 127 */ #define Tcl_ErrnoMsg \ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ -#define Tcl_Eval \ - (tclStubsPtr->tcl_Eval) /* 129 */ +/* Slot 129 is reserved */ #define Tcl_EvalFile \ (tclStubsPtr->tcl_EvalFile) /* 130 */ -#define Tcl_EvalObj \ - (tclStubsPtr->tcl_EvalObj) /* 131 */ +/* Slot 131 is reserved */ #define Tcl_EventuallyFree \ (tclStubsPtr->tcl_EventuallyFree) /* 132 */ #define Tcl_Exit \ @@ -2888,8 +2729,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ExprString) /* 142 */ #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ -#define Tcl_FindExecutable \ - (tclStubsPtr->tcl_FindExecutable) /* 144 */ +/* Slot 144 is reserved */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ @@ -2956,14 +2796,11 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetStdChannel) /* 173 */ #define Tcl_GetStringResult \ (tclStubsPtr->tcl_GetStringResult) /* 174 */ -#define Tcl_GetVar \ - (tclStubsPtr->tcl_GetVar) /* 175 */ +/* Slot 175 is reserved */ #define Tcl_GetVar2 \ (tclStubsPtr->tcl_GetVar2) /* 176 */ -#define Tcl_GlobalEval \ - (tclStubsPtr->tcl_GlobalEval) /* 177 */ -#define Tcl_GlobalEvalObj \ - (tclStubsPtr->tcl_GlobalEvalObj) /* 178 */ +/* Slot 177 is reserved */ +/* Slot 178 is reserved */ #define Tcl_HideCommand \ (tclStubsPtr->tcl_HideCommand) /* 179 */ #define Tcl_Init \ @@ -3045,8 +2882,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ScanElement) /* 218 */ #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ -#define Tcl_SeekOld \ - (tclStubsPtr->tcl_SeekOld) /* 220 */ +/* Slot 220 is reserved */ #define Tcl_ServiceAll \ (tclStubsPtr->tcl_ServiceAll) /* 221 */ #define Tcl_ServiceEvent \ @@ -3065,12 +2901,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetErrorCode) /* 228 */ #define Tcl_SetMaxBlockTime \ (tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */ -#define Tcl_SetPanicProc \ - (tclStubsPtr->tcl_SetPanicProc) /* 230 */ +/* Slot 230 is reserved */ #define Tcl_SetRecursionLimit \ (tclStubsPtr->tcl_SetRecursionLimit) /* 231 */ -#define Tcl_SetResult \ - (tclStubsPtr->tcl_SetResult) /* 232 */ +/* Slot 232 is reserved */ #define Tcl_SetServiceMode \ (tclStubsPtr->tcl_SetServiceMode) /* 233 */ #define Tcl_SetObjErrorCode \ @@ -3079,8 +2913,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetObjResult) /* 235 */ #define Tcl_SetStdChannel \ (tclStubsPtr->tcl_SetStdChannel) /* 236 */ -#define Tcl_SetVar \ - (tclStubsPtr->tcl_SetVar) /* 237 */ +/* Slot 237 is reserved */ #define Tcl_SetVar2 \ (tclStubsPtr->tcl_SetVar2) /* 238 */ #define Tcl_SignalId \ @@ -3093,14 +2926,11 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SplitList) /* 242 */ #define Tcl_SplitPath \ (tclStubsPtr->tcl_SplitPath) /* 243 */ -#define Tcl_StaticPackage \ - (tclStubsPtr->tcl_StaticPackage) /* 244 */ +/* Slot 244 is reserved */ #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ -#define Tcl_TellOld \ - (tclStubsPtr->tcl_TellOld) /* 246 */ -#define Tcl_TraceVar \ - (tclStubsPtr->tcl_TraceVar) /* 247 */ +/* Slot 246 is reserved */ +/* Slot 247 is reserved */ #define Tcl_TraceVar2 \ (tclStubsPtr->tcl_TraceVar2) /* 248 */ #define Tcl_TranslateFileName \ @@ -3111,24 +2941,20 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UnlinkVar) /* 251 */ #define Tcl_UnregisterChannel \ (tclStubsPtr->tcl_UnregisterChannel) /* 252 */ -#define Tcl_UnsetVar \ - (tclStubsPtr->tcl_UnsetVar) /* 253 */ +/* Slot 253 is reserved */ #define Tcl_UnsetVar2 \ (tclStubsPtr->tcl_UnsetVar2) /* 254 */ -#define Tcl_UntraceVar \ - (tclStubsPtr->tcl_UntraceVar) /* 255 */ +/* Slot 255 is reserved */ #define Tcl_UntraceVar2 \ (tclStubsPtr->tcl_UntraceVar2) /* 256 */ #define Tcl_UpdateLinkedVar \ (tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */ -#define Tcl_UpVar \ - (tclStubsPtr->tcl_UpVar) /* 258 */ +/* Slot 258 is reserved */ #define Tcl_UpVar2 \ (tclStubsPtr->tcl_UpVar2) /* 259 */ #define Tcl_VarEval \ (tclStubsPtr->tcl_VarEval) /* 260 */ -#define Tcl_VarTraceInfo \ - (tclStubsPtr->tcl_VarTraceInfo) /* 261 */ +/* Slot 261 is reserved */ #define Tcl_VarTraceInfo2 \ (tclStubsPtr->tcl_VarTraceInfo2) /* 262 */ #define Tcl_Write \ @@ -3139,30 +2965,22 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DumpActiveMemory) /* 265 */ #define Tcl_ValidateAllMemory \ (tclStubsPtr->tcl_ValidateAllMemory) /* 266 */ -#define Tcl_AppendResultVA \ - (tclStubsPtr->tcl_AppendResultVA) /* 267 */ -#define Tcl_AppendStringsToObjVA \ - (tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */ +/* Slot 267 is reserved */ +/* Slot 268 is reserved */ #define Tcl_HashStats \ (tclStubsPtr->tcl_HashStats) /* 269 */ #define Tcl_ParseVar \ (tclStubsPtr->tcl_ParseVar) /* 270 */ -#define Tcl_PkgPresent \ - (tclStubsPtr->tcl_PkgPresent) /* 271 */ +/* Slot 271 is reserved */ #define Tcl_PkgPresentEx \ (tclStubsPtr->tcl_PkgPresentEx) /* 272 */ -#define Tcl_PkgProvide \ - (tclStubsPtr->tcl_PkgProvide) /* 273 */ -#define Tcl_PkgRequire \ - (tclStubsPtr->tcl_PkgRequire) /* 274 */ -#define Tcl_SetErrorCodeVA \ - (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */ -#define Tcl_VarEvalVA \ - (tclStubsPtr->tcl_VarEvalVA) /* 276 */ +/* Slot 273 is reserved */ +/* Slot 274 is reserved */ +/* Slot 275 is reserved */ +/* Slot 276 is reserved */ #define Tcl_WaitPid \ (tclStubsPtr->tcl_WaitPid) /* 277 */ -#define Tcl_PanicVA \ - (tclStubsPtr->tcl_PanicVA) /* 278 */ +/* Slot 278 is reserved */ #define Tcl_GetVersion \ (tclStubsPtr->tcl_GetVersion) /* 279 */ #define Tcl_InitMemory \ @@ -3184,8 +3002,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */ #define Tcl_DeleteThreadExitHandler \ (tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */ -#define Tcl_DiscardResult \ - (tclStubsPtr->tcl_DiscardResult) /* 290 */ +/* Slot 290 is reserved */ #define Tcl_EvalEx \ (tclStubsPtr->tcl_EvalEx) /* 291 */ #define Tcl_EvalObjv \ @@ -3232,10 +3049,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_NumUtfChars) /* 312 */ #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ -#define Tcl_RestoreResult \ - (tclStubsPtr->tcl_RestoreResult) /* 314 */ -#define Tcl_SaveResult \ - (tclStubsPtr->tcl_SaveResult) /* 315 */ +/* Slot 314 is reserved */ +/* Slot 315 is reserved */ #define Tcl_SetSystemEncoding \ (tclStubsPtr->tcl_SetSystemEncoding) /* 316 */ #define Tcl_SetVar2Ex \ @@ -3286,10 +3101,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_WriteObj) /* 339 */ #define Tcl_GetString \ (tclStubsPtr->tcl_GetString) /* 340 */ -#define Tcl_GetDefaultEncodingDir \ - (tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */ -#define Tcl_SetDefaultEncodingDir \ - (tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */ +/* Slot 341 is reserved */ +/* Slot 342 is reserved */ #define Tcl_AlertNotifier \ (tclStubsPtr->tcl_AlertNotifier) /* 343 */ #define Tcl_ServiceModeHook \ @@ -3318,8 +3131,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */ #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ -#define Tcl_EvalTokens \ - (tclStubsPtr->tcl_EvalTokens) /* 357 */ +/* Slot 357 is reserved */ #define Tcl_FreeParse \ (tclStubsPtr->tcl_FreeParse) /* 358 */ #define Tcl_LogCommandInfo \ @@ -3368,8 +3180,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetCharLength) /* 380 */ #define Tcl_GetUniChar \ (tclStubsPtr->tcl_GetUniChar) /* 381 */ -#define Tcl_GetUnicode \ - (tclStubsPtr->tcl_GetUnicode) /* 382 */ +/* Slot 382 is reserved */ #define Tcl_GetRange \ (tclStubsPtr->tcl_GetRange) /* 383 */ #define Tcl_AppendUnicodeToObj \ @@ -3446,10 +3257,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */ #define Tcl_UniCharCaseMatch \ (tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */ -#define Tcl_FindHashEntry \ - (tclStubsPtr->tcl_FindHashEntry) /* 421 */ -#define Tcl_CreateHashEntry \ - (tclStubsPtr->tcl_CreateHashEntry) /* 422 */ +/* Slot 421 is reserved */ +/* Slot 422 is reserved */ #define Tcl_InitCustomHashTable \ (tclStubsPtr->tcl_InitCustomHashTable) /* 423 */ #define Tcl_InitObjHashTable \ @@ -3474,10 +3283,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #define Tcl_GetUnicodeFromObj \ (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ -#define Tcl_GetMathFuncInfo \ - (tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */ -#define Tcl_ListMathFuncs \ - (tclStubsPtr->tcl_ListMathFuncs) /* 436 */ +/* Slot 435 is reserved */ +/* Slot 436 is reserved */ #define Tcl_SubstObj \ (tclStubsPtr->tcl_SubstObj) /* 437 */ #define Tcl_DetachChannel \ @@ -3642,8 +3449,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ #define Tcl_FSEvalFileEx \ (tclStubsPtr->tcl_FSEvalFileEx) /* 518 */ -#define Tcl_SetExitProc \ - (tclStubsPtr->tcl_SetExitProc) /* 519 */ +/* Slot 519 is reserved */ #define Tcl_LimitAddHandler \ (tclStubsPtr->tcl_LimitAddHandler) /* 520 */ #define Tcl_LimitRemoveHandler \ @@ -3899,13 +3705,9 @@ extern const TclStubs *tclStubsPtr; #if defined(USE_TCL_STUBS) # undef Tcl_CreateInterp -# undef Tcl_FindExecutable # undef Tcl_GetStringResult # undef Tcl_Init -# undef Tcl_SetPanicProc -# undef Tcl_SetExitProc # undef Tcl_ObjSetVar2 -# undef Tcl_StaticPackage # define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp()) # define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp)) # define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp)) @@ -3916,7 +3718,7 @@ extern const TclStubs *tclStubsPtr; #if defined(_WIN32) && defined(UNICODE) # define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg))) # define Tcl_MainEx Tcl_MainExW - EXTERN void Tcl_MainExW(int argc, wchar_t **argv, + EXTERN TCL_NORETURN void Tcl_MainExW(int argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv); #endif @@ -3924,83 +3726,57 @@ extern const TclStubs *tclStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef Tcl_SeekOld -#undef Tcl_TellOld - -#undef Tcl_PkgPresent #define Tcl_PkgPresent(interp, name, version, exact) \ Tcl_PkgPresentEx(interp, name, version, exact, NULL) -#undef Tcl_PkgProvide #define Tcl_PkgProvide(interp, name, version) \ Tcl_PkgProvideEx(interp, name, version, NULL) -#undef Tcl_PkgRequire #define Tcl_PkgRequire(interp, name, version, exact) \ Tcl_PkgRequireEx(interp, name, version, exact, NULL) -#undef Tcl_GetIndexFromObj #define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \ sizeof(char *), msg, flags, indexPtr) -#undef Tcl_NewBooleanObj #define Tcl_NewBooleanObj(boolValue) \ Tcl_NewWideIntObj((boolValue)!=0) -#undef Tcl_DbNewBooleanObj #define Tcl_DbNewBooleanObj(boolValue, file, line) \ Tcl_DbNewWideIntObj((boolValue)!=0, file, line) -#undef Tcl_SetBooleanObj #define Tcl_SetBooleanObj(objPtr, boolValue) \ Tcl_SetWideIntObj(objPtr, (boolValue)!=0) -#undef Tcl_SetVar #define Tcl_SetVar(interp, varName, newValue, flags) \ Tcl_SetVar2(interp, varName, NULL, newValue, flags) -#undef Tcl_UnsetVar #define Tcl_UnsetVar(interp, varName, flags) \ Tcl_UnsetVar2(interp, varName, NULL, flags) -#undef Tcl_GetVar #define Tcl_GetVar(interp, varName, flags) \ Tcl_GetVar2(interp, varName, NULL, flags) -#undef Tcl_TraceVar #define Tcl_TraceVar(interp, varName, flags, proc, clientData) \ Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData) -#undef Tcl_UntraceVar #define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData) -#undef Tcl_VarTraceInfo #define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \ Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData) -#undef Tcl_UpVar #define Tcl_UpVar(interp, frameName, varName, localName, flags) \ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) -#undef Tcl_AddErrorInfo #define Tcl_AddErrorInfo(interp, message) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1)) -#undef Tcl_AddObjErrorInfo #define Tcl_AddObjErrorInfo(interp, message, length) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length)) -#ifdef TCL_NO_DEPRECATED -#undef Tcl_Eval #define Tcl_Eval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, 0) -#undef Tcl_GlobalEval #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL) -#undef Tcl_SaveResult #define Tcl_SaveResult(interp, statePtr) \ do { \ - (statePtr)->objResultPtr = Tcl_GetObjResult(interp); \ - Tcl_IncrRefCount((statePtr)->objResultPtr); \ + *(statePtr) = Tcl_GetObjResult(interp); \ + Tcl_IncrRefCount(*(statePtr)); \ Tcl_SetObjResult(interp, Tcl_NewObj()); \ } while(0) -#undef Tcl_RestoreResult #define Tcl_RestoreResult(interp, statePtr) \ do { \ Tcl_ResetResult(interp); \ - Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \ - Tcl_DecrRefCount((statePtr)->objResultPtr); \ + Tcl_SetObjResult(interp, *(statePtr)); \ + Tcl_DecrRefCount(*(statePtr)); \ } while(0) -#undef Tcl_DiscardResult #define Tcl_DiscardResult(statePtr) \ - Tcl_DecrRefCount((statePtr)->objResultPtr) -#undef Tcl_SetResult + Tcl_DecrRefCount(*(statePtr)) #define Tcl_SetResult(interp, result, freeProc) \ do { \ char *__result = result; \ @@ -4008,13 +3784,12 @@ extern const TclStubs *tclStubsPtr; Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \ if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \ if (__freeProc == TCL_DYNAMIC) { \ - ckfree(__result); \ + Tcl_Free(__result); \ } else { \ (*__freeProc)(__result); \ } \ } \ } while(0) -#endif /* TCL_NO_DEPRECATED */ #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) # if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG) @@ -4028,10 +3803,6 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_GetLongFromObj # undef Tcl_ExprLong # undef Tcl_ExprLongObj -# undef Tcl_UniCharNcmp -# undef Tcl_UtfNcmp -# undef Tcl_UtfNcasecmp -# undef Tcl_UniCharNcasecmp # define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj) # define Tcl_ExprLong TclExprLong static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){ @@ -4047,39 +3818,77 @@ extern const TclStubs *tclStubsPtr; if (result == TCL_OK) *ptr = (long)intValue; return result; } -# define Tcl_UniCharNcmp(ucs,uct,n) \ - ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n)) -# define Tcl_UtfNcmp(s1,s2,n) \ - ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n)) -# define Tcl_UtfNcasecmp(s1,s2,n) \ - ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n)) -# define Tcl_UniCharNcasecmp(ucs,uct,n) \ - ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) # endif #endif -#undef Tcl_NewLongObj +#ifdef TCL_MEM_DEBUG +# undef Tcl_Alloc +# define Tcl_Alloc(x) \ + (Tcl_DbCkalloc((x), __FILE__, __LINE__)) +# undef Tcl_Free +# define Tcl_Free(x) \ + Tcl_DbCkfree((x), __FILE__, __LINE__) +# undef Tcl_Realloc +# define Tcl_Realloc(x,y) \ + (Tcl_DbCkrealloc((x), (y), __FILE__, __LINE__)) +# undef Tcl_AttemptAlloc +# define Tcl_AttemptAlloc(x) \ + (Tcl_AttemptDbCkalloc((x), __FILE__, __LINE__)) +# undef Tcl_AttemptRealloc +# define Tcl_AttemptRealloc(x,y) \ + (Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__)) +#endif /* !TCL_MEM_DEBUG */ + #define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value)) -#undef Tcl_NewIntObj #define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value)) -#undef Tcl_DbNewLongObj #define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line) -#undef Tcl_SetIntObj #define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (int)(value)) -#undef Tcl_SetLongObj #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) -#undef Tcl_GetUnicode #define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL) /* * Deprecated Tcl procedures: */ -#undef Tcl_EvalObj #define Tcl_EvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, 0) -#undef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) +#if defined(TCL_8_COMPAT) && !defined(BUILD_tcl) +# ifdef USE_TCL_STUBS +# undef Tcl_Gets +# undef Tcl_GetsObj +# undef Tcl_Read +# undef Tcl_Ungets +# undef Tcl_Write +# undef Tcl_ReadChars +# undef Tcl_WriteChars +# undef Tcl_WriteObj +# undef Tcl_ReadRaw +# undef Tcl_WriteRaw +# define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_Gets)(chan, dsPtr)+1))-1) +# define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_GetsObj)(chan, objPtr)+1))-1) +# define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((tclStubsPtr->tcl_Read)(chan, bufPtr, toRead)+1))-1) +# define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((tclStubsPtr->tcl_Ungets)(chan, str, len, atHead)+1))-1) +# define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((tclStubsPtr->tcl_Write)(chan, s, slen)+1))-1) +# define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1) +# define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteChars)(chan, src, srcLen)+1))-1) +# define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteObj)(chan, objPtr)+1))-1) +# define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1) +# define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteRaw()(chan, src, srcLen)+1))-1) +# else +# define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((Tcl_Gets)(chan, dsPtr)+1))-1) +# define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((Tcl_GetsObj)(chan, objPtr)+1))-1) +# define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((Tcl_Read)(chan, bufPtr, toRead)+1))-1) +# define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((Tcl_Ungets)(chan, str, len, atHead)+1))-1) +# define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((Tcl_Write)(chan, s, slen)+1))-1) +# define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((Tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1) +# define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteChars)(chan, src, srcLen)+1))-1) +# define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((Tcl_WriteObj)(chan, objPtr)+1))-1) +# define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((Tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1) +# define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteRaw()(chan, src, srcLen)+1))-1) +# endif +#endif + #endif /* _TCLDECLS */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 629a3f0..9462581 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -65,7 +65,7 @@ static void FreeDictInternalRep(Tcl_Obj *dictPtr); static void InvalidateDictChain(Tcl_Obj *dictObj); static int SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDict(Tcl_Obj *dictPtr); -static Tcl_HashEntry * AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr); +static Tcl_HashEntry * AllocChainEntry(Tcl_HashTable *tablePtr, void *keyPtr); static inline void InitChainTable(struct Dict *dict); static inline void DeleteChainTable(struct Dict *dict); static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict, @@ -142,7 +142,7 @@ typedef struct Dict { * the dictionary. Used for doing traversal of * the entries in the order that they are * created. */ - unsigned int epoch; /* Epoch counter */ + size_t epoch; /* Epoch counter */ size_t refCount; /* Reference counter (see above) */ Tcl_Obj *chain; /* Linked list used for invalidating the * string representations of updated nested @@ -238,13 +238,13 @@ AllocChainEntry( Tcl_HashTable *tablePtr, void *keyPtr) { - Tcl_Obj *objPtr = keyPtr; + Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; ChainEntry *cPtr; - cPtr = ckalloc(sizeof(ChainEntry)); + cPtr = Tcl_Alloc(sizeof(ChainEntry)); cPtr->entry.key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); - cPtr->entry.clientData = NULL; + Tcl_SetHashValue(&cPtr->entry, NULL); cPtr->prevPtr = cPtr->nextPtr = NULL; return &cPtr->entry; @@ -372,7 +372,7 @@ DupDictInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { - Dict *oldDict, *newDict = ckalloc(sizeof(Dict)); + Dict *oldDict, *newDict = Tcl_Alloc(sizeof(Dict)); ChainEntry *cPtr; DictGetIntRep(srcPtr, oldDict); @@ -467,7 +467,7 @@ DeleteDict( Dict *dict) { DeleteChainTable(dict); - ckfree(dict); + Tcl_Free(dict); } /* @@ -501,7 +501,7 @@ UpdateStringOfDict( Dict *dict; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; - int i, length, bytesNeeded = 0; + size_t i, length, bytesNeeded = 0; const char *elem; char *dst; @@ -510,7 +510,7 @@ UpdateStringOfDict( * is not exposed by any API function... */ - int numElems; + size_t numElems; DictGetIntRep(dictPtr, dict); @@ -531,7 +531,7 @@ UpdateStringOfDict( if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; } else { - flagPtr = ckalloc(numElems); + flagPtr = Tcl_Alloc(numElems); } for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) { /* @@ -541,22 +541,14 @@ UpdateStringOfDict( flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); - elem = TclGetStringFromObj(keyPtr, &length); + elem = TclGetString(keyPtr); + length = keyPtr->length; bytesNeeded += TclScanElement(elem, length, flagPtr+i); - if (bytesNeeded < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - flagPtr[i+1] = TCL_DONT_QUOTE_HASH; valuePtr = Tcl_GetHashValue(&cPtr->entry); - elem = TclGetStringFromObj(valuePtr, &length); + elem = TclGetString(valuePtr); + length = valuePtr->length; bytesNeeded += TclScanElement(elem, length, flagPtr+i+1); - if (bytesNeeded < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - } - if (bytesNeeded > INT_MAX - numElems + 1) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems; @@ -569,20 +561,22 @@ UpdateStringOfDict( for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); - elem = TclGetStringFromObj(keyPtr, &length); + elem = TclGetString(keyPtr); + length = keyPtr->length; dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; flagPtr[i+1] |= TCL_DONT_QUOTE_HASH; valuePtr = Tcl_GetHashValue(&cPtr->entry); - elem = TclGetStringFromObj(valuePtr, &length); + elem = TclGetString(valuePtr); + length = valuePtr->length; dst += TclConvertElement(elem, length, dst, flagPtr[i+1]); *dst++ = ' '; } (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); if (flagPtr != localFlags) { - ckfree(flagPtr); + Tcl_Free(flagPtr); } } @@ -613,7 +607,7 @@ SetDictFromAny( { Tcl_HashEntry *hPtr; int isNew; - Dict *dict = ckalloc(sizeof(Dict)); + Dict *dict = Tcl_Alloc(sizeof(Dict)); InitChainTable(dict); @@ -654,14 +648,15 @@ SetDictFromAny( Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */ } } else { - int length; + size_t length; const char *nextElem = TclGetStringFromObj(objPtr, &length); const char *limit = (nextElem + length); while (nextElem < limit) { Tcl_Obj *keyPtr, *valuePtr; const char *elemStart; - int elemSize, literal; + size_t elemSize; + int literal; if (TclFindDictElement(interp, nextElem, (limit - nextElem), &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) { @@ -741,7 +736,7 @@ SetDictFromAny( } errorInFindDictElement: DeleteChainTable(dict); - ckfree(dict); + Tcl_Free(dict); return TCL_ERROR; } @@ -1419,7 +1414,7 @@ Tcl_NewDictObj(void) TclNewObj(dictPtr); TclInvalidateStringRep(dictPtr); - dict = ckalloc(sizeof(Dict)); + dict = Tcl_Alloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 1; dict->chain = NULL; @@ -1467,7 +1462,7 @@ Tcl_DbNewDictObj( TclDbNewObj(dictPtr, file, line); TclInvalidateStringRep(dictPtr); - dict = ckalloc(sizeof(Dict)); + dict = Tcl_Alloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 1; dict->chain = NULL; @@ -2068,7 +2063,7 @@ DictInfoCmd( statsStr = Tcl_HashStats(&dict->table); Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); - ckfree(statsStr); + Tcl_Free(statsStr); return TCL_OK; } diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 027683d..9847b6b 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -195,10 +195,10 @@ TclPrintObject( FILE *outFile, /* The file to print the source to. */ Tcl_Obj *objPtr, /* Points to the Tcl object whose string * representation should be printed. */ - int maxChars) /* Maximum number of chars to print. */ + size_t maxChars) /* Maximum number of chars to print. */ { char *bytes; - int length; + size_t length; bytes = TclGetStringFromObj(objPtr, &length); TclPrintSource(outFile, bytes, TclMin(length, maxChars)); @@ -226,7 +226,7 @@ void TclPrintSource( FILE *outFile, /* The file to print the source to. */ const char *stringPtr, /* The string to print. */ - int maxChars) /* Maximum number of chars to print. */ + size_t maxChars) /* Maximum number of chars to print. */ { Tcl_Obj *bufferObj; @@ -280,9 +280,8 @@ DisassembleByteCodeObj( */ Tcl_AppendPrintfToObj(bufferObj, - "ByteCode %p, refCt %u, epoch %u, interp %p (epoch %u)\n", - codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, - iPtr->compileEpoch); + "ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n", + codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); Tcl_AppendToObj(bufferObj, " Source ", -1); PrintSourceToObj(bufferObj, codePtr->source, TclMin(codePtr->numSrcBytes, 55)); @@ -325,7 +324,7 @@ DisassembleByteCodeObj( int numCompiledLocals = procPtr->numCompiledLocals; Tcl_AppendPrintfToObj(bufferObj, - " Proc %p, refCt %u, args %d, compiled locals %d\n", + " Proc %p, refCt %" TCL_Z_MODIFIER "u, args %d, compiled locals %d\n", procPtr, procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { @@ -409,7 +408,7 @@ DisassembleByteCodeObj( srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; for (i = 0; i < numCmds; i++) { - if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { + if (*codeDeltaNext == 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; @@ -419,7 +418,7 @@ DisassembleByteCodeObj( } codeOffset += delta; - if ((unsigned) *codeLengthNext == (unsigned) 0xFF) { + if (*codeLengthNext == 0xFF) { codeLengthNext++; codeLen = TclGetInt4AtPtr(codeLengthNext); codeLengthNext += 4; @@ -428,7 +427,7 @@ DisassembleByteCodeObj( codeLengthNext++; } - if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { + if (*srcDeltaNext == 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -438,7 +437,7 @@ DisassembleByteCodeObj( } srcOffset += delta; - if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { + if (*srcLengthNext == 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -468,7 +467,7 @@ DisassembleByteCodeObj( codeOffset = srcOffset = 0; pc = codeStart; for (i = 0; i < numCmds; i++) { - if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { + if (*codeDeltaNext == 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; @@ -478,7 +477,7 @@ DisassembleByteCodeObj( } codeOffset += delta; - if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { + if (*srcDeltaNext == 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -488,7 +487,7 @@ DisassembleByteCodeObj( } srcOffset += delta; - if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { + if (*srcLengthNext == 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -568,7 +567,7 @@ FormatInstruction( break; case OPERAND_UINT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_UINT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; @@ -576,7 +575,7 @@ FormatInstruction( sprintf(suffixBuffer+strlen(suffixBuffer), ", %u cmds start here", opnd); } - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_OFFSET1: opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; @@ -595,16 +594,16 @@ FormatInstruction( case OPERAND_LIT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; suffixObj = codePtr->objArrayPtr[opnd]; - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_LIT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; suffixObj = codePtr->objArrayPtr[opnd]; - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_AUX4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); auxPtr = &codePtr->auxDataArrayPtr[opnd]; break; case OPERAND_IDX4: @@ -628,19 +627,19 @@ FormatInstruction( if (localPtr != NULL) { if (opnd >= localCt) { Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)", - (unsigned) opnd, localCt); + opnd, localCt); } for (j = 0; j < opnd; j++) { localPtr = localPtr->nextPtr; } if (TclIsVarTemporary(localPtr)) { - sprintf(suffixBuffer, "temp var %u", (unsigned) opnd); + sprintf(suffixBuffer, "temp var %u", opnd); } else { sprintf(suffixBuffer, "var "); suffixSrc = localPtr->name; } } - Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", opnd); break; case OPERAND_SCLS1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; @@ -654,7 +653,7 @@ FormatInstruction( } if (suffixObj) { const char *bytes; - int length; + size_t length; Tcl_AppendToObj(bufferObj, "\t# ", -1); bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length); @@ -837,11 +836,11 @@ UpdateStringOfInstName( if (inst > LAST_INST_OPCODE) { dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); TclOOM(dst, TCL_INTEGER_SPACE + 5); - sprintf(dst, "inst_%" TCL_Z_MODIFIER "d", inst); + sprintf(dst, "inst_%" TCL_Z_MODIFIER "u", inst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { const char *s = tclInstructionTable[inst].name; - unsigned int len = strlen(s); + size_t len = strlen(s); dst = Tcl_InitStringRep(objPtr, s, len); TclOOM(dst, len); } diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index e601c3a..6abefa9 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -610,14 +610,14 @@ TclInitEncodingSubsystem(void) * code to duplicate the structure of a table encoding here. */ - dataPtr = ckalloc(sizeof(TableEncodingData)); + dataPtr = Tcl_Alloc(sizeof(TableEncodingData)); memset(dataPtr, 0, sizeof(TableEncodingData)); dataPtr->fallback = '?'; size = 256*(sizeof(unsigned short *) + sizeof(unsigned short)); - dataPtr->toUnicode = ckalloc(size); + dataPtr->toUnicode = Tcl_Alloc(size); memset(dataPtr->toUnicode, 0, size); - dataPtr->fromUnicode = ckalloc(size); + dataPtr->fromUnicode = Tcl_Alloc(size); memset(dataPtr->fromUnicode, 0, size); dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256); @@ -694,70 +694,6 @@ TclFinalizeEncodingSubsystem(void) /* *------------------------------------------------------------------------- * - * Tcl_GetDefaultEncodingDir -- - * - * Legacy public interface to retrieve first directory in the encoding - * searchPath. - * - * Results: - * The directory pathname, as a string, or NULL for an empty encoding - * search path. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -const char * -Tcl_GetDefaultEncodingDir(void) -{ - int numDirs; - Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); - - Tcl_ListObjLength(NULL, searchPath, &numDirs); - if (numDirs == 0) { - return NULL; - } - Tcl_ListObjIndex(NULL, searchPath, 0, &first); - - return TclGetString(first); -} - -/* - *------------------------------------------------------------------------- - * - * Tcl_SetDefaultEncodingDir -- - * - * Legacy public interface to set the first directory in the encoding - * search path. - * - * Results: - * None. - * - * Side effects: - * Modifies the encoding search path. - * - *------------------------------------------------------------------------- - */ - -void -Tcl_SetDefaultEncodingDir( - const char *path) -{ - Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath(); - Tcl_Obj *directory = Tcl_NewStringObj(path, -1); - - searchPath = Tcl_DuplicateObj(searchPath); - Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); - Tcl_SetEncodingSearchPath(searchPath); -} -#endif - -/* - *------------------------------------------------------------------------- - * * Tcl_GetEncoding -- * * Given the name of a encoding, find the corresponding Tcl_Encoding @@ -870,9 +806,9 @@ FreeEncoding( Tcl_DeleteHashEntry(encodingPtr->hPtr); } if (encodingPtr->name) { - ckfree(encodingPtr->name); + Tcl_Free(encodingPtr->name); } - ckfree(encodingPtr); + Tcl_Free(encodingPtr); } } @@ -1060,7 +996,7 @@ Tcl_CreateEncoding( const Tcl_EncodingType *typePtr) /* The encoding type. */ { - Encoding *encodingPtr = ckalloc(sizeof(Encoding)); + Encoding *encodingPtr = Tcl_Alloc(sizeof(Encoding)); encodingPtr->name = NULL; encodingPtr->toUtfProc = typePtr->toUtfProc; encodingPtr->fromUtfProc = typePtr->fromUtfProc; @@ -1092,7 +1028,7 @@ Tcl_CreateEncoding( replaceMe->hPtr = NULL; } - name = ckalloc(strlen(typePtr->encodingName) + 1); + name = Tcl_Alloc(strlen(typePtr->encodingName) + 1); encodingPtr->name = strcpy(name, typePtr->encodingName); encodingPtr->hPtr = hPtr; Tcl_SetHashValue(hPtr, encodingPtr); @@ -1128,7 +1064,7 @@ Tcl_ExternalToUtfDString( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - int srcLen, /* Source string length in bytes, or < 0 for + size_t srcLen, /* Source string length in bytes, or -1 for * encoding-specific string length. */ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the * converted string is stored. */ @@ -1136,7 +1072,8 @@ Tcl_ExternalToUtfDString( char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; - int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars; + int flags, result, soFar, srcRead, dstWrote, dstChars; + size_t dstLen; Tcl_DStringInit(dstPtr); dst = Tcl_DStringValue(dstPtr); @@ -1149,7 +1086,7 @@ Tcl_ExternalToUtfDString( if (src == NULL) { srcLen = 0; - } else if (srcLen < 0) { + } else if (srcLen == TCL_AUTO_LENGTH) { srcLen = encodingPtr->lengthProc(src); } @@ -1201,8 +1138,8 @@ Tcl_ExternalToUtf( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - int srcLen, /* Source string length in bytes, or < 0 for - * encoding-specific string length. */ + size_t srcLen, /* Source string length in bytes, or -1 + * for encoding-specific string length. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise @@ -1211,7 +1148,7 @@ Tcl_ExternalToUtf( * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ - int dstLen, /* The maximum length of output buffer in + size_t dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may @@ -1239,7 +1176,7 @@ Tcl_ExternalToUtf( if (src == NULL) { srcLen = 0; - } else if (srcLen < 0) { + } else if (srcLen == TCL_AUTO_LENGTH) { srcLen = encodingPtr->lengthProc(src); } if (statePtr == NULL) { @@ -1318,7 +1255,7 @@ Tcl_UtfToExternalDString( Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ - int srcLen, /* Source string length in bytes, or < 0 for + size_t srcLen, /* Source string length in bytes, or -1 for * strlen(). */ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the * converted string is stored. */ @@ -1326,7 +1263,8 @@ Tcl_UtfToExternalDString( char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; - int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars; + int flags, result, soFar, srcRead, dstWrote, dstChars; + size_t dstLen; Tcl_DStringInit(dstPtr); dst = Tcl_DStringValue(dstPtr); @@ -1339,7 +1277,7 @@ Tcl_UtfToExternalDString( if (src == NULL) { srcLen = 0; - } else if (srcLen < 0) { + } else if (srcLen == TCL_AUTO_LENGTH) { srcLen = strlen(src); } flags = TCL_ENCODING_START | TCL_ENCODING_END; @@ -1393,8 +1331,8 @@ Tcl_UtfToExternal( Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ - int srcLen, /* Source string length in bytes, or < 0 for - * strlen(). */ + size_t srcLen, /* Source string length in bytes, or -1 + * for strlen(). */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise @@ -1403,7 +1341,7 @@ Tcl_UtfToExternal( * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string * is stored. */ - int dstLen, /* The maximum length of output buffer in + size_t dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may @@ -1428,7 +1366,7 @@ Tcl_UtfToExternal( if (src == NULL) { srcLen = 0; - } else if (srcLen < 0) { + } else if (srcLen == TCL_AUTO_LENGTH) { srcLen = strlen(src); } if (statePtr == NULL) { @@ -1760,7 +1698,7 @@ LoadTableEncoding( #undef PAGESIZE #define PAGESIZE (256 * sizeof(unsigned short)) - dataPtr = ckalloc(sizeof(TableEncodingData)); + dataPtr = Tcl_Alloc(sizeof(TableEncodingData)); memset(dataPtr, 0, sizeof(TableEncodingData)); dataPtr->fallback = fallback; @@ -1772,7 +1710,7 @@ LoadTableEncoding( */ size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE; - dataPtr->toUnicode = ckalloc(size); + dataPtr->toUnicode = Tcl_Alloc(size); memset(dataPtr->toUnicode, 0, size); pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256); @@ -1781,7 +1719,7 @@ LoadTableEncoding( for (i = 0; i < numPages; i++) { int ch; const char *p; - int expected = 3 + 16 * (16 * 4 + 1); + size_t expected = 3 + 16 * (16 * 4 + 1); if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) { return NULL; @@ -1833,7 +1771,7 @@ LoadTableEncoding( } } size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE; - dataPtr->fromUnicode = ckalloc(size); + dataPtr->fromUnicode = Tcl_Alloc(size); memset(dataPtr->fromUnicode, 0, size); pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256); @@ -1929,7 +1867,7 @@ LoadTableEncoding( */ for (TclDStringClear(&lineString); - (len = Tcl_Gets(chan, &lineString)) >= 0; + (len = Tcl_Gets(chan, &lineString)) != -1; TclDStringClear(&lineString)) { const unsigned char *p; int to, from; @@ -2023,7 +1961,7 @@ LoadEscapeEncoding( Tcl_DString lineString; Tcl_DStringInit(&lineString); - if (Tcl_Gets(chan, &lineString) < 0) { + if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) { break; } line = Tcl_DStringValue(&lineString); @@ -2065,17 +2003,17 @@ LoadEscapeEncoding( Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est)); } } - ckfree(argv); + Tcl_Free(argv); Tcl_DStringFree(&lineString); } size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable) + Tcl_DStringLength(&escapeData); - dataPtr = ckalloc(size); + dataPtr = Tcl_Alloc(size); dataPtr->initLen = strlen(init); - memcpy(dataPtr->init, init, (unsigned) dataPtr->initLen + 1); + memcpy(dataPtr->init, init, dataPtr->initLen + 1); dataPtr->finalLen = strlen(final); - memcpy(dataPtr->final, final, (unsigned) dataPtr->finalLen + 1); + memcpy(dataPtr->final, final, dataPtr->finalLen + 1); dataPtr->numSubTables = Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable); memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData), @@ -2167,7 +2105,7 @@ BinaryProc( *srcReadPtr = srcLen; *dstWrotePtr = srcLen; *dstCharsPtr = srcLen; - memcpy(dst, src, (size_t) srcLen); + memcpy(dst, src, srcLen); return result; } @@ -3065,11 +3003,11 @@ TableFreeProc( * Make sure we aren't freeing twice on shutdown. [Bug 219314] */ - ckfree(dataPtr->toUnicode); + Tcl_Free(dataPtr->toUnicode); dataPtr->toUnicode = NULL; - ckfree(dataPtr->fromUnicode); + Tcl_Free(dataPtr->fromUnicode); dataPtr->fromUnicode = NULL; - ckfree(dataPtr); + Tcl_Free(dataPtr); } /* @@ -3364,7 +3302,7 @@ EscapeFromUtfProc( *dstWrotePtr = 0; return TCL_CONVERT_NOSPACE; } - memcpy(dst, dataPtr->init, (size_t)dataPtr->initLen); + memcpy(dst, dataPtr->init, dataPtr->initLen); dst += dataPtr->initLen; } else { state = PTR2INT(*statePtr); @@ -3442,8 +3380,7 @@ EscapeFromUtfProc( result = TCL_CONVERT_NOSPACE; break; } - memcpy(dst, subTablePtr->sequence, - (size_t) subTablePtr->sequenceLen); + memcpy(dst, subTablePtr->sequence, subTablePtr->sequenceLen); dst += subTablePtr->sequenceLen; } } @@ -3486,7 +3423,7 @@ EscapeFromUtfProc( memcpy(dst, dataPtr->subTables[0].sequence, len); dst += len; } - memcpy(dst, dataPtr->final, (size_t) dataPtr->finalLen); + memcpy(dst, dataPtr->final, dataPtr->finalLen); dst += dataPtr->finalLen; state &= ~TCL_ENCODING_END; } @@ -3548,7 +3485,7 @@ EscapeFreeProc( subTablePtr++; } } - ckfree(dataPtr); + Tcl_Free(dataPtr); } /* @@ -3649,7 +3586,7 @@ unilen( static void InitializeEncodingSearchPath( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { const char *bytes; @@ -3686,7 +3623,7 @@ InitializeEncodingSearchPath( bytes = TclGetString(searchPathObj); *lengthPtr = searchPathObj->length; - *valuePtr = ckalloc(*lengthPtr + 1); + *valuePtr = Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, bytes, *lengthPtr + 1); Tcl_DecrRefCount(searchPathObj); } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 73e3ce7..ef3b0cf 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -105,7 +105,7 @@ static const Tcl_ObjType ensembleCmdType = { */ typedef struct { - unsigned int epoch; /* Used to confirm when the data in this + size_t epoch; /* Used to confirm when the data in this * really structure matches up with the * ensemble. */ Command *token; /* Reference to the command for which this @@ -675,12 +675,12 @@ TclCreateEnsembleInNs( EnsembleConfig *ensemblePtr; Tcl_Command token; - ensemblePtr = ckalloc(sizeof(EnsembleConfig)); + ensemblePtr = Tcl_Alloc(sizeof(EnsembleConfig)); token = TclNRCreateCommandInNs(interp, name, (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd, NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig); if (token == NULL) { - ckfree(ensemblePtr); + Tcl_Free(ensemblePtr); return NULL; } @@ -1645,7 +1645,7 @@ TclMakeEnsemble( Tcl_DStringFree(&buf); Tcl_DStringFree(&hiddenBuf); if (nameParts != NULL) { - ckfree(nameParts); + Tcl_Free(nameParts); } return ensemble; } @@ -1701,7 +1701,7 @@ NsEnsembleImplementationCmdNR( int reparseCount = 0; /* Number of reparses. */ Tcl_Obj *errorObj; /* Used for building error messages. */ Tcl_Obj *subObj; - int subIdx; + size_t subIdx; /* * Must recheck objc, since numParameters might have changed. Cf. test @@ -1710,7 +1710,7 @@ NsEnsembleImplementationCmdNR( restartEnsembleParse: subIdx = 1 + ensemblePtr->numParameters; - if (objc < subIdx + 1) { + if ((size_t)objc < subIdx + 1) { /* * We don't have a subcommand argument. Make error message. */ @@ -1807,15 +1807,16 @@ NsEnsembleImplementationCmdNR( * it (will be an error for a non-unique * prefix). */ char *fullName = NULL; /* Full name of the subcommand. */ - int stringLength, i; - int tableLength = ensemblePtr->subcommandTable.numEntries; + size_t stringLength, i; + size_t tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; - subcmdName = TclGetStringFromObj(subObj, &stringLength); + subcmdName = TclGetString(subObj); + stringLength = subObj->length; for (i=0 ; i<tableLength ; i++) { register int cmp = strncmp(subcmdName, ensemblePtr->subcommandArrayPtr[i], - (unsigned) stringLength); + stringLength); if (cmp == 0) { if (fullName != NULL) { @@ -1972,7 +1973,7 @@ NsEnsembleImplementationCmdNR( if (ensemblePtr->subcommandTable.numEntries == 1) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1); } else { - int i; + size_t i; for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1); @@ -2017,8 +2018,8 @@ TclClearRootEnsemble( int TclInitRewriteEnsemble( Tcl_Interp *interp, - int numRemoved, - int numInserted, + size_t numRemoved, + size_t numInserted, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -2030,7 +2031,7 @@ TclInitRewriteEnsemble( iPtr->ensembleRewrite.numRemovedObjs = numRemoved; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { - int numIns = iPtr->ensembleRewrite.numInsertedObjs; + size_t numIns = iPtr->ensembleRewrite.numInsertedObjs; if (numIns < numRemoved) { iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns; @@ -2100,8 +2101,8 @@ FreeER( Tcl_Obj **tmp = (Tcl_Obj **) data[0]; Tcl_Obj **store = (Tcl_Obj **) data[1]; - ckfree(store); - ckfree(tmp); + Tcl_Free(store); + Tcl_Free(tmp); return result; } @@ -2110,15 +2111,15 @@ TclSpellFix( Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, - int badIdx, + size_t badIdx, Tcl_Obj *bad, Tcl_Obj *fix) { Interp *iPtr = (Interp *) interp; Tcl_Obj *const *search; Tcl_Obj **store; - int idx; - int size; + size_t idx; + size_t size; if (iPtr->ensembleRewrite.sourceObjs == NULL) { iPtr->ensembleRewrite.sourceObjs = objv; @@ -2176,9 +2177,9 @@ TclSpellFix( if (search[0] == NULL) { store = (Tcl_Obj **) search[2]; } else { - Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *)); + Tcl_Obj **tmp = Tcl_Alloc(3 * sizeof(Tcl_Obj *)); - store = ckalloc(size * sizeof(Tcl_Obj *)); + store = Tcl_Alloc(size * sizeof(Tcl_Obj *)); memcpy(store, iPtr->ensembleRewrite.sourceObjs, size * sizeof(Tcl_Obj *)); @@ -2418,7 +2419,7 @@ MakeCachedEnsembleCommand( * our own. */ - ensembleCmd = ckalloc(sizeof(EnsembleCmdRep)); + ensembleCmd = Tcl_Alloc(sizeof(EnsembleCmdRep)); ECRSetIntRep(objPtr, ensembleCmd); } @@ -2471,7 +2472,7 @@ ClearTable( Tcl_DecrRefCount(prefixObj); hPtr = Tcl_NextHashEntry(&search); } - ckfree((char *) ensemblePtr->subcommandArrayPtr); + Tcl_Free(ensemblePtr->subcommandArrayPtr); } Tcl_DeleteHashTable(hash); } @@ -2568,7 +2569,8 @@ BuildEnsembleConfig( Tcl_HashSearch search; /* Used for scanning the set of commands in * the namespace that backs up this * ensemble. */ - int i, j, isNew; + size_t i, j; + int isNew; Tcl_HashTable *hash = &ensemblePtr->subcommandTable; Tcl_HashEntry *hPtr; Tcl_Obj *mapDict = ensemblePtr->subcommandDict; @@ -2594,7 +2596,7 @@ BuildEnsembleConfig( * as the dict mapping to targets. */ - for (i = 0; i < subc; i += 2) { + for (i = 0; i < (size_t)subc; i += 2) { name = TclGetString(subv[i]); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); if (!isNew) { @@ -2618,7 +2620,7 @@ BuildEnsembleConfig( * Usual case where we can freely act on the list and dict. */ - for (i = 0; i < subc; i++) { + for (i = 0; i < (size_t)subc; i++) { name = TclGetString(subv[i]); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); if (!isNew) { @@ -2736,7 +2738,7 @@ BuildEnsembleConfig( */ ensemblePtr->subcommandArrayPtr = - ckalloc(sizeof(char *) * hash->numEntries); + Tcl_Alloc(sizeof(char *) * hash->numEntries); /* * Fill array from both ends as this makes us less likely to end up with @@ -2769,7 +2771,7 @@ BuildEnsembleConfig( hPtr = Tcl_NextHashEntry(&search); } if (hash->numEntries > 1) { - qsort(ensemblePtr->subcommandArrayPtr, (unsigned) hash->numEntries, + qsort(ensemblePtr->subcommandArrayPtr, hash->numEntries, sizeof(char *), NsEnsembleStringOrder); } } @@ -2830,7 +2832,7 @@ FreeEnsembleCmdRep( if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); } - ckfree(ensembleCmd); + Tcl_Free(ensembleCmd); } /* @@ -2857,7 +2859,7 @@ DupEnsembleCmdRep( Tcl_Obj *copyPtr) { EnsembleCmdRep *ensembleCmd; - EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep)); + EnsembleCmdRep *ensembleCopy = Tcl_Alloc(sizeof(EnsembleCmdRep)); ECRGetIntRep(objPtr, ensembleCmd); ECRSetIntRep(copyPtr, ensembleCopy); @@ -2909,7 +2911,7 @@ TclCompileEnsemble( Command *oldCmdPtr = cmdPtr, *newCmdPtr; int len, result, flags = 0, i, depth = 1, invokeAnyway = 0; int ourResult = TCL_ERROR; - unsigned numBytes; + size_t numBytes; const char *word; DefineLineInformation; @@ -2979,7 +2981,7 @@ TclCompileEnsemble( (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj); if (listObj != NULL) { - int sclen; + size_t sclen; const char *str; Tcl_Obj *matchObj = NULL; @@ -2988,7 +2990,7 @@ TclCompileEnsemble( } for (i=0 ; i<len ; i++) { str = TclGetStringFromObj(elems[i], &sclen); - if ((sclen == (int) numBytes) && !memcmp(word, str, numBytes)) { + if ((sclen == numBytes) && !memcmp(word, str, numBytes)) { /* * Exact match! Excellent! */ @@ -3035,7 +3037,7 @@ TclCompileEnsemble( * No map, so check the dictionary directly. */ - TclNewStringObj(subcmdObj, word, (int) numBytes); + TclNewStringObj(subcmdObj, word, numBytes); result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj); if (result == TCL_OK && targetCmdObj != NULL) { /* @@ -3176,7 +3178,7 @@ TclCompileEnsemble( while (mapPtr->nuloc - 1 > eclIndex) { mapPtr->nuloc--; - ckfree(mapPtr->loc[mapPtr->nuloc].line); + Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); mapPtr->loc[mapPtr->nuloc].line = NULL; } @@ -3351,7 +3353,7 @@ TclAttemptCompileProc( if (diff != 1) { Tcl_Panic("bad stack adjustment when compiling" - " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size, + " %.*s (was %d instead of 1)", (int)parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, diff); } #endif diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 40ced17..b4a62b9 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -18,7 +18,7 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ static struct { - int cacheSize; /* Number of env strings in cache. */ + size_t cacheSize; /* Number of env strings in cache. */ char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ #ifndef USE_PUTENV @@ -26,7 +26,7 @@ static struct { * need to track this in case another * subsystem swaps around the environ array * like we do. */ - int ourEnvironSize; /* Non-zero means that the environ array was + size_t ourEnvironSize; /* Non-zero means that the environ array was * malloced and has this many total entries * allocated to it (not all may be in use at * once). Zero means that the environment @@ -203,8 +203,8 @@ TclSetEnv( const char *value) /* New value for variable (UTF-8). */ { Tcl_DString envString; - unsigned nameLength, valueLength; - int index, length; + size_t nameLength, valueLength; + size_t index, length; char *p, *oldValue; const char *p2; @@ -217,7 +217,7 @@ TclSetEnv( Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); - if (index == -1) { + if (index == TCL_AUTO_LENGTH) { #ifndef USE_PUTENV /* * We need to handle the case where the environment may be changed @@ -226,11 +226,11 @@ TclSetEnv( */ if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) { - char **newEnviron = ckalloc((length + 5) * sizeof(char *)); + char **newEnviron = Tcl_Alloc((length + 5) * sizeof(char *)); memcpy(newEnviron, environ, length * sizeof(char *)); if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) { - ckfree(env.ourEnviron); + Tcl_Free(env.ourEnviron); } environ = env.ourEnviron = newEnviron; env.ourEnvironSize = length + 5; @@ -260,7 +260,7 @@ TclSetEnv( Tcl_DStringFree(&envString); oldValue = environ[index]; - nameLength = (unsigned) length; + nameLength = length; } /* @@ -270,7 +270,7 @@ TclSetEnv( */ valueLength = strlen(value); - p = ckalloc(nameLength + valueLength + 2); + p = Tcl_Alloc(nameLength + valueLength + 2); memcpy(p, name, nameLength); p[nameLength] = '='; memcpy(p+nameLength+1, value, valueLength+1); @@ -280,8 +280,8 @@ TclSetEnv( * Copy the native string to heap memory. */ - p = ckrealloc(p, Tcl_DStringLength(&envString) + 1); - memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + 1); + p = Tcl_Realloc(p, Tcl_DStringLength(&envString) + 1); + memcpy(p, p2, Tcl_DStringLength(&envString) + 1); Tcl_DStringFree(&envString); #ifdef USE_PUTENV @@ -301,7 +301,7 @@ TclSetEnv( * string in the cache. */ - if ((index != -1) && (environ[index] == p)) { + if ((index != TCL_AUTO_LENGTH) && (environ[index] == p)) { ReplaceString(oldValue, p); #ifdef HAVE_PUTENV_THAT_COPIES } else { @@ -309,7 +309,7 @@ TclSetEnv( * This putenv() copies instead of taking ownership. */ - ckfree(p); + Tcl_Free(p); #endif /* HAVE_PUTENV_THAT_COPIES */ } @@ -401,8 +401,7 @@ TclUnsetEnv( const char *name) /* Name of variable to remove (UTF-8). */ { char *oldValue; - int length; - int index; + size_t length, index; #ifdef USE_PUTENV_FOR_UNSET Tcl_DString envString; char *string; @@ -418,7 +417,7 @@ TclUnsetEnv( * needless work and to avoid recursion on the unset. */ - if (index == -1) { + if (index == TCL_AUTO_LENGTH) { Tcl_MutexUnlock(&envMutex); return; } @@ -441,20 +440,20 @@ TclUnsetEnv( */ #if defined(_WIN32) - string = ckalloc(length + 2); + string = Tcl_Alloc(length + 2); memcpy(string, name, (size_t) length); string[length] = '='; string[length+1] = '\0'; #else - string = ckalloc(length + 1); + string = Tcl_Alloc(length + 1); memcpy(string, name, (size_t) length); string[length] = '\0'; #endif /* _WIN32 */ Tcl_UtfToExternalDString(NULL, string, -1, &envString); - string = ckrealloc(string, Tcl_DStringLength(&envString) + 1); + string = Tcl_Realloc(string, Tcl_DStringLength(&envString) + 1); memcpy(string, Tcl_DStringValue(&envString), - (unsigned) Tcl_DStringLength(&envString)+1); + Tcl_DStringLength(&envString)+1); Tcl_DStringFree(&envString); putenv(string); @@ -473,7 +472,7 @@ TclUnsetEnv( * This putenv() copies instead of taking ownership. */ - ckfree(string); + Tcl_Free(string); #endif /* HAVE_PUTENV_THAT_COPIES */ } #else /* !USE_PUTENV_FOR_UNSET */ @@ -517,13 +516,13 @@ TclGetEnv( * value of the environment variable is * stored. */ { - int length, index; + size_t length, index; const char *result; Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); result = NULL; - if (index != -1) { + if (index != TCL_AUTO_LENGTH) { Tcl_DString envStr; result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr); @@ -650,7 +649,7 @@ ReplaceString( const char *oldStr, /* Old environment string. */ char *newStr) /* New environment string. */ { - int i; + size_t i; /* * Check to see if the old value was allocated by Tcl. If so, it needs to @@ -670,7 +669,7 @@ ReplaceString( */ if (env.cache[i]) { - ckfree(env.cache[i]); + Tcl_Free(env.cache[i]); } if (newStr) { @@ -688,7 +687,7 @@ ReplaceString( const int growth = 5; - env.cache = ckrealloc(env.cache, + env.cache = Tcl_Realloc(env.cache, (env.cacheSize + growth) * sizeof(char *)); env.cache[env.cacheSize] = newStr; (void) memset(env.cache+env.cacheSize+1, 0, @@ -731,15 +730,15 @@ TclFinalizeEnvironment(void) #ifdef PURIFY int i; for (i = 0; i < env.cacheSize; i++) { - ckfree(env.cache[i]); + Tcl_Free(env.cache[i]); } #endif - ckfree(env.cache); + Tcl_Free(env.cache); env.cache = NULL; env.cacheSize = 0; #ifndef USE_PUTENV if ((env.ourEnviron != NULL)) { - ckfree(env.ourEnviron); + Tcl_Free(env.ourEnviron); env.ourEnviron = NULL; } env.ourEnvironSize = 0; diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 913ff0f..91a5323 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -160,7 +160,7 @@ Tcl_BackgroundException( return; } - errPtr = ckalloc(sizeof(BgError)); + errPtr = Tcl_Alloc(sizeof(BgError)); errPtr->errorMsg = Tcl_GetObjResult(interp); Tcl_IncrRefCount(errPtr->errorMsg); errPtr->returnOpts = Tcl_GetReturnOptions(interp, code); @@ -227,7 +227,7 @@ HandleBgErrors( errPtr = assocPtr->firstBgPtr; Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); - tempObjv = ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *)); + tempObjv = Tcl_Alloc((prefixObjc+2) * sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; tempObjv[prefixObjc+1] = errPtr->returnOpts; @@ -242,8 +242,8 @@ HandleBgErrors( Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); assocPtr->firstBgPtr = errPtr->nextPtr; - ckfree(errPtr); - ckfree(tempObjv); + Tcl_Free(errPtr); + Tcl_Free(tempObjv); if (code == TCL_BREAK) { /* @@ -256,7 +256,7 @@ HandleBgErrors( assocPtr->firstBgPtr = errPtr->nextPtr; Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); - ckfree(errPtr); + Tcl_Free(errPtr); } } else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) { Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); @@ -525,7 +525,7 @@ TclSetBgErrorHandler( * First access: initialize. */ - assocPtr = ckalloc(sizeof(ErrAssocData)); + assocPtr = Tcl_Alloc(sizeof(ErrAssocData)); assocPtr->interp = interp; assocPtr->cmdPrefix = NULL; assocPtr->firstBgPtr = NULL; @@ -604,7 +604,7 @@ BgErrorDeleteProc( assocPtr->firstBgPtr = errPtr->nextPtr; Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); - ckfree(errPtr); + Tcl_Free(errPtr); } Tcl_CancelIdleCall(HandleBgErrors, assocPtr); Tcl_DecrRefCount(assocPtr->cmdPrefix); @@ -634,7 +634,7 @@ Tcl_CreateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler)); + ExitHandler *exitPtr = Tcl_Alloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; @@ -667,7 +667,7 @@ TclCreateLateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler)); + ExitHandler *exitPtr = Tcl_Alloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; @@ -712,7 +712,7 @@ Tcl_DeleteExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree(exitPtr); + Tcl_Free(exitPtr); break; } } @@ -755,7 +755,7 @@ TclDeleteLateExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree(exitPtr); + Tcl_Free(exitPtr); break; } } @@ -789,7 +789,7 @@ Tcl_CreateThreadExitHandler( ExitHandler *exitPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - exitPtr = ckalloc(sizeof(ExitHandler)); + exitPtr = Tcl_Alloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; exitPtr->nextPtr = tsdPtr->firstExitPtr; @@ -831,7 +831,7 @@ Tcl_DeleteThreadExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree(exitPtr); + Tcl_Free(exitPtr); return; } } @@ -909,7 +909,7 @@ InvokeExitHandlers(void) firstExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); - ckfree(exitPtr); + Tcl_Free(exitPtr); Tcl_MutexLock(&exitMutex); } firstExitPtr = NULL; @@ -1132,7 +1132,7 @@ Tcl_Finalize(void) firstLateExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); - ckfree(exitPtr); + Tcl_Free(exitPtr); Tcl_MutexLock(&exitMutex); } firstLateExitPtr = NULL; @@ -1243,7 +1243,7 @@ Tcl_Finalize(void) TclResetFilesystem(); /* - * At this point, there should no longer be any ckalloc'ed memory. + * At this point, there should no longer be any Tcl_Alloc'ed memory. */ TclFinalizeMemorySubsystem(); @@ -1302,7 +1302,7 @@ FinalizeThread( tsdPtr->firstExitPtr = exitPtr->nextPtr; exitPtr->proc(exitPtr->clientData); - ckfree(exitPtr); + Tcl_Free(exitPtr); } TclFinalizeIOSubsystem(); TclFinalizeNotifier(); @@ -1565,7 +1565,7 @@ NewThreadProc( threadProc = cdPtr->proc; threadClientData = cdPtr->clientData; - ckfree(clientData); /* Allocated in Tcl_CreateThread() */ + Tcl_Free(clientData); /* Allocated in Tcl_CreateThread() */ threadProc(threadClientData); @@ -1597,19 +1597,19 @@ Tcl_CreateThread( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ ClientData clientData, /* The one argument to Main() */ - int stackSize, /* Size of stack for the new thread */ + size_t stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { #if TCL_THREADS - ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData)); + ThreadClientData *cdPtr = Tcl_Alloc(sizeof(ThreadClientData)); int result; cdPtr->proc = proc; cdPtr->clientData = clientData; result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags); if (result != TCL_OK) { - ckfree(cdPtr); + Tcl_Free(cdPtr); } return result; #else diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 897e2cd..a30cd4b 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -73,11 +73,11 @@ int tclTraceExec = 0; * expression opcodes (e.g., INST_LOR) in tclCompile.h. * * Does not include the string for INST_EXPON (and beyond), as that is - * disjoint for backward-compatability reasons. + * disjoint for backward-compatibility reasons. */ static const char *const operatorStrings[] = { - "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>", + "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>", "+", "-", "*", "/", "%", "+", "-", "~", "!" }; @@ -101,64 +101,6 @@ long tclObjsAlloced = 0; long tclObjsFreed = 0; long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ - -/* - * Support pre-8.5 bytecodes unless specifically requested otherwise. - */ - -#ifndef TCL_SUPPORT_84_BYTECODE -#define TCL_SUPPORT_84_BYTECODE 1 -#endif - -#if TCL_SUPPORT_84_BYTECODE -/* - * We need to know the tclBuiltinFuncTable to support translation of pre-8.5 - * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+. - */ - -typedef struct { - const char *name; /* Name of function. */ - int numArgs; /* Number of arguments for function. */ -} BuiltinFunc; - -/* - * Table describing the built-in math functions. Entries in this table are - * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's - * operand byte. - */ - -static BuiltinFunc const tclBuiltinFuncTable[] = { - {"acos", 1}, - {"asin", 1}, - {"atan", 1}, - {"atan2", 2}, - {"ceil", 1}, - {"cos", 1}, - {"cosh", 1}, - {"exp", 1}, - {"floor", 1}, - {"fmod", 2}, - {"hypot", 2}, - {"log", 1}, - {"log10", 1}, - {"pow", 2}, - {"sin", 1}, - {"sinh", 1}, - {"sqrt", 1}, - {"tan", 1}, - {"tanh", 1}, - {"abs", 1}, - {"double", 1}, - {"int", 1}, - {"rand", 0}, - {"round", 1}, - {"srand", 1}, - {"wide", 1}, - {NULL, 0}, -}; - -#define LAST_BUILTIN_FUNC 25 -#endif /* * NR_TEBC @@ -166,7 +108,7 @@ static BuiltinFunc const tclBuiltinFuncTable[] = { * Minimal data required to fully reconstruct the execution state. */ -typedef struct TEBCdata { +typedef struct { ByteCode *codePtr; /* Constant until the BC returns */ /* -----------------------------------------*/ ptrdiff_t *catchTop; /* These fields are used on return TO this */ @@ -683,7 +625,7 @@ static void FreeExprCodeInternalRep(Tcl_Obj *objPtr); static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc, int searchMode, ByteCode *codePtr); static const char * GetSrcInfoForPc(const unsigned char *pc, - ByteCode *codePtr, int *lengthPtr, + ByteCode *codePtr, size_t *lengthPtr, const unsigned char **pcBeg, int *cmdIdxPtr); static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, int move); @@ -760,7 +702,7 @@ ReleaseDictIterator( searchPtr = irPtr->twoPtrValue.ptr1; Tcl_DictObjDone(searchPtr); - ckfree(searchPtr); + Tcl_Free(searchPtr); dictPtr = irPtr->twoPtrValue.ptr2; TclDecrRefCount(dictPtr); @@ -830,11 +772,11 @@ ExecEnv * TclCreateExecEnv( Tcl_Interp *interp, /* Interpreter for which the execution * environment is being created. */ - int size) /* The initial stack size, in number of words + size_t size) /* The initial stack size, in number of words * [sizeof(Tcl_Obj*)] */ { - ExecEnv *eePtr = ckalloc(sizeof(ExecEnv)); - ExecStack *esPtr = ckalloc(sizeof(ExecStack) + ExecEnv *eePtr = Tcl_Alloc(sizeof(ExecEnv)); + ExecStack *esPtr = Tcl_Alloc(sizeof(ExecStack) + (size_t) (size-1) * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; @@ -894,7 +836,7 @@ DeleteExecStack( if (esPtr->nextPtr) { esPtr->nextPtr->prevPtr = esPtr->prevPtr; } - ckfree(esPtr); + Tcl_Free(esPtr); } void @@ -926,7 +868,7 @@ TclDeleteExecEnv( if (eePtr->corPtr && !cachedInExit) { Tcl_Panic("Deleting execEnv with existing coroutine"); } - ckfree(eePtr); + Tcl_Free(eePtr); } /* @@ -1103,7 +1045,7 @@ GrowEvaluationStack( newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *); oldPtr = esPtr; - esPtr = ckalloc(newBytes); + esPtr = Tcl_Alloc(newBytes); oldPtr->nextPtr = esPtr; esPtr->prevPtr = oldPtr; @@ -1202,7 +1144,7 @@ TclStackFree( Tcl_Obj **markerPtr, *marker; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - ckfree(freePtr); + Tcl_Free(freePtr); return; } @@ -1260,13 +1202,13 @@ TclStackFree( void * TclStackAlloc( Tcl_Interp *interp, - int numBytes) + size_t numBytes) { Interp *iPtr = (Interp *) interp; int numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - return (void *) ckalloc(numBytes); + return (void *) Tcl_Alloc(numBytes); } numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *); return (void *) StackAllocWords(interp, numWords); @@ -1276,7 +1218,7 @@ void * TclStackRealloc( Tcl_Interp *interp, void *ptr, - int numBytes) + size_t numBytes) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr; @@ -1285,7 +1227,7 @@ TclStackRealloc( int numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - return (void *) ckrealloc((char *) ptr, numBytes); + return (void *) Tcl_Realloc((char *) ptr, numBytes); } eePtr = iPtr->execEnvPtr; @@ -1327,7 +1269,7 @@ int Tcl_ExprObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - register Tcl_Obj *objPtr, /* Points to Tcl object containing expression + Tcl_Obj *objPtr, /* Points to Tcl object containing expression * to evaluate. */ Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression * result is stored if no errors occur. */ @@ -1444,7 +1386,7 @@ CompileExprObj( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - register ByteCode *codePtr = NULL; + ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ @@ -1598,8 +1540,8 @@ TclCompileObj( const CmdFrame *invoker, int word) { - register Interp *iPtr = (Interp *) interp; - register ByteCode *codePtr; /* Tcl Internal type of bytecode. */ + Interp *iPtr = (Interp *) interp; + ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; /* @@ -2493,7 +2435,7 @@ TEBCresume( #ifdef TCL_COMPILE_DEBUG /* FIXME: What is the right thing to trace? */ { - register int i; + int i; TRACE(("%d [", opnd)); for (i=opnd-1 ; i>=0 ; i--) { @@ -2615,7 +2557,7 @@ TEBCresume( * command starts. * * Use a Tcl_Obj as linked list element; slight mem waste, but faster - * allocation than ckalloc. This also abuses the Tcl_Obj structure, as + * allocation than Tcl_Alloc. This also abuses the Tcl_Obj structure, as * we do not define a special tclObjType for it. It is not dangerous * as the obj is never passed anywhere, so that all manipulations are * performed here and in INST_INVOKE_EXPANDED (in case of an expansion @@ -2805,91 +2747,6 @@ TEBCresume( return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); -#if TCL_SUPPORT_84_BYTECODE - case INST_CALL_BUILTIN_FUNC1: - /* - * Call one of the built-in pre-8.5 Tcl math functions. This - * translates to INST_INVOKE_STK1 with the first argument of - * ::tcl::mathfunc::$objv[0]. We need to insert the named math - * function into the stack. - */ - - opnd = TclGetUInt1AtPtr(pc+1); - if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) { - TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd)); - Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd); - } - - TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::"); - Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1); - - /* - * Only 0, 1 or 2 args. - */ - - { - int numArgs = tclBuiltinFuncTable[opnd].numArgs; - Tcl_Obj *tmpPtr1, *tmpPtr2; - - if (numArgs == 0) { - PUSH_OBJECT(objPtr); - } else if (numArgs == 1) { - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - Tcl_DecrRefCount(tmpPtr1); - } else { - tmpPtr2 = POP_OBJECT(); - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - PUSH_OBJECT(tmpPtr2); - Tcl_DecrRefCount(tmpPtr1); - Tcl_DecrRefCount(tmpPtr2); - } - objc = numArgs + 1; - } - pcAdjustment = 2; - goto doInvocation; - - case INST_CALL_FUNC1: - /* - * Call a non-builtin Tcl math function previously registered by a - * call to Tcl_CreateMathFunc pre-8.5. This is essentially - * INST_INVOKE_STK1 converting the first arg to - * ::tcl::mathfunc::$objv[0]. - */ - - objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function - * name is the 0-th argument. */ - - objPtr = OBJ_AT_DEPTH(objc-1); - TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::"); - Tcl_AppendObjToObj(tmpPtr, objPtr); - Tcl_DecrRefCount(objPtr); - - /* - * Variation of PUSH_OBJECT. - */ - - OBJ_AT_DEPTH(objc-1) = tmpPtr; - Tcl_IncrRefCount(tmpPtr); - - pcAdjustment = 2; - goto doInvocation; -#else - /* - * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the - * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support - * remains for existing bytecode precompiled files. - */ - - case INST_CALL_BUILTIN_FUNC1: - Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found"); - case INST_CALL_FUNC1: - Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found"); -#endif - case INST_INVOKE_REPLACE: objc = TclGetUInt4AtPtr(pc+1); opnd = TclGetUInt1AtPtr(pc+5); @@ -3972,29 +3829,6 @@ TEBCresume( CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; - - /* - * This is really an unset operation these days. Do not issue. - */ - - case INST_DICT_DONE: - opnd = TclGetUInt4AtPtr(pc+1); - TRACE(("%u => OK\n", opnd)); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } - if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) { - if (!TclIsVarUndefined(varPtr)) { - TclDecrRefCount(varPtr->value.objPtr); - } - varPtr->value.objPtr = NULL; - } else { - DECACHE_STACK_INFO(); - TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd); - CACHE_STACK_INFO(); - } - NEXT_INST_F(5, 0, 0); } /* @@ -4313,50 +4147,6 @@ TEBCresume( } /* - * These two instructions are now redundant: the complete logic of the LOR - * and LAND is now handled by the expression compiler. - */ - - case INST_LOR: - case INST_LAND: { - /* - * Operands must be boolean or numeric. No int->double conversions are - * performed. - */ - - int i1, i2, iResult; - - value2Ptr = OBJ_AT_TOS; - valuePtr = OBJ_UNDER_TOS; - if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) { - TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), - (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); - IllegalExprOperandType(interp, pc, valuePtr); - CACHE_STACK_INFO(); - goto gotError; - } - - if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) { - TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), - (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); - IllegalExprOperandType(interp, pc, value2Ptr); - CACHE_STACK_INFO(); - goto gotError; - } - - if (*pc == INST_LOR) { - iResult = (i1 || i2); - } else { - iResult = (i1 && i2); - } - objResultPtr = TCONST(iResult); - TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult)); - NEXT_INST_F(1, 2, 1); - } - - /* * ----------------------------------------------------------------- * Start of general introspector instructions. */ @@ -4390,8 +4180,8 @@ TEBCresume( NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { int level; - register CallFrame *framePtr = iPtr->varFramePtr; - register CallFrame *rootFramePtr = iPtr->rootFramePtr; + CallFrame *framePtr = iPtr->varFramePtr; + CallFrame *rootFramePtr = iPtr->rootFramePtr; TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) { @@ -4688,7 +4478,7 @@ TEBCresume( } { - register Method *const mPtr = + Method *const mPtr = contextPtr->callPtr->chain[newDepth].mPtr; return mPtr->typePtr->callProc(mPtr->clientData, interp, @@ -4735,6 +4525,7 @@ TEBCresume( { int index, numIndices, fromIdx, toIdx; int nocase, match, length2, cflags, s1len, s2len; + size_t slength; const char *s1, *s2; case INST_LIST: @@ -5008,7 +4799,8 @@ TEBCresume( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - s1 = TclGetStringFromObj(valuePtr, &s1len); + s1 = TclGetString(valuePtr); + s1len = valuePtr->length; TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { TRACE_ERROR(interp); @@ -5026,7 +4818,8 @@ TEBCresume( do { Tcl_ListObjIndex(NULL, value2Ptr, i, &o); if (o != NULL) { - s2 = TclGetStringFromObj(o, &s2len); + s2 = TclGetString(o); + s2len = o->length; } else { s2 = ""; s2len = 0; @@ -5134,24 +4927,24 @@ TEBCresume( case INST_STR_LEN: valuePtr = OBJ_AT_TOS; - length = Tcl_GetCharLength(valuePtr); - TclNewIntObj(objResultPtr, length); - TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length)); + slength = Tcl_GetCharLength(valuePtr); + TclNewIntObj(objResultPtr, slength); + TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "d\n", O2S(valuePtr), slength)); NEXT_INST_F(1, 1, 1); case INST_STR_UPPER: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { - s1 = TclGetStringFromObj(valuePtr, &length); - TclNewStringObj(objResultPtr, s1, length); - length = Tcl_UtfToUpper(TclGetString(objResultPtr)); - Tcl_SetObjLength(objResultPtr, length); + s1 = TclGetStringFromObj(valuePtr, &slength); + TclNewStringObj(objResultPtr, s1, slength); + slength = Tcl_UtfToUpper(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, slength); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { - length = Tcl_UtfToUpper(TclGetString(valuePtr)); - Tcl_SetObjLength(valuePtr, length); + slength = Tcl_UtfToUpper(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, slength); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); @@ -5160,15 +4953,15 @@ TEBCresume( valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { - s1 = TclGetStringFromObj(valuePtr, &length); - TclNewStringObj(objResultPtr, s1, length); - length = Tcl_UtfToLower(TclGetString(objResultPtr)); - Tcl_SetObjLength(objResultPtr, length); + s1 = TclGetStringFromObj(valuePtr, &slength); + TclNewStringObj(objResultPtr, s1, slength); + slength = Tcl_UtfToLower(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, slength); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { - length = Tcl_UtfToLower(TclGetString(valuePtr)); - Tcl_SetObjLength(valuePtr, length); + slength = Tcl_UtfToLower(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, slength); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); @@ -5177,15 +4970,15 @@ TEBCresume( valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { - s1 = TclGetStringFromObj(valuePtr, &length); - TclNewStringObj(objResultPtr, s1, length); - length = Tcl_UtfToTitle(TclGetString(objResultPtr)); - Tcl_SetObjLength(objResultPtr, length); + s1 = TclGetStringFromObj(valuePtr, &slength); + TclNewStringObj(objResultPtr, s1, slength); + slength = Tcl_UtfToTitle(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, slength); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { - length = Tcl_UtfToTitle(TclGetString(valuePtr)); - Tcl_SetObjLength(valuePtr, length); + slength = Tcl_UtfToTitle(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, slength); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); @@ -5200,18 +4993,18 @@ TEBCresume( * Get char length to calulate what 'end' means. */ - length = Tcl_GetCharLength(valuePtr); - if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { + slength = Tcl_GetCharLength(valuePtr); + if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } - if ((index < 0) || (index >= length)) { + if ((index < 0) || (index >= (int)slength)) { TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1); - } else if (valuePtr->bytes && length == valuePtr->length) { + } else if (valuePtr->bytes && slength == valuePtr->length) { objResultPtr = Tcl_NewStringObj((const char *) valuePtr->bytes+index, 1); } else { @@ -5226,11 +5019,11 @@ TEBCresume( if (ch == -1) { objResultPtr = Tcl_NewObj(); } else { - length = Tcl_UniCharToUtf(ch, buf); - if (!length) { - length = Tcl_UniCharToUtf(-1, buf); + slength = Tcl_UniCharToUtf(ch, buf); + if (!slength) { + slength = Tcl_UniCharToUtf(-1, buf); } - objResultPtr = Tcl_NewStringObj(buf, length); + objResultPtr = Tcl_NewStringObj(buf, slength); } } @@ -5240,10 +5033,10 @@ TEBCresume( case INST_STR_RANGE: TRACE(("\"%.20s\" %.20s %.20s =>", O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); - length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1; - if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length, + slength = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1; + if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength, &fromIdx) != TCL_OK - || TclGetIntForIndexM(interp, OBJ_AT_TOS, length, + || TclGetIntForIndexM(interp, OBJ_AT_TOS, slength, &toIdx) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -5252,8 +5045,8 @@ TEBCresume( if (fromIdx < 0) { fromIdx = 0; } - if (toIdx >= length) { - toIdx = length; + if (toIdx >= (int)slength) { + toIdx = slength; } if (toIdx >= fromIdx) { objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); @@ -5267,11 +5060,11 @@ TEBCresume( valuePtr = OBJ_AT_TOS; fromIdx = TclGetInt4AtPtr(pc+1); toIdx = TclGetInt4AtPtr(pc+5); - length = Tcl_GetCharLength(valuePtr); + slength = Tcl_GetCharLength(valuePtr); TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx)); /* Every range of an empty value is an empty value */ - if (length == 0) { + if (slength == 0) { TRACE_APPEND(("\n")); NEXT_INST_F(9, 0, 0); } @@ -5287,14 +5080,14 @@ TEBCresume( goto emptyRange; } - toIdx = TclIndexDecode(toIdx, length - 1); + toIdx = TclIndexDecode(toIdx, slength - 1); if (toIdx < 0) { goto emptyRange; - } else if (toIdx >= length) { - toIdx = length - 1; + } else if (toIdx >= (int)slength) { + toIdx = slength - 1; } - assert ( toIdx >= 0 && toIdx < length ); + assert ( toIdx >= 0 && (size_t)toIdx < slength ); /* assert ( fromIdx != TCL_INDEX_NONE ); @@ -5305,7 +5098,7 @@ TEBCresume( fromIdx = TCL_INDEX_START; } - fromIdx = TclIndexDecode(fromIdx, length - 1); + fromIdx = TclIndexDecode(fromIdx, slength - 1); if (fromIdx < 0) { fromIdx = 0; } @@ -5321,18 +5114,18 @@ TEBCresume( { Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p; - int length3, endIdx; + int length3; Tcl_Obj *value3Ptr; case INST_STR_REPLACE: value3Ptr = POP_OBJECT(); valuePtr = OBJ_AT_DEPTH(2); - endIdx = Tcl_GetCharLength(valuePtr) - 1; + slength = Tcl_GetCharLength(valuePtr) - 1; TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr))); - if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx, + if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength, &fromIdx) != TCL_OK - || TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx, + || TclGetIntForIndexM(interp, OBJ_AT_TOS, slength, &toIdx) != TCL_OK) { TclDecrRefCount(value3Ptr); TRACE_ERROR(interp); @@ -5344,7 +5137,7 @@ TEBCresume( (void) POP_OBJECT(); if ((toIdx < 0) || - (fromIdx > endIdx) || + (fromIdx > (int)slength) || (toIdx < fromIdx)) { TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); TclDecrRefCount(value3Ptr); @@ -5355,11 +5148,11 @@ TEBCresume( fromIdx = 0; } - if (toIdx > endIdx) { - toIdx = endIdx; + if (toIdx > (int)slength) { + toIdx = slength; } - if (fromIdx == 0 && toIdx == endIdx) { + if (fromIdx == 0 && toIdx == (int)slength) { TclDecrRefCount(OBJ_AT_TOS); OBJ_AT_TOS = value3Ptr; TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr))); @@ -5391,28 +5184,28 @@ TEBCresume( objResultPtr = value3Ptr; goto doneStringMap; } - ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); - if (length == 0) { + ustring1 = TclGetUnicodeFromObj(valuePtr, &slength); + if (slength == 0) { objResultPtr = valuePtr; goto doneStringMap; } - ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); - if (length2 > length || length2 == 0) { + ustring2 = TclGetUnicodeFromObj(value2Ptr, &length2); + if (length2 > (int)slength || length2 == 0) { objResultPtr = valuePtr; goto doneStringMap; - } else if (length2 == length) { - if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) { + } else if (length2 == (int)slength) { + if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * slength)) { objResultPtr = valuePtr; } else { objResultPtr = value3Ptr; } goto doneStringMap; } - ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); + ustring3 = TclGetUnicodeFromObj(value3Ptr, &length3); objResultPtr = Tcl_NewUnicodeObj(ustring1, 0); p = ustring1; - end = ustring1 + length; + end = ustring1 + slength; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) @@ -5441,19 +5234,19 @@ TEBCresume( NEXT_INST_V(1, 3, 1); case INST_STR_FIND: - match = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0); + slength = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0); - TRACE(("%.20s %.20s => %d\n", - O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); + TRACE(("%.20s %.20s => %" TCL_Z_MODIFIER "d\n", + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), slength)); + objResultPtr = TclNewWideIntObjFromSize(slength); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: - match = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1); + slength = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, (size_t)-2); - TRACE(("%.20s %.20s => %d\n", - O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); + TRACE(("%.20s %.20s => %" TCL_Z_MODIFIER "d\n", + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), slength)); + objResultPtr = TclNewWideIntObjFromSize(slength); NEXT_INST_F(1, 2, 1); case INST_STR_CLASS: @@ -5461,10 +5254,10 @@ TEBCresume( valuePtr = OBJ_AT_TOS; TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name, O2S(valuePtr))); - ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); + ustring1 = TclGetUnicodeFromObj(valuePtr, &slength); match = 1; - if (length > 0) { - end = ustring1 + length; + if (slength > 0) { + end = ustring1 + slength; for (p=ustring1 ; p<end ; p++) { if (!tclStringClassTable[opnd].comparator(*p)) { match = 0; @@ -5490,16 +5283,17 @@ TEBCresume( || (value2Ptr->typePtr == &tclStringType)) { Tcl_UniChar *ustring1, *ustring2; - ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); - ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); - match = TclUniCharMatch(ustring1, length, ustring2, length2, + ustring1 = TclGetUnicodeFromObj(valuePtr, &slength); + ustring2 = TclGetUnicodeFromObj(value2Ptr, &length2); + match = TclUniCharMatch(ustring1, slength, ustring2, length2, nocase); } else if (TclIsPureByteArray(valuePtr) && !nocase) { unsigned char *bytes1, *bytes2; + size_t wlen1, wlen2; - bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length); - bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2); - match = TclByteArrayMatch(bytes1, length, bytes2, length2, 0); + bytes1 = TclGetByteArrayFromObj(valuePtr, &wlen1); + bytes2 = TclGetByteArrayFromObj(value2Ptr, &wlen2); + match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0); } else { match = Tcl_StringCaseMatch(TclGetString(valuePtr), TclGetString(value2Ptr), nocase); @@ -5520,30 +5314,30 @@ TEBCresume( { const char *string1, *string2; - int trim1, trim2; + size_t trim1, trim2; case INST_STR_TRIM_LEFT: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ string2 = TclGetStringFromObj(value2Ptr, &length2); - string1 = TclGetStringFromObj(valuePtr, &length); - trim1 = TclTrimLeft(string1, length, string2, length2); + string1 = TclGetStringFromObj(valuePtr, &slength); + trim1 = TclTrimLeft(string1, slength, string2, length2); trim2 = 0; goto createTrimmedString; case INST_STR_TRIM_RIGHT: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ string2 = TclGetStringFromObj(value2Ptr, &length2); - string1 = TclGetStringFromObj(valuePtr, &length); - trim2 = TclTrimRight(string1, length, string2, length2); + string1 = TclGetStringFromObj(valuePtr, &slength); + trim2 = TclTrimRight(string1, slength, string2, length2); trim1 = 0; goto createTrimmedString; case INST_STR_TRIM: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ string2 = TclGetStringFromObj(value2Ptr, &length2); - string1 = TclGetStringFromObj(valuePtr, &length); - trim1 = TclTrim(string1, length, string2, length2, &trim2); + string1 = TclGetStringFromObj(valuePtr, &slength); + trim1 = TclTrim(string1, slength, string2, length2, &trim2); createTrimmedString: /* * Careful here; trim set often contains non-ASCII characters so we @@ -5566,7 +5360,7 @@ TEBCresume( #endif NEXT_INST_F(1, 1, 0); } else { - objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2); + objResultPtr = Tcl_NewStringObj(string1+trim1, slength-trim1-trim2); #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { TclPrintObject(stdout, objResultPtr, 30); @@ -6326,170 +6120,6 @@ TEBCresume( { ForeachInfo *infoPtr; - Var *iterVarPtr, *listVarPtr; - Tcl_Obj *oldValuePtr, *listPtr, **elements; - ForeachVarList *varListPtr; - int numLists, listTmpIndex, listLen, numVars; - size_t iterNum; - int varIndex, valIndex, continueLoop, j, iterTmpIndex; - long i; - - case INST_FOREACH_START4: /* DEPRECATED */ - /* - * Initialize the temporary local var that holds the count of the - * number of iterations of the loop body to -1. - */ - - opnd = TclGetUInt4AtPtr(pc+1); - infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; - iterTmpIndex = infoPtr->loopCtTemp; - iterVarPtr = LOCAL(iterTmpIndex); - oldValuePtr = iterVarPtr->value.objPtr; - - if (oldValuePtr == NULL) { - TclNewIntObj(iterVarPtr->value.objPtr, -1); - Tcl_IncrRefCount(iterVarPtr->value.objPtr); - } else { - TclSetIntObj(oldValuePtr, -1); - } - TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex)); - -#ifndef TCL_COMPILE_DEBUG - /* - * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately - * after INST_FOREACH_START4 - let us just fall through instead of - * jumping back to the top. - */ - - pc += 5; - TCL_DTRACE_INST_NEXT(); -#else - NEXT_INST_F(5, 0, 0); -#endif - - case INST_FOREACH_STEP4: /* DEPRECATED */ - /* - * "Step" a foreach loop (i.e., begin its next iteration) by assigning - * the next value list element to each loop var. - */ - - opnd = TclGetUInt4AtPtr(pc+1); - TRACE(("%u => ", opnd)); - infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; - numLists = infoPtr->numLists; - - /* - * Increment the temp holding the loop iteration number. - */ - - iterVarPtr = LOCAL(infoPtr->loopCtTemp); - valuePtr = iterVarPtr->value.objPtr; - iterNum = (size_t)valuePtr->internalRep.wideValue + 1; - TclSetIntObj(valuePtr, iterNum); - - /* - * Check whether all value lists are exhausted and we should stop the - * loop. - */ - - continueLoop = 0; - listTmpIndex = infoPtr->firstValueTemp; - for (i = 0; i < numLists; i++) { - varListPtr = infoPtr->varLists[i]; - numVars = varListPtr->numVars; - - listVarPtr = LOCAL(listTmpIndex); - listPtr = listVarPtr->value.objPtr; - if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { - TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n", - i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); - goto gotError; - } - if ((size_t)listLen > iterNum * numVars) { - continueLoop = 1; - } - listTmpIndex++; - } - - /* - * If some var in some var list still has a remaining list element - * iterate one more time. Assign to var the next element from its - * value list. We already checked above that each list temp holds a - * valid list object (by calling Tcl_ListObjLength), but cannot rely - * on that check remaining valid: one list could have been shimmered - * as a side effect of setting a traced variable. - */ - - if (continueLoop) { - listTmpIndex = infoPtr->firstValueTemp; - for (i = 0; i < numLists; i++) { - varListPtr = infoPtr->varLists[i]; - numVars = varListPtr->numVars; - - listVarPtr = LOCAL(listTmpIndex); - listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); - TclListObjGetElements(interp, listPtr, &listLen, &elements); - - valIndex = (iterNum * numVars); - for (j = 0; j < numVars; j++) { - if (valIndex >= listLen) { - TclNewObj(valuePtr); - } else { - valuePtr = elements[valIndex]; - } - - varIndex = varListPtr->varIndexes[j]; - varPtr = LOCAL(varIndex); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } - if (TclIsVarDirectWritable(varPtr)) { - value2Ptr = varPtr->value.objPtr; - if (valuePtr != value2Ptr) { - if (value2Ptr != NULL) { - TclDecrRefCount(value2Ptr); - } - varPtr->value.objPtr = valuePtr; - Tcl_IncrRefCount(valuePtr); - } - } else { - DECACHE_STACK_INFO(); - if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, - valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ - CACHE_STACK_INFO(); - TRACE_APPEND(( - "ERROR init. index temp %d: %s\n", - varIndex, O2S(Tcl_GetObjResult(interp)))); - TclDecrRefCount(listPtr); - goto gotError; - } - CACHE_STACK_INFO(); - } - valIndex++; - } - TclDecrRefCount(listPtr); - listTmpIndex++; - } - } - TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "d, %s loop\n", - numLists, iterNum, (continueLoop? "continue" : "exit"))); - - /* - * Run-time peep-hole optimisation: the compiler ALWAYS follows - * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that - * instruction and jump direct from here. - */ - - pc += 5; - if (*pc == INST_JUMP_FALSE1) { - NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0); - } else { - NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); - } - - } - { - ForeachInfo *infoPtr; Tcl_Obj *listPtr, **elements, *tmpPtr; ForeachVarList *varListPtr; int numLists, listLen, numVars; @@ -6771,8 +6401,8 @@ TEBCresume( case INST_DICT_GET: case INST_DICT_EXISTS: { - register Tcl_Interp *interp2 = interp; - register int found; + Tcl_Interp *interp2 = interp; + int found; opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); @@ -7084,7 +6714,7 @@ TEBCresume( opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = POP_OBJECT(); - searchPtr = ckalloc(sizeof(Tcl_DictSearch)); + searchPtr = Tcl_Alloc(sizeof(Tcl_DictSearch)); if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr, &valuePtr, &done) != TCL_OK) { @@ -7095,7 +6725,7 @@ TEBCresume( */ Tcl_DecrRefCount(dictPtr); - ckfree(searchPtr); + Tcl_Free(searchPtr); TRACE_ERROR(interp); goto gotError; } @@ -7180,7 +6810,7 @@ TEBCresume( TRACE_ERROR(interp); goto gotError; } - if (length != duiPtr->length) { + if ((unsigned int)length != duiPtr->length) { Tcl_Panic("dictUpdateStart argument length mismatch"); } for (i=0 ; i<length ; i++) { @@ -7540,11 +7170,12 @@ TEBCresume( } if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { const unsigned char *pcBeg; + size_t xxx1length; - bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL); + bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, &pcBeg, NULL); DECACHE_STACK_INFO(); TclLogCommandInfo(interp, codePtr->source, bytes, - bytes ? length : 0, pcBeg, tosPtr); + bytes ? xxx1length : 0, pcBeg, tosPtr); CACHE_STACK_INFO(); } iPtr->flags &= ~ERR_ALREADY_LOGGED; @@ -7706,9 +7337,10 @@ TEBCresume( instStartCmdFailed: { const char *bytes; + size_t xxx1length; checkInterp = 1; - length = 0; + xxx1length = 0; /* * We used to switch to direct eval; for NRE-awareness we now @@ -7721,11 +7353,11 @@ TEBCresume( } codePtr->flags |= TCL_BYTECODE_RECOMPILE; - bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL); + bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, NULL, NULL); opnd = TclGetUInt4AtPtr(pc+1); pc += (opnd-1); assert(bytes); - PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); + PUSH_OBJECT(Tcl_NewStringObj(bytes, xxx1length)); goto instEvalStk; } } @@ -8841,16 +8473,15 @@ TclCompareTwoNumbers( static void PrintByteCodeInfo( - register ByteCode *codePtr) /* The bytecode whose summary is printed to + ByteCode *codePtr) /* The bytecode whose summary is printed to * stdout. */ { Proc *procPtr = codePtr->procPtr; Interp *iPtr = (Interp *) *codePtr->interpHandle; - fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n", + fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n", codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); - fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); @@ -8876,7 +8507,7 @@ PrintByteCodeInfo( #endif /* TCL_COMPILE_STATS */ if (procPtr != NULL) { fprintf(stdout, - " Proc 0x%p, refCt %d, args %d, compiled locals %d\n", + " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %d, compiled locals %d\n", procPtr, procPtr->refCount, procPtr->numArgs, procPtr->numCompiledLocals); } @@ -8905,7 +8536,7 @@ PrintByteCodeInfo( #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( - register ByteCode *codePtr, /* The bytecode whose summary is printed to + ByteCode *codePtr, /* The bytecode whose summary is printed to * stdout. */ const unsigned char *pc, /* Points to first byte of a bytecode * instruction. The program counter. */ @@ -8917,28 +8548,28 @@ ValidatePcAndStackTop( { int stackUpperBound = codePtr->maxStackDepth; /* Greatest legal value for stackTop. */ - unsigned relativePc = (unsigned) (pc - codePtr->codeStart); - unsigned long codeStart = (unsigned long) codePtr->codeStart; - unsigned long codeEnd = (unsigned long) + size_t relativePc = (size_t) (pc - codePtr->codeStart); + size_t codeStart = (size_t) codePtr->codeStart; + size_t codeEnd = (size_t) (codePtr->codeStart + codePtr->numCodeBytes); unsigned char opCode = *pc; - if (((unsigned long) pc < codeStart) || ((unsigned long) pc > codeEnd)) { + if (((size_t) pc < codeStart) || ((size_t) pc > codeEnd)) { fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n", pc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc"); } - if ((unsigned) opCode > LAST_INST_OPCODE) { - fprintf(stderr, "\nBad opcode %d at pc %u in TclNRExecuteByteCode\n", + if ((unsigned) opCode >= LAST_INST_OPCODE) { + fprintf(stderr, "\nBad opcode %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n", (unsigned) opCode, relativePc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode"); } if (checkStack && ((stackTop < 0) || (stackTop > stackUpperBound))) { - int numChars; + size_t numChars; const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); - fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)", + fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)", stackTop, relativePc, stackUpperBound); if (cmd != NULL) { Tcl_Obj *message; @@ -8991,20 +8622,11 @@ IllegalExprOperandType( if (opcode == INST_EXPON) { operator = "**"; } else if (opcode <= INST_LNOT) { - operator = operatorStrings[opcode - INST_LOR]; + operator = operatorStrings[opcode - INST_BITOR]; } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { - int numBytes; - const char *bytes = TclGetStringFromObj(opndPtr, &numBytes); - - if (numBytes == 0) { - description = "empty string"; - } else if (TclCheckBadOctal(NULL, bytes)) { - description = "invalid octal number"; - } else { - description = "non-numeric string"; - } + description = "non-numeric string"; } else if (type == TCL_NUMBER_NAN) { description = "non-numeric floating-point value"; } else if (type == TCL_NUMBER_DOUBLE) { @@ -9015,7 +8637,8 @@ IllegalExprOperandType( } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use %s as operand of \"%s\"", description, operator)); + "can't use %s \"%s\" as operand of \"%s\"", description, + Tcl_GetString(opndPtr), operator)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL); } @@ -9092,7 +8715,8 @@ TclGetSrcInfoForPc( ExtCmdLoc *eclPtr; ECL *locPtr = NULL; - int srcOffset, i; + size_t srcOffset; + int i; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); @@ -9138,7 +8762,7 @@ GetSrcInfoForPc( * in codePtr's code. */ ByteCode *codePtr, /* The bytecode sequence in which to look up * the command source for the pc. */ - int *lengthPtr, /* If non-NULL, the location where the length + size_t *lengthPtr, /* If non-NULL, the location where the length * of the command's source should be stored. * If NULL, no length is stored. */ const unsigned char **pcBeg,/* If non-NULL, the bytecode location @@ -9148,18 +8772,18 @@ GetSrcInfoForPc( * of the command containing the pc should * be stored. */ { - register int pcOffset = (pc - codePtr->codeStart); - int numCmds = codePtr->numCommands; + size_t pcOffset = (size_t)(pc - codePtr->codeStart); + size_t numCmds = codePtr->numCommands; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; - int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; + size_t codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */ int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */ int bestSrcLength = -1; /* Initialized to avoid compiler warning. */ int bestCmdIdx = -1; /* The pc must point within the bytecode */ - assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes)); + assert ((int)pcOffset < codePtr->numCodeBytes); /* * Decode the code and source offset and length for each command. The @@ -9301,9 +8925,9 @@ GetExceptRangeForPc( { ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; - register ExceptionRange *rangePtr; - int pcOffset = pc - codePtr->codeStart; - register int start; + ExceptionRange *rangePtr; + unsigned int pcOffset = pc - codePtr->codeStart; + unsigned int start; if (numRanges == 0) { return NULL; @@ -9435,11 +9059,11 @@ TclExprFloatError( int TclLog2( - register int value) /* The integer for which to compute the log + int value) /* The integer for which to compute the log * base 2. */ { - register int n = value; - register int result = 0; + int n = value; + int result = 0; while (n > 1) { n = n >> 1; @@ -9483,7 +9107,7 @@ EvalStatsCmd( long numCurrentByteCodes, numByteCodeLits; long refCountSum, literalMgmtBytes, sum; int numSharedMultX, numSharedOnce; - int decadeHigh, minSizeDecade, maxSizeDecade, length, i; + size_t decadeHigh, minSizeDecade, maxSizeDecade, length, i; char *litTableStats; LiteralEntry *entryPtr; Tcl_Obj *objPtr; @@ -9525,12 +9149,12 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); Tcl_AppendPrintfToObj(objPtr, - "Compilation and execution statistics for interpreter %#lx\n", - (long int)iPtr); + "Compilation and execution statistics for interpreter %p\n", + iPtr); - Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "d\n", statsPtr->numExecutions); - Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%" TCL_Z_MODIFIER "d\n", statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean executions/compile\t%.1f\n", statsPtr->numExecutions / (float)statsPtr->numCompilations); @@ -9542,7 +9166,7 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, " Mean inst/execution\t\t%.0f\n", numInstructions / statsPtr->numExecutions); - Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%" TCL_Z_MODIFIER "d\n", statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n", statsPtr->totalSrcBytes); @@ -9552,11 +9176,11 @@ EvalStatsCmd( statsPtr->totalByteCodeBytes); Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n", totalLiteralBytes); - Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", - (unsigned long) sizeof(LiteralTable), - (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), - (unsigned long) (statsPtr->numLiteralsCreated * sizeof(LiteralEntry)), - (unsigned long) (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj)), + Tcl_AppendPrintfToObj(objPtr, " table %" TCL_Z_MODIFIER "u + bkts %" TCL_Z_MODIFIER "u + entries %" TCL_Z_MODIFIER "u + objects %" TCL_Z_MODIFIER "u + strings %.6g\n", + sizeof(LiteralTable), + iPtr->literalTable.numBuckets * sizeof(LiteralEntry *), + statsPtr->numLiteralsCreated * sizeof(LiteralEntry), + statsPtr->numLiteralsCreated * sizeof(Tcl_Obj), statsPtr->totalLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Mean code/compile\t\t%.1f\n", totalCodeBytes / statsPtr->numCompilations); @@ -9573,11 +9197,11 @@ EvalStatsCmd( statsPtr->currentByteCodeBytes); Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n", currentLiteralBytes); - Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", - (unsigned long) sizeof(LiteralTable), - (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), - (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)), - (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)), + Tcl_AppendPrintfToObj(objPtr, " table %" TCL_Z_MODIFIER "u + bkts %" TCL_Z_MODIFIER "u + entries %" TCL_Z_MODIFIER "u + objects %" TCL_Z_MODIFIER "u + strings %.6g\n", + sizeof(LiteralTable), + iPtr->literalTable.numBuckets * sizeof(LiteralEntry *), + iPtr->literalTable.numEntries * sizeof(LiteralEntry), + iPtr->literalTable.numEntries * sizeof(Tcl_Obj), statsPtr->currentLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n", currentCodeBytes / statsPtr->currentSrcBytes); @@ -9597,11 +9221,11 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, " Object had refcount <=1 (not shared)\t%ld\n", tclObjsShared[1]); for (i = 2; i < TCL_MAX_SHARED_OBJ_STATS; i++) { - Tcl_AppendPrintfToObj(objPtr, " refcount ==%d\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, " refcount ==%" TCL_Z_MODIFIER "d\t\t%ld\n", i, tclObjsShared[i]); numSharedMultX += tclObjsShared[i]; } - Tcl_AppendPrintfToObj(objPtr, " refcount >=%d\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, " refcount >=%" TCL_Z_MODIFIER "d\t\t%ld\n", i, tclObjsShared[0]); numSharedMultX += tclObjsShared[0]; Tcl_AppendPrintfToObj(objPtr, " Total shared objects\t\t\t%d\n", @@ -9645,10 +9269,10 @@ EvalStatsCmd( tclObjsAlloced); Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%ld\n", (tclObjsAlloced - tclObjsFreed)); - Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "d\n", statsPtr->numLiteralsCreated); - Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n", + Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_Z_MODIFIER "d (%0.1f%% of current objects)\n", globalTablePtr->numEntries, Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed)); Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%ld (%0.1f%% of current literals)\n", @@ -9739,14 +9363,14 @@ EvalStatsCmd( for (i = 0; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->literalCount[i]; - Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", + Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "d\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numLiteralsCreated)); } litTableStats = TclLiteralStats(globalTablePtr); Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n", litTableStats); - ckfree(litTableStats); + Tcl_Free(litTableStats); /* * Source and ByteCode size distributions. @@ -9771,7 +9395,7 @@ EvalStatsCmd( for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->srcCount[i]; - Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", + Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "d\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } @@ -9794,7 +9418,7 @@ EvalStatsCmd( for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->byteCodeCount[i]; - Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", + Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "d\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } @@ -9826,8 +9450,8 @@ EvalStatsCmd( */ Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n"); - for (i = 0; i <= LAST_INST_OPCODE; i++) { - Tcl_AppendPrintfToObj(objPtr, "%20s %8ld ", + for (i = 0; i < LAST_INST_OPCODE; i++) { + Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "d ", tclInstructionTable[i].name, statsPtr->instructionCount[i]); if (statsPtr->instructionCount[i]) { Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n", diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index a4dded2..5c6883d 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -1389,7 +1389,7 @@ TclFileTemporaryCmd( TclNewObj(nameObj); } if (objc > 2) { - int length; + size_t length; Tcl_Obj *templateObj = objv[2]; const char *string = TclGetStringFromObj(templateObj, &length); diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 7dba19c..33980eb 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -537,7 +537,7 @@ TclpNativeSplitPath( * *argcPtr will get filled in with the number of valid elements in the * array. A single block of memory is dynamically allocated to hold both * the argv array and a copy of the path elements. The caller must - * eventually free this memory by calling ckfree() on *argvPtr. Note: + * eventually free this memory by calling Tcl_Free() on *argvPtr. Note: * *argvPtr and *argcPtr are only modified if the procedure returns * normally. * @@ -578,7 +578,7 @@ Tcl_SplitPath( size = 1; for (i = 0; i < *argcPtr; i++) { Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr); - TclGetStringFromObj(eltPtr, &len); + (void)TclGetStringFromObj(eltPtr, &len); size += len + 1; } @@ -587,7 +587,7 @@ Tcl_SplitPath( * plus the argv pointers and the terminating NULL pointer. */ - *argvPtr = ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size); + *argvPtr = Tcl_Alloc((((*argcPtr) + 1) * sizeof(char *)) + size); /* * Position p after the last argv pointer and copy the contents of the @@ -642,7 +642,7 @@ static Tcl_Obj * SplitUnixPath( const char *path) /* Pointer to string containing a path. */ { - int length; + size_t length; const char *origPath = path, *elementStart; Tcl_Obj *result = Tcl_NewObj(); @@ -731,7 +731,7 @@ static Tcl_Obj * SplitWinPath( const char *path) /* Pointer to string containing a path. */ { - int length; + size_t length; const char *p, *elementStart; Tcl_PathType type = TCL_PATH_ABSOLUTE; Tcl_DString buf; @@ -821,12 +821,12 @@ Tcl_FSJoinToPath( return TclJoinPath(2, pair, 0); } else { int elemc = objc + 1; - Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj *)); + Tcl_Obj *ret, **elemv = Tcl_Alloc(elemc*sizeof(Tcl_Obj *)); elemv[0] = pathPtr; memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *)); ret = TclJoinPath(elemc, elemv, 0); - ckfree(elemv); + Tcl_Free(elemv); return ret; } } @@ -852,7 +852,8 @@ TclpNativeJoinPath( Tcl_Obj *prefix, const char *joining) { - int length, needsSep; + int needsSep; + size_t length; char *dest; const char *p; const char *start; @@ -885,7 +886,7 @@ TclpNativeJoinPath( if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); - TclGetStringFromObj(prefix, &length); + (void)TclGetStringFromObj(prefix, &length); } needsSep = 0; @@ -921,7 +922,7 @@ TclpNativeJoinPath( if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); - TclGetStringFromObj(prefix, &length); + (void)TclGetStringFromObj(prefix, &length); } needsSep = 0; @@ -1456,7 +1457,7 @@ Tcl_GlobObjCmd( globTypes->macCreator = NULL; while (--length >= 0) { - int len; + size_t len; const char *str; Tcl_ListObjIndex(interp, typePtr, length, &look); @@ -1514,9 +1515,10 @@ Tcl_GlobObjCmd( } else { Tcl_Obj *item; + int llen; - if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) - && (len == 3)) { + if ((Tcl_ListObjLength(NULL, look, &llen) == TCL_OK) + && (llen == 3)) { Tcl_ListObjIndex(interp, look, 0, &item); if (!strcmp("macintosh", Tcl_GetString(item))) { Tcl_ListObjIndex(interp, look, 1, &item); @@ -2381,7 +2383,7 @@ DoGlob( */ if (*p == '\0') { - int length; + size_t length; Tcl_DString append; /* @@ -2512,7 +2514,7 @@ DoGlob( * * Results: * A pointer to a Tcl_StatBuf which may be deallocated by being passed to - * ckfree(). + * Tcl_Free(). * * Side effects: * None. @@ -2523,7 +2525,7 @@ DoGlob( Tcl_StatBuf * Tcl_AllocStatBuf(void) { - return ckalloc(sizeof(Tcl_StatBuf)); + return Tcl_Alloc(sizeof(Tcl_StatBuf)); } /* diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h index 1eec7ff..684407c 100644 --- a/generic/tclFileSystem.h +++ b/generic/tclFileSystem.h @@ -30,7 +30,7 @@ MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp, MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr, const Tcl_Filesystem **fsPtrPtr); MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr, - const Tcl_Filesystem *fsPtr, ClientData clientData); + const Tcl_Filesystem *fsPtr, void *clientData); MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp, Tcl_Obj *pathPtr); MODULE_SCOPE size_t TclFSEpoch(void); diff --git a/generic/tclGet.c b/generic/tclGet.c index 12e0e79..4811c42 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -142,7 +142,7 @@ Tcl_GetBoolean( Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } if (code == TCL_OK) { - TclGetBooleanFromObj(NULL, &obj, boolPtr); + *boolPtr = obj.internalRep.wideValue != 0; } return code; } diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 59f85bd..017f3c0 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -89,8 +89,8 @@ typedef struct DateInfo { int dateDigitCount; } DateInfo; -#define YYMALLOC ckalloc -#define YYFREE(x) (ckfree((void*) (x))) +#define YYMALLOC Tcl_Alloc +#define YYFREE(x) (Tcl_Free((void*) (x))) #define yyDSTmode (info->dateDSTmode) #define yyDayOrdinal (info->dateDayOrdinal) @@ -1064,16 +1064,16 @@ TclClockOldscanObjCmd( resultElement = Tcl_NewObj(); if (yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyYear)); + Tcl_NewIntObj(yyYear)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj(yyMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDay)); + Tcl_NewIntObj(yyDay)); } Tcl_ListObjAppendElement(interp, result, resultElement); if (yyHaveTime) { - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj( ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian))); } else { Tcl_ListObjAppendElement(interp, result, Tcl_NewObj()); @@ -1082,7 +1082,7 @@ TclClockOldscanObjCmd( resultElement = Tcl_NewObj(); if (yyHaveZone) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) -yyTimezone)); + Tcl_NewIntObj(-yyTimezone)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj(1 - yyDSTmode)); } @@ -1091,29 +1091,29 @@ TclClockOldscanObjCmd( resultElement = Tcl_NewObj(); if (yyHaveRel) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelMonth)); + Tcl_NewIntObj(yyRelMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelDay)); + Tcl_NewIntObj(yyRelDay)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelSeconds)); + Tcl_NewIntObj(yyRelSeconds)); } Tcl_ListObjAppendElement(interp, result, resultElement); resultElement = Tcl_NewObj(); if (yyHaveDay && !yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDayOrdinal)); + Tcl_NewIntObj(yyDayOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDayNumber)); + Tcl_NewIntObj(yyDayNumber)); } Tcl_ListObjAppendElement(interp, result, resultElement); resultElement = Tcl_NewObj(); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonthOrdinal)); + Tcl_NewIntObj(yyMonthOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj(yyMonth)); } Tcl_ListObjAppendElement(interp, result, resultElement); diff --git a/generic/tclHash.c b/generic/tclHash.c index 32c9aec..2ab4292 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -14,13 +14,6 @@ #include "tclInt.h" /* - * Prevent macros from clashing with function definitions. - */ - -#undef Tcl_FindHashEntry -#undef Tcl_CreateHashEntry - -/* * When there are this many entries per bucket, on average, rebuild the hash * table to make it larger. */ @@ -35,7 +28,7 @@ */ #define RANDOM_INDEX(tablePtr, i) \ - ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask) + ((((i)*(size_t)1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask) /* * Prototypes for the array hash key methods. @@ -200,7 +193,7 @@ Tcl_InitCustomHashTable( /* *---------------------------------------------------------------------- * - * Tcl_FindHashEntry -- + * FindHashEntry -- * * Given a hash table find the entry with a matching key. * @@ -214,14 +207,6 @@ Tcl_InitCustomHashTable( *---------------------------------------------------------------------- */ -Tcl_HashEntry * -Tcl_FindHashEntry( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const void *key) /* Key to use to find matching entry. */ -{ - return (*((tablePtr)->findProc))(tablePtr, key); -} - static Tcl_HashEntry * FindHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ @@ -234,7 +219,7 @@ FindHashEntry( /* *---------------------------------------------------------------------- * - * Tcl_CreateHashEntry -- + * CreateHashEntry -- * * Given a hash table with string keys, and a string key, find the entry * with a matching key. If there is no matching entry, then create a new @@ -252,17 +237,6 @@ FindHashEntry( *---------------------------------------------------------------------- */ -Tcl_HashEntry * -Tcl_CreateHashEntry( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const void *key, /* Key to use to find or create matching - * entry. */ - int *newPtr) /* Store info here telling whether a new entry - * was created. */ -{ - return (*((tablePtr)->createProc))(tablePtr, key, newPtr); -} - static Tcl_HashEntry * CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ @@ -273,8 +247,7 @@ CreateHashEntry( { register Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; - unsigned int hash; - int index; + size_t hash, index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -295,7 +268,7 @@ CreateHashEntry( index = hash & tablePtr->mask; } } else { - hash = PTR2UINT(key); + hash = (size_t) key; index = RANDOM_INDEX(tablePtr, hash); } @@ -308,7 +281,7 @@ CreateHashEntry( for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != hPtr->hash) { continue; } if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) { @@ -321,7 +294,7 @@ CreateHashEntry( } else { for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != hPtr->hash) { continue; } if (key == hPtr->key.oneWordValue) { @@ -345,13 +318,13 @@ CreateHashEntry( if (typePtr->allocEntryProc) { hPtr = typePtr->allocEntryProc(tablePtr, (void *) key); } else { - hPtr = ckalloc(sizeof(Tcl_HashEntry)); + hPtr = Tcl_Alloc(sizeof(Tcl_HashEntry)); hPtr->key.oneWordValue = (char *) key; - hPtr->clientData = 0; + Tcl_SetHashValue(hPtr, NULL); } hPtr->tablePtr = tablePtr; - hPtr->hash = UINT2PTR(hash); + hPtr->hash = hash; hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; tablePtr->numEntries++; @@ -393,7 +366,7 @@ Tcl_DeleteHashEntry( const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; - int index; + size_t index; tablePtr = entryPtr->tablePtr; @@ -410,9 +383,9 @@ Tcl_DeleteHashEntry( if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash)); + index = RANDOM_INDEX(tablePtr, entryPtr->hash); } else { - index = PTR2UINT(entryPtr->hash) & tablePtr->mask; + index = entryPtr->hash & tablePtr->mask; } bucketPtr = &tablePtr->buckets[index]; @@ -435,7 +408,7 @@ Tcl_DeleteHashEntry( if (typePtr->freeEntryProc) { typePtr->freeEntryProc(entryPtr); } else { - ckfree(entryPtr); + Tcl_Free(entryPtr); } } @@ -462,7 +435,7 @@ Tcl_DeleteHashTable( { register Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; - int i; + size_t i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -486,7 +459,7 @@ Tcl_DeleteHashTable( if (typePtr->freeEntryProc) { typePtr->freeEntryProc(hPtr); } else { - ckfree(hPtr); + Tcl_Free(hPtr); } hPtr = nextPtr; } @@ -500,7 +473,7 @@ Tcl_DeleteHashTable( if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { TclpSysFree((char *) tablePtr->buckets); } else { - ckfree(tablePtr->buckets); + Tcl_Free(tablePtr->buckets); } } @@ -611,7 +584,7 @@ Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - int count[NUM_COUNTERS], overflow, i, j; + size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; register Tcl_HashEntry *hPtr; char *result, *p; @@ -645,16 +618,16 @@ Tcl_HashStats( * Print out the histogram and a few other pieces of information. */ - result = ckalloc((NUM_COUNTERS * 60) + 300); - sprintf(result, "%d entries in table, %d buckets\n", + result = Tcl_Alloc((NUM_COUNTERS * 60) + 300); + sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i = 0; i < NUM_COUNTERS; i++) { - sprintf(p, "number of buckets with %d entries: %d\n", + sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n", i, count[i]); p += strlen(p); } - sprintf(p, "number of buckets with %d or more entries: %d\n", + sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n", NUM_COUNTERS, overflow); p += strlen(p); sprintf(p, "average search distance for entry: %.1f", average); @@ -680,13 +653,13 @@ Tcl_HashStats( static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key to store in the hash table entry. */ + void *keyPtr) /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; register int *iPtr1, *iPtr2; Tcl_HashEntry *hPtr; int count; - unsigned int size; + size_t size; count = tablePtr->keyType; @@ -694,13 +667,13 @@ AllocArrayEntry( if (size < sizeof(Tcl_HashEntry)) { size = sizeof(Tcl_HashEntry); } - hPtr = ckalloc(size); + hPtr = Tcl_Alloc(size); for (iPtr1 = array, iPtr2 = hPtr->key.words; count > 0; count--, iPtr1++, iPtr2++) { *iPtr2 = *iPtr1; } - hPtr->clientData = 0; + Tcl_SetHashValue(hPtr, NULL); return hPtr; } @@ -724,11 +697,11 @@ AllocArrayEntry( static int CompareArrayKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - register const int *iPtr1 = (const int *) keyPtr; - register const int *iPtr2 = (const int *) hPtr->key.words; + const int *iPtr1 = keyPtr; + const int *iPtr2 = hPtr->key.words; Tcl_HashTable *tablePtr = hPtr->tablePtr; int count; @@ -764,17 +737,17 @@ CompareArrayKeys( static TCL_HASH_TYPE HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { register const int *array = (const int *) keyPtr; - register unsigned int result; + register TCL_HASH_TYPE result; int count; for (result = 0, count = tablePtr->keyType; count > 0; count--, array++) { result += *array; } - return (TCL_HASH_TYPE) result; + return result; } /* @@ -796,19 +769,19 @@ HashArrayKey( static Tcl_HashEntry * AllocStringEntry( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key to store in the hash table entry. */ + void *keyPtr) /* Key to store in the hash table entry. */ { const char *string = (const char *) keyPtr; Tcl_HashEntry *hPtr; - unsigned int size, allocsize; + size_t size, allocsize; allocsize = size = strlen(string) + 1; if (size < sizeof(hPtr->key)) { allocsize = sizeof(hPtr->key); } - hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize); + hPtr = Tcl_Alloc(TclOffset(Tcl_HashEntry, key) + allocsize); memcpy(hPtr->key.string, string, size); - hPtr->clientData = 0; + Tcl_SetHashValue(hPtr, NULL); return hPtr; } @@ -831,13 +804,10 @@ AllocStringEntry( static int CompareStringKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - register const char *p1 = (const char *) keyPtr; - register const char *p2 = (const char *) hPtr->key.string; - - return !strcmp(p1, p2); + return !strcmp(keyPtr, hPtr->key.string); } /* @@ -860,10 +830,10 @@ CompareStringKeys( static TCL_HASH_TYPE HashStringKey( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { register const char *string = keyPtr; - register unsigned int result; + register TCL_HASH_TYPE result; register char c; /* @@ -903,7 +873,7 @@ HashStringKey( result += (result << 3) + UCHAR(c); } } - return (TCL_HASH_TYPE) result; + return result; } /* @@ -985,14 +955,14 @@ static void RebuildTable( register Tcl_HashTable *tablePtr) /* Table to enlarge. */ { - int count, index, oldSize = tablePtr->numBuckets; + size_t count, index, oldSize = tablePtr->numBuckets; Tcl_HashEntry **oldBuckets = tablePtr->buckets; register Tcl_HashEntry **oldChainPtr, **newChainPtr; register Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; /* Avoid outgrowing capability of the memory allocators */ - if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) { + if (oldSize > UINT_MAX / (4 * sizeof(Tcl_HashEntry *))) { tablePtr->rebuildSize = INT_MAX; return; } @@ -1015,18 +985,20 @@ RebuildTable( tablePtr->numBuckets *= 4; if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { - tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned) - (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0); + tablePtr->buckets = TclpSysAlloc( + tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } else { tablePtr->buckets = - ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); + Tcl_Alloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets; count > 0; count--, newChainPtr++) { *newChainPtr = NULL; } tablePtr->rebuildSize *= 4; - tablePtr->downShift -= 2; + if (tablePtr->downShift > 1) { + tablePtr->downShift -= 2; + } tablePtr->mask = (tablePtr->mask << 2) + 3; /* @@ -1038,9 +1010,9 @@ RebuildTable( *oldChainPtr = hPtr->nextPtr; if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash)); + index = RANDOM_INDEX(tablePtr, hPtr->hash); } else { - index = PTR2UINT(hPtr->hash) & tablePtr->mask; + index = hPtr->hash & tablePtr->mask; } hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; @@ -1055,7 +1027,7 @@ RebuildTable( if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { TclpSysFree((char *) oldBuckets); } else { - ckfree(oldBuckets); + Tcl_Free(oldBuckets); } } } diff --git a/generic/tclHistory.c b/generic/tclHistory.c index 47806d4..eb12651 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -74,13 +74,6 @@ Tcl_RecordAndEval( result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* * Discard the Tcl object created to hold the command. */ @@ -137,7 +130,7 @@ Tcl_RecordAndEvalObj( */ if (histObjsPtr == NULL) { - histObjsPtr = ckalloc(sizeof(HistoryObjs)); + histObjsPtr = Tcl_Alloc(sizeof(HistoryObjs)); TclNewLiteralStringObj(histObjsPtr->historyObj, "::history"); TclNewLiteralStringObj(histObjsPtr->addObj, "add"); Tcl_IncrRefCount(histObjsPtr->historyObj); @@ -217,7 +210,7 @@ DeleteHistoryObjs( TclDecrRefCount(histObjsPtr->historyObj); TclDecrRefCount(histObjsPtr->addObj); - ckfree(histObjsPtr); + Tcl_Free(histObjsPtr); } /* diff --git a/generic/tclIO.c b/generic/tclIO.c index 7c93e1a..da6c4f1 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -191,9 +191,9 @@ static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan); static void DiscardInputQueued(ChannelState *statePtr, int discardSavedBuffers); static void DiscardOutputQueued(ChannelState *chanPtr); -static int DoRead(Channel *chanPtr, char *dst, int bytesToRead, +static int DoRead(Channel *chanPtr, char *dst, size_t bytesToRead, int allowShortReads); -static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead, +static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, size_t toRead, int appendFlag); static int FilterInputBytes(Channel *chanPtr, GetsState *statePtr); @@ -239,7 +239,7 @@ static int WillRead(Channel *chanPtr); * short description of what the macro does. * * -------------------------------------------------------------------------- - * int BytesLeft(ChannelBuffer *bufPtr) + * size_t BytesLeft(ChannelBuffer *bufPtr) * * Returns the number of bytes of data remaining in the buffer. * @@ -277,9 +277,9 @@ static int WillRead(Channel *chanPtr); * -------------------------------------------------------------------------- */ -#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved) +#define BytesLeft(bufPtr) ((size_t)((bufPtr)->nextAdded - (bufPtr)->nextRemoved)) -#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded) +#define SpaceLeft(bufPtr) ((size_t)((bufPtr)->bufLength - (bufPtr)->nextAdded)) #define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved) @@ -440,7 +440,7 @@ ChanRead( } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; - if (WillRead(chanPtr) < 0) { + if (WillRead(chanPtr) == -1) { return -1; } @@ -456,7 +456,16 @@ ChanRead( } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; - if (bytesRead > 0) { + if (bytesRead == -1) { + if ((result == EWOULDBLOCK) || (result == EAGAIN)) { + SetFlag(chanPtr->state, CHANNEL_BLOCKED); + result = EAGAIN; + } + Tcl_SetErrno(result); + } else if (bytesRead == 0) { + SetFlag(chanPtr->state, CHANNEL_EOF); + chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; + } else { /* * If we get a short read, signal up that we may be BLOCKED. We should * avoid calling the driver because on some platforms we will block in @@ -467,15 +476,6 @@ ChanRead( if (bytesRead < dstSize) { SetFlag(chanPtr->state, CHANNEL_BLOCKED); } - } else if (bytesRead == 0) { - SetFlag(chanPtr->state, CHANNEL_EOF); - chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; - } else if (bytesRead < 0) { - if ((result == EWOULDBLOCK) || (result == EAGAIN)) { - SetFlag(chanPtr->state, CHANNEL_BLOCKED); - result = EAGAIN; - } - Tcl_SetErrno(result); } return bytesRead; } @@ -673,7 +673,7 @@ TclFinalizeIOSubsystem(void) statePtr->refCount--; } - if (statePtr->refCount <= 0) { + if (statePtr->refCount + 1 <= 1) { /* * Close it only if the refcount indicates that the channel is * not referenced from any interpreter. If it is, that @@ -860,7 +860,7 @@ Tcl_CreateCloseHandler( ChannelState *statePtr = ((Channel *) chan)->state; CloseCallback *cbPtr; - cbPtr = ckalloc(sizeof(CloseCallback)); + cbPtr = Tcl_Alloc(sizeof(CloseCallback)); cbPtr->proc = proc; cbPtr->clientData = clientData; @@ -906,7 +906,7 @@ Tcl_DeleteCloseHandler( } else { cbPrevPtr->nextPtr = cbPtr->nextPtr; } - ckfree(cbPtr); + Tcl_Free(cbPtr); break; } cbPrevPtr = cbPtr; @@ -941,7 +941,7 @@ GetChannelTable( hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { - hTblPtr = ckalloc(sizeof(Tcl_HashTable)); + hTblPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS); Tcl_SetAssocData(interp, "tclIO", (Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr); @@ -1033,7 +1033,7 @@ DeleteChannelTable( TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); - ckfree(sPtr); + Tcl_Free(sPtr); } else { prevPtr = sPtr; } @@ -1056,7 +1056,7 @@ DeleteChannelTable( } Tcl_DeleteHashTable(hTblPtr); - ckfree(hTblPtr); + Tcl_Free(hTblPtr); } /* @@ -1091,7 +1091,7 @@ CheckForStdChannelsBeingClosed( if (tsdPtr->stdinInitialized == 1 && tsdPtr->stdinChannel != NULL && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) { - if (statePtr->refCount < 2) { + if (statePtr->refCount + 1 < 3) { statePtr->refCount = 0; tsdPtr->stdinChannel = NULL; return; @@ -1099,7 +1099,7 @@ CheckForStdChannelsBeingClosed( } else if (tsdPtr->stdoutInitialized == 1 && tsdPtr->stdoutChannel != NULL && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) { - if (statePtr->refCount < 2) { + if (statePtr->refCount + 1 < 3) { statePtr->refCount = 0; tsdPtr->stdoutChannel = NULL; return; @@ -1107,7 +1107,7 @@ CheckForStdChannelsBeingClosed( } else if (tsdPtr->stderrInitialized == 1 && tsdPtr->stderrChannel != NULL && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) { - if (statePtr->refCount < 2) { + if (statePtr->refCount + 1 < 3) { statePtr->refCount = 0; tsdPtr->stderrChannel = NULL; return; @@ -1269,7 +1269,7 @@ Tcl_UnregisterChannel( * If the refCount reached zero, close the actual channel. */ - if (statePtr->refCount <= 0) { + if (statePtr->refCount + 1 <= 1) { Tcl_Preserve(statePtr); if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { /* @@ -1565,7 +1565,7 @@ TclGetChannelFromObj( Tcl_Release((ClientData) resPtr->statePtr); } else { - resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName)); + resPtr = (ResolvedChanName *) Tcl_Alloc(sizeof(ResolvedChanName)); resPtr->refCount = 0; ChanSetIntRep(objPtr, resPtr); /* Overwrites, if needed */ } @@ -1649,8 +1649,8 @@ Tcl_CreateChannel( * assignments to 0/NULL below. */ - chanPtr = ckalloc(sizeof(Channel)); - statePtr = ckalloc(sizeof(ChannelState)); + chanPtr = Tcl_Alloc(sizeof(Channel)); + statePtr = Tcl_Alloc(sizeof(ChannelState)); chanPtr->state = statePtr; chanPtr->instanceData = instanceData; @@ -1669,10 +1669,10 @@ Tcl_CreateChannel( * later. */ - tmp = ckalloc((len < 7) ? 7 : len); + tmp = Tcl_Alloc((len < 7) ? 7 : len); strcpy(tmp, chanName); } else { - tmp = ckalloc(7); + tmp = Tcl_Alloc(7); tmp[0] = '\0'; } statePtr->channelName = tmp; @@ -1945,7 +1945,7 @@ Tcl_StackChannel( statePtr->inQueueTail = NULL; } - chanPtr = ckalloc(sizeof(Channel)); + chanPtr = Tcl_Alloc(sizeof(Channel)); /* * Save some of the current state into the new structure, reinitialize the @@ -2007,7 +2007,7 @@ TclChannelRelease( return; } if (chanPtr->typePtr == NULL) { - ckfree(chanPtr); + Tcl_Free(chanPtr); } } @@ -2015,8 +2015,8 @@ static void ChannelFree( Channel *chanPtr) { - if (chanPtr->refCount == 0) { - ckfree(chanPtr); + if (!chanPtr->refCount) { + Tcl_Free(chanPtr); return; } chanPtr->typePtr = NULL; @@ -2187,7 +2187,7 @@ Tcl_UnstackChannel( * necessary. */ - if (statePtr->refCount <= 0) { + if (statePtr->refCount + 1 <= 1) { if (Tcl_Close(interp, chan) != TCL_OK) { /* * TIP #219, Tcl Channel Reflection API. @@ -2474,7 +2474,7 @@ AllocChannelBuffer( int n; n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING; - bufPtr = ckalloc(n); + bufPtr = Tcl_Alloc(n); bufPtr->nextAdded = BUFFER_PADDING; bufPtr->nextRemoved = BUFFER_PADDING; bufPtr->bufLength = length + BUFFER_PADDING; @@ -2487,7 +2487,7 @@ static void PreserveChannelBuffer( ChannelBuffer *bufPtr) { - if (bufPtr->refCount == 0) { + if (!bufPtr->refCount) { Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr); } bufPtr->refCount++; @@ -2500,14 +2500,14 @@ ReleaseChannelBuffer( if (--bufPtr->refCount) { return; } - ckfree(bufPtr); + Tcl_Free(bufPtr); } static int IsShared( ChannelBuffer *bufPtr) { - return bufPtr->refCount > 1; + return bufPtr->refCount + 1 > 2; } /* @@ -2943,7 +2943,7 @@ FlushChannel( * current output buffer. */ - if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) && + if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount + 1 <= 1) && (statePtr->outQueueHead == NULL) && ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { @@ -3079,7 +3079,7 @@ CloseChannel( if (chanPtr == statePtr->bottomChanPtr) { if (statePtr->channelName != NULL) { - ckfree(statePtr->channelName); + Tcl_Free(statePtr->channelName); statePtr->channelName = NULL; } @@ -3410,7 +3410,7 @@ Tcl_Close( statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; - if (statePtr->refCount > 0) { + if (statePtr->refCount + 1 > 1) { Tcl_Panic("called Tcl_Close on channel with refCount > 0"); } @@ -3470,7 +3470,7 @@ Tcl_Close( cbPtr = statePtr->closeCbPtr; statePtr->closeCbPtr = cbPtr->nextPtr; cbPtr->proc(cbPtr->clientData); - ckfree(cbPtr); + Tcl_Free(cbPtr); } ResetFlag(statePtr, CHANNEL_INCLOSE); @@ -3940,7 +3940,7 @@ Tcl_ClearChannelHandlers( for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) { chNext = chPtr->nextPtr; - ckfree(chPtr); + Tcl_Free(chPtr); } statePtr->chPtr = NULL; @@ -3967,7 +3967,7 @@ Tcl_ClearChannelHandlers( for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) { eNextPtr = ePtr->nextPtr; TclDecrRefCount(ePtr->scriptPtr); - ckfree(ePtr); + Tcl_Free(ePtr); } statePtr->scriptRecordPtr = NULL; } @@ -3986,8 +3986,8 @@ Tcl_ClearChannelHandlers( * No encoding conversions are applied to the bytes being read. * * Results: - * The number of bytes written or -1 in case of error. If -1, - * Tcl_GetErrno will return the error code. + * The number of bytes written or TCL_IO_FAILURE in case of error. If + * TCL_IO_FAILURE, Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the @@ -3996,11 +3996,11 @@ Tcl_ClearChannelHandlers( *---------------------------------------------------------------------- */ -int +size_t Tcl_Write( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ - int srcLen) /* Length of data in bytes, or < 0 for + size_t srcLen) /* Length of data in bytes, or -1 for * strlen(). */ { /* @@ -4014,14 +4014,14 @@ Tcl_Write( chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return -1; + return TCL_IO_FAILURE; } - if (srcLen < 0) { + if (srcLen == TCL_AUTO_LENGTH) { srcLen = strlen(src); } - if (WriteBytes(chanPtr, src, srcLen) < 0) { - return -1; + if (WriteBytes(chanPtr, src, srcLen) == -1) { + return TCL_IO_FAILURE; } return srcLen; } @@ -4040,8 +4040,8 @@ Tcl_Write( * No encoding conversions are applied to the bytes being read. * * Results: - * The number of bytes written or -1 in case of error. If -1, - * Tcl_GetErrno will return the error code. + * The number of bytes written or TCL_IO_FAILURE in case of error. If + * TCL_IO_FAILURE, Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the @@ -4050,23 +4050,24 @@ Tcl_Write( *---------------------------------------------------------------------- */ -int +size_t Tcl_WriteRaw( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ - int srcLen) /* Length of data in bytes, or < 0 for + size_t srcLen) /* Length of data in bytes, or -1 for * strlen(). */ { Channel *chanPtr = ((Channel *) chan); ChannelState *statePtr = chanPtr->state; /* State info for channel */ - int errorCode, written; + int errorCode; + size_t written; if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) { - return -1; + return TCL_IO_FAILURE; } - if (srcLen < 0) { + if (srcLen == TCL_AUTO_LENGTH) { srcLen = strlen(src); } @@ -4076,7 +4077,7 @@ Tcl_WriteRaw( */ written = ChanWrite(chanPtr, src, srcLen, &errorCode); - if (written < 0) { + if (written == TCL_IO_FAILURE) { Tcl_SetErrno(errorCode); } @@ -4096,8 +4097,8 @@ Tcl_WriteRaw( * specified channel to the topmost channel in a stack. * * Results: - * The number of bytes written or -1 in case of error. If -1, - * Tcl_GetErrno will return the error code. + * The number of bytes written or TCL_IO_FAILURE in case of error. If + * TCL_IO_FAILURE, Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the @@ -4106,12 +4107,12 @@ Tcl_WriteRaw( *---------------------------------------------------------------------- */ -int +size_t Tcl_WriteChars( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* UTF-8 characters to queue in output * buffer. */ - int len) /* Length of string in bytes, or < 0 for + size_t len) /* Length of string in bytes, or -1 for * strlen(). */ { Channel *chanPtr = (Channel *) chan; @@ -4120,12 +4121,12 @@ Tcl_WriteChars( Tcl_Obj *objPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return -1; + return TCL_IO_FAILURE; } chanPtr = statePtr->topChanPtr; - if (len < 0) { + if (len == TCL_AUTO_LENGTH) { len = strlen(src); } if (statePtr->encoding) { @@ -4144,7 +4145,7 @@ Tcl_WriteChars( } objPtr = Tcl_NewStringObj(src, len); - src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len); + src = (char *) TclGetByteArrayFromObj(objPtr, &len); result = WriteBytes(chanPtr, src, len); TclDecrRefCount(objPtr); return result; @@ -4175,7 +4176,7 @@ Tcl_WriteChars( *---------------------------------------------------------------------- */ -int +size_t Tcl_WriteObj( Tcl_Channel chan, /* The channel to buffer output for. */ Tcl_Obj *objPtr) /* The object to write. */ @@ -4187,16 +4188,16 @@ Tcl_WriteObj( Channel *chanPtr; ChannelState *statePtr; /* State info for channel */ const char *src; - int srcLen; + size_t srcLen; statePtr = ((Channel *) chan)->state; chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return -1; + return TCL_IO_FAILURE; } if (statePtr->encoding == NULL) { - src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen); + src = (char *) TclGetByteArrayFromObj(objPtr, &srcLen); return WriteBytes(chanPtr, src, srcLen); } else { src = TclGetStringFromObj(objPtr, &srcLen); @@ -4469,7 +4470,7 @@ Write( *--------------------------------------------------------------------------- */ -int +size_t Tcl_Gets( Tcl_Channel chan, /* Channel from which to read. */ Tcl_DString *lineRead) /* The line read will be appended to this @@ -4478,11 +4479,11 @@ Tcl_Gets( * for managing the storage. */ { Tcl_Obj *objPtr; - int charsStored; + size_t charsStored; TclNewObj(objPtr); charsStored = Tcl_GetsObj(chan, objPtr); - if (charsStored > 0) { + if (charsStored + 1 > 1) { TclDStringAppendObj(lineRead, objPtr); } TclDecrRefCount(objPtr); @@ -4512,7 +4513,7 @@ Tcl_Gets( *--------------------------------------------------------------------------- */ -int +size_t Tcl_GetsObj( Tcl_Channel chan, /* Channel from which to read. */ Tcl_Obj *objPtr) /* The line read will be appended to this @@ -4529,7 +4530,7 @@ Tcl_GetsObj( Tcl_EncodingState oldState; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - return -1; + return TCL_IO_FAILURE; } /* @@ -4544,7 +4545,7 @@ Tcl_GetsObj( /* TODO: Do we need this? */ UpdateInterest(chanPtr); - return -1; + return TCL_IO_FAILURE; } /* @@ -4574,7 +4575,7 @@ Tcl_GetsObj( * newline in the available input. */ - TclGetStringFromObj(objPtr, &oldLength); + (void)TclGetStringFromObj(objPtr, &oldLength); oldFlags = statePtr->inputEncodingFlags; oldState = statePtr->inputEncodingState; oldRemoved = BUFFER_PADDING; @@ -4671,7 +4672,7 @@ Tcl_GetsObj( */ if (eol >= dstEnd) { - int offset; + size_t offset; if (eol != eof) { offset = eol - objPtr->bytes; @@ -4938,8 +4939,9 @@ TclGetsObjBinary( ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; - int rawLen, byteLen, eolChar; + int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; + size_t rawLen, byteLen, oldLength; + int eolChar; unsigned char *dst, *dstEnd, *eol, *eof, *byteArray; /* @@ -4956,7 +4958,7 @@ TclGetsObjBinary( * newline in the available input. */ - byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen); + byteArray = TclGetByteArrayFromObj(objPtr, &byteLen); oldFlags = statePtr->inputEncodingFlags; oldRemoved = BUFFER_PADDING; oldLength = byteLen; @@ -5579,11 +5581,11 @@ CommonGetsCleanup( *---------------------------------------------------------------------- */ -int +size_t Tcl_Read( Tcl_Channel chan, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - int bytesToRead) /* Maximum number of bytes to read. */ + size_t bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; @@ -5596,7 +5598,7 @@ Tcl_Read( chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - return -1; + return TCL_IO_FAILURE; } return DoRead(chanPtr, dst, bytesToRead, 0); @@ -5624,11 +5626,11 @@ Tcl_Read( *---------------------------------------------------------------------- */ -int +size_t Tcl_ReadRaw( Tcl_Channel chan, /* The channel from which to read. */ char *readBuf, /* Where to store input read. */ - int bytesToRead) /* Maximum number of bytes to read. */ + size_t bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; @@ -5637,7 +5639,7 @@ Tcl_ReadRaw( assert(bytesToRead > 0); if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) { - return -1; + return TCL_IO_FAILURE; } /* @@ -5647,8 +5649,8 @@ Tcl_ReadRaw( while (chanPtr->inQueueHead && bytesToRead > 0) { ChannelBuffer *bufPtr = chanPtr->inQueueHead; int bytesInBuffer = BytesLeft(bufPtr); - int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer - : bytesToRead; + int toCopy = (bytesInBuffer < (int)bytesToRead) ? bytesInBuffer + : (int)bytesToRead; /* * Copy the current chunk into the read buffer. @@ -5691,13 +5693,7 @@ Tcl_ReadRaw( if (bytesToRead > 0) { int nread = ChanRead(chanPtr, readBuf, bytesToRead); - if (nread > 0) { - /* - * Successful read (short is OK) - add to bytes copied. - */ - - copied += nread; - } else if (nread < 0) { + if (nread == -1) { /* * An error signaled. If CHANNEL_BLOCKED, then the error is not * real, but an indication of blocked state. In that case, retain @@ -5711,6 +5707,12 @@ Tcl_ReadRaw( if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { copied = -1; } + } else if (nread > 0) { + /* + * Successful read (short is OK) - add to bytes copied. + */ + + copied += nread; } else { /* * nread == 0. Driver is at EOF. Let that state filter up. @@ -5742,11 +5744,11 @@ Tcl_ReadRaw( *--------------------------------------------------------------------------- */ -int +size_t Tcl_ReadChars( Tcl_Channel chan, /* The channel to read. */ Tcl_Obj *objPtr, /* Input data is stored in this object. */ - int toRead, /* Maximum number of characters to store, or + size_t toRead, /* Maximum number of characters to store, or * -1 to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel @@ -5802,7 +5804,7 @@ static int DoReadChars( Channel *chanPtr, /* The channel to read. */ Tcl_Obj *objPtr, /* Input data is stored in this object. */ - int toRead, /* Maximum number of characters to store, or + size_t toRead, /* Maximum number of characters to store, or * -1 to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel @@ -5888,7 +5890,7 @@ DoReadChars( } ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; - for (copied = 0; (unsigned) toRead > 0; ) { + for (copied = 0; toRead > 0; ) { copiedNow = -1; if (statePtr->inQueueHead != NULL) { if (binaryMode) { @@ -6006,7 +6008,7 @@ ReadBytes( * been allocated to hold data, not how many * bytes of data have been stored in the * object. */ - int bytesToRead) /* Maximum number of bytes to store, or < 0 to + int bytesToRead) /* Maximum number of bytes to store, or -1 to * get all available bytes. Bytes are obtained * from the first buffer in the queue - even * if this number is larger than the number of @@ -6106,7 +6108,7 @@ ReadChars( (void) TclGetStringFromObj(objPtr, &numBytes); Tcl_AppendToObj(objPtr, NULL, dstLimit); if (toRead == srcLen) { - unsigned int size; + size_t size; dst = TclGetStringStorage(objPtr, &size) + numBytes; dstLimit = size - numBytes; @@ -6612,7 +6614,7 @@ TranslateInputEOL( * channel, at either the head or tail of the queue. * * Results: - * The number of bytes stored in the channel, or -1 on error. + * The number of bytes stored in the channel, or TCL_IO_FAILURE on error. * * Side effects: * Adds input to the input queue of a channel. @@ -6620,11 +6622,11 @@ TranslateInputEOL( *---------------------------------------------------------------------- */ -int +size_t Tcl_Ungets( Tcl_Channel chan, /* The channel for which to add the input. */ const char *str, /* The input itself. */ - int len, /* The length of the input. */ + size_t len, /* The length of the input. */ int atEnd) /* If non-zero, add at end of queue; otherwise * add at head of queue. */ { @@ -6648,7 +6650,7 @@ Tcl_Ungets( flags = statePtr->flags; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - len = -1; + len = TCL_IO_FAILURE; goto done; } statePtr->flags = flags; @@ -6665,7 +6667,7 @@ Tcl_Ungets( statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; bufPtr = AllocChannelBuffer(len); - memcpy(InsertPoint(bufPtr), str, (size_t) len); + memcpy(InsertPoint(bufPtr), str, len); bufPtr->nextAdded += len; if (statePtr->inQueueHead == NULL) { @@ -7240,7 +7242,7 @@ Tcl_TruncateChannel( WillWrite(chanPtr); - if (WillRead(chanPtr) < 0) { + if (WillRead(chanPtr) == -1) { return TCL_ERROR; } @@ -7668,7 +7670,7 @@ Tcl_BadChannelOption( Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]); Tcl_SetObjResult(interp, errObj); Tcl_DStringFree(&ds); - ckfree(argv); + Tcl_Free(argv); } Tcl_SetErrno(EINVAL); return TCL_ERROR; @@ -8059,7 +8061,7 @@ Tcl_SetChannelOption( "bad value for -eofchar: must be non-NUL ASCII" " character", -1)); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } if (GotFlag(statePtr, TCL_READABLE)) { @@ -8074,11 +8076,11 @@ Tcl_SetChannelOption( "bad value for -eofchar: should be a list of zero," " one, or two elements", -1)); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } if (argv != NULL) { - ckfree(argv); + Tcl_Free(argv); } /* @@ -8112,7 +8114,7 @@ Tcl_SetChannelOption( "bad value for -translation: must be a one or two" " element list", -1)); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } @@ -8142,7 +8144,7 @@ Tcl_SetChannelOption( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", -1)); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } @@ -8192,11 +8194,11 @@ Tcl_SetChannelOption( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", -1)); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } } - ckfree(argv); + Tcl_Free(argv); return TCL_OK; } else if (chanPtr->typePtr->setOptionProc != NULL) { return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp, @@ -8255,7 +8257,7 @@ CleanupChannelHandlers( TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); - ckfree(sPtr); + Tcl_Free(sPtr); } else { prevPtr = sPtr; } @@ -8602,7 +8604,7 @@ Tcl_CreateChannelHandler( } } if (chPtr == NULL) { - chPtr = ckalloc(sizeof(ChannelHandler)); + chPtr = Tcl_Alloc(sizeof(ChannelHandler)); chPtr->mask = 0; chPtr->proc = proc; chPtr->clientData = clientData; @@ -8706,7 +8708,7 @@ Tcl_DeleteChannelHandler( } else { prevChPtr->nextPtr = chPtr->nextPtr; } - ckfree(chPtr); + Tcl_Free(chPtr); /* * Recompute the interest list for the channel, so that infinite loops @@ -8765,7 +8767,7 @@ DeleteScriptRecord( TclChannelEventScriptInvoker, esPtr); TclDecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + Tcl_Free(esPtr); break; } @@ -8814,7 +8816,7 @@ CreateScriptRecord( makeCH = (esPtr == NULL); if (makeCH) { - esPtr = ckalloc(sizeof(EventScriptRecord)); + esPtr = Tcl_Alloc(sizeof(EventScriptRecord)); } /* @@ -9048,20 +9050,6 @@ ZeroTransferTimerProc( *---------------------------------------------------------------------- */ -#if !defined(TCL_NO_DEPRECATED) -int -TclCopyChannelOld( - Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Channel inChan, /* Channel to read from. */ - Tcl_Channel outChan, /* Channel to write to. */ - int toRead, /* Amount of data to copy, or -1 for all. */ - Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ -{ - return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, - cmdPtr); -} -#endif - int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ @@ -9144,7 +9132,7 @@ TclCopyChannel( * completed. */ - csPtr = ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize); + csPtr = Tcl_Alloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize); csPtr->bufSize = !moveBytes * inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; @@ -9766,14 +9754,12 @@ static int DoRead( Channel *chanPtr, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - int bytesToRead, /* Maximum number of bytes to read. */ + size_t bytesToRead, /* Maximum number of bytes to read. */ int allowShortReads) /* Allow half-blocking (pipes,sockets) */ { ChannelState *statePtr = chanPtr->state; char *p = dst; - assert(bytesToRead >= 0); - /* * Early out when we know a read will get the eofchar. * @@ -9827,7 +9813,7 @@ DoRead( while (!bufPtr || /* We got no buffer! OR */ (!IsBufferFull(bufPtr) && /* Our buffer has room AND */ - (BytesLeft(bufPtr) < bytesToRead))) { + ((size_t)BytesLeft(bufPtr) < bytesToRead))) { /* Not enough bytes in it yet * to fill the dst */ int code; @@ -10071,7 +10057,7 @@ StopCopy( } inStatePtr->csPtrR = NULL; outStatePtr->csPtrW = NULL; - ckfree(csPtr); + Tcl_Free(csPtr); } /* @@ -10373,7 +10359,7 @@ Tcl_IsChannelShared( ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ - return ((statePtr->refCount > 1) ? 1 : 0); + return ((statePtr->refCount + 1 > 2) ? 1 : 0); } /* @@ -11044,7 +11030,7 @@ FixLevelCode( lcn += 2; } - lvn = ckalloc(lcn * sizeof(Tcl_Obj *)); + lvn = Tcl_Alloc(lcn * sizeof(Tcl_Obj *)); /* * New level/code information is spliced into the first occurence of @@ -11097,7 +11083,7 @@ FixLevelCode( msg = Tcl_NewListObj(j, lvn); - ckfree(lvn); + Tcl_Free(lvn); return msg; } @@ -11245,7 +11231,7 @@ FreeChannelIntRep( return; } Tcl_Release(resPtr->statePtr); - ckfree(resPtr); + Tcl_Free(resPtr); } #if 0 diff --git a/generic/tclIO.h b/generic/tclIO.h index 15f0f78..eea7429 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -36,7 +36,7 @@ */ typedef struct ChannelBuffer { - int refCount; /* Current uses count */ + size_t refCount; /* Current uses count */ int nextAdded; /* The next position into which a character * will be put in the buffer. */ int nextRemoved; /* Position of next byte to be removed from @@ -113,7 +113,7 @@ typedef struct Channel { ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */ - int refCount; + size_t refCount; } Channel; /* @@ -163,7 +163,7 @@ typedef struct ChannelState { int unreportedError; /* Non-zero if an error report was deferred * because it happened in the background. The * value is the POSIX error code. */ - int refCount; /* How many interpreters hold references to + size_t refCount; /* How many interpreters hold references to * this IO channel? */ struct CloseCallback *closeCbPtr; /* Callbacks registered to be called when the diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 1dd8666..3e65002 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -15,7 +15,7 @@ * Callback structure for accept callback in a TCP server. */ -typedef struct AcceptCallback { +typedef struct { Tcl_Obj *script; /* Script to invoke. */ Tcl_Interp *interp; /* Interpreter in which to run it. */ } AcceptCallback; @@ -137,19 +137,6 @@ Tcl_PutsObjCmd( chanObjPtr = objv[2]; string = objv[3]; break; -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - } else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) { - /* - * The code below provides backwards compatibility with an old - * form of the command that is no longer recommended or - * documented. See also [Bug #3151675]. Will be removed in Tcl 9, - * maybe even earlier. - */ - - chanObjPtr = objv[1]; - string = objv[2]; - break; -#endif } /* Fall through */ default: /* [puts] or @@ -181,12 +168,12 @@ Tcl_PutsObjCmd( TclChannelPreserve(chan); result = Tcl_WriteObj(chan, string); - if (result < 0) { + if (result == -1) { goto error; } if (newline != 0) { result = Tcl_WriteChars(chan, "\n", 1); - if (result < 0) { + if (result == -1) { goto error; } } @@ -439,25 +426,11 @@ Tcl_ReadObjCmd( if (i < objc) { if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - /* - * The code below provides backwards compatibility with an old - * form of the command that is no longer recommended or - * documented. See also [Bug #3151675]. Will be removed in Tcl 9, - * maybe even earlier. - */ - - if (strcmp(TclGetString(objv[i]), "nonewline") != 0) { -#endif Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected non-negative integer but got \"%s\"", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); return TCL_ERROR; -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - } - newline = 1; -#endif } } @@ -489,7 +462,7 @@ Tcl_ReadObjCmd( if ((charactersRead > 0) && (newline != 0)) { const char *result; - int length; + size_t length; result = TclGetStringFromObj(resultPtr, &length); if (result[length - 1] == '\n') { @@ -952,7 +925,7 @@ Tcl_ExecObjCmd( */ argc = objc - skip; - argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *)); + argv = TclStackAlloc(interp, (argc + 1) * sizeof(char *)); /* * Copy the string conversions of each (post option) object into the @@ -1192,7 +1165,7 @@ Tcl_OpenObjCmd( Tcl_SetChannelOption(interp, chan, "-translation", "binary"); } } - ckfree(cmdArgv); + Tcl_Free(cmdArgv); } if (chan == NULL) { return TCL_ERROR; @@ -1241,7 +1214,7 @@ TcpAcceptCallbacksDeleteProc( acceptCallbackPtr->interp = NULL; } Tcl_DeleteHashTable(hTblPtr); - ckfree(hTblPtr); + Tcl_Free(hTblPtr); } /* @@ -1281,7 +1254,7 @@ RegisterTcpServerInterpCleanup( hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL); if (hTblPtr == NULL) { - hTblPtr = ckalloc(sizeof(Tcl_HashTable)); + hTblPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS); Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks", TcpAcceptCallbacksDeleteProc, hTblPtr); @@ -1456,7 +1429,7 @@ TcpServerCloseProc( acceptCallbackPtr); } Tcl_DecrRefCount(acceptCallbackPtr->script); - ckfree(acceptCallbackPtr); + Tcl_Free(acceptCallbackPtr); } /* @@ -1652,7 +1625,7 @@ Tcl_SocketObjCmd( port = TclGetString(objv[a]); if (server) { - AcceptCallback *acceptCallbackPtr = ckalloc(sizeof(AcceptCallback)); + AcceptCallback *acceptCallbackPtr = Tcl_Alloc(sizeof(AcceptCallback)); Tcl_IncrRefCount(script); acceptCallbackPtr->script = script; @@ -1662,7 +1635,7 @@ Tcl_SocketObjCmd( AcceptCallbackProc, acceptCallbackPtr); if (chan == NULL) { Tcl_DecrRefCount(script); - ckfree(acceptCallbackPtr); + Tcl_Free(acceptCallbackPtr); return TCL_ERROR; } diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 9949a0e..5e52042 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -230,7 +230,7 @@ ReleaseData( } ResultClear(&dataPtr->result); Tcl_DecrRefCount(dataPtr->command); - ckfree(dataPtr); + Tcl_Free(dataPtr); } /* @@ -287,7 +287,7 @@ TclChannelTransform( * regime of the underlying channel and to use the same for us too. */ - dataPtr = ckalloc(sizeof(TransformChannelData)); + dataPtr = Tcl_Alloc(sizeof(TransformChannelData)); dataPtr->refCount = 1; Tcl_DStringInit(&ds); @@ -378,7 +378,7 @@ ExecuteCallback( * interpreters. */ { Tcl_Obj *resObj; /* See below, switch (transmit). */ - int resLen; + size_t resLen; unsigned char *resBuf; Tcl_InterpState state = NULL; int res = TCL_OK; @@ -443,7 +443,7 @@ ExecuteCallback( break; } resObj = Tcl_GetObjResult(eval); - resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); + resBuf = TclGetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf, resLen); break; @@ -453,13 +453,13 @@ ExecuteCallback( break; } resObj = Tcl_GetObjResult(eval); - resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); + resBuf = TclGetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen); break; case TRANSMIT_IBUF: resObj = Tcl_GetObjResult(eval); - resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); + resBuf = TclGetByteArrayFromObj(resObj, &resLen); ResultAdd(&dataPtr->result, resBuf, resLen); break; @@ -1272,7 +1272,7 @@ ResultClear( r->used = 0; if (r->allocated) { - ckfree(r->buf); + Tcl_Free(r->buf); r->buf = NULL; r->allocated = 0; } @@ -1416,10 +1416,10 @@ ResultAdd( if (r->allocated == 0) { r->allocated = toWrite + INCREMENT; - r->buf = ckalloc(r->allocated); + r->buf = Tcl_Alloc(r->allocated); } else { r->allocated += toWrite + INCREMENT; - r->buf = ckrealloc(r->buf, r->allocated); + r->buf = Tcl_Realloc(r->buf, r->allocated); } } diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 611ee3f..c8858af 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -252,7 +252,7 @@ typedef struct { struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ - int toRead; /* I: #bytes to read, + size_t toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { @@ -385,7 +385,7 @@ static void SrcExitProc(ClientData clientData); #define FreeReceivedError(p) \ if ((p)->base.mustFree) { \ - ckfree((p)->base.msgStr); \ + Tcl_Free((p)->base.msgStr); \ } #define PassReceivedErrorInterp(i,p) \ if ((i) != NULL) { \ @@ -670,7 +670,7 @@ TclChanCreateObjCmd( * as the actual channel type. */ - Tcl_ChannelType *clonePtr = ckalloc(sizeof(Tcl_ChannelType)); + Tcl_ChannelType *clonePtr = Tcl_Alloc(sizeof(Tcl_ChannelType)); memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType)); @@ -725,7 +725,7 @@ TclChanCreateObjCmd( Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); Tcl_DecrRefCount(rcPtr->cmd); - ckfree(rcPtr); + Tcl_Free(rcPtr); return TCL_ERROR; #undef MODE @@ -923,7 +923,7 @@ TclChanPostEventObjCmd( Tcl_NotifyChannel(chan, events); #if TCL_THREADS } else { - ReflectEvent *ev = ckalloc(sizeof(ReflectEvent)); + ReflectEvent *ev = Tcl_Alloc(sizeof(ReflectEvent)); ev->header.proc = ReflectEventRun; ev->events = events; @@ -1158,7 +1158,7 @@ ReflectClose( tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { - ckfree(tctPtr); + Tcl_Free((void *)tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); @@ -1227,7 +1227,7 @@ ReflectClose( #endif tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { - ckfree(tctPtr); + Tcl_Free((void *)tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); @@ -1259,7 +1259,7 @@ ReflectInput( { ReflectedChannel *rcPtr = clientData; Tcl_Obj *toReadObj; - int bytec; /* Number of returned bytes */ + size_t bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ Tcl_Obj *resObj; /* Result data for 'read' */ @@ -1287,7 +1287,7 @@ ReflectInput( PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; } - p.input.toRead = -1; + p.input.toRead = TCL_AUTO_LENGTH; } else { *errorCodePtr = EOK; } @@ -1316,17 +1316,17 @@ ReflectInput( goto invalid; } - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); - if (toRead < bytec) { + if ((size_t)toRead < bytec) { SetChannelErrorStr(rcPtr->chan, msg_read_toomuch); - goto invalid; + goto invalid; } *errorCodePtr = EOK; - if (bytec > 0) { - memcpy(buf, bytev, (size_t) bytec); + if (bytec + 1 > 1) { + memcpy(buf, bytev, bytec); } stop: @@ -2124,7 +2124,7 @@ NewReflectedChannel( ReflectedChannel *rcPtr; MethodName mn = METH_BLOCKING; - rcPtr = ckalloc(sizeof(ReflectedChannel)); + rcPtr = Tcl_Alloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ @@ -2209,7 +2209,7 @@ FreeReflectedChannel( if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); } - ckfree(rcPtr); + Tcl_Free(rcPtr); } /* @@ -2445,7 +2445,7 @@ GetReflectedChannelMap( ReflectedChannelMap *rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL); if (rcmPtr == NULL) { - rcmPtr = ckalloc(sizeof(ReflectedChannelMap)); + rcmPtr = Tcl_Alloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS); Tcl_SetAssocData(interp, RCMKEY, (Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr); @@ -2534,7 +2534,7 @@ DeleteReflectedChannelMap( Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rcmPtr->map); - ckfree(&rcmPtr->map); + Tcl_Free(&rcmPtr->map); #if TCL_THREADS /* @@ -2646,7 +2646,7 @@ GetThreadReflectedChannelMap(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rcmPtr) { - tsdPtr->rcmPtr = ckalloc(sizeof(ReflectedChannelMap)); + tsdPtr->rcmPtr = Tcl_Alloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL); } @@ -2769,7 +2769,7 @@ DeleteThreadReflectedChannelMap( MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } - ckfree(rcmPtr); + Tcl_Free(rcmPtr); } static void @@ -2809,8 +2809,8 @@ ForwardOpToHandlerThread( * Create and initialize the event and data structures. */ - evPtr = ckalloc(sizeof(ForwardingEvent)); - resultPtr = ckalloc(sizeof(ForwardingResult)); + evPtr = Tcl_Alloc(sizeof(ForwardingEvent)); + resultPtr = Tcl_Alloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; @@ -2892,7 +2892,7 @@ ForwardOpToHandlerThread( Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); - ckfree(resultPtr); + Tcl_Free(resultPtr); } static int @@ -2992,23 +2992,23 @@ ForwardProc( } else { ForwardSetObjError(paramPtr, resObj); } - paramPtr->input.toRead = -1; + paramPtr->input.toRead = TCL_IO_FAILURE; } else { /* * Process a regular result. */ - int bytec; /* Number of returned bytes */ + size_t bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); if (paramPtr->input.toRead < bytec) { ForwardSetStaticError(paramPtr, msg_read_toomuch); - paramPtr->input.toRead = -1; + paramPtr->input.toRead = TCL_IO_FAILURE; } else { - if (bytec > 0) { - memcpy(paramPtr->input.buf, bytev, (size_t) bytec); + if (bytec + 1 > 1) { + memcpy(paramPtr->input.buf, bytev, bytec); } paramPtr->input.toRead = bytec; } @@ -3187,7 +3187,7 @@ ForwardProc( * Odd number of elements is wrong. [x]. */ - char *buf = ckalloc(200); + char *buf = Tcl_Alloc(200); sprintf(buf, "{Expected list with even number of elements, got %d %s instead}", listc, (listc == 1 ? "element" : "elements")); @@ -3293,12 +3293,12 @@ ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - int len; + size_t len; const char *msgStr = TclGetStringFromObj(obj, &len); len++; - ForwardSetDynamicError(paramPtr, ckalloc(len)); - memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len); + ForwardSetDynamicError(paramPtr, Tcl_Alloc(len)); + memcpy(paramPtr->base.msgStr, msgStr, len); } #endif diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 4841e39..678fcc1 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -366,7 +366,7 @@ static void SrcExitProc(ClientData clientData); #define FreeReceivedError(p) \ do { \ if ((p)->base.mustFree) { \ - ckfree((p)->base.msgStr); \ + Tcl_Free((p)->base.msgStr); \ } \ } while (0) #define PassReceivedErrorInterp(i,p) \ @@ -1759,7 +1759,7 @@ NewReflectedTransform( Tcl_Obj **listv; int i; - rtPtr = ckalloc(sizeof(ReflectedTransform)); + rtPtr = Tcl_Alloc(sizeof(ReflectedTransform)); /* rtPtr->chan: Assigned by caller. Dummy data here. */ /* rtPtr->methods: Assigned by caller. Dummy data here. */ @@ -1806,7 +1806,7 @@ NewReflectedTransform( */ rtPtr->argc = listc + 2; - rtPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4)); + rtPtr->argv = Tcl_Alloc(sizeof(Tcl_Obj *) * (listc+4)); /* * Duplicate object references. @@ -1914,8 +1914,8 @@ FreeReflectedTransform( FreeReflectedTransformArgs(rtPtr); - ckfree(rtPtr->argv); - ckfree(rtPtr); + Tcl_Free(rtPtr->argv); + Tcl_Free(rtPtr); } /* @@ -2114,7 +2114,7 @@ GetReflectedTransformMap( ReflectedTransformMap *rtmPtr = Tcl_GetAssocData(interp, RTMKEY, NULL); if (rtmPtr == NULL) { - rtmPtr = ckalloc(sizeof(ReflectedTransformMap)); + rtmPtr = Tcl_Alloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS); Tcl_SetAssocData(interp, RTMKEY, (Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr); @@ -2179,7 +2179,7 @@ DeleteReflectedTransformMap( Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rtmPtr->map); - ckfree(&rtmPtr->map); + Tcl_Free(&rtmPtr->map); #if TCL_THREADS /* @@ -2277,7 +2277,7 @@ GetThreadReflectedTransformMap(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rtmPtr) { - tsdPtr->rtmPtr = ckalloc(sizeof(ReflectedTransformMap)); + tsdPtr->rtmPtr = Tcl_Alloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL); } @@ -2335,7 +2335,7 @@ DeleteThreadReflectedTransformMap( FreeReflectedTransformArgs(rtPtr); Tcl_DeleteHashEntry(hPtr); } - ckfree(rtmPtr); + Tcl_Free(rtmPtr); /* * Go through the list of pending results and cancel all whose events were @@ -2412,8 +2412,8 @@ ForwardOpToOwnerThread( * Create and initialize the event and data structures. */ - evPtr = ckalloc(sizeof(ForwardingEvent)); - resultPtr = ckalloc(sizeof(ForwardingResult)); + evPtr = Tcl_Alloc(sizeof(ForwardingEvent)); + resultPtr = Tcl_Alloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; @@ -2493,7 +2493,7 @@ ForwardOpToOwnerThread( Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); - ckfree(resultPtr); + Tcl_Free(resultPtr); } static int @@ -2597,16 +2597,16 @@ ForwardProc( * Sent it back to the request originator. */ - int bytec; /* Number of returned bytes */ + size_t bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = ckalloc(bytec); + paramPtr->transform.buf = Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, (size_t)bytec); } else { paramPtr->transform.buf = NULL; @@ -2631,16 +2631,16 @@ ForwardProc( * Sent it back to the request originator. */ - int bytec; /* Number of returned bytes */ + size_t bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = ckalloc(bytec); + paramPtr->transform.buf = Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, (size_t)bytec); } else { paramPtr->transform.buf = NULL; @@ -2661,15 +2661,15 @@ ForwardProc( * Sent it back to the request originator. */ - int bytec; /* Number of returned bytes */ + size_t bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = ckalloc(bytec); + paramPtr->transform.buf = Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, (size_t)bytec); } else { paramPtr->transform.buf = NULL; @@ -2687,16 +2687,16 @@ ForwardProc( * Sent it back to the request originator. */ - int bytec; /* Number of returned bytes */ + size_t bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = ckalloc(bytec); + paramPtr->transform.buf = Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, (size_t)bytec); } else { paramPtr->transform.buf = NULL; @@ -2805,12 +2805,12 @@ ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - int len; + size_t len; const char *msgStr = TclGetStringFromObj(obj, &len); len++; - ForwardSetDynamicError(paramPtr, ckalloc(len)); - memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len); + ForwardSetDynamicError(paramPtr, Tcl_Alloc(len)); + memcpy(paramPtr->base.msgStr, msgStr, len); } #endif /* TCL_THREADS */ @@ -2954,7 +2954,7 @@ ResultClear( return; } - ckfree(rPtr->buf); + Tcl_Free(rPtr->buf); rPtr->buf = NULL; rPtr->allocated = 0; } @@ -2989,10 +2989,10 @@ ResultAdd( if (rPtr->allocated == 0) { rPtr->allocated = toWrite + RB_INCREMENT; - rPtr->buf = UCHARP(ckalloc(rPtr->allocated)); + rPtr->buf = UCHARP(Tcl_Alloc(rPtr->allocated)); } else { rPtr->allocated += toWrite + RB_INCREMENT; - rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf, + rPtr->buf = UCHARP(Tcl_Realloc((char *) rPtr->buf, rPtr->allocated)); } } @@ -3080,7 +3080,7 @@ TransformRead( Tcl_Obj *bufObj) { Tcl_Obj *resObj; - int bytec; /* Number of returned bytes */ + size_t bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* @@ -3091,7 +3091,7 @@ TransformRead( if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj, + p.transform.buf = (char *) TclGetByteArrayFromObj(bufObj, &(p.transform.size)); ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p); @@ -3104,7 +3104,7 @@ TransformRead( *errorCodePtr = EOK; ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size); - ckfree(p.transform.buf); + Tcl_Free(p.transform.buf); return 1; } #endif /* TCL_THREADS */ @@ -3119,7 +3119,7 @@ TransformRead( return 0; } - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ @@ -3135,7 +3135,7 @@ TransformWrite( { Tcl_Obj *bufObj; Tcl_Obj *resObj; - int bytec; /* Number of returned bytes */ + size_t bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; @@ -3161,7 +3161,7 @@ TransformWrite( *errorCodePtr = EOK; res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf, p.transform.size); - ckfree(p.transform.buf); + Tcl_Free(p.transform.buf); } else #endif /* TCL_THREADS */ { @@ -3181,7 +3181,7 @@ TransformWrite( *errorCodePtr = EOK; - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); Tcl_DecrRefCount(bufObj); @@ -3202,7 +3202,7 @@ TransformDrain( int *errorCodePtr) { Tcl_Obj *resObj; - int bytec; /* Number of returned bytes */ + size_t bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* @@ -3223,7 +3223,7 @@ TransformDrain( *errorCodePtr = EOK; ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size); - ckfree(p.transform.buf); + Tcl_Free(p.transform.buf); } else #endif /* TCL_THREADS */ { @@ -3234,7 +3234,7 @@ TransformDrain( return 0; } - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ @@ -3251,7 +3251,7 @@ TransformFlush( int op) { Tcl_Obj *resObj; - int bytec; /* Number of returned bytes */ + size_t bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; @@ -3278,7 +3278,7 @@ TransformFlush( } else { res = 0; } - ckfree(p.transform.buf); + Tcl_Free(p.transform.buf); } else #endif /* TCL_THREADS */ { @@ -3290,7 +3290,7 @@ TransformFlush( } if (op == FLUSH_WRITE) { - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); } else { res = 0; diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 12e2900..db124fb 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -223,7 +223,7 @@ TclCreateSocketAddress( * using AI_ADDRCONFIG is probably low even in situations where it works, * we'll leave it out for now. After all, it is just an optimisation. * - * Missing on: OpenBSD, NetBSD. + * Missing on NetBSD. * Causes failure when used on AIX 5.1 and HP-UX */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 63d16be..3a6233a 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -457,7 +457,7 @@ FsThrExitProc( while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr->nextPtr; fsRecPtr->fsPtr = NULL; - ckfree(fsRecPtr); + Tcl_Free(fsRecPtr); fsRecPtr = tmpFsRecPtr; } tsdPtr->filesystemList = NULL; @@ -596,7 +596,7 @@ FsRecacheFilesystemList(void) list = NULL; fsRecPtr = tmpFsRecPtr; while (fsRecPtr != NULL) { - tmpFsRecPtr = ckalloc(sizeof(FilesystemRecord)); + tmpFsRecPtr = Tcl_Alloc(sizeof(FilesystemRecord)); *tmpFsRecPtr = *fsRecPtr; tmpFsRecPtr->nextPtr = list; tmpFsRecPtr->prevPtr = NULL; @@ -611,7 +611,7 @@ FsRecacheFilesystemList(void) FilesystemRecord *next = toFree->nextPtr; toFree->fsPtr = NULL; - ckfree(toFree); + Tcl_Free(toFree); toFree = next; } @@ -681,7 +681,7 @@ FsUpdateCwd( Tcl_Obj *cwdObj, ClientData clientData) { - int len; + int len = 0; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); @@ -787,7 +787,7 @@ TclFinalizeFilesystem(void) */ if (fsRecPtr != &nativeFilesystemRecord) { - ckfree(fsRecPtr); + Tcl_Free(fsRecPtr); } fsRecPtr = tmpFsRecPtr; } @@ -872,7 +872,7 @@ Tcl_FSRegister( return TCL_ERROR; } - newFilesystemPtr = ckalloc(sizeof(FilesystemRecord)); + newFilesystemPtr = Tcl_Alloc(sizeof(FilesystemRecord)); newFilesystemPtr->clientData = clientData; newFilesystemPtr->fsPtr = fsPtr; @@ -975,7 +975,7 @@ Tcl_FSUnregister( ++theFilesystemEpoch; } - ckfree(fsRecPtr); + Tcl_Free(fsRecPtr); retVal = TCL_OK; } else { @@ -1667,7 +1667,7 @@ TclGetOpenModeEx( "access mode \"%s\" not supported by this system", flag)); } - ckfree(modeArgv); + Tcl_Free(modeArgv); return -1; #endif @@ -1680,7 +1680,7 @@ TclGetOpenModeEx( "access mode \"%s\" not supported by this system", flag)); } - ckfree(modeArgv); + Tcl_Free(modeArgv); return -1; #endif @@ -1696,12 +1696,12 @@ TclGetOpenModeEx( "RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK," " or TRUNC", flag)); } - ckfree(modeArgv); + Tcl_Free(modeArgv); return -1; } } - ckfree(modeArgv); + Tcl_Free(modeArgv); if (!gotRW) { if (interp != NULL) { @@ -1752,7 +1752,8 @@ Tcl_FSEvalFileEx( const char *encodingName) /* If non-NULL, then use this encoding for the * file. NULL means use the system encoding. */ { - int length, result = TCL_ERROR; + size_t length; + int result = TCL_ERROR; Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile; Interp *iPtr; @@ -1866,12 +1867,12 @@ Tcl_FSEvalFileEx( */ const char *pathString = TclGetStringFromObj(pathPtr, &length); - int limit = 150; + unsigned limit = 150; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (file \"%.*s%s\" line %d)", - (overflow ? limit : length), pathString, + (overflow ? limit : (unsigned)length), pathString, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -3466,7 +3467,7 @@ Tcl_LoadFile( * unload and cleanup the temporary file correctly. */ - tvdlPtr = ckalloc(sizeof(FsDivertLoad)); + tvdlPtr = Tcl_Alloc(sizeof(FsDivertLoad)); /* * Remember three pieces of information. This allows us to cleanup the @@ -3512,7 +3513,7 @@ Tcl_LoadFile( copyToPtr = NULL; - divertedLoadHandle = ckalloc(sizeof(struct Tcl_LoadHandle_)); + divertedLoadHandle = Tcl_Alloc(sizeof(struct Tcl_LoadHandle_)); divertedLoadHandle->clientData = tvdlPtr; divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol; divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile; @@ -3658,8 +3659,8 @@ DivertUnloadFile( Tcl_DecrRefCount(tvdlPtr->divertedFile); } - ckfree(tvdlPtr); - ckfree(loadHandle); + Tcl_Free(tvdlPtr); + Tcl_Free(loadHandle); } /* @@ -3808,7 +3809,7 @@ TclFSUnloadTempFile( Tcl_DecrRefCount(tvdlPtr->divertedFile); } - ckfree(tvdlPtr); + Tcl_Free(tvdlPtr); } /* @@ -4749,7 +4750,7 @@ static void NativeFreeInternalRep( ClientData clientData) { - ckfree(clientData); + Tcl_Free(clientData); } /* diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 965ec24..33656d6 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -61,8 +61,8 @@ static const Tcl_ObjType indexType = { typedef struct { void *tablePtr; /* Pointer to the table of strings */ - int offset; /* Offset between table entries */ - int index; /* Selected index into table. */ + size_t offset; /* Offset between table entries */ + size_t index; /* Selected index into table. */ } IndexRep; /* @@ -79,75 +79,6 @@ typedef struct { /* *---------------------------------------------------------------------- * - * Tcl_GetIndexFromObj -- - * - * This function looks up an object's value in a table of strings and - * returns the index of the matching string, if any. - * - * Results: - * If the value of objPtr is identical to or a unique abbreviation for - * one of the entries in tablePtr, then the return value is TCL_OK and the - * index of the matching entry is stored at *indexPtr. If there isn't a - * proper match, then TCL_ERROR is returned and an error message is left - * in interp's result (unless interp is NULL). The msg argument is used - * in the error message; for example, if msg has the value "option" then - * the error message will say something flag 'bad option "foo": must be - * ...' - * - * Side effects: - * The result of the lookup is cached as the internal rep of objPtr, so - * that repeated lookups can be done quickly. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_GetIndexFromObj -int -Tcl_GetIndexFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* Object containing the string to lookup. */ - const char *const*tablePtr, /* Array of strings to compare against the - * value of objPtr; last entry must be NULL - * and there must not be duplicate entries. */ - const char *msg, /* Identifying word to use in error - * messages. */ - int flags, /* 0 or TCL_EXACT */ - int *indexPtr) /* Place to store resulting integer index. */ -{ - if (!(flags & INDEX_TEMP_TABLE)) { - - /* - * See if there is a valid cached result from a previous lookup (doing the - * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in - * the common case where the result is cached). - */ - - const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &indexType); - - if (irPtr) { - IndexRep *indexRep = irPtr->twoPtrValue.ptr1; - - /* - * Here's hoping we don't get hit by unfortunate packing constraints - * on odd platforms like a Cray PVP... - */ - - if (indexRep->tablePtr == (void *) tablePtr - && indexRep->offset == sizeof(char *)) { - *indexPtr = indexRep->index; - return TCL_OK; - } - } - } - return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *), - msg, flags, indexPtr); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * GetIndexFromObjList -- * * This procedure looks up an object's value in a table of strings and @@ -200,14 +131,14 @@ GetIndexFromObjList( * Build a string table from the list. */ - tablePtr = ckalloc((objc + 1) * sizeof(char *)); + tablePtr = Tcl_Alloc((objc + 1) * sizeof(char *)); for (t = 0; t < objc; t++) { if (objv[t] == objPtr) { /* * An exact match is always chosen, so we can stop here. */ - ckfree(tablePtr); + Tcl_Free(tablePtr); *indexPtr = t; return TCL_OK; } @@ -219,7 +150,7 @@ GetIndexFromObjList( result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *), msg, flags | INDEX_TEMP_TABLE, indexPtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); return result; } @@ -259,7 +190,7 @@ Tcl_GetIndexFromObjStruct( * offset, the third plus the offset again, * etc. The last entry must be NULL and there * must not be duplicate entries. */ - int offset, /* The number of bytes between entries */ + size_t offset, /* The number of bytes between entries */ const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ @@ -274,8 +205,8 @@ Tcl_GetIndexFromObjStruct( const Tcl_ObjIntRep *irPtr; /* Protect against invalid values, like -1 or 0. */ - if (offset < (int)sizeof(char *)) { - offset = (int)sizeof(char *); + if (offset+1 <= sizeof(char *)) { + offset = sizeof(char *); } /* * See if there is a valid cached result from a previous lookup. @@ -352,7 +283,7 @@ Tcl_GetIndexFromObjStruct( } else { Tcl_ObjIntRep ir; - indexRep = ckalloc(sizeof(IndexRep)); + indexRep = Tcl_Alloc(sizeof(IndexRep)); ir.twoPtrValue.ptr1 = indexRep; Tcl_StoreIntRep(objPtr, &indexType, &ir); } @@ -487,7 +418,7 @@ DupIndex( Tcl_Obj *dupPtr) { Tcl_ObjIntRep ir; - IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep)); + IndexRep *dupIndexRep = Tcl_Alloc(sizeof(IndexRep)); memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1, sizeof(IndexRep)); @@ -517,7 +448,7 @@ static void FreeIndex( Tcl_Obj *objPtr) { - ckfree(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); + Tcl_Free(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); objPtr->typePtr = NULL; } @@ -883,34 +814,12 @@ Tcl_WrongNumArgs( * NULL. */ { Tcl_Obj *objPtr; - int i, len, elemLen; + int i; + size_t len, elemLen; char flags; Interp *iPtr = (Interp *) interp; const char *elementStr; - /* - * [incr Tcl] does something fairly horrific when generating error - * messages for its ensembles; it passes the whole set of ensemble - * arguments as a list in the first argument. This means that this code - * causes a problem in iTcl if it attempts to correctly quote all - * arguments, which would be the correct thing to do. We work around this - * nasty behaviour for now, and hope that we can remove it all in the - * future... - */ - -#ifndef AVOID_HACKS_FOR_ITCL - int isFirst = 1; /* Special flag used to inhibit the treating - * of the first word as a list element so the - * hacky way Itcl generates error messages for - * its ensembles will still work. [Bug - * 1066837] */ -# define MAY_QUOTE_WORD (!isFirst) -# define AFTER_FIRST_WORD (isFirst = 0) -#else /* !AVOID_HACKS_FOR_ITCL */ -# define MAY_QUOTE_WORD 1 -# define AFTER_FIRST_WORD (void) 0 -#endif /* AVOID_HACKS_FOR_ITCL */ - TclNewObj(objPtr); if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS; @@ -977,9 +886,8 @@ Tcl_WrongNumArgs( flags = 0; len = TclScanElement(elementStr, elemLen, &flags); - if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, - (unsigned)len + 1); + if (len != elemLen) { + char *quotedElementStr = TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); @@ -989,8 +897,6 @@ Tcl_WrongNumArgs( Tcl_AppendToObj(objPtr, elementStr, elemLen); } - AFTER_FIRST_WORD; - /* * Add a space if the word is not the last one (which has a * moderately complex condition here). @@ -1029,9 +935,8 @@ Tcl_WrongNumArgs( flags = 0; len = TclScanElement(elementStr, elemLen, &flags); - if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, - (unsigned) len + 1); + if (len != elemLen) { + char *quotedElementStr = TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); @@ -1042,8 +947,6 @@ Tcl_WrongNumArgs( } } - AFTER_FIRST_WORD; - /* * Append a space character (" ") if there is more text to follow * (either another element from objv, or the message string). @@ -1066,8 +969,6 @@ Tcl_WrongNumArgs( Tcl_AppendStringsToObj(objPtr, "\"", NULL); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); Tcl_SetObjResult(interp, objPtr); -#undef MAY_QUOTE_WORD -#undef AFTER_FIRST_WORD } /* @@ -1126,7 +1027,7 @@ Tcl_ParseArgsObjv( * being processed, primarily for error * reporting. */ int objc; /* # arguments in objv still to process. */ - int length; /* Number of characters in current argument */ + size_t length; /* Number of characters in current argument */ if (remObjv != NULL) { /* @@ -1137,7 +1038,7 @@ Tcl_ParseArgsObjv( */ nrem = 1; - leftovers = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *)); + leftovers = Tcl_Alloc((1 + *objcPtr) * sizeof(Tcl_Obj *)); leftovers[0] = objv[0]; } else { nrem = 0; @@ -1321,7 +1222,7 @@ Tcl_ParseArgsObjv( } leftovers[nrem] = NULL; *objcPtr = nrem++; - *remObjv = ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *)); + *remObjv = Tcl_Realloc(leftovers, nrem * sizeof(Tcl_Obj *)); return TCL_OK; /* @@ -1334,7 +1235,7 @@ Tcl_ParseArgsObjv( "\"%s\" option requires an additional argument", str)); error: if (leftovers != NULL) { - ckfree(leftovers); + Tcl_Free(leftovers); } return TCL_ERROR; } @@ -1378,13 +1279,13 @@ PrintUsage( width = 4; for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { - int length; + size_t length; if (infoPtr->keyStr == NULL) { continue; } length = strlen(infoPtr->keyStr); - if (length > width) { + if (length > (size_t)width) { width = length; } } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 106b4e9..03f56c3 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -48,12 +48,13 @@ declare 6 { void TclCleanupCommand(Command *cmdPtr) } declare 7 { - int TclCopyAndCollapse(int count, const char *src, char *dst) -} -declare 8 {deprecated {}} { - int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, - Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) + size_t TclCopyAndCollapse(size_t count, const char *src, char *dst) } +# Removed in 9.0: +#declare 8 { +# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, +# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) +#} # TclCreatePipeline unofficially exported for use by BLT. @@ -79,7 +80,7 @@ declare 12 { # Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types) #} declare 14 { - int TclDumpMemoryInfo(ClientData clientData, int flags) + int TclDumpMemoryInfo(void *clientData, int flags) } # Removed in 8.1: # declare 15 { @@ -107,14 +108,14 @@ declare 16 { declare 22 { int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, - int *sizePtr, int *bracePtr) + size_t *sizePtr, int *bracePtr) } declare 23 { Proc *TclFindProc(Interp *iPtr, const char *procName) } # Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10 declare 24 { - int TclFormatInt(char *buffer, Tcl_WideInt n) + size_t TclFormatInt(char *buffer, Tcl_WideInt n) } declare 25 { void TclFreePackageInfo(Interp *iPtr) @@ -153,7 +154,7 @@ declare 32 { #} declare 34 { int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, - int endValue, int *indexPtr) + size_t endValue, int *indexPtr) } # Removed in 8.4b2: #declare 35 { @@ -183,7 +184,7 @@ declare 41 { Tcl_Command TclGetOriginalCommand(Tcl_Command command) } declare 42 { - CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) + const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } # Removed in 8.5a2: #declare 43 { @@ -226,11 +227,11 @@ declare 51 { # int flags) #} declare 53 { - int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, + int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp, int argc, const char **argv) } declare 54 { - int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, + int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 55 { @@ -266,7 +267,7 @@ declare 62 { int TclObjCommandComplete(Tcl_Obj *cmdPtr) } declare 63 { - int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, + int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 64 { @@ -289,7 +290,7 @@ declare 64 { # int TclpAccess(const char *path, int mode) #} declare 69 { - char *TclpAlloc(unsigned int size) + void *TclpAlloc(size_t size) } #declare 70 { # int TclpCopyFile(const char *source, const char *dest) @@ -305,17 +306,19 @@ declare 69 { # int TclpDeleteFile(const char *path) #} declare 74 { - void TclpFree(char *ptr) + void TclpFree(void *ptr) } declare 75 { - unsigned long TclpGetClicks(void) + Tcl_WideUInt TclpGetClicks(void) } declare 76 { - unsigned long TclpGetSeconds(void) -} -declare 77 {deprecated {}} { - void TclpGetTime(Tcl_Time *time) + Tcl_WideUInt TclpGetSeconds(void) } + +# Removed in 9.0: +#declare 77 { +# void TclpGetTime(Tcl_Time *time) +#} # Removed in 8.6: #declare 78 { # int TclpGetTimeZone(unsigned long time) @@ -330,7 +333,7 @@ declare 77 {deprecated {}} { # char *modeString, int permissions) #} declare 81 { - char *TclpRealloc(char *ptr, unsigned int size) + void *TclpRealloc(void *ptr, size_t size) } #declare 82 { # int TclpRemoveDirectory(const char *path, int recursive, @@ -355,10 +358,11 @@ declare 81 { # declare 87 { # void TclPlatformInit(Tcl_Interp *interp) # } -declare 88 {deprecated {}} { - char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, - const char *name1, const char *name2, int flags) -} +# Removed in 9.0: +#declare 88 { +# char *TclPrecTraceProc(void *clientData, Tcl_Interp *interp, +# const char *name1, const char *name2, int flags) +#} declare 89 { int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd) @@ -376,11 +380,11 @@ declare 92 { const char *procName) } declare 93 { - void TclProcDeleteProc(ClientData clientData) + void TclProcDeleteProc(void *clientData) } # Removed in 8.5: #declare 94 { -# int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, +# int TclProcInterpProc(void *clientData, Tcl_Interp *interp, # int argc, const char **argv) #} # Replaced by Tcl_FSStat in 8.4: @@ -408,7 +412,7 @@ declare 98 { # Tcl_Obj *objPtr, int flags) #} declare 101 { - CONST86 char *TclSetPreInitScript(const char *string) + const char *TclSetPreInitScript(const char *string) } declare 102 { void TclSetupEnv(Tcl_Interp *interp) @@ -417,9 +421,10 @@ declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } -declare 104 {deprecated {}} { - int TclSockMinimumBuffersOld(int sock, int size) -} +# Removed in 9.0: +#declare 104 { +# int TclSockMinimumBuffersOld(int sock, int size) +#} # Replaced by Tcl_FSStat in 8.4: #declare 105 { # int TclStat(const char *path, Tcl_StatBuf *buf) @@ -452,29 +457,35 @@ declare 111 { Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } -declare 112 { - int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - Tcl_Obj *objPtr) -} -declare 113 { - Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name, - ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) -} -declare 114 { - void TclDeleteNamespace(Tcl_Namespace *nsPtr) -} -declare 115 { - int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int resetListFirst) -} -declare 116 { - Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags) -} -declare 117 { - Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags) -} +# Removed in 9.0: +#declare 112 { +# int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 113 { +# Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, +# void *clientData, Tcl_NamespaceDeleteProc *deleteProc) +#} +# Removed in 9.0: +#declare 114 { +# void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) +#} +# Removed in 9.0: +#declare 115 { +# int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int resetListFirst) +#} +# Removed in 9.0: +#declare 116 { +# Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} +# Removed in 9.0: +#declare 117 { +# Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} declare 118 { int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo) @@ -487,31 +498,37 @@ declare 120 { Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } -declare 121 { - int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern) -} -declare 122 { - Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} -declare 123 { - void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command, - Tcl_Obj *objPtr) -} -declare 124 { - Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp) -} -declare 125 { - Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp) -} +# Removed in 9.0: +#declare 121 { +# int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern) +#} +# Removed in 9.0: +#declare 122 { +# Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 123 { +# void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, +# Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 124 { +# Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp) +#} +# Removed in 9.0: +#declare 125 { +# Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp) +#} declare 126 { void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } -declare 127 { - int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int allowOverwrite) -} +# Removed in 9.0: +#declare 127 { +# int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int allowOverwrite) +#} declare 128 { void Tcl_PopCallFrame(Tcl_Interp *interp) } @@ -530,9 +547,10 @@ declare 131 { declare 132 { int TclpHasSockets(Tcl_Interp *interp) } -declare 133 {deprecated {}} { - struct tm *TclpGetDate(const time_t *time, int useGMT) -} +# Removed in 9.0 +#declare 133 { +# struct tm *TclpGetDate(const time_t *time, int useGMT) +#} # Removed in 8.5 #declare 134 { # size_t TclpStrftime(char *s, size_t maxsize, const char *format, @@ -553,7 +571,7 @@ declare 138 { #declare 139 { # int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, # char *sym2, Tcl_PackageInitProc **proc1Ptr, -# Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr) +# Tcl_PackageInitProc **proc2Ptr, void **clientDataPtr) #} #declare 140 { # int TclLooksLikeInt(const char *bytes, int length) @@ -564,7 +582,7 @@ declare 141 { } declare 142 { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, - CompileHookProc *hookProc, ClientData clientData) + CompileHookProc *hookProc, void *clientData) } declare 143 { int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, @@ -596,7 +614,7 @@ declare 150 { int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re) } declare 151 { - void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, + void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, int *startPtr, int *endPtr) } declare 152 { @@ -608,11 +626,11 @@ declare 153 { # moved to tclTest.c (static) in 8.3.2/8.4a2 #declare 154 { -# int TclTestChannelCmd(ClientData clientData, +# int TclTestChannelCmd(void *clientData, # Tcl_Interp *interp, int argc, char **argv) #} #declare 155 { -# int TclTestChannelEventCmd(ClientData clientData, +# int TclTestChannelEventCmd(void *clientData, # Tcl_Interp *interp, int argc, char **argv) #} @@ -623,12 +641,14 @@ declare 156 { declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } -declare 158 {deprecated {use public Tcl_SetStartupScript()}} { - void TclSetStartupScriptFileName(const char *filename) -} -declare 159 {deprecated {use public Tcl_GetStartupScript()}} { - const char *TclGetStartupScriptFileName(void) -} +# REMOVED - use public Tcl_SetStartupScript() +#declare 158 { +# void TclSetStartupScriptFileName(const char *filename) +#} +# REMOVED - use public Tcl_GetStartupScript() +#declare 159 { +# const char *TclGetStartupScriptFileName(void) +#} #declare 160 { # int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, # Tcl_DString *dirPtr, char *pattern, char *tail, @@ -641,7 +661,7 @@ declare 161 { Tcl_Obj *cmdObjPtr) } declare 162 { - void TclChannelEventScriptInvoker(ClientData clientData, int flags) + void TclChannelEventScriptInvoker(void *clientData, int flags) } # ALERT: The result of 'TclGetInstructionTable' is actually a @@ -672,24 +692,27 @@ declare 166 { int index, Tcl_Obj *valuePtr) } -declare 167 {deprecated {use public Tcl_SetStartupScript()}} { - void TclSetStartupScriptPath(Tcl_Obj *pathPtr) -} -declare 168 {deprecated {use public Tcl_GetStartupScript()}} { - Tcl_Obj *TclGetStartupScriptPath(void) -} +# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above) +# REMOVED - use public Tcl_SetStartupScript() +#declare 167 { +# void TclSetStartupScriptPath(Tcl_Obj *pathPtr) +#} +# REMOVED - use public Tcl_GetStartupScript() +#declare 168 { +# Tcl_Obj *TclGetStartupScriptPath(void) +#} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { - int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) + int TclpUtfNcmp2(const char *s1, const char *s2, size_t n) } declare 170 { int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, - int numChars, Command *cmdPtr, int result, int traceFlags, + size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]) } declare 171 { int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command, - int numChars, Command *cmdPtr, int result, int traceFlags, + size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]) } declare 172 { @@ -699,8 +722,8 @@ declare 172 { # added for 8.4.2 declare 173 { - int TclUniCharMatch(const Tcl_UniChar *string, int strLen, - const Tcl_UniChar *pattern, int ptnLen, int flags) + int TclUniCharMatch(const Tcl_UniChar *string, size_t strLen, + const Tcl_UniChar *pattern, size_t ptnLen, int flags) } # added for 8.4.3 @@ -723,12 +746,13 @@ declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } -declare 178 { - void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) -} -declare 179 { - Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr) -} +# TIP 338 made these public - now declared in tcl.h +#declare 178 { +# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) +#} +#declare 179 { +# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) +#} # REMOVED # Allocate lists without copying arrays @@ -740,12 +764,14 @@ declare 179 { # const char *file, int line) #} -declare 182 {deprecated {}} { - struct tm *TclpLocaltime(const time_t *clock) -} -declare 183 {deprecated {}} { - struct tm *TclpGmtime(const time_t *clock) -} +# Removed in 9.0 +#declare 182 { +# struct tm *TclpLocaltime(const time_t *clock) +#} +# Removed in 9.0 +#declare 183 { +# struct tm *TclpGmtime(const time_t *clock) +#} # For the new "Thread Storage" subsystem. @@ -860,7 +886,7 @@ declare 214 { void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding) } declare 215 { - void *TclStackAlloc(Tcl_Interp *interp, int numBytes) + void *TclStackAlloc(Tcl_Interp *interp, size_t numBytes) } declare 216 { void TclStackFree(Tcl_Interp *interp, void *freePtr) @@ -887,7 +913,7 @@ declare 226 { int TclObjBeingDeleted(Tcl_Obj *objPtr) } declare 227 { - void TclSetNsPath(Namespace *nsPtr, int pathLength, + void TclSetNsPath(Namespace *nsPtr, size_t pathLength, Tcl_Namespace *pathAry[]) } # Used to be needed for TclOO-extension; unneeded now that TclOO is in the @@ -927,9 +953,12 @@ declare 234 { declare 235 { void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) } -declare 236 {deprecated {use Tcl_BackgroundException}} { - void TclBackgroundException(Tcl_Interp *interp, int code) -} + + +# TIP 337 made this one public +#declare 236 { +# void TclBackgroundException(Tcl_Interp *interp, int code) +#} # TIP #285: Script cancellation support. declare 237 { @@ -939,7 +968,7 @@ declare 237 { # NRE functions for "rogue" extensions to exploit NRE; they will need to # include NRE.h too. declare 238 { - int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp, + int TclNRInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 239 { @@ -972,8 +1001,8 @@ declare 245 { Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr) } declare 246 { - int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved, - int numInserted, Tcl_Obj *const *objv) + int TclInitRewriteEnsemble(Tcl_Interp *interp, size_t numRemoved, + size_t numInserted, Tcl_Obj *const *objv) } declare 247 { void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble) @@ -996,7 +1025,7 @@ declare 250 { # Allow extensions for optimization declare 251 { int TclRegisterLiteral(void *envPtr, - const char *bytes, int length, int flags) + const char *bytes, size_t length, int flags) } # Exporting of the internal API to variables. @@ -1042,17 +1071,20 @@ interface tclIntPlat declare 0 win { void TclWinConvertError(DWORD errCode) } -declare 1 win { - void TclWinConvertWSAError(DWORD errCode) -} -declare 2 win { - struct servent *TclWinGetServByName(const char *nm, - const char *proto) -} -declare 3 win { - int TclWinGetSockOpt(SOCKET s, int level, int optname, - char *optval, int *optlen) -} +# Removed in 9.0: +#declare 1 win { +# void TclWinConvertWSAError(DWORD errCode) +#} +# Removed in 9.0: +#declare 2 win { +# struct servent *TclWinGetServByName(const char *nm, +# const char *proto) +#} +# Removed in 9.0: +#declare 3 win { +# int TclWinGetSockOpt(SOCKET s, int level, int optname, +# char *optval, int *optlen) +#} declare 4 win { HINSTANCE TclWinGetTclInstance(void) } @@ -1064,23 +1096,26 @@ declare 5 win { # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } -declare 6 win { - unsigned short TclWinNToHS(unsigned short ns) -} -declare 7 win { - int TclWinSetSockOpt(SOCKET s, int level, int optname, - const char *optval, int optlen) -} +# Removed in 9.0: +#declare 6 win { +# unsigned short TclWinNToHS(unsigned short ns) +#} +# Removed in 9.0: +#declare 7 win { +# int TclWinSetSockOpt(SOCKET s, int level, int optname, +# const char *optval, int optlen) +#} declare 8 win { - int TclpGetPid(Tcl_Pid pid) -} -declare 9 win { - int TclWinGetPlatformId(void) -} -# new for 8.4.20+/8.5.12+ Cygwin only -declare 10 win { - Tcl_DirEntry *TclpReaddir(TclDIR *dir) + size_t TclpGetPid(Tcl_Pid pid) } +# Removed in 9.0: +#declare 9 win { +# int TclWinGetPlatformId(void) +#} +# Removed in 9.0: +#declare 10 win { +# Tcl_DirEntry *TclpReaddir(TclDIR *dir) +#} # Removed in 8.3.1 (for Win32s only): #declare 10 win { # int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr) @@ -1129,11 +1164,12 @@ declare 19 win { TclFile TclpOpenFile(const char *fname, int mode) } declare 20 win { - void TclWinAddProcess(HANDLE hProcess, DWORD id) -} -declare 21 win { - char *TclpInetNtoa(struct in_addr addr) + void TclWinAddProcess(HANDLE hProcess, size_t id) } +# Removed in 9.0: +#declare 21 win { +# char *TclpInetNtoa(struct in_addr addr) +#} # removed permanently for 8.4 #declare 21 win { # void TclpAsyncMark(Tcl_AsyncHandler async) @@ -1154,9 +1190,10 @@ declare 24 win { #declare 25 win { # TclPlatformType *TclWinGetPlatform(void) #} -declare 26 win { - void TclWinSetInterfaces(int wide) -} +# Removed in 9.0: +#declare 26 win { +# void TclWinSetInterfaces(int wide) +#} # Added in Tcl 8.3.3 / 8.4 @@ -1166,9 +1203,10 @@ declare 27 win { # Added in 8.4.2 -declare 28 win { - void TclWinResetInterfaces(void) -} +# Removed in 9.0: +#declare 28 win { +# void TclWinResetInterfaces(void) +#} ################################ # Unix specific functions @@ -1215,20 +1253,22 @@ declare 9 unix { # Added in 8.4: -declare 10 unix { - Tcl_DirEntry *TclpReaddir(TclDIR *dir) -} -# Slots 11 and 12 are forwarders for functions that were promoted to -# generic Stubs -declare 11 unix { - struct tm *TclpLocaltime_unix(const time_t *clock) -} -declare 12 unix { - struct tm *TclpGmtime_unix(const time_t *clock) -} -declare 13 unix { - char *TclpInetNtoa(struct in_addr addr) -} +# Removed in 9.0: +#declare 10 unix { +# Tcl_DirEntry *TclpReaddir(TclDIR *dir) +#} +# Removed in 9.0: +#declare 11 unix { +# struct tm *TclpLocaltime_unix(const time_t *clock) +#} +# Removed in 9.0: +#declare 12 unix { +# struct tm *TclpGmtime_unix(const time_t *clock) +#} +# Removed in 9.0: +#declare 13 unix { +# char *TclpInetNtoa(struct in_addr addr) +#} # Added in 8.5: diff --git a/generic/tclInt.h b/generic/tclInt.h index b220a31..aa312c4 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -26,20 +26,6 @@ #undef ACCEPT_NAN /* - * In Tcl 8.7, stop supporting special hacks for legacy Itcl 3. - * Itcl 4 doesn't need them. Itcl 3 can be updated to not need them - * using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+ - * releases. Perhaps Tcl 8.7 will add even better public interfaces - * supporting all the re-invocation mechanisms extensions like Itcl 3 - * need. As an absolute last resort, folks who must make Itcl 3 work - * unchanged with Tcl 8.7 can remove this line to regain the migration - * support. Tcl 9 will no longer offer even that option. - */ - -#define AVOID_HACKS_FOR_ITCL 1 - - -/* * Used to tag functions that are only to be visible within the module being * built and not outside it (where this is supported by the linker). * Also used in the platform-specific *Port.h files. @@ -53,8 +39,6 @@ # endif #endif - - /* * Common include files needed by most of the Tcl source files are included * here, so that system-dependent personalizations for the include files only @@ -68,6 +52,7 @@ #include <stdio.h> #include <ctype.h> +#include <stdarg.h> #ifdef NO_STDLIB_H # include "../compat/stdlib.h" #else @@ -214,9 +199,6 @@ typedef struct Tcl_ResolverInfo { * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers - * - * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag - * (Bug #835020) */ #define TCL_AVOID_RESOLVERS 0x40000 @@ -289,16 +271,16 @@ typedef struct Namespace { * strings; values have type (Namespace *). If * NULL, there are no children. */ #endif - unsigned long nsId; /* Unique id for the namespace. */ - Tcl_Interp *interp; /* The interpreter containing this + size_t nsId; /* Unique id for the namespace. */ + Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status * flags NS_DYING and NS_DEAD listed below. */ - int activationCount; /* Number of "activations" or active call + size_t activationCount; /* Number of "activations" or active call * frames for this namespace that are on the * Tcl call stack. The namespace won't be * freed until activationCount becomes zero. */ - unsigned int refCount; /* Count of references by namespaceName + size_t refCount; /* Count of references by namespaceName * objects. The namespace can't be freed until * refCount becomes zero. */ Tcl_HashTable cmdTable; /* Contains all the commands currently @@ -319,16 +301,16 @@ typedef struct Namespace { * commands; however, no namespace qualifiers * are allowed. NULL if no export patterns are * registered. */ - int numExportPatterns; /* Number of export patterns currently + size_t numExportPatterns; /* Number of export patterns currently * registered using "namespace export". */ - int maxExportPatterns; /* Mumber of export patterns for which space + size_t maxExportPatterns; /* Number of export patterns for which space * is currently allocated. */ - unsigned int cmdRefEpoch; /* Incremented if a newly added command + size_t cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to * be invalidated. */ - unsigned int resolverEpoch; /* Incremented whenever (a) the name + size_t resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a * command that is compiled to bytecodes. This @@ -355,7 +337,7 @@ typedef struct Namespace { * LookupCompiledLocal to resolve variable * references within the namespace at compile * time. */ - unsigned int exportLookupEpoch; /* Incremented whenever a command is added to + size_t exportLookupEpoch; /* Incremented whenever a command is added to * a namespace, removed from a namespace or * the exports of a namespace are changed. * Allows TIP#112-driven command lists to be @@ -366,7 +348,7 @@ typedef struct Namespace { Tcl_Obj *unknownHandlerPtr; /* A script fragment to be used when command * resolution in this namespace fails. TIP * 181. */ - int commandPathLength; /* The length of the explicit path. */ + size_t commandPathLength; /* The length of the explicit path. */ NamespacePathEntry *commandPathArray; /* The explicit path of the namespace as an * array. */ @@ -456,7 +438,7 @@ typedef struct EnsembleConfig { * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - unsigned int epoch; /* The epoch at which this ensemble's table of + size_t epoch; /* The epoch at which this ensemble's table of * exported commands is valid. */ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all * consistent points, this will have the same @@ -569,7 +551,7 @@ typedef struct CommandTrace { struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ - size_t refCount; /* Used to ensure this structure is not + size_t refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ @@ -632,7 +614,7 @@ typedef struct Var { TclVarHashTable *tablePtr;/* For array variables, this points to * information about the hash table used to * implement the associative array. Points to - * ckalloc-ed data. */ + * Tcl_Alloc-ed data. */ struct Var *linkPtr; /* If this is a global variable being referred * to in a procedure, or a variable created by * "upvar", this field points to the @@ -642,7 +624,7 @@ typedef struct Var { typedef struct VarInHash { Var var; - unsigned int refCount; /* Counts number of active uses of this + size_t refCount; /* Counts number of active uses of this * variable: 1 for the entry in the hash * table, 1 for each additional variable whose * linkPtr points here, 1 for each nested @@ -974,7 +956,7 @@ typedef struct CompiledLocal { typedef struct Proc { struct Interp *iPtr; /* Interpreter for which this command is * defined. */ - unsigned int refCount; /* Reference count: 1 if still present in + size_t refCount; /* Reference count: 1 if still present in * command table plus 1 for each call to the * procedure that is currently active. This * structure can be freed when refCount @@ -1091,7 +1073,7 @@ typedef struct AssocData { */ typedef struct LocalCache { - unsigned int refCount; + size_t refCount; int numVars; Tcl_Obj *varName0; } LocalCache; @@ -1246,7 +1228,7 @@ typedef struct CmdFrame { } data; Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ - int len; /* ... and its length. */ + size_t len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by @@ -1257,13 +1239,13 @@ typedef struct CmdFrame { typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ int word; /* Index of the word in the command. */ - unsigned int refCount; /* Number of times the word is on the + size_t refCount; /* Number of times the word is on the * stack. */ } CFWord; typedef struct CFWordBC { CmdFrame *framePtr; /* CmdFrame to access. */ - int pc; /* Instruction pointer of a command in + size_t pc; /* Instruction pointer of a command in * ExtCmdLoc.loc[.] */ int word; /* Index of word in * ExtCmdLoc.loc[cmd]->line[.] */ @@ -1344,7 +1326,7 @@ typedef struct { * proc field is NULL. */ } ExtraFrameInfoField; typedef struct { - int length; /* Length of array. */ + size_t length; /* Length of array. */ ExtraFrameInfoField fields[2]; /* Really as long as necessary, but this is * long enough for nearly anything. */ @@ -1433,7 +1415,7 @@ typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr, */ typedef int (CompileHookProc)(Tcl_Interp *interp, - struct CompileEnv *compEnvPtr, ClientData clientData); + struct CompileEnv *compEnvPtr, void *clientData); /* * The data structure for a (linked list of) execution stacks. @@ -1524,7 +1506,7 @@ typedef struct LiteralEntry { * table, the number of ByteCode structures * that share the literal object; the literal * entry can be freed when refCount drops to - * 0. If in a local literal table, (size_t)-1. */ + * 0. If in a local literal table, -1. */ Namespace *nsPtr; /* Namespace in which this literal is used. We * try to avoid sharing literal non-FQ command * names among different namespaces to reduce @@ -1538,13 +1520,13 @@ typedef struct LiteralTable { LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ - int numBuckets; /* Total number of buckets allocated at + size_t numBuckets; /* Total number of buckets allocated at * **buckets. */ - int numEntries; /* Total number of entries present in + size_t numEntries; /* Total number of entries present in * table. */ - int rebuildSize; /* Enlarge table when numEntries gets to be + size_t rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ - unsigned int mask; /* Mask value used in hashing function. */ + size_t mask; /* Mask value used in hashing function. */ } LiteralTable; /* @@ -1555,10 +1537,10 @@ typedef struct LiteralTable { #ifdef TCL_COMPILE_STATS typedef struct ByteCodeStats { - long numExecutions; /* Number of ByteCodes executed. */ - long numCompilations; /* Number of ByteCodes created. */ - long numByteCodesFreed; /* Number of ByteCodes destroyed. */ - long instructionCount[256]; /* Number of times each instruction was + size_t numExecutions; /* Number of ByteCodes executed. */ + size_t numCompilations; /* Number of ByteCodes created. */ + size_t numByteCodesFreed; /* Number of ByteCodes destroyed. */ + size_t instructionCount[256]; /* Number of times each instruction was * executed. */ double totalSrcBytes; /* Total source bytes ever compiled. */ @@ -1566,10 +1548,10 @@ typedef struct ByteCodeStats { double currentSrcBytes; /* Src bytes for all current ByteCodes. */ double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */ - long srcCount[32]; /* Source size distribution: # of srcs of + size_t srcCount[32]; /* Source size distribution: # of srcs of * size [2**(n-1)..2**n), n in [0..32). */ - long byteCodeCount[32]; /* ByteCode size distribution. */ - long lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ + size_t byteCodeCount[32]; /* ByteCode size distribution. */ + size_t lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ double currentInstBytes; /* Instruction bytes-current ByteCodes. */ double currentLitBytes; /* Current literal bytes. */ @@ -1577,11 +1559,11 @@ typedef struct ByteCodeStats { double currentAuxBytes; /* Current auxiliary information bytes. */ double currentCmdMapBytes; /* Current src<->code map bytes. */ - long numLiteralsCreated; /* Total literal objects ever compiled. */ + size_t numLiteralsCreated; /* Total literal objects ever compiled. */ double totalLitStringBytes; /* Total string bytes in all literals. */ double currentLitStringBytes; /* String bytes in current literals. */ - long literalCount[32]; /* Distribution of literal string sizes. */ + size_t literalCount[32]; /* Distribution of literal string sizes. */ } ByteCodeStats; #endif /* TCL_COMPILE_STATS */ @@ -1662,12 +1644,12 @@ typedef struct Command { * recreated). */ Namespace *nsPtr; /* Points to the namespace containing this * command. */ - unsigned int refCount; /* 1 if in command hashtable plus 1 for each + size_t refCount; /* 1 if in command hashtable plus 1 for each * reference from a CmdName Tcl object * representing a command's name in a ByteCode * instruction sequence. This structure can be * freed when refCount becomes zero. */ - unsigned int cmdEpoch; /* Incremented to invalidate any references + size_t cmdEpoch; /* Incremented to invalidate any references * that point to this command when it is * renamed, deleted, hidden, or exposed. */ CompileProc *compileProc; /* Procedure called to compile command. NULL @@ -1787,7 +1769,7 @@ typedef struct AllocCache { struct Cache *nextPtr; /* Linked list of cache entries. */ Tcl_ThreadId owner; /* Which thread's cache is this? */ Tcl_Obj *firstObjPtr; /* List of free objects for thread. */ - int numObjects; /* Number of objects for thread. */ + size_t numObjects; /* Number of objects for thread. */ } AllocCache; /* @@ -1801,41 +1783,31 @@ typedef struct AllocCache { typedef struct Interp { /* - * Note: the first three fields must match exactly the fields in a - * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the - * other. - * - * The interpreter's result is held in both the string and the - * objResultPtr fields. These fields hold, respectively, the result's - * string or object value. The interpreter's result is always in the - * result field if that is non-empty, otherwise it is in objResultPtr. - * The two fields are kept consistent unless some C code sets - * interp->result directly. Programs should not access result and - * objResultPtr directly; instead, they should always get and set the - * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and - * Tcl_GetStringResult. See the SetResult man page for details. + * The first two fields were named "result" and "freeProc" in earlier + * versions of Tcl. They are no longer used within Tcl, and are no + * longer available to be accessed by extensions. However, they cannot + * be removed. Why? There is a deployed base of stub-enabled extensions + * that query the value of iPtr->stubTable. For them to continue to work, + * the location of the field "stubTable" within the Interp struct cannot + * change. The most robust way to assure that is to leave all fields up to + * that one undisturbed. */ - char *result; /* If the last command returned a string - * result, this points to it. Should not be - * accessed directly; see comment above. */ - Tcl_FreeProc *freeProc; /* Zero means a string result is statically - * allocated. TCL_DYNAMIC means string result - * was allocated with ckalloc and should be - * freed with ckfree. Other values give - * address of procedure to invoke to free the - * string result. Tcl_Eval must free it before - * executing next command. */ + const char *legacyResult; + void (*legacyFreeProc) (void); int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ const struct TclStubs *stubTable; - /* Pointer to the exported Tcl stub table. On - * previous versions of Tcl this is a pointer - * to the objResultPtr or a pointer to a - * buckets array in a hash table. We therefore - * have to do some careful checking before we - * can use this. */ + /* Pointer to the exported Tcl stub table. In + * ancient pre-8.1 versions of Tcl this was a + * pointer to the objResultPtr or a pointer to a + * buckets array in a hash table. Deployed stubs + * enabled extensions check for a NULL pointer value + * and for a TCL_STUBS_MAGIC value to verify they + * are not [load]ing into one of those pre-stubs + * interps. + */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ @@ -1848,15 +1820,7 @@ typedef struct Interp { void *interpInfo; /* Information used by tclInterp.c to keep * track of master/slave interps on a * per-interp basis. */ - union { - void (*optimizer)(void *envPtr); - Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The - * unused space in interp was repurposed for - * pluggable bytecode optimizers. The core - * contains one optimizer, which can be - * selectively overridden by extensions. */ - } extra; - + void (*optimizer)(void *envPtr); /* * Information related to procedures and variables. See tclProc.c and * tclVar.c for usage. @@ -1886,25 +1850,6 @@ typedef struct Interp { * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ /* - * Information used by Tcl_AppendResult to keep track of partial results. - * See Tcl_AppendResult code for details. - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - char *appendResult; /* Storage space for results generated by - * Tcl_AppendResult. Ckalloc-ed. NULL means - * not yet allocated. */ - int appendAvl; /* Total amount of space available at - * partialResult. */ - int appendUsed; /* Number of non-null bytes currently stored - * at partialResult. */ -#else - char *appendResultDontUse; - int appendAvlDontUse; - int appendUsedDontUse; -#endif - - /* * Information about packages. Used only in tclPkg.c. */ @@ -1920,19 +1865,18 @@ typedef struct Interp { * Miscellaneous information: */ - int cmdCount; /* Total number of times a command procedure + size_t cmdCount; /* Total number of times a command procedure * has been called for this interpreter. */ int evalFlags; /* Flags to control next call to Tcl_Eval. * Normally zero, but may be set before * calling Tcl_Eval. See below for valid * values. */ - int unused1; /* No longer used (was termOffset) */ LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl * objects holding literals of scripts * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ - unsigned int compileEpoch; /* Holds the current "compilation epoch" for + size_t compileEpoch; /* Holds the current "compilation epoch" for * this interpreter. This is incremented to * invalidate existing ByteCodes when, e.g., a * command with a compile procedure is @@ -1964,14 +1908,6 @@ typedef struct Interp { * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ -#if TCL_MAJOR_VERSION < 9 -# if !defined(TCL_NO_DEPRECATED) - char resultSpace[TCL_DSTRING_STATIC_SIZE+1]; - /* Static space holding small results. */ -# else - char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1]; -# endif -#endif Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ @@ -2014,7 +1950,7 @@ typedef struct Interp { * as flag values the same as the 'active' * field. */ - int cmdCount; /* Limit for how many commands to execute in + size_t cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is @@ -2050,9 +1986,9 @@ typedef struct Interp { * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ - int numRemovedObjs; /* How many arguments have been stripped off + size_t numRemovedObjs; /* How many arguments have been stripped off * because of ensemble processing. */ - int numInsertedObjs; /* How many of the current arguments were + size_t numInsertedObjs; /* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; @@ -2368,7 +2304,7 @@ typedef struct Interp { */ #define TclOOM(ptr, size) \ - ((size) && ((ptr)||(Tcl_Panic("unable to alloc %u bytes", (size)),1))) + ((size) && ((ptr)||(Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)),1))) /* * The following enum values are used to specify the runtime platform setting @@ -2421,7 +2357,7 @@ typedef enum TclEolTranslation { */ typedef struct List { - unsigned int refCount; + size_t refCount; int maxElemCount; /* Total number of element array slots. */ int elemCount; /* Current number of list elements. */ int canonicalFlag; /* Set if the string representation was @@ -2435,7 +2371,7 @@ typedef struct List { #define LIST_MAX \ (1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *))) #define LIST_SIZE(numElems) \ - (unsigned)(sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *))) + (sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *))) /* * Macro used to get the elements of a list object. @@ -2484,10 +2420,9 @@ typedef struct List { */ #define TclGetBooleanFromObj(interp, objPtr, boolPtr) \ - (((objPtr)->typePtr == &tclIntType) \ + (((objPtr)->typePtr == &tclIntType \ + || (objPtr)->typePtr == &tclBooleanType) \ ? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ - : ((objPtr)->typePtr == &tclBooleanType) \ - ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr))) #ifdef TCL_WIDE_INT_IS_LONG @@ -2572,7 +2507,7 @@ typedef struct List { */ #define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) -typedef ClientData (TclFSGetCwdProc2)(ClientData clientData); +typedef void *(TclFSGetCwdProc2)(void *clientData); typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); @@ -2653,7 +2588,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType; *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr, Tcl_Encoding *encodingPtr); /* @@ -2665,9 +2600,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *leng */ typedef struct ProcessGlobalValue { - unsigned int epoch; /* Epoch counter to detect changes in the + size_t epoch; /* Epoch counter to detect changes in the * master value. */ - unsigned int numBytes; /* Length of the master string. */ + size_t numBytes; /* Length of the master string. */ char *value; /* The master string value. */ Tcl_Encoding encoding; /* system encoding when master string was * initialized. */ @@ -2711,10 +2646,6 @@ typedef struct ProcessGlobalValue { */ #define TCL_NUMBER_INT 2 -#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED) -# define TCL_NUMBER_LONG 1 /* deprecated, not used any more */ -# define TCL_NUMBER_WIDE TCL_NUMBER_INT /* deprecated */ -#endif #define TCL_NUMBER_BIG 3 #define TCL_NUMBER_DOUBLE 4 #define TCL_NUMBER_NAN 5 @@ -2740,7 +2671,7 @@ MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr; MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr; -MODULE_SCOPE ClientData tclTimeClientData; +MODULE_SCOPE void *tclTimeClientData; /* * Variables denoting the Tcl object types defined in the core. @@ -2906,7 +2837,7 @@ struct Tcl_LoadHandle_ { */ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, - const unsigned char *bytes, int len); + const unsigned char *bytes, size_t len); MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); MODULE_SCOPE void TclAdvanceContinuations(int *line, int **next, @@ -2919,22 +2850,20 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], int objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, - void *codePtr, CmdFrame *cfPtr, int cmd, int pc); + void *codePtr, CmdFrame *cfPtr, int cmd, size_t pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, CmdFrame **cfPtrPtr, int *wordPtr); MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, - int strLen, const unsigned char *pattern, - int ptnLen, int flags); + size_t strLen, const unsigned char *pattern, + size_t ptnLen, int flags); MODULE_SCOPE double TclCeil(const mp_int *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *name, int index); -MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, - const char *value); MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); @@ -2949,11 +2878,11 @@ MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, Tcl_Obj *originObjPtr); -MODULE_SCOPE int TclConvertElement(const char *src, int length, +MODULE_SCOPE size_t TclConvertElement(const char *src, size_t length, char *dst, int flags); MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, - Tcl_ObjCmdProc *proc, ClientData clientData, + Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, const char *name, Tcl_Namespace *nameNamespacePtr, @@ -2962,10 +2891,10 @@ MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, - int *sizePtr, int *literalPtr); + size_t *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, - int numBytes, int flags, int line, + size_t numBytes, int flags, int line, int *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; @@ -2976,9 +2905,9 @@ MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd; MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, @@ -3017,7 +2946,7 @@ MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, - ClientData clientData, + void *clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *encodingName); @@ -3033,7 +2962,7 @@ MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr); MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, ClientData *clientDataPtr, + Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, const char *modeString, int *seekFlagPtr, @@ -3042,7 +2971,7 @@ MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, - unsigned int *sizePtr); + size_t *sizePtr); MODULE_SCOPE int TclGetLoadedPackagesEx(Tcl_Interp *interp, const char *targetName, const char *packageName); @@ -3055,16 +2984,16 @@ MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); -MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoExistsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoCoroutineCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); -MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoGlobalsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoLocalsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoVarsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitBignumFromLong(mp_int *, long); @@ -3105,7 +3034,7 @@ MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name, const EnsembleImplMap map[]); -MODULE_SCOPE int TclMaxListLength(const char *bytes, int numBytes, +MODULE_SCOPE int TclMaxListLength(const char *bytes, size_t numBytes, const char **endPtr); MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, @@ -3122,22 +3051,22 @@ MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); MODULE_SCOPE int TclParseBackslash(const char *src, - int numBytes, int *readPtr, char *dst); -MODULE_SCOPE int TclParseHex(const char *src, int numBytes, + size_t numBytes, size_t *readPtr, char *dst); +MODULE_SCOPE int TclParseHex(const char *src, size_t numBytes, int *resultPtr); MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *expected, const char *bytes, - int numBytes, const char **endPtrPtr, int flags); + size_t numBytes, const char **endPtrPtr, int flags); MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, - int numBytes, Tcl_Parse *parsePtr); -MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes); + size_t numBytes, Tcl_Parse *parsePtr); +MODULE_SCOPE size_t TclParseAllWhiteSpace(const char *src, size_t numBytes); MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, - int len); + size_t len); MODULE_SCOPE int TclpDeleteFile(const void *path); MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr); MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr); @@ -3148,11 +3077,11 @@ MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, const char *host, int port, int willBind, const char **errorMsgPtr); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, - Tcl_ThreadCreateProc *proc, ClientData clientData, - int stackSize, int flags); -MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); + Tcl_ThreadCreateProc *proc, void *clientData, + size_t stackSize, int flags); +MODULE_SCOPE size_t TclpFindVariable(const char *name, size_t *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, - unsigned int *lengthPtr, Tcl_Encoding *encodingPtr); + size_t *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); @@ -3172,7 +3101,7 @@ MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp, MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); -MODULE_SCOPE ClientData TclpGetNativeCwd(ClientData clientData); +MODULE_SCOPE void *TclpGetNativeCwd(void *clientData); MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep; MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType); @@ -3196,9 +3125,9 @@ MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id); MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, - int reStrLen, Tcl_DString *dsPtr, int *flagsPtr, + size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); -MODULE_SCOPE int TclScanElement(const char *string, int length, +MODULE_SCOPE size_t TclScanElement(const char *string, size_t length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); @@ -3213,37 +3142,37 @@ MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result); MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, - Tcl_Obj *const *objv, int objc, int subIdx, + Tcl_Obj *const *objv, int objc, size_t subIdx, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, - int numBytes); + size_t numBytes); typedef int (*memCmpFn_t)(const void*, const void*, size_t); MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, - int checkEq, int nocase, int reqlength); + int checkEq, int nocase, size_t reqlength); MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int *nocase, int *reqlength); -MODULE_SCOPE int TclStringMatch(const char *str, int strLen, +MODULE_SCOPE int TclStringMatch(const char *str, size_t strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, Tcl_Obj *patternObj, int flags); MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes, - int numBytes, int flags, int line, + size_t numBytes, int flags, int line, struct CompileEnv *envPtr); MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts, Tcl_Obj *const opts[], int *flagPtr); MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, - int numBytes, int flags, Tcl_Parse *parsePtr, + size_t numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr); MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, int *tokensLeftPtr, int line, int *clNextOuter, const char *outerScript); -MODULE_SCOPE int TclTrim(const char *bytes, int numBytes, - const char *trim, int numTrim, int *trimRight); -MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, - const char *trim, int numTrim); -MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, - const char *trim, int numTrim); +MODULE_SCOPE size_t TclTrim(const char *bytes, size_t numBytes, + const char *trim, size_t numTrim, size_t *trimRight); +MODULE_SCOPE size_t TclTrimLeft(const char *bytes, size_t numBytes, + const char *trim, size_t numTrim); +MODULE_SCOPE size_t TclTrimRight(const char *bytes, size_t numBytes, + const char *trim, size_t numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); MODULE_SCOPE void TclRegisterCommandTypeName( Tcl_ObjCmdProc *implementationProc, @@ -3251,7 +3180,7 @@ MODULE_SCOPE void TclRegisterCommandTypeName( MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCount(int ch); -MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); +MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(void *clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, @@ -3276,7 +3205,7 @@ MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, - const char *msg, int length); + const char *msg, size_t length); /* Tip 430 */ MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp); @@ -3287,60 +3216,55 @@ MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp); *---------------------------------------------------------------- */ -MODULE_SCOPE int Tcl_AfterObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_AfterObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_AppendObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_AppendObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ApplyObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ApplyObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_BreakObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_CatchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -#endif -MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CdObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_CdObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclChanCreateObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanCreateObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPostEventObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanPostEventObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPopObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanPopObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPushObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanPushObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclClockInit(Tcl_Interp *interp); MODULE_SCOPE int TclClockOldscanObjCmd( void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CloseObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_CloseObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ConcatObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ConcatObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ContinueObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ContinueObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, - ClientData clientData); + void *clientData); MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd( - ClientData clientData, Tcl_Interp *interp, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp); MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, @@ -3349,230 +3273,230 @@ MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, Tcl_Obj *const pathv[], Tcl_Obj *keysPtr); MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr, int pathc, Tcl_Obj *const pathv[]); -MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_DisassembleObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* Assemble command function */ -MODULE_SCOPE int Tcl_AssembleObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_AssembleObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData, +MODULE_SCOPE int TclNRAssembleObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_EofObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ErrorObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ErrorObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_EvalObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_EvalObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExecObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ExecObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExitObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ExitObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExprObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ExprObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FblockedObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_FblockedObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FconfigureObjCmd( - ClientData clientData, Tcl_Interp *interp, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FcopyObjCmd(ClientData dummy, +MODULE_SCOPE int Tcl_FcopyObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_FileEventObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_FileEventObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FlushObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_FlushObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ForObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ForObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ForeachObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ForeachObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FormatObjCmd(ClientData dummy, +MODULE_SCOPE int Tcl_FormatObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GetsObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_GetsObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GlobalObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_GlobalObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GlobObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_GlobObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_IfObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_IfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_IncrObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_IncrObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_InterpObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_InterpObjCmd(void *clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_JoinObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_JoinObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LappendObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LappendObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LassignObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LassignObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LindexObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LindexObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LinsertObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LinsertObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LlengthObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LlengthObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ListObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ListObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LmapObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LmapObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LoadObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LpopObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LpopObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LrangeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LrepeatObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LreplaceObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LreplaceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LreverseObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LreverseObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsearchObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LsearchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsetObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LsetObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsortObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LsortObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclNamespaceEnsembleCmd(ClientData dummy, +MODULE_SCOPE int TclNamespaceEnsembleCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_OpenObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_OpenObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PackageObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PackageObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PidObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PidObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_PutsObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PutsObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PwdObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PwdObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ReadObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ReadObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RegexpObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RegexpObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RegsubObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RegsubObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RenameObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RenameObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RepresentationCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RepresentationCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ReturnObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ReturnObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ScanObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ScanObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SeekObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SeekObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SetObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SetObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SplitObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SplitObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SocketObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SocketObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SourceObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SourceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_SubstObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SubstObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SwitchObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SwitchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TellObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int Tcl_ThrowObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TimeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TraceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TryObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UnloadObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UnloadObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UnsetObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UnsetObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UpdateObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UpdateObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UplevelObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UplevelObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UpvarObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UpvarObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_VariableObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_VariableObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_VwaitObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_VwaitObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_WhileObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -3898,139 +3822,139 @@ MODULE_SCOPE int TclCompileBasicMin2ArgCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclInvertOpCmd(ClientData clientData, +MODULE_SCOPE int TclInvertOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNotOpCmd(ClientData clientData, +MODULE_SCOPE int TclNotOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNotOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclAddOpCmd(ClientData clientData, +MODULE_SCOPE int TclAddOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileAddOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclMulOpCmd(ClientData clientData, +MODULE_SCOPE int TclMulOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileMulOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclAndOpCmd(ClientData clientData, +MODULE_SCOPE int TclAndOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileAndOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclOrOpCmd(ClientData clientData, +MODULE_SCOPE int TclOrOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileOrOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclXorOpCmd(ClientData clientData, +MODULE_SCOPE int TclXorOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileXorOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclPowOpCmd(ClientData clientData, +MODULE_SCOPE int TclPowOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompilePowOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLshiftOpCmd(ClientData clientData, +MODULE_SCOPE int TclLshiftOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLshiftOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclRshiftOpCmd(ClientData clientData, +MODULE_SCOPE int TclRshiftOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileRshiftOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclModOpCmd(ClientData clientData, +MODULE_SCOPE int TclModOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileModOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNeqOpCmd(ClientData clientData, +MODULE_SCOPE int TclNeqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclStrneqOpCmd(ClientData clientData, +MODULE_SCOPE int TclStrneqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStrneqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclInOpCmd(ClientData clientData, +MODULE_SCOPE int TclInOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNiOpCmd(ClientData clientData, +MODULE_SCOPE int TclNiOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNiOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclMinusOpCmd(ClientData clientData, +MODULE_SCOPE int TclMinusOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileMinusOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclDivOpCmd(ClientData clientData, +MODULE_SCOPE int TclDivOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLessOpCmd(ClientData clientData, +MODULE_SCOPE int TclLessOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLeqOpCmd(ClientData clientData, +MODULE_SCOPE int TclLeqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData, +MODULE_SCOPE int TclGreaterOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclGeqOpCmd(ClientData clientData, +MODULE_SCOPE int TclGeqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclEqOpCmd(ClientData clientData, +MODULE_SCOPE int TclEqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclStreqOpCmd(ClientData clientData, +MODULE_SCOPE int TclStreqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, @@ -4048,14 +3972,14 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); -MODULE_SCOPE int TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack, - int start); -MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, - int last); +MODULE_SCOPE size_t TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack, + size_t start); +MODULE_SCOPE size_t TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, + size_t last); MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr, - int count, int flags); + size_t count, int flags); MODULE_SCOPE Tcl_Obj * TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr, - int first, int count, Tcl_Obj *insertPtr, + size_t first, size_t count, Tcl_Obj *insertPtr, int flags); MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags); @@ -4170,8 +4094,8 @@ MODULE_SCOPE Tcl_Obj * TclGetArrayDefault(Var *arrayPtr); */ MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, - int before, int after, int *indexPtr); -MODULE_SCOPE int TclIndexDecode(int encoded, int endValue); + size_t before, size_t after, int *indexPtr); +MODULE_SCOPE size_t TclIndexDecode(int encoded, size_t endValue); /* Constants used in index value encoding routines. */ #define TCL_INDEX_END (-2) @@ -4244,7 +4168,7 @@ typedef const char *TclDTraceStr; /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) with - * 'length == -1'. + * 'length == TCL_AUTO_LENGTH'. * Use empty 'if ; else' to handle use in unbraced outer if/else conditions. */ @@ -4254,9 +4178,9 @@ typedef const char *TclDTraceStr; TCL_DTRACE_OBJ_FREE(objPtr); \ if ((objPtr)->bytes \ && ((objPtr)->bytes != &tclEmptyString)) { \ - ckfree((objPtr)->bytes); \ + Tcl_Free((objPtr)->bytes); \ } \ - (objPtr)->length = -1; \ + (objPtr)->length = TCL_AUTO_LENGTH; \ TclFreeObjStorage(objPtr); \ TclIncrObjsFreed(); \ } else { \ @@ -4278,10 +4202,10 @@ typedef const char *TclDTraceStr; */ # define TclAllocObjStorageEx(interp, objPtr) \ - (objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj)) + (objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj)) # define TclFreeObjStorageEx(interp, objPtr) \ - ckfree(objPtr) + Tcl_Free(objPtr) #undef USE_THREAD_ALLOC #undef USE_TCLALLOC @@ -4409,7 +4333,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, * is referenced multiple times, it should be as simple an expression as * possible. The ANSI C "prototype" for this macro is: * - * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, int len); + * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len); * * This macro should only be called on an unshared objPtr where * objPtr->typePtr->freeIntRepProc == NULL @@ -4421,8 +4345,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (objPtr)->bytes = &tclEmptyString; \ (objPtr)->length = 0; \ } else { \ - (objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \ - memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (unsigned) (len)); \ + (objPtr)->bytes = Tcl_Alloc((len) + 1); \ + memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ } @@ -4442,10 +4366,37 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) +#if 0 + static inline char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lenPtr) { + char *response = Tcl_GetString(objPtr); + *(lenPtr) = objPtr->length; + return response; + } + static inline Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lenPtr) { + Tcl_UniChar *response = Tcl_GetUnicodeFromObj(objPtr, NULL); + *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1); + return response; + } + static inline unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lenPtr) { + unsigned char *response = Tcl_GetByteArrayFromObj(objPtr, NULL); + *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1); + return response; + } + +#else #define TclGetStringFromObj(objPtr, lenPtr) \ - ((objPtr)->bytes \ - ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ - : Tcl_GetStringFromObj((objPtr), (lenPtr))) + (((objPtr)->bytes \ + ? 0 : Tcl_GetString((objPtr)), \ + *(lenPtr) = (objPtr)->length, (objPtr)->bytes)) +#define TclGetUnicodeFromObj(objPtr, lenPtr) \ + (Tcl_GetUnicodeFromObj(objPtr, NULL), \ + *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1), \ + Tcl_GetUnicodeFromObj(objPtr, NULL)) +#define TclGetByteArrayFromObj(objPtr, lenPtr) \ + (Tcl_GetByteArrayFromObj(objPtr, NULL), \ + *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1), \ + Tcl_GetByteArrayFromObj(objPtr, NULL)) +#endif /* *---------------------------------------------------------------- @@ -4477,7 +4428,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclInvalidateStringRep(objPtr) \ if ((objPtr)->bytes != NULL) { \ if ((objPtr)->bytes != &tclEmptyString) { \ - ckfree((objPtr)->bytes); \ + Tcl_Free((objPtr)->bytes); \ } \ (objPtr)->bytes = NULL; \ } @@ -4541,14 +4492,14 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, if (allocated > TCL_MAX_TOKENS) { \ allocated = TCL_MAX_TOKENS; \ } \ - newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr, \ + newPtr = (Tcl_Token *) Tcl_AttemptRealloc((char *) oldPtr, \ (unsigned int) (allocated * sizeof(Tcl_Token))); \ if (newPtr == NULL) { \ allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH; \ if (allocated > TCL_MAX_TOKENS) { \ allocated = TCL_MAX_TOKENS; \ } \ - newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr, \ + newPtr = (Tcl_Token *) Tcl_Realloc((char *) oldPtr, \ (unsigned int) (allocated * sizeof(Tcl_Token))); \ } \ (available) = allocated; \ @@ -4590,13 +4541,13 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, * "prototype" for this macro is: * * MODULE_SCOPE void TclNumUtfChars(int numChars, const char *bytes, - * int numBytes); + * size_t numBytes); *---------------------------------------------------------------- */ #define TclNumUtfChars(numChars, bytes, numBytes) \ do { \ - int _count, _i = (numBytes); \ + size_t _count, _i = (numBytes); \ unsigned char *_str = (unsigned char *) (bytes); \ while (_i && (*_str < 0xC0)) { _i--; _str++; } \ _count = (numBytes) - _i; \ @@ -4737,7 +4688,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * * MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d); - * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len); + * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, size_t len); * MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral); * *---------------------------------------------------------------- @@ -4792,7 +4743,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * sizeof(sLiteral "") will fail to compile otherwise. */ #define TclNewLiteralStringObj(objPtr, sLiteral) \ - TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) + TclNewStringObj((objPtr), (sLiteral), sizeof(sLiteral "") - 1) /* *---------------------------------------------------------------- @@ -4805,7 +4756,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #define TclDStringAppendLiteral(dsPtr, sLiteral) \ - Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) + Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1) #define TclDStringClear(dsPtr) \ Tcl_DStringSetLength((dsPtr), 0) @@ -4837,9 +4788,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #ifdef offsetof -#define TclOffset(type, field) ((int) offsetof(type, field)) +#define TclOffset(type, field) (offsetof(type, field)) #else -#define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field)) +#define TclOffset(type, field) (((char *) &((type *) 0)->field)) #endif /* @@ -4861,7 +4812,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; #define TclCleanupCommandMacro(cmdPtr) \ if ((cmdPtr)->refCount-- <= 1) { \ - ckfree(cmdPtr);\ + Tcl_Free(cmdPtr);\ } /* @@ -4924,13 +4875,13 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; Tcl_Obj *_objPtr; \ TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ TclIncrObjsAllocated(); \ - TclAllocObjStorageEx((interp), (_objPtr)); \ - memPtr = (ClientData) (_objPtr); \ + TclAllocObjStorageEx((interp), _objPtr); \ + memPtr = (void *)_objPtr; \ } while (0) #define TclSmallFreeEx(interp, memPtr) \ do { \ - TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr)); \ + TclFreeObjStorageEx((interp), (Tcl_Obj *)memPtr); \ TclIncrObjsFreed(); \ } while (0) @@ -4940,7 +4891,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; Tcl_Obj *_objPtr; \ TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ TclNewObj(_objPtr); \ - memPtr = (ClientData) _objPtr; \ + memPtr = (void *)_objPtr; \ } while (0) #define TclSmallFreeEx(interp, memPtr) \ @@ -4954,6 +4905,21 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; #endif /* TCL_MEM_DEBUG */ /* + * Macros to convert size_t to wide-int (and wide-int object) considering + * platform-related negative value ((size_t)-1), if wide-int and size_t + * have different dimensions (e. g. 32-bit platform). + */ + +#if (!defined(TCL_WIDE_INT_IS_LONG) || (LONG_MAX > UINT_MAX)) && (SIZE_MAX <= UINT_MAX) +# define TclWideIntFromSize(value) (((Tcl_WideInt)(((size_t)(value))+1))-1) +# define TclNewWideIntObjFromSize(value) \ + Tcl_NewWideIntObj(TclWideIntFromSize(value)) +#else +# define TclWideIntFromSize(value) (value) +# define TclNewWideIntObjFromSize Tcl_NewWideIntObj +#endif + +/* * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org> */ @@ -4989,7 +4955,7 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn)); typedef struct NRE_callback { Tcl_NRPostProc *procPtr; - ClientData data[4]; + void *data[4]; struct NRE_callback *nextPtr; } NRE_callback; @@ -5004,10 +4970,10 @@ typedef struct NRE_callback { NRE_callback *_callbackPtr; \ TCLNR_ALLOC((interp), (_callbackPtr)); \ _callbackPtr->procPtr = (postProcPtr); \ - _callbackPtr->data[0] = (ClientData)(data0); \ - _callbackPtr->data[1] = (ClientData)(data1); \ - _callbackPtr->data[2] = (ClientData)(data2); \ - _callbackPtr->data[3] = (ClientData)(data3); \ + _callbackPtr->data[0] = (void *)(data0); \ + _callbackPtr->data[1] = (void *)(data1); \ + _callbackPtr->data[2] = (void *)(data2); \ + _callbackPtr->data[3] = (void *)(data3); \ _callbackPtr->nextPtr = TOP_CB(interp); \ TOP_CB(interp) = _callbackPtr; \ } while (0) @@ -5018,8 +4984,8 @@ typedef struct NRE_callback { #define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr)) #else #define TCLNR_ALLOC(interp, ptr) \ - (ptr = ((ClientData) ckalloc(sizeof(NRE_callback)))) -#define TCLNR_FREE(interp, ptr) ckfree(ptr) + (ptr = (Tcl_Alloc(sizeof(NRE_callback)))) +#define TCLNR_FREE(interp, ptr) Tcl_Free(ptr) #endif #if NRE_ENABLE_ASSERTS @@ -5033,9 +4999,9 @@ typedef struct NRE_callback { #include "tclTomMathDecls.h" #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) -#define Tcl_AttemptAlloc(size) TclpAlloc(size) -#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size)) -#define Tcl_Free(ptr) TclpFree(ptr) +#define Tcl_AttemptAlloc TclpAlloc +#define Tcl_AttemptRealloc TclpRealloc +#define Tcl_Free TclpFree #endif #endif /* _TCLINT */ diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index eddbcb3..1bf36ab 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -27,22 +27,6 @@ # endif #endif -#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) -/* Those macro's are especially for Itcl 3.4 compatibility */ -# define tclCreateNamespace tcl_CreateNamespace -# define tclDeleteNamespace tcl_DeleteNamespace -# define tclAppendExportList tcl_AppendExportList -# define tclExport tcl_Export -# define tclImport tcl_Import -# define tclForgetImport tcl_ForgetImport -# define tclGetCurrentNamespace_ tcl_GetCurrentNamespace -# define tclGetGlobalNamespace_ tcl_GetGlobalNamespace -# define tclFindNamespace tcl_FindNamespace -# define tclFindCommand tcl_FindCommand -# define tclGetCommandFromObj tcl_GetCommandFromObj -# define tclGetCommandFullName tcl_GetCommandFullName -#endif /* !defined(TCL_NO_DEPRECATED) */ - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -71,13 +55,9 @@ EXTERN int TclCleanupChildren(Tcl_Interp *interp, int numPids, /* 6 */ EXTERN void TclCleanupCommand(Command *cmdPtr); /* 7 */ -EXTERN int TclCopyAndCollapse(int count, const char *src, +EXTERN size_t TclCopyAndCollapse(size_t count, const char *src, char *dst); -/* 8 */ -TCL_DEPRECATED("") -int TclCopyChannelOld(Tcl_Interp *interp, - Tcl_Channel inChan, Tcl_Channel outChan, - int toRead, Tcl_Obj *cmdPtr); +/* Slot 8 is reserved */ /* 9 */ EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, @@ -95,7 +75,7 @@ EXTERN void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr); /* Slot 13 is reserved */ /* 14 */ -EXTERN int TclDumpMemoryInfo(ClientData clientData, int flags); +EXTERN int TclDumpMemoryInfo(void *clientData, int flags); /* Slot 15 is reserved */ /* 16 */ EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); @@ -108,12 +88,12 @@ EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); EXTERN int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, - const char **nextPtr, int *sizePtr, + const char **nextPtr, size_t *sizePtr, int *bracePtr); /* 23 */ EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ -EXTERN int TclFormatInt(char *buffer, Tcl_WideInt n); +EXTERN size_t TclFormatInt(char *buffer, Tcl_WideInt n); /* 25 */ EXTERN void TclFreePackageInfo(Interp *iPtr); /* Slot 26 is reserved */ @@ -130,7 +110,8 @@ EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str, /* Slot 33 is reserved */ /* 34 */ EXTERN int TclGetIntForIndex(Tcl_Interp *interp, - Tcl_Obj *objPtr, int endValue, int *indexPtr); + Tcl_Obj *objPtr, size_t endValue, + int *indexPtr); /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* 37 */ @@ -151,7 +132,7 @@ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ -EXTERN CONST86 char * TclpGetUserHome(const char *name, +EXTERN const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* Slot 43 is reserved */ /* 44 */ @@ -171,11 +152,11 @@ EXTERN void TclInitCompiledLocals(Tcl_Interp *interp, EXTERN int TclInterpInit(Tcl_Interp *interp); /* Slot 52 is reserved */ /* 53 */ -EXTERN int TclInvokeObjectCommand(ClientData clientData, +EXTERN int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp, int argc, const char **argv); /* 54 */ -EXTERN int TclInvokeStringCommand(ClientData clientData, +EXTERN int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 55 */ @@ -195,7 +176,7 @@ EXTERN Tcl_Obj * TclNewProcBodyObj(Proc *procPtr); /* 62 */ EXTERN int TclObjCommandComplete(Tcl_Obj *cmdPtr); /* 63 */ -EXTERN int TclObjInterpProc(ClientData clientData, +EXTERN int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 64 */ @@ -206,36 +187,30 @@ EXTERN int TclObjInvoke(Tcl_Interp *interp, int objc, /* Slot 67 is reserved */ /* Slot 68 is reserved */ /* 69 */ -EXTERN char * TclpAlloc(unsigned int size); +EXTERN void * TclpAlloc(size_t size); /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* 74 */ -EXTERN void TclpFree(char *ptr); +EXTERN void TclpFree(void *ptr); /* 75 */ -EXTERN unsigned long TclpGetClicks(void); +EXTERN Tcl_WideUInt TclpGetClicks(void); /* 76 */ -EXTERN unsigned long TclpGetSeconds(void); -/* 77 */ -TCL_DEPRECATED("") -void TclpGetTime(Tcl_Time *time); +EXTERN Tcl_WideUInt TclpGetSeconds(void); +/* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ -EXTERN char * TclpRealloc(char *ptr, unsigned int size); +EXTERN void * TclpRealloc(void *ptr, size_t size); /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ /* Slot 85 is reserved */ /* Slot 86 is reserved */ /* Slot 87 is reserved */ -/* 88 */ -TCL_DEPRECATED("") -char * TclPrecTraceProc(ClientData clientData, - Tcl_Interp *interp, const char *name1, - const char *name2, int flags); +/* Slot 88 is reserved */ /* 89 */ EXTERN int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); @@ -248,7 +223,7 @@ EXTERN int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, const char *description, const char *procName); /* 93 */ -EXTERN void TclProcDeleteProc(ClientData clientData); +EXTERN void TclProcDeleteProc(void *clientData); /* Slot 94 is reserved */ /* Slot 95 is reserved */ /* 96 */ @@ -262,15 +237,13 @@ EXTERN int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ /* 101 */ -EXTERN CONST86 char * TclSetPreInitScript(const char *string); +EXTERN const char * TclSetPreInitScript(const char *string); /* 102 */ EXTERN void TclSetupEnv(Tcl_Interp *interp); /* 103 */ EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); -/* 104 */ -TCL_DEPRECATED("") -int TclSockMinimumBuffersOld(int sock, int size); +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ @@ -286,25 +259,12 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); -/* 112 */ -EXTERN int TclAppendExportList(Tcl_Interp *interp, - Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); -/* 113 */ -EXTERN Tcl_Namespace * TclCreateNamespace(Tcl_Interp *interp, - const char *name, ClientData clientData, - Tcl_NamespaceDeleteProc *deleteProc); -/* 114 */ -EXTERN void TclDeleteNamespace(Tcl_Namespace *nsPtr); -/* 115 */ -EXTERN int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int resetListFirst); -/* 116 */ -EXTERN Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags); -/* 117 */ -EXTERN Tcl_Namespace * TclFindNamespace(Tcl_Interp *interp, - const char *name, - Tcl_Namespace *contextNsPtr, int flags); +/* Slot 112 is reserved */ +/* Slot 113 is reserved */ +/* Slot 114 is reserved */ +/* Slot 115 is reserved */ +/* Slot 116 is reserved */ +/* Slot 117 is reserved */ /* 118 */ EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); @@ -316,25 +276,15 @@ EXTERN int Tcl_GetNamespaceResolvers( EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); -/* 121 */ -EXTERN int TclForgetImport(Tcl_Interp *interp, - Tcl_Namespace *nsPtr, const char *pattern); -/* 122 */ -EXTERN Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr); -/* 123 */ -EXTERN void TclGetCommandFullName(Tcl_Interp *interp, - Tcl_Command command, Tcl_Obj *objPtr); -/* 124 */ -EXTERN Tcl_Namespace * TclGetCurrentNamespace_(Tcl_Interp *interp); -/* 125 */ -EXTERN Tcl_Namespace * TclGetGlobalNamespace_(Tcl_Interp *interp); +/* Slot 121 is reserved */ +/* Slot 122 is reserved */ +/* Slot 123 is reserved */ +/* Slot 124 is reserved */ +/* Slot 125 is reserved */ /* 126 */ EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); -/* 127 */ -EXTERN int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int allowOverwrite); +/* Slot 127 is reserved */ /* 128 */ EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp); /* 129 */ @@ -352,9 +302,7 @@ EXTERN void Tcl_SetNamespaceResolvers( Tcl_ResolveCompiledVarProc *compiledVarProc); /* 132 */ EXTERN int TclpHasSockets(Tcl_Interp *interp); -/* 133 */ -TCL_DEPRECATED("") -struct tm * TclpGetDate(const time_t *time, int useGMT); +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -368,7 +316,7 @@ EXTERN const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 142 */ EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, - ClientData clientData); + void *clientData); /* 143 */ EXTERN int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); @@ -388,7 +336,7 @@ EXTERN void TclHandleRelease(TclHandle handle); /* 150 */ EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); /* 151 */ -EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, int index, +EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, int *startPtr, int *endPtr); /* 152 */ EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr); @@ -402,18 +350,14 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg, /* 157 */ EXTERN Var * TclVarTraceExists(Tcl_Interp *interp, const char *varName); -/* 158 */ -TCL_DEPRECATED("use public Tcl_SetStartupScript()") -void TclSetStartupScriptFileName(const char *filename); -/* 159 */ -TCL_DEPRECATED("use public Tcl_GetStartupScript()") -const char * TclGetStartupScriptFileName(void); +/* Slot 158 is reserved */ +/* Slot 159 is reserved */ /* Slot 160 is reserved */ /* 161 */ EXTERN int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 162 */ -EXTERN void TclChannelEventScriptInvoker(ClientData clientData, +EXTERN void TclChannelEventScriptInvoker(void *clientData, int flags); /* 163 */ EXTERN const void * TclGetInstructionTable(void); @@ -425,31 +369,27 @@ EXTERN void TclpSetInitialEncodings(void); EXTERN int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); -/* 167 */ -TCL_DEPRECATED("use public Tcl_SetStartupScript()") -void TclSetStartupScriptPath(Tcl_Obj *pathPtr); -/* 168 */ -TCL_DEPRECATED("use public Tcl_GetStartupScript()") -Tcl_Obj * TclGetStartupScriptPath(void); +/* Slot 167 is reserved */ +/* Slot 168 is reserved */ /* 169 */ EXTERN int TclpUtfNcmp2(const char *s1, const char *s2, - unsigned long n); + size_t n); /* 170 */ EXTERN int TclCheckInterpTraces(Tcl_Interp *interp, - const char *command, int numChars, + const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ EXTERN int TclCheckExecutionTraces(Tcl_Interp *interp, - const char *command, int numChars, + const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 172 */ EXTERN int TclInThreadExit(void); /* 173 */ EXTERN int TclUniCharMatch(const Tcl_UniChar *string, - int strLen, const Tcl_UniChar *pattern, - int ptnLen, int flags); + size_t strLen, const Tcl_UniChar *pattern, + size_t ptnLen, int flags); /* Slot 174 is reserved */ /* 175 */ EXTERN int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, @@ -462,19 +402,12 @@ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr); EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); -/* 178 */ -EXTERN void TclSetStartupScript(Tcl_Obj *pathPtr, - const char *encodingName); -/* 179 */ -EXTERN Tcl_Obj * TclGetStartupScript(const char **encodingNamePtr); +/* Slot 178 is reserved */ +/* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -/* 182 */ -TCL_DEPRECATED("") -struct tm * TclpLocaltime(const time_t *clock); -/* 183 */ -TCL_DEPRECATED("") -struct tm * TclpGmtime(const time_t *clock); +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ @@ -527,7 +460,7 @@ EXTERN Tcl_Obj * TclGetObjNameOfExecutable(void); EXTERN void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding); /* 215 */ -EXTERN void * TclStackAlloc(Tcl_Interp *interp, int numBytes); +EXTERN void * TclStackAlloc(Tcl_Interp *interp, size_t numBytes); /* 216 */ EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr); /* 217 */ @@ -551,7 +484,7 @@ EXTERN Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp, /* 226 */ EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr); /* 227 */ -EXTERN void TclSetNsPath(Namespace *nsPtr, int pathLength, +EXTERN void TclSetNsPath(Namespace *nsPtr, size_t pathLength, Tcl_Namespace *pathAry[]); /* Slot 228 is reserved */ /* 229 */ @@ -577,15 +510,12 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); -/* 236 */ -TCL_DEPRECATED("use Tcl_BackgroundException") -void TclBackgroundException(Tcl_Interp *interp, int code); +/* Slot 236 is reserved */ /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ -EXTERN int TclNRInterpProc(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +EXTERN int TclNRInterpProc(void *clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* 239 */ EXTERN int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, @@ -608,7 +538,7 @@ EXTERN Tcl_HashTable * TclGetNamespaceChildTable(Tcl_Namespace *nsPtr); EXTERN Tcl_HashTable * TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr); /* 246 */ EXTERN int TclInitRewriteEnsemble(Tcl_Interp *interp, - int numRemoved, int numInserted, + size_t numRemoved, size_t numInserted, Tcl_Obj *const *objv); /* 247 */ EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp, @@ -625,7 +555,7 @@ EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force); /* 251 */ EXTERN int TclRegisterLiteral(void *envPtr, const char *bytes, - int length, int flags); + size_t length, int flags); /* 252 */ EXTERN Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, @@ -665,14 +595,14 @@ typedef struct TclIntStubs { void (*reserved4)(void); int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */ void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */ - int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */ - TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */ + size_t (*tclCopyAndCollapse) (size_t count, const char *src, char *dst); /* 7 */ + void (*reserved8)(void); int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */ int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */ void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */ void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */ void (*reserved13)(void); - int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */ + int (*tclDumpMemoryInfo) (void *clientData, int flags); /* 14 */ void (*reserved15)(void); void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */ void (*reserved17)(void); @@ -680,9 +610,9 @@ typedef struct TclIntStubs { void (*reserved19)(void); void (*reserved20)(void); void (*reserved21)(void); - int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */ + int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, size_t *sizePtr, int *bracePtr); /* 22 */ Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */ - int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */ + size_t (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */ void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */ void (*reserved26)(void); void (*reserved27)(void); @@ -692,7 +622,7 @@ typedef struct TclIntStubs { const char * (*tclGetExtension) (const char *name); /* 31 */ int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */ void (*reserved33)(void); - int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */ + int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, int *indexPtr); /* 34 */ void (*reserved35)(void); void (*reserved36)(void); int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */ @@ -700,7 +630,7 @@ typedef struct TclIntStubs { TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ - CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ + const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ void (*reserved43)(void); int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */ int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */ @@ -711,8 +641,8 @@ typedef struct TclIntStubs { void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */ int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */ void (*reserved52)(void); - int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */ - int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ + int (*tclInvokeObjectCommand) (void *clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */ + int (*tclInvokeStringCommand) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */ void (*reserved56)(void); void (*reserved57)(void); @@ -721,37 +651,37 @@ typedef struct TclIntStubs { int (*tclNeedSpace) (const char *start, const char *end); /* 60 */ Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */ int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */ - int (*tclObjInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */ + int (*tclObjInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */ int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 64 */ void (*reserved65)(void); void (*reserved66)(void); void (*reserved67)(void); void (*reserved68)(void); - char * (*tclpAlloc) (unsigned int size); /* 69 */ + void * (*tclpAlloc) (size_t size); /* 69 */ void (*reserved70)(void); void (*reserved71)(void); void (*reserved72)(void); void (*reserved73)(void); - void (*tclpFree) (char *ptr); /* 74 */ - unsigned long (*tclpGetClicks) (void); /* 75 */ - unsigned long (*tclpGetSeconds) (void); /* 76 */ - TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */ + void (*tclpFree) (void *ptr); /* 74 */ + Tcl_WideUInt (*tclpGetClicks) (void); /* 75 */ + Tcl_WideUInt (*tclpGetSeconds) (void); /* 76 */ + void (*reserved77)(void); void (*reserved78)(void); void (*reserved79)(void); void (*reserved80)(void); - char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */ + void * (*tclpRealloc) (void *ptr, size_t size); /* 81 */ void (*reserved82)(void); void (*reserved83)(void); void (*reserved84)(void); void (*reserved85)(void); void (*reserved86)(void); void (*reserved87)(void); - TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */ + void (*reserved88)(void); int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */ void (*reserved90)(void); void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */ int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */ - void (*tclProcDeleteProc) (ClientData clientData); /* 93 */ + void (*tclProcDeleteProc) (void *clientData); /* 93 */ void (*reserved94)(void); void (*reserved95)(void); int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */ @@ -759,10 +689,10 @@ typedef struct TclIntStubs { int (*tclServiceIdle) (void); /* 98 */ void (*reserved99)(void); void (*reserved100)(void); - CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */ + const char * (*tclSetPreInitScript) (const char *string); /* 101 */ void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */ int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */ - TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */ + void (*reserved104)(void); void (*reserved105)(void); void (*reserved106)(void); void (*reserved107)(void); @@ -770,28 +700,28 @@ typedef struct TclIntStubs { int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */ int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */ void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */ - int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */ - Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */ - void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */ - int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */ - Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */ - Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ + void (*reserved112)(void); + void (*reserved113)(void); + void (*reserved114)(void); + void (*reserved115)(void); + void (*reserved116)(void); + void (*reserved117)(void); int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */ int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */ Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */ - int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */ - Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */ - void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */ - Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */ - Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */ + void (*reserved121)(void); + void (*reserved122)(void); + void (*reserved123)(void); + void (*reserved124)(void); + void (*reserved125)(void); void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */ - int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */ + void (*reserved127)(void); void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */ int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */ int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */ void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */ int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */ - TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */ + void (*reserved133)(void); void (*reserved134)(void); void (*reserved135)(void); void (*reserved136)(void); @@ -800,7 +730,7 @@ typedef struct TclIntStubs { void (*reserved139)(void); void (*reserved140)(void); const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ - int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */ + int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 142 */ int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */ @@ -809,39 +739,39 @@ typedef struct TclIntStubs { TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */ void (*tclHandleRelease) (TclHandle handle); /* 149 */ int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */ - void (*tclRegExpRangeUniChar) (Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 151 */ + void (*tclRegExpRangeUniChar) (Tcl_RegExp re, size_t index, int *startPtr, int *endPtr); /* 151 */ void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */ Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */ void (*reserved154)(void); void (*reserved155)(void); void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */ Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */ - TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */ - TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */ + void (*reserved158)(void); + void (*reserved159)(void); void (*reserved160)(void); int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */ - void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */ + void (*tclChannelEventScriptInvoker) (void *clientData, int flags); /* 162 */ const void * (*tclGetInstructionTable) (void); /* 163 */ void (*tclExpandCodeArray) (void *envPtr); /* 164 */ void (*tclpSetInitialEncodings) (void); /* 165 */ int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */ - TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */ - TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */ - int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */ - int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ - int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ + void (*reserved167)(void); + void (*reserved168)(void); + int (*tclpUtfNcmp2) (const char *s1, const char *s2, size_t n); /* 169 */ + int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ + int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ int (*tclInThreadExit) (void); /* 172 */ - int (*tclUniCharMatch) (const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* 173 */ + int (*tclUniCharMatch) (const Tcl_UniChar *string, size_t strLen, const Tcl_UniChar *pattern, size_t ptnLen, int flags); /* 173 */ void (*reserved174)(void); int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */ void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */ void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */ - void (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */ - Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */ + void (*reserved178)(void); + void (*reserved179)(void); void (*reserved180)(void); void (*reserved181)(void); - TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */ - TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */ + void (*reserved182)(void); + void (*reserved183)(void); void (*reserved184)(void); void (*reserved185)(void); void (*reserved186)(void); @@ -873,7 +803,7 @@ typedef struct TclIntStubs { void (*tclpFindExecutable) (const char *argv0); /* 212 */ Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */ void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */ - void * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */ + void * (*tclStackAlloc) (Tcl_Interp *interp, size_t numBytes); /* 215 */ void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */ int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */ void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */ @@ -885,7 +815,7 @@ typedef struct TclIntStubs { TclPlatformType * (*tclGetPlatform) (void); /* 224 */ Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */ int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */ - void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */ + void (*tclSetNsPath) (Namespace *nsPtr, size_t pathLength, Tcl_Namespace *pathAry[]); /* 227 */ void (*reserved228)(void); int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */ Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */ @@ -894,9 +824,9 @@ typedef struct TclIntStubs { void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ - TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */ + void (*reserved236)(void); int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ - int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ + int (*tclNRInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int 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 */ @@ -904,12 +834,12 @@ typedef struct TclIntStubs { void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */ Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */ Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */ - int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */ + int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, size_t numRemoved, size_t numInserted, Tcl_Obj *const *objv); /* 246 */ void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */ int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */ char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */ void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */ - int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */ + int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */ Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ @@ -942,8 +872,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupCommand) /* 6 */ #define TclCopyAndCollapse \ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */ -#define TclCopyChannelOld \ - (tclIntStubsPtr->tclCopyChannelOld) /* 8 */ +/* Slot 8 is reserved */ #define TclCreatePipeline \ (tclIntStubsPtr->tclCreatePipeline) /* 9 */ #define TclCreateProc \ @@ -1050,8 +979,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclpGetClicks) /* 75 */ #define TclpGetSeconds \ (tclIntStubsPtr->tclpGetSeconds) /* 76 */ -#define TclpGetTime \ - (tclIntStubsPtr->tclpGetTime) /* 77 */ +/* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ @@ -1063,8 +991,7 @@ extern const TclIntStubs *tclIntStubsPtr; /* Slot 85 is reserved */ /* Slot 86 is reserved */ /* Slot 87 is reserved */ -#define TclPrecTraceProc \ - (tclIntStubsPtr->tclPrecTraceProc) /* 88 */ +/* Slot 88 is reserved */ #define TclPreventAliasLoop \ (tclIntStubsPtr->tclPreventAliasLoop) /* 89 */ /* Slot 90 is reserved */ @@ -1090,8 +1017,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ -#define TclSockMinimumBuffersOld \ - (tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */ +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ @@ -1103,38 +1029,26 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ #define Tcl_AddInterpResolvers \ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ -#define TclAppendExportList \ - (tclIntStubsPtr->tclAppendExportList) /* 112 */ -#define TclCreateNamespace \ - (tclIntStubsPtr->tclCreateNamespace) /* 113 */ -#define TclDeleteNamespace \ - (tclIntStubsPtr->tclDeleteNamespace) /* 114 */ -#define TclExport \ - (tclIntStubsPtr->tclExport) /* 115 */ -#define TclFindCommand \ - (tclIntStubsPtr->tclFindCommand) /* 116 */ -#define TclFindNamespace \ - (tclIntStubsPtr->tclFindNamespace) /* 117 */ +/* Slot 112 is reserved */ +/* Slot 113 is reserved */ +/* Slot 114 is reserved */ +/* Slot 115 is reserved */ +/* Slot 116 is reserved */ +/* Slot 117 is reserved */ #define Tcl_GetInterpResolvers \ (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */ #define Tcl_GetNamespaceResolvers \ (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */ #define Tcl_FindNamespaceVar \ (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */ -#define TclForgetImport \ - (tclIntStubsPtr->tclForgetImport) /* 121 */ -#define TclGetCommandFromObj \ - (tclIntStubsPtr->tclGetCommandFromObj) /* 122 */ -#define TclGetCommandFullName \ - (tclIntStubsPtr->tclGetCommandFullName) /* 123 */ -#define TclGetCurrentNamespace_ \ - (tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */ -#define TclGetGlobalNamespace_ \ - (tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */ +/* Slot 121 is reserved */ +/* Slot 122 is reserved */ +/* Slot 123 is reserved */ +/* Slot 124 is reserved */ +/* Slot 125 is reserved */ #define Tcl_GetVariableFullName \ (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */ -#define TclImport \ - (tclIntStubsPtr->tclImport) /* 127 */ +/* Slot 127 is reserved */ #define Tcl_PopCallFrame \ (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */ #define Tcl_PushCallFrame \ @@ -1145,8 +1059,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ #define TclpHasSockets \ (tclIntStubsPtr->tclpHasSockets) /* 132 */ -#define TclpGetDate \ - (tclIntStubsPtr->tclpGetDate) /* 133 */ +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -1187,10 +1100,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclRegError) /* 156 */ #define TclVarTraceExists \ (tclIntStubsPtr->tclVarTraceExists) /* 157 */ -#define TclSetStartupScriptFileName \ - (tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */ -#define TclGetStartupScriptFileName \ - (tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */ +/* Slot 158 is reserved */ +/* Slot 159 is reserved */ /* Slot 160 is reserved */ #define TclChannelTransform \ (tclIntStubsPtr->tclChannelTransform) /* 161 */ @@ -1204,10 +1115,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */ #define TclListObjSetElement \ (tclIntStubsPtr->tclListObjSetElement) /* 166 */ -#define TclSetStartupScriptPath \ - (tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */ -#define TclGetStartupScriptPath \ - (tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */ +/* Slot 167 is reserved */ +/* Slot 168 is reserved */ #define TclpUtfNcmp2 \ (tclIntStubsPtr->tclpUtfNcmp2) /* 169 */ #define TclCheckInterpTraces \ @@ -1225,16 +1134,12 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupVar) /* 176 */ #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ -#define TclSetStartupScript \ - (tclIntStubsPtr->tclSetStartupScript) /* 178 */ -#define TclGetStartupScript \ - (tclIntStubsPtr->tclGetStartupScript) /* 179 */ +/* Slot 178 is reserved */ +/* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -#define TclpLocaltime \ - (tclIntStubsPtr->tclpLocaltime) /* 182 */ -#define TclpGmtime \ - (tclIntStubsPtr->tclpGmtime) /* 183 */ +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ @@ -1315,8 +1220,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ -#define TclBackgroundException \ - (tclIntStubsPtr->tclBackgroundException) /* 236 */ +/* Slot 236 is reserved */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ #define TclNRInterpProc \ @@ -1364,33 +1268,13 @@ extern const TclIntStubs *tclIntStubsPtr; /* !END!: Do not edit above this line. */ +#if defined(USE_TCL_STUBS) +#undef Tcl_StaticPackage +#define Tcl_StaticPackage \ + (tclIntStubsPtr->tclStaticPackage) +#endif /* defined(USE_TCL_STUBS) */ + #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#if defined(USE_TCL_STUBS) -# undef TclGetStartupScriptFileName -# undef TclSetStartupScriptFileName -# undef TclGetStartupScriptPath -# undef TclSetStartupScriptPath -# undef TclBackgroundException -# undef TclSetStartupScript -# undef TclGetStartupScript -# undef TclCreateNamespace -# undef TclDeleteNamespace -# undef TclAppendExportList -# undef TclExport -# undef TclImport -# undef TclForgetImport -# undef TclGetCurrentNamespace_ -# undef TclGetGlobalNamespace_ -# undef TclFindNamespace -# undef TclFindCommand -# undef TclGetCommandFromObj -# undef TclGetCommandFullName -# undef TclCopyChannelOld -# undef TclSockMinimumBuffersOld -# undef Tcl_StaticPackage -# define Tcl_StaticPackage (tclIntStubsPtr->tclStaticPackage) -#endif - #endif /* _TCLINTDECLS */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 51d2f65..37a9176 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -66,14 +66,10 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode); EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); -/* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, @@ -102,29 +98,19 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN void TclWinConvertError(DWORD errCode); -/* 1 */ -EXTERN void TclWinConvertWSAError(DWORD errCode); -/* 2 */ -EXTERN struct servent * TclWinGetServByName(const char *nm, - const char *proto); -/* 3 */ -EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname, - char *optval, int *optlen); +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ +/* Slot 3 is reserved */ /* 4 */ EXTERN HINSTANCE TclWinGetTclInstance(void); /* 5 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); -/* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); -/* 7 */ -EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, - const char *optval, int optlen); +/* Slot 6 is reserved */ +/* Slot 7 is reserved */ /* 8 */ -EXTERN int TclpGetPid(Tcl_Pid pid); -/* 9 */ -EXTERN int TclWinGetPlatformId(void); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); +EXTERN size_t TclpGetPid(Tcl_Pid pid); +/* Slot 9 is reserved */ +/* Slot 10 is reserved */ /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); @@ -152,21 +138,18 @@ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 19 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 20 */ -EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id); -/* 21 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +EXTERN void TclWinAddProcess(HANDLE hProcess, size_t id); +/* Slot 21 is reserved */ /* 22 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 23 is reserved */ /* 24 */ EXTERN char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ -/* 26 */ -EXTERN void TclWinSetInterfaces(int wide); +/* Slot 26 is reserved */ /* 27 */ EXTERN void TclWinFlushDirtyChannels(void); -/* 28 */ -EXTERN void TclWinResetInterfaces(void); +/* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(int index, int *regs); /* 30 */ @@ -200,14 +183,10 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode); EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); -/* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, @@ -264,10 +243,10 @@ typedef struct TclIntPlatStubs { TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ - struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ - struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ + void (*reserved10)(void); + void (*reserved11)(void); + void (*reserved12)(void); + void (*reserved13)(void); int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ void (*reserved15)(void); void (*reserved16)(void); @@ -288,16 +267,16 @@ typedef struct TclIntPlatStubs { #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ void (*tclWinConvertError) (DWORD errCode); /* 0 */ - void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */ - struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */ - int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */ + void (*reserved1)(void); + void (*reserved2)(void); + void (*reserved3)(void); HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ - unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ - int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */ - int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ - int (*tclWinGetPlatformId) (void); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ + void (*reserved6)(void); + void (*reserved7)(void); + size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */ + void (*reserved9)(void); + void (*reserved10)(void); void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile) (TclFile file); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */ @@ -307,15 +286,15 @@ typedef struct TclIntPlatStubs { int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */ - void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */ + void (*tclWinAddProcess) (HANDLE hProcess, size_t id); /* 20 */ + void (*reserved21)(void); TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ void (*reserved25)(void); - void (*tclWinSetInterfaces) (int wide); /* 26 */ + void (*reserved26)(void); void (*tclWinFlushDirtyChannels) (void); /* 27 */ - void (*tclWinResetInterfaces) (void); /* 28 */ + void (*reserved28)(void); int (*tclWinCPUID) (int index, int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* WIN */ @@ -330,10 +309,10 @@ typedef struct TclIntPlatStubs { TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ - struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ - struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ + void (*reserved10)(void); + void (*reserved11)(void); + void (*reserved12)(void); + void (*reserved13)(void); int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ @@ -386,14 +365,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ /* Slot 15 is reserved */ @@ -418,26 +393,19 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ -#define TclWinGetServByName \ - (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ -#define TclWinGetSockOpt \ - (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */ +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ +/* Slot 3 is reserved */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ -#define TclWinSetSockOpt \ - (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ +/* Slot 6 is reserved */ +/* Slot 7 is reserved */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ -#define TclWinGetPlatformId \ - (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ +/* Slot 9 is reserved */ +/* Slot 10 is reserved */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ @@ -458,20 +426,17 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */ +/* Slot 21 is reserved */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ /* Slot 23 is reserved */ #define TclWinNoBackslash \ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ /* Slot 25 is reserved */ -#define TclWinSetInterfaces \ - (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ +/* Slot 26 is reserved */ #define TclWinFlushDirtyChannels \ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ -#define TclWinResetInterfaces \ - (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ +/* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ @@ -497,14 +462,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ @@ -538,33 +499,11 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef TclpLocaltime_unix -#undef TclpGmtime_unix -#undef TclWinConvertWSAError #define TclWinConvertWSAError TclWinConvertError -#undef TclpInetNtoa -#define TclpInetNtoa inet_ntoa -#if defined(_WIN32) -# undef TclWinNToHS -# undef TclWinGetServByName -# undef TclWinGetSockOpt -# undef TclWinSetSockOpt -# undef TclWinGetPlatformId -# undef TclWinResetInterfaces -# undef TclWinSetInterfaces -# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# define TclWinNToHS ntohs -# define TclWinGetServByName getservbyname -# define TclWinGetSockOpt getsockopt -# define TclWinSetSockOpt setsockopt -# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */ -# define TclWinResetInterfaces() /* nop */ -# define TclWinSetInterfaces(dummy) /* nop */ -# endif /* TCL_NO_DEPRECATED */ -#else +#if !defined(_WIN32) # undef TclpGetPid -# define TclpGetPid(pid) ((unsigned long) (pid)) +# define TclpGetPid(pid) ((size_t) (pid)) #endif #endif /* _TCLINTPLATDECLS */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 1863ea5..dd9fec8 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -25,14 +25,14 @@ static const char *tclPreInitScript = NULL; struct Target; /* - * struct Alias: + * Alias: * * Stores information about an alias. Is stored in the slave interpreter and * used by the source command to find the target command in the master when * the source command is invoked. */ -typedef struct Alias { +typedef struct { Tcl_Obj *token; /* Token for the alias command in the slave * interp. This used to be the command name in * the slave when the alias was first @@ -66,14 +66,14 @@ typedef struct Alias { /* * - * struct Slave: + * Slave: * * Used by the "interp" command to record and find information about slave * interpreters. Maps from a command name in the master to information about a * slave interpreter, e.g. what aliases are defined in it. */ -typedef struct Slave { +typedef struct { Tcl_Interp *masterInterp; /* Master interpreter for this slave. */ Tcl_HashEntry *slaveEntryPtr; /* Hash entry in masters slave table for this @@ -112,7 +112,7 @@ typedef struct Target { } Target; /* - * struct Master: + * Master: * * This record is used for two purposes: First, slaveTable (a hashtable) maps * from names of commands to slave interpreters. This hashtable is used to @@ -127,7 +127,7 @@ typedef struct Target { * only load safe extensions. */ -typedef struct Master { +typedef struct { Tcl_HashTable slaveTable; /* Hash table for slave interpreters. Maps * from command names to Slave records. */ Target *targetsPtr; /* The head of a doubly-linked list of all the @@ -144,7 +144,7 @@ typedef struct Master { * on a per-interp basis. */ -typedef struct InterpInfo { +typedef struct { Master master; /* Keeps track of all interps for which this * interp is the Master. */ Slave slave; /* Information necessary for this interp to @@ -158,7 +158,7 @@ typedef struct InterpInfo { * likely to work properly on 64-bit architectures. */ -typedef struct ScriptLimitCallback { +typedef struct { Tcl_Interp *interp; /* The interpreter in which to execute the * callback. */ Tcl_Obj *scriptObj; /* The script to execute to perform the @@ -171,7 +171,7 @@ typedef struct ScriptLimitCallback { * table. */ } ScriptLimitCallback; -typedef struct ScriptLimitCallbackKey { +typedef struct { Tcl_Interp *interp; /* The interpreter that the limit callback was * attached to. This is not the interpreter * that the callback runs in! */ @@ -485,7 +485,7 @@ TclInterpInit( Master *masterPtr; Slave *slavePtr; - interpInfoPtr = ckalloc(sizeof(InterpInfo)); + interpInfoPtr = Tcl_Alloc(sizeof(InterpInfo)); ((Interp *) interp)->interpInfo = interpInfoPtr; masterPtr = &interpInfoPtr->master; @@ -582,7 +582,7 @@ InterpInfoDeleteProc( } Tcl_DeleteHashTable(&slavePtr->aliasTable); - ckfree(interpInfoPtr); + Tcl_Free(interpInfoPtr); } /* @@ -1309,7 +1309,7 @@ Tcl_GetAlias( } if (argvPtr != NULL) { *argvPtr = (const char **) - ckalloc(sizeof(const char *) * (objc - 1)); + Tcl_Alloc(sizeof(const char *) * (objc - 1)); for (i = 1; i < objc; i++) { (*argvPtr)[i - 1] = TclGetString(objv[i]); } @@ -1517,7 +1517,7 @@ AliasCreate( Tcl_Obj **prefv; int isNew, i; - aliasPtr = ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *)); + aliasPtr = Tcl_Alloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *)); aliasPtr->token = namePtr; Tcl_IncrRefCount(aliasPtr->token); aliasPtr->targetInterp = masterInterp; @@ -1568,7 +1568,7 @@ AliasCreate( cmdPtr->deleteData = NULL; Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd); - ckfree(aliasPtr); + Tcl_Free(aliasPtr); /* * The result was already set by TclPreventAliasLoop. @@ -1625,7 +1625,7 @@ AliasCreate( * interp alias {} foo {} zop # Now recreate "foo"... */ - targetPtr = ckalloc(sizeof(Target)); + targetPtr = Tcl_Alloc(sizeof(Target)); targetPtr->slaveCmd = aliasPtr->slaveCmd; targetPtr->slaveInterp = slaveInterp; @@ -2059,8 +2059,8 @@ AliasObjCmdDeleteProc( targetPtr->nextPtr->prevPtr = targetPtr->prevPtr; } - ckfree(targetPtr); - ckfree(aliasPtr); + Tcl_Free(targetPtr); + Tcl_Free(aliasPtr); } /* @@ -3560,7 +3560,7 @@ RunLimitHandlers( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } } } @@ -3597,14 +3597,14 @@ Tcl_LimitAddHandler( */ if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) { - deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free; + deleteProc = (Tcl_LimitHandlerDeleteProc *) TclpFree; } /* * Allocate a handler record. */ - handlerPtr = ckalloc(sizeof(LimitHandler)); + handlerPtr = Tcl_Alloc(sizeof(LimitHandler)); handlerPtr->flags = 0; handlerPtr->handlerProc = handlerProc; handlerPtr->clientData = clientData; @@ -3723,7 +3723,7 @@ Tcl_LimitRemoveHandler( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } return; } @@ -3783,7 +3783,7 @@ TclLimitRemoveAllHandlers( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } } @@ -3816,7 +3816,7 @@ TclLimitRemoveAllHandlers( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } } @@ -4211,7 +4211,7 @@ DeleteScriptLimitCallback( if (limitCBPtr->entryPtr != NULL) { Tcl_DeleteHashEntry(limitCBPtr->entryPtr); } - ckfree(limitCBPtr); + Tcl_Free(limitCBPtr); } /* @@ -4311,7 +4311,7 @@ SetScriptLimitCallback( limitCBPtr); } - limitCBPtr = ckalloc(sizeof(ScriptLimitCallback)); + limitCBPtr = Tcl_Alloc(sizeof(ScriptLimitCallback)); limitCBPtr->interp = interp; limitCBPtr->scriptObj = scriptObj; limitCBPtr->entryPtr = hashPtr; @@ -4564,7 +4564,8 @@ SlaveCommandLimitCmd( Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { - int i, scriptLen = 0, limitLen = 0; + int i; + size_t scriptLen = 0, limitLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL; int gran = 0, limit = 0; @@ -4769,7 +4770,8 @@ SlaveTimeLimitCmd( Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { - int i, scriptLen = 0, milliLen = 0, secLen = 0; + int i; + size_t scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; diff --git a/generic/tclLink.c b/generic/tclLink.c index eb4155a..1ae8501 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -21,7 +21,7 @@ * variable. */ -typedef struct Link { +typedef struct { Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ Tcl_Obj *varName; /* Name of variable (must be global). This is * needed during trace callbacks, since the @@ -125,7 +125,7 @@ Tcl_LinkVar( return TCL_ERROR; } - linkPtr = ckalloc(sizeof(Link)); + linkPtr = Tcl_Alloc(sizeof(Link)); linkPtr->interp = interp; linkPtr->varName = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(linkPtr->varName); @@ -148,7 +148,7 @@ Tcl_LinkVar( if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount(linkPtr->varName); - ckfree(linkPtr); + Tcl_Free(linkPtr); return TCL_ERROR; } code = Tcl_TraceVar2(interp, varName, NULL, @@ -156,7 +156,7 @@ Tcl_LinkVar( LinkTraceProc, linkPtr); if (code != TCL_OK) { Tcl_DecrRefCount(linkPtr->varName); - ckfree(linkPtr); + Tcl_Free(linkPtr); } return code; } @@ -194,7 +194,7 @@ Tcl_UnlinkVar( TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr); Tcl_DecrRefCount(linkPtr->varName); - ckfree(linkPtr); + Tcl_Free(linkPtr); } /* @@ -289,7 +289,7 @@ LinkTraceProc( if (flags & TCL_TRACE_UNSETS) { if (Tcl_InterpDeleted(interp)) { Tcl_DecrRefCount(linkPtr->varName); - ckfree(linkPtr); + Tcl_Free(linkPtr); } else if (flags & TCL_TRACE_DESTROYED) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); @@ -549,7 +549,7 @@ LinkTraceProc( valueLength = valueObj->length + 1; pp = (char **) linkPtr->addr; - *pp = ckrealloc(*pp, valueLength); + *pp = Tcl_Realloc(*pp, valueLength); memcpy(*pp, value, valueLength); break; diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 7a90950..504af4b 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -77,20 +77,22 @@ const Tcl_ObjType tclListType = { * * NewListIntRep -- * - * Creates a list internal rep with space for objc elements. objc - * must be > 0. If objv!=NULL, initializes with the first objc values - * in that array. If objv==NULL, initalize list internal rep to have - * 0 elements, with space to add objc more. Flag value "p" indicates + * Creates a 'List' structure with space for 'objc' elements. 'objc' must + * be > 0. If 'objv' is not NULL, The list is initialized with first + * 'objc' values in that array. Otherwise the list is initialized to have + * 0 elements, with space to add 'objc' more. Flag value 'p' indicates * how to behave on failure. * - * Results: - * A new List struct with refCount 0 is returned. If some failure - * prevents this then if p=0, NULL is returned and otherwise the - * routine panics. + * Value * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * A new 'List' structure with refCount 0. If some failure + * prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic' + * is called if it is not. + * + * Effect + * + * The refCount of each value in 'objv' is incremented as it is added + * to the list. * *---------------------------------------------------------------------- */ @@ -122,10 +124,10 @@ NewListIntRep( return NULL; } - listRepPtr = attemptckalloc(LIST_SIZE(objc)); + listRepPtr = Tcl_AttemptAlloc(LIST_SIZE(objc)); if (listRepPtr == NULL) { if (p) { - Tcl_Panic("list creation failed: unable to alloc %u bytes", + Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", LIST_SIZE(objc)); } return NULL; @@ -154,21 +156,9 @@ NewListIntRep( /* *---------------------------------------------------------------------- * - * AttemptNewList -- + * AttemptNewList -- * - * Creates a list internal rep with space for objc elements. objc - * must be > 0. If objv!=NULL, initializes with the first objc values - * in that array. If objv==NULL, initalize list internal rep to have - * 0 elements, with space to add objc more. - * - * Results: - * A new List struct with refCount 0 is returned. If some failure - * prevents this then NULL is returned, and an error message is left - * in the interp result, unless interp is NULL. - * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * Like NewListIntRep, but additionally sets an error message on failure. * *---------------------------------------------------------------------- */ @@ -188,7 +178,7 @@ AttemptNewList( LIST_MAX)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "list creation failed: unable to alloc %u bytes", + "list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", LIST_SIZE(objc))); } Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); @@ -201,23 +191,20 @@ AttemptNewList( * * Tcl_NewListObj -- * - * This function is normally called when not debugging: i.e., when - * TCL_MEM_DEBUG is not defined. It creates a new list object from an - * (objc,objv) array: that is, each of the objc elements of the array - * referenced by objv is inserted as an element into a new Tcl object. + * Creates a new list object and adds values to it. When TCL_MEM_DEBUG is + * defined, 'Tcl_DbNewListObj' is called instead. * - * When TCL_MEM_DEBUG is defined, this function just returns the result - * of calling the debugging version Tcl_DbNewListObj. + * Value * - * Results: - * A new list object is returned that is initialized from the object - * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation is left - * NULL. The resulting new list object has ref count 0. + * A new list 'Tcl_Obj' to which is appended values from 'objv', or if + * 'objc' is less than or equal to zero, a list 'Tcl_Obj' having no + * elements. The string representation of the new 'Tcl_Obj' is set to + * NULL. The refCount of the list is 0. * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * Effect + * + * The refCount of each elements in 'objv' is incremented as it is added + * to the list. * *---------------------------------------------------------------------- */ @@ -268,28 +255,14 @@ Tcl_NewListObj( /* *---------------------------------------------------------------------- * - * Tcl_DbNewListObj -- - * - * This function is normally called when debugging: i.e., when - * TCL_MEM_DEBUG is defined. It creates new list objects. It is the same - * as the Tcl_NewListObj function above except that it calls - * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the [memory active] - * command will report the correct file name and line number when - * reporting objects that haven't been freed. + * Tcl_DbNewListObj -- * - * When TCL_MEM_DEBUG is not defined, this function just returns the - * result of calling Tcl_NewListObj. + * Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the + * file name and line number from its caller. This simplifies debugging + * since the [memory active] command will report the correct file + * name and line number when reporting objects that haven't been freed. * - * Results: - * A new list object is returned that is initialized from the object - * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation is left - * NULL. The new list object has ref count 0. - * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead. * *---------------------------------------------------------------------- */ @@ -350,19 +323,8 @@ Tcl_DbNewListObj( * * Tcl_SetListObj -- * - * Modify an object to be a list containing each of the objc elements of - * the object array referenced by objv. - * - * Results: - * None. - * - * Side effects: - * The object is made a list object and is initialized from the object - * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation is left - * NULL. The ref counts of the elements in objv are incremented since the - * list now refers to them. The object's old string and internal - * representations are freed and its type is set NULL. + * Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of + * creating a new one. * *---------------------------------------------------------------------- */ @@ -405,18 +367,20 @@ Tcl_SetListObj( * * TclListObjCopy -- * - * Makes a "pure list" copy of a list value. This provides for the C - * level a counterpart of the [lrange $list 0 end] command, while using - * internals details to be as efficient as possible. + * Creates a new 'Tcl_Obj' which is a pure copy of a list value. This + * provides for the C level a counterpart of the [lrange $list 0 end] + * command, while using internals details to be as efficient as possible. * - * Results: - * Normally returns a pointer to a new Tcl_Obj, that contains the same - * list value as *listPtr does. The returned Tcl_Obj has a refCount of - * zero. If *listPtr does not hold a list, NULL is returned, and if - * interp is non-NULL, an error message is recorded there. + * Value * - * Side effects: - * None. + * The address of the new 'Tcl_Obj' which shares its internal + * representation with 'listPtr', and whose refCount is 0. If 'listPtr' + * is not actually a list, the value is NULL, and an error message is left + * in 'interp' if it is not NULL. + * + * Effect + * + * 'listPtr' is converted to a list if it isn't one already. * *---------------------------------------------------------------------- */ @@ -529,27 +493,30 @@ TclListObjRange( * * Tcl_ListObjGetElements -- * - * This function returns an (objc,objv) array of the elements in a list - * object. + * Retreive the elements in a list 'Tcl_Obj'. * - * Results: - * The return value is normally TCL_OK; in this case *objcPtr is set to - * the count of list elements and *objvPtr is set to a pointer to an - * array of (*objcPtr) pointers to each list element. If listPtr does not - * refer to a list object and the object can not be converted to one, - * TCL_ERROR is returned and an error message will be left in the - * interpreter's result if interp is not NULL. - * - * The objects referenced by the returned array should be treated as - * readonly and their ref counts are _not_ incremented; the caller must - * do that if it holds on to a reference. Furthermore, the pointer and - * length returned by this function may change as soon as any function is - * called on the list object; be careful about retaining the pointer in a - * local data structure. + * Value * - * Side effects: - * The possible conversion of the object referenced by listPtr - * to a list object. + * TCL_OK + * + * A count of list elements is stored, 'objcPtr', And a pointer to the + * array of elements in the list is stored in 'objvPtr'. + * + * The elements accessible via 'objvPtr' should be treated as readonly + * and the refCount for each object is _not_ incremented; the caller + * must do that if it holds on to a reference. Furthermore, the + * pointer and length returned by this function may change as soon as + * any function is called on the list object. Be careful about + * retaining the pointer in a local data structure. + * + * TCL_ERROR + * + * 'listPtr' is not a valid list. An error message is left in the + * interpreter's result if 'interp' is not NULL. + * + * Effect + * + * 'listPtr' is converted to a list object if it isn't one already. * *---------------------------------------------------------------------- */ @@ -593,20 +560,27 @@ Tcl_ListObjGetElements( * * Tcl_ListObjAppendList -- * - * This function appends the elements in the list value referenced by - * elemListPtr to the list value referenced by listPtr. + * Appends the elements of elemListPtr to those of listPtr. * - * Results: - * The return value is normally TCL_OK. If listPtr or elemListPtr do not - * refer to list values, TCL_ERROR is returned and an error message is - * left in the interpreter's result if interp is not NULL. + * Value * - * Side effects: - * The reference counts of the elements in elemListPtr are incremented - * since the list now refers to them. listPtr and elemListPtr are - * converted, if necessary, to list objects. Also, appending the new - * elements may cause listObj's array of element pointers to grow. - * listPtr's old string representation, if any, is invalidated. + * TCL_OK + * + * Success. + * + * TCL_ERROR + * + * 'listPtr' or 'elemListPtr' are not valid lists. An error + * message is left in the interpreter's result if 'interp' is not NULL. + * + * Effect + * + * The reference count of each element of 'elemListPtr' as it is added to + * 'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType' + * if they are not already. Appending the new elements may cause the + * array of element pointers in 'listObj' to grow. If any objects are + * appended to 'listPtr'. Any preexisting string representation of + * 'listPtr' is invalidated. * *---------------------------------------------------------------------- */ @@ -645,24 +619,27 @@ Tcl_ListObjAppendList( * * Tcl_ListObjAppendElement -- * - * This function is a special purpose version of Tcl_ListObjAppendList: - * it appends a single object referenced by objPtr to the list object - * referenced by listPtr. If listPtr is not already a list object, an - * attempt will be made to convert it to one. + * Like 'Tcl_ListObjAppendList', but Appends a single value to a list. * - * Results: - * The return value is normally TCL_OK; in this case objPtr is added to - * the end of listPtr's list. If listPtr does not refer to a list object - * and the object can not be converted to one, TCL_ERROR is returned and - * an error message will be left in the interpreter's result if interp is - * not NULL. + * Value * - * Side effects: - * The ref count of objPtr is incremented since the list now refers to - * it. listPtr will be converted, if necessary, to a list object. Also, - * appending the new element may cause listObj's array of element - * pointers to grow. listPtr's old string representation, if any, is - * invalidated. + * TCL_OK + * + * 'objPtr' is appended to the elements of 'listPtr'. + * + * TCL_ERROR + * + * listPtr does not refer to a list object and the object can not be + * converted to one. An error message will be left in the + * interpreter's result if interp is not NULL. + * + * Effect + * + * If 'listPtr' is not already of type 'tclListType', it is converted. + * The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'. + * Appending the new element may cause the the array of element pointers + * in 'listObj' to grow. Any preexisting string representation of + * 'listPtr' is invalidated. * *---------------------------------------------------------------------- */ @@ -718,18 +695,18 @@ Tcl_ListObjAppendElement( attempt = 2 * numRequired; if (attempt <= LIST_MAX) { - newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH; if (attempt > LIST_MAX) { attempt = LIST_MAX; } - newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired; - newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr) { listRepPtr = newPtr; @@ -787,7 +764,7 @@ Tcl_ListObjAppendElement( */ memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *)); - ckfree(listRepPtr); + Tcl_Free(listRepPtr); } listRepPtr = newPtr; } @@ -820,23 +797,27 @@ Tcl_ListObjAppendElement( * * Tcl_ListObjIndex -- * - * This function returns a pointer to the index'th object from the list - * referenced by listPtr. The first element has index 0. If index is - * negative or greater than or equal to the number of elements in the - * list, a NULL is returned. If listPtr is not a list object, an attempt - * will be made to convert it to a list. + * Retrieve a pointer to the element of 'listPtr' at 'index'. The index + * of the first element is 0. * - * Results: - * The return value is normally TCL_OK; in this case objPtrPtr is set to - * the Tcl_Obj pointer for the index'th list element or NULL if index is - * out of range. This object should be treated as readonly and its ref - * count is _not_ incremented; the caller must do that if it holds on to - * the reference. If listPtr does not refer to a list and can't be - * converted to one, TCL_ERROR is returned and an error message is left - * in the interpreter's result if interp is not NULL. + * Value * - * Side effects: - * listPtr will be converted, if necessary, to a list object. + * TCL_OK + * + * A pointer to the element at 'index' is stored in 'objPtrPtr'. If + * 'index' is out of range, NULL is stored in 'objPtrPtr'. This + * object should be treated as readonly and its 'refCount' is _not_ + * incremented. The caller must do that if it holds on to the + * reference. + * + * TCL_ERROR + * + * 'listPtr' is not a valid list. An an error message is left in the + * interpreter's result if 'interp' is not NULL. + * + * Effect + * + * If 'listPtr' is not already of type 'tclListType', it is converted. * *---------------------------------------------------------------------- */ @@ -880,19 +861,20 @@ Tcl_ListObjIndex( * * Tcl_ListObjLength -- * - * This function returns the number of elements in a list object. If the - * object is not already a list object, an attempt will be made to - * convert it to one. + * Retrieve the number of elements in a list. * - * Results: - * The return value is normally TCL_OK; in this case *intPtr will be set - * to the integer count of list elements. If listPtr does not refer to a - * list object and the object can not be converted to one, TCL_ERROR is - * returned and an error message will be left in the interpreter's result - * if interp is not NULL. + * Value * - * Side effects: - * The possible conversion of the argument object to a list object. + * TCL_OK + * + * A count of list elements is stored at the address provided by + * 'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is + * converted. + * + * TCL_ERROR + * + * 'listPtr' is not a valid list. An error message will be left in + * the interpreter's result if 'interp' is not NULL. * *---------------------------------------------------------------------- */ @@ -930,35 +912,36 @@ Tcl_ListObjLength( * * Tcl_ListObjReplace -- * - * This function replaces zero or more elements of the list referenced by - * listPtr with the objects from an (objc,objv) array. The objc elements - * of the array referenced by objv replace the count elements in listPtr - * starting at first. + * Replace values in a list. * - * If the argument first is zero or negative, it refers to the first - * element. If first is greater than or equal to the number of elements - * in the list, then no elements are deleted; the new elements are - * appended to the list. Count gives the number of elements to replace. - * If count is zero or negative then no elements are deleted; the new - * elements are simply inserted before first. + * If 'first' is zero or negative, it refers to the first element. If + * 'first' outside the range of elements in the list, no elements are + * deleted. * - * The argument objv refers to an array of objc pointers to the new - * elements to be added to listPtr in place of those that were deleted. - * If objv is NULL, no new elements are added. If listPtr is not a list - * object, an attempt will be made to convert it to one. + * If 'count' is zero or negative no elements are deleted, and any new + * elements are inserted at the beginning of the list. * - * Results: - * The return value is normally TCL_OK. If listPtr does not refer to a - * list object and can not be converted to one, TCL_ERROR is returned and - * an error message will be left in the interpreter's result if interp is - * not NULL. + * Value * - * Side effects: - * The ref counts of the objc elements in objv are incremented since the - * resulting list now refers to them. Similarly, the ref counts for - * replaced objects are decremented. listPtr is converted, if necessary, - * to a list object. listPtr's old string representation, if any, is - * freed. + * TCL_OK + * + * The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr' + * starting at 'first'. If 'objc' 0, no new elements are added. + * + * TCL_ERROR + * + * 'listPtr' is not a valid list. An error message is left in the + * interpreter's result if 'interp' is not NULL. + * + * Effect + * + * If 'listPtr' is not of type 'tclListType', it is converted if possible. + * + * The 'refCount' of each element appended to the list is incremented. + * Similarly, the 'refCount' for each replaced element is decremented. + * + * If 'listPtr' is modified, any previous string representation is + * invalidated. * *---------------------------------------------------------------------- */ @@ -983,9 +966,9 @@ Tcl_ListObjReplace( ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int length; + size_t length; - (void) Tcl_GetStringFromObj(listPtr, &length); + (void) TclGetStringFromObj(listPtr, &length); if (length == 0) { if (objc == 0) { return TCL_OK; @@ -1047,18 +1030,18 @@ Tcl_ListObjReplace( List *newPtr = NULL; int attempt = 2 * numRequired; if (attempt <= LIST_MAX) { - newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH; if (attempt > LIST_MAX) { attempt = LIST_MAX; } - newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired; - newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr) { listRepPtr = newPtr; @@ -1124,11 +1107,7 @@ Tcl_ListObjReplace( if (listRepPtr == NULL) { for (i = 0; i < objc; i++) { /* See bug 3598580 */ -#if TCL_MAJOR_VERSION > 8 Tcl_DecrRefCount(objv[i]); -#else - objv[i]->refCount--; -#endif } return TCL_ERROR; } @@ -1189,7 +1168,7 @@ Tcl_ListObjReplace( (size_t) numAfterLast * sizeof(Tcl_Obj *)); } - ckfree(oldListRepPtr); + Tcl_Free(oldListRepPtr); } } @@ -1226,22 +1205,19 @@ Tcl_ListObjReplace( * * TclLindexList -- * - * This procedure handles the 'lindex' command when objc==3. + * Implements the 'lindex' command when objc==3. * - * Results: - * Returns a pointer to the object extracted, or NULL if an error - * occurred. The returned object already includes one reference count for - * the pointer returned. + * Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures + * the argument format into required form while taking care to manage + * shimmering so as to tend to keep the most useful intreps + * and/or avoid the most expensive conversions. * - * Side effects: - * None. + * Value + * + * A pointer to the specified element, with its 'refCount' incremented, or + * NULL if an error occurred. * - * Notes: - * This procedure is implemented entirely as a wrapper around - * TclLindexFlat. All it does is reconfigure the argument format into the - * form required by TclLindexFlat, while taking care to manage shimmering - * in such a way that we tend to keep the most useful intreps and/or - * avoid the most expensive conversions. + * Notes * *---------------------------------------------------------------------- */ @@ -1265,7 +1241,7 @@ TclLindexList( ListGetIntRep(argPtr, listRepPtr); if ((listRepPtr == NULL) - && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) { + && TclGetIntForIndexM(NULL , argPtr, TCL_INDEX_START, &index) == TCL_OK) { /* * argPtr designates a single index. */ @@ -1308,25 +1284,20 @@ TclLindexList( /* *---------------------------------------------------------------------- * - * TclLindexFlat -- + * TclLindexFlat -- * - * This procedure is the core of the 'lindex' command, with all index - * arguments presented as a flat list. + * The core of the 'lindex' command, with all index + * arguments presented as a flat list. * - * Results: - * Returns a pointer to the object extracted, or NULL if an error - * occurred. The returned object already includes one reference count for - * the pointer returned. + * Value * - * Side effects: - * None. + * A pointer to the object extracted, with its 'refCount' incremented, or + * NULL if an error occurred. Thus, the calling code will usually do + * something like: + * + * Tcl_SetObjResult(interp, result); + * Tcl_DecrRefCount(result); * - * Notes: - * The reference count of the returned object includes one reference - * corresponding to the pointer returned. Thus, the calling code will - * usually do something like: - * Tcl_SetObjResult(interp, result); - * Tcl_DecrRefCount(result); * *---------------------------------------------------------------------- */ @@ -1375,7 +1346,7 @@ TclLindexFlat( */ while (++i < indexCount) { - if (TclGetIntForIndexM(interp, indexArray[i], -1, &index) + if (TclGetIntForIndexM(interp, indexArray[i], TCL_INDEX_NONE, &index) != TCL_OK) { Tcl_DecrRefCount(sublistCopy); return NULL; @@ -1402,24 +1373,17 @@ TclLindexFlat( * * TclLsetList -- * - * Core of the 'lset' command when objc == 4. Objv[2] may be either a + * The core of [lset] when objc == 4. Objv[2] may be either a * scalar index or a list of indices. * It also handles 'lpop' when given a NULL value. * - * Results: - * Returns the new value of the list variable, or NULL if there was an - * error. The returned object includes one reference count for the - * pointer returned. + * Implemented entirely as a wrapper around 'TclLindexFlat', as described + * for 'TclLindexList'. * - * Side effects: - * None. + * Value * - * Notes: - * This procedure is implemented entirely as a wrapper around - * TclLsetFlat. All it does is reconfigure the argument format into the - * form required by TclLsetFlat, while taking care to manage shimmering - * in such a way that we tend to keep the most useful intreps and/or - * avoid the most expensive conversions. + * The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if + * there was an error. * *---------------------------------------------------------------------- */ @@ -1446,7 +1410,7 @@ TclLsetList( ListGetIntRep(indexArgPtr, listRepPtr); if (listRepPtr == NULL - && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) { + && TclGetIntForIndexM(NULL, indexArgPtr, TCL_INDEX_START, &index) == TCL_OK) { /* * indexArgPtr designates a single index. */ @@ -1484,36 +1448,39 @@ TclLsetList( * Core engine of the 'lset' command. * It also handles 'lpop' when given a NULL value. * - * Results: - * Returns the new value of the list variable, or NULL if an error - * occurred. The returned object includes one reference count for the - * pointer returned. + * Value * - * Side effects: - * On entry, the reference count of the variable value does not reflect - * any references held on the stack. The first action of this function is - * to determine whether the object is shared, and to duplicate it if it - * is. The reference count of the duplicate is incremented. At this - * point, the reference count will be 1 for either case, so that the - * object will appear to be unshared. - * - * If an error occurs, and the object has been duplicated, the reference - * count on the duplicate is decremented so that it is now 0: this - * dismisses any memory that was allocated by this function. - * - * If no error occurs, the reference count of the original object is - * incremented if the object has not been duplicated, and nothing is done - * to a reference count of the duplicate. Now the reference count of an - * unduplicated object is 2 (the returned pointer, plus the one stored in - * the variable). The reference count of a duplicate object is 1, - * reflecting that the returned pointer is the only active reference. The - * caller is expected to store the returned value back in the variable - * and decrement its reference count. (INST_STORE_* does exactly this.) - * - * Surgery is performed on the unshared list value to produce the result. - * TclLsetFlat maintains a linked list of Tcl_Obj's whose string + * The resulting list + * + * The 'refCount' of 'valuePtr' is incremented. If 'listPtr' was not + * duplicated, its 'refCount' is incremented. The reference count of + * an unduplicated object is therefore 2 (one for the returned pointer + * and one for the variable that holds it). The reference count of a + * duplicate object is 1, reflecting that result is the only active + * reference. The caller is expected to store the result in the + * variable and decrement its reference count. (INST_STORE_* does + * exactly this.) + * + * NULL + * + * An error occurred. If 'listPtr' was duplicated, the reference + * count on the duplicate is decremented so that it is 0, causing any + * memory allocated by this function to be freed. + * + * + * Effect + * + * On entry, the reference count of 'listPtr' does not reflect any + * references held on the stack. The first action of this function is to + * determine whether 'listPtr' is shared and to create a duplicate + * unshared copy if it is. The reference count of the duplicate is + * incremented. At this point, the reference count is 1 in either case so + * that the object is considered unshared. + * + * The unshared list is altered directly to produce the result. + * 'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string * representations must be spoilt by threading via 'ptr2' of the - * two-pointer internal representation. On entry to TclLsetFlat, the + * two-pointer internal representation. On entry to 'TclLsetFlat', the * values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any * Tcl_Obj that has been modified is set to NULL. * @@ -1747,26 +1714,38 @@ TclLsetFlat( * * TclListObjSetElement -- * - * Set a single element of a list to a specified value + * Set a single element of a list to a specified value. * - * Results: - * The return value is normally TCL_OK. If listPtr does not refer to a - * list object and cannot be converted to one, TCL_ERROR is returned and - * an error message will be left in the interpreter result if interp is - * not NULL. Similarly, if index designates an element outside the range - * [0..listLength-1], where listLength is the count of elements in the - * list object designated by listPtr, TCL_ERROR is returned and an error - * message is left in the interpreter result. + * It is the caller's responsibility to invalidate the string + * representation of the 'listPtr'. * - * Side effects: - * Tcl_Panic if listPtr designates a shared object. Otherwise, attempts - * to convert it to a list with a non-shared internal rep. Decrements the - * ref count of the object at the specified index within the list, - * replaces with the object designated by valuePtr, and increments the - * ref count of the replacement object. + * Value + * + * TCL_OK + * + * Success. + * + * TCL_ERROR + * + * 'listPtr' does not refer to a list object and cannot be converted + * to one. An error message will be left in the interpreter result if + * interp is not NULL. + * + * TCL_ERROR + * + * An index designates an element outside the range [0..listLength-1], + * where 'listLength' is the count of elements in the list object + * designated by 'listPtr'. An error message is left in the + * interpreter result. + * + * Effect + * + * If 'listPtr' designates a shared object, 'Tcl_Panic' is called. If + * 'listPtr' is not already of type 'tclListType', it is converted and the + * internal representation is unshared. The 'refCount' of the element at + * 'index' is decremented and replaced in the list with the 'valuePtr', + * whose 'refCount' in turn is incremented. * - * It is the caller's responsibility to invalidate the string - * representation of the object. * *---------------------------------------------------------------------- */ @@ -1900,13 +1879,11 @@ TclListObjSetElement( * * FreeListInternalRep -- * - * Deallocate the storage associated with a list object's internal - * representation. + * Deallocate the storage associated with the internal representation of a + * a list object. * - * Results: - * None. + * Effect * - * Side effects: * Frees listPtr's List* internal representation, if no longer shared. * May decrement the ref counts of element objects, which may free them. * @@ -1929,7 +1906,7 @@ FreeListInternalRep( for (i = 0; i < numElems; i++) { Tcl_DecrRefCount(elemPtrs[i]); } - ckfree(listRepPtr); + Tcl_Free(listRepPtr); } } @@ -1938,14 +1915,12 @@ FreeListInternalRep( * * DupListInternalRep -- * - * Initialize the internal representation of a list Tcl_Obj to share the + * Initialize the internal representation of a list 'Tcl_Obj' to share the * internal representation of an existing list object. * - * Results: - * None. + * Effect * - * Side effects: - * The reference count of the List internal rep is incremented. + * The 'refCount' of the List internal rep is incremented. * *---------------------------------------------------------------------- */ @@ -1967,16 +1942,20 @@ DupListInternalRep( * * SetListFromAny -- * - * Attempt to generate a list internal form for the Tcl object "objPtr". + * Convert any object to a list. * - * Results: - * The return value is TCL_OK or TCL_ERROR. If an error occurs during - * conversion, an error message is left in the interpreter's result - * unless "interp" is NULL. + * Value + * + * TCL_OK + * + * Success. The internal representation of 'objPtr' is set, and the type + * of 'objPtr' is 'tclListType'. + * + * TCL_ERROR + * + * An error occured during conversion. An error message is left in the + * interpreter's result if 'interp' is not NULL. * - * Side effects: - * If no error occurs, a list is stored as "objPtr"s internal - * representation. * *---------------------------------------------------------------------- */ @@ -2056,7 +2035,8 @@ SetListFromAny( while (nextElem < limit) { const char *elemStart; char *check; - int elemSize, literal; + size_t elemSize; + int literal; if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem, &elemStart, &nextElem, &elemSize, &literal)) { @@ -2064,7 +2044,7 @@ SetListFromAny( while (--elemPtrs >= &listRepPtr->elements) { Tcl_DecrRefCount(*elemPtrs); } - ckfree(listRepPtr); + Tcl_Free(listRepPtr); return TCL_ERROR; } if (elemStart == limit) { @@ -2109,18 +2089,16 @@ SetListFromAny( * * UpdateStringOfList -- * - * Update the string representation for a list object. Note: This - * function does not invalidate an existing old string rep so storage - * will be lost if this has not already been done. + * Update the string representation for a list object. * - * Results: - * None. + * Any previously-exising string representation is not invalidated, so + * storage is lost if this has not been taken care of. * - * Side effects: - * The object's string is set to a valid string that results from the - * list-to-string conversion. This string will be empty if the list has - * no elements. The list internal representation should not be NULL and - * we assume it is not NULL. + * Effect + * + * The string representation of 'listPtr' is set to the resulting string. + * This string will be empty if the list has no elements. It is assumed + * that the list internal representation is not NULL. * *---------------------------------------------------------------------- */ @@ -2131,7 +2109,8 @@ UpdateStringOfList( { # define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; - int numElems, i, length, bytesNeeded = 0; + int numElems, i; + size_t length, bytesNeeded = 0; const char *elem, *start; char *dst; Tcl_Obj **elemPtrs; @@ -2171,19 +2150,13 @@ UpdateStringOfList( * We know numElems <= LIST_MAX, so this is safe. */ - flagPtr = ckalloc(numElems); + flagPtr = Tcl_Alloc(numElems); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); - if (bytesNeeded < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - } - if (bytesNeeded > INT_MAX - numElems + 1) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems - 1; @@ -2204,7 +2177,7 @@ UpdateStringOfList( (void) Tcl_InitStringRep(listPtr, NULL, dst - 1 - start); if (flagPtr != localFlags) { - ckfree(flagPtr); + Tcl_Free(flagPtr); } } diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 577c9e5..3ece98b 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -31,7 +31,7 @@ static int AddLocalLiteralEntry(CompileEnv *envPtr, Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); -static unsigned HashString(const char *string, int length); +static size_t HashString(const char *string, size_t length); #ifdef TCL_COMPILE_DEBUG static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -104,7 +104,7 @@ TclDeleteLiteralTable( { LiteralEntry *entryPtr, *nextPtr; Tcl_Obj *objPtr; - int i; + size_t i; /* * Release remaining literals in the table. Note that releasing a literal @@ -131,7 +131,7 @@ TclDeleteLiteralTable( objPtr = entryPtr->objPtr; TclDecrRefCount(objPtr); nextPtr = entryPtr->nextPtr; - ckfree(entryPtr); + Tcl_Free(entryPtr); entryPtr = nextPtr; } } @@ -141,7 +141,7 @@ TclDeleteLiteralTable( */ if (tablePtr->buckets != tablePtr->staticBuckets) { - ckfree(tablePtr->buckets); + Tcl_Free(tablePtr->buckets); } } @@ -176,8 +176,8 @@ TclCreateLiteral( Interp *iPtr, const char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ - int length, /* Number of bytes in the string. */ - unsigned hash, /* The string's hash. If -1, it will be + size_t length, /* Number of bytes in the string. */ + size_t hash, /* The string's hash. If -1, it will be * computed here. */ int *newPtr, Namespace *nsPtr, @@ -186,14 +186,14 @@ TclCreateLiteral( { LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; - unsigned int globalHash; + size_t globalHash; Tcl_Obj *objPtr; /* * Is it in the interpreter's global literal table? */ - if (hash == (unsigned) -1) { + if (hash == TCL_AUTO_LENGTH) { hash = HashString(bytes, length); } globalHash = (hash & globalTablePtr->mask); @@ -208,7 +208,7 @@ TclCreateLiteral( * https://stackoverflow.com/q/54337750/301832 */ - int objLength; + size_t objLength; char *objBytes = TclGetStringFromObj(objPtr, &objLength); if ((objLength == length) && ((length == 0) @@ -225,7 +225,7 @@ TclCreateLiteral( *globalPtrPtr = globalPtr; } if (flags & LITERAL_ON_HEAP) { - ckfree(bytes); + Tcl_Free((void *)bytes); } globalPtr->refCount++; return objPtr; @@ -234,7 +234,7 @@ TclCreateLiteral( } if (!newPtr) { if ((flags & LITERAL_ON_HEAP)) { - ckfree(bytes); + Tcl_Free((void *)bytes); } return NULL; } @@ -270,11 +270,11 @@ TclCreateLiteral( #ifdef TCL_COMPILE_DEBUG if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be", - "TclRegisterLiteral", (length>60? 60 : length), bytes); + "TclRegisterLiteral", (length>60? 60 : (int)length), bytes); } #endif - globalPtr = ckalloc(sizeof(LiteralEntry)); + globalPtr = Tcl_Alloc(sizeof(LiteralEntry)); globalPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); globalPtr->refCount = 1; @@ -296,7 +296,8 @@ TclCreateLiteral( TclVerifyGlobalLiteralTable(iPtr); { LiteralEntry *entryPtr; - int found, i; + int found; + size_t i; found = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { @@ -309,7 +310,7 @@ TclCreateLiteral( } if (!found) { Tcl_Panic("%s: literal \"%.*s\" wasn't global", - "TclRegisterLiteral", (length>60? 60 : length), bytes); + "TclRegisterLiteral", (length>60? 60 : (int)length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ @@ -346,10 +347,10 @@ Tcl_Obj * TclFetchLiteral( CompileEnv *envPtr, /* Points to the CompileEnv from which to * fetch the registered literal value. */ - unsigned int index) /* Index of the desired literal, as returned + size_t index) /* Index of the desired literal, as returned * by prior call to TclRegisterLiteral() */ { - if (index >= (unsigned int) envPtr->literalArrayNext) { + if (index >= (size_t) envPtr->literalArrayNext) { return NULL; } return envPtr->literalArrayPtr[index].objPtr; @@ -389,7 +390,7 @@ TclRegisterLiteral( register const char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ - int length, /* Number of bytes in the string. If < 0, the + size_t length, /* Number of bytes in the string. If -1, the * string consists of all bytes up to the * first null character. */ int flags) /* If LITERAL_ON_HEAP then the caller already @@ -403,12 +404,11 @@ TclRegisterLiteral( LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *globalPtr, *localPtr; Tcl_Obj *objPtr; - unsigned hash; - unsigned int localHash; - int objIndex, new; + size_t hash, localHash, objIndex; + int new; Namespace *nsPtr; - if (length < 0) { + if (length == TCL_AUTO_LENGTH) { length = (bytes ? strlen(bytes) : 0); } hash = HashString(bytes, length); @@ -422,11 +422,11 @@ TclRegisterLiteral( for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL; localPtr = localPtr->nextPtr) { objPtr = localPtr->objPtr; - if ((objPtr->length == length) && ((length == 0) + if (((size_t)objPtr->length == length) && ((length == 0) || ((objPtr->bytes[0] == bytes[0]) - && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { + && (memcmp(objPtr->bytes, bytes, length) == 0)))) { if ((flags & LITERAL_ON_HEAP)) { - ckfree(bytes); + Tcl_Free((void *)bytes); } objIndex = (localPtr - envPtr->literalArrayPtr); #ifdef TCL_COMPILE_DEBUG @@ -464,9 +464,9 @@ TclRegisterLiteral( objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG - if (globalPtr != NULL && globalPtr->refCount < 1) { - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", - "TclRegisterLiteral", (length>60? 60 : length), bytes, + if (globalPtr != NULL && (globalPtr->refCount + 1 < 2)) { + Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "d", + "TclRegisterLiteral", (length>60? 60 : (int)length), bytes, globalPtr->refCount); } TclVerifyLocalLiteralTable(envPtr); @@ -504,10 +504,10 @@ LookupLiteralEntry( LiteralTable *globalTablePtr = &iPtr->literalTable; register LiteralEntry *entryPtr; const char *bytes; - int length, globalHash; + size_t globalHash; - bytes = TclGetStringFromObj(objPtr, &length); - globalHash = (HashString(bytes, length) & globalTablePtr->mask); + bytes = TclGetString(objPtr); + globalHash = (HashString(bytes, objPtr->length) & globalTablePtr->mask); for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL; entryPtr=entryPtr->nextPtr) { if (entryPtr->objPtr == objPtr) { @@ -549,8 +549,8 @@ TclHideLiteral( { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; - unsigned int localHash; - int length; + size_t localHash; + size_t length; const char *bytes; Tcl_Obj *newObjPtr; @@ -568,7 +568,8 @@ TclHideLiteral( TclReleaseLiteral(interp, lPtr->objPtr); lPtr->objPtr = newObjPtr; - bytes = TclGetStringFromObj(newObjPtr, &length); + bytes = TclGetString(newObjPtr); + length = newObjPtr->length; localHash = HashString(bytes, length) & localTablePtr->mask; nextPtrPtr = &localTablePtr->buckets[localHash]; @@ -625,7 +626,7 @@ TclAddLiteralObj( lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); - lPtr->refCount = (size_t)-1; /* i.e., unused */ + lPtr->refCount = TCL_AUTO_LENGTH; /* i.e., unused */ lPtr->nextPtr = NULL; if (litPtrPtr) { @@ -687,7 +688,8 @@ AddLocalLiteralEntry( TclVerifyLocalLiteralTable(envPtr); { char *bytes; - int length, found, i; + int found; + size_t length, i; found = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { @@ -700,9 +702,10 @@ AddLocalLiteralEntry( } if (!found) { - bytes = TclGetStringFromObj(objPtr, &length); + bytes = TclGetString(objPtr); + length = objPtr->length; Tcl_Panic("%s: literal \"%.*s\" wasn't found locally", - "AddLocalLiteralEntry", (length>60? 60 : length), bytes); + "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ @@ -741,27 +744,27 @@ ExpandLocalLiteralArray( */ LiteralTable *localTablePtr = &envPtr->localLitTable; - int currElems = envPtr->literalArrayNext; + size_t currElems = envPtr->literalArrayNext; size_t currBytes = (currElems * sizeof(LiteralEntry)); LiteralEntry *currArrayPtr = envPtr->literalArrayPtr; LiteralEntry *newArrayPtr; - int i; - unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; + size_t i; + size_t newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; if (currBytes == newSize) { - Tcl_Panic("max size of Tcl literal array (%d literals) exceeded", + Tcl_Panic("max size of Tcl literal array (%" TCL_Z_MODIFIER "u literals) exceeded", currElems); } if (envPtr->mallocedLiteralArray) { - newArrayPtr = ckrealloc(currArrayPtr, newSize); + newArrayPtr = Tcl_Realloc(currArrayPtr, newSize); } else { /* - * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must - * code a ckrealloc equivalent for ourselves. + * envPtr->literalArrayPtr isn't a Tcl_Alloc'd pointer, so we must + * code a Tcl_Realloc equivalent for ourselves. */ - newArrayPtr = ckalloc(newSize); + newArrayPtr = Tcl_Alloc(newSize); memcpy(newArrayPtr, currArrayPtr, currBytes); envPtr->mallocedLiteralArray = 1; } @@ -822,16 +825,16 @@ TclReleaseLiteral( LiteralTable *globalTablePtr; register LiteralEntry *entryPtr, *prevPtr; const char *bytes; - int length; - unsigned int index; + size_t length, index; if (iPtr == NULL) { goto done; } globalTablePtr = &iPtr->literalTable; - bytes = TclGetStringFromObj(objPtr, &length); - index = (HashString(bytes, length) & globalTablePtr->mask); + bytes = TclGetString(objPtr); + length = objPtr->length; + index = HashString(bytes, length) & globalTablePtr->mask; /* * Check to see if the object is in the global literal table and remove @@ -854,7 +857,7 @@ TclReleaseLiteral( } else { prevPtr->nextPtr = entryPtr->nextPtr; } - ckfree(entryPtr); + Tcl_Free(entryPtr); globalTablePtr->numEntries--; TclDecrRefCount(objPtr); @@ -892,12 +895,12 @@ TclReleaseLiteral( *---------------------------------------------------------------------- */ -static unsigned +static size_t HashString( register const char *string, /* String for which to compute hash value. */ - int length) /* Number of bytes in the string. */ + size_t length) /* Number of bytes in the string. */ { - register unsigned int result = 0; + register size_t result = 0; /* * I tried a zillion different hash functions and asked many other people @@ -966,8 +969,7 @@ RebuildLiteralTable( register LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; - unsigned int oldSize, index; - int count, length; + size_t oldSize, count, index, length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; @@ -988,7 +990,7 @@ RebuildLiteralTable( } tablePtr->numBuckets *= 4; - tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(LiteralEntry*)); + tablePtr->buckets = Tcl_Alloc(tablePtr->numBuckets * sizeof(LiteralEntry*)); for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets; count>0 ; count--, newChainPtr++) { *newChainPtr = NULL; @@ -1002,7 +1004,8 @@ RebuildLiteralTable( for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) { for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) { - bytes = TclGetStringFromObj(entryPtr->objPtr, &length); + bytes = TclGetString(entryPtr->objPtr); + length = entryPtr->objPtr->length; index = (HashString(bytes, length) & tablePtr->mask); *oldChainPtr = entryPtr->nextPtr; @@ -1017,7 +1020,7 @@ RebuildLiteralTable( */ if (oldBuckets != tablePtr->staticBuckets) { - ckfree(oldBuckets); + Tcl_Free(oldBuckets); } } @@ -1090,7 +1093,7 @@ TclLiteralStats( LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - int count[NUM_COUNTERS], overflow, i, j; + size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; register LiteralEntry *entryPtr; char *result, *p; @@ -1124,16 +1127,16 @@ TclLiteralStats( * Print out the histogram and a few other pieces of information. */ - result = ckalloc(NUM_COUNTERS*60 + 300); - sprintf(result, "%d entries in table, %d buckets\n", + result = Tcl_Alloc(NUM_COUNTERS*60 + 300); + sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i=0 ; i<NUM_COUNTERS ; i++) { - sprintf(p, "number of buckets with %d entries: %d\n", + sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "d entries: %" TCL_Z_MODIFIER "d\n", i, count[i]); p += strlen(p); } - sprintf(p, "number of buckets with %d or more entries: %d\n", + sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "d\n", NUM_COUNTERS, overflow); p += strlen(p); sprintf(p, "average search distance for entry: %.1f", average); @@ -1166,19 +1169,18 @@ TclVerifyLocalLiteralTable( register LiteralTable *localTablePtr = &envPtr->localLitTable; register LiteralEntry *localPtr; char *bytes; - register int i; - int length, count; + size_t i, length, count = 0; - count = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; - if (localPtr->refCount != -1) { - bytes = TclGetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d", + if (localPtr->refCount != TCL_AUTO_LENGTH) { + bytes = TclGetString(localPtr->objPtr); + length = localPtr->objPtr->length; + Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", "TclVerifyLocalLiteralTable", - (length>60? 60 : length), bytes, localPtr->refCount); + (length>60? 60 : (int) length), bytes, localPtr->refCount); } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", @@ -1187,7 +1189,7 @@ TclVerifyLocalLiteralTable( } } if (count != localTablePtr->numEntries) { - Tcl_Panic("%s: local literal table had %d entries, should be %d", + Tcl_Panic("%s: local literal table had %" TCL_Z_MODIFIER "d entries, should be %" TCL_Z_MODIFIER "d", "TclVerifyLocalLiteralTable", count, localTablePtr->numEntries); } @@ -1217,19 +1219,18 @@ TclVerifyGlobalLiteralTable( register LiteralTable *globalTablePtr = &iPtr->literalTable; register LiteralEntry *globalPtr; char *bytes; - register int i; - int length, count; + size_t i, length, count = 0; - count = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; - if (globalPtr->refCount < 1) { - bytes = TclGetStringFromObj(globalPtr->objPtr, &length); - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", + if (globalPtr->refCount + 1 < 2) { + bytes = TclGetString(globalPtr->objPtr); + length = globalPtr->objPtr->length; + Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "d", "TclVerifyGlobalLiteralTable", - (length>60? 60 : length), bytes, globalPtr->refCount); + (length>60? 60 : (int)length), bytes, globalPtr->refCount); } if (globalPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", @@ -1238,7 +1239,7 @@ TclVerifyGlobalLiteralTable( } } if (count != globalTablePtr->numEntries) { - Tcl_Panic("%s: global literal table had %d entries, should be %d", + Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "d entries, should be %" TCL_Z_MODIFIER "d", "TclVerifyGlobalLiteralTable", count, globalTablePtr->numEntries); } diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 77e6425..ce8a85f 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -131,7 +131,7 @@ Tcl_LoadObjCmd( const char *p, *fullFileName, *packageName; Tcl_LoadHandle loadHandle; Tcl_UniChar ch = 0; - unsigned len; + size_t len; int index, flags = 0; Tcl_Obj *const *savedobjv = objv; static const char *const options[] = { @@ -401,12 +401,12 @@ Tcl_LoadObjCmd( * Create a new record to describe this package. */ - pkgPtr = ckalloc(sizeof(LoadedPackage)); + pkgPtr = Tcl_Alloc(sizeof(LoadedPackage)); len = strlen(fullFileName) + 1; - pkgPtr->fileName = ckalloc(len); + pkgPtr->fileName = Tcl_Alloc(len); memcpy(pkgPtr->fileName, fullFileName, len); - len = (unsigned) Tcl_DStringLength(&pkgName) + 1; - pkgPtr->packageName = ckalloc(len); + len = Tcl_DStringLength(&pkgName) + 1; + pkgPtr->packageName = Tcl_Alloc(len); memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len); pkgPtr->loadHandle = loadHandle; pkgPtr->initProc = initProc; @@ -470,19 +470,17 @@ Tcl_LoadObjCmd( */ if (code != TCL_OK) { -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 Interp *iPtr = (Interp *) target; - if (iPtr->result && *(iPtr->result) && !iPtr->freeProc) { + if (iPtr->legacyResult && *(iPtr->legacyResult) && !iPtr->legacyFreeProc) { /* * A call to Tcl_InitStubs() determined the caller extension and * this interp are incompatible in their stubs mechanisms, and * recorded the error in the oldest legacy place we have to do so. */ - Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->result, -1)); - iPtr->result = &tclEmptyString; - iPtr->freeProc = NULL; + Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1)); + iPtr->legacyResult = NULL; + iPtr->legacyFreeProc = (void (*) (void))-1; } -#endif /* defined(TCL_NO_DEPRECATED) */ Tcl_TransferResult(target, code, interp); goto done; } @@ -508,7 +506,7 @@ Tcl_LoadObjCmd( */ ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); - ipPtr = ckalloc(sizeof(InterpPackage)); + ipPtr = Tcl_Alloc(sizeof(InterpPackage)); ipPtr->pkgPtr = pkgPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr); @@ -892,10 +890,10 @@ Tcl_UnloadObjCmd( } Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); - ckfree(defaultPtr->fileName); - ckfree(defaultPtr->packageName); - ckfree(defaultPtr); - ckfree(ipPtr); + Tcl_Free(defaultPtr->fileName); + Tcl_Free(defaultPtr->packageName); + Tcl_Free(defaultPtr); + Tcl_Free(ipPtr); Tcl_MutexUnlock(&packageMutex); } else { code = TCL_ERROR; @@ -982,10 +980,10 @@ Tcl_StaticPackage( */ if (pkgPtr == NULL) { - pkgPtr = ckalloc(sizeof(LoadedPackage)); - pkgPtr->fileName = ckalloc(1); + pkgPtr = Tcl_Alloc(sizeof(LoadedPackage)); + pkgPtr->fileName = Tcl_Alloc(1); pkgPtr->fileName[0] = 0; - pkgPtr->packageName = ckalloc(strlen(pkgName) + 1); + pkgPtr->packageName = Tcl_Alloc(strlen(pkgName) + 1); strcpy(pkgPtr->packageName, pkgName); pkgPtr->loadHandle = NULL; pkgPtr->initProc = initProc; @@ -1015,7 +1013,7 @@ Tcl_StaticPackage( * loaded. */ - ipPtr = ckalloc(sizeof(InterpPackage)); + ipPtr = Tcl_Alloc(sizeof(InterpPackage)); ipPtr->pkgPtr = pkgPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr); @@ -1159,7 +1157,7 @@ LoadCleanupProc( ipPtr = clientData; while (ipPtr != NULL) { nextPtr = ipPtr->nextPtr; - ckfree(ipPtr); + Tcl_Free(ipPtr); ipPtr = nextPtr; } } @@ -1210,9 +1208,9 @@ TclFinalizeLoad(void) } #endif - ckfree(pkgPtr->fileName); - ckfree(pkgPtr->packageName); - ckfree(pkgPtr); + Tcl_Free(pkgPtr->fileName); + Tcl_Free(pkgPtr->packageName); + Tcl_Free(pkgPtr); } } diff --git a/generic/tclMain.c b/generic/tclMain.c index 9380fb2..f85f8aa 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -18,7 +18,7 @@ /* * On Windows, this file needs to be compiled twice, once with TCL_ASCII_MAIN - * defined. This way both Tcl_Main and Tcl_MainExW can be implemented, sharing + * defined. This way both Tcl_MainEx and Tcl_MainExW can be implemented, sharing * the same source code. */ @@ -65,7 +65,7 @@ static inline Tcl_Obj * NewNativeObj( char *string, - int length) + size_t length) { Tcl_DString ds; @@ -299,7 +299,7 @@ Tcl_SourceRCFile( *---------------------------------------------------------------------- */ -void +TCL_NORETURN void Tcl_MainEx( int argc, /* Number of arguments. */ TCHAR **argv, /* Array of argument strings. */ @@ -467,7 +467,7 @@ Tcl_MainEx( while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) { mainLoopProc = TclGetMainLoop(); if (mainLoopProc == NULL) { - int length; + size_t length; if (is.tty) { Prompt(interp, &is); @@ -488,7 +488,7 @@ Tcl_MainEx( Tcl_IncrRefCount(is.commandPtr); } length = Tcl_GetsObj(is.input, is.commandPtr); - if (length < 0) { + if (length == (size_t)-1) { if (Tcl_InputBlocked(is.input)) { /* * This can only happen if stdin has been set to @@ -532,7 +532,7 @@ Tcl_MainEx( * error messages troubles deeper in, so lop it back off. */ - TclGetStringFromObj(is.commandPtr, &length); + (void)TclGetStringFromObj(is.commandPtr, &length); Tcl_SetObjLength(is.commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, is.commandPtr, TCL_EVAL_GLOBAL); @@ -549,7 +549,7 @@ Tcl_MainEx( } else if (is.tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); - TclGetStringFromObj(resultPtr, &length); + (void)TclGetStringFromObj(resultPtr, &length); chan = Tcl_GetStdChannel(TCL_STDOUT); if ((length > 0) && chan) { Tcl_WriteObj(chan, resultPtr); @@ -753,7 +753,8 @@ StdinProc( ClientData clientData, /* The state of interactive cmd line */ int mask) /* Not used. */ { - int code, length; + int code; + size_t length; InteractiveState *isPtr = clientData; Tcl_Channel chan = isPtr->input; Tcl_Obj *commandPtr = isPtr->commandPtr; @@ -765,7 +766,7 @@ StdinProc( Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(chan, commandPtr); - if (length < 0) { + if (length == (size_t)-1) { if (Tcl_InputBlocked(chan)) { return; } @@ -793,7 +794,7 @@ StdinProc( goto prompt; } isPtr->prompt = PROMPT_START; - TclGetStringFromObj(commandPtr, &length); + (void)TclGetStringFromObj(commandPtr, &length); Tcl_SetObjLength(commandPtr, --length); /* @@ -824,7 +825,7 @@ StdinProc( chan = Tcl_GetStdChannel(TCL_STDOUT); Tcl_IncrRefCount(resultPtr); - TclGetStringFromObj(resultPtr, &length); + (void)TclGetStringFromObj(resultPtr, &length); if ((length > 0) && (chan != NULL)) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index de2222e..48a0e34 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -33,7 +33,7 @@ */ typedef struct { - unsigned long numNsCreated; /* Count of the number of namespaces created + size_t numNsCreated; /* Count of the number of namespaces created * within the thread. This value is used as a * unique id for each namespace. Cannot be * per-interp because the nsId is used to @@ -53,7 +53,7 @@ static Tcl_ThreadDataKey dataKey; * with some information that is used to check the cached pointer's validity. */ -typedef struct ResolvedNsName { +typedef struct { Namespace *nsPtr; /* A cached pointer to the Namespace that the * name resolved to. */ Namespace *refNsPtr; /* Points to the namespace context in which @@ -412,7 +412,7 @@ Tcl_PopCallFrame( if (framePtr->varTablePtr != NULL) { TclDeleteVars(iPtr, framePtr->varTablePtr); - ckfree(framePtr->varTablePtr); + Tcl_Free(framePtr->varTablePtr); framePtr->varTablePtr = NULL; } if (framePtr->numCompiledLocals > 0) { @@ -430,9 +430,8 @@ Tcl_PopCallFrame( */ nsPtr = framePtr->nsPtr; - nsPtr->activationCount--; - if ((nsPtr->flags & NS_DYING) - && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) { + if ((--nsPtr->activationCount <= (nsPtr == iPtr->globalNsPtr)) + && (nsPtr->flags & NS_DYING)) { Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); } framePtr->nsPtr = NULL; @@ -686,7 +685,8 @@ Tcl_CreateNamespace( Tcl_HashEntry *entryPtr; Tcl_DString buffer1, buffer2; Tcl_DString *namePtr, *buffPtr; - int newEntry, nameLen; + int newEntry; + size_t nameLen; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); const char *nameStr; Tcl_DString tmpBuffer; @@ -785,9 +785,9 @@ Tcl_CreateNamespace( */ doCreate: - nsPtr = ckalloc(sizeof(Namespace)); + nsPtr = Tcl_Alloc(sizeof(Namespace)); nameLen = strlen(simpleName) + 1; - nsPtr->name = ckalloc(nameLen); + nsPtr->name = Tcl_Alloc(nameLen); memcpy(nsPtr->name, simpleName, nameLen); nsPtr->fullName = NULL; /* Set below. */ nsPtr->clientData = clientData; @@ -875,8 +875,8 @@ Tcl_CreateNamespace( name = Tcl_DStringValue(namePtr); nameLen = Tcl_DStringLength(namePtr); - nsPtr->fullName = ckalloc(nameLen + 1); - memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1); + nsPtr->fullName = Tcl_Alloc(nameLen + 1); + memcpy(nsPtr->fullName, name, nameLen + 1); Tcl_DStringFree(&buffer1); Tcl_DStringFree(&buffer2); @@ -1023,7 +1023,7 @@ Tcl_DeleteNamespace( * refCount reaches 0. */ - if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) { + if (nsPtr->activationCount > (nsPtr == globalNsPtr)) { nsPtr->flags |= NS_DYING; if (nsPtr->parentPtr != NULL) { entryPtr = Tcl_FindHashEntry( @@ -1062,7 +1062,7 @@ Tcl_DeleteNamespace( #else if (nsPtr->childTablePtr != NULL) { Tcl_DeleteHashTable(nsPtr->childTablePtr); - ckfree(nsPtr->childTablePtr); + Tcl_Free(nsPtr->childTablePtr); } #endif Tcl_DeleteHashTable(&nsPtr->cmdTable); @@ -1117,7 +1117,7 @@ TclTeardownNamespace( Interp *iPtr = (Interp *) nsPtr->interp; register Tcl_HashEntry *entryPtr; Tcl_HashSearch search; - int i; + size_t i; /* * Start by destroying the namespace's variable table, since variables @@ -1138,7 +1138,7 @@ TclTeardownNamespace( */ while (nsPtr->cmdTable.numEntries > 0) { - int length = nsPtr->cmdTable.numEntries; + size_t length = nsPtr->cmdTable.numEntries; Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Command *) * length); @@ -1210,7 +1210,7 @@ TclTeardownNamespace( #ifndef BREAK_NAMESPACE_COMPAT while (nsPtr->childTable.numEntries > 0) { - int length = nsPtr->childTable.numEntries; + size_t length = nsPtr->childTable.numEntries; Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); @@ -1231,7 +1231,7 @@ TclTeardownNamespace( #else if (nsPtr->childTablePtr != NULL) { while (nsPtr->childTablePtr->numEntries > 0) { - int length = nsPtr->childTablePtr->numEntries; + size_t length = nsPtr->childTablePtr->numEntries; Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); @@ -1258,9 +1258,9 @@ TclTeardownNamespace( if (nsPtr->exportArrayPtr != NULL) { for (i = 0; i < nsPtr->numExportPatterns; i++) { - ckfree(nsPtr->exportArrayPtr[i]); + Tcl_Free(nsPtr->exportArrayPtr[i]); } - ckfree(nsPtr->exportArrayPtr); + Tcl_Free(nsPtr->exportArrayPtr); nsPtr->exportArrayPtr = NULL; nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; @@ -1312,9 +1312,9 @@ NamespaceFree( * (for error messages), and the structure itself. */ - ckfree(nsPtr->name); - ckfree(nsPtr->fullName); - ckfree(nsPtr); + Tcl_Free(nsPtr->name); + Tcl_Free(nsPtr->fullName); + Tcl_Free(nsPtr); } /* @@ -1383,7 +1383,7 @@ Tcl_Export( Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); const char *simplePattern; char *patternCpy; - int neededElems, len, i; + size_t neededElems, len, i; /* * If the specified namespace is NULL, use the current namespace. @@ -1403,9 +1403,9 @@ Tcl_Export( if (resetListFirst) { if (nsPtr->exportArrayPtr != NULL) { for (i = 0; i < nsPtr->numExportPatterns; i++) { - ckfree(nsPtr->exportArrayPtr[i]); + Tcl_Free(nsPtr->exportArrayPtr[i]); } - ckfree(nsPtr->exportArrayPtr); + Tcl_Free(nsPtr->exportArrayPtr); nsPtr->exportArrayPtr = NULL; TclInvalidateNsCmdLookup(nsPtr); nsPtr->numExportPatterns = 0; @@ -1452,7 +1452,7 @@ Tcl_Export( if (neededElems > nsPtr->maxExportPatterns) { nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ? 2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS; - nsPtr->exportArrayPtr = ckrealloc(nsPtr->exportArrayPtr, + nsPtr->exportArrayPtr = Tcl_Realloc(nsPtr->exportArrayPtr, sizeof(char *) * nsPtr->maxExportPatterns); } @@ -1461,8 +1461,8 @@ Tcl_Export( */ len = strlen(pattern); - patternCpy = ckalloc(len + 1); - memcpy(patternCpy, pattern, (unsigned) len + 1); + patternCpy = Tcl_Alloc(len + 1); + memcpy(patternCpy, pattern, len + 1); nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy; nsPtr->numExportPatterns++; @@ -1510,7 +1510,8 @@ Tcl_AppendExportList( * export pattern list is appended. */ { Namespace *nsPtr; - int i, result; + size_t i; + int result; /* * If the specified namespace is NULL, use the current namespace. @@ -1712,7 +1713,7 @@ DoImport( Namespace *importNsPtr, int allowOverwrite) { - int i = 0, exported = 0; + size_t i = 0, exported = 0; Tcl_HashEntry *found; /* @@ -1779,7 +1780,7 @@ DoImport( } } - dataPtr = ckalloc(sizeof(ImportedCmdData)); + dataPtr = Tcl_Alloc(sizeof(ImportedCmdData)); importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr, DeleteImportedCmd); @@ -1793,7 +1794,7 @@ DoImport( * and add it to the import ref list in the "real" command. */ - refPtr = ckalloc(sizeof(ImportRef)); + refPtr = Tcl_Alloc(sizeof(ImportRef)); refPtr->importedCmdPtr = (Command *) importedCmd; refPtr->nextPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = refPtr; @@ -2090,8 +2091,8 @@ DeleteImportedCmd( } else { prevPtr->nextPtr = refPtr->nextPtr; } - ckfree(refPtr); - ckfree(dataPtr); + Tcl_Free(refPtr); + Tcl_Free(dataPtr); return; } prevPtr = refPtr; @@ -2621,7 +2622,7 @@ Tcl_FindCommand( cmdPtr = NULL; if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2) && !(flags & TCL_NAMESPACE_ONLY)) { - int i; + size_t i; Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr; (void) TclGetNamespaceForQualName(interp, name, cxtNsPtr, @@ -3048,7 +3049,7 @@ NamespaceChildrenCmd( listPtr = Tcl_NewListObj(0, NULL); if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { - unsigned int length = strlen(nsPtr->fullName); + size_t length = strlen(nsPtr->fullName); if (strncmp(pattern, nsPtr->fullName, length) != 0) { goto searchDone; @@ -3128,7 +3129,7 @@ NamespaceCodeCmd( Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; register const char *arg; - int length; + size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg"); @@ -3441,15 +3442,15 @@ NsEval_Callback( Tcl_Namespace *namespacePtr = data[0]; if (result == TCL_ERROR) { - int length = strlen(namespacePtr->fullName); - int limit = 200; + size_t length = strlen(namespacePtr->fullName); + unsigned limit = 200; int overflow = (length > limit); char *cmd = data[1]; Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in namespace %s \"%.*s%s\" script line %d)", cmd, - (overflow ? limit : length), namespacePtr->fullName, + (overflow ? limit : (unsigned)length), namespacePtr->fullName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -4022,7 +4023,8 @@ NamespacePathCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp); - int i, nsObjc, result = TCL_ERROR; + size_t i; + int nsObjc, result = TCL_ERROR; Tcl_Obj **nsObjv; Tcl_Namespace **namespaceList = NULL; @@ -4059,7 +4061,7 @@ NamespacePathCmd( namespaceList = TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc); - for (i=0 ; i<nsObjc ; i++) { + for (i=0 ; i<(size_t)nsObjc ; i++) { if (TclGetNamespaceFromObj(interp, nsObjv[i], &namespaceList[i]) != TCL_OK) { goto badNamespace; @@ -4104,13 +4106,13 @@ NamespacePathCmd( void TclSetNsPath( Namespace *nsPtr, /* Namespace whose path is to be set. */ - int pathLength, /* Length of pathAry. */ + size_t pathLength, /* Length of pathAry. */ Tcl_Namespace *pathAry[]) /* Array of namespaces that are the path. */ { if (pathLength != 0) { NamespacePathEntry *tmpPathArray = - ckalloc(sizeof(NamespacePathEntry) * pathLength); - int i; + Tcl_Alloc(sizeof(NamespacePathEntry) * pathLength); + size_t i; for (i=0 ; i<pathLength ; i++) { tmpPathArray[i].nsPtr = (Namespace *) pathAry[i]; @@ -4161,7 +4163,7 @@ static void UnlinkNsPath( Namespace *nsPtr) { - int i; + size_t i; for (i=0 ; i<nsPtr->commandPathLength ; i++) { NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i]; @@ -4177,7 +4179,7 @@ UnlinkNsPath( } } } - ckfree(nsPtr->commandPathArray); + Tcl_Free(nsPtr->commandPathArray); } /* @@ -4247,7 +4249,7 @@ NamespaceQualifiersCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register const char *name, *p; - int length; + size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); @@ -4725,7 +4727,7 @@ FreeNsNameInternalRep( */ TclNsDecrRefCount(resNamePtr->nsPtr); - ckfree(resNamePtr); + Tcl_Free(resNamePtr); } } @@ -4812,7 +4814,7 @@ SetNsNameFromAny( */ nsPtr->refCount++; - resNamePtr = ckalloc(sizeof(ResolvedNsName)); + resNamePtr = Tcl_Alloc(sizeof(ResolvedNsName)); resNamePtr->nsPtr = nsPtr; if ((name[0] == ':') && (name[1] == ':')) { resNamePtr->refNsPtr = NULL; @@ -4872,7 +4874,7 @@ TclGetNamespaceChildTable( return &nPtr->childTable; #else if (nPtr->childTablePtr == NULL) { - nPtr->childTablePtr = ckalloc(sizeof(Tcl_HashTable)); + nPtr->childTablePtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS); } return nPtr->childTablePtr; @@ -4908,8 +4910,8 @@ TclLogCommandInfo( * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ - int length, /* Number of bytes in command (-1 means use - * all bytes up to first null byte). */ + size_t length, /* Number of bytes in command (-1 means + * use all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ Tcl_Obj **tosPtr) /* Current stack of bytecode execution * context */ @@ -4940,14 +4942,14 @@ TclLogCommandInfo( } } - if (length < 0) { + if (length == TCL_AUTO_LENGTH) { length = strlen(command); } - overflow = (length > limit); + overflow = (length > (size_t)limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL) ? "while executing" : "invoked from within"), - (overflow ? limit : length), command, + (overflow ? limit : (int)length), command, (overflow ? "..." : ""))); varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY, @@ -5065,7 +5067,7 @@ void TclErrorStackResetIf( Tcl_Interp *interp, const char *msg, - int length) + size_t length) { Interp *iPtr = (Interp *) interp; @@ -5120,7 +5122,7 @@ Tcl_LogCommandInfo( * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ - int length) /* Number of bytes in command (-1 means use + size_t length) /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ { TclLogCommandInfo(interp, script, command, length, NULL, NULL); diff --git a/generic/tclNotify.c b/generic/tclNotify.c index e76bca8..41a70b1 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -181,7 +181,7 @@ TclFinalizeNotifier(void) for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) { hold = evPtr; evPtr = evPtr->nextPtr; - ckfree(hold); + Tcl_Free(hold); } tsdPtr->firstEventPtr = NULL; tsdPtr->lastEventPtr = NULL; @@ -276,7 +276,7 @@ Tcl_CreateEventSource( * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - EventSource *sourcePtr = ckalloc(sizeof(EventSource)); + EventSource *sourcePtr = Tcl_Alloc(sizeof(EventSource)); sourcePtr->setupProc = setupProc; sourcePtr->checkProc = checkProc; @@ -330,7 +330,7 @@ Tcl_DeleteEventSource( } else { prevPtr->nextPtr = sourcePtr->nextPtr; } - ckfree(sourcePtr); + Tcl_Free(sourcePtr); return; } } @@ -355,7 +355,7 @@ void Tcl_QueueEvent( Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with - * malloc (ckalloc), and it becomes the + * malloc (Tcl_Alloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, @@ -387,7 +387,7 @@ Tcl_ThreadQueueEvent( Tcl_ThreadId threadId, /* Identifier for thread to use. */ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with - * malloc (ckalloc), and it becomes the + * malloc (Tcl_Alloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, @@ -412,7 +412,7 @@ Tcl_ThreadQueueEvent( if (tsdPtr) { QueueEvent(tsdPtr, evPtr, position); } else { - ckfree(evPtr); + Tcl_Free(evPtr); } Tcl_MutexUnlock(&listLock); } @@ -444,7 +444,7 @@ QueueEvent( * which event queue to use. */ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with - * malloc (ckalloc), and it becomes the + * malloc (Tcl_Alloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, @@ -563,7 +563,7 @@ Tcl_DeleteEvents( hold = evPtr; evPtr = evPtr->nextPtr; - ckfree(hold); + Tcl_Free(hold); } else { /* * Event is to be retained. @@ -702,7 +702,7 @@ Tcl_ServiceEvent( } } if (evPtr) { - ckfree(evPtr); + Tcl_Free(evPtr); } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); return 1; diff --git a/generic/tclOO.c b/generic/tclOO.c index 0440395..360c7dd 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -300,7 +300,7 @@ InitFoundation( static Tcl_ThreadDataKey tsdKey; ThreadLocalData *tsdPtr = Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); - Foundation *fPtr = ckalloc(sizeof(Foundation)); + Foundation *fPtr = Tcl_Alloc(sizeof(Foundation)); Tcl_Obj *namePtr; Tcl_DString buffer; Command *cmdPtr; @@ -323,7 +323,7 @@ InitFoundation( DeletedObjdefNamespace); fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr, DeletedHelpersNamespace); - fPtr->epoch = 0; + fPtr->epoch = 1; fPtr->tsdPtr = tsdPtr; TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown"); TclNewLiteralStringObj(fPtr->constructorName, "<constructor>"); @@ -465,7 +465,7 @@ InitClassSystemRoots( */ fPtr->objectCls->superclasses.num = 0; - ckfree(fPtr->objectCls->superclasses.list); + Tcl_Free(fPtr->objectCls->superclasses.list); fPtr->objectCls->superclasses.list = NULL; /* @@ -584,7 +584,7 @@ KillFoundation( TclOODecrRefCount(fPtr->objectCls->thisPtr); TclOODecrRefCount(fPtr->classCls->thisPtr); - ckfree(fPtr); + Tcl_Free(fPtr); } /* @@ -622,9 +622,9 @@ AllocObject( Object *oPtr; Command *cmdPtr; CommandTrace *tracePtr; - int creationEpoch; + size_t creationEpoch; - oPtr = ckalloc(sizeof(Object)); + oPtr = Tcl_Alloc(sizeof(Object)); memset(oPtr, 0, sizeof(Object)); /* @@ -651,7 +651,7 @@ AllocObject( while (1) { char objName[10 + TCL_INTEGER_SPACE]; - sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount); + sprintf(objName, "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount); oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL); if (oPtr->namespacePtr != NULL) { creationEpoch = fPtr->tsdPtr->nsCount; @@ -737,7 +737,7 @@ AllocObject( cmdPtr = (Command *) oPtr->command; cmdPtr->nreProc = PublicNRObjectCmd; - cmdPtr->tracePtr = tracePtr = ckalloc(sizeof(CommandTrace)); + cmdPtr->tracePtr = tracePtr = Tcl_Alloc(sizeof(CommandTrace)); tracePtr->traceProc = ObjectRenamedTrace; tracePtr->clientData = oPtr; tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE; @@ -887,7 +887,7 @@ TclOODeleteDescendants( } } if (clsPtr->mixinSubs.size > 0) { - ckfree(clsPtr->mixinSubs.list); + Tcl_Free(clsPtr->mixinSubs.list); clsPtr->mixinSubs.size = 0; } @@ -907,7 +907,7 @@ TclOODeleteDescendants( } } if (clsPtr->subclasses.size > 0) { - ckfree(clsPtr->subclasses.list); + Tcl_Free(clsPtr->subclasses.list); clsPtr->subclasses.list = NULL; clsPtr->subclasses.size = 0; } @@ -931,7 +931,7 @@ TclOODeleteDescendants( } } if (clsPtr->instances.size > 0) { - ckfree(clsPtr->instances.list); + Tcl_Free(clsPtr->instances.list); clsPtr->instances.list = NULL; clsPtr->instances.size = 0; } @@ -1007,7 +1007,7 @@ TclOOReleaseClassContents( TclOODeleteChain(callPtr); } Tcl_DeleteHashTable(clsPtr->classChainCache); - ckfree(clsPtr->classChainCache); + Tcl_Free(clsPtr->classChainCache); clsPtr->classChainCache = NULL; } @@ -1021,7 +1021,7 @@ TclOOReleaseClassContents( FOREACH(filterObj, clsPtr->filters) { TclDecrRefCount(filterObj); } - ckfree(clsPtr->filters.list); + Tcl_Free(clsPtr->filters.list); clsPtr->filters.list = NULL; clsPtr->filters.num = 0; } @@ -1038,7 +1038,7 @@ TclOOReleaseClassContents( metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(clsPtr->metadataPtr); - ckfree(clsPtr->metadataPtr); + Tcl_Free(clsPtr->metadataPtr); clsPtr->metadataPtr = NULL; } @@ -1047,7 +1047,7 @@ TclOOReleaseClassContents( TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr); TclOODecrRefCount(tmpClsPtr->thisPtr); } - ckfree(clsPtr->mixins.list); + Tcl_Free(clsPtr->mixins.list); clsPtr->mixins.list = NULL; clsPtr->mixins.num = 0; } @@ -1057,7 +1057,7 @@ TclOOReleaseClassContents( TclOORemoveFromSubclasses(clsPtr, tmpClsPtr); TclOODecrRefCount(tmpClsPtr->thisPtr); } - ckfree(clsPtr->superclasses.list); + Tcl_Free(clsPtr->superclasses.list); clsPtr->superclasses.num = 0; clsPtr->superclasses.list = NULL; } @@ -1073,7 +1073,7 @@ TclOOReleaseClassContents( TclDecrRefCount(variableObj); } if (i) { - ckfree(clsPtr->variables.list); + Tcl_Free(clsPtr->variables.list); } FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) { @@ -1081,7 +1081,7 @@ TclOOReleaseClassContents( TclDecrRefCount(privateVariable->fullNameObj); } if (i) { - ckfree(clsPtr->privateVariables.list); + Tcl_Free(clsPtr->privateVariables.list); } if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) { @@ -1213,7 +1213,7 @@ ObjectNamespaceDeleted( TclOODecrRefCount(mixinPtr->thisPtr); } if (oPtr->mixins.list != NULL) { - ckfree(oPtr->mixins.list); + Tcl_Free(oPtr->mixins.list); } } @@ -1221,7 +1221,7 @@ ObjectNamespaceDeleted( TclDecrRefCount(filterObj); } if (i) { - ckfree(oPtr->filters.list); + Tcl_Free(oPtr->filters.list); } if (oPtr->methodsPtr) { @@ -1229,14 +1229,14 @@ ObjectNamespaceDeleted( TclOODelMethodRef(mPtr); } Tcl_DeleteHashTable(oPtr->methodsPtr); - ckfree(oPtr->methodsPtr); + Tcl_Free(oPtr->methodsPtr); } FOREACH(variableObj, oPtr->variables) { TclDecrRefCount(variableObj); } if (i) { - ckfree(oPtr->variables.list); + Tcl_Free(oPtr->variables.list); } FOREACH_STRUCT(privateVariable, oPtr->privateVariables) { @@ -1244,7 +1244,7 @@ ObjectNamespaceDeleted( TclDecrRefCount(privateVariable->fullNameObj); } if (i) { - ckfree(oPtr->privateVariables.list); + Tcl_Free(oPtr->privateVariables.list); } if (oPtr->chainCache) { @@ -1261,7 +1261,7 @@ ObjectNamespaceDeleted( metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(oPtr->metadataPtr); - ckfree(oPtr->metadataPtr); + Tcl_Free(oPtr->metadataPtr); oPtr->metadataPtr = NULL; } @@ -1317,9 +1317,9 @@ TclOODecrRefCount( if (oPtr->refCount-- <= 1) { if (oPtr->classPtr != NULL) { - ckfree(oPtr->classPtr); + Tcl_Free(oPtr->classPtr); } - ckfree(oPtr); + Tcl_Free(oPtr); return 1; } return 0; @@ -1377,9 +1377,9 @@ TclOOAddToInstances( if (clsPtr->instances.num >= clsPtr->instances.size) { clsPtr->instances.size += ALLOC_CHUNK; if (clsPtr->instances.size == ALLOC_CHUNK) { - clsPtr->instances.list = ckalloc(sizeof(Object *) * ALLOC_CHUNK); + clsPtr->instances.list = Tcl_Alloc(sizeof(Object *) * ALLOC_CHUNK); } else { - clsPtr->instances.list = ckrealloc(clsPtr->instances.list, + clsPtr->instances.list = Tcl_Realloc(clsPtr->instances.list, sizeof(Object *) * clsPtr->instances.size); } } @@ -1416,7 +1416,7 @@ TclOORemoveFromMixins( } } if (oPtr->mixins.num == 0) { - ckfree(oPtr->mixins.list); + Tcl_Free(oPtr->mixins.list); oPtr->mixins.list = NULL; } return res; @@ -1476,9 +1476,9 @@ TclOOAddToSubclasses( if (superPtr->subclasses.num >= superPtr->subclasses.size) { superPtr->subclasses.size += ALLOC_CHUNK; if (superPtr->subclasses.size == ALLOC_CHUNK) { - superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK); + superPtr->subclasses.list = Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK); } else { - superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list, + superPtr->subclasses.list = Tcl_Realloc(superPtr->subclasses.list, sizeof(Class *) * superPtr->subclasses.size); } } @@ -1541,9 +1541,9 @@ TclOOAddToMixinSubs( if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) { superPtr->mixinSubs.size += ALLOC_CHUNK; if (superPtr->mixinSubs.size == ALLOC_CHUNK) { - superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK); + superPtr->mixinSubs.list = Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK); } else { - superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list, + superPtr->mixinSubs.list = Tcl_Realloc(superPtr->mixinSubs.list, sizeof(Class *) * superPtr->mixinSubs.size); } } @@ -1589,7 +1589,7 @@ TclOOAllocClass( * representation. */ { Foundation *fPtr = GetFoundation(interp); - Class *clsPtr = ckalloc(sizeof(Class)); + Class *clsPtr = Tcl_Alloc(sizeof(Class)); memset(clsPtr, 0, sizeof(Class)); clsPtr->thisPtr = useThisObj; @@ -1606,7 +1606,7 @@ TclOOAllocClass( */ clsPtr->superclasses.num = 1; - clsPtr->superclasses.list = ckalloc(sizeof(Class *)); + clsPtr->superclasses.list = Tcl_Alloc(sizeof(Class *)); clsPtr->superclasses.list[0] = fPtr->objectCls; AddRef(fPtr->objectCls->thisPtr); @@ -1967,7 +1967,7 @@ Tcl_CopyObjectInstance( } TclOODecrRefCount(mixinPtr->thisPtr); } - ckfree(o2Ptr->mixins.list); + Tcl_Free(o2Ptr->mixins.list); } DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *); FOREACH(mixinPtr, o2Ptr->mixins) { @@ -2063,11 +2063,11 @@ Tcl_CopyObjectInstance( TclOODecrRefCount(superPtr->thisPtr); } if (cls2Ptr->superclasses.num) { - cls2Ptr->superclasses.list = ckrealloc(cls2Ptr->superclasses.list, + cls2Ptr->superclasses.list = Tcl_Realloc(cls2Ptr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); } else { cls2Ptr->superclasses.list = - ckalloc(sizeof(Class *) * clsPtr->superclasses.num); + Tcl_Alloc(sizeof(Class *) * clsPtr->superclasses.num); } memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); @@ -2116,7 +2116,7 @@ Tcl_CopyObjectInstance( TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - ckfree(clsPtr->mixins.list); + Tcl_Free(clsPtr->mixins.list); } DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *); FOREACH(mixinPtr, cls2Ptr->mixins) { @@ -2355,7 +2355,7 @@ Tcl_ClassSetMetadata( if (metadata == NULL) { return; } - clsPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable)); + clsPtr->metadataPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS); } @@ -2435,7 +2435,7 @@ Tcl_ObjectSetMetadata( if (metadata == NULL) { return; } - oPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable)); + oPtr->metadataPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS); } diff --git a/generic/tclOO.decls b/generic/tclOO.decls index f1bb320..ed7b800 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -51,7 +51,7 @@ declare 8 { } declare 9 { int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, - ClientData *clientDataPtr) + void **clientDataPtr) } declare 10 { Tcl_Obj *Tcl_MethodName(Tcl_Method method) @@ -59,12 +59,12 @@ declare 10 { declare 11 { Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - ClientData clientData) + void *clientData) } declare 12 { Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - ClientData clientData) + void *clientData) } declare 13 { Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, @@ -87,20 +87,20 @@ declare 18 { int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context) } declare 19 { - ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, + void *Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr) } declare 20 { void Tcl_ClassSetMetadata(Tcl_Class clazz, - const Tcl_ObjectMetadataType *typePtr, ClientData metadata) + const Tcl_ObjectMetadataType *typePtr, void *metadata) } declare 21 { - ClientData Tcl_ObjectGetMetadata(Tcl_Object object, + void *Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr) } declare 22 { void Tcl_ObjectSetMetadata(Tcl_Object object, - const Tcl_ObjectMetadataType *typePtr, ClientData metadata) + const Tcl_ObjectMetadataType *typePtr, void *metadata) } declare 23 { int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, @@ -144,14 +144,14 @@ declare 0 { declare 1 { Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, - const Tcl_MethodType *typePtr, ClientData clientData, + const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr) } declare 2 { Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - ClientData clientData, Proc **procPtrPtr) + void *clientData, Proc **procPtrPtr) } declare 3 { Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, @@ -182,13 +182,13 @@ declare 9 { Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, - ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, + void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } declare 10 { Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, + ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } diff --git a/generic/tclOO.h b/generic/tclOO.h index 9c1dd1e..4a3398f 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -60,12 +60,12 @@ typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext; * and to allow the attachment of arbitrary data to objects and classes. */ -typedef int (Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv); -typedef void (Tcl_MethodDeleteProc)(ClientData clientData); -typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData, - ClientData *newClientData); -typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData clientData); +typedef void (Tcl_MethodDeleteProc)(void *clientData); +typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData, + void **newClientData); +typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData); typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp, Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj); @@ -95,7 +95,7 @@ typedef struct { /* * The correct value for the version field of the Tcl_MethodType structure. * This allows new versions of the structure to be introduced without breaking - * binary compatability. + * binary compatibility. */ #define TCL_OO_METHOD_VERSION_CURRENT 1 @@ -131,7 +131,7 @@ typedef struct { /* * The correct value for the version field of the Tcl_ObjectMetadataType * structure. This allows new versions of the structure to be introduced - * without breaking binary compatability. + * without breaking binary compatibility. */ #define TCL_OO_METADATA_VERSION_CURRENT 1 diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 13c98f4..60e7456 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -108,7 +108,7 @@ TclOO_Class_Constructor( * Delegate to [oo::define] to do the work. */ - invoke = ckalloc(3 * sizeof(Tcl_Obj *)); + invoke = Tcl_Alloc(3 * sizeof(Tcl_Obj *)); invoke[0] = oPtr->fPtr->defineName; invoke[1] = TclOOObjectName(interp, oPtr); invoke[2] = objv[objc-1]; @@ -154,7 +154,7 @@ DecrRefsPostClassConstructor( code = Tcl_EvalObjv(interp, 2, invoke, 0); TclDecrRefCount(invoke[0]); TclDecrRefCount(invoke[1]); - ckfree(invoke); + Tcl_Free(invoke); if (code != TCL_OK) { Tcl_DiscardInterpState(saved); return code; @@ -183,7 +183,7 @@ TclOO_Class_Create( { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName; - int len; + size_t len; /* * Sanity check; should not be possible to invoke this method on a @@ -208,7 +208,7 @@ TclOO_Class_Create( "objectName ?arg ...?"); return TCL_ERROR; } - objName = Tcl_GetStringFromObj( + objName = TclGetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -248,7 +248,7 @@ TclOO_Class_CreateNs( { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName, *nsName; - int len; + size_t len; /* * Sanity check; should not be possible to invoke this method on a @@ -273,7 +273,7 @@ TclOO_Class_CreateNs( "objectName namespaceName ?arg ...?"); return TCL_ERROR; } - objName = Tcl_GetStringFromObj( + objName = TclGetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -281,7 +281,7 @@ TclOO_Class_CreateNs( Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } - nsName = Tcl_GetStringFromObj( + nsName = TclGetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)+1], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -605,7 +605,7 @@ TclOO_Object_Unknown( Tcl_AppendToObj(errorMsg, " or ", -1); } Tcl_AppendToObj(errorMsg, methodNames[i], -1); - ckfree(methodNames); + Tcl_Free(methodNames); Tcl_SetObjResult(interp, errorMsg); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[skip]), NULL); diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 908dd26..596d036 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -205,7 +205,7 @@ TclOODeleteChainCache( } } Tcl_DeleteHashTable(tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); } /* @@ -226,9 +226,9 @@ TclOODeleteChain( return; } if (callPtr->chain != callPtr->staticChain) { - ckfree(callPtr->chain); + Tcl_Free(callPtr->chain); } - ckfree(callPtr); + Tcl_Free(callPtr); } /* @@ -589,13 +589,13 @@ SortMethodNames( * methods. Full private methods are handled * on insertion to the table. */ const char ***stringsPtr) /* Where to store the sorted list of strings - * that we produce. ckalloced() */ + * that we produce. Tcl_Alloced() */ { const char **strings; FOREACH_HASH_DECLS; Tcl_Obj *namePtr; void *isWanted; - int i = 0; + size_t i = 0; /* * See how many (visible) method names there are. If none, we do not (and @@ -613,7 +613,7 @@ SortMethodNames( * sorted when it is long enough to matter. */ - strings = ckalloc(sizeof(char *) * namesPtr->numEntries); + strings = Tcl_Alloc(sizeof(char *) * namesPtr->numEntries); FOREACH_HASH(namePtr, isWanted, namesPtr) { if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) { if (PTR2INT(isWanted) & NO_IMPLEMENTATION) { @@ -631,11 +631,11 @@ SortMethodNames( if (i > 0) { if (i > 1) { - qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr); + qsort((void *) strings, i, sizeof(char *), CmpStr); } *stringsPtr = strings; } else { - ckfree(strings); + Tcl_Free(strings); *stringsPtr = NULL; } return i; @@ -1034,11 +1034,11 @@ AddMethodToCallChain( if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) { callPtr->chain = - ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1)); + Tcl_Alloc(sizeof(struct MInvoke) * (callPtr->numChain + 1)); memcpy(callPtr->chain, callPtr->staticChain, sizeof(struct MInvoke) * callPtr->numChain); } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) { - callPtr->chain = ckrealloc(callPtr->chain, + callPtr->chain = Tcl_Realloc(callPtr->chain, sizeof(struct MInvoke) * (callPtr->numChain + 1)); } callPtr->chain[i].mPtr = mPtr; @@ -1227,7 +1227,7 @@ TclOOGetCallContext( doFilters = 1; } - callPtr = ckalloc(sizeof(CallChain)); + callPtr = Tcl_Alloc(sizeof(CallChain)); InitCallChain(callPtr, oPtr, flags); cb.callChainPtr = callPtr; @@ -1245,7 +1245,7 @@ TclOOGetCallContext( AddSimpleChainToCallContext(oPtr, NULL, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (callPtr->numChain == 0) { TclOODeleteChain(callPtr); return NULL; @@ -1322,7 +1322,7 @@ TclOOGetCallContext( AddSimpleChainToCallContext(oPtr, NULL, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; @@ -1332,7 +1332,7 @@ TclOOGetCallContext( if (oPtr->flags & USE_CLASS_CACHE) { if (oPtr->selfCls->classChainCache == NULL) { oPtr->selfCls->classChainCache = - ckalloc(sizeof(Tcl_HashTable)); + Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->selfCls->classChainCache); } @@ -1340,7 +1340,7 @@ TclOOGetCallContext( (char *) methodNameObj, &i); } else { if (oPtr->chainCache == NULL) { - oPtr->chainCache = ckalloc(sizeof(Tcl_HashTable)); + oPtr->chainCache = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->chainCache); } @@ -1447,7 +1447,7 @@ TclOOGetStereotypeCallChain( hPtr = NULL; } - callPtr = ckalloc(sizeof(CallChain)); + callPtr = Tcl_Alloc(sizeof(CallChain)); memset(callPtr, 0, sizeof(CallChain)); callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING); callPtr->epoch = fPtr->epoch; @@ -1494,7 +1494,7 @@ TclOOGetStereotypeCallChain( AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; @@ -1502,7 +1502,7 @@ TclOOGetStereotypeCallChain( } else { if (hPtr == NULL) { if (clsPtr->classChainCache == NULL) { - clsPtr->classChainCache = ckalloc(sizeof(Tcl_HashTable)); + clsPtr->classChainCache = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(clsPtr->classChainCache); } hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache, @@ -1919,7 +1919,7 @@ TclOOGetDefineContextNamespace( Tcl_ResetResult(interp); } if (define.list != staticSpace) { - ckfree(define.list); + Tcl_Free(define.list); } return nsPtr; } @@ -2084,11 +2084,11 @@ AddDefinitionNamespaceToChain( DefineEntry *staticList = definePtr->list; definePtr->list = - ckalloc(sizeof(DefineEntry) * definePtr->size); + Tcl_Alloc(sizeof(DefineEntry) * definePtr->size); memcpy(definePtr->list, staticList, sizeof(DefineEntry) * definePtr->num); } else { - definePtr->list = ckrealloc(definePtr->list, + definePtr->list = Tcl_Realloc(definePtr->list, sizeof(DefineEntry) * definePtr->size); } } diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 928d07e..9e47852 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -53,19 +53,19 @@ TCLAPI int Tcl_MethodIsPublic(Tcl_Method method); /* 9 */ TCLAPI int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, - ClientData *clientDataPtr); + void **clientDataPtr); /* 10 */ TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method); /* 11 */ TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - ClientData clientData); + void *clientData); /* 12 */ TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - ClientData clientData); + void *clientData); /* 13 */ TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, @@ -84,19 +84,19 @@ TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); TCLAPI int Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ -TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, +TCLAPI void * Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 20 */ TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, - ClientData metadata); + void *metadata); /* 21 */ -TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object, +TCLAPI void * Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 22 */ TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, - ClientData metadata); + void *metadata); /* 23 */ TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -136,20 +136,20 @@ typedef struct TclOOStubs { Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */ Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */ int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */ - int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */ + int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */ Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */ - Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */ - Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */ + Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 11 */ + Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 12 */ Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */ int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */ int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */ Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */ Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */ int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */ - ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ - void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */ - ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ - void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */ + void * (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ + void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */ + void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ + void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */ int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */ Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */ void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */ diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 65d6ea1..28ea4b5 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -261,7 +261,7 @@ TclOOObjectSetFilters( * No list of filters was supplied, so we're deleting filters. */ - ckfree(oPtr->filters.list); + Tcl_Free(oPtr->filters.list); oPtr->filters.list = NULL; oPtr->filters.num = 0; RecomputeClassCacheFlag(oPtr); @@ -274,9 +274,9 @@ TclOOObjectSetFilters( int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (oPtr->filters.num == 0) { - filtersList = ckalloc(size); + filtersList = Tcl_Alloc(size); } else { - filtersList = ckrealloc(oPtr->filters.list, size); + filtersList = Tcl_Realloc(oPtr->filters.list, size); } for (i=0 ; i<numFilters ; i++) { filtersList[i] = filters[i]; @@ -321,7 +321,7 @@ TclOOClassSetFilters( * No list of filters was supplied, so we're deleting filters. */ - ckfree(classPtr->filters.list); + Tcl_Free(classPtr->filters.list); classPtr->filters.list = NULL; classPtr->filters.num = 0; } else { @@ -333,9 +333,9 @@ TclOOClassSetFilters( int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (classPtr->filters.num == 0) { - filtersList = ckalloc(size); + filtersList = Tcl_Alloc(size); } else { - filtersList = ckrealloc(classPtr->filters.list, size); + filtersList = Tcl_Realloc(classPtr->filters.list, size); } for (i=0 ; i<numFilters ; i++) { filtersList[i] = filters[i]; @@ -377,7 +377,7 @@ TclOOObjectSetMixins( TclOORemoveFromInstances(oPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - ckfree(oPtr->mixins.list); + Tcl_Free(oPtr->mixins.list); oPtr->mixins.num = 0; } RecomputeClassCacheFlag(oPtr); @@ -389,10 +389,10 @@ TclOOObjectSetMixins( } TclOODecrRefCount(mixinPtr->thisPtr); } - oPtr->mixins.list = ckrealloc(oPtr->mixins.list, + oPtr->mixins.list = Tcl_Realloc(oPtr->mixins.list, sizeof(Class *) * numMixins); } else { - oPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins); + oPtr->mixins.list = Tcl_Alloc(sizeof(Class *) * numMixins); oPtr->flags &= ~USE_CLASS_CACHE; } oPtr->mixins.num = numMixins; @@ -434,7 +434,7 @@ TclOOClassSetMixins( TclOORemoveFromMixinSubs(classPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - ckfree(classPtr->mixins.list); + Tcl_Free(classPtr->mixins.list); classPtr->mixins.num = 0; } } else { @@ -443,10 +443,10 @@ TclOOClassSetMixins( TclOORemoveFromMixinSubs(classPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - classPtr->mixins.list = ckrealloc(classPtr->mixins.list, + classPtr->mixins.list = Tcl_Realloc(classPtr->mixins.list, sizeof(Class *) * numMixins); } else { - classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins); + classPtr->mixins.list = Tcl_Alloc(sizeof(Class *) * numMixins); } classPtr->mixins.num = numMixins; memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins); @@ -486,11 +486,11 @@ InstallStandardVariableMapping( } if (i != varc) { if (varc == 0) { - ckfree(vnlPtr->list); + Tcl_Free(vnlPtr->list); } else if (i) { - vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc); + vnlPtr->list = Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc); } else { - vnlPtr->list = ckalloc(sizeof(Tcl_Obj *) * varc); + vnlPtr->list = Tcl_Alloc(sizeof(Tcl_Obj *) * varc); } } vnlPtr->num = 0; @@ -511,7 +511,7 @@ InstallStandardVariableMapping( */ if (n != varc) { - vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n); + vnlPtr->list = Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * n); } Tcl_DeleteHashTable(&uniqueTable); } @@ -537,12 +537,12 @@ InstallPrivateVariableMapping( } if (i != varc) { if (varc == 0) { - ckfree(pvlPtr->list); + Tcl_Free(pvlPtr->list); } else if (i) { - pvlPtr->list = ckrealloc(pvlPtr->list, + pvlPtr->list = Tcl_Realloc(pvlPtr->list, sizeof(PrivateVariableMapping) * varc); } else { - pvlPtr->list = ckalloc(sizeof(PrivateVariableMapping) * varc); + pvlPtr->list = Tcl_Alloc(sizeof(PrivateVariableMapping) * varc); } } @@ -569,7 +569,7 @@ InstallPrivateVariableMapping( */ if (n != varc) { - pvlPtr->list = ckrealloc(pvlPtr->list, + pvlPtr->list = Tcl_Realloc(pvlPtr->list, sizeof(PrivateVariableMapping) * n); } Tcl_DeleteHashTable(&uniqueTable); @@ -689,7 +689,7 @@ TclOOUnknownDefinition( Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_HashSearch search; Tcl_HashEntry *hPtr; - int soughtLen; + size_t soughtLen; const char *soughtStr, *matchedStr = NULL; if (objc < 2) { @@ -762,7 +762,7 @@ FindCommand( Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { - int length; + size_t length; const char *nameStr, *string = TclGetStringFromObj(stringObj, &length); register Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; @@ -981,16 +981,16 @@ GenerateErrorInfo( * an object, class or class-as-object that * was being configured. */ { - int length; + size_t length; Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr) ? savedNameObj : TclOOObjectName(interp, oPtr); const char *objName = TclGetStringFromObj(realNameObj, &length); - int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; + unsigned limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in definition script for %s \"%.*s%s\" line %d)", - typeOfSubject, (overflow ? limit : length), objName, + typeOfSubject, (overflow ? limit : (unsigned)length), objName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -1478,8 +1478,8 @@ TclOODefineClassObjCmd( TclOODeleteDescendants(interp, oPtr); oPtr->flags &= ~DONT_DELETE; TclOOReleaseClassContents(interp, oPtr); - ckfree(oPtr->classPtr); - oPtr->classPtr = NULL; + Tcl_Free(oPtr->classPtr); + oPtr->classPtr = NULL; } else if (!wasClass && willBeClass) { TclOOAllocClass(interp, oPtr); } @@ -1514,7 +1514,7 @@ TclOODefineConstructorObjCmd( Object *oPtr; Class *clsPtr; Tcl_Method method; - int bodyLength; + size_t bodyLength; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arguments body"); @@ -1532,7 +1532,7 @@ TclOODefineConstructorObjCmd( } clsPtr = oPtr->classPtr; - TclGetStringFromObj(objv[2], &bodyLength); + (void)TclGetStringFromObj(objv[2], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. @@ -1725,7 +1725,7 @@ TclOODefineDestructorObjCmd( Object *oPtr; Class *clsPtr; Tcl_Method method; - int bodyLength; + size_t bodyLength; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "body"); @@ -1738,7 +1738,7 @@ TclOODefineDestructorObjCmd( } clsPtr = oPtr->classPtr; - TclGetStringFromObj(objv[1], &bodyLength); + (void)TclGetStringFromObj(objv[1], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. @@ -1823,7 +1823,7 @@ TclOODefineExportObjCmd( if (isInstanceExport) { if (!oPtr->methodsPtr) { - oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable)); + oPtr->methodsPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } @@ -1835,7 +1835,7 @@ TclOODefineExportObjCmd( } if (isNew) { - mPtr = ckalloc(sizeof(Method)); + mPtr = Tcl_Alloc(sizeof(Method)); memset(mPtr, 0, sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = objv[i]; @@ -2136,7 +2136,7 @@ TclOODefineUnexportObjCmd( if (isInstanceUnexport) { if (!oPtr->methodsPtr) { - oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable)); + oPtr->methodsPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } @@ -2148,7 +2148,7 @@ TclOODefineUnexportObjCmd( } if (isNew) { - mPtr = ckalloc(sizeof(Method)); + mPtr = Tcl_Alloc(sizeof(Method)); memset(mPtr, 0, sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = objv[i]; @@ -2557,7 +2557,7 @@ ClassSuperSet( * Allocate some working space. */ - superclasses = (Class **) ckalloc(sizeof(Class *) * superc); + superclasses = (Class **) Tcl_Alloc(sizeof(Class *) * superc); /* * Parse the arguments to get the class to use as superclasses. @@ -2567,7 +2567,7 @@ ClassSuperSet( */ if (superc == 0) { - superclasses = ckrealloc(superclasses, sizeof(Class *)); + superclasses = Tcl_Realloc(superclasses, sizeof(Class *)); if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) { superclasses[0] = oPtr->fPtr->classCls; } else { @@ -2600,7 +2600,7 @@ ClassSuperSet( for (; i > 0; i--) { TclOODecrRefCount(superclasses[i]->thisPtr); } - ckfree(superclasses); + Tcl_Free(superclasses); return TCL_ERROR; } @@ -2625,7 +2625,7 @@ ClassSuperSet( TclOORemoveFromSubclasses(oPtr->classPtr, superPtr); TclOODecrRefCount(superPtr->thisPtr); } - ckfree(oPtr->classPtr->superclasses.list); + Tcl_Free(oPtr->classPtr->superclasses.list); } oPtr->classPtr->superclasses.list = superclasses; oPtr->classPtr->superclasses.num = superc; diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index fefeb0f..faf3676 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -612,7 +612,7 @@ InfoObjectMethodsCmd( Tcl_NewStringObj(names[i], -1)); } if (numNames > 0) { - ckfree(names); + Tcl_Free(names); } } else if (oPtr->methodsPtr) { FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { @@ -1366,7 +1366,7 @@ InfoClassMethodsCmd( Tcl_NewStringObj(names[i], -1)); } if (numNames > 0) { - ckfree(names); + Tcl_Free(names); } } else { FOREACH_HASH_DECLS; diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index c1a9010..b0f022d 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -46,7 +46,7 @@ typedef struct Method { /* The type of method. If NULL, this is a * special flag record which is just used for * the setting of the flags field. */ - int refCount; + size_t refCount; void *clientData; /* Type-specific data. */ Tcl_Obj *namePtr; /* Name of the method. */ struct Object *declaringObjectPtr; @@ -65,12 +65,12 @@ typedef struct Method { * tuned in their behaviour. */ -typedef int (TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (TclOO_PreCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished); -typedef int (TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (TclOO_PostCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result); -typedef void (TclOO_PmCDDeleteProc)(ClientData clientData); -typedef ClientData (TclOO_PmCDCloneProc)(ClientData clientData); +typedef void (TclOO_PmCDDeleteProc)(void *clientData); +typedef void *(TclOO_PmCDCloneProc)(void *clientData); /* * Procedure-like methods have the following extra information. @@ -83,7 +83,7 @@ typedef struct ProcedureMethod { * includes the argument definition and the * body bytecodes. */ int flags; /* Flags to control features. */ - int refCount; + size_t refCount; void *clientData; TclOO_PmCDDeleteProc *deleteClientdataProc; TclOO_PmCDCloneProc *cloneClientdataProc; @@ -184,18 +184,18 @@ typedef struct Object { struct Class *classPtr; /* This is non-NULL for all classes, and NULL * for everything else. It points to the class * structure. */ - int refCount; /* Number of strong references to this object. + size_t refCount; /* Number of strong references to this object. * Note that there may be many more weak * references; this mechanism exists to * avoid Tcl_Preserve. */ int flags; - int creationEpoch; /* Unique value to make comparisons of objects + size_t creationEpoch; /* Unique value to make comparisons of objects * easier. */ - int epoch; /* Per-object epoch, incremented when the way + size_t epoch; /* Per-object epoch, incremented when the way * an object should resolve call chains is * changed. */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to - * the ClientData values that are the values + * the void *values that are the values * of each piece of attached metadata. This * field starts out as NULL and is only * allocated if metadata is attached. */ @@ -286,7 +286,7 @@ typedef struct Class { Method *destructorPtr; /* Method record of the class destructor (if * any). */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to - * the ClientData values that are the values + * the void *values that are the values * of each piece of attached metadata. This * field starts out as NULL and is only * allocated if metadata is attached. */ @@ -332,7 +332,7 @@ typedef struct Class { */ typedef struct ThreadLocalData { - int nsCount; /* Master epoch counter is used for keeping + size_t nsCount; /* Master epoch counter is used for keeping * the values used in Tcl_Obj internal * representations sane. Must be thread-local * because Tcl_Objs can cross interpreter @@ -356,7 +356,7 @@ typedef struct Foundation { Tcl_Namespace *helpersNs; /* Namespace containing the commands that are * only valid when executing inside a * procedural method. */ - int epoch; /* Used to invalidate method chains when the + size_t epoch; /* Used to invalidate method chains when the * class structure changes. */ ThreadLocalData *tsdPtr; /* Counter so we can allocate a unique * namespace to each object. */ @@ -390,15 +390,15 @@ struct MInvoke { }; typedef struct CallChain { - int objectCreationEpoch; /* The object's creation epoch. Note that the + size_t objectCreationEpoch; /* The object's creation epoch. Note that the * object reference is not stored in the call * chain; it is in the call context. */ - int objectEpoch; /* Local (object structure) epoch counter + size_t objectEpoch; /* Local (object structure) epoch counter * snapshot. */ - int epoch; /* Global (class structure) epoch counter + size_t epoch; /* Global (class structure) epoch counter * snapshot. */ int flags; /* Assorted flags, see below. */ - int refCount; /* Reference count. */ + size_t refCount; /* Reference count. */ int numChain; /* Size of the call chain. */ struct MInvoke *chain; /* Array of call chain entries. May point to * staticChain if the number of entries is @@ -450,64 +450,88 @@ typedef struct { */ MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); -MODULE_SCOPE int TclOODefineObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOObjDefObjCmd(ClientData clientData, +MODULE_SCOPE int TclOOObjDefObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineConstructorObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineConstructorObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineDefnNsObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineDestructorObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineExportObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineForwardObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineMethodObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineRenameMethodObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineDestructorObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineUnexportObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineExportObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineClassObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineForwardObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineMethodObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineObjSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineRenameMethodObjCmd(ClientData clientData, +MODULE_SCOPE int TclOOUnknownDefinition(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineUnexportObjCmd(ClientData clientData, +MODULE_SCOPE int TclOOCopyObjectCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineClassObjCmd(ClientData clientData, +MODULE_SCOPE int TclOONextObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData, +MODULE_SCOPE int TclOONextToObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineObjSelfObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineUnexportObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefinePrivateObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineClassObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData, +MODULE_SCOPE int TclOODefineSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOCopyObjectCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineObjSelfObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefinePrivateObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOOUnknownDefinition(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOOCopyObjectCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineDefnNsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOONextObjCmd(ClientData clientData, +MODULE_SCOPE int TclOONextObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOONextToObjCmd(ClientData clientData, +MODULE_SCOPE int TclOONextToObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData, +MODULE_SCOPE int TclOOSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); @@ -515,31 +539,31 @@ MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData, * Method implementations (in tclOOBasic.c). */ -MODULE_SCOPE int TclOO_Class_Constructor(ClientData clientData, +MODULE_SCOPE int TclOO_Class_Constructor(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_Create(ClientData clientData, +MODULE_SCOPE int TclOO_Class_Create(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_CreateNs(ClientData clientData, +MODULE_SCOPE int TclOO_Class_CreateNs(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_New(ClientData clientData, +MODULE_SCOPE int TclOO_Class_New(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Destroy(ClientData clientData, +MODULE_SCOPE int TclOO_Object_Destroy(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Eval(ClientData clientData, +MODULE_SCOPE int TclOO_Object_Eval(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_LinkVar(ClientData clientData, +MODULE_SCOPE int TclOO_Object_LinkVar(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Unknown(ClientData clientData, +MODULE_SCOPE int TclOO_Object_Unknown(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_VarName(ClientData clientData, +MODULE_SCOPE int TclOO_Object_VarName(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); @@ -589,7 +613,7 @@ MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, const char ***stringsPtr); MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp); -MODULE_SCOPE int TclOOInvokeContext(ClientData clientData, +MODULE_SCOPE int TclOOInvokeContext(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, @@ -671,9 +695,9 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); #undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */ #define DUPLICATE(target,source,type) \ do { \ - register unsigned len = sizeof(type) * ((target).num=(source).num);\ + register size_t len = sizeof(type) * ((target).num=(source).num);\ if (len != 0) { \ - memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \ + memcpy(((target).list=(type*)Tcl_Alloc(len)), (source).list, len); \ } else { \ (target).list = NULL; \ } \ diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h index 74a8d81..6a5cfd3 100644 --- a/generic/tclOOIntDecls.h +++ b/generic/tclOOIntDecls.h @@ -22,14 +22,14 @@ TCLAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - ClientData clientData, Proc **procPtrPtr); + void *clientData, Proc **procPtrPtr); /* 2 */ TCLAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - ClientData clientData, Proc **procPtrPtr); + void *clientData, Proc **procPtrPtr); /* 3 */ TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, @@ -59,19 +59,19 @@ TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, - ClientData clientData, Tcl_Obj *nameObj, - Tcl_Obj *argsObj, Tcl_Obj *bodyObj, - int flags, void **internalTokenPtr); + ProcErrorProc *errProc, void *clientData, + Tcl_Obj *nameObj, Tcl_Obj *argsObj, + Tcl_Obj *bodyObj, int flags, + void **internalTokenPtr); /* 10 */ TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, - ClientData clientData, Tcl_Obj *nameObj, - Tcl_Obj *argsObj, Tcl_Obj *bodyObj, - int flags, void **internalTokenPtr); + ProcErrorProc *errProc, void *clientData, + Tcl_Obj *nameObj, Tcl_Obj *argsObj, + Tcl_Obj *bodyObj, int flags, + void **internalTokenPtr); /* 11 */ TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, @@ -97,16 +97,16 @@ typedef struct TclOOIntStubs { void *hooks; Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */ - Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 1 */ - Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */ + Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */ + Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */ Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */ Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */ Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */ Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ - Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ - Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ + Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ + Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */ void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */ void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index db31795..fa3cd6c 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -155,19 +155,19 @@ Tcl_NewInstanceMethod( int isNew; if (nameObj == NULL) { - mPtr = ckalloc(sizeof(Method)); + mPtr = Tcl_Alloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; goto populate; } if (!oPtr->methodsPtr) { - oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable)); + oPtr->methodsPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew); if (isNew) { - mPtr = ckalloc(sizeof(Method)); + mPtr = Tcl_Alloc(sizeof(Method)); mPtr->namePtr = nameObj; mPtr->refCount = 1; Tcl_IncrRefCount(nameObj); @@ -227,14 +227,14 @@ Tcl_NewMethod( int isNew; if (nameObj == NULL) { - mPtr = ckalloc(sizeof(Method)); + mPtr = Tcl_Alloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; goto populate; } hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew); if (isNew) { - mPtr = ckalloc(sizeof(Method)); + mPtr = Tcl_Alloc(sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = nameObj; Tcl_IncrRefCount(nameObj); @@ -286,7 +286,7 @@ TclOODelMethodRef( Tcl_DecrRefCount(mPtr->namePtr); } - ckfree(mPtr); + Tcl_Free(mPtr); } } @@ -350,7 +350,7 @@ TclOONewProcInstanceMethod( if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } - pmPtr = ckalloc(sizeof(ProcedureMethod)); + pmPtr = Tcl_Alloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; @@ -359,7 +359,7 @@ TclOONewProcInstanceMethod( method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); if (method == NULL) { - ckfree(pmPtr); + Tcl_Free(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } @@ -411,7 +411,7 @@ TclOONewProcMethod( procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj)); } - pmPtr = ckalloc(sizeof(ProcedureMethod)); + pmPtr = Tcl_Alloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; @@ -424,7 +424,7 @@ TclOONewProcMethod( Tcl_DecrRefCount(argsObj); } if (method == NULL) { - ckfree(pmPtr); + Tcl_Free(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } @@ -505,12 +505,12 @@ TclOOMakeProcInstanceMethod( if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { int isNew; - CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = Tcl_Alloc(sizeof(CmdFrame)); Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; - cfPtr->line = ckalloc(sizeof(int)); + cfPtr->line = Tcl_Alloc(sizeof(int)); cfPtr->line[0] = context.line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -618,12 +618,12 @@ TclOOMakeProcMethod( if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { int isNew; - CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = Tcl_Alloc(sizeof(CmdFrame)); Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; - cfPtr->line = ckalloc(sizeof(int)); + cfPtr->line = Tcl_Alloc(sizeof(int)); cfPtr->line[0] = context.line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -993,7 +993,8 @@ ProcedureMethodCompiledVarConnect( Tcl_Obj *variableObj; PrivateVariableMapping *privateVar; Tcl_HashEntry *hPtr; - int i, isNew, cacheIt, varLen, len; + int i, isNew, cacheIt; + size_t varLen, len; const char *match, *varName; /* @@ -1100,7 +1101,7 @@ ProcedureMethodCompiledVarDelete( TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL); } Tcl_DecrRefCount(infoPtr->variableObj); - ckfree(infoPtr); + Tcl_Free(infoPtr); } static int @@ -1125,7 +1126,7 @@ ProcedureMethodCompiledVarResolver( return TCL_CONTINUE; } - infoPtr = ckalloc(sizeof(OOResVarInfo)); + infoPtr = Tcl_Alloc(sizeof(OOResVarInfo)); infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect; infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete; infoPtr->cachedObjectVar = NULL; @@ -1178,14 +1179,14 @@ RenderDeclarerName( #define LIMIT 60 #define ELLIPSIFY(str,len) \ - ((len) > LIMIT ? LIMIT : (len)), (str), ((len) > LIMIT ? "..." : "") + ((len) > LIMIT ? LIMIT : (int)(len)), (str), ((len) > LIMIT ? "..." : "") static void MethodErrorHandler( Tcl_Interp *interp, Tcl_Obj *methodNameObj) { - int nameLen, objectNameLen; + size_t nameLen, objectNameLen; CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const char *objectName, *kindName, *methodName = @@ -1203,7 +1204,7 @@ MethodErrorHandler( kindName = "class"; } - objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), + objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" method \"%.*s%s\" line %d)", @@ -1220,7 +1221,7 @@ ConstructorErrorHandler( Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; Object *declarerPtr; const char *objectName, *kindName; - int objectNameLen; + size_t objectNameLen; if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; @@ -1233,7 +1234,7 @@ ConstructorErrorHandler( kindName = "class"; } - objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), + objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" constructor line %d)", kindName, @@ -1249,7 +1250,7 @@ DestructorErrorHandler( Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; Object *declarerPtr; const char *objectName, *kindName; - int objectNameLen; + size_t objectNameLen; if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; @@ -1262,7 +1263,7 @@ DestructorErrorHandler( kindName = "class"; } - objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), + objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" destructor line %d)", kindName, @@ -1287,7 +1288,7 @@ DeleteProcedureMethodRecord( if (pmPtr->deleteClientdataProc) { pmPtr->deleteClientdataProc(pmPtr->clientData); } - ckfree(pmPtr); + Tcl_Free(pmPtr); } static void @@ -1345,7 +1346,7 @@ CloneProcedureMethod( * record. */ - pm2Ptr = ckalloc(sizeof(ProcedureMethod)); + pm2Ptr = Tcl_Alloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; Tcl_IncrRefCount(argsObj); @@ -1354,7 +1355,7 @@ CloneProcedureMethod( &pm2Ptr->procPtr) != TCL_OK) { Tcl_DecrRefCount(argsObj); Tcl_DecrRefCount(bodyObj); - ckfree(pm2Ptr); + Tcl_Free(pm2Ptr); return TCL_ERROR; } Tcl_DecrRefCount(argsObj); @@ -1399,7 +1400,7 @@ TclOONewForwardInstanceMethod( return NULL; } - fmPtr = ckalloc(sizeof(ForwardMethod)); + fmPtr = Tcl_Alloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, @@ -1438,7 +1439,7 @@ TclOONewForwardMethod( return NULL; } - fmPtr = ckalloc(sizeof(ForwardMethod)); + fmPtr = Tcl_Alloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, @@ -1519,7 +1520,7 @@ DeleteForwardMethod( ForwardMethod *fmPtr = clientData; Tcl_DecrRefCount(fmPtr->prefixObj); - ckfree(fmPtr); + Tcl_Free(fmPtr); } static int @@ -1529,7 +1530,7 @@ CloneForwardMethod( void **newClientData) { ForwardMethod *fmPtr = clientData; - ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod)); + ForwardMethod *fm2Ptr = Tcl_Alloc(sizeof(ForwardMethod)); fm2Ptr->prefixObj = fmPtr->prefixObj; Tcl_IncrRefCount(fm2Ptr->prefixObj); diff --git a/generic/tclObj.c b/generic/tclObj.c index 3385c0d..d6a6c80 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -58,7 +58,7 @@ char tclEmptyString = '\0'; * for sanity checking purposes. */ -typedef struct ObjData { +typedef struct { Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */ const char *file; /* The name of the source file calling this * function; used for debugging. */ @@ -178,7 +178,7 @@ static Tcl_ThreadDataKey pendingObjDataKey; #define PACK_BIGNUM(bignum, objPtr) \ if ((bignum).used > 0x7fff) { \ - mp_int *temp = (void *) ckalloc(sizeof(mp_int)); \ + mp_int *temp = (void *) Tcl_Alloc(sizeof(mp_int)); \ *temp = bignum; \ (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ @@ -186,7 +186,7 @@ static Tcl_ThreadDataKey pendingObjDataKey; if ((bignum).alloc > 0x7fff) { \ mp_shrink(&(bignum)); \ } \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (bignum).dp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \ | ((bignum).alloc << 15) | ((bignum).used)); \ } @@ -211,9 +211,6 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) -static void UpdateStringOfOldInt(Tcl_Obj *objPtr); -#endif static void FreeBignum(Tcl_Obj *objPtr); static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void UpdateStringOfBignum(Tcl_Obj *objPtr); @@ -242,17 +239,8 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); * implementations. */ -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -static const Tcl_ObjType oldBooleanType = { - "boolean", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - NULL, /* updateStringProc */ - TclSetBooleanFromAny /* setFromAnyProc */ -}; -#endif const Tcl_ObjType tclBooleanType = { - "booleanString", /* name */ + "boolean", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ @@ -266,25 +254,12 @@ const Tcl_ObjType tclDoubleType = { SetDoubleFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclIntType = { -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG) "int", /* name */ -#else - "wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/ -#endif NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) -static const Tcl_ObjType oldIntType = { - "int", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - UpdateStringOfOldInt, /* updateStringProc */ - SetIntFromAny /* setFromAnyProc */ -}; -#endif const Tcl_ObjType tclBignumType = { "bignum", /* name */ FreeBignum, /* freeIntRepProc */ @@ -350,17 +325,17 @@ typedef struct ResolvedCmdName { * reference (not the namespace that contains * the referenced command). NULL if the name * is fully qualified.*/ - unsigned long refNsId; /* refNsPtr's unique namespace id. Used to + size_t refNsId; /* refNsPtr's unique namespace id. Used to * verify that refNsPtr is still valid (e.g., * it's possible that the cmd's containing * namespace was deleted and a new one created * at the same address). */ - unsigned int refNsCmdEpoch; /* Value of the referencing namespace's + size_t refNsCmdEpoch; /* Value of the referencing namespace's * cmdRefEpoch when the pointer was cached. * Before using the cached pointer, we check * if the namespace's epoch was incremented; * if so, this cached pointer is invalid. */ - unsigned int cmdEpoch; /* Value of the command's cmdEpoch when this + size_t cmdEpoch; /* Value of the command's cmdEpoch when this * pointer was cached. Before using the cached * pointer, we check if the cmd's epoch was * incremented; if so, the cmd was renamed, @@ -409,15 +384,6 @@ TclInitObjSubsystem(void) Tcl_RegisterObjType(&tclRegexpType); Tcl_RegisterObjType(&tclProcBodyType); - /* For backward compatibility only ... */ -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - Tcl_RegisterObjType(&tclIntType); -#if !defined(TCL_WIDE_INT_IS_LONG) - Tcl_RegisterObjType(&oldIntType); -#endif - Tcl_RegisterObjType(&oldBooleanType); -#endif - #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); tclObjsAlloced = 0; @@ -465,12 +431,12 @@ TclFinalizeThreadObjects(void) ObjData *objData = Tcl_GetHashValue(hPtr); if (objData != NULL) { - ckfree(objData); + Tcl_Free(objData); } } Tcl_DeleteHashTable(tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); tsdPtr->objThreadMap = NULL; } #endif @@ -546,7 +512,7 @@ TclGetContLineTable(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->lineCLPtr) { - tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable)); + tsdPtr->lineCLPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS); Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL); } @@ -581,7 +547,7 @@ TclContinuationsEnter( ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry); - ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int)); + ContLineLoc *clLocPtr = Tcl_Alloc(sizeof(ContLineLoc) + num*sizeof(int)); if (!newEntry) { /* @@ -605,7 +571,7 @@ TclContinuationsEnter( * doing. */ - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); } clLocPtr->num = num; @@ -641,7 +607,8 @@ TclContinuationsEnterDerived( int start, int *clNext) { - int length, end, num; + size_t length; + int end, num; int *wordCLLast = clNext; /* @@ -668,7 +635,7 @@ TclContinuationsEnterDerived( * better way which doesn't shimmer?) */ - TclGetStringFromObj(objPtr, &length); + (void)TclGetStringFromObj(objPtr, &length); end = start + length; /* First char after the word */ /* @@ -809,11 +776,11 @@ TclThreadFinalizeContLines( for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(tsdPtr->lineCLPtr); - ckfree(tsdPtr->lineCLPtr); + Tcl_Free(tsdPtr->lineCLPtr); tsdPtr->lineCLPtr = NULL; } @@ -1019,7 +986,7 @@ TclDbDumpActiveObjects( tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { - fprintf(outFile, "total objects: %d\n", tablePtr->numEntries); + fprintf(outFile, "total objects: %" TCL_Z_MODIFIER "u\n", tablePtr->numEntries); for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { ObjData *objData = Tcl_GetHashValue(hPtr); @@ -1083,7 +1050,7 @@ TclDbInitNewObj( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->objThreadMap == NULL) { - tsdPtr->objThreadMap = ckalloc(sizeof(Tcl_HashTable)); + tsdPtr->objThreadMap = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS); } tablePtr = tsdPtr->objThreadMap; @@ -1096,7 +1063,7 @@ TclDbInitNewObj( * Record the debugging information. */ - objData = ckalloc(sizeof(ObjData)); + objData = Tcl_Alloc(sizeof(ObjData)); objData->objPtr = objPtr; objData->file = file; objData->line = line; @@ -1221,7 +1188,7 @@ Tcl_DbNewObj( * TclAllocateFreeObjects -- * * Function to allocate a number of free Tcl_Objs. This is done using a - * single ckalloc to reduce the overhead for Tcl_Obj allocation. + * single Tcl_Alloc to reduce the overhead for Tcl_Obj allocation. * * Assumes mutex is held. * @@ -1250,12 +1217,12 @@ TclAllocateFreeObjects(void) * This has been noted by Purify to be a potential leak. The problem is * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually - * freeing the memory. TclFinalizeObjects() does not ckfree() this memory, + * freeing the memory. TclFinalizeObjects() does not Tcl_Free() this memory, * but leaves it to Tcl's memory subsystem finalization to release it. * Purify apparently can't figure that out, and fires a false alarm. */ - basePtr = ckalloc(bytesToAlloc); + basePtr = Tcl_Alloc(bytesToAlloc); prevPtr = NULL; objPtr = (Tcl_Obj *) basePtr; @@ -1330,7 +1297,7 @@ TclFreeObj( ObjData *objData = Tcl_GetHashValue(hPtr); if (objData != NULL) { - ckfree(objData); + Tcl_Free(objData); } Tcl_DeleteHashEntry(hPtr); @@ -1344,7 +1311,7 @@ TclFreeObj( * either from 1 to 0, or from 0 to -1. Falling from -1 to -2, though, * and so on, is always a sign of a botch in the caller. */ - if (objPtr->refCount < -1) { + if (objPtr->refCount == (size_t)-2) { Tcl_Panic("Reference count for %p was negative", objPtr); } /* @@ -1352,16 +1319,16 @@ TclFreeObj( * sure we do not accept a second free when falling from 0 to -1. * Skip that possibility so any double free will trigger the panic. */ - objPtr->refCount = -1; + objPtr->refCount = TCL_AUTO_LENGTH; /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) - * with 'length == -1'. + * with 'length == TCL_AUTO_LENGTH'. */ TclInvalidateStringRep(objPtr); - objPtr->length = -1; + objPtr->length = TCL_AUTO_LENGTH; if (ObjDeletePending(context)) { PushObjToDelete(context, objPtr); @@ -1374,7 +1341,7 @@ TclFreeObj( } Tcl_MutexLock(&tclObjMutex); - ckfree(objPtr); + Tcl_Free(objPtr); Tcl_MutexUnlock(&tclObjMutex); TclIncrObjsFreed(); ObjDeletionLock(context); @@ -1386,7 +1353,7 @@ TclFreeObj( TclFreeIntRep(objToFree); Tcl_MutexLock(&tclObjMutex); - ckfree(objToFree); + Tcl_Free(objToFree); Tcl_MutexUnlock(&tclObjMutex); TclIncrObjsFreed(); } @@ -1410,7 +1377,7 @@ TclFreeObj( if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } @@ -1501,7 +1468,7 @@ TclFreeObj( if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } @@ -1531,7 +1498,7 @@ int TclObjBeingDeleted( Tcl_Obj *objPtr) { - return (objPtr->length == -1); + return (objPtr->length == TCL_AUTO_LENGTH); } /* @@ -1650,7 +1617,7 @@ Tcl_GetString( objPtr->typePtr->name); } objPtr->typePtr->updateStringProc(objPtr); - if (objPtr->bytes == NULL || objPtr->length < 0 + if (objPtr->bytes == NULL || objPtr->length == TCL_AUTO_LENGTH || objPtr->bytes[objPtr->length] != '\0') { Tcl_Panic("UpdateStringProc for type '%s' " "failed to create a valid string rep", @@ -1709,7 +1676,7 @@ Tcl_GetStringFromObj( objPtr->typePtr->name); } objPtr->typePtr->updateStringProc(objPtr); - if (objPtr->bytes == NULL || objPtr->length < 0 + if (objPtr->bytes == NULL || objPtr->length == TCL_AUTO_LENGTH || objPtr->bytes[objPtr->length] != '\0') { Tcl_Panic("UpdateStringProc for type '%s' " "failed to create a valid string rep", @@ -1717,7 +1684,7 @@ Tcl_GetStringFromObj( } } if (lengthPtr != NULL) { - *lengthPtr = objPtr->length; + *lengthPtr = (objPtr->length < INT_MAX)? objPtr->length: INT_MAX; } return objPtr->bytes; } @@ -1731,15 +1698,15 @@ Tcl_GetStringFromObj( * the tools needed to set an object's string representation. The * function is determined by the arguments. * - * (objPtr->bytes != NULL && bytes != NULL) || (numBytes < 0) + * (objPtr->bytes != NULL && bytes != NULL) || (numBytes == -1) * Invalid call -- panic! * - * objPtr->bytes == NULL && bytes == NULL && numBytes >= 0 + * objPtr->bytes == NULL && bytes == NULL && numBytes != -1 * Allocation only - allocate space for (numBytes+1) chars. * store in objPtr->bytes and return. Also sets * objPtr->length to 0 and objPtr->bytes[0] to NUL. * - * objPtr->bytes == NULL && bytes != NULL && numBytes >= 0 + * objPtr->bytes == NULL && bytes != NULL && numBytes != -1 * Allocate and copy. bytes is assumed to point to chars to * copy into the string rep. objPtr->length = numBytes. Allocate * array of (numBytes + 1) chars. store in objPtr->bytes. Copy @@ -1748,7 +1715,7 @@ Tcl_GetStringFromObj( * Caller must guarantee there are numBytes chars at bytes to * be copied. * - * objPtr->bytes != NULL && bytes == NULL && numBytes >= 0 + * objPtr->bytes != NULL && bytes == NULL && numBytes != -1 * Truncate. Set objPtr->length to numBytes and * objPr->bytes[numBytes] to NUL. Caller has to guarantee * that a prior allocating call allocated enough bytes for @@ -1770,35 +1737,31 @@ char * Tcl_InitStringRep( Tcl_Obj *objPtr, /* Object whose string rep is to be set */ const char *bytes, - unsigned int numBytes) + size_t numBytes) { assert(objPtr->bytes == NULL || bytes == NULL); - if (numBytes > INT_MAX) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - /* Allocate */ if (objPtr->bytes == NULL) { /* Allocate only as empty - extend later if bytes copied */ objPtr->length = 0; if (numBytes) { - objPtr->bytes = attemptckalloc(numBytes + 1); + objPtr->bytes = Tcl_AttemptAlloc(numBytes + 1); if (objPtr->bytes == NULL) { return NULL; } if (bytes) { /* Copy */ memcpy(objPtr->bytes, bytes, numBytes); - objPtr->length = (int) numBytes; + objPtr->length = numBytes; } } else { TclInitStringRep(objPtr, NULL, 0); } } else { /* objPtr->bytes != NULL bytes == NULL - Truncate */ - objPtr->bytes = ckrealloc(objPtr->bytes, numBytes + 1); - objPtr->length = (int)numBytes; + objPtr->bytes = Tcl_Realloc(objPtr->bytes, numBytes + 1); + objPtr->length = numBytes; } /* Terminate */ @@ -1947,147 +1910,6 @@ Tcl_FreeIntRep( /* *---------------------------------------------------------------------- * - * Tcl_NewBooleanObj -- - * - * This function is normally called when not debugging: i.e., when - * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and - * initializes it from the argument boolean value. A nonzero "boolValue" - * is coerced to 1. - * - * When TCL_MEM_DEBUG is defined, this function just returns the result - * of calling the debugging version Tcl_DbNewLongObj. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_NewBooleanObj -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_NewBooleanObj( - register int boolValue) /* Boolean used to initialize new object. */ -{ - return Tcl_DbNewWideIntObj(boolValue!=0, "unknown", 0); -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_NewBooleanObj( - register int boolValue) /* Boolean used to initialize new object. */ -{ - register Tcl_Obj *objPtr; - - TclNewIntObj(objPtr, boolValue!=0); - return objPtr; -} -#endif /* TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_DbNewBooleanObj -- - * - * This function is normally called when debugging: i.e., when - * TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the - * same as the Tcl_NewBooleanObj function above except that it calls - * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the [memory active] - * command will report the correct file name and line number when - * reporting objects that haven't been freed. - * - * When TCL_MEM_DEBUG is not defined, this function just returns the - * result of calling Tcl_NewBooleanObj. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_DbNewBooleanObj -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_DbNewBooleanObj( - register int boolValue, /* Boolean used to initialize new object. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ -{ - register Tcl_Obj *objPtr; - - TclDbNewObj(objPtr, file, line); - /* Optimized TclInvalidateStringRep() */ - objPtr->bytes = NULL; - - objPtr->internalRep.wideValue = (boolValue != 0); - objPtr->typePtr = &tclIntType; - return objPtr; -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_DbNewBooleanObj( - register int boolValue, /* Boolean used to initialize new object. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ -{ - return Tcl_NewBooleanObj(boolValue); -} -#endif /* TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetBooleanObj -- - * - * Modify an object to be a boolean object and to have the specified - * boolean value. A nonzero "boolValue" is coerced to 1. - * - * Results: - * None. - * - * Side effects: - * The object's old string rep, if any, is freed. Also, any old internal - * rep is freed. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_SetBooleanObj -void -Tcl_SetBooleanObj( - register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - register int boolValue) /* Boolean used to set object's value. */ -{ - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); - } - - TclSetIntObj(objPtr, boolValue!=0); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetBooleanFromObj -- * * Attempt to return a boolean from the Tcl object "objPtr". This @@ -2111,14 +1933,10 @@ Tcl_GetBooleanFromObj( register int *boolPtr) /* Place to store resulting boolean. */ { do { - if (objPtr->typePtr == &tclIntType) { + if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) { *boolPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; } - if (objPtr->typePtr == &tclBooleanType) { - *boolPtr = objPtr->internalRep.longValue != 0; - return TCL_OK; - } if (objPtr->typePtr == &tclDoubleType) { /* * Caution: Don't be tempted to check directly for the "double" @@ -2160,12 +1978,7 @@ Tcl_GetBooleanFromObj( * * Side effects: * If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal - * representation and the type of "objPtr" is set to boolean or int/wideInt. - * - * Warning: If the returned type is "wideInt" (32-bit platforms) and your - * platform is bigendian, you cannot use internalRep.longValue to distinguish - * between false and true. On Windows and most other platforms this still will - * work fine, but basically it is non-portable. + * representation and the type of "objPtr" is set to boolean or int. * *---------------------------------------------------------------------- */ @@ -2204,7 +2017,7 @@ TclSetBooleanFromAny( badBoolean: if (interp != NULL) { - int length; + size_t length; const char *str = TclGetStringFromObj(objPtr, &length); Tcl_Obj *msg; @@ -2223,8 +2036,8 @@ ParseBoolean( { int newBool; char lowerCase[6]; - const char *str = TclGetString(objPtr); - size_t i, length = objPtr->length; + size_t i, length; + const char *str = TclGetStringFromObj(objPtr, &length); if ((length == 0) || (length > 5)) { /* @@ -2323,7 +2136,7 @@ ParseBoolean( goodBoolean: TclFreeIntRep(objPtr); - objPtr->internalRep.longValue = newBool; + objPtr->internalRep.wideValue = newBool; objPtr->typePtr = &tclBooleanType; return TCL_OK; @@ -2560,8 +2373,7 @@ SetDoubleFromAny( * UpdateStringOfDouble -- * * Update the string representation for a double-precision floating point - * object. This must obey the current tcl_precision value for - * double-to-string conversions. Note: This function does not free an + * object. Note: This function does not free an * existing old string rep so storage will be lost if this has not * already been done. * @@ -2590,112 +2402,28 @@ UpdateStringOfDouble( /* *---------------------------------------------------------------------- * - * Tcl_NewIntObj -- - * - * If a client is compiled with TCL_MEM_DEBUG defined, calls to - * Tcl_NewIntObj to create a new integer object end up calling the - * debugging function Tcl_DbNewLongObj instead. - * - * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, - * calls to Tcl_NewIntObj result in a call to one of the two - * Tcl_NewIntObj implementations below. We provide two implementations so - * that the Tcl core can be compiled to do memory debugging of the core - * even if a client does not request it for itself. - * - * Integer and long integer objects share the same "integer" type - * implementation. We store all integers as longs and Tcl_GetIntFromObj - * checks whether the current value of the long can be represented by an - * int. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_NewIntObj -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_NewIntObj( - register int intValue) /* Int used to initialize the new object. */ -{ - return Tcl_DbNewWideIntObj((long)intValue, "unknown", 0); -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_NewIntObj( - register int intValue) /* Int used to initialize the new object. */ -{ - register Tcl_Obj *objPtr; - - TclNewIntObj(objPtr, intValue); - return objPtr; -} -#endif /* if TCL_MEM_DEBUG */ -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetIntObj -- - * - * Modify an object to be an integer and to have the specified integer - * value. + * Tcl_GetIntFromObj -- * - * Results: - * None. + * Retrieve the integer value of 'objPtr'. * - * Side effects: - * The object's old string rep, if any, is freed. Also, any old internal - * rep is freed. + * Value * - *---------------------------------------------------------------------- - */ -#ifndef TCL_NO_DEPRECATED -#undef Tcl_SetIntObj -void -Tcl_SetIntObj( - register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - register int intValue) /* Integer used to set object's value. */ -{ - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); - } - - TclSetIntObj(objPtr, intValue); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- + * TCL_OK * - * Tcl_GetIntFromObj -- + * Success. * - * Attempt to return an int from the Tcl object "objPtr". If the object - * is not already an int, an attempt will be made to convert it to one. + * TCL_ERROR * - * Integer and long integer objects share the same "integer" type - * implementation. We store all integers as longs and Tcl_GetIntFromObj - * checks whether the current value of the long can be represented by an - * int. + * An error occurred during conversion or the integral value can not + * be represented as an integer (it might be too large). An error + * message is left in the interpreter's result if 'interp' is not + * NULL. * - * Results: - * The return value is a standard Tcl object result. If an error occurs - * during conversion or if the long integer held by the object can not be - * represented by an int, an error message is left in the interpreter's - * result unless "interp" is NULL. + * Effect * - * Side effects: - * If the object is not already an int, the conversion will free any old - * internal representation. + * 'objPtr' is converted to an integer if necessary if it is not one + * already. The conversion frees any previously-existing internal + * representation. * *---------------------------------------------------------------------- */ @@ -2782,19 +2510,6 @@ UpdateStringOfInt( (void) Tcl_InitStringRep(objPtr, NULL, TclFormatInt(dst, objPtr->internalRep.wideValue)); } - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) -static void -UpdateStringOfOldInt( - register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ -{ - char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); - - TclOOM(dst, TCL_INTEGER_SPACE + 1); - (void) Tcl_InitStringRep(objPtr, NULL, - TclFormatInt(dst, objPtr->internalRep.longValue)); -} -#endif /* *---------------------------------------------------------------------- @@ -2928,40 +2643,6 @@ Tcl_DbNewLongObj( /* *---------------------------------------------------------------------- * - * Tcl_SetLongObj -- - * - * Modify an object to be an integer object and to have the specified - * long integer value. - * - * Results: - * None. - * - * Side effects: - * The object's old string rep, if any, is freed. Also, any old internal - * rep is freed. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_SetLongObj -void -Tcl_SetLongObj( - register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - register long longValue) /* Long integer used to initialize the - * object's value. */ -{ - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetLongObj"); - } - - TclSetIntObj(objPtr, longValue); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetLongFromObj -- * * Attempt to return an long integer from the Tcl object "objPtr". If the @@ -3398,7 +3079,7 @@ FreeBignum( UNPACK_BIGNUM(objPtr, toFree); mp_clear(&toFree); if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) { - ckfree(objPtr->internalRep.twoPtrValue.ptr1); + Tcl_Free(objPtr->internalRep.twoPtrValue.ptr1); } objPtr->typePtr = NULL; } @@ -3846,8 +3527,7 @@ TclGetNumberFromObj( } if (objPtr->typePtr == &tclBignumType) { static Tcl_ThreadDataKey bignumKey; - mp_int *bigPtr = Tcl_GetThreadData(&bignumKey, - (int) sizeof(mp_int)); + mp_int *bigPtr = Tcl_GetThreadData(&bignumKey, sizeof(mp_int)); UNPACK_BIGNUM(objPtr, *bigPtr); *typePtr = TCL_NUMBER_BIG; @@ -3921,7 +3601,7 @@ int Tcl_IsShared( Tcl_Obj *objPtr) /* The object to test for being shared. */ { - return ((objPtr)->refCount > 1); + return ((objPtr)->refCount + 1 > 2); } /* @@ -4177,8 +3857,8 @@ AllocObjEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { - Tcl_Obj *objPtr = keyPtr; - Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry)); + Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; + Tcl_HashEntry *hPtr = Tcl_Alloc(sizeof(Tcl_HashEntry)); hPtr->key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); @@ -4209,7 +3889,7 @@ TclCompareObjKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - Tcl_Obj *objPtr1 = keyPtr; + Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; register const char *p1, *p2; register size_t l1, l2; @@ -4272,7 +3952,7 @@ TclFreeObjEntry( Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue; Tcl_DecrRefCount(objPtr); - ckfree(hPtr); + Tcl_Free(hPtr); } /* @@ -4298,10 +3978,10 @@ TclHashObjKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { - Tcl_Obj *objPtr = keyPtr; - int length; - const char *string = TclGetStringFromObj(objPtr, &length); - unsigned int result = 0; + Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; + const char *string = TclGetString(objPtr); + size_t length = objPtr->length; + TCL_HASH_TYPE result = 0; /* * I tried a zillion different hash functions and asked many other people @@ -4337,13 +4017,13 @@ TclHashObjKey( * See [tcl-Feature Request #2958832] */ - if (length > 0) { + if (length) { result = UCHAR(*string); while (--length) { result += (result << 3) + UCHAR(*++string); } } - return (TCL_HASH_TYPE) result; + return result; } /* @@ -4462,7 +4142,7 @@ SetCmdNameObj( if (resPtr) { fillPtr = resPtr; } else { - fillPtr = ckalloc(sizeof(ResolvedCmdName)); + fillPtr = Tcl_Alloc(sizeof(ResolvedCmdName)); fillPtr->refCount = 1; } @@ -4565,7 +4245,7 @@ FreeCmdNameInternalRep( Command *cmdPtr = resPtr->cmdPtr; TclCleanupCommandMacro(cmdPtr); - ckfree(resPtr); + Tcl_Free(resPtr); } objPtr->typePtr = NULL; } @@ -4714,7 +4394,7 @@ Tcl_RepresentationCmd( * "1872361827361287" */ - descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d," + descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u," " object pointer at %p", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", objv[1]->refCount, objv[1]); diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c index 8267a7d..6419d87 100644 --- a/generic/tclOptimize.c +++ b/generic/tclOptimize.c @@ -231,7 +231,7 @@ ConvertZeroEffectToNOP( && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt1AtPtr(currentInstPtr + 1)); - int numBytes; + size_t numBytes; (void) TclGetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { @@ -246,7 +246,7 @@ ConvertZeroEffectToNOP( && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt4AtPtr(currentInstPtr + 1)); - int numBytes; + size_t numBytes; (void) TclGetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { @@ -287,8 +287,6 @@ ConvertZeroEffectToNOP( case INST_INCR_ARRAY_STK: case INST_INCR_SCALAR_STK: case INST_INCR_STK: - case INST_LOR: - case INST_LAND: case INST_EQ: case INST_NEQ: case INST_LT: diff --git a/generic/tclPanic.c b/generic/tclPanic.c index e8c1e7f..277f7ad 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -15,7 +15,7 @@ #include "tclInt.h" #if defined(_WIN32) || defined(__CYGWIN__) - MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); + MODULE_SCOPE void tclWinDebugPanic(const char *format, ...); #endif /* @@ -23,11 +23,7 @@ * procedure. */ -#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8)) -static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic; -#else static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL; -#endif /* *---------------------------------------------------------------------- @@ -49,14 +45,6 @@ void Tcl_SetPanicProc( TCL_NORETURN1 Tcl_PanicProc *proc) { -#if defined(_WIN32) - /* tclWinDebugPanic only installs if there is no panicProc yet. */ - if ((proc != tclWinDebugPanic) || (panicProc == NULL)) -#elif defined(__CYGWIN__) - if (proc == NULL) - panicProc = tclWinDebugPanic; - else -#endif panicProc = proc; TclInitSubsystems(); } @@ -64,7 +52,7 @@ Tcl_SetPanicProc( /* *---------------------------------------------------------------------- * - * Tcl_PanicVA -- + * Tcl_Panic -- * * Print an error message and kill the process. * @@ -77,16 +65,25 @@ Tcl_SetPanicProc( *---------------------------------------------------------------------- */ + /* ARGSUSED */ +/* + * The following comment is here so that Coverity's static analizer knows that + * a Tcl_Panic() call can never return and avoids lots of false positives. + */ + +/* coverity[+kill] */ void -Tcl_PanicVA( - const char *format, /* Format string, suitable for passing to - * fprintf. */ - va_list argList) /* Variable argument list. */ +Tcl_Panic( + const char *format, + ...) { + va_list argList; char *arg1, *arg2, *arg3; /* Additional arguments (variable in number) * to pass to fprintf. */ char *arg4, *arg5, *arg6, *arg7, *arg8; + + va_start(argList, format); arg1 = va_arg(argList, char *); arg2 = va_arg(argList, char *); arg3 = va_arg(argList, char *); @@ -95,29 +92,28 @@ Tcl_PanicVA( arg6 = va_arg(argList, char *); arg7 = va_arg(argList, char *); arg8 = va_arg(argList, char *); + va_end (argList); if (panicProc != NULL) { panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -#ifdef _WIN32 - } else if (IsDebuggerPresent()) { - tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -#endif } else { +#if defined(_WIN32) || defined(__CYGWIN__) + tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); +#else fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); fprintf(stderr, "\n"); fflush(stderr); -#if defined(_WIN32) || defined(__CYGWIN__) +#endif # if defined(__GNUC__) __builtin_trap(); # elif defined(_WIN64) __debugbreak(); # elif defined(_MSC_VER) && defined (_M_IX86) _asm {int 3} -# else +# elif defined(_WIN32) DebugBreak(); # endif -#endif #if defined(_WIN32) ExitProcess(1); #else @@ -127,42 +123,6 @@ Tcl_PanicVA( } /* - *---------------------------------------------------------------------- - * - * Tcl_Panic -- - * - * Print an error message and kill the process. - * - * Results: - * None. - * - * Side effects: - * The process dies, entering the debugger if possible. - * - *---------------------------------------------------------------------- - */ - -/* ARGSUSED */ - -/* - * The following comment is here so that Coverity's static analizer knows that - * a Tcl_Panic() call can never return and avoids lots of false positives. - */ - -/* coverity[+kill] */ -void -Tcl_Panic( - const char *format, - ...) -{ - va_list argList; - - va_start(argList, format); - Tcl_PanicVA(format, argList); - va_end (argList); -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclParse.c b/generic/tclParse.c index ccb648c..7259567 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -119,14 +119,14 @@ const char tclCharTypeTable[] = { * Prototypes for local functions defined in this file: */ -static inline int CommandComplete(const char *script, int numBytes); -static int ParseComment(const char *src, int numBytes, +static inline int CommandComplete(const char *script, size_t numBytes); +static size_t ParseComment(const char *src, size_t numBytes, Tcl_Parse *parsePtr); -static int ParseTokens(const char *src, int numBytes, int mask, +static int ParseTokens(const char *src, size_t numBytes, int mask, int flags, Tcl_Parse *parsePtr); -static int ParseWhiteSpace(const char *src, int numBytes, +static size_t ParseWhiteSpace(const char *src, size_t numBytes, int *incompletePtr, char *typePtr); -static int ParseAllWhiteSpace(const char *src, int numBytes, +static size_t ParseAllWhiteSpace(const char *src, size_t numBytes, int *incompletePtr); /* @@ -149,7 +149,7 @@ void TclParseInit( Tcl_Interp *interp, /* Interpreter to use for error reporting */ const char *start, /* Start of string to be parsed. */ - int numBytes, /* Total number of bytes in string. If < 0, + size_t numBytes, /* Total number of bytes in string. If -1, * the script consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr) /* Points to struct to initialize */ @@ -195,19 +195,19 @@ Tcl_ParseCommand( * NULL, then no error message is provided. */ const char *start, /* First character of string containing one or * more Tcl commands. */ - register int numBytes, /* Total number of bytes in string. If < 0, + size_t numBytes, /* Total number of bytes in string. If -1, * the script consists of all bytes up to the * first null character. */ int nested, /* Non-zero means this is a nested command: * close bracket should be considered a * command terminator. If zero, then close * bracket has no special meaning. */ - register Tcl_Parse *parsePtr) + Tcl_Parse *parsePtr) /* Structure to fill in with information about * the parsed command; any previous * information in the structure is ignored. */ { - register const char *src; /* Points to current character in the + const char *src; /* Points to current character in the * command. */ char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ @@ -216,7 +216,7 @@ Tcl_ParseCommand( * command. */ const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to * point to char after terminating one. */ - int scanned; + size_t scanned; if ((start == NULL) && (numBytes != 0)) { if (interp != NULL) { @@ -225,7 +225,7 @@ Tcl_ParseCommand( } return TCL_ERROR; } - if (numBytes < 0) { + if (numBytes == TCL_AUTO_LENGTH) { numBytes = strlen(start); } TclParseInit(interp, start, numBytes, parsePtr); @@ -344,7 +344,7 @@ Tcl_ParseCommand( /* Haven't seen prefix already */ && (1 == parsePtr->numTokens - expIdx) /* Only one token */ - && (((1 == (size_t) expPtr->size) + && (((1 == expPtr->size) /* Same length as prefix */ && (expPtr->start[0] == '*'))) /* Is the prefix */ @@ -379,7 +379,8 @@ Tcl_ParseCommand( tokenPtr->size = src - tokenPtr->start; tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); if (expandWord) { - int i, isLiteral = 1; + size_t i; + int isLiteral = 1; /* * When a command includes a word that is an expanded literal; for @@ -425,7 +426,7 @@ Tcl_ParseCommand( */ while (nextElem < listEnd) { - int size; + size_t size; code = TclFindElement(NULL, nextElem, listEnd - nextElem, &elemStart, &nextElem, &size, &literal); @@ -617,10 +618,10 @@ TclIsBareword( *---------------------------------------------------------------------- */ -static int +static size_t ParseWhiteSpace( const char *src, /* First character to parse. */ - register int numBytes, /* Max number of bytes to scan. */ + size_t numBytes, /* Max number of bytes to scan. */ int *incompletePtr, /* Set this boolean memory to true if parsing * indicates an incomplete command. */ char *typePtr) /* Points to location to store character type @@ -671,17 +672,17 @@ ParseWhiteSpace( *---------------------------------------------------------------------- */ -static int +static size_t ParseAllWhiteSpace( const char *src, /* First character to parse. */ - int numBytes, /* Max number of byes to scan */ + size_t numBytes, /* Max number of byes to scan */ int *incompletePtr) /* Set true if parse is incomplete. */ { char type; const char *p = src; do { - int scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type); + size_t scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type); p += scanned; numBytes -= scanned; @@ -689,10 +690,10 @@ ParseAllWhiteSpace( return (p-src); } -int +size_t TclParseAllWhiteSpace( const char *src, /* First character to parse. */ - int numBytes) /* Max number of byes to scan */ + size_t numBytes) /* Max number of byes to scan */ { int dummy; return ParseAllWhiteSpace(src, numBytes, &dummy); @@ -723,8 +724,8 @@ TclParseAllWhiteSpace( int TclParseHex( const char *src, /* First character to parse. */ - int numBytes, /* Max number of byes to scan */ - int *resultPtr) /* Points to storage provided by caller where + size_t numBytes, /* Max number of byes to scan */ + int *resultPtr) /* Points to storage provided by caller where * the character resulting from the * conversion is to be written. */ { @@ -779,8 +780,8 @@ int TclParseBackslash( const char *src, /* Points to the backslash character of a a * backslash sequence. */ - int numBytes, /* Max number of bytes to scan. */ - int *readPtr, /* NULL, or points to storage where the number + size_t numBytes, /* Max number of bytes to scan. */ + size_t *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be @@ -790,7 +791,7 @@ TclParseBackslash( register const char *p = src+1; Tcl_UniChar unichar = 0; int result; - int count; + size_t count; char buf[TCL_UTF_MAX]; if (numBytes == 0) { @@ -964,10 +965,10 @@ TclParseBackslash( *---------------------------------------------------------------------- */ -static int +static size_t ParseComment( const char *src, /* First character to parse. */ - register int numBytes, /* Max number of bytes to scan. */ + size_t numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ @@ -976,7 +977,7 @@ ParseComment( int incomplete = parsePtr->incomplete; while (numBytes) { - int scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); + size_t scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); p += scanned; numBytes -= scanned; @@ -1040,7 +1041,7 @@ ParseComment( static int ParseTokens( register const char *src, /* First character to parse. */ - register int numBytes, /* Max number of bytes to scan. */ + size_t numBytes, /* Max number of bytes to scan. */ int mask, /* Specifies when to stop parsing. The parse * stops at the first unquoted character whose * CHAR_TYPE contains any of the bits in @@ -1280,7 +1281,7 @@ Tcl_FreeParse( * call to Tcl_ParseCommand. */ { if (parsePtr->tokenPtr != parsePtr->staticTokens) { - ckfree(parsePtr->tokenPtr); + Tcl_Free(parsePtr->tokenPtr); parsePtr->tokenPtr = parsePtr->staticTokens; } } @@ -1318,7 +1319,7 @@ Tcl_ParseVarName( * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ - register int numBytes, /* Total number of bytes in string. If < 0, + size_t numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about @@ -1336,7 +1337,7 @@ Tcl_ParseVarName( if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } - if (numBytes < 0) { + if (numBytes == TCL_AUTO_LENGTH) { numBytes = strlen(start); } @@ -1596,7 +1597,7 @@ Tcl_ParseBraces( * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ - register int numBytes, /* Total number of bytes in string. If < 0, + size_t numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ register Tcl_Parse *parsePtr, @@ -1613,12 +1614,13 @@ Tcl_ParseBraces( { Tcl_Token *tokenPtr; register const char *src; - int startIndex, level, length; + int startIndex, level; + size_t length; if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } - if (numBytes < 0) { + if (numBytes == TCL_AUTO_LENGTH) { numBytes = strlen(start); } @@ -1798,7 +1800,7 @@ Tcl_ParseQuotedString( * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ - register int numBytes, /* Total number of bytes in string. If < 0, + size_t numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ register Tcl_Parse *parsePtr, @@ -1816,7 +1818,7 @@ Tcl_ParseQuotedString( if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } - if (numBytes < 0) { + if (numBytes == TCL_AUTO_LENGTH) { numBytes = strlen(start); } @@ -1880,12 +1882,12 @@ void TclSubstParse( Tcl_Interp *interp, const char *bytes, - int numBytes, + size_t numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr) { - int length = numBytes; + size_t length = numBytes; const char *p = bytes; TclParseInit(interp, p, length, parsePtr); @@ -2142,7 +2144,7 @@ TclSubstTokens( if (isLiteral) { maxNumCL = NUM_STATIC_POS; - clPosition = ckalloc(maxNumCL * sizeof(int)); + clPosition = Tcl_Alloc(maxNumCL * sizeof(int)); } adjust = 0; @@ -2182,17 +2184,17 @@ TclSubstTokens( if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') && (tokenPtr->start[1] == '\n')) { if (isLiteral) { - int clPos; + size_t clPos; if (result == 0) { clPos = 0; } else { - TclGetStringFromObj(result, &clPos); + (void)TclGetStringFromObj(result, &clPos); } if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = ckrealloc(clPosition, + clPosition = Tcl_Realloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; @@ -2350,7 +2352,7 @@ TclSubstTokens( */ if (maxNumCL) { - ckfree(clPosition); + Tcl_Free(clPosition); } } else { Tcl_ResetResult(interp); @@ -2388,7 +2390,7 @@ TclSubstTokens( static inline int CommandComplete( const char *script, /* Script to check. */ - int numBytes) /* Number of bytes in script. */ + size_t numBytes) /* Number of bytes in script. */ { Tcl_Parse parse; const char *p, *end; @@ -2462,7 +2464,7 @@ TclObjCommandComplete( Tcl_Obj *objPtr) /* Points to object holding script to * check. */ { - int length; + size_t length; const char *script = TclGetStringFromObj(objPtr, &length); return CommandComplete(script, length); diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 0532b98..d53b05c 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -25,7 +25,7 @@ static void DupFsPathInternalRep(Tcl_Obj *srcPtr, static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); -static int FindSplitPos(const char *path, int separator); +static size_t FindSplitPos(const char *path, int separator); static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); static int MakePathFromNormalized(Tcl_Interp *interp, @@ -67,7 +67,7 @@ static const Tcl_ObjType fsPathType = { * */ -typedef struct FsPath { +typedef struct { Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this * is NULL, then this is a pure normalized, * absolute path object, in which the parent @@ -82,7 +82,7 @@ typedef struct FsPath { * below. */ ClientData nativePathPtr; /* Native representation of this path, which * is filesystem dependent. */ - int filesystemEpoch; /* Used to ensure the path representation was + size_t filesystemEpoch; /* Used to ensure the path representation was * generated during the correct filesystem * epoch. The epoch changes when * filesystem-mounts are changed. */ @@ -221,14 +221,14 @@ TclFSNormalizeAbsolutePath( /* * Need to skip '.' in the path. */ - int curLen; + size_t curLen; if (retVal == NULL) { const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - TclGetStringFromObj(retVal, &curLen); + (void)TclGetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } @@ -241,7 +241,7 @@ TclFSNormalizeAbsolutePath( } if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { Tcl_Obj *linkObj; - int curLen; + size_t curLen; char *linkStr; /* @@ -254,7 +254,7 @@ TclFSNormalizeAbsolutePath( retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - TclGetStringFromObj(retVal, &curLen); + (void)TclGetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } @@ -287,7 +287,7 @@ TclFSNormalizeAbsolutePath( const char *path = TclGetStringFromObj(retVal, &curLen); - while (--curLen >= 0) { + while (curLen-- > 0) { if (IsSeparatorOrNull(path[curLen])) { break; } @@ -320,7 +320,7 @@ TclFSNormalizeAbsolutePath( */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - int i; + size_t i; for (i = 0; i < curLen; i++) { if (linkStr[i] == '\\') { @@ -338,7 +338,7 @@ TclFSNormalizeAbsolutePath( * not the first character of the path). */ - while (--curLen >= 0) { + while (curLen-- > 0) { if (IsSeparatorOrNull(linkStr[curLen])) { if (curLen) { Tcl_SetObjLength(retVal, curLen); @@ -400,7 +400,7 @@ TclFSNormalizeAbsolutePath( */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - int len; + size_t len; const char *path = TclGetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { @@ -576,9 +576,8 @@ TclPathPart( * the standardPath code. */ - int numBytes; - const char *rest = - TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + const char *rest = TclGetString(fsPathPtr->normPathPtr); + size_t numBytes = fsPathPtr->normPathPtr->length; if (strchr(rest, '/') != NULL) { goto standardPath; @@ -614,9 +613,8 @@ TclPathPart( * we don't, and instead just use the standardPath code. */ - int numBytes; - const char *rest = - TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + const char *rest = TclGetString(fsPathPtr->normPathPtr); + size_t numBytes = fsPathPtr->normPathPtr->length; if (strchr(rest, '/') != NULL) { goto standardPath; @@ -643,7 +641,7 @@ TclPathPart( return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { const char *fileName, *extension; - int length; + size_t length; fileName = TclGetStringFromObj(fsPathPtr->normPathPtr, &length); @@ -666,7 +664,7 @@ TclPathPart( Tcl_Obj *resultPtr = TclNewFSPathObj(fsPathPtr->cwdPtr, fileName, - (int)(length - strlen(extension))); + length - strlen(extension)); Tcl_IncrRefCount(resultPtr); return resultPtr; @@ -694,7 +692,7 @@ TclPathPart( if (portion == TCL_PATH_EXTENSION) { return GetExtension(pathPtr); } else if (portion == TCL_PATH_ROOT) { - int length; + size_t length; const char *fileName, *extension; fileName = TclGetStringFromObj(pathPtr, &length); @@ -704,7 +702,7 @@ TclPathPart( return pathPtr; } else { Tcl_Obj *root = Tcl_NewStringObj(fileName, - (int) (length - strlen(extension))); + length - strlen(extension)); Tcl_IncrRefCount(root); return root; @@ -887,7 +885,7 @@ TclJoinPath( TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; - int len; + size_t len; str = TclGetStringFromObj(tailObj, &len); if (len == 0) { @@ -1102,9 +1100,9 @@ TclJoinPath( if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - TclGetStringFromObj(res, &length); + (void)TclGetStringFromObj(res, &length); } - Tcl_SetObjLength(res, length + (int) strlen(strElt)); + Tcl_SetObjLength(res, length + strlen(strElt)); ptr = TclGetString(res) + length; for (; *strElt != '\0'; strElt++) { @@ -1208,7 +1206,7 @@ IsSeparatorOrNull( * of the end of the string. */ -static int +static size_t FindSplitPos( const char *path, int separator) @@ -1262,7 +1260,7 @@ Tcl_Obj * TclNewFSPathObj( Tcl_Obj *dirPtr, const char *addStrRep, - int len) + size_t len) { FsPath *fsPathPtr; Tcl_Obj *pathPtr; @@ -1294,7 +1292,7 @@ TclNewFSPathObj( } pathPtr = Tcl_NewObj(); - fsPathPtr = ckalloc(sizeof(FsPath)); + fsPathPtr = Tcl_Alloc(sizeof(FsPath)); /* * Set up the path. @@ -1319,12 +1317,12 @@ TclNewFSPathObj( * things as needing more aggressive normalization that don't actually * need it. No harm done. */ - for (p = addStrRep; len > 0; p++, len--) { + for (p = addStrRep; len+1 > 1; p++, len--) { switch (state) { case 0: /* So far only "." since last dirsep or start */ switch (*p) { case '.': - count++; + count = 1; break; case '/': case '\\': @@ -1361,7 +1359,6 @@ AppendPath( Tcl_Obj *head, Tcl_Obj *tail) { - int numBytes; const char *bytes; Tcl_Obj *copy = Tcl_DuplicateObj(head); @@ -1373,8 +1370,8 @@ AppendPath( * intrep produce the same results; that is, bugward compatibility. If * we need to fix that bug here, it needs fixing in TclJoinPath() too. */ - bytes = TclGetStringFromObj(tail, &numBytes); - if (numBytes == 0) { + bytes = TclGetString(tail); + if (tail->length == 0) { Tcl_AppendToObj(copy, "/", 1); } else { TclpNativeJoinPath(copy, bytes); @@ -1487,7 +1484,7 @@ MakePathFromNormalized( return TCL_OK; } - fsPathPtr = ckalloc(sizeof(FsPath)); + fsPathPtr = Tcl_Alloc(sizeof(FsPath)); /* * It's a pure normalized absolute path. @@ -1522,7 +1519,7 @@ MakePathFromNormalized( * Any memory which is allocated for 'clientData' should be retained * until clientData is passed to the filesystem's freeInternalRepProc * when it can be freed. The built in platform-specific filesystems use - * 'ckalloc' to allocate clientData, and ckfree to free it. + * 'Tcl_Alloc' to allocate clientData, and Tcl_Free to free it. * * Results: * NULL or a valid path object pointer, with refCount zero. @@ -1555,7 +1552,7 @@ Tcl_FSNewNativePath( */ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); - fsPathPtr = ckalloc(sizeof(FsPath)); + fsPathPtr = Tcl_Alloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; @@ -1682,7 +1679,7 @@ Tcl_FSGetTranslatedStringPath( if (transPtr != NULL) { int len; const char *orig = TclGetStringFromObj(transPtr, &len); - char *result = ckalloc(len+1); + char *result = Tcl_Alloc(len+1); memcpy(result, orig, (size_t) len+1); TclDecrRefCount(transPtr); @@ -1740,7 +1737,7 @@ Tcl_FSGetNormalizedPath( /* TODO: Figure out why this is needed. */ TclGetString(pathPtr); - TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); + (void)TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); if (tailLen) { copy = AppendPath(dir, fsPathPtr->normPathPtr); } else { @@ -1840,7 +1837,7 @@ Tcl_FSGetNormalizedPath( } fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { - int cwdLen; + size_t cwdLen; Tcl_Obj *copy; copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); @@ -2187,7 +2184,8 @@ Tcl_FSEqualPaths( Tcl_Obj *secondPtr) { const char *firstStr, *secondStr; - int firstLen, secondLen, tempErrno; + size_t firstLen, secondLen; + int tempErrno; if (firstPtr == secondPtr) { return 1; @@ -2246,7 +2244,7 @@ SetFsPathFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { - int len; + size_t len; FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; @@ -2278,7 +2276,7 @@ SetFsPathFromAny( if (len && name[0] == '~') { Tcl_DString temp; - int split; + size_t split; char separator = '/'; /* @@ -2392,7 +2390,7 @@ SetFsPathFromAny( * slashes on Windows, and will not contain any ~user sequences. */ - fsPathPtr = ckalloc(sizeof(FsPath)); + fsPathPtr = Tcl_Alloc(sizeof(FsPath)); if (transPtr == pathPtr) { transPtr = Tcl_DuplicateObj(pathPtr); @@ -2443,7 +2441,7 @@ FreeFsPathInternalRep( } } - ckfree(fsPathPtr); + Tcl_Free(fsPathPtr); } static void @@ -2452,7 +2450,7 @@ DupFsPathInternalRep( Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */ { FsPath *srcFsPathPtr = PATHOBJ(srcPtr); - FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath)); + FsPath *copyFsPathPtr = Tcl_Alloc(sizeof(FsPath)); SETPATHOBJ(copyPtr, copyFsPathPtr); @@ -2512,7 +2510,7 @@ UpdateStringOfFsPath( register Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); - int cwdLen; + size_t cwdLen; Tcl_Obj *copy; if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { @@ -2586,7 +2584,7 @@ TclNativePathInFilesystem( * situation. */ - int len; + size_t len; (void) TclGetStringFromObj(pathPtr, &len); if (len == 0) { diff --git a/generic/tclPipe.c b/generic/tclPipe.c index f94fe5c..8f51383 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -188,7 +188,7 @@ Tcl_DetachPids( Tcl_MutexLock(&pipeMutex); for (i = 0; i < numPids; i++) { - detPtr = ckalloc(sizeof(Detached)); + detPtr = Tcl_Alloc(sizeof(Detached)); detPtr->pid = pidPtr[i]; detPtr->nextPtr = detList; detList = detPtr; @@ -238,7 +238,7 @@ Tcl_ReapDetachedProcs(void) } else { prevPtr->nextPtr = detPtr->nextPtr; } - ckfree(detPtr); + Tcl_Free(detPtr); detPtr = nextPtr; } Tcl_MutexUnlock(&pipeMutex); @@ -336,7 +336,7 @@ TclCleanupChildren( Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET); objPtr = Tcl_NewObj(); count = Tcl_ReadChars(errorChan, objPtr, -1, 0); - if (count < 0) { + if (count == -1) { result = TCL_ERROR; Tcl_DecrRefCount(objPtr); Tcl_ResetResult(interp); @@ -824,7 +824,7 @@ TclCreatePipeline( */ Tcl_ReapDetachedProcs(); - pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid)); + pidPtr = Tcl_Alloc(cmdCount * sizeof(Tcl_Pid)); curInFile = inputFile; @@ -978,7 +978,7 @@ TclCreatePipeline( Tcl_DetachPids(1, &pidPtr[i]); } } - ckfree(pidPtr); + Tcl_Free(pidPtr); } numPids = -1; goto cleanup; @@ -1082,7 +1082,7 @@ Tcl_OpenCommandChannel( error: if (numPids > 0) { Tcl_DetachPids(numPids, pidPtr); - ckfree(pidPtr); + Tcl_Free(pidPtr); } if (inPipe != NULL) { TclpCloseFile(inPipe); diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 2c16458..ed04cb1 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -55,7 +55,7 @@ typedef struct PkgFiles { * "Tk" (no version number). */ -typedef struct Package { +typedef struct { char *version; /* Version that has been supplied in this * interpreter via "package provide" * (malloc'ed). NULL means the package doesn't @@ -112,7 +112,7 @@ static int TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int */ #define DupBlock(v,s,len) \ - ((v) = ckalloc(len), memcpy((v),(s),(len))) + ((v) = Tcl_Alloc(len), memcpy((v),(s),(len))) #define DupString(v,s) \ do { \ size_t local__len = strlen(s) + 1; \ @@ -175,13 +175,13 @@ Tcl_PkgProvideEx( NULL) != TCL_OK) { return TCL_ERROR; } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) { - ckfree(pvi); + Tcl_Free(pvi); return TCL_ERROR; } res = CompareVersions(pvi, vi, NULL); - ckfree(pvi); - ckfree(vi); + Tcl_Free(pvi); + Tcl_Free(vi); if (res == 0) { if (clientData != NULL) { @@ -233,7 +233,7 @@ static void PkgFilesCleanupProc(ClientData clientData, while (pkgFiles->names) { PkgName *name = pkgFiles->names; pkgFiles->names = name->nextPtr; - ckfree(name); + Tcl_Free(name); } entry = Tcl_FirstHashEntry(&pkgFiles->table, &search); while (entry) { @@ -242,7 +242,7 @@ static void PkgFilesCleanupProc(ClientData clientData, entry = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&pkgFiles->table); - ckfree(pkgFiles); + Tcl_Free(pkgFiles); return; } @@ -251,7 +251,7 @@ void *TclInitPkgFiles(Tcl_Interp *interp) /* If assocdata "tclPkgFiles" doesn't exist yet, create it */ PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); if (!pkgFiles) { - pkgFiles = ckalloc(sizeof(PkgFiles)); + pkgFiles = Tcl_Alloc(sizeof(PkgFiles)); pkgFiles->names = NULL; Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS); Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles); @@ -445,7 +445,7 @@ PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result) if (code != TCL_OK) { return code; } - reqPtr = ckalloc(sizeof(Require)); + reqPtr = Tcl_Alloc(sizeof(Require)); Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL); reqPtr->clientDataPtr = data[3]; reqPtr->name = name; @@ -543,7 +543,7 @@ PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) { CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pkgVersionI, NULL); satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv); - ckfree(pkgVersionI); + Tcl_Free(pkgVersionI); if (!satisfies) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -567,7 +567,7 @@ PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) { static int PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) { - ckfree(data[0]); + Tcl_Free(data[0]); return result; } @@ -629,7 +629,7 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { if (reqc > 0) { satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv); if (!satisfies) { - ckfree(availVersion); + Tcl_Free(availVersion); availVersion = NULL; continue; } @@ -647,7 +647,7 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { * The version of the package sought is better than the * currently selected version. */ - ckfree(bestVersion); + Tcl_Free(bestVersion); bestVersion = NULL; goto newbest; } @@ -660,7 +660,7 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { } if (!availStable) { - ckfree(availVersion); + Tcl_Free(availVersion); availVersion = NULL; continue; } @@ -677,7 +677,7 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { * This stable version of the package sought is better * than the currently selected stable version. */ - ckfree(bestStableVersion); + Tcl_Free(bestStableVersion); bestStableVersion = NULL; goto newstable; } @@ -688,7 +688,7 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL); } - ckfree(availVersion); + Tcl_Free(availVersion); availVersion = NULL; } /* end for */ @@ -697,12 +697,12 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { */ if (bestVersion != NULL) { - ckfree(bestVersion); + Tcl_Free(bestVersion); bestVersion = NULL; } if (bestStableVersion != NULL) { - ckfree(bestStableVersion); + Tcl_Free(bestStableVersion); bestStableVersion = NULL; } @@ -736,7 +736,7 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { pkgFiles = TclInitPkgFiles(interp); /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */ - pkgName = ckalloc(sizeof(PkgName) + strlen(name)); + pkgName = Tcl_Alloc(sizeof(PkgName) + strlen(name)); pkgName->nextPtr = pkgFiles->names; strcpy(pkgName->name, name); pkgFiles->names = pkgName; @@ -762,7 +762,7 @@ SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) { PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); PkgName *pkgName = pkgFiles->names; pkgFiles->names = pkgName->nextPtr; - ckfree(pkgName); + Tcl_Free(pkgName); reqPtr->pkgPtr = FindPackage(interp, name); if (result == TCL_OK) { @@ -783,13 +783,13 @@ SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) { result = TCL_ERROR; } else if (CheckVersionAndConvert(interp, versionToProvide, &vi, NULL) != TCL_OK) { - ckfree(pvi); + Tcl_Free(pvi); result = TCL_ERROR; } else { int res = CompareVersions(pvi, vi, NULL); - ckfree(pvi); - ckfree(vi); + Tcl_Free(pvi); + Tcl_Free(vi); if (res != 0) { result = TCL_ERROR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -834,7 +834,7 @@ SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) { */ if (reqPtr->pkgPtr->version != NULL) { - ckfree(reqPtr->pkgPtr->version); + Tcl_Free(reqPtr->pkgPtr->version); reqPtr->pkgPtr->version = NULL; } reqPtr->pkgPtr->clientData = NULL; @@ -1036,7 +1036,7 @@ TclNRPackageObjCmd( pkgPtr = Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (pkgPtr->version != NULL) { - ckfree(pkgPtr->version); + Tcl_Free(pkgPtr->version); } while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; @@ -1047,14 +1047,15 @@ TclNRPackageObjCmd( Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); availPtr->pkgIndex = NULL; } - ckfree(availPtr); + Tcl_Free(availPtr); } - ckfree(pkgPtr); + Tcl_Free(pkgPtr); } break; } case PKG_IFNEEDED: { - int length, res; + size_t length; + int res; char *argv3i, *avi; if ((objc != 4) && (objc != 5)) { @@ -1069,7 +1070,7 @@ TclNRPackageObjCmd( if (objc == 4) { hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr == NULL) { - ckfree(argv3i); + Tcl_Free(argv3i); return TCL_OK; } pkgPtr = Tcl_GetHashValue(hPtr); @@ -1082,16 +1083,16 @@ TclNRPackageObjCmd( prevPtr = availPtr, availPtr = availPtr->nextPtr) { if (CheckVersionAndConvert(interp, availPtr->version, &avi, NULL) != TCL_OK) { - ckfree(argv3i); + Tcl_Free(argv3i); return TCL_ERROR; } res = CompareVersions(avi, argv3i, NULL); - ckfree(avi); + Tcl_Free(avi); if (res == 0){ if (objc == 4) { - ckfree(argv3i); + Tcl_Free(argv3i); Tcl_SetObjResult(interp, Tcl_NewStringObj(availPtr->script, -1)); return TCL_OK; @@ -1104,15 +1105,15 @@ TclNRPackageObjCmd( break; } } - ckfree(argv3i); + Tcl_Free(argv3i); if (objc == 4) { return TCL_OK; } if (availPtr == NULL) { - availPtr = ckalloc(sizeof(PkgAvail)); + availPtr = Tcl_Alloc(sizeof(PkgAvail)); availPtr->pkgIndex = NULL; - DupBlock(availPtr->version, argv3, (unsigned) length + 1); + DupBlock(availPtr->version, argv3, length + 1); if (prevPtr == NULL) { availPtr->nextPtr = pkgPtr->availPtr; @@ -1124,10 +1125,10 @@ TclNRPackageObjCmd( } if (iPtr->scriptFile) { argv4 = TclGetStringFromObj(iPtr->scriptFile, &length); - DupBlock(availPtr->pkgIndex, argv4, (unsigned) length + 1); + DupBlock(availPtr->pkgIndex, argv4, length + 1); } argv4 = TclGetStringFromObj(objv[4], &length); - DupBlock(availPtr->script, argv4, (unsigned) length + 1); + DupBlock(availPtr->script, argv4, length + 1); break; } case PKG_NAMES: @@ -1286,7 +1287,7 @@ TclNRPackageObjCmd( } break; case PKG_UNKNOWN: { - int length; + size_t length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { @@ -1295,13 +1296,13 @@ TclNRPackageObjCmd( } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { - ckfree(iPtr->packageUnknown); + Tcl_Free(iPtr->packageUnknown); } argv2 = TclGetStringFromObj(objv[2], &length); if (argv2[0] == 0) { iPtr->packageUnknown = NULL; } else { - DupBlock(iPtr->packageUnknown, argv2, (unsigned) length+1); + DupBlock(iPtr->packageUnknown, argv2, length+1); } } else { Tcl_WrongNumArgs(interp, 2, objv, "?command?"); @@ -1356,7 +1357,7 @@ TclNRPackageObjCmd( if (CheckVersionAndConvert(interp, argv2, &iva, NULL) != TCL_OK || CheckVersionAndConvert(interp, argv3, &ivb, NULL) != TCL_OK) { if (iva != NULL) { - ckfree(iva); + Tcl_Free(iva); } /* @@ -1372,8 +1373,8 @@ TclNRPackageObjCmd( Tcl_SetObjResult(interp, Tcl_NewIntObj(CompareVersions(iva, ivb, NULL))); - ckfree(iva); - ckfree(ivb); + Tcl_Free(iva); + Tcl_Free(ivb); break; case PKG_VERSIONS: if (objc != 3) { @@ -1407,12 +1408,12 @@ TclNRPackageObjCmd( if (CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK) { return TCL_ERROR; } else if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) { - ckfree(argv2i); + Tcl_Free(argv2i); return TCL_ERROR; } satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3); - ckfree(argv2i); + Tcl_Free(argv2i); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies)); break; @@ -1460,7 +1461,7 @@ FindPackage( hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew); if (isNew) { - pkgPtr = ckalloc(sizeof(Package)); + pkgPtr = Tcl_Alloc(sizeof(Package)); pkgPtr->version = NULL; pkgPtr->availPtr = NULL; pkgPtr->clientData = NULL; @@ -1501,7 +1502,7 @@ TclFreePackageInfo( hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { pkgPtr = Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { - ckfree(pkgPtr->version); + Tcl_Free(pkgPtr->version); } while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; @@ -1512,13 +1513,13 @@ TclFreePackageInfo( Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); availPtr->pkgIndex = NULL; } - ckfree(availPtr); + Tcl_Free(availPtr); } - ckfree(pkgPtr); + Tcl_Free(pkgPtr); } Tcl_DeleteHashTable(&iPtr->packageTable); if (iPtr->packageUnknown != NULL) { - ckfree(iPtr->packageUnknown); + Tcl_Free(iPtr->packageUnknown); } } @@ -1558,7 +1559,7 @@ CheckVersionAndConvert( * 4* assuming that each char is a separator (a,b become ' -x '). * 4+ to have spce for an additional -2 at the end */ - char *ibuf = ckalloc(4 + 4*strlen(string)); + char *ibuf = Tcl_Alloc(4 + 4*strlen(string)); char *ip = ibuf; /* @@ -1626,7 +1627,7 @@ CheckVersionAndConvert( if (internal != NULL) { *internal = ibuf; } else { - ckfree(ibuf); + Tcl_Free(ibuf); } if (stable != NULL) { *stable = !hasunstable; @@ -1635,7 +1636,7 @@ CheckVersionAndConvert( } error: - ckfree(ibuf); + Tcl_Free(ibuf); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected version number but got \"%s\"", string)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL); @@ -1909,7 +1910,7 @@ CheckRequirement( * Exactly one dash is present. Copy the string, split at the location of * dash and check that both parts are versions. Note that the max part can * be empty. Also note that the string allocated with strdup() must be - * freed with free() and not ckfree(). + * freed with free() and not Tcl_Free(). */ DupString(buf, string); @@ -1920,11 +1921,11 @@ CheckRequirement( if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) || ((*dash != '\0') && (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) { - ckfree(buf); + Tcl_Free(buf); return TCL_ERROR; } - ckfree(buf); + Tcl_Free(buf); return TCL_OK; } @@ -1953,7 +1954,8 @@ AddRequirementsToResult( * available. */ { Tcl_Obj *result = Tcl_GetObjResult(interp); - int i, length; + int i; + size_t length; for (i = 0; i < reqc; i++) { const char *v = TclGetStringFromObj(reqv[i], &length); @@ -2089,7 +2091,7 @@ RequirementSatisfied( strcat(reqi, " -2"); res = CompareVersions(havei, reqi, &thisIsMajor); satisfied = (res == 0) || ((res == 1) && !thisIsMajor); - ckfree(reqi); + Tcl_Free(reqi); return satisfied; } @@ -2113,8 +2115,8 @@ RequirementSatisfied( CheckVersionAndConvert(NULL, buf, &min, NULL); strcat(min, " -2"); satisfied = (CompareVersions(havei, min, NULL) >= 0); - ckfree(min); - ckfree(buf); + Tcl_Free(min); + Tcl_Free(buf); return satisfied; } @@ -2136,9 +2138,9 @@ RequirementSatisfied( (CompareVersions(havei, max, NULL) < 0)); } - ckfree(min); - ckfree(max); - ckfree(buf); + Tcl_Free(min); + Tcl_Free(max); + Tcl_Free(buf); return satisfied; } diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index abc8ee8..7218490 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -52,22 +52,22 @@ extern "C" { #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ -EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, +EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, size_t len, Tcl_DString *dsPtr); /* 1 */ -EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, +EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, size_t len, Tcl_DString *dsPtr); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, - int maxPathLen, char *libraryPath); + size_t maxPathLen, char *libraryPath); /* 1 */ EXTERN int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, - int hasResourceFile, int maxPathLen, + int hasResourceFile, size_t maxPathLen, char *libraryPath); #endif /* MACOSX */ @@ -76,12 +76,12 @@ typedef struct TclPlatStubs { void *hooks; #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ - TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */ - char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */ + TCHAR * (*tcl_WinUtfToTChar) (const char *str, size_t len, Tcl_DString *dsPtr); /* 0 */ + char * (*tcl_WinTCharToUtf) (const TCHAR *str, size_t len, Tcl_DString *dsPtr); /* 1 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */ - int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ + int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 0 */ + int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 1 */ #endif /* MACOSX */ } TclPlatStubs; diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c index 5c6097f..695eeb9 100644 --- a/generic/tclPreserve.c +++ b/generic/tclPreserve.c @@ -37,9 +37,9 @@ typedef struct { */ static Reference *refArray = NULL; /* First in array of references. */ -static int spaceAvl = 0; /* Total number of structures available at +static size_t spaceAvl = 0; /* Total number of structures available at * *firstRefPtr. */ -static int inUse = 0; /* Count of structures currently in use in +static size_t inUse = 0; /* Count of structures currently in use in * refArray. */ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ @@ -53,7 +53,7 @@ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ * objects that we don't want to live any longer than necessary. */ -typedef struct HandleStruct { +typedef struct { void *ptr; /* Pointer to the memory block being tracked. * This field will become NULL when the memory * block is deleted. This field must be the @@ -89,7 +89,7 @@ TclFinalizePreserve(void) { Tcl_MutexLock(&preserveMutex); if (spaceAvl != 0) { - ckfree(refArray); + Tcl_Free(refArray); refArray = NULL; inUse = 0; spaceAvl = 0; @@ -121,7 +121,7 @@ Tcl_Preserve( ClientData clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; - int i; + size_t i; /* * See if there is already a reference for this pointer. If so, just @@ -144,7 +144,7 @@ Tcl_Preserve( if (inUse == spaceAvl) { spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE; - refArray = ckrealloc(refArray, spaceAvl * sizeof(Reference)); + refArray = Tcl_Realloc(refArray, spaceAvl * sizeof(Reference)); } /* @@ -184,7 +184,7 @@ Tcl_Release( ClientData clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; - int i; + size_t i; Tcl_MutexLock(&preserveMutex); for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) { @@ -224,7 +224,7 @@ Tcl_Release( Tcl_MutexUnlock(&preserveMutex); if (mustFree) { if (freeProc == TCL_DYNAMIC) { - ckfree(clientData); + Tcl_Free(clientData); } else { freeProc(clientData); } @@ -264,7 +264,7 @@ Tcl_EventuallyFree( Tcl_FreeProc *freeProc) /* Function to actually do free. */ { Reference *refPtr; - int i; + size_t i; /* * See if there is a reference for this pointer. If so, set its "mustFree" @@ -291,7 +291,7 @@ Tcl_EventuallyFree( */ if (freeProc == TCL_DYNAMIC) { - ckfree(clientData); + Tcl_Free(clientData); } else { freeProc(clientData); } @@ -327,7 +327,7 @@ TclHandleCreate( * be tracked for deletion. Must not be * NULL. */ { - HandleStruct *handlePtr = ckalloc(sizeof(HandleStruct)); + HandleStruct *handlePtr = Tcl_Alloc(sizeof(HandleStruct)); handlePtr->ptr = ptr; #ifdef TCL_MEM_DEBUG @@ -377,7 +377,7 @@ TclHandleFree( #endif handlePtr->ptr = NULL; if (handlePtr->refCount == 0) { - ckfree(handlePtr); + Tcl_Free(handlePtr); } } @@ -460,7 +460,7 @@ TclHandleRelease( } #endif if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) { - ckfree(handlePtr); + Tcl_Free(handlePtr); } } diff --git a/generic/tclProc.c b/generic/tclProc.c index 8580359..0de0dd6 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -263,11 +263,11 @@ Tcl_ProcObjCmd( && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) { int isNew; Tcl_HashEntry *hePtr; - CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = Tcl_Alloc(sizeof(CmdFrame)); cfPtr->level = -1; cfPtr->type = contextPtr->type; - cfPtr->line = ckalloc(sizeof(int)); + cfPtr->line = Tcl_Alloc(sizeof(int)); cfPtr->line[0] = contextPtr->line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -295,9 +295,9 @@ Tcl_ProcObjCmd( Tcl_DecrRefCount(cfOldPtr->data.eval.path); cfOldPtr->data.eval.path = NULL; } - ckfree(cfOldPtr->line); + Tcl_Free(cfOldPtr->line); cfOldPtr->line = NULL; - ckfree(cfOldPtr); + Tcl_Free(cfOldPtr); } Tcl_SetHashValue(hePtr, cfPtr); } @@ -340,7 +340,7 @@ Tcl_ProcObjCmd( } if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) { - int numBytes; + size_t numBytes; procArgs +=4; while (*procArgs != '\0') { @@ -354,7 +354,8 @@ Tcl_ProcObjCmd( * The argument list is just "args"; check the body */ - procBody = TclGetStringFromObj(objv[3], &numBytes); + procBody = TclGetString(objv[3]); + numBytes = objv[3]->length; if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) { goto done; } @@ -406,7 +407,8 @@ TclCreateProc( Interp *iPtr = (Interp *) interp; register Proc *procPtr = NULL; - int i, result, numArgs, plen; + int i, result, numArgs; + size_t plen; const char *bytes, *argname, *argnamei; char argnamelast; register CompiledLocal *localPtr = NULL; @@ -447,7 +449,7 @@ TclCreateProc( */ if (Tcl_IsShared(bodyPtr)) { - int length; + size_t length; Tcl_Obj *sharedBodyPtr = bodyPtr; bytes = TclGetStringFromObj(bodyPtr, &length); @@ -470,7 +472,7 @@ TclCreateProc( Tcl_IncrRefCount(bodyPtr); - procPtr = ckalloc(sizeof(Proc)); + procPtr = Tcl_Alloc(sizeof(Proc)); procPtr->iPtr = iPtr; procPtr->refCount = 1; procPtr->bodyPtr = bodyPtr; @@ -540,7 +542,7 @@ TclCreateProc( goto procError; } - argname = Tcl_GetStringFromObj(fieldValues[0], &plen); + argname = TclGetStringFromObj(fieldValues[0], &plen); nameLength = Tcl_NumUtfChars(argname, plen); if (fieldCount == 2) { const char * value = TclGetString(fieldValues[1]); @@ -638,7 +640,7 @@ TclCreateProc( * local variables for the argument. */ - localPtr = ckalloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1); + localPtr = Tcl_Alloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { @@ -684,9 +686,9 @@ TclCreateProc( Tcl_DecrRefCount(defPtr); } - ckfree(localPtr); + Tcl_Free(localPtr); } - ckfree(procPtr); + Tcl_Free(procPtr); } return TCL_ERROR; } @@ -1059,11 +1061,7 @@ ProcWrongNumArgs( if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { -#ifdef AVOID_HACKS_FOR_ITCL desiredObjs[0] = framePtr->objv[skip-1]; -#else - desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); -#endif /* AVOID_HACKS_FOR_ITCL */ } Tcl_IncrRefCount(desiredObjs[0]); @@ -1203,7 +1201,7 @@ InitResolvedLocals( if (localPtr->resolveInfo->deleteProc) { localPtr->resolveInfo->deleteProc(localPtr->resolveInfo); } else { - ckfree(localPtr->resolveInfo); + Tcl_Free(localPtr->resolveInfo); } localPtr->resolveInfo = NULL; } @@ -1289,7 +1287,7 @@ TclFreeLocalCache( TclReleaseLiteral(interp, objPtr); } } - ckfree(localCachePtr); + Tcl_Free(localCachePtr); } static void @@ -1315,7 +1313,7 @@ InitLocalCache( * for future calls. */ - localCachePtr = ckalloc(sizeof(LocalCache) + localCachePtr = Tcl_Alloc(sizeof(LocalCache) + (localCt - 1) * sizeof(Tcl_Obj *) + numArgs * sizeof(Var)); @@ -1327,7 +1325,7 @@ InitLocalCache( *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, - localPtr->nameLength, /* hash */ (unsigned int) -1, + localPtr->nameLength, /* hash */ -1, &new, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } @@ -2000,10 +1998,10 @@ TclProcCompileProc( if (toFree->resolveInfo->deleteProc) { toFree->resolveInfo->deleteProc(toFree->resolveInfo); } else { - ckfree(toFree->resolveInfo); + Tcl_Free(toFree->resolveInfo); } } - ckfree(toFree); + Tcl_Free(toFree); } procPtr->numCompiledLocals = procPtr->numArgs; } @@ -2064,13 +2062,14 @@ MakeProcError( Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { - int overflow, limit = 60, nameLen; + unsigned int overflow, limit = 60; + size_t nameLen; const char *procName = TclGetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (procedure \"%.*s%s\" line %d)", - (overflow ? limit : nameLen), procName, + (int)(overflow ? limit :nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -2145,7 +2144,7 @@ TclProcCleanupProc( if (resVarInfo->deleteProc) { resVarInfo->deleteProc(resVarInfo); } else { - ckfree(resVarInfo); + Tcl_Free(resVarInfo); } } @@ -2153,10 +2152,10 @@ TclProcCleanupProc( defPtr = localPtr->defValuePtr; Tcl_DecrRefCount(defPtr); } - ckfree(localPtr); + Tcl_Free(localPtr); localPtr = nextPtr; } - ckfree(procPtr); + Tcl_Free(procPtr); /* * TIP #280: Release the location data associated with this Proc @@ -2180,9 +2179,9 @@ TclProcCleanupProc( Tcl_DecrRefCount(cfPtr->data.eval.path); cfPtr->data.eval.path = NULL; } - ckfree(cfPtr->line); + Tcl_Free(cfPtr->line); cfPtr->line = NULL; - ckfree(cfPtr); + Tcl_Free(cfPtr); } Tcl_DeleteHashEntry(hePtr); } @@ -2516,12 +2515,12 @@ SetLambdaFromAny( * location (line of 2nd list element). */ - cfPtr = ckalloc(sizeof(CmdFrame)); + cfPtr = Tcl_Alloc(sizeof(CmdFrame)); TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); cfPtr->level = -1; cfPtr->type = contextPtr->type; - cfPtr->line = ckalloc(sizeof(int)); + cfPtr->line = Tcl_Alloc(sizeof(int)); cfPtr->line[0] = buf[1]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -2734,13 +2733,14 @@ MakeLambdaError( Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { - int overflow, limit = 60, nameLen; + unsigned int overflow, limit = 60; + size_t nameLen; const char *procName = TclGetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (lambda term \"%.*s%s\" line %d)", - (overflow ? limit : nameLen), procName, + (int)(overflow ? limit : nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } diff --git a/generic/tclProcess.c b/generic/tclProcess.c index a781386..ef16f4f 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -47,7 +47,7 @@ static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid, int resolvedPid); static void FreeProcessInfo(ProcessInfo *info); static int RefreshProcessInfo(ProcessInfo *info, int options); -static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid, +static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, size_t resolvedPid, int options, int *codePtr, Tcl_Obj **msgPtr, Tcl_Obj **errorObjPtr); static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info); @@ -130,7 +130,7 @@ FreeProcessInfo( * Free allocated structure. */ - ckfree(info); + Tcl_Free(info); } /* @@ -193,7 +193,7 @@ RefreshProcessInfo( TclProcessWaitStatus WaitProcessStatus( Tcl_Pid pid, /* Process id. */ - int resolvedPid, /* Resolved process id. */ + size_t resolvedPid, /* Resolved process id. */ int options, /* Options passed to Tcl_WaitPid. */ int *codePtr, /* If non-NULL, will receive either: * - 0 for normal exit. @@ -799,7 +799,7 @@ void TclProcessCreated( Tcl_Pid pid) /* Process id. */ { - int resolvedPid; + size_t resolvedPid; Tcl_HashEntry *entry, *entry2; int isNew; ProcessInfo *info; @@ -833,7 +833,7 @@ TclProcessCreated( * Allocate and initialize info structure. */ - info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo)); + info = (ProcessInfo *) Tcl_Alloc(sizeof(ProcessInfo)); InitProcessInfo(info, pid, resolvedPid); /* diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index ce53ced..65bc94e 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -70,7 +70,7 @@ typedef struct { char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular * expression patterns. NULL means that this * slot isn't used. Malloc-ed. */ - int patLengths[NUM_REGEXPS];/* Number of non-null characters in + size_t patLengths[NUM_REGEXPS];/* Number of non-null characters in * corresponding entry in patterns. -1 means * entry isn't used. */ struct TclRegexp *regexps[NUM_REGEXPS]; @@ -85,15 +85,15 @@ static Tcl_ThreadDataKey dataKey; */ static TclRegexp * CompileRegexp(Tcl_Interp *interp, const char *pattern, - int length, int flags); + size_t length, int flags); static void DupRegexpInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FinalizeRegexp(ClientData clientData); static void FreeRegexp(TclRegexp *regexpPtr); static void FreeRegexpInternalRep(Tcl_Obj *objPtr); static int RegExpExecUniChar(Tcl_Interp *interp, Tcl_RegExp re, - const Tcl_UniChar *uniString, int numChars, - int nmatches, int flags); + const Tcl_UniChar *uniString, size_t numChars, + size_t nmatches, int flags); static int SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); /* @@ -190,7 +190,8 @@ Tcl_RegExpExec( * identifies beginning of larger string, so * that "^" won't match. */ { - int flags, result, numChars; + int flags, result; + size_t numChars; TclRegexp *regexp = (TclRegexp *) re; Tcl_DString ds; const Tcl_UniChar *ustr; @@ -250,7 +251,7 @@ void Tcl_RegExpRange( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ - int index, /* 0 means give the range of the entire match, + size_t index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching * subrange. */ const char **startPtr, /* Store address of first character in @@ -261,7 +262,7 @@ Tcl_RegExpRange( TclRegexp *regexpPtr = (TclRegexp *) re; const char *string; - if ((size_t) index > regexpPtr->re.re_nsub) { + if (index > regexpPtr->re.re_nsub) { *startPtr = *endPtr = NULL; } else if (regexpPtr->matches[index].rm_so < 0) { *startPtr = *endPtr = NULL; @@ -302,9 +303,8 @@ RegExpExecUniChar( Tcl_RegExp re, /* Compiled regular expression; returned by a * previous call to Tcl_GetRegExpFromObj */ const Tcl_UniChar *wString, /* String against which to match re. */ - int numChars, /* Length of Tcl_UniChar string (must be - * >=0). */ - int nmatches, /* How many subexpression matches (counting + size_t numChars, /* Length of Tcl_UniChar string. */ + size_t nm, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means "don't know". */ int flags) /* Regular expression flags. */ @@ -312,13 +312,12 @@ RegExpExecUniChar( int status; TclRegexp *regexpPtr = (TclRegexp *) re; size_t last = regexpPtr->re.re_nsub + 1; - size_t nm = last; - if (nmatches >= 0 && (size_t) nmatches < nm) { - nm = (size_t) nmatches; + if (nm >= last) { + nm = last; } - status = TclReExec(®expPtr->re, wString, (size_t) numChars, + status = TclReExec(®expPtr->re, wString, numChars, ®expPtr->details, nm, regexpPtr->matches, flags); /* @@ -362,7 +361,7 @@ void TclRegExpRangeUniChar( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ - int index, /* 0 means give the range of the entire match, + size_t index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching * subrange, -1 means the range of the * rm_extend field. */ @@ -373,10 +372,10 @@ TclRegExpRangeUniChar( { TclRegexp *regexpPtr = (TclRegexp *) re; - if ((regexpPtr->flags®_EXPECT) && index == -1) { + if ((regexpPtr->flags®_EXPECT) && index == TCL_AUTO_LENGTH) { *startPtr = regexpPtr->details.rm_extend.rm_so; *endPtr = regexpPtr->details.rm_extend.rm_eo; - } else if ((size_t) index > regexpPtr->re.re_nsub) { + } else if (index > regexpPtr->re.re_nsub) { *startPtr = -1; *endPtr = -1; } else { @@ -442,16 +441,16 @@ Tcl_RegExpExecObj( * returned by previous call to * Tcl_GetRegExpFromObj. */ Tcl_Obj *textObj, /* Text against which to match re. */ - int offset, /* Character index that marks where matching + size_t offset, /* Character index that marks where matching * should begin. */ - int nmatches, /* How many subexpression matches (counting + size_t nmatches, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means all of them. */ int flags) /* Regular expression execution flags. */ { TclRegexp *regexpPtr = (TclRegexp *) re; Tcl_UniChar *udata; - int length; + size_t length; int reflags = regexpPtr->flags; #define TCL_REG_GLOBOK_FLAGS \ (TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE) @@ -482,7 +481,7 @@ Tcl_RegExpExecObj( regexpPtr->string = NULL; regexpPtr->objPtr = textObj; - udata = Tcl_GetUnicodeFromObj(textObj, &length); + udata = TclGetUnicodeFromObj(textObj, &length); if (offset > length) { offset = length; @@ -594,7 +593,7 @@ Tcl_GetRegExpFromObj( * expression. */ int flags) /* Regular expression compilation flags. */ { - int length; + size_t length; TclRegexp *regexpPtr; const char *pattern; @@ -858,7 +857,7 @@ static TclRegexp * CompileRegexp( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ const char *string, /* The regexp to compile (UTF-8). */ - int length, /* The length of the string in bytes. */ + size_t length, /* The length of the string in bytes. */ int flags) /* Compilation flags. */ { TclRegexp *regexpPtr; @@ -916,7 +915,7 @@ CompileRegexp( * This is a new expression, so compile it and add it to the cache. */ - regexpPtr = ckalloc(sizeof(TclRegexp)); + regexpPtr = Tcl_Alloc(sizeof(TclRegexp)); regexpPtr->objPtr = NULL; regexpPtr->string = NULL; regexpPtr->details.rm_extend.rm_so = -1; @@ -943,7 +942,7 @@ CompileRegexp( * Clean up and report errors in the interpreter, if possible. */ - ckfree(regexpPtr); + Tcl_Free(regexpPtr); if (interp) { TclRegError(interp, "couldn't compile regular expression pattern: ", status); @@ -971,7 +970,7 @@ CompileRegexp( */ regexpPtr->matches = - ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1)); + Tcl_Alloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1)); /* * Initialize the refcount to one initially, since it is in the cache. @@ -990,15 +989,15 @@ CompileRegexp( if (oldRegexpPtr->refCount-- <= 1) { FreeRegexp(oldRegexpPtr); } - ckfree(tsdPtr->patterns[NUM_REGEXPS-1]); + Tcl_Free(tsdPtr->patterns[NUM_REGEXPS-1]); } for (i = NUM_REGEXPS - 2; i >= 0; i--) { tsdPtr->patterns[i+1] = tsdPtr->patterns[i]; tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i]; tsdPtr->regexps[i+1] = tsdPtr->regexps[i]; } - tsdPtr->patterns[0] = ckalloc(length + 1); - memcpy(tsdPtr->patterns[0], string, (unsigned) length + 1); + tsdPtr->patterns[0] = Tcl_Alloc(length + 1); + memcpy(tsdPtr->patterns[0], string, length + 1); tsdPtr->patLengths[0] = length; tsdPtr->regexps[0] = regexpPtr; @@ -1030,9 +1029,9 @@ FreeRegexp( TclDecrRefCount(regexpPtr->globObjPtr); } if (regexpPtr->matches) { - ckfree(regexpPtr->matches); + Tcl_Free(regexpPtr->matches); } - ckfree(regexpPtr); + Tcl_Free(regexpPtr); } /* @@ -1064,7 +1063,7 @@ FinalizeRegexp( if (regexpPtr->refCount-- <= 1) { FreeRegexp(regexpPtr); } - ckfree(tsdPtr->patterns[i]); + Tcl_Free(tsdPtr->patterns[i]); tsdPtr->patterns[i] = NULL; } diff --git a/generic/tclResolve.c b/generic/tclResolve.c index 974737e..23f2326 100644 --- a/generic/tclResolve.c +++ b/generic/tclResolve.c @@ -101,9 +101,9 @@ Tcl_AddInterpResolvers( * list, so that it overrides existing schemes. */ - resPtr = ckalloc(sizeof(ResolverScheme)); + resPtr = Tcl_Alloc(sizeof(ResolverScheme)); len = strlen(name) + 1; - resPtr->name = ckalloc(len); + resPtr->name = Tcl_Alloc(len); memcpy(resPtr->name, name, len); resPtr->cmdResProc = cmdProc; resPtr->varResProc = varProc; @@ -225,8 +225,8 @@ Tcl_RemoveInterpResolvers( } *prevPtrPtr = resPtr->nextPtr; - ckfree(resPtr->name); - ckfree(resPtr); + Tcl_Free(resPtr->name); + Tcl_Free(resPtr); return 1; } diff --git a/generic/tclResult.c b/generic/tclResult.c index a5ec4be..76ba02a 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -27,9 +27,6 @@ enum returnKeys { static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); -#ifndef TCL_NO_DEPRECATED -static void SetupAppendBuffer(Interp *iPtr, int newSpace); -#endif /* !TCL_NO_DEPRECATED */ /* * This structure is used to take a snapshot of the interpreter state in @@ -77,7 +74,7 @@ Tcl_SaveInterpState( int status) /* status code for current operation */ { Interp *iPtr = (Interp *) interp; - InterpState *statePtr = ckalloc(sizeof(InterpState)); + InterpState *statePtr = Tcl_Alloc(sizeof(InterpState)); statePtr->status = status; statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED; @@ -207,268 +204,12 @@ Tcl_DiscardInterpState( Tcl_DecrRefCount(statePtr->errorStack); } Tcl_DecrRefCount(statePtr->objResult); - ckfree(statePtr); + Tcl_Free(statePtr); } /* *---------------------------------------------------------------------- * - * Tcl_SaveResult -- - * - * Takes a snapshot of the current result state of the interpreter. The - * snapshot can be restored at any point by Tcl_RestoreResult. Note that - * this routine does not preserve the errorCode, errorInfo, or flags - * fields so it should not be used if an error is in progress. - * - * Once a snapshot is saved, it must be restored by calling - * Tcl_RestoreResult, or discarded by calling Tcl_DiscardResult. - * - * Results: - * None. - * - * Side effects: - * Resets the interpreter result. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_SaveResult -void -Tcl_SaveResult( - Tcl_Interp *interp, /* Interpreter to save. */ - Tcl_SavedResult *statePtr) /* Pointer to state structure. */ -{ - Interp *iPtr = (Interp *) interp; - - /* - * Move the result object into the save state. Note that we don't need to - * change its refcount because we're moving it, not adding a new - * reference. Put an empty object into the interpreter. - */ - - statePtr->objResultPtr = iPtr->objResultPtr; - iPtr->objResultPtr = Tcl_NewObj(); - Tcl_IncrRefCount(iPtr->objResultPtr); - - /* - * Save the string result. - */ - - statePtr->freeProc = iPtr->freeProc; - if (iPtr->result == iPtr->resultSpace) { - /* - * Copy the static string data out of the interp buffer. - */ - - statePtr->result = statePtr->resultSpace; - strcpy(statePtr->result, iPtr->result); - statePtr->appendResult = NULL; - } else if (iPtr->result == iPtr->appendResult) { - /* - * Move the append buffer out of the interp. - */ - - statePtr->appendResult = iPtr->appendResult; - statePtr->appendAvl = iPtr->appendAvl; - statePtr->appendUsed = iPtr->appendUsed; - statePtr->result = statePtr->appendResult; - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; - } else { - /* - * Move the dynamic or static string out of the interpreter. - */ - - statePtr->result = iPtr->result; - statePtr->appendResult = NULL; - } - - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; - iPtr->freeProc = 0; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_RestoreResult -- - * - * Restores the state of the interpreter to a snapshot taken by - * Tcl_SaveResult. After this call, the token for the interpreter state - * is no longer valid. - * - * Results: - * None. - * - * Side effects: - * Restores the interpreter result. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_RestoreResult -void -Tcl_RestoreResult( - Tcl_Interp *interp, /* Interpreter being restored. */ - Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ -{ - Interp *iPtr = (Interp *) interp; - - Tcl_ResetResult(interp); - - /* - * Restore the string result. - */ - - iPtr->freeProc = statePtr->freeProc; - if (statePtr->result == statePtr->resultSpace) { - /* - * Copy the static string data into the interp buffer. - */ - - iPtr->result = iPtr->resultSpace; - strcpy(iPtr->result, statePtr->result); - } else if (statePtr->result == statePtr->appendResult) { - /* - * Move the append buffer back into the interp. - */ - - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - - iPtr->appendResult = statePtr->appendResult; - iPtr->appendAvl = statePtr->appendAvl; - iPtr->appendUsed = statePtr->appendUsed; - iPtr->result = iPtr->appendResult; - } else { - /* - * Move the dynamic or static string back into the interpreter. - */ - - iPtr->result = statePtr->result; - } - - /* - * Restore the object result. - */ - - Tcl_DecrRefCount(iPtr->objResultPtr); - iPtr->objResultPtr = statePtr->objResultPtr; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_DiscardResult -- - * - * Frees the memory associated with an interpreter snapshot taken by - * Tcl_SaveResult. If the snapshot is not restored, this function must be - * called to discard it, or the memory will be lost. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_DiscardResult -void -Tcl_DiscardResult( - Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ -{ - TclDecrRefCount(statePtr->objResultPtr); - - if (statePtr->result == statePtr->appendResult) { - ckfree(statePtr->appendResult); - } else if (statePtr->freeProc == TCL_DYNAMIC) { - ckfree(statePtr->result); - } else if (statePtr->freeProc) { - statePtr->freeProc(statePtr->result); - } -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetResult -- - * - * Arrange for "result" to be the Tcl return value. - * - * Results: - * None. - * - * Side effects: - * interp->result is left pointing either to "result" or to a copy of it. - * Also, the object result is reset. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetResult( - Tcl_Interp *interp, /* Interpreter with which to associate the - * return value. */ - register char *result, /* Value to be returned. If NULL, the result - * is set to an empty string. */ - Tcl_FreeProc *freeProc) /* Gives information about the string: - * TCL_STATIC, TCL_VOLATILE, or the address of - * a Tcl_FreeProc such as free. */ -{ - Interp *iPtr = (Interp *) interp; - register Tcl_FreeProc *oldFreeProc = iPtr->freeProc; - char *oldResult = iPtr->result; - - if (result == NULL) { - iPtr->resultSpace[0] = 0; - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } else if (freeProc == TCL_VOLATILE) { - int length = strlen(result); - - if (length > TCL_RESULT_SIZE) { - iPtr->result = ckalloc(length + 1); - iPtr->freeProc = TCL_DYNAMIC; - } else { - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } - memcpy(iPtr->result, result, (unsigned) length+1); - } else { - iPtr->result = (char *) result; - iPtr->freeProc = freeProc; - } - - /* - * If the old result was dynamically-allocated, free it up. Do it here, - * rather than at the beginning, in case the new result value was part of - * the old result value. - */ - - if (oldFreeProc != 0) { - if (oldFreeProc == TCL_DYNAMIC) { - ckfree(oldResult); - } else { - oldFreeProc(oldResult); - } - } - - /* - * Reset the object result since we just set the string result. - */ - - ResetObjResult(iPtr); -} -#endif /* !TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetStringResult -- * * Returns an interpreter's result value as a string. @@ -488,20 +229,8 @@ Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; -#ifdef TCL_NO_DEPRECATED - return Tcl_GetString(iPtr->objResultPtr); -#else - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - if (*(iPtr->result) == 0) { - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), - TCL_VOLATILE); - } - return iPtr->result; -#endif + return Tcl_GetString(iPtr->objResultPtr); } /* @@ -542,23 +271,6 @@ Tcl_SetObjResult( */ TclDecrRefCount(oldObjResult); - -#ifndef TCL_NO_DEPRECATED - /* - * Reset the string result since we just set the result object. - */ - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif } /* @@ -587,75 +299,13 @@ Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { register Interp *iPtr = (Interp *) interp; -#ifndef TCL_NO_DEPRECATED - Tcl_Obj *objResultPtr; - int length; - - /* - * If the string result is non-empty, move the string result to the object - * result, then reset the string result. - */ - - if (iPtr->result[0] != 0) { - ResetObjResult(iPtr); - objResultPtr = iPtr->objResultPtr; - length = strlen(iPtr->result); - TclInitStringRep(objResultPtr, iPtr->result, length); - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->result[0] = 0; - } -#endif /* !TCL_NO_DEPRECATED */ return iPtr->objResultPtr; } /* *---------------------------------------------------------------------- * - * Tcl_AppendResultVA -- - * - * Append a variable number of strings onto the interpreter's result. - * - * Results: - * None. - * - * Side effects: - * The result of the interpreter given by the first argument is extended - * by the strings in the va_list (up to a terminating NULL argument). - * - * If the string result is non-empty, the object result forced to be a - * duplicate of it first. There will be a string result afterwards. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AppendResultVA( - Tcl_Interp *interp, /* Interpreter with which to associate the - * return value. */ - va_list argList) /* Variable argument list. */ -{ - Tcl_Obj *objPtr = Tcl_GetObjResult(interp); - - if (Tcl_IsShared(objPtr)) { - objPtr = Tcl_DuplicateObj(objPtr); - } - Tcl_AppendStringsToObjVA(objPtr, argList); - Tcl_SetObjResult(interp, objPtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_AppendResult -- * * Append a variable number of strings onto the interpreter's result. @@ -679,9 +329,23 @@ Tcl_AppendResult( Tcl_Interp *interp, ...) { va_list argList; + Tcl_Obj *objPtr; va_start(argList, interp); - Tcl_AppendResultVA(interp, argList); + objPtr = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(objPtr)) { + objPtr = Tcl_DuplicateObj(objPtr); + } + while (1) { + const char *bytes = va_arg(argList, char *); + + if (bytes == NULL) { + break; + } + Tcl_AppendToObj(objPtr, bytes, -1); + } + Tcl_SetObjResult(interp, objPtr); va_end(argList); } @@ -716,7 +380,6 @@ Tcl_AppendElement( * to result. */ { Interp *iPtr = (Interp *) interp; -#ifdef TCL_NO_DEPRECATED Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); const char *bytes; @@ -730,134 +393,7 @@ Tcl_AppendElement( } Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); Tcl_DecrRefCount(listPtr); -#else - char *dst; - int size; - int flags; - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* - * See how much space is needed, and grow the append buffer if needed to - * accommodate the list element. - */ - - size = Tcl_ScanElement(element, &flags) + 1; - if ((iPtr->result != iPtr->appendResult) - || (iPtr->appendResult[iPtr->appendUsed] != 0) - || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) { - SetupAppendBuffer(iPtr, size+iPtr->appendUsed); - } - - /* - * Convert the string into a list element and copy it to the buffer that's - * forming, with a space separator if needed. - */ - - dst = iPtr->appendResult + iPtr->appendUsed; - if (TclNeedSpace(iPtr->appendResult, dst)) { - iPtr->appendUsed++; - *dst = ' '; - dst++; - - /* - * If we need a space to separate this element from preceding stuff, - * then this element will not lead a list, and need not have it's - * leading '#' quoted. - */ - - flags |= TCL_DONT_QUOTE_HASH; - } - iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); -#endif /* !TCL_NO_DEPRECATED */ -} - -/* - *---------------------------------------------------------------------- - * - * SetupAppendBuffer -- - * - * This function makes sure that there is an append buffer properly - * initialized, if necessary, from the interpreter's result, and that it - * has at least enough room to accommodate newSpace new bytes of - * information. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -static void -SetupAppendBuffer( - Interp *iPtr, /* Interpreter whose result is being set up. */ - int newSpace) /* Make sure that at least this many bytes of - * new information may be added. */ -{ - int totalSpace; - - /* - * Make the append buffer larger, if that's necessary, then copy the - * result into the append buffer and make the append buffer the official - * Tcl result. - */ - - if (iPtr->result != iPtr->appendResult) { - /* - * If an oversized buffer was used recently, then free it up so we go - * back to a smaller buffer. This avoids tying up memory forever after - * a large operation. - */ - - if (iPtr->appendAvl > 500) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - } - iPtr->appendUsed = strlen(iPtr->result); - } else if (iPtr->result[iPtr->appendUsed] != 0) { - /* - * Most likely someone has modified a result created by - * Tcl_AppendResult et al. so that it has a different size. Just - * recompute the size. - */ - - iPtr->appendUsed = strlen(iPtr->result); - } - - totalSpace = newSpace + iPtr->appendUsed; - if (totalSpace >= iPtr->appendAvl) { - char *new; - - if (totalSpace < 100) { - totalSpace = 200; - } else { - totalSpace *= 2; - } - new = ckalloc(totalSpace); - strcpy(new, iPtr->result); - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - iPtr->appendResult = new; - iPtr->appendAvl = totalSpace; - } else if (iPtr->result != iPtr->appendResult) { - strcpy(iPtr->appendResult, iPtr->result); - } - - Tcl_FreeResult((Tcl_Interp *) iPtr); - iPtr->result = iPtr->appendResult; } -#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -865,18 +401,17 @@ SetupAppendBuffer( * Tcl_FreeResult -- * * This function frees up the memory associated with an interpreter's - * string result. It also resets the interpreter's result object. - * Tcl_FreeResult is most commonly used when a function is about to - * replace one result value with another. + * result, resetting the interpreter's result object. Tcl_FreeResult is + * most commonly used when a function is about to replace one result + * value with another. * * Results: * None. * * Side effects: - * Frees the memory associated with interp's string result and sets - * interp->freeProc to zero, but does not change interp->result or clear - * error state. Resets interp's result object to an unshared empty - * object. + * Frees the memory associated with interp's result but does not change + * any part of the error dictionary (i.e., the errorinfo and errorcode + * remain the same). * *---------------------------------------------------------------------- */ @@ -887,17 +422,6 @@ Tcl_FreeResult( { register Interp *iPtr = (Interp *) interp; -#ifndef TCL_NO_DEPRECATED - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - -#endif /* !TCL_NO_DEPRECATED */ ResetObjResult(iPtr); } @@ -927,18 +451,6 @@ Tcl_ResetResult( register Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); -#ifndef TCL_NO_DEPRECATED - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif /* !TCL_NO_DEPRECATED */ if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { @@ -1000,7 +512,7 @@ ResetObjResult( } else { if (objResultPtr->bytes != &tclEmptyString) { if (objResultPtr->bytes) { - ckfree(objResultPtr->bytes); + Tcl_Free(objResultPtr->bytes); } objResultPtr->bytes = &tclEmptyString; objResultPtr->length = 0; @@ -1012,7 +524,7 @@ ResetObjResult( /* *---------------------------------------------------------------------- * - * Tcl_SetErrorCodeVA -- + * Tcl_SetErrorCode -- * * This function is called to record machine-readable information about * an error that is about to be returned. @@ -1029,11 +541,19 @@ ResetObjResult( */ void -Tcl_SetErrorCodeVA( - Tcl_Interp *interp, /* Interpreter in which to set errorCode */ - va_list argList) /* Variable argument list. */ +Tcl_SetErrorCode( + Tcl_Interp *interp, ...) { - Tcl_Obj *errorObj = Tcl_NewObj(); + va_list argList; + Tcl_Obj *errorObj; + + /* + * Scan through the arguments one at a time, appending them to the + * errorCode field as list elements. + */ + + va_start(argList, interp); + errorObj = Tcl_NewObj(); /* * Scan through the arguments one at a time, appending them to the @@ -1049,40 +569,6 @@ Tcl_SetErrorCodeVA( Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1)); } Tcl_SetObjErrorCode(interp, errorObj); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetErrorCode -- - * - * This function is called to record machine-readable information about - * an error that is about to be returned. - * - * Results: - * None. - * - * Side effects: - * The errorCode field of the interp is modified to hold all of the - * arguments to this function, in a list form with each argument becoming - * one element of the list. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetErrorCode( - Tcl_Interp *interp, ...) -{ - va_list argList; - - /* - * Scan through the arguments one at a time, appending them to the - * errorCode field as list elements. - */ - - va_start(argList, interp); - Tcl_SetErrorCodeVA(interp, argList); va_end(argList); } diff --git a/generic/tclScan.c b/generic/tclScan.c index fbfba2d..bf611fc 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -29,7 +29,7 @@ * character set. */ -typedef struct CharSet { +typedef struct { int exclude; /* 1 if this is an exclusion set. */ int nchars; Tcl_UniChar *chars; @@ -102,9 +102,9 @@ BuildCharSet( end += TclUtfToUniChar(end, &ch); } - cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1)); + cset->chars = Tcl_Alloc(sizeof(Tcl_UniChar) * (end - format - 1)); if (nranges > 0) { - cset->ranges = ckalloc(sizeof(struct Range) * nranges); + cset->ranges = Tcl_Alloc(sizeof(struct Range) * nranges); } else { cset->ranges = NULL; } @@ -224,9 +224,9 @@ static void ReleaseCharSet( CharSet *cset) { - ckfree(cset->chars); + Tcl_Free(cset->chars); if (cset->ranges) { - ckfree(cset->ranges); + Tcl_Free(cset->ranges); } } @@ -605,7 +605,7 @@ Tcl_ScanObjCmd( */ if (totalVars > 0) { - objs = ckalloc(sizeof(Tcl_Obj *) * totalVars); + objs = Tcl_Alloc(sizeof(Tcl_Obj *) * totalVars); for (i = 0; i < totalVars; i++) { objs[i] = NULL; } @@ -951,7 +951,7 @@ Tcl_ScanObjCmd( if (code == TCL_ERROR) { if (objs != NULL) { - ckfree(objs); + Tcl_Free(objs); } Tcl_DecrRefCount(objPtr); Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -1076,7 +1076,7 @@ Tcl_ScanObjCmd( } } if (objs != NULL) { - ckfree(objs); + Tcl_Free(objs); } if (code == TCL_OK) { if (underflow && (nconversions == 0)) { diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index a46b29a..85b3e65 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -474,7 +474,7 @@ TclParseNumber( * ("integer", "boolean value", etc.). */ const char *bytes, /* Pointer to the start of the string to * scan. */ - int numBytes, /* Maximum number of bytes to scan, see + size_t numBytes, /* Maximum number of bytes to scan, see * above. */ const char **endPtrPtr, /* Place to store pointer to the character * that terminated the scan. */ @@ -483,7 +483,7 @@ TclParseNumber( enum State { INITIAL, SIGNUM, ZERO, ZERO_X, ZERO_O, ZERO_B, ZERO_D, BINARY, - HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, + HEXADECIMAL, OCTAL, DECIMAL, LEADING_RADIX_POINT, FRACTION, EXPONENT_START, EXPONENT_SIGNUM, EXPONENT, sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY @@ -528,7 +528,6 @@ TclParseNumber( char d = 0; /* Last hexadecimal digit scanned; initialized * to avoid a compiler warning. */ int shift = 0; /* Amount to shift when accumulating binary */ - int explicitOctal = 0; #define ALL_BITS (~(Tcl_WideUInt)0) #define MOST_BITS (ALL_BITS >> 1) @@ -660,7 +659,6 @@ TclParseNumber( goto zerob; } if (c == 'o' || c == 'O') { - explicitOctal = 1; state = ZERO_O; break; } @@ -668,10 +666,7 @@ TclParseNumber( state = ZERO_D; break; } -#ifdef TCL_NO_DEPRECATED goto decimal; -#endif - /* FALLTHROUGH */ case OCTAL: /* @@ -734,58 +729,6 @@ TclParseNumber( state = OCTAL; break; } - /* FALLTHROUGH */ - - case BAD_OCTAL: - if (explicitOctal) { - /* - * No forgiveness for bad digits in explicitly octal numbers. - */ - - goto endgame; - } - if (flags & TCL_PARSE_INTEGER_ONLY) { - /* - * No seeking floating point when parsing only integer. - */ - - goto endgame; - } -#ifndef TCL_NO_DEPRECATED - - /* - * Scanned a number with a leading zero that contains an 8, 9, - * radix point or E. This is an invalid octal number, but might - * still be floating point. - */ - - if (c == '0') { - numTrailZeros++; - state = BAD_OCTAL; - break; - } else if (isdigit(UCHAR(c))) { - if (objPtr != NULL) { - significandOverflow = AccumulateDecimalDigit( - (unsigned)(c-'0'), numTrailZeros, - &significandWide, &significandBig, - significandOverflow); - } - if (numSigDigs != 0) { - numSigDigs += (numTrailZeros + 1); - } else { - numSigDigs = 1; - } - numTrailZeros = 0; - state = BAD_OCTAL; - break; - } else if (c == '.') { - state = FRACTION; - break; - } else if (c == 'E' || c == 'e') { - state = EXPONENT_START; - break; - } -#endif goto endgame; /* @@ -900,9 +843,7 @@ TclParseNumber( * digits. */ -#ifdef TCL_NO_DEPRECATED decimal: -#endif acceptState = state; acceptPoint = p; acceptLen = len; @@ -1170,7 +1111,7 @@ TclParseNumber( } } if (endPtrPtr == NULL) { - if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) { + if ((len != 0) && ((numBytes + 1 > 1) || (*p != '\0'))) { status = TCL_ERROR; } } else { @@ -1186,7 +1127,6 @@ TclParseNumber( TclFreeIntRep(objPtr); switch (acceptState) { case SIGNUM: - case BAD_OCTAL: case ZERO_X: case ZERO_O: case ZERO_B: @@ -1384,9 +1324,6 @@ TclParseNumber( Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); Tcl_AppendToObj(msg, "\"", -1); - if (state == BAD_OCTAL) { - Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1); - } Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); } @@ -2173,7 +2110,7 @@ TakeAbsoluteValue( * * Results: * Returns one of the strings 'Infinity' and 'NaN'. The string returned - * must be freed by the caller using 'ckfree'. + * must be freed by the caller using 'Tcl_Free'. * * Side effects: * Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating @@ -2192,13 +2129,13 @@ FormatInfAndNaN( *decpt = 9999; if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) { - retval = ckalloc(9); + retval = Tcl_Alloc(9); strcpy(retval, "Infinity"); if (endPtr) { *endPtr = retval + 8; } } else { - retval = ckalloc(4); + retval = Tcl_Alloc(4); strcpy(retval, "NaN"); if (endPtr) { *endPtr = retval + 3; @@ -2229,7 +2166,7 @@ FormatZero( int *decpt, /* Location of the decimal point. */ char **endPtr) /* Pointer to the end of the formatted data */ { - char *retval = ckalloc(2); + char *retval = Tcl_Alloc(2); strcpy(retval, "0"); if (endPtr) { @@ -2782,7 +2719,7 @@ QuickConversion( * Handle the peculiar case where the result has no significant digits. */ - retval = ckalloc(len + 1); + retval = Tcl_Alloc(len + 1); if (ilim == 0) { d -= 5.; if (d > eps.d) { @@ -2793,7 +2730,7 @@ QuickConversion( *decpt = k; return retval; } else { - ckfree(retval); + Tcl_Free(retval); return NULL; } } @@ -2808,7 +2745,7 @@ QuickConversion( end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt); } if (end == NULL) { - ckfree(retval); + Tcl_Free(retval); return NULL; } *end = '\0'; @@ -2895,7 +2832,7 @@ ShorteningInt64Conversion( char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = ckalloc(len + 1); + char *retval = Tcl_Alloc(len + 1); /* Output buffer. */ Tcl_WideUInt b = (bw * wuipow5[b5]) << b2; /* Numerator of the fraction being @@ -3061,7 +2998,7 @@ StrictInt64Conversion( char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = ckalloc(len + 1); + char *retval = Tcl_Alloc(len + 1); /* Output buffer. */ Tcl_WideUInt b = (bw * wuipow5[b5]) << b2; /* Numerator of the fraction being @@ -3271,7 +3208,7 @@ ShorteningBignumConversionPowD( char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = ckalloc(len + 1); + char *retval = Tcl_Alloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ @@ -3461,7 +3398,7 @@ StrictBignumConversionPowD( char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = ckalloc(len + 1); + char *retval = Tcl_Alloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ @@ -3663,7 +3600,7 @@ ShorteningBignumConversion( int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the end of the number */ { - char *retval = ckalloc(len+1); + char *retval = Tcl_Alloc(len+1); /* Buffer of digits to return. */ char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ @@ -3878,7 +3815,7 @@ StrictBignumConversion( int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the end of the number */ { - char *retval = ckalloc(len+1); + char *retval = Tcl_Alloc(len+1); /* Buffer of digits to return. */ char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ @@ -4031,8 +3968,8 @@ StrictBignumConversion( * This function is a service routine that produces the string of digits for * floating-point-to-decimal conversion. It can do a number of things * according to the 'flags' argument. Valid values for 'flags' include: - * TCL_DD_SHORTEST - This is the default for floating point conversion if - * ::tcl_precision is 0. It constructs the shortest string of + * TCL_DD_SHORTEST - This is the default for floating point conversion. + * It constructs the shortest string of * digits that will reconvert to the given number when scanned. * For floating point numbers that are exactly between two * decimal numbers, it resolves using the 'round to even' rule. @@ -4047,8 +3984,7 @@ StrictBignumConversion( * subsequent input conversion is 'round up' or 'round down' * rather than 'round to nearest', but is surprising otherwise. * TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format - * conversion (or for default floating->string if tcl_precision - * is not 0). It constructs a string of at most 'ndigits' digits, + * conversion. It constructs a string of at most 'ndigits' digits, * choosing the one that is closest to the given number (and * resolving ties with 'round to even'). It is allowed to return * fewer than 'ndigits' if the number converts exactly; if the @@ -4386,7 +4322,7 @@ TclInitDoubleConversion(void) maxpow10_wide = (int) floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.)); - pow10_wide = ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt)); + pow10_wide = Tcl_Alloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt)); u = 1; for (i = 0; i < maxpow10_wide; ++i) { pow10_wide[i] = u; @@ -4493,7 +4429,7 @@ TclFinalizeDoubleConversion(void) { int i; - ckfree(pow10_wide); + Tcl_Free(pow10_wide); for (i=0; i<9; ++i) { mp_clear(pow5 + i); } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 72ca7cd..9537490 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -46,28 +46,28 @@ static void AppendPrintfToObjVA(Tcl_Obj *objPtr, const char *format, va_list argList); static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int appendNumChars); + const Tcl_UniChar *unicode, size_t appendNumChars); static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); + const Tcl_UniChar *unicode, size_t numChars); static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, - const char *bytes, int numBytes); + const char *bytes, size_t numBytes); static void AppendUtfToUtfRep(Tcl_Obj *objPtr, - const char *bytes, int numBytes); + const char *bytes, size_t numBytes); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); -static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); +static size_t ExtendStringRepWithUnicode(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, size_t numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, - const char *bytes, int numBytes, - int numAppendChars); + const char *bytes, size_t numBytes, + size_t numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); -static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag); -static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed); +static void GrowStringBuffer(Tcl_Obj *objPtr, size_t needed, int flag); +static void GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); -static int UnicodeLength(const Tcl_UniChar *unicode); + const Tcl_UniChar *unicode, size_t numChars); +static size_t UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); /* @@ -123,7 +123,7 @@ const Tcl_ObjType tclStringType = { static void GrowStringBuffer( Tcl_Obj *objPtr, - int needed, + size_t needed, int flag) { /* @@ -135,15 +135,15 @@ GrowStringBuffer( String *stringPtr = GET_STRING(objPtr); char *ptr = NULL; - int attempt; + size_t attempt; if (objPtr->bytes == &tclEmptyString) { objPtr->bytes = NULL; } if (flag == 0 || stringPtr->allocated > 0) { - if (needed <= INT_MAX / 2) { + if (needed <= STRING_MAXCHARS / 2) { attempt = 2 * needed; - ptr = attemptckrealloc(objPtr->bytes, attempt + 1); + ptr = Tcl_AttemptRealloc(objPtr->bytes, attempt + 1); } if (ptr == NULL) { /* @@ -151,12 +151,12 @@ GrowStringBuffer( * overflow into invalid argument values for attempt. */ - unsigned int limit = INT_MAX - needed; - unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH; - int growth = (int) ((extra > limit) ? limit : extra); + size_t limit = INT_MAX - needed; + size_t extra = needed - objPtr->length + TCL_MIN_GROWTH; + size_t growth = (extra > limit) ? limit : extra; attempt = needed + growth; - ptr = attemptckrealloc(objPtr->bytes, attempt + 1); + ptr = Tcl_AttemptRealloc(objPtr->bytes, attempt + 1); } } if (ptr == NULL) { @@ -165,7 +165,7 @@ GrowStringBuffer( */ attempt = needed; - ptr = ckrealloc(objPtr->bytes, attempt + 1); + ptr = Tcl_Realloc(objPtr->bytes, attempt + 1); } objPtr->bytes = ptr; stringPtr->allocated = attempt; @@ -174,7 +174,7 @@ GrowStringBuffer( static void GrowUnicodeBuffer( Tcl_Obj *objPtr, - int needed) + size_t needed) { /* * Pre-conditions: @@ -184,7 +184,7 @@ GrowUnicodeBuffer( */ String *ptr = NULL, *stringPtr = GET_STRING(objPtr); - int attempt; + size_t attempt; if (stringPtr->maxChars > 0) { /* @@ -201,10 +201,10 @@ GrowUnicodeBuffer( * overflow into invalid argument values for attempt. */ - unsigned int limit = STRING_MAXCHARS - needed; - unsigned int extra = needed - stringPtr->numChars + size_t limit = STRING_MAXCHARS - needed; + size_t extra = needed - stringPtr->numChars + TCL_MIN_UNICHAR_GROWTH; - int growth = (int) ((extra > limit) ? limit : extra); + size_t growth = (extra > limit) ? limit : extra; attempt = needed + growth; ptr = stringAttemptRealloc(stringPtr, attempt); @@ -254,7 +254,7 @@ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length) /* The number of bytes to copy from "bytes" + size_t length) /* The number of bytes to copy from "bytes" * when initializing the new object. If * negative, use bytes up to the first NUL * byte. */ @@ -266,14 +266,13 @@ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length) /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first NUL - * byte. */ + size_t length) /* The number of bytes to copy from "bytes" + * when initializing the new object. If -1, + * use bytes up to the first NUL byte. */ { Tcl_Obj *objPtr; - if (length < 0) { + if (length == TCL_AUTO_LENGTH) { length = (bytes? strlen(bytes) : 0); } TclNewStringObj(objPtr, bytes, length); @@ -315,10 +314,9 @@ Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length, /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first NUL - * byte. */ + size_t length, /* The number of bytes to copy from "bytes" + * when initializing the new object. If -1, + * use bytes up to the first NUL byte. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for @@ -326,7 +324,7 @@ Tcl_DbNewStringObj( { Tcl_Obj *objPtr; - if (length < 0) { + if (length == TCL_AUTO_LENGTH) { length = (bytes? strlen(bytes) : 0); } TclDbNewObj(objPtr, file, line); @@ -338,10 +336,9 @@ Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length, /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first NUL - * byte. */ + size_t length, /* The number of bytes to copy from "bytes" + * when initializing the new object. If -1, + * use bytes up to the first NUL byte. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for @@ -374,7 +371,7 @@ Tcl_Obj * Tcl_NewUnicodeObj( const Tcl_UniChar *unicode, /* The unicode string used to initialize the * new object. */ - int numChars) /* Number of characters in the unicode + size_t numChars) /* Number of characters in the unicode * string. */ { Tcl_Obj *objPtr; @@ -401,13 +398,13 @@ Tcl_NewUnicodeObj( *---------------------------------------------------------------------- */ -int +size_t Tcl_GetCharLength( Tcl_Obj *objPtr) /* The String object to get the num chars * of. */ { String *stringPtr; - int numChars; + size_t numChars; /* * Quick, no-shimmer return for short string reps. @@ -430,10 +427,8 @@ Tcl_GetCharLength( */ if (TclIsPureByteArray(objPtr)) { - int length; - - (void) Tcl_GetByteArrayFromObj(objPtr, &length); - return length; + (void) TclGetByteArrayFromObj(objPtr, &numChars); + return numChars; } /* @@ -448,7 +443,7 @@ Tcl_GetCharLength( * If numChars is unknown, compute it. */ - if (numChars == -1) { + if (numChars == TCL_AUTO_LENGTH) { TclNumUtfChars(numChars, objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; } @@ -519,14 +514,10 @@ int Tcl_GetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ - int index) /* Get the index'th Unicode character. */ + size_t index) /* Get the index'th Unicode character. */ { String *stringPtr; - int ch, length; - - if (index < 0) { - return -1; - } + int ch; /* * Optimize the case where we're really dealing with a bytearray object @@ -534,12 +525,13 @@ Tcl_GetUniChar( */ if (TclIsPureByteArray(objPtr)) { - unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); + size_t length; + unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; } - return (int) bytes[index]; + return bytes[index]; } /* @@ -554,7 +546,7 @@ Tcl_GetUniChar( * If numChars is unknown, compute it. */ - if (stringPtr->numChars == -1) { + if (stringPtr->numChars == TCL_AUTO_LENGTH) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { @@ -590,36 +582,6 @@ Tcl_GetUniChar( /* *---------------------------------------------------------------------- * - * Tcl_GetUnicode -- - * - * Get the Unicode form of the String object. If the object is not - * already a String object, it will be converted to one. If the String - * object does not have a Unicode rep, then one is created from the UTF - * string format. - * - * Results: - * Returns a pointer to the object's internal Unicode string. - * - * Side effects: - * Converts the object to have the String internal rep. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_GetUnicode -Tcl_UniChar * -Tcl_GetUnicode( - Tcl_Obj *objPtr) /* The object to find the unicode string - * for. */ -{ - return Tcl_GetUnicodeFromObj(objPtr, NULL); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetUnicodeFromObj -- * * Get the Unicode form of the String object with length. If the object @@ -682,16 +644,19 @@ Tcl_GetUnicodeFromObj( Tcl_Obj * Tcl_GetRange( Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ - int first, /* First index of the range. */ - int last) /* Last index of the range. */ + size_t first, /* First index of the range. */ + size_t last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; - int length; + size_t length; - if (first < 0) { + if (first == TCL_AUTO_LENGTH) { first = 0; } + if (last + 2 <= first + 1) { + return Tcl_NewObj(); + } /* * Optimize the case where we're really dealing with a bytearray object @@ -699,7 +664,7 @@ Tcl_GetRange( */ if (TclIsPureByteArray(objPtr)) { - unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); + unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length); if (last >= length) { last = length - 1; @@ -722,7 +687,7 @@ Tcl_GetRange( * If numChars is unknown, compute it. */ - if (stringPtr->numChars == -1) { + if (stringPtr->numChars == TCL_AUTO_LENGTH) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { @@ -754,11 +719,11 @@ Tcl_GetRange( } #if TCL_UTF_MAX <= 4 /* See: bug [11ae2be95dac9417] */ - if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) + if ((first + 1 > 1) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { ++first; } - if ((last + 1 < stringPtr->numChars) + if ((last + 2 < stringPtr->numChars + 1) && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) { ++last; @@ -793,8 +758,8 @@ Tcl_SetStringObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ const char *bytes, /* Points to the first of the length bytes * used to initialize the object. */ - int length) /* The number of bytes to copy from "bytes" - * when initializing the object. If negative, + size_t length) /* The number of bytes to copy from "bytes" + * when initializing the object. If -1, * use bytes up to the first NUL byte.*/ { if (Tcl_IsShared(objPtr)) { @@ -813,7 +778,7 @@ Tcl_SetStringObj( */ TclInvalidateStringRep(objPtr); - if (length < 0) { + if (length == TCL_AUTO_LENGTH) { length = (bytes? strlen(bytes) : 0); } TclInitStringRep(objPtr, bytes, length); @@ -846,21 +811,12 @@ void Tcl_SetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - int length) /* Number of bytes desired for string + size_t length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { String *stringPtr; - if (length < 0) { - /* - * Setting to a negative length is nonsense. This is probably the - * result of overflowing the signed integer range. - */ - - Tcl_Panic("Tcl_SetObjLength: negative length requested: " - "%d (integer overflow?)", length); - } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetObjLength"); } @@ -881,9 +837,9 @@ Tcl_SetObjLength( * Need to enlarge the buffer. */ if (objPtr->bytes == &tclEmptyString) { - objPtr->bytes = ckalloc(length + 1); + objPtr->bytes = Tcl_Alloc(length + 1); } else { - objPtr->bytes = ckrealloc(objPtr->bytes, length + 1); + objPtr->bytes = Tcl_Realloc(objPtr->bytes, length + 1); } stringPtr->allocated = length; } @@ -895,7 +851,7 @@ Tcl_SetObjLength( * Invalidate the unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = TCL_AUTO_LENGTH; stringPtr->hasUnicode = 0; } else { /* @@ -951,20 +907,12 @@ int Tcl_AttemptSetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - int length) /* Number of bytes desired for string + size_t length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { String *stringPtr; - if (length < 0) { - /* - * Setting to a negative length is nonsense. This is probably the - * result of overflowing the signed integer range. - */ - - return 0; - } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength"); } @@ -987,9 +935,9 @@ Tcl_AttemptSetObjLength( char *newBytes; if (objPtr->bytes == &tclEmptyString) { - newBytes = attemptckalloc(length + 1); + newBytes = Tcl_AttemptAlloc(length + 1); } else { - newBytes = attemptckrealloc(objPtr->bytes, length + 1); + newBytes = Tcl_AttemptRealloc(objPtr->bytes, length + 1); } if (newBytes == NULL) { return 0; @@ -1005,7 +953,7 @@ Tcl_AttemptSetObjLength( * Invalidate the unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = TCL_AUTO_LENGTH; stringPtr->hasUnicode = 0; } else { /* @@ -1061,7 +1009,7 @@ Tcl_SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ const Tcl_UniChar *unicode, /* The unicode string used to initialize the * object. */ - int numChars) /* Number of characters in the unicode + size_t numChars) /* Number of characters in the unicode * string. */ { if (Tcl_IsShared(objPtr)) { @@ -1071,14 +1019,14 @@ Tcl_SetUnicodeObj( SetUnicodeObj(objPtr, unicode, numChars); } -static int +static size_t UnicodeLength( const Tcl_UniChar *unicode) { - int numChars = 0; + size_t numChars = 0; if (unicode) { - while (numChars >= 0 && unicode[numChars] != 0) { + while ((numChars != TCL_AUTO_LENGTH) && (unicode[numChars] != 0)) { numChars++; } } @@ -1091,12 +1039,12 @@ SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ const Tcl_UniChar *unicode, /* The unicode string used to initialize the * object. */ - int numChars) /* Number of characters in the unicode + size_t numChars) /* Number of characters in the unicode * string. */ { String *stringPtr; - if (numChars < 0) { + if (numChars == TCL_AUTO_LENGTH) { numChars = UnicodeLength(unicode); } @@ -1142,23 +1090,23 @@ Tcl_AppendLimitedToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - int length, /* The number of bytes available to be - * appended from "bytes". If < 0, then all - * bytes up to a NUL byte are available. */ - int limit, /* The maximum number of bytes to append to + size_t length, /* The number of bytes available to be + * appended from "bytes". If -1, then + * all bytes up to a NUL byte are available. */ + size_t limit, /* The maximum number of bytes to append to * the object. */ const char *ellipsis) /* Ellipsis marker string, appended to the * object to indicate not all available bytes * at "bytes" were appended. */ { String *stringPtr; - int toCopy = 0; + size_t toCopy = 0; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj"); } - if (length < 0) { + if (length == TCL_AUTO_LENGTH) { length = (bytes ? strlen(bytes) : 0); } if (length == 0) { @@ -1172,7 +1120,7 @@ Tcl_AppendLimitedToObj( ellipsis = "..."; } toCopy = (bytes == NULL) ? limit - : Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes; + : (size_t)(Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes); } /* @@ -1184,7 +1132,7 @@ Tcl_AppendLimitedToObj( SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode && stringPtr->numChars > 0) { + if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) { AppendUtfToUnicodeRep(objPtr, bytes, toCopy); } else { AppendUtfToUtfRep(objPtr, bytes, toCopy); @@ -1195,7 +1143,7 @@ Tcl_AppendLimitedToObj( } stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode && stringPtr->numChars > 0) { + if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) { AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis)); } else { AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis)); @@ -1224,11 +1172,11 @@ Tcl_AppendToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - int length) /* The number of bytes to append from "bytes". - * If < 0, then append all bytes up to NUL + size_t length) /* The number of bytes to append from "bytes". + * If -1, then append all bytes up to NUL * byte. */ { - Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); + Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_AUTO_LENGTH, NULL); } /* @@ -1253,7 +1201,7 @@ Tcl_AppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* The unicode string to append to the * object. */ - int length) /* Number of chars in "unicode". */ + size_t length) /* Number of chars in "unicode". */ { String *stringPtr; @@ -1307,7 +1255,8 @@ Tcl_AppendObjToObj( Tcl_Obj *appendObjPtr) /* Object to append. */ { String *stringPtr; - int length, numChars, appendNumChars = -1; + size_t length, numChars; + size_t appendNumChars = TCL_AUTO_LENGTH; const char *bytes; /* @@ -1331,7 +1280,7 @@ Tcl_AppendObjToObj( /* * You might expect the code here to be * - * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length); + * bytes = TclGetByteArrayFromObj(appendObjPtr, &length); * TclAppendBytesToByteArray(objPtr, bytes, length); * * and essentially all of the time that would be fine. However, it @@ -1347,10 +1296,10 @@ Tcl_AppendObjToObj( * First, get the lengths. */ - int lengthSrc; + size_t lengthSrc; - (void) Tcl_GetByteArrayFromObj(objPtr, &length); - (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); + (void) TclGetByteArrayFromObj(objPtr, &length); + (void) TclGetByteArrayFromObj(appendObjPtr, &lengthSrc); /* * Grow buffer enough for the append. @@ -1393,7 +1342,7 @@ Tcl_AppendObjToObj( if (appendObjPtr->typePtr == &tclStringType) { Tcl_UniChar *unicode = - Tcl_GetUnicodeFromObj(appendObjPtr, &numChars); + TclGetUnicodeFromObj(appendObjPtr, &numChars); AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); } else { @@ -1412,7 +1361,7 @@ Tcl_AppendObjToObj( bytes = TclGetStringFromObj(appendObjPtr, &length); numChars = stringPtr->numChars; - if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) { + if ((numChars != TCL_AUTO_LENGTH) && (appendObjPtr->typePtr == &tclStringType)) { String *appendStringPtr = GET_STRING(appendObjPtr); appendNumChars = appendStringPtr->numChars; @@ -1420,7 +1369,7 @@ Tcl_AppendObjToObj( AppendUtfToUtfRep(objPtr, bytes, length); - if (numChars >= 0 && appendNumChars >= 0) { + if ((numChars != TCL_AUTO_LENGTH) && (appendNumChars != TCL_AUTO_LENGTH)) { stringPtr->numChars = numChars + appendNumChars; } } @@ -1446,12 +1395,12 @@ static void AppendUnicodeToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to append. */ - int appendNumChars) /* Number of chars of "unicode" to append. */ + size_t appendNumChars) /* Number of chars of "unicode" to append. */ { String *stringPtr; - int numChars; + size_t numChars; - if (appendNumChars < 0) { + if (appendNumChars == TCL_AUTO_LENGTH) { appendNumChars = UnicodeLength(unicode); } if (appendNumChars == 0) { @@ -1473,7 +1422,7 @@ AppendUnicodeToUnicodeRep( stringCheckLimits(numChars); if (numChars > stringPtr->maxChars) { - int offset = -1; + size_t offset = TCL_AUTO_LENGTH; /* * Protect against case where unicode points into the existing @@ -1493,7 +1442,7 @@ AppendUnicodeToUnicodeRep( * Relocate unicode if needed; see above. */ - if (offset >= 0) { + if (offset != TCL_AUTO_LENGTH) { unicode = stringPtr->unicode + offset; } } @@ -1535,13 +1484,13 @@ static void AppendUnicodeToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to convert to UTF. */ - int numChars) /* Number of chars of "unicode" to convert. */ + size_t numChars) /* Number of chars of "unicode" to convert. */ { String *stringPtr = GET_STRING(objPtr); numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars); - if (stringPtr->numChars != -1) { + if (stringPtr->numChars != TCL_AUTO_LENGTH) { stringPtr->numChars += numChars; } } @@ -1568,7 +1517,7 @@ static void AppendUtfToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to convert to Unicode. */ - int numBytes) /* Number of bytes of "bytes" to convert. */ + size_t numBytes) /* Number of bytes of "bytes" to convert. */ { String *stringPtr; @@ -1604,10 +1553,10 @@ static void AppendUtfToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to append. */ - int numBytes) /* Number of bytes of "bytes" to append. */ + size_t numBytes) /* Number of bytes of "bytes" to append. */ { String *stringPtr; - int newLength, oldLength; + size_t newLength, oldLength; if (numBytes == 0) { return; @@ -1623,13 +1572,10 @@ AppendUtfToUtfRep( } oldLength = objPtr->length; newLength = numBytes + oldLength; - if (newLength < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { - int offset = -1; + size_t offset = TCL_AUTO_LENGTH; /* * Protect against case where unicode points into the existing @@ -1653,7 +1599,7 @@ AppendUtfToUtfRep( * Relocate bytes if needed; see above. */ - if (offset >= 0) { + if (offset != TCL_AUTO_LENGTH) { bytes = objPtr->bytes + offset; } } @@ -1662,7 +1608,7 @@ AppendUtfToUtfRep( * Invalidate the unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = TCL_AUTO_LENGTH; stringPtr->hasUnicode = 0; if (bytes) { @@ -1675,7 +1621,7 @@ AppendUtfToUtfRep( /* *---------------------------------------------------------------------- * - * Tcl_AppendStringsToObjVA -- + * Tcl_AppendStringsToObj -- * * This function appends one or more null-terminated strings to an * object. @@ -1691,10 +1637,13 @@ AppendUtfToUtfRep( */ void -Tcl_AppendStringsToObjVA( - Tcl_Obj *objPtr, /* Points to the object to append to. */ - va_list argList) /* Variable argument list. */ +Tcl_AppendStringsToObj( + Tcl_Obj *objPtr, + ...) { + va_list argList; + + va_start(argList, objPtr); if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj"); } @@ -1707,35 +1656,6 @@ Tcl_AppendStringsToObjVA( } Tcl_AppendToObj(objPtr, bytes, -1); } -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_AppendStringsToObj -- - * - * This function appends one or more null-terminated strings to an - * object. - * - * Results: - * None. - * - * Side effects: - * The contents of all the string arguments are appended to the string - * representation of objPtr. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AppendStringsToObj( - Tcl_Obj *objPtr, - ...) -{ - va_list argList; - - va_start(argList, objPtr); - Tcl_AppendStringsToObjVA(objPtr, argList); va_end(argList); } @@ -1768,8 +1688,8 @@ Tcl_AppendFormatToObj( Tcl_Obj *const objv[]) { const char *span = format, *msg, *errCode; - int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; - int originalLength, limit; + int objIndex = 0, gotXpg = 0, gotSequential = 0; + size_t originalLength, limit, numBytes = 0; Tcl_UniChar ch = 0; static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; @@ -1782,8 +1702,8 @@ Tcl_AppendFormatToObj( if (Tcl_IsShared(appendObj)) { Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); } - TclGetStringFromObj(appendObj, &originalLength); - limit = INT_MAX - originalLength; + (void)TclGetStringFromObj(appendObj, &originalLength); + limit = (size_t)INT_MAX - originalLength; /* * Format string is NUL-terminated. @@ -1796,7 +1716,8 @@ Tcl_AppendFormatToObj( #ifndef TCL_WIDE_INT_IS_LONG int useWide = 0; #endif - int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; + int newXpg, numChars, allocSegment = 0, segmentLimit; + size_t segmentNumBytes; Tcl_Obj *segment; int step = TclUtfToUniChar(format, &ch); @@ -1928,7 +1849,7 @@ Tcl_AppendFormatToObj( format += step; step = TclUtfToUniChar(format, &ch); } - if (width > limit) { + if (width > (int) limit) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; @@ -2153,20 +2074,12 @@ Tcl_AppendFormatToObj( Tcl_AppendToObj(segment, "0b", 2); segmentLimit -= 2; break; -#if TCL_MAJOR_VERSION < 9 - case 'd': - if (gotZero) { - Tcl_AppendToObj(segment, "0d", 2); - segmentLimit -= 2; - } - break; -#endif } } switch (ch) { case 'd': { - int length; + size_t length; Tcl_Obj *pure; const char *bytes; @@ -2201,10 +2114,10 @@ Tcl_AppendFormatToObj( */ if (gotPrecision) { - if (length < precision) { + if (length < (size_t)precision) { segmentLimit -= precision - length; } - while (length < precision) { + while (length < (size_t)precision) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2212,10 +2125,10 @@ Tcl_AppendFormatToObj( } if (gotZero) { length += Tcl_GetCharLength(segment); - if (length < width) { + if (length < (size_t)width) { segmentLimit -= width - length; } - while (length < width) { + while (length < (size_t)width) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2236,9 +2149,10 @@ Tcl_AppendFormatToObj( case 'x': case 'X': case 'b': { - Tcl_WideUInt bits = (Tcl_WideUInt) 0; - Tcl_WideInt numDigits = (Tcl_WideInt) 0; - int length, numBits = 4, base = 16, index = 0, shift = 0; + Tcl_WideUInt bits = 0; + Tcl_WideInt numDigits = 0; + int numBits = 4, base = 16, index = 0, shift = 0; + size_t length; Tcl_Obj *pure; char *bytes; @@ -2302,9 +2216,9 @@ Tcl_AppendFormatToObj( numDigits = 1; } pure = Tcl_NewObj(); - Tcl_SetObjLength(pure, (int) numDigits); + Tcl_SetObjLength(pure, numDigits); bytes = TclGetString(pure); - toAppend = length = (int) numDigits; + toAppend = length = numDigits; while (numDigits--) { int digitOffset; @@ -2316,7 +2230,7 @@ Tcl_AppendFormatToObj( } shift -= numBits; } - digitOffset = (int) (bits % base); + digitOffset = bits % base; if (digitOffset > 9) { if (ch == 'X') { bytes[numDigits] = 'A' + digitOffset - 10; @@ -2332,10 +2246,10 @@ Tcl_AppendFormatToObj( mp_clear(&big); } if (gotPrecision) { - if (length < precision) { + if (length < (size_t)precision) { segmentLimit -= precision - length; } - while (length < precision) { + while (length < (size_t)precision) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2343,10 +2257,10 @@ Tcl_AppendFormatToObj( } if (gotZero) { length += Tcl_GetCharLength(segment); - if (length < width) { + if (length < (size_t)width) { segmentLimit -= width - length; } - while (length < width) { + while (length < (size_t)width) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2465,7 +2379,7 @@ Tcl_AppendFormatToObj( } } - TclGetStringFromObj(segment, &segmentNumBytes); + (void)TclGetStringFromObj(segment, &segmentNumBytes); if (segmentNumBytes > limit) { if (allocSegment) { Tcl_DecrRefCount(segment); @@ -2608,7 +2522,7 @@ AppendPrintfToObjVA( */ q = Tcl_UtfPrev(end, bytes); - if (!Tcl_UtfCharComplete(q, (int)(end - q))) { + if (!Tcl_UtfCharComplete(q, (end - q))) { end = q; } @@ -2619,7 +2533,7 @@ AppendPrintfToObjVA( } Tcl_ListObjAppendElement(NULL, list, - Tcl_NewStringObj(bytes , (int)(end - bytes))); + Tcl_NewStringObj(bytes , (end - bytes))); break; } @@ -2669,7 +2583,7 @@ AppendPrintfToObjVA( seekingConversion = 0; break; case '*': - lastNum = (int) va_arg(argList, int); + lastNum = va_arg(argList, int); Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(lastNum)); p++; break; @@ -2677,7 +2591,7 @@ AppendPrintfToObjVA( case '5': case '6': case '7': case '8': case '9': { char *end; - lastNum = (int) strtoul(p, &end, 10); + lastNum = strtoul(p, &end, 10); p = end; break; } @@ -2808,12 +2722,12 @@ Tcl_ObjPrintf( char * TclGetStringStorage( Tcl_Obj *objPtr, - unsigned int *sizePtr) + size_t *sizePtr) { String *stringPtr; if (objPtr->typePtr != &tclStringType || objPtr->bytes == NULL) { - return TclGetStringFromObj(objPtr, (int *)sizePtr); + return TclGetStringFromObj(objPtr, sizePtr); } stringPtr = GET_STRING(objPtr); @@ -2842,12 +2756,12 @@ Tcl_Obj * TclStringRepeat( Tcl_Interp *interp, Tcl_Obj *objPtr, - int count, + size_t count, int flags) { Tcl_Obj *objResultPtr; int inPlace = flags & TCL_STRING_IN_PLACE; - int length = 0, unichar = 0, done = 1; + size_t length = 0, unichar = 0, done = 1; int binary = TclIsPureByteArray(objPtr); /* assert (count >= 2) */ @@ -2870,13 +2784,13 @@ TclStringRepeat( if (binary) { /* Result will be pure byte array. Pre-size it */ - Tcl_GetByteArrayFromObj(objPtr, &length); + TclGetByteArrayFromObj(objPtr, &length); } else if (unichar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ - Tcl_GetUnicodeFromObj(objPtr, &length); + TclGetUnicodeFromObj(objPtr, &length); } else { /* Result will be concat of string reps. Pre-size it. */ - Tcl_GetStringFromObj(objPtr, &length); + (void)TclGetStringFromObj(objPtr, &length); } if (length == 0) { @@ -2950,7 +2864,7 @@ TclStringRepeat( if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "string size overflow: unable to alloc %u bytes", + "string size overflow: unable to alloc %" TCL_Z_MODIFIER "u bytes", count*length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } @@ -2992,7 +2906,8 @@ TclStringCat( int flags) { Tcl_Obj *objResultPtr, * const *ov; - int oc, length = 0, binary = 1; + int oc, binary = 1; + size_t length = 0; int allowUniChar = 1, requestUniChar = 0; int first = objc - 1; /* Index of first value possibly not empty */ int last = 0; /* Index of last value possibly not empty */ @@ -3052,7 +2967,7 @@ TclStringCat( * Result will be pure byte array. Pre-size it */ - int numBytes; + size_t numBytes; ov = objv; oc = objc; do { @@ -3065,14 +2980,12 @@ TclStringCat( */ if (TclIsPureByteArray(objPtr)) { - Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ + TclGetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ if (numBytes) { last = objc - oc; if (length == 0) { first = last; - } else if (numBytes > INT_MAX - length) { - goto overflow; } length += numBytes; } @@ -3089,15 +3002,13 @@ TclStringCat( Tcl_Obj *objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int numChars; + size_t numChars; - Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ + TclGetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ if (numChars) { last = objc - oc; if (length == 0) { first = last; - } else if (numChars > INT_MAX - length) { - goto overflow; } length += numChars; } @@ -3124,7 +3035,7 @@ TclStringCat( /* No string rep; Take the chance we can avoid making it */ pendingPtr = objPtr; } else { - Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */ + (void)TclGetStringFromObj(objPtr, &length); /* PANIC? */ } } while (--oc && (length == 0) && (pendingPtr == NULL)); @@ -3138,7 +3049,7 @@ TclStringCat( first = last = objc - oc - 1; if (oc && (length == 0)) { - int numBytes; + size_t numBytes; /* assert ( pendingPtr != NULL ) */ @@ -3150,20 +3061,21 @@ TclStringCat( do { Tcl_Obj *objPtr = *ov++; - Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ + Tcl_GetString(objPtr); /* PANIC? */ + numBytes = objPtr->length; } while (--oc && numBytes == 0 && pendingPtr->bytes == NULL); if (numBytes) { last = objc -oc -1; } if (oc || numBytes) { - Tcl_GetStringFromObj(pendingPtr, &length); + (void)TclGetStringFromObj(pendingPtr, &length); } if (length == 0) { if (numBytes) { first = last; } - } else if (numBytes > INT_MAX - length) { + } else if (numBytes + length > (size_t)INT_MAX) { goto overflow; } length += numBytes; @@ -3171,15 +3083,16 @@ TclStringCat( } while (oc && (length == 0)); while (oc) { - int numBytes; + size_t numBytes; Tcl_Obj *objPtr = *ov++; /* assert ( length > 0 && pendingPtr == NULL ) */ - Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ + Tcl_GetString(objPtr); /* PANIC? */ + numBytes = objPtr->length; if (numBytes) { last = objc - oc; - if (numBytes > INT_MAX - length) { + if (numBytes + length > (size_t)INT_MAX) { goto overflow; } length += numBytes; @@ -3206,10 +3119,10 @@ TclStringCat( */ if (inPlace && !Tcl_IsShared(*objv)) { - int start; + size_t start; objResultPtr = *objv++; objc--; - Tcl_GetByteArrayFromObj(objResultPtr, &start); + TclGetByteArrayFromObj(objResultPtr, &start); dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; } else { objResultPtr = Tcl_NewByteArrayObj(NULL, length); @@ -3225,9 +3138,9 @@ TclStringCat( */ if (TclIsPureByteArray(objPtr)) { - int more; - unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more); - memcpy(dst, src, (size_t) more); + size_t more; + unsigned char *src = TclGetByteArrayFromObj(objPtr, &more); + memcpy(dst, src, more); dst += more; } } @@ -3236,12 +3149,12 @@ TclStringCat( Tcl_UniChar *dst; if (inPlace && !Tcl_IsShared(*objv)) { - int start; + size_t start; objResultPtr = *objv++; objc--; /* Ugly interface! Force resize of the unicode array. */ - Tcl_GetUnicodeFromObj(objResultPtr, &start); + TclGetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { @@ -3276,8 +3189,8 @@ TclStringCat( Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int more; - Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more); + size_t more; + Tcl_UniChar *src = TclGetUnicodeFromObj(objPtr, &more); memcpy(dst, src, more * sizeof(Tcl_UniChar)); dst += more; } @@ -3287,15 +3200,15 @@ TclStringCat( char *dst; if (inPlace && !Tcl_IsShared(*objv)) { - int start; + size_t start; objResultPtr = *objv++; objc--; - Tcl_GetStringFromObj(objResultPtr, &start); + (void)TclGetStringFromObj(objResultPtr, &start); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %u bytes", + "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } @@ -3311,7 +3224,7 @@ TclStringCat( Tcl_DecrRefCount(objResultPtr); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %u bytes", + "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } @@ -3323,8 +3236,8 @@ TclStringCat( Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int more; - char *src = Tcl_GetStringFromObj(objPtr, &more); + size_t more; + char *src = TclGetStringFromObj(objPtr, &more); memcpy(dst, src, (size_t) more); dst += more; @@ -3366,10 +3279,11 @@ TclStringCmp( Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ - int reqlength) /* requested length */ + size_t reqlength) /* requested length */ { char *s1, *s2; - int empty, length, match, s1len, s2len; + int empty, match; + size_t length, s1len, s2len; memCmpFn_t memCmpFn; if ((reqlength == 0) || (value1Ptr == value2Ptr)) { @@ -3387,8 +3301,8 @@ TclStringCmp( * arrays anyway, and we have no memcasecmp() for some reason... :^) */ - s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); - s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); + s1 = (char *) TclGetByteArrayFromObj(value1Ptr, &s1len); + s2 = (char *) TclGetByteArrayFromObj(value2Ptr, &s2len); memCmpFn = memcmp; } else if ((value1Ptr->typePtr == &tclStringType) && (value2Ptr->typePtr == &tclStringType)) { @@ -3400,8 +3314,8 @@ TclStringCmp( */ if (nocase) { - s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); - s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); + s1 = (char *) TclGetUnicodeFromObj(value1Ptr, &s1len); + s2 = (char *) TclGetUnicodeFromObj(value2Ptr, &s2len); memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp; } else { s1len = Tcl_GetCharLength(value1Ptr); @@ -3484,7 +3398,7 @@ TclStringCmp( * length was requested. */ - if ((reqlength < 0) && !nocase) { + if ((reqlength == TCL_AUTO_LENGTH) && !nocase) { memCmpFn = (memCmpFn_t) TclpUtfNcmp2; } else { s1len = Tcl_NumUtfChars(s1, s1len); @@ -3496,15 +3410,15 @@ TclStringCmp( } length = (s1len < s2len) ? s1len : s2len; - if (reqlength > 0 && reqlength < length) { - length = reqlength; - } else if (reqlength < 0) { + if (reqlength == TCL_AUTO_LENGTH) { /* * The requested length is negative, so we ignore it by setting it * to length + 1 so we correct the match var. */ reqlength = length + 1; + } else if (reqlength > 0 && reqlength < length) { + length = reqlength; } if (checkEq && (s1len != s2len)) { @@ -3536,7 +3450,7 @@ TclStringCmp( * Results: * If needle is found as a substring of haystack, the index of the * first instance of such a find is returned. If needle is not present - * as a substring of haystack, -1 is returned. + * as a substring of haystack, TCL_IO_FAILURE is returned. * * Side effects: * needle and haystack may have their Tcl_ObjType changed. @@ -3544,33 +3458,33 @@ TclStringCmp( *--------------------------------------------------------------------------- */ -int +size_t TclStringFirst( Tcl_Obj *needle, Tcl_Obj *haystack, - int start) + size_t start) { - int lh, ln = Tcl_GetCharLength(needle); + size_t lh, ln = Tcl_GetCharLength(needle); - if (start < 0) { + if (start == TCL_AUTO_LENGTH) { start = 0; } if (ln == 0) { /* We don't find empty substrings. Bizarre! * Whenever this routine is turned into a proper substring * finder, change to `return start` after limits imposed. */ - return -1; + return TCL_IO_FAILURE; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { unsigned char *end, *try, *bh; - unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); + unsigned char *bn = TclGetByteArrayFromObj(needle, &ln); /* Find bytes in bytes */ - bh = Tcl_GetByteArrayFromObj(haystack, &lh); + bh = TclGetByteArrayFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ - return -1; + return TCL_IO_FAILURE; } end = bh + lh; @@ -3584,7 +3498,7 @@ TclStringFirst( try = memchr(try, bn[0], (end + 1 - ln) - try); if (try == NULL) { /* Leading byte not found -> needle cannot be found. */ - return -1; + return TCL_IO_FAILURE; } /* Leading byte found, check rest of needle. */ if (0 == memcmp(try+1, bn+1, ln-1)) { @@ -3594,7 +3508,7 @@ TclStringFirst( /* Rest of needle match failed; Iterate to continue search. */ try++; } - return -1; + return TCL_IO_FAILURE; } /* @@ -3611,12 +3525,12 @@ TclStringFirst( { Tcl_UniChar *try, *end, *uh; - Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); + Tcl_UniChar *un = TclGetUnicodeFromObj(needle, &ln); - uh = Tcl_GetUnicodeFromObj(haystack, &lh); + uh = TclGetUnicodeFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ - return -1; + return TCL_IO_FAILURE; } end = uh + lh; @@ -3626,7 +3540,7 @@ TclStringFirst( return (try - uh); } } - return -1; + return TCL_IO_FAILURE; } } @@ -3640,7 +3554,7 @@ TclStringFirst( * Results: * If needle is found as a substring of haystack, the index of the * last instance of such a find is returned. If needle is not present - * as a substring of haystack, -1 is returned. + * as a substring of haystack, TCL_IO_FAILURE is returned. * * Side effects: * needle and haystack may have their Tcl_ObjType changed. @@ -3648,13 +3562,13 @@ TclStringFirst( *--------------------------------------------------------------------------- */ -int +size_t TclStringLast( Tcl_Obj *needle, Tcl_Obj *haystack, - int last) + size_t last) { - int lh, ln = Tcl_GetCharLength(needle); + size_t lh, ln = Tcl_GetCharLength(needle); if (ln == 0) { /* @@ -3663,19 +3577,19 @@ TclStringLast( * TODO: When we one day make this a true substring * finder, change this to "return last", after limitation. */ - return -1; + return TCL_IO_FAILURE; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { - unsigned char *try, *bh = Tcl_GetByteArrayFromObj(haystack, &lh); - unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); + unsigned char *try, *bh = TclGetByteArrayFromObj(haystack, &lh); + unsigned char *bn = TclGetByteArrayFromObj(needle, &ln); - if (last >= lh) { + if (last + 1 >= lh + 1) { last = lh - 1; } if (last + 1 < ln) { /* Don't start the loop if there cannot be a valid answer */ - return -1; + return TCL_IO_FAILURE; } try = bh + last + 1 - ln; @@ -3686,19 +3600,19 @@ TclStringLast( } try--; } - return -1; + return TCL_IO_FAILURE; } { - Tcl_UniChar *try, *uh = Tcl_GetUnicodeFromObj(haystack, &lh); - Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); + Tcl_UniChar *try, *uh = TclGetUnicodeFromObj(haystack, &lh); + Tcl_UniChar *un = TclGetUnicodeFromObj(needle, &ln); - if (last >= lh) { + if (last + 1 >= lh + 1) { last = lh - 1; } if (last + 1 < ln) { /* Don't start the loop if there cannot be a valid answer */ - return -1; + return TCL_IO_FAILURE; } try = uh + last + 1 - ln; while (try >= uh) { @@ -3708,7 +3622,7 @@ TclStringLast( } try--; } - return -1; + return TCL_IO_FAILURE; } } @@ -3734,7 +3648,7 @@ static void ReverseBytes( unsigned char *to, /* Copy bytes into here... */ unsigned char *from, /* ...from here... */ - int count) /* Until this many are copied, */ + size_t count) /* Until this many are copied, */ /* reversing as you go. */ { unsigned char *src = from + count; @@ -3764,8 +3678,8 @@ TclStringReverse( int inPlace = flags & TCL_STRING_IN_PLACE; if (TclIsPureByteArray(objPtr)) { - int numBytes; - unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); + size_t numBytes; + unsigned char *from = TclGetByteArrayFromObj(objPtr, &numBytes); if (!inPlace || Tcl_IsShared(objPtr)) { objPtr = Tcl_NewByteArrayObj(NULL, numBytes); @@ -3809,8 +3723,8 @@ TclStringReverse( } if (objPtr->bytes) { - int numChars = stringPtr->numChars; - int numBytes = objPtr->length; + size_t numChars = stringPtr->numChars; + size_t numBytes = objPtr->length; char *to, *from = objPtr->bytes; if (!inPlace || Tcl_IsShared(objPtr)) { @@ -3819,7 +3733,7 @@ TclStringReverse( } to = objPtr->bytes; - if (numChars < numBytes) { + if ((numChars == TCL_AUTO_LENGTH) || (numChars < numBytes)) { /* * Either numChars == -1 and we don't know how many chars are * represented by objPtr->bytes and we need Pass 1 just in case, @@ -3829,8 +3743,8 @@ TclStringReverse( * Pass 1. Reverse the bytes of each multi-byte character. */ - int charCount = 0; - int bytesLeft = numBytes; + size_t charCount = 0; + size_t bytesLeft = numBytes; while (bytesLeft) { /* @@ -3839,7 +3753,7 @@ TclStringReverse( * skip calling Tcl_UtfCharComplete() here. */ - int bytesInChar = TclUtfToUniChar(from, &ch); + size_t bytesInChar = TclUtfToUniChar(from, &ch); ReverseBytes((unsigned char *)to, (unsigned char *)from, bytesInChar); @@ -3888,18 +3802,14 @@ Tcl_Obj * TclStringReplace( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* String to act upon */ - int first, /* First index to replace */ - int count, /* How many chars to replace */ + size_t first, /* First index to replace */ + size_t count, /* How many chars to replace */ Tcl_Obj *insertPtr, /* Replacement string, may be NULL */ int flags) /* TCL_STRING_IN_PLACE => attempt in-place */ { int inPlace = flags & TCL_STRING_IN_PLACE; Tcl_Obj *result; - /* Caller is expected to pass sensible arguments */ - assert ( count >= 0 ) ; - assert ( first >= 0 ) ; - /* Replace nothing with nothing */ if ((insertPtr == NULL) && (count == 0)) { if (inPlace) { @@ -3917,8 +3827,8 @@ TclStringReplace( */ if (TclIsPureByteArray(objPtr)) { - int numBytes; - unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes); + size_t numBytes; + unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &numBytes); if (insertPtr == NULL) { /* Replace something with nothing. */ @@ -3940,9 +3850,9 @@ TclStringReplace( } if (TclIsPureByteArray(insertPtr)) { - int newBytes; + size_t newBytes; unsigned char *iBytes - = Tcl_GetByteArrayFromObj(insertPtr, &newBytes); + = TclGetByteArrayFromObj(insertPtr, &newBytes); if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) { /* @@ -3955,7 +3865,7 @@ TclStringReplace( return objPtr; } - if (newBytes > INT_MAX - (numBytes - count)) { + if ((size_t)newBytes > INT_MAX - (numBytes - count)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max size for a Tcl value (%d bytes) exceeded", @@ -3985,8 +3895,8 @@ TclStringReplace( /* The traditional implementation... */ { - int numChars; - Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars); + size_t numChars; + Tcl_UniChar *ustring = TclGetUnicodeFromObj(objPtr, &numChars); /* TODO: Is there an in-place option worth pursuing here? */ @@ -3994,7 +3904,7 @@ TclStringReplace( if (insertPtr) { Tcl_AppendObjToObj(result, insertPtr); } - if (first + count < numChars) { + if (first + count < (size_t)numChars) { Tcl_AppendUnicodeToObj(result, ustring + first + count, numChars - first - count); } @@ -4035,17 +3945,17 @@ static void ExtendUnicodeRepWithString( Tcl_Obj *objPtr, const char *bytes, - int numBytes, - int numAppendChars) + size_t numBytes, + size_t numAppendChars) { String *stringPtr = GET_STRING(objPtr); - int needed, numOrigChars = 0; + size_t needed, numOrigChars = 0; Tcl_UniChar *dst, unichar = 0; if (stringPtr->hasUnicode) { numOrigChars = stringPtr->numChars; } - if (numAppendChars == -1) { + if (numAppendChars == TCL_AUTO_LENGTH) { TclNumUtfChars(numAppendChars, bytes, numBytes); } needed = numOrigChars + numAppendChars; @@ -4097,7 +4007,7 @@ DupStringInternalRep( String *srcStringPtr = GET_STRING(srcPtr); String *copyStringPtr = NULL; - if (srcStringPtr->numChars == -1) { + if (srcStringPtr->numChars == TCL_AUTO_LENGTH) { /* * The String struct in the source value holds zero useful data. Don't * bother copying it. Don't even bother allocating space in which to @@ -4233,21 +4143,21 @@ UpdateStringOfString( } } -static int +static size_t ExtendStringRepWithUnicode( Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - int numChars) + size_t numChars) { /* * Pre-condition: this is the "string" Tcl_ObjType. */ - int i, origLength, size = 0; + size_t i, origLength, size = 0; char *dst; String *stringPtr = GET_STRING(objPtr); - if (numChars < 0) { + if (numChars == TCL_AUTO_LENGTH) { numChars = UnicodeLength(unicode); } @@ -4269,12 +4179,9 @@ ExtendStringRepWithUnicode( goto copyBytes; } - for (i = 0; i < numChars && size >= 0; i++) { + for (i = 0; i < numChars; i++) { size += TclUtfCount(unicode[i]); } - if (size < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } /* * Grow space if needed. @@ -4287,7 +4194,7 @@ ExtendStringRepWithUnicode( copyBytes: dst = objPtr->bytes + origLength; for (i = 0; i < numChars; i++) { - dst += Tcl_UniCharToUtf((int) unicode[i], dst); + dst += Tcl_UniCharToUtf(unicode[i], dst); } *dst = '\0'; objPtr->length = dst - objPtr->bytes; @@ -4315,7 +4222,7 @@ static void FreeStringInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_STRING(objPtr)); + Tcl_Free(GET_STRING(objPtr)); objPtr->typePtr = NULL; } diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index fc5a713..a8b3b08 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -47,15 +47,15 @@ */ typedef struct { - int numChars; /* The number of chars in the string. -1 means - * this value has not been calculated. >= 0 + size_t numChars; /* The number of chars in the string. -1 means + * this value has not been calculated. Any other * means that there is a valid Unicode rep, or * that the number of UTF bytes == the number * of chars. */ - int allocated; /* The amount of space actually allocated for + size_t allocated; /* The amount of space actually allocated for * the UTF string (minus 1 byte for the * termination char). */ - int maxChars; /* Max number of chars that can fit in the + size_t maxChars; /* Max number of chars that can fit in the * space allocated for the unicode array. */ int hasUnicode; /* Boolean determining whether the string has * a Unicode representation. */ @@ -65,24 +65,24 @@ typedef struct { } String; #define STRING_MAXCHARS \ - (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)) + ((UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)) #define STRING_SIZE(numChars) \ (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar))) #define stringCheckLimits(numChars) \ do { \ - if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \ - Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \ - (int)STRING_MAXCHARS); \ + if ((size_t)(numChars) > STRING_MAXCHARS) { \ + Tcl_Panic("max length for a Tcl unicode value (%" TCL_Z_MODIFIER "u chars) exceeded", \ + STRING_MAXCHARS); \ } \ } while (0) #define stringAttemptAlloc(numChars) \ - (String *) attemptckalloc(STRING_SIZE(numChars)) + (String *) Tcl_AttemptAlloc(STRING_SIZE(numChars)) #define stringAlloc(numChars) \ - (String *) ckalloc(STRING_SIZE(numChars)) + (String *) Tcl_Alloc(STRING_SIZE(numChars)) #define stringRealloc(ptr, numChars) \ - (String *) ckrealloc((ptr), STRING_SIZE(numChars)) + (String *) Tcl_Realloc((ptr), STRING_SIZE(numChars)) #define stringAttemptRealloc(ptr, numChars) \ - (String *) attemptckrealloc((ptr), STRING_SIZE(numChars)) + (String *) Tcl_AttemptRealloc((ptr), STRING_SIZE(numChars)) #define GET_STRING(objPtr) \ ((String *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_STRING(objPtr, stringPtr) \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index fa3f734..61a4d76 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -50,129 +50,33 @@ #undef TclpGetPid #undef TclSockMinimumBuffers #undef Tcl_SetIntObj -#undef Tcl_SetLongObj -#undef TclpInetNtoa -#undef TclWinGetServByName -#undef TclWinGetSockOpt -#undef TclWinSetSockOpt -#undef TclWinNToHS #undef TclStaticPackage #define TclStaticPackage Tcl_StaticPackage -/* See bug 510001: TclSockMinimumBuffers needs plat imp */ -#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 -# define TclSockMinimumBuffersOld 0 -#else -#define TclSockMinimumBuffersOld sockMinimumBuffersOld -static int TclSockMinimumBuffersOld(int sock, int size) -{ - return TclSockMinimumBuffers(INT2PTR(sock), size); -} -#endif - -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 -# define TclSetStartupScriptPath 0 -# define TclGetStartupScriptPath 0 -# define TclSetStartupScriptFileName 0 -# define TclGetStartupScriptFileName 0 -# define TclPrecTraceProc 0 -# define TclpInetNtoa 0 -# define TclWinGetServByName 0 -# define TclWinGetSockOpt 0 -# define TclWinSetSockOpt 0 -# define TclWinNToHS 0 -# define TclWinGetPlatformId 0 -# define TclWinResetInterfaces 0 -# define TclWinSetInterfaces 0 -# define TclWinGetPlatformId 0 -# define TclBNInitBignumFromWideUInt 0 -# define TclBNInitBignumFromWideInt 0 -# define TclBNInitBignumFromLong 0 -# define Tcl_Backslash 0 -# define Tcl_GetDefaultEncodingDir 0 -# define Tcl_SetDefaultEncodingDir 0 -# define Tcl_EvalTokens 0 -# define Tcl_CreateMathFunc 0 -# define Tcl_GetMathFuncInfo 0 -# define Tcl_ListMathFuncs 0 -# define Tcl_SetIntObj 0 -# define Tcl_SetLongObj 0 -# define Tcl_NewIntObj 0 -# define Tcl_NewLongObj 0 -# define Tcl_DbNewLongObj 0 - -#else -#define TclSetStartupScriptPath setStartupScriptPath -static void TclSetStartupScriptPath(Tcl_Obj *path) -{ - Tcl_SetStartupScript(path, NULL); -} -#define TclGetStartupScriptPath getStartupScriptPath -static Tcl_Obj *TclGetStartupScriptPath(void) -{ - return Tcl_GetStartupScript(NULL); -} -#define TclSetStartupScriptFileName setStartupScriptFileName -static void TclSetStartupScriptFileName( - const char *fileName) -{ - Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL); -} -#define TclGetStartupScriptFileName getStartupScriptFileName -static const char *TclGetStartupScriptFileName(void) -{ - Tcl_Obj *path = Tcl_GetStartupScript(NULL); - if (path == NULL) { - return NULL; - } - return Tcl_GetString(path); -} -#if defined(_WIN32) || defined(__CYGWIN__) -#undef TclWinNToHS -#undef TclWinGetPlatformId -#undef TclWinResetInterfaces -#undef TclWinSetInterfaces -static void -doNothing(void) -{ - /* dummy implementation, no need to do anything */ -} -#define TclWinNToHS winNToHS -static unsigned short TclWinNToHS(unsigned short ns) { - return ntohs(ns); -} -#define TclWinGetPlatformId winGetPlatformId -static int -TclWinGetPlatformId(void) -{ - return 2; /* VER_PLATFORM_WIN32_NT */; -} -#define TclWinResetInterfaces doNothing -#define TclWinSetInterfaces (void (*) (int)) doNothing +#ifdef TCL_MEM_DEBUG +# define Tcl_Alloc TclpAlloc +# define Tcl_Free TclpFree +# define Tcl_Realloc TclpRealloc +# undef Tcl_AttemptAlloc +# define Tcl_AttemptAlloc TclpAlloc +# undef Tcl_AttemptRealloc +# define Tcl_AttemptRealloc TclpRealloc #endif -# define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt -# define TclBNInitBignumFromWideInt TclInitBignumFromWideInt -# define TclBNInitBignumFromLong TclInitBignumFromLong -#endif /* TCL_NO_DEPRECATED */ #ifdef _WIN32 # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 # define TclUnixOpenTemporaryFile 0 -# define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) # define TclpIsAtty TclPlatIsAtty -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 static void doNothing(void) { /* dummy implementation, no need to do anything */ } -#endif -# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing +# define TclWinAddProcess (void (*) (void *, size_t)) doNothing # define TclWinFlushDirtyChannels doNothing - static int TclpIsAtty(int fd) { @@ -187,31 +91,6 @@ void *TclWinGetTclInstance() return hInstance; } -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#define TclWinSetSockOpt winSetSockOpt -static int -TclWinSetSockOpt(SOCKET s, int level, int optname, - const char *optval, int optlen) -{ - return setsockopt((int) s, level, optname, optval, optlen); -} - -#define TclWinGetSockOpt winGetSockOpt -static int -TclWinGetSockOpt(SOCKET s, int level, int optname, - char *optval, int *optlen) -{ - return getsockopt((int) s, level, optname, optval, optlen); -} - -#define TclWinGetServByName winGetServByName -static struct servent * -TclWinGetServByName(const char *name, const char *proto) -{ - return getservbyname(name, proto); -} -#endif /* TCL_NO_DEPRECATED */ - #define TclWinNoBackslash winNoBackslash static char * TclWinNoBackslash(char *path) @@ -226,16 +105,16 @@ TclWinNoBackslash(char *path) return path; } -int +size_t TclpGetPid(Tcl_Pid pid) { - return (int) (size_t) pid; + return (size_t) pid; } char * Tcl_WinUtfToTChar( const char *string, - int len, + size_t len, Tcl_DString *dsPtr) { #if TCL_UTF_MAX > 4 @@ -305,7 +184,7 @@ Tcl_WinUtfToTChar( char * Tcl_WinTCharToUtf( const char *string, - int len, + size_t len, Tcl_DString *dsPtr) { #if TCL_UTF_MAX > 4 @@ -318,7 +197,7 @@ Tcl_WinTCharToUtf( if (!string) { return NULL; } - if (len < 0) { + if (len == TCL_AUTO_LENGTH) { len = wcslen((wchar_t *)string); } else { len /= 2; @@ -389,154 +268,10 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj -static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ - return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); -} -#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcmp -static int utfNcmp(const char *s1, const char *s2, unsigned int n){ - return Tcl_UtfNcmp(s1, s2, (unsigned long)n); -} -#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))utfNcmp -static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ - return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); -} -#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp -static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ - return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n); -} -#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp - #endif /* TCL_WIDE_INT_IS_LONG */ #endif /* __CYGWIN__ */ -#if defined(TCL_NO_DEPRECATED) -# define Tcl_SeekOld 0 -# define Tcl_TellOld 0 -# undef Tcl_SetBooleanObj -# define Tcl_SetBooleanObj 0 -# undef Tcl_PkgPresent -# define Tcl_PkgPresent 0 -# undef Tcl_PkgProvide -# define Tcl_PkgProvide 0 -# undef Tcl_PkgRequire -# define Tcl_PkgRequire 0 -# undef Tcl_GetIndexFromObj -# define Tcl_GetIndexFromObj 0 -# define Tcl_NewBooleanObj 0 -# undef Tcl_DbNewBooleanObj -# define Tcl_DbNewBooleanObj 0 -# undef Tcl_SetBooleanObj -# define Tcl_SetBooleanObj 0 -# undef Tcl_SetVar -# define Tcl_SetVar 0 -# undef Tcl_UnsetVar -# define Tcl_UnsetVar 0 -# undef Tcl_GetVar -# define Tcl_GetVar 0 -# undef Tcl_TraceVar -# define Tcl_TraceVar 0 -# undef Tcl_UntraceVar -# define Tcl_UntraceVar 0 -# undef Tcl_VarTraceInfo -# define Tcl_VarTraceInfo 0 -# undef Tcl_UpVar -# define Tcl_UpVar 0 -# undef Tcl_AddErrorInfo -# define Tcl_AddErrorInfo 0 -# undef Tcl_AddObjErrorInfo -# define Tcl_AddObjErrorInfo 0 -# undef Tcl_Eval -# define Tcl_Eval 0 -# undef Tcl_GlobalEval -# define Tcl_GlobalEval 0 -# undef Tcl_SaveResult -# define Tcl_SaveResult 0 -# undef Tcl_RestoreResult -# define Tcl_RestoreResult 0 -# undef Tcl_DiscardResult -# define Tcl_DiscardResult 0 -# undef Tcl_SetResult -# define Tcl_SetResult 0 -# undef Tcl_EvalObj -# define Tcl_EvalObj 0 -# undef Tcl_GlobalEvalObj -# define Tcl_GlobalEvalObj 0 -# define TclBackgroundException 0 -# undef TclpReaddir -# define TclpReaddir 0 -# define TclSetStartupScript 0 -# define TclGetStartupScript 0 -# define TclCreateNamespace 0 -# define TclDeleteNamespace 0 -# define TclAppendExportList 0 -# define TclExport 0 -# define TclImport 0 -# define TclForgetImport 0 -# define TclGetCurrentNamespace_ 0 -# define TclGetGlobalNamespace_ 0 -# define TclFindNamespace 0 -# define TclFindCommand 0 -# define TclGetCommandFromObj 0 -# define TclGetCommandFullName 0 -# define TclCopyChannelOld 0 -# define Tcl_AppendResultVA 0 -# define Tcl_AppendStringsToObjVA 0 -# define Tcl_SetErrorCodeVA 0 -# define Tcl_PanicVA 0 -# define Tcl_VarEvalVA 0 -# undef TclpGetDate -# define TclpGetDate 0 -# undef TclpLocaltime -# define TclpLocaltime 0 -# undef TclpGmtime -# define TclpGmtime 0 -# define TclpLocaltime_unix 0 -# define TclpGmtime_unix 0 -# define Tcl_SetExitProc 0 -# define Tcl_SetPanicProc 0 -# define Tcl_FindExecutable 0 -# define Tcl_GetUnicode 0 -# define TclOldFreeObj 0 -#else /* TCL_NO_DEPRECATED */ -# define Tcl_SeekOld seekOld -# define Tcl_TellOld tellOld -# define TclBackgroundException Tcl_BackgroundException -# define TclSetStartupScript Tcl_SetStartupScript -# define TclGetStartupScript Tcl_GetStartupScript -# define TclCreateNamespace Tcl_CreateNamespace -# define TclDeleteNamespace Tcl_DeleteNamespace -# define TclAppendExportList Tcl_AppendExportList -# define TclExport Tcl_Export -# define TclImport Tcl_Import -# define TclForgetImport Tcl_ForgetImport -# define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace -# define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace -# define TclFindNamespace Tcl_FindNamespace -# define TclFindCommand Tcl_FindCommand -# define TclGetCommandFromObj Tcl_GetCommandFromObj -# define TclGetCommandFullName Tcl_GetCommandFullName -# define TclpLocaltime_unix TclpLocaltime -# define TclpGmtime_unix TclpGmtime -# define TclOldFreeObj TclFreeObj - -static int -seekOld( - Tcl_Channel chan, /* The channel on which to seek. */ - int offset, /* Offset to seek to. */ - int mode) /* Relative to which location to seek? */ -{ - return Tcl_Seek(chan, offset, mode); -} - -static int -tellOld( - Tcl_Channel chan) /* The channel to return pos for. */ -{ - return Tcl_Tell(chan); -} -#endif /* !TCL_NO_DEPRECATED */ - /* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations @@ -568,7 +303,7 @@ static const TclIntStubs tclIntStubs = { TclCleanupChildren, /* 5 */ TclCleanupCommand, /* 6 */ TclCopyAndCollapse, /* 7 */ - TclCopyChannelOld, /* 8 */ + 0, /* 8 */ TclCreatePipeline, /* 9 */ TclCreateProc, /* 10 */ TclDeleteCompiledLocalVars, /* 11 */ @@ -637,7 +372,7 @@ static const TclIntStubs tclIntStubs = { TclpFree, /* 74 */ TclpGetClicks, /* 75 */ TclpGetSeconds, /* 76 */ - TclpGetTime, /* 77 */ + 0, /* 77 */ 0, /* 78 */ 0, /* 79 */ 0, /* 80 */ @@ -648,7 +383,7 @@ static const TclIntStubs tclIntStubs = { 0, /* 85 */ 0, /* 86 */ 0, /* 87 */ - TclPrecTraceProc, /* 88 */ + 0, /* 88 */ TclPreventAliasLoop, /* 89 */ 0, /* 90 */ TclProcCleanupProc, /* 91 */ @@ -664,7 +399,7 @@ static const TclIntStubs tclIntStubs = { TclSetPreInitScript, /* 101 */ TclSetupEnv, /* 102 */ TclSockGetPort, /* 103 */ - TclSockMinimumBuffersOld, /* 104 */ + 0, /* 104 */ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ @@ -672,28 +407,28 @@ static const TclIntStubs tclIntStubs = { TclUpdateReturnInfo, /* 109 */ TclSockMinimumBuffers, /* 110 */ Tcl_AddInterpResolvers, /* 111 */ - TclAppendExportList, /* 112 */ - TclCreateNamespace, /* 113 */ - TclDeleteNamespace, /* 114 */ - TclExport, /* 115 */ - TclFindCommand, /* 116 */ - TclFindNamespace, /* 117 */ + 0, /* 112 */ + 0, /* 113 */ + 0, /* 114 */ + 0, /* 115 */ + 0, /* 116 */ + 0, /* 117 */ Tcl_GetInterpResolvers, /* 118 */ Tcl_GetNamespaceResolvers, /* 119 */ Tcl_FindNamespaceVar, /* 120 */ - TclForgetImport, /* 121 */ - TclGetCommandFromObj, /* 122 */ - TclGetCommandFullName, /* 123 */ - TclGetCurrentNamespace_, /* 124 */ - TclGetGlobalNamespace_, /* 125 */ + 0, /* 121 */ + 0, /* 122 */ + 0, /* 123 */ + 0, /* 124 */ + 0, /* 125 */ Tcl_GetVariableFullName, /* 126 */ - TclImport, /* 127 */ + 0, /* 127 */ Tcl_PopCallFrame, /* 128 */ Tcl_PushCallFrame, /* 129 */ Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ TclpHasSockets, /* 132 */ - TclpGetDate, /* 133 */ + 0, /* 133 */ 0, /* 134 */ 0, /* 135 */ 0, /* 136 */ @@ -718,8 +453,8 @@ static const TclIntStubs tclIntStubs = { 0, /* 155 */ TclRegError, /* 156 */ TclVarTraceExists, /* 157 */ - TclSetStartupScriptFileName, /* 158 */ - TclGetStartupScriptFileName, /* 159 */ + 0, /* 158 */ + 0, /* 159 */ 0, /* 160 */ TclChannelTransform, /* 161 */ TclChannelEventScriptInvoker, /* 162 */ @@ -727,8 +462,8 @@ static const TclIntStubs tclIntStubs = { TclExpandCodeArray, /* 164 */ TclpSetInitialEncodings, /* 165 */ TclListObjSetElement, /* 166 */ - TclSetStartupScriptPath, /* 167 */ - TclGetStartupScriptPath, /* 168 */ + 0, /* 167 */ + 0, /* 168 */ TclpUtfNcmp2, /* 169 */ TclCheckInterpTraces, /* 170 */ TclCheckExecutionTraces, /* 171 */ @@ -738,12 +473,12 @@ static const TclIntStubs tclIntStubs = { TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ - TclSetStartupScript, /* 178 */ - TclGetStartupScript, /* 179 */ + 0, /* 178 */ + 0, /* 179 */ 0, /* 180 */ 0, /* 181 */ - TclpLocaltime, /* 182 */ - TclpGmtime, /* 183 */ + 0, /* 182 */ + 0, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ @@ -796,7 +531,7 @@ static const TclIntStubs tclIntStubs = { TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ - TclBackgroundException, /* 236 */ + 0, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ @@ -834,10 +569,10 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ - TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ - TclpInetNtoa, /* 13 */ + 0, /* 10 */ + 0, /* 11 */ + 0, /* 12 */ + 0, /* 13 */ TclUnixCopyFile, /* 14 */ 0, /* 15 */ 0, /* 16 */ @@ -858,16 +593,16 @@ static const TclIntPlatStubs tclIntPlatStubs = { #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ - TclWinGetServByName, /* 2 */ - TclWinGetSockOpt, /* 3 */ + 0, /* 1 */ + 0, /* 2 */ + 0, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ - TclWinNToHS, /* 6 */ - TclWinSetSockOpt, /* 7 */ + 0, /* 6 */ + 0, /* 7 */ TclpGetPid, /* 8 */ - TclWinGetPlatformId, /* 9 */ - TclpReaddir, /* 10 */ + 0, /* 9 */ + 0, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ @@ -878,14 +613,14 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ - TclpInetNtoa, /* 21 */ + 0, /* 21 */ TclpCreateTempFile, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ 0, /* 25 */ - TclWinSetInterfaces, /* 26 */ + 0, /* 26 */ TclWinFlushDirtyChannels, /* 27 */ - TclWinResetInterfaces, /* 28 */ + 0, /* 28 */ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* WIN */ @@ -900,10 +635,10 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ - TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ - TclpInetNtoa, /* 13 */ + 0, /* 10 */ + 0, /* 11 */ + 0, /* 12 */ + 0, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ TclMacOSXSetFileAttribute, /* 16 */ @@ -1004,9 +739,9 @@ const TclTomMathStubs tclTomMathStubs = { TclBN_mp_init_set_int, /* 61 */ TclBN_mp_set_int, /* 62 */ TclBN_mp_cnt_lsb, /* 63 */ - TclBNInitBignumFromLong, /* 64 */ - TclBNInitBignumFromWideInt, /* 65 */ - TclBNInitBignumFromWideUInt, /* 66 */ + 0, /* 64 */ + 0, /* 65 */ + 0, /* 66 */ TclBN_mp_expt_d_ex, /* 67 */ TclBN_mp_set_long_long, /* 68 */ TclBN_mp_get_long_long, /* 69 */ @@ -1066,21 +801,21 @@ const TclStubs tclStubs = { Tcl_DbDecrRefCount, /* 19 */ Tcl_DbIncrRefCount, /* 20 */ Tcl_DbIsShared, /* 21 */ - Tcl_DbNewBooleanObj, /* 22 */ + 0, /* 22 */ Tcl_DbNewByteArrayObj, /* 23 */ Tcl_DbNewDoubleObj, /* 24 */ Tcl_DbNewListObj, /* 25 */ - Tcl_DbNewLongObj, /* 26 */ + 0, /* 26 */ Tcl_DbNewObj, /* 27 */ Tcl_DbNewStringObj, /* 28 */ Tcl_DuplicateObj, /* 29 */ - TclOldFreeObj, /* 30 */ + 0, /* 30 */ Tcl_GetBoolean, /* 31 */ Tcl_GetBooleanFromObj, /* 32 */ Tcl_GetByteArrayFromObj, /* 33 */ Tcl_GetDouble, /* 34 */ Tcl_GetDoubleFromObj, /* 35 */ - Tcl_GetIndexFromObj, /* 36 */ + 0, /* 36 */ Tcl_GetInt, /* 37 */ Tcl_GetIntFromObj, /* 38 */ Tcl_GetLongFromObj, /* 39 */ @@ -1093,25 +828,25 @@ const TclStubs tclStubs = { Tcl_ListObjIndex, /* 46 */ Tcl_ListObjLength, /* 47 */ Tcl_ListObjReplace, /* 48 */ - Tcl_NewBooleanObj, /* 49 */ + 0, /* 49 */ Tcl_NewByteArrayObj, /* 50 */ Tcl_NewDoubleObj, /* 51 */ - Tcl_NewIntObj, /* 52 */ + 0, /* 52 */ Tcl_NewListObj, /* 53 */ - Tcl_NewLongObj, /* 54 */ + 0, /* 54 */ Tcl_NewObj, /* 55 */ Tcl_NewStringObj, /* 56 */ - Tcl_SetBooleanObj, /* 57 */ + 0, /* 57 */ Tcl_SetByteArrayLength, /* 58 */ Tcl_SetByteArrayObj, /* 59 */ Tcl_SetDoubleObj, /* 60 */ - Tcl_SetIntObj, /* 61 */ + 0, /* 61 */ Tcl_SetListObj, /* 62 */ - Tcl_SetLongObj, /* 63 */ + 0, /* 63 */ Tcl_SetObjLength, /* 64 */ Tcl_SetStringObj, /* 65 */ - Tcl_AddErrorInfo, /* 66 */ - Tcl_AddObjErrorInfo, /* 67 */ + 0, /* 66 */ + 0, /* 67 */ Tcl_AllowExceptions, /* 68 */ Tcl_AppendElement, /* 69 */ Tcl_AppendResult, /* 70 */ @@ -1121,7 +856,7 @@ const TclStubs tclStubs = { Tcl_AsyncMark, /* 74 */ Tcl_AsyncReady, /* 75 */ Tcl_BackgroundError, /* 76 */ - Tcl_Backslash, /* 77 */ + 0, /* 77 */ Tcl_BadChannelOption, /* 78 */ Tcl_CallWhenDeleted, /* 79 */ Tcl_CancelIdleCall, /* 80 */ @@ -1139,7 +874,7 @@ const TclStubs tclStubs = { Tcl_CreateEventSource, /* 92 */ Tcl_CreateExitHandler, /* 93 */ Tcl_CreateInterp, /* 94 */ - Tcl_CreateMathFunc, /* 95 */ + 0, /* 95 */ Tcl_CreateObjCommand, /* 96 */ Tcl_CreateSlave, /* 97 */ Tcl_CreateTimerHandler, /* 98 */ @@ -1173,9 +908,9 @@ const TclStubs tclStubs = { Tcl_Eof, /* 126 */ Tcl_ErrnoId, /* 127 */ Tcl_ErrnoMsg, /* 128 */ - Tcl_Eval, /* 129 */ + 0, /* 129 */ Tcl_EvalFile, /* 130 */ - Tcl_EvalObj, /* 131 */ + 0, /* 131 */ Tcl_EventuallyFree, /* 132 */ Tcl_Exit, /* 133 */ Tcl_ExposeCommand, /* 134 */ @@ -1188,7 +923,7 @@ const TclStubs tclStubs = { Tcl_ExprObj, /* 141 */ Tcl_ExprString, /* 142 */ Tcl_Finalize, /* 143 */ - Tcl_FindExecutable, /* 144 */ + 0, /* 144 */ Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ Tcl_FreeResult, /* 147 */ @@ -1227,10 +962,10 @@ const TclStubs tclStubs = { Tcl_GetSlave, /* 172 */ Tcl_GetStdChannel, /* 173 */ Tcl_GetStringResult, /* 174 */ - Tcl_GetVar, /* 175 */ + 0, /* 175 */ Tcl_GetVar2, /* 176 */ - Tcl_GlobalEval, /* 177 */ - Tcl_GlobalEvalObj, /* 178 */ + 0, /* 177 */ + 0, /* 178 */ Tcl_HideCommand, /* 179 */ Tcl_Init, /* 180 */ Tcl_InitHashTable, /* 181 */ @@ -1272,7 +1007,7 @@ const TclStubs tclStubs = { Tcl_ResetResult, /* 217 */ Tcl_ScanElement, /* 218 */ Tcl_ScanCountedElement, /* 219 */ - Tcl_SeekOld, /* 220 */ + 0, /* 220 */ Tcl_ServiceAll, /* 221 */ Tcl_ServiceEvent, /* 222 */ Tcl_SetAssocData, /* 223 */ @@ -1282,55 +1017,55 @@ const TclStubs tclStubs = { Tcl_SetErrno, /* 227 */ Tcl_SetErrorCode, /* 228 */ Tcl_SetMaxBlockTime, /* 229 */ - Tcl_SetPanicProc, /* 230 */ + 0, /* 230 */ Tcl_SetRecursionLimit, /* 231 */ - Tcl_SetResult, /* 232 */ + 0, /* 232 */ Tcl_SetServiceMode, /* 233 */ Tcl_SetObjErrorCode, /* 234 */ Tcl_SetObjResult, /* 235 */ Tcl_SetStdChannel, /* 236 */ - Tcl_SetVar, /* 237 */ + 0, /* 237 */ Tcl_SetVar2, /* 238 */ Tcl_SignalId, /* 239 */ Tcl_SignalMsg, /* 240 */ Tcl_SourceRCFile, /* 241 */ Tcl_SplitList, /* 242 */ Tcl_SplitPath, /* 243 */ - Tcl_StaticPackage, /* 244 */ + 0, /* 244 */ Tcl_StringMatch, /* 245 */ - Tcl_TellOld, /* 246 */ - Tcl_TraceVar, /* 247 */ + 0, /* 246 */ + 0, /* 247 */ Tcl_TraceVar2, /* 248 */ Tcl_TranslateFileName, /* 249 */ Tcl_Ungets, /* 250 */ Tcl_UnlinkVar, /* 251 */ Tcl_UnregisterChannel, /* 252 */ - Tcl_UnsetVar, /* 253 */ + 0, /* 253 */ Tcl_UnsetVar2, /* 254 */ - Tcl_UntraceVar, /* 255 */ + 0, /* 255 */ Tcl_UntraceVar2, /* 256 */ Tcl_UpdateLinkedVar, /* 257 */ - Tcl_UpVar, /* 258 */ + 0, /* 258 */ Tcl_UpVar2, /* 259 */ Tcl_VarEval, /* 260 */ - Tcl_VarTraceInfo, /* 261 */ + 0, /* 261 */ Tcl_VarTraceInfo2, /* 262 */ Tcl_Write, /* 263 */ Tcl_WrongNumArgs, /* 264 */ Tcl_DumpActiveMemory, /* 265 */ Tcl_ValidateAllMemory, /* 266 */ - Tcl_AppendResultVA, /* 267 */ - Tcl_AppendStringsToObjVA, /* 268 */ + 0, /* 267 */ + 0, /* 268 */ Tcl_HashStats, /* 269 */ Tcl_ParseVar, /* 270 */ - Tcl_PkgPresent, /* 271 */ + 0, /* 271 */ Tcl_PkgPresentEx, /* 272 */ - Tcl_PkgProvide, /* 273 */ - Tcl_PkgRequire, /* 274 */ - Tcl_SetErrorCodeVA, /* 275 */ - Tcl_VarEvalVA, /* 276 */ + 0, /* 273 */ + 0, /* 274 */ + 0, /* 275 */ + 0, /* 276 */ Tcl_WaitPid, /* 277 */ - Tcl_PanicVA, /* 278 */ + 0, /* 278 */ Tcl_GetVersion, /* 279 */ Tcl_InitMemory, /* 280 */ Tcl_StackChannel, /* 281 */ @@ -1342,7 +1077,7 @@ const TclStubs tclStubs = { Tcl_CreateEncoding, /* 287 */ Tcl_CreateThreadExitHandler, /* 288 */ Tcl_DeleteThreadExitHandler, /* 289 */ - Tcl_DiscardResult, /* 290 */ + 0, /* 290 */ Tcl_EvalEx, /* 291 */ Tcl_EvalObjv, /* 292 */ Tcl_EvalObjEx, /* 293 */ @@ -1366,8 +1101,8 @@ const TclStubs tclStubs = { Tcl_ConditionWait, /* 311 */ Tcl_NumUtfChars, /* 312 */ Tcl_ReadChars, /* 313 */ - Tcl_RestoreResult, /* 314 */ - Tcl_SaveResult, /* 315 */ + 0, /* 314 */ + 0, /* 315 */ Tcl_SetSystemEncoding, /* 316 */ Tcl_SetVar2Ex, /* 317 */ Tcl_ThreadAlert, /* 318 */ @@ -1393,8 +1128,8 @@ const TclStubs tclStubs = { Tcl_WriteChars, /* 338 */ Tcl_WriteObj, /* 339 */ Tcl_GetString, /* 340 */ - Tcl_GetDefaultEncodingDir, /* 341 */ - Tcl_SetDefaultEncodingDir, /* 342 */ + 0, /* 341 */ + 0, /* 342 */ Tcl_AlertNotifier, /* 343 */ Tcl_ServiceModeHook, /* 344 */ Tcl_UniCharIsAlnum, /* 345 */ @@ -1409,7 +1144,7 @@ const TclStubs tclStubs = { Tcl_UniCharToUtfDString, /* 354 */ Tcl_UtfToUniCharDString, /* 355 */ Tcl_GetRegExpFromObj, /* 356 */ - Tcl_EvalTokens, /* 357 */ + 0, /* 357 */ Tcl_FreeParse, /* 358 */ Tcl_LogCommandInfo, /* 359 */ Tcl_ParseBraces, /* 360 */ @@ -1434,7 +1169,7 @@ const TclStubs tclStubs = { Tcl_SetUnicodeObj, /* 379 */ Tcl_GetCharLength, /* 380 */ Tcl_GetUniChar, /* 381 */ - Tcl_GetUnicode, /* 382 */ + 0, /* 382 */ Tcl_GetRange, /* 383 */ Tcl_AppendUnicodeToObj, /* 384 */ Tcl_RegExpMatchObj, /* 385 */ @@ -1473,8 +1208,8 @@ const TclStubs tclStubs = { Tcl_IsChannelExisting, /* 418 */ Tcl_UniCharNcasecmp, /* 419 */ Tcl_UniCharCaseMatch, /* 420 */ - Tcl_FindHashEntry, /* 421 */ - Tcl_CreateHashEntry, /* 422 */ + 0, /* 421 */ + 0, /* 422 */ Tcl_InitCustomHashTable, /* 423 */ Tcl_InitObjHashTable, /* 424 */ Tcl_CommandTraceInfo, /* 425 */ @@ -1487,8 +1222,8 @@ const TclStubs tclStubs = { Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ Tcl_GetUnicodeFromObj, /* 434 */ - Tcl_GetMathFuncInfo, /* 435 */ - Tcl_ListMathFuncs, /* 436 */ + 0, /* 435 */ + 0, /* 436 */ Tcl_SubstObj, /* 437 */ Tcl_DetachChannel, /* 438 */ Tcl_IsStandardChannel, /* 439 */ @@ -1571,7 +1306,7 @@ const TclStubs tclStubs = { Tcl_GetCommandFromObj, /* 516 */ Tcl_GetCommandFullName, /* 517 */ Tcl_FSEvalFileEx, /* 518 */ - Tcl_SetExitProc, /* 519 */ + 0, /* 519 */ Tcl_LimitAddHandler, /* 520 */ Tcl_LimitRemoveHandler, /* 521 */ Tcl_LimitReady, /* 522 */ diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 5261591..b26fb01 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -66,8 +66,8 @@ Tcl_InitStubs( */ if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) { - iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism"; - iPtr->freeProc = 0; + iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism"; + iPtr->legacyFreeProc = 0; /* TCL_STATIC */ return NULL; } diff --git a/generic/tclTest.c b/generic/tclTest.c index 3ebd91d..08669db 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -220,7 +220,7 @@ static int ObjTraceProc(void *clientData, Tcl_Obj *const objv[]); static void ObjTraceDeleteProc(void *clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); -static void SpecialFree(char *blockPtr); +static void SpecialFree(void *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static int TestasyncCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); @@ -346,7 +346,7 @@ static void TestregexpXflags(const char *string, static int TestsaveresultCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static void TestsaveresultFree(char *blockPtr); +static void TestsaveresultFree(void *blockPtr); static int TestsetassocdataCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(void *dummy, @@ -843,8 +843,8 @@ TestasyncCmd( if (argc != 3) { goto wrongNumArgs; } - asyncPtr = ckalloc(sizeof(TestAsyncHandler)); - asyncPtr->command = ckalloc(strlen(argv[2]) + 1); + asyncPtr = Tcl_Alloc(sizeof(TestAsyncHandler)); + asyncPtr->command = Tcl_Alloc(strlen(argv[2]) + 1); strcpy(asyncPtr->command, argv[2]); Tcl_MutexLock(&asyncTestMutex); asyncPtr->id = nextId; @@ -862,8 +862,8 @@ TestasyncCmd( asyncPtr = firstHandler; firstHandler = asyncPtr->nextPtr; Tcl_AsyncDelete(asyncPtr->handler); - ckfree(asyncPtr->command); - ckfree(asyncPtr); + Tcl_Free(asyncPtr->command); + Tcl_Free(asyncPtr); } Tcl_MutexUnlock(&asyncTestMutex); return TCL_OK; @@ -886,8 +886,8 @@ TestasyncCmd( prevPtr->nextPtr = asyncPtr->nextPtr; } Tcl_AsyncDelete(asyncPtr->handler); - ckfree(asyncPtr->command); - ckfree(asyncPtr); + Tcl_Free(asyncPtr->command); + Tcl_Free(asyncPtr); break; } Tcl_MutexUnlock(&asyncTestMutex); @@ -958,7 +958,8 @@ AsyncHandlerProc( { TestAsyncHandler *asyncPtr; int id = PTR2INT(clientData); - const char *listArgv[4], *cmd; + const char *listArgv[4]; + char *cmd; char string[TCL_INTEGER_SPACE]; Tcl_MutexLock(&asyncTestMutex); @@ -987,7 +988,7 @@ AsyncHandlerProc( * invoked, it's possible. Better error checking is needed here. */ } - ckfree(cmd); + Tcl_Free(cmd); return code; } @@ -1615,9 +1616,9 @@ TestdelCmd( return TCL_ERROR; } - dPtr = ckalloc(sizeof(DelCmd)); + dPtr = Tcl_Alloc(sizeof(DelCmd)); dPtr->interp = interp; - dPtr->deleteCmd = ckalloc(strlen(argv[3]) + 1); + dPtr->deleteCmd = Tcl_Alloc(strlen(argv[3]) + 1); strcpy(dPtr->deleteCmd, argv[3]); Tcl_CreateCommand(slave, argv[2], DelCmdProc, dPtr, @@ -1635,8 +1636,8 @@ DelCmdProc( DelCmd *dPtr = (DelCmd *) clientData; Tcl_AppendResult(interp, dPtr->deleteCmd, NULL); - ckfree(dPtr->deleteCmd); - ckfree(dPtr); + Tcl_Free(dPtr->deleteCmd); + Tcl_Free(dPtr); return TCL_OK; } @@ -1648,8 +1649,8 @@ DelDeleteProc( Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0); Tcl_ResetResult(dPtr->interp); - ckfree(dPtr->deleteCmd); - ckfree(dPtr); + Tcl_Free(dPtr->deleteCmd); + Tcl_Free(dPtr); } /* @@ -1773,7 +1774,7 @@ TestdoubledigitsObjCmd(void *unused, } str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr); strObj = Tcl_NewStringObj(str, endPtr-str); - ckfree(str); + Tcl_Free(str); retval = Tcl_NewListObj(1, &strObj); Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt)); strObj = Tcl_NewStringObj(signum ? "-" : "+", 1); @@ -1851,11 +1852,11 @@ TestdstringCmd( } else if (strcmp(argv[2], "staticlarge") == 0) { Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL); } else if (strcmp(argv[2], "free") == 0) { - char *s = ckalloc(100); + char *s = Tcl_Alloc(100); strcpy(s, "This is a malloc-ed string"); Tcl_SetResult(interp, s, TCL_DYNAMIC); } else if (strcmp(argv[2], "special") == 0) { - char *s = (char*)ckalloc(100) + 16; + char *s = (char*)Tcl_Alloc(100) + 16; strcpy(s, "This is a specially-allocated string"); Tcl_SetResult(interp, s, SpecialFree); } else { @@ -1904,9 +1905,9 @@ TestdstringCmd( */ static void SpecialFree(blockPtr) - char *blockPtr; /* Block to free. */ + void *blockPtr; /* Block to free. */ { - ckfree(blockPtr - 16); + Tcl_Free(((char *)blockPtr) - 16); } /* @@ -1957,15 +1958,15 @@ TestencodingObjCmd( if (objc != 5) { return TCL_ERROR; } - encodingPtr = ckalloc(sizeof(TclEncoding)); + encodingPtr = Tcl_Alloc(sizeof(TclEncoding)); encodingPtr->interp = interp; string = Tcl_GetStringFromObj(objv[3], &length); - encodingPtr->toUtfCmd = ckalloc(length + 1); + encodingPtr->toUtfCmd = Tcl_Alloc(length + 1); memcpy(encodingPtr->toUtfCmd, string, length + 1); string = Tcl_GetStringFromObj(objv[4], &length); - encodingPtr->fromUtfCmd = ckalloc(length + 1); + encodingPtr->fromUtfCmd = Tcl_Alloc(length + 1); memcpy(encodingPtr->fromUtfCmd, string, length + 1); string = Tcl_GetStringFromObj(objv[2], &length); @@ -2065,9 +2066,9 @@ EncodingFreeProc( { TclEncoding *encodingPtr = clientData; - ckfree(encodingPtr->toUtfCmd); - ckfree(encodingPtr->fromUtfCmd); - ckfree(encodingPtr); + Tcl_Free(encodingPtr->toUtfCmd); + Tcl_Free(encodingPtr->fromUtfCmd); + Tcl_Free(encodingPtr); } /* @@ -2222,7 +2223,7 @@ TesteventObjCmd( "position specifier", TCL_EXACT, &posIndex) != TCL_OK) { return TCL_ERROR; } - ev = ckalloc(sizeof(TestEvent)); + ev = Tcl_Alloc(sizeof(TestEvent)); ev->header.proc = TesteventProc; ev->header.nextPtr = NULL; ev->interp = interp; @@ -3075,12 +3076,12 @@ TestlinkCmd( } if (argv[5][0] != 0) { if (stringVar != NULL) { - ckfree(stringVar); + Tcl_Free(stringVar); } if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { - stringVar = ckalloc(strlen(argv[5]) + 1); + stringVar = Tcl_Alloc(strlen(argv[5]) + 1); strcpy(stringVar, argv[5]); } } @@ -3182,12 +3183,12 @@ TestlinkCmd( } if (argv[5][0] != 0) { if (stringVar != NULL) { - ckfree(stringVar); + Tcl_Free(stringVar); } if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { - stringVar = ckalloc(strlen(argv[5]) + 1); + stringVar = Tcl_Alloc(strlen(argv[5]) + 1); strcpy(stringVar, argv[5]); } Tcl_UpdateLinkedVar(interp, "string"); @@ -3361,7 +3362,7 @@ CleanupTestSetassocdataTests( void *clientData, /* Data to be released. */ Tcl_Interp *interp) /* Interpreter being deleted. */ { - ckfree(clientData); + Tcl_Free(clientData); } /* @@ -4127,7 +4128,7 @@ TestsetassocdataCmd( return TCL_ERROR; } - buf = ckalloc(strlen(argv[2]) + 1); + buf = Tcl_Alloc(strlen(argv[2]) + 1); strcpy(buf, argv[2]); /* @@ -4137,7 +4138,7 @@ TestsetassocdataCmd( oldData = (char *) Tcl_GetAssocData(interp, argv[1], &procPtr); if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) { - ckfree(oldData); + Tcl_Free(oldData); } Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, buf); @@ -4527,7 +4528,7 @@ TestpanicCmd( argString = Tcl_Merge(argc-1, argv+1); Tcl_Panic("%s", argString); - ckfree(argString); + Tcl_Free(argString); return TCL_OK; } @@ -4707,8 +4708,8 @@ GetTimesObjCmd( fprintf(stderr, "alloc & free 100000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { - objPtr = ckalloc(sizeof(Tcl_Obj)); - ckfree(objPtr); + objPtr = Tcl_Alloc(sizeof(Tcl_Obj)); + Tcl_Free(objPtr); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -4716,10 +4717,10 @@ GetTimesObjCmd( /* alloc 5000 times */ fprintf(stderr, "alloc 5000 6 word items\n"); - objv = ckalloc(5000 * sizeof(Tcl_Obj *)); + objv = Tcl_Alloc(5000 * sizeof(Tcl_Obj *)); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { - objv[i] = ckalloc(sizeof(Tcl_Obj)); + objv[i] = Tcl_Alloc(sizeof(Tcl_Obj)); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -4729,7 +4730,7 @@ GetTimesObjCmd( fprintf(stderr, "free 5000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { - ckfree(objv[i]); + Tcl_Free(objv[i]); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -4755,7 +4756,7 @@ GetTimesObjCmd( Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_DecrRefCount\n", timePer/5000); - ckfree(objv); + Tcl_Free(objv); /* TclGetString 100000 times */ fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n"); @@ -4981,7 +4982,7 @@ TestpurebytesobjObjCmd( if (objc == 2) { const char *s = Tcl_GetString(objv[1]); objPtr->length = objv[1]->length; - objPtr->bytes = ckalloc(objPtr->length + 1); + objPtr->bytes = Tcl_Alloc(objPtr->length + 1); memcpy(objPtr->bytes, s, objPtr->length); objPtr->bytes[objPtr->length] = 0; } @@ -5133,7 +5134,6 @@ TestsaveresultCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; @@ -5170,7 +5170,7 @@ TestsaveresultCmd( Tcl_AppendResult(interp, "append result", NULL); break; case RESULT_FREE: { - char *buf = ckalloc(200); + char *buf = Tcl_Alloc(200); strcpy(buf, "free result"); Tcl_SetResult(interp, buf, TCL_DYNAMIC); @@ -5201,12 +5201,9 @@ TestsaveresultCmd( } switch ((enum options) index) { - case RESULT_DYNAMIC: { - int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount; - - Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak"); + case RESULT_DYNAMIC: + Tcl_AppendElement(interp, freeCount ? "freed" : "leak"); break; - } case RESULT_OBJECT: Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr ? "same" : "different"); @@ -5235,7 +5232,7 @@ TestsaveresultCmd( static void TestsaveresultFree( - char *blockPtr) + void *blockPtr) { freeCount++; } @@ -5422,7 +5419,7 @@ TestChannelCmd( *nextPtrPtr = curPtr->nextPtr; curPtr->nextPtr = NULL; chan = curPtr->chan; - ckfree(curPtr); + Tcl_Free(curPtr); break; } } @@ -5492,7 +5489,7 @@ TestChannelCmd( /* Remember the channel in the pool of detached channels */ - det = ckalloc(sizeof(TestChannel)); + det = Tcl_Alloc(sizeof(TestChannel)); det->chan = chan; det->nextPtr = firstDetached; firstDetached = det; @@ -5890,7 +5887,7 @@ TestChannelEventCmd( return TCL_ERROR; } - esPtr = ckalloc(sizeof(EventScriptRecord)); + esPtr = Tcl_Alloc(sizeof(EventScriptRecord)); esPtr->nextPtr = statePtr->scriptRecordPtr; statePtr->scriptRecordPtr = esPtr; @@ -5947,7 +5944,7 @@ TestChannelEventCmd( Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + Tcl_Free(esPtr); return TCL_OK; } @@ -5988,7 +5985,7 @@ TestChannelEventCmd( Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + Tcl_Free(esPtr); } statePtr->scriptRecordPtr = NULL; return TCL_OK; @@ -6932,7 +6929,7 @@ TestHashSystemHashCmd( Tcl_SetHashValue(hPtr, INT2PTR(i+42)); } - if (hash.numEntries != limit) { + if (hash.numEntries != (size_t)limit) { Tcl_AppendResult(interp, "unexpected maximal size", NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; @@ -7008,7 +7005,7 @@ TestlongsizeCmd( Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long))); + Tcl_SetObjResult(interp, Tcl_NewIntObj(sizeof(long))); return TCL_OK; } @@ -7031,9 +7028,9 @@ NREUnwind_callback( &none, NULL); } else { Tcl_Obj *idata[3]; - idata[0] = Tcl_NewIntObj((int) ((char *) data[1] - (char *) data[0])); - idata[1] = Tcl_NewIntObj((int) ((char *) data[2] - (char *) data[0])); - idata[2] = Tcl_NewIntObj((int) ((char *) &none - (char *) data[0])); + idata[0] = Tcl_NewIntObj(((char *) data[1] - (char *) data[0])); + idata[1] = Tcl_NewIntObj(((char *) data[2] - (char *) data[0])); + idata[2] = Tcl_NewIntObj(((char *) &none - (char *) data[0])); Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata)); } return TCL_OK; @@ -7433,7 +7430,7 @@ TestparseargsCmd( result[1] = Tcl_NewIntObj(count); result[2] = Tcl_NewListObj(count, remObjv); Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); - ckfree(remObjv); + Tcl_Free(remObjv); return TCL_OK; } @@ -7560,7 +7557,7 @@ HashVarFree( Tcl_Var var) { if (VarHashRefCount(var) < 2) { - ckfree(var); + Tcl_Free(var); } else { VarHashRefCount(var)--; } @@ -7576,7 +7573,7 @@ MyCompiledVarFree( if (resVarInfo->var) { HashVarFree(resVarInfo->var); } - ckfree(vInfoPtr); + Tcl_Free(vInfoPtr); } #define TclVarHashGetValue(hPtr) \ @@ -7619,7 +7616,7 @@ MyCompiledVarFetch( resVarInfo->var = var; /* - * Increment the reference counter to avoid ckfree() of the variable in + * Increment the reference counter to avoid Tcl_Free() of the variable in * Tcl's FreeVarEntry(); for cleanup, we provide our own HashVarFree(); */ @@ -7636,7 +7633,7 @@ InterpCompiledVarResolver( Tcl_ResolvedVarInfo **rPtr) { if (*name == 'T') { - MyResolvedVarInfo *resVarInfo = ckalloc(sizeof(MyResolvedVarInfo)); + MyResolvedVarInfo *resVarInfo = Tcl_Alloc(sizeof(MyResolvedVarInfo)); resVarInfo->vInfo.fetchProc = MyCompiledVarFetch; resVarInfo->vInfo.deleteProc = MyCompiledVarFree; diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 67b1997..0a7e8b1 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -59,7 +59,7 @@ static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp) if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); } Tcl_DeleteAssocData(interp, VARPTR_KEY); - ckfree(varPtr); + Tcl_Free(varPtr); } static Tcl_Obj **GetVarPtr(Tcl_Interp *interp) @@ -99,7 +99,7 @@ TclObjTest_Init( */ Tcl_Obj **varPtr; - varPtr = (Tcl_Obj **) ckalloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0])); + varPtr = (Tcl_Obj **) Tcl_Alloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0])); if (!varPtr) { return TCL_ERROR; } @@ -576,8 +576,8 @@ TestindexobjCmd( */ struct IndexRep { void *tablePtr; /* Pointer to the table of strings. */ - int offset; /* Offset between table entries. */ - int index; /* Selected index into table. */ + size_t offset; /* Offset between table entries. */ + size_t index; /* Selected index into table. */ }; struct IndexRep *indexRep; @@ -616,7 +616,7 @@ TestindexobjCmd( return TCL_ERROR; } - argv = ckalloc((objc-3) * sizeof(char *)); + argv = Tcl_Alloc((objc-3) * sizeof(char *)); for (i = 4; i < objc; i++) { argv[i-4] = Tcl_GetString(objv[i]); } @@ -625,7 +625,7 @@ TestindexobjCmd( result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3], argv, "token", INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT), &index); - ckfree(argv); + Tcl_Free(argv); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), index); } @@ -1273,8 +1273,8 @@ TeststringobjCmd( if (objc != 3) { goto wrongNumArgs; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) - ? varPtr[varIndex]->length : -1); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) + ? (Tcl_WideInt)varPtr[varIndex]->length : (Tcl_WideInt)-1); break; case 5: /* length2 */ if (objc != 3) { @@ -1348,7 +1348,7 @@ TeststringobjCmd( if (objc != 3) { goto wrongNumArgs; } - Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL); + Tcl_GetUnicode(varPtr[varIndex]); break; case 11: /* appendself */ if (objc != 4) { diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 4d32c5a..42fbea9 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -34,7 +34,7 @@ static const char procCommand[] = "proc"; * procs */ -typedef struct CmdTable { +typedef struct { const char *cmdName; /* command name */ Tcl_ObjCmdProc *proc; /* command proc */ int exportIt; /* if 1, export the command */ diff --git a/generic/tclThread.c b/generic/tclThread.c index cafd824..45b0af2 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -61,7 +61,7 @@ static void RememberSyncObject(void *objPtr, void * Tcl_GetThreadData( Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk */ - int size) /* Size of storage block */ + size_t size) /* Size of storage block */ { void *result; #if TCL_THREADS @@ -72,14 +72,14 @@ Tcl_GetThreadData( result = TclThreadStorageKeyGet(keyPtr); if (result == NULL) { - result = ckalloc(size); - memset(result, 0, (size_t) size); + result = Tcl_Alloc(size); + memset(result, 0, size); TclThreadStorageKeySet(keyPtr, result); } #else /* TCL_THREADS */ if (*keyPtr == NULL) { - result = ckalloc(size); - memset(result, 0, (size_t)size); + result = Tcl_Alloc(size); + memset(result, 0, size); *keyPtr = result; RememberSyncObject(keyPtr, &keyRecord); } else { @@ -164,14 +164,14 @@ RememberSyncObject( if (recPtr->num >= recPtr->max) { recPtr->max += 8; - newList = ckalloc(recPtr->max * sizeof(void *)); + newList = Tcl_Alloc(recPtr->max * sizeof(void *)); for (i=0,j=0 ; i<recPtr->num ; i++) { if (recPtr->list[i] != NULL) { newList[j++] = recPtr->list[i]; } } if (recPtr->list != NULL) { - ckfree(recPtr->list); + Tcl_Free(recPtr->list); } recPtr->list = newList; recPtr->num = j; @@ -392,9 +392,9 @@ TclFinalizeSynchronization(void) for (i=0 ; i<keyRecord.num ; i++) { keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i]; blockPtr = *keyPtr; - ckfree(blockPtr); + Tcl_Free(blockPtr); } - ckfree(keyRecord.list); + Tcl_Free(keyRecord.list); keyRecord.list = NULL; } keyRecord.max = 0; @@ -414,7 +414,7 @@ TclFinalizeSynchronization(void) } } if (mutexRecord.list != NULL) { - ckfree(mutexRecord.list); + Tcl_Free(mutexRecord.list); mutexRecord.list = NULL; } mutexRecord.max = 0; @@ -427,7 +427,7 @@ TclFinalizeSynchronization(void) } } if (condRecord.list != NULL) { - ckfree(condRecord.list); + Tcl_Free(condRecord.list); condRecord.list = NULL; } condRecord.max = 0; diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 3f1abc2..cd57d2e 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -82,18 +82,18 @@ typedef union Block { * and statistics information. */ -typedef struct Bucket { +typedef struct { Block *firstPtr; /* First block available */ Block *lastPtr; /* End of block list */ - long numFree; /* Number of blocks available */ + size_t numFree; /* Number of blocks available */ /* All fields below for accounting only */ - long numRemoves; /* Number of removes from bucket */ - long numInserts; /* Number of inserts into bucket */ - long numWaits; /* Number of waits to acquire a lock */ - long numLocks; /* Number of locks acquired */ - long totalAssigned; /* Total space assigned to bucket */ + size_t numRemoves; /* Number of removes from bucket */ + size_t numInserts; /* Number of inserts into bucket */ + size_t numWaits; /* Number of waits to acquire a lock */ + size_t numLocks; /* Number of locks acquired */ + size_t totalAssigned; /* Total space assigned to bucket */ } Bucket; /* @@ -120,8 +120,8 @@ typedef struct Cache { static struct { size_t blockSize; /* Bucket blocksize. */ - int maxBlocks; /* Max blocks before move to share. */ - int numMove; /* Num blocks to move to share. */ + size_t maxBlocks; /* Max blocks before move to share. */ + size_t numMove; /* Num blocks to move to share. */ Tcl_Mutex *lockPtr; /* Share bucket lock. */ } bucketInfo[NBUCKETS]; @@ -211,7 +211,7 @@ GetCache(void) cachePtr = TclpGetAllocCache(); if (cachePtr == NULL) { - cachePtr = TclpSysAlloc(sizeof(Cache), 0); + cachePtr = TclpSysAlloc(sizeof(Cache)); if (cachePtr == NULL) { Tcl_Panic("alloc: could not allocate new cache"); } @@ -299,9 +299,9 @@ TclFreeAllocCache( *---------------------------------------------------------------------- */ -char * +void * TclpAlloc( - unsigned int reqSize) + size_t reqSize) { Cache *cachePtr; Block *blockPtr; @@ -314,7 +314,7 @@ TclpAlloc( const size_t zero = 0; const size_t max = ~zero; - if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) { + if (reqSize > max - sizeof(Block) - RCHECK) { /* Requested allocation exceeds memory */ return NULL; } @@ -337,7 +337,7 @@ TclpAlloc( #endif if (size > MAXALLOC) { bucket = NBUCKETS; - blockPtr = TclpSysAlloc(size, 0); + blockPtr = TclpSysAlloc(size); if (blockPtr != NULL) { cachePtr->totalAssigned += reqSize; } @@ -378,7 +378,7 @@ TclpAlloc( void TclpFree( - char *ptr) + void *ptr) { Cache *cachePtr; Block *blockPtr; @@ -435,10 +435,10 @@ TclpFree( *---------------------------------------------------------------------- */ -char * +void * TclpRealloc( - char *ptr, - unsigned int reqSize) + void *ptr, + size_t reqSize) { Cache *cachePtr; Block *blockPtr; @@ -456,7 +456,7 @@ TclpRealloc( const size_t zero = 0; const size_t max = ~zero; - if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) { + if ((reqSize) > max - sizeof(Block) - RCHECK) { /* Requested allocation exceeds memory */ return NULL; } @@ -563,7 +563,7 @@ TclThreadAllocObj(void) Tcl_Obj *newObjsPtr; cachePtr->numObjects = numMove = NOBJALLOC; - newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0); + newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove); if (newObjsPtr == NULL) { Tcl_Panic("alloc: could not allocate %d new objects", numMove); } @@ -671,8 +671,8 @@ Tcl_GetMemoryInfo( Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { - sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld", - (unsigned long) bucketInfo[n].blockSize, + sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d", + bucketInfo[n].blockSize, cachePtr->buckets[n].numFree, cachePtr->buckets[n].numRemoves, cachePtr->buckets[n].numInserts, @@ -961,7 +961,7 @@ GetBlocks( int bucket) { register Block *blockPtr; - register int n; + register size_t n; /* * First, atttempt to move blocks from the shared cache. Note the @@ -1016,7 +1016,7 @@ GetBlocks( blockPtr = NULL; n = NBUCKETS; size = 0; /* lint */ - while (--n > bucket) { + while (--n > (size_t)bucket) { if (cachePtr->buckets[n].numFree > 0) { size = bucketInfo[n].blockSize; blockPtr = cachePtr->buckets[n].firstPtr; @@ -1032,7 +1032,7 @@ GetBlocks( if (blockPtr == NULL) { size = MAXALLOC; - blockPtr = TclpSysAlloc(size, 0); + blockPtr = TclpSysAlloc(size); if (blockPtr == NULL) { return 0; } diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c index 5c70a62..66c54a0 100644 --- a/generic/tclThreadJoin.c +++ b/generic/tclThreadJoin.c @@ -201,7 +201,7 @@ TclJoinThread( Tcl_ConditionFinalize(&threadPtr->cond); Tcl_MutexFinalize(&threadPtr->threadMutex); - ckfree(threadPtr); + Tcl_Free(threadPtr); return TCL_OK; } @@ -230,7 +230,7 @@ TclRememberJoinableThread( { JoinableThread *threadPtr; - threadPtr = ckalloc(sizeof(JoinableThread)); + threadPtr = Tcl_Alloc(sizeof(JoinableThread)); threadPtr->id = id; threadPtr->done = 0; threadPtr->waitedUpon = 0; diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c index b56ec80..339cc71 100644 --- a/generic/tclThreadStorage.c +++ b/generic/tclThreadStorage.c @@ -47,7 +47,7 @@ static struct TSDMaster { * The type of the data held per thread in a system TSD. */ -typedef struct TSDTable { +typedef struct { ClientData *tablePtr; /* The table of Tcl TSDs. */ sig_atomic_t allocated; /* The size of the table in the current * thread. */ @@ -85,14 +85,14 @@ TSDTableCreate(void) TSDTable *tsdTablePtr; sig_atomic_t i; - tsdTablePtr = TclpSysAlloc(sizeof(TSDTable), 0); + tsdTablePtr = TclpSysAlloc(sizeof(TSDTable)); if (tsdTablePtr == NULL) { Tcl_Panic("unable to allocate TSDTable"); } tsdTablePtr->allocated = 8; tsdTablePtr->tablePtr = - TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0); + TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated); if (tsdTablePtr->tablePtr == NULL) { Tcl_Panic("unable to allocate TSDTable"); } @@ -117,7 +117,7 @@ TSDTableDelete( * and must now be deallocated or they will leak. */ - ckfree(tsdTablePtr->tablePtr[i]); + Tcl_Free(tsdTablePtr->tablePtr[i]); } } diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index e9b1107..db4ee0d 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -432,10 +432,10 @@ ThreadObjCmd( Tcl_MutexLock(&threadMutex); errorThreadId = Tcl_GetCurrentThread(); if (errorProcString) { - ckfree(errorProcString); + Tcl_Free(errorProcString); } proc = Tcl_GetString(objv[2]); - errorProcString = ckalloc(strlen(proc) + 1); + errorProcString = Tcl_Alloc(strlen(proc) + 1); strcpy(errorProcString, proc); Tcl_MutexUnlock(&threadMutex); return TCL_OK; @@ -595,7 +595,7 @@ NewTestThread( * eval'ing, for the case that we exit during evaluation */ - threadEvalScript = ckalloc(strlen(ctrlPtr->script) + 1); + threadEvalScript = Tcl_Alloc(strlen(ctrlPtr->script) + 1); strcpy(threadEvalScript, ctrlPtr->script); Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript); @@ -670,7 +670,7 @@ ThreadErrorProc( argv[2] = errorInfo; script = Tcl_Merge(3, argv); ThreadSend(interp, errorThreadId, script, 0); - ckfree(script); + Tcl_Free(script); } } @@ -840,13 +840,13 @@ ThreadSend( * Create the event for its event queue. */ - threadEventPtr = ckalloc(sizeof(ThreadEvent)); - threadEventPtr->script = ckalloc(strlen(script) + 1); + threadEventPtr = Tcl_Alloc(sizeof(ThreadEvent)); + threadEventPtr->script = Tcl_Alloc(strlen(script) + 1); strcpy(threadEventPtr->script, script); if (!wait) { resultPtr = threadEventPtr->resultPtr = NULL; } else { - resultPtr = ckalloc(sizeof(ThreadEventResult)); + resultPtr = Tcl_Alloc(sizeof(ThreadEventResult)); threadEventPtr->resultPtr = resultPtr; /* @@ -918,19 +918,19 @@ ThreadSend( if (resultPtr->code != TCL_OK) { if (resultPtr->errorCode) { Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL); - ckfree(resultPtr->errorCode); + Tcl_Free(resultPtr->errorCode); } if (resultPtr->errorInfo) { Tcl_AddErrorInfo(interp, resultPtr->errorInfo); - ckfree(resultPtr->errorInfo); + Tcl_Free(resultPtr->errorInfo); } } Tcl_AppendResult(interp, resultPtr->result, NULL); Tcl_ConditionFinalize(&resultPtr->done); code = resultPtr->code; - ckfree(resultPtr->result); - ckfree(resultPtr); + Tcl_Free(resultPtr->result); + Tcl_Free(resultPtr); return code; } @@ -1038,18 +1038,18 @@ ThreadEventProc( } result = Tcl_GetStringResult(interp); } - ckfree(threadEventPtr->script); + Tcl_Free(threadEventPtr->script); if (resultPtr) { Tcl_MutexLock(&threadMutex); resultPtr->code = code; - resultPtr->result = ckalloc(strlen(result) + 1); + resultPtr->result = Tcl_Alloc(strlen(result) + 1); strcpy(resultPtr->result, result); if (errorCode != NULL) { - resultPtr->errorCode = ckalloc(strlen(errorCode) + 1); + resultPtr->errorCode = Tcl_Alloc(strlen(errorCode) + 1); strcpy(resultPtr->errorCode, errorCode); } if (errorInfo != NULL) { - resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1); + resultPtr->errorInfo = Tcl_Alloc(strlen(errorInfo) + 1); strcpy(resultPtr->errorInfo, errorInfo); } Tcl_ConditionNotify(&resultPtr->done); @@ -1084,7 +1084,7 @@ ThreadFreeProc( ClientData clientData) { if (clientData) { - ckfree(clientData); + Tcl_Free(clientData); } } @@ -1112,7 +1112,7 @@ ThreadDeleteEvent( ClientData clientData) /* dummy */ { if (eventPtr->proc == ThreadEventProc) { - ckfree(((ThreadEvent *) eventPtr)->script); + Tcl_Free(((ThreadEvent *) eventPtr)->script); return 1; } @@ -1159,14 +1159,14 @@ ThreadExitProc( if (self == errorThreadId) { if (errorProcString) { /* Extra safety */ - ckfree(errorProcString); + Tcl_Free(errorProcString); errorProcString = NULL; } errorThreadId = 0; } if (threadEvalScript) { - ckfree(threadEvalScript); + Tcl_Free(threadEvalScript); threadEvalScript = NULL; } Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL); @@ -1189,7 +1189,7 @@ ThreadExitProc( } resultPtr->nextPtr = resultPtr->prevPtr = 0; resultPtr->eventPtr->resultPtr = NULL; - ckfree(resultPtr); + Tcl_Free(resultPtr); } else if (resultPtr->dstThreadId == self) { /* * Dang. The target is going away. Unblock the caller. The result @@ -1199,7 +1199,7 @@ ThreadExitProc( const char *msg = "target thread died"; - resultPtr->result = ckalloc(strlen(msg) + 1); + resultPtr->result = Tcl_Alloc(strlen(msg) + 1); strcpy(resultPtr->result, msg); resultPtr->code = TCL_ERROR; Tcl_ConditionNotify(&resultPtr->done); diff --git a/generic/tclTimer.c b/generic/tclTimer.c index ccfd179..0dbf834 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -222,7 +222,7 @@ TimerExitProc( timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; while (timerHandlerPtr != NULL) { tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; - ckfree(timerHandlerPtr); + Tcl_Free(timerHandlerPtr); timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; } } @@ -297,7 +297,7 @@ TclCreateAbsoluteTimerHandler( register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); - timerHandlerPtr = ckalloc(sizeof(TimerHandler)); + timerHandlerPtr = Tcl_Alloc(sizeof(TimerHandler)); /* * Fill in fields for the event. @@ -373,7 +373,7 @@ Tcl_DeleteTimerHandler( } else { prevPtr->nextPtr = timerHandlerPtr->nextPtr; } - ckfree(timerHandlerPtr); + Tcl_Free(timerHandlerPtr); return; } } @@ -488,7 +488,7 @@ TimerCheckProc( if (blockTime.sec == 0 && blockTime.usec == 0 && !tsdPtr->timerPending) { tsdPtr->timerPending = 1; - timerEvPtr = ckalloc(sizeof(Tcl_Event)); + timerEvPtr = Tcl_Alloc(sizeof(Tcl_Event)); timerEvPtr->proc = TimerHandlerEventProc; Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); } @@ -591,7 +591,7 @@ TimerHandlerEventProc( *nextPtrPtr = timerHandlerPtr->nextPtr; timerHandlerPtr->proc(timerHandlerPtr->clientData); - ckfree(timerHandlerPtr); + Tcl_Free(timerHandlerPtr); } TimerSetupProc(NULL, TCL_TIMER_EVENTS); return 1; @@ -625,7 +625,7 @@ Tcl_DoWhenIdle( Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); - idlePtr = ckalloc(sizeof(IdleHandler)); + idlePtr = Tcl_Alloc(sizeof(IdleHandler)); idlePtr->proc = proc; idlePtr->clientData = clientData; idlePtr->generation = tsdPtr->idleGeneration; @@ -674,7 +674,7 @@ Tcl_CancelIdleCall( while ((idlePtr->proc == proc) && (idlePtr->clientData == clientData)) { nextPtr = idlePtr->nextPtr; - ckfree(idlePtr); + Tcl_Free(idlePtr); idlePtr = nextPtr; if (prevPtr == NULL) { tsdPtr->idleList = idlePtr; @@ -749,7 +749,7 @@ TclServiceIdle(void) tsdPtr->lastIdlePtr = NULL; } idlePtr->proc(idlePtr->clientData); - ckfree(idlePtr); + Tcl_Free(idlePtr); } if (tsdPtr->idleList) { blockTime.sec = 0; @@ -788,7 +788,7 @@ Tcl_AfterObjCmd( Tcl_Time wakeup; AfterInfo *afterPtr; AfterAssocData *assocPtr; - int length; + size_t length; int index = -1; static const char *const afterSubCmds[] = { "cancel", "idle", "info", NULL @@ -808,7 +808,7 @@ Tcl_AfterObjCmd( assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL); if (assocPtr == NULL) { - assocPtr = ckalloc(sizeof(AfterAssocData)); + assocPtr = Tcl_Alloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr); @@ -845,7 +845,7 @@ Tcl_AfterObjCmd( if (objc == 2) { return AfterDelay(interp, ms); } - afterPtr = ckalloc(sizeof(AfterInfo)); + afterPtr = Tcl_Alloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { afterPtr->commandPtr = objv[2]; @@ -883,7 +883,7 @@ Tcl_AfterObjCmd( case AFTER_CANCEL: { Tcl_Obj *commandPtr; const char *command, *tempCommand; - int tempLength; + size_t tempLength; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "id|command"); @@ -900,7 +900,7 @@ Tcl_AfterObjCmd( tempCommand = TclGetStringFromObj(afterPtr->commandPtr, &tempLength); if ((length == tempLength) - && !memcmp(command, tempCommand, (unsigned) length)) { + && !memcmp(command, tempCommand, length)) { break; } } @@ -925,7 +925,7 @@ Tcl_AfterObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?"); return TCL_ERROR; } - afterPtr = ckalloc(sizeof(AfterInfo)); + afterPtr = Tcl_Alloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { afterPtr->commandPtr = objv[2]; @@ -1190,7 +1190,7 @@ AfterProc( */ Tcl_DecrRefCount(afterPtr->commandPtr); - ckfree(afterPtr); + Tcl_Free(afterPtr); } /* @@ -1228,7 +1228,7 @@ FreeAfterPtr( prevPtr->nextPtr = afterPtr->nextPtr; } Tcl_DecrRefCount(afterPtr->commandPtr); - ckfree(afterPtr); + Tcl_Free(afterPtr); } /* @@ -1267,9 +1267,9 @@ AfterCleanupProc( Tcl_CancelIdleCall(AfterProc, afterPtr); } Tcl_DecrRefCount(afterPtr->commandPtr); - ckfree(afterPtr); + Tcl_Free(afterPtr); } - ckfree(assocPtr); + Tcl_Free(assocPtr); } /* diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls index a6c3d5b..c83f9e0 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -223,15 +223,18 @@ declare 63 { # Formerly internal API to allow initialisation of bignums without knowing the # typedefs of how a bignum works internally. -declare 64 {deprecated {Use mp_init() + mp_set_long_long()}} { - void TclBNInitBignumFromLong(mp_int *bignum, long initVal) -} -declare 65 {deprecated {Use mp_init() + mp_set_long_long()}} { - void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal) -} -declare 66 {deprecated {Use mp_init() + mp_set_long_long()}} { - void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal) -} +# Removed in 9.0 +#declare 64 { +# void TclBNInitBignumFromLong(mp_int *bignum, long initVal) +#} +# Removed in 9.0 +#declare 65 { +# void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal) +#} +# Removed in 9.0 +#declare 66 { +# void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal) +#} # Added in libtommath 1.0 declare 67 { diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h index 1e402fd..84e904c 100644 --- a/generic/tclTomMathDecls.h +++ b/generic/tclTomMathDecls.h @@ -31,11 +31,11 @@ /* Define custom memory allocation for libtommath */ /* MODULE_SCOPE void* TclBNAlloc( size_t ); */ -#define TclBNAlloc(s) ((void*)ckalloc((size_t)(s))) +#define TclBNAlloc(s) ((void*)Tcl_Alloc((size_t)(s))) /* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */ -#define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s))) +#define TclBNRealloc(x,s) ((void*)Tcl_Realloc((char*)(x),(size_t)(s))) /* MODULE_SCOPE void TclBNFree( void* ); */ -#define TclBNFree(x) (ckfree((char*)(x))) +#define TclBNFree(x) (Tcl_Free((char*)(x))) /* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */ /* unused - no macro */ @@ -305,17 +305,9 @@ EXTERN int TclBN_mp_init_set_int(mp_int *a, unsigned long i); EXTERN int TclBN_mp_set_int(mp_int *a, unsigned long i); /* 63 */ EXTERN int TclBN_mp_cnt_lsb(const mp_int *a); -/* 64 */ -TCL_DEPRECATED("Use mp_init() + mp_set_long_long()") -void TclBNInitBignumFromLong(mp_int *bignum, long initVal); -/* 65 */ -TCL_DEPRECATED("Use mp_init() + mp_set_long_long()") -void TclBNInitBignumFromWideInt(mp_int *bignum, - Tcl_WideInt initVal); -/* 66 */ -TCL_DEPRECATED("Use mp_init() + mp_set_long_long()") -void TclBNInitBignumFromWideUInt(mp_int *bignum, - Tcl_WideUInt initVal); +/* Slot 64 is reserved */ +/* Slot 65 is reserved */ +/* Slot 66 is reserved */ /* 67 */ EXTERN int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast); @@ -409,9 +401,9 @@ typedef struct TclTomMathStubs { int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */ int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */ int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */ - TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */ - TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */ - TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */ + void (*reserved64)(void); + void (*reserved65)(void); + void (*reserved66)(void); int (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */ int (*tclBN_mp_set_long_long) (mp_int *a, Tcl_WideUInt i); /* 68 */ Tcl_WideUInt (*tclBN_mp_get_long_long) (const mp_int *a); /* 69 */ @@ -564,12 +556,9 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; (tclTomMathStubsPtr->tclBN_mp_set_int) /* 62 */ #define TclBN_mp_cnt_lsb \ (tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */ -#define TclBNInitBignumFromLong \ - (tclTomMathStubsPtr->tclBNInitBignumFromLong) /* 64 */ -#define TclBNInitBignumFromWideInt \ - (tclTomMathStubsPtr->tclBNInitBignumFromWideInt) /* 65 */ -#define TclBNInitBignumFromWideUInt \ - (tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */ +/* Slot 64 is reserved */ +/* Slot 65 is reserved */ +/* Slot 66 is reserved */ #define TclBN_mp_expt_d_ex \ (tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */ #define TclBN_mp_set_long_long \ diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c index 9e7bf4b..8a3d532 100644 --- a/generic/tclTomMathInterface.c +++ b/generic/tclTomMathInterface.c @@ -125,7 +125,7 @@ TclInitBignumFromLong( /* *---------------------------------------------------------------------- * - * TclBNInitBignumFromWideInt -- + * TclInitBignumFromWideInt -- * * Allocate and initialize a 'bignum' from a Tcl_WideInt * @@ -157,7 +157,7 @@ TclInitBignumFromWideInt( /* *---------------------------------------------------------------------- * - * TclBNInitBignumFromWideUInt -- + * TclInitBignumFromWideUInt -- * * Allocate and initialize a 'bignum' from a Tcl_WideUInt * diff --git a/generic/tclTrace.c b/generic/tclTrace.c index db48f7a..13b7528 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -121,7 +121,7 @@ static Tcl_TraceTypeObjCmd *const traceSubCmds[] = { */ static int CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr, - Command *cmdPtr, const char *command, int numChars, + Command *cmdPtr, const char *command, size_t numChars, int objc, Tcl_Obj *const objv[]); static char * TraceVarProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); @@ -271,7 +271,8 @@ Tcl_TraceObjCmd( case TRACE_OLD_VDELETE: { Tcl_Obj *copyObjv[6]; Tcl_Obj *opsList; - int code, numFlags; + int code; + size_t numFlags; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name ops command"); @@ -403,9 +404,9 @@ TraceExecutionObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int commandLength, index; + int index; const char *name, *command; - size_t length; + size_t commandLength, length; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; @@ -469,7 +470,7 @@ TraceExecutionObjCmd( command = TclGetStringFromObj(objv[5], &commandLength); length = (size_t) commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { - TraceCommandInfo *tcmdPtr = ckalloc( + TraceCommandInfo *tcmdPtr = Tcl_Alloc( TclOffset(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; @@ -487,7 +488,7 @@ TraceExecutionObjCmd( name = Tcl_GetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, tcmdPtr) != TCL_OK) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); return TCL_ERROR; } } else { @@ -537,7 +538,7 @@ TraceExecutionObjCmd( Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + Tcl_Free(tcmdPtr->startCmd); } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* @@ -547,7 +548,7 @@ TraceExecutionObjCmd( tcmdPtr->flags = 0; } if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } break; } @@ -651,9 +652,9 @@ TraceCommandObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int commandLength, index; + int index; const char *name, *command; - size_t length; + size_t commandLength, length; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; static const char *const opStrings[] = { "delete", "rename", NULL }; enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME }; @@ -706,7 +707,7 @@ TraceCommandObjCmd( command = TclGetStringFromObj(objv[5], &commandLength); length = (size_t) commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { - TraceCommandInfo *tcmdPtr = ckalloc( + TraceCommandInfo *tcmdPtr = Tcl_Alloc( TclOffset(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; @@ -720,7 +721,7 @@ TraceCommandObjCmd( name = Tcl_GetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, tcmdPtr) != TCL_OK) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); return TCL_ERROR; } } else { @@ -751,7 +752,7 @@ TraceCommandObjCmd( TraceCommandProc, clientData); tcmdPtr->flags |= TCL_TRACE_DESTROYED; if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } break; } @@ -845,9 +846,9 @@ TraceVariableObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int commandLength, index; + int index; const char *name, *command; - size_t length; + size_t commandLength, length; ClientData clientData; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; static const char *const opStrings[] = { @@ -909,7 +910,7 @@ TraceVariableObjCmd( command = TclGetStringFromObj(objv[5], &commandLength); length = (size_t) commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { - CombinedTraceVarInfo *ctvarPtr = ckalloc( + CombinedTraceVarInfo *ctvarPtr = Tcl_Alloc( TclOffset(CombinedTraceVarInfo, traceCmdInfo.command) + 1 + length); @@ -928,7 +929,7 @@ TraceVariableObjCmd( name = Tcl_GetString(objv[3]); if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr) != TCL_OK) { - ckfree(ctvarPtr); + Tcl_Free(ctvarPtr); return TCL_ERROR; } } else { @@ -1126,7 +1127,7 @@ Tcl_TraceCommand( * Set up trace information. */ - tracePtr = ckalloc(sizeof(CommandTrace)); + tracePtr = Tcl_Alloc(sizeof(CommandTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags & @@ -1232,7 +1233,7 @@ Tcl_UntraceCommand( tracePtr->flags = 0; if (tracePtr->refCount-- <= 1) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } if (hasExecTraces) { @@ -1347,7 +1348,7 @@ TraceCommandProc( if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + Tcl_Free(tcmdPtr->startCmd); } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* @@ -1389,7 +1390,7 @@ TraceCommandProc( tcmdPtr->refCount--; } if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } @@ -1423,7 +1424,7 @@ TclCheckExecutionTraces( Tcl_Interp *interp, /* The current interpreter. */ const char *command, /* Pointer to beginning of the current command * string. */ - int numChars, /* The number of characters in 'command' which + size_t numChars, /* The number of characters in 'command' which * are part of the command string. */ Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ @@ -1481,7 +1482,7 @@ TclCheckExecutionTraces( traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel, command, (Tcl_Command) cmdPtr, objc, objv); if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } } @@ -1529,7 +1530,7 @@ TclCheckInterpTraces( Tcl_Interp *interp, /* The current interpreter. */ const char *command, /* Pointer to beginning of the current command * string. */ - int numChars, /* The number of characters in 'command' which + size_t numChars, /* The number of characters in 'command' which * are part of the command string. */ Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ @@ -1676,7 +1677,7 @@ CallTraceFunction( Command *cmdPtr, /* Points to command's Command struct. */ const char *command, /* Points to the first character of the * command's source before substitutions. */ - int numChars, /* The number of characters in the command's + size_t numChars, /* The number of characters in the command's * source. */ register int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ @@ -1689,8 +1690,8 @@ CallTraceFunction( * Copy the command characters into a new string. */ - commandCopy = TclStackAlloc(interp, (unsigned) numChars + 1); - memcpy(commandCopy, command, (size_t) numChars); + commandCopy = TclStackAlloc(interp, numChars + 1); + memcpy(commandCopy, command, numChars); commandCopy[numChars] = '\0'; /* @@ -1728,7 +1729,7 @@ CommandObjTraceDeleted( TraceCommandInfo *tcmdPtr = clientData; if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } @@ -1810,7 +1811,7 @@ TraceExecutionProc( && (strcmp(command, tcmdPtr->startCmd) == 0)) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + Tcl_Free(tcmdPtr->startCmd); } /* @@ -1923,7 +1924,7 @@ TraceExecutionProc( register unsigned len = strlen(command) + 1; tcmdPtr->startLevel = level; - tcmdPtr->startCmd = ckalloc(len); + tcmdPtr->startCmd = Tcl_Alloc(len); memcpy(tcmdPtr->startCmd, command, len); tcmdPtr->refCount++; tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0, @@ -1935,12 +1936,12 @@ TraceExecutionProc( if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + Tcl_Free(tcmdPtr->startCmd); } } if (call) { if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } return traceCode; @@ -2167,7 +2168,7 @@ Tcl_CreateObjTrace( iPtr->tracesForbiddingInline++; } - tracePtr = ckalloc(sizeof(Trace)); + tracePtr = Tcl_Alloc(sizeof(Trace)); tracePtr->level = level; tracePtr->proc = proc; tracePtr->clientData = clientData; @@ -2230,7 +2231,7 @@ Tcl_CreateTrace( * command. */ ClientData clientData) /* Arbitrary value word to pass to proc. */ { - StringTraceData *data = ckalloc(sizeof(StringTraceData)); + StringTraceData *data = Tcl_Alloc(sizeof(StringTraceData)); data->clientData = clientData; data->proc = proc; @@ -2275,7 +2276,7 @@ StringTraceProc( */ argv = (const char **) TclStackAlloc(interp, - (unsigned) ((objc + 1) * sizeof(const char *))); + (objc + 1) * sizeof(const char *)); for (i = 0; i < objc; i++) { argv[i] = Tcl_GetString(objv[i]); } @@ -2314,7 +2315,7 @@ static void StringTraceDeleteProc( ClientData clientData) { - ckfree(clientData); + Tcl_Free(clientData); } /* @@ -2839,7 +2840,7 @@ DisposeTraceResult( * to be disposed. */ { if (flags & TCL_TRACE_RESULT_DYNAMIC) { - ckfree(result); + Tcl_Free(result); } else if (flags & TCL_TRACE_RESULT_OBJECT) { Tcl_DecrRefCount((Tcl_Obj *) result); } @@ -2848,41 +2849,6 @@ DisposeTraceResult( /* *---------------------------------------------------------------------- * - * Tcl_UntraceVar -- - * - * Remove a previously-created trace for a variable. - * - * Results: - * None. - * - * Side effects: - * If there exists a trace for the variable given by varName with the - * given flags, proc, and clientData, then that trace is removed. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_UntraceVar -void -Tcl_UntraceVar( - Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *varName, /* Name of variable; may end with "(index)" to - * signify an array reference. */ - int flags, /* OR-ed collection of bits describing current - * trace, including any of TCL_TRACE_READS, - * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, - * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */ - Tcl_VarTraceProc *proc, /* Function assocated with trace. */ - ClientData clientData) /* Arbitrary argument to pass to proc. */ -{ - Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_UntraceVar2 -- * * Remove a previously-created trace for a variable. @@ -3013,49 +2979,6 @@ Tcl_UntraceVar2( /* *---------------------------------------------------------------------- * - * Tcl_VarTraceInfo -- - * - * Return the clientData value associated with a trace on a variable. - * This function can also be used to step through all of the traces on a - * particular variable that have the same trace function. - * - * Results: - * The return value is the clientData value associated with a trace on - * the given variable. Information will only be returned for a trace with - * proc as trace function. If the clientData argument is NULL then the - * first such trace is returned; otherwise, the next relevant one after - * the one given by clientData will be returned. If the variable doesn't - * exist, or if there are no (more) traces for it, then NULL is returned. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_VarTraceInfo -ClientData -Tcl_VarTraceInfo( - Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *varName, /* Name of variable; may end with "(index)" to - * signify an array reference. */ - int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY (can be 0). */ - Tcl_VarTraceProc *proc, /* Function assocated with trace. */ - ClientData prevClientData) /* If non-NULL, gives last value returned by - * this function, so this call will return the - * next trace after that one. If NULL, this - * call will return the first trace. */ -{ - return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, - prevClientData); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_VarTraceInfo2 -- * * Same as Tcl_VarTraceInfo, except takes name in two pieces instead of @@ -3126,47 +3049,6 @@ Tcl_VarTraceInfo2( /* *---------------------------------------------------------------------- * - * Tcl_TraceVar -- - * - * Arrange for reads and/or writes to a variable to cause a function to - * be invoked, which can monitor the operations and/or change their - * actions. - * - * Results: - * A standard Tcl return value. - * - * Side effects: - * A trace is set up on the variable given by varName, such that future - * references to the variable will be intermediated by proc. See the - * manual entry for complete details on the calling sequence for proc. - * The variable's flags are updated. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_TraceVar -int -Tcl_TraceVar( - Tcl_Interp *interp, /* Interpreter in which variable is to be - * traced. */ - const char *varName, /* Name of variable; may end with "(index)" to - * signify an array reference. */ - int flags, /* OR-ed collection of bits, including any of - * TCL_TRACE_READS, TCL_TRACE_WRITES, - * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and - * TCL_NAMESPACE_ONLY. */ - Tcl_VarTraceProc *proc, /* Function to call when specified ops are - * invoked upon varName. */ - ClientData clientData) /* Arbitrary argument to pass to proc. */ -{ - return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_TraceVar2 -- * * Arrange for reads and/or writes to a variable to cause a function to @@ -3204,7 +3086,7 @@ Tcl_TraceVar2( register VarTrace *tracePtr; int result; - tracePtr = ckalloc(sizeof(VarTrace)); + tracePtr = Tcl_Alloc(sizeof(VarTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags; @@ -3212,7 +3094,7 @@ Tcl_TraceVar2( result = TraceVarEx(interp, part1, part2, tracePtr); if (result != TCL_OK) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } return result; } @@ -3248,7 +3130,7 @@ TraceVarEx( * as-a-whole. */ register VarTrace *tracePtr)/* Structure containing flags, traceProc and * clientData fields. Others should be left - * blank. Will be ckfree()d (eventually) if + * blank. Will be Tcl_Free()d (eventually) if * this function returns TCL_OK, and up to * caller to free if this function returns * TCL_ERROR. */ diff --git a/generic/tclUtf.c b/generic/tclUtf.c index ce67db7..6b73a8f 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -211,14 +211,15 @@ three: char * Tcl_UniCharToUtfDString( const Tcl_UniChar *uniStr, /* Unicode string to convert to UTF-8. */ - int uniLength, /* Length of Unicode string in Tcl_UniChars + size_t uniLength, /* Length of Unicode string in Tcl_UniChars * (must be >= 0). */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { const Tcl_UniChar *w, *wEnd; char *p, *string; - int oldLength, len = 1; + size_t oldLength; + int len = 1; /* * UTF-8 string length in bytes will be <= Unicode string length * 4. @@ -414,7 +415,7 @@ Tcl_UtfToUniChar( Tcl_UniChar * Tcl_UtfToUniCharDString( const char *src, /* UTF-8 string to convert to Unicode. */ - int length, /* Length of UTF-8 string in bytes, or -1 for + size_t length, /* Length of UTF-8 string in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Unicode representation of string is * appended to this previously initialized @@ -422,9 +423,9 @@ Tcl_UtfToUniCharDString( { Tcl_UniChar ch = 0, *w, *wString; const char *p, *end; - int oldLength; + size_t oldLength; - if (length < 0) { + if (length == TCL_AUTO_LENGTH) { length = strlen(src); } @@ -487,9 +488,9 @@ int Tcl_UtfCharComplete( const char *src, /* String to check if first few bytes contain * a complete UTF-8 character. */ - int length) /* Length of above string in bytes. */ + size_t length) /* Length of above string in bytes. */ { - return length >= totalBytes[(unsigned char)*src]; + return length >= totalBytes[(unsigned char)*src]; } /* @@ -510,14 +511,14 @@ Tcl_UtfCharComplete( *--------------------------------------------------------------------------- */ -int +size_t Tcl_NumUtfChars( register const char *src, /* The UTF-8 string to measure. */ - int length) /* The length of the string in bytes, or -1 + size_t length) /* The length of the string in bytes, or -1 * for strlen(string). */ { Tcl_UniChar ch = 0; - register int i = 0; + register size_t i = 0; /* * The separate implementations are faster. @@ -526,12 +527,11 @@ Tcl_NumUtfChars( * single-byte char case specially. */ - if (length < 0) { + if (length == TCL_AUTO_LENGTH) { while (*src != '\0') { src += TclUtfToUniChar(src, &ch); i++; } - if (i < 0) i = INT_MAX; /* Bug [2738427] */ } else { register const char *endPtr = src + length - 4; @@ -750,7 +750,7 @@ Tcl_UtfPrev( int Tcl_UniCharAtIndex( register const char *src, /* The UTF-8 string to dereference. */ - register int index) /* The position of the desired character. */ + register size_t index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int fullchar = 0; @@ -758,7 +758,8 @@ Tcl_UniCharAtIndex( int len = 1; #endif - while (index-- >= 0) { + src += TclUtfToUniChar(src, &ch); + while (index--) { #if TCL_UTF_MAX <= 4 src += (len = TclUtfToUniChar(src, &ch)); #else @@ -798,21 +799,28 @@ Tcl_UniCharAtIndex( const char * Tcl_UtfAtIndex( register const char *src, /* The UTF-8 string. */ - register int index) /* The position of the desired character. */ + register size_t index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; +#if TCL_UTF_MAX <= 4 int len = 1; +#endif - while (index-- > 0) { - len = TclUtfToUniChar(src, &ch); - src += len; - } + if (index != TCL_AUTO_LENGTH) { + while (index--) { #if TCL_UTF_MAX <= 4 - if (!len) { - /* Index points at character following High Surrogate */ - src += TclUtfToUniChar(src, &ch); - } + src += (len = TclUtfToUniChar(src, &ch)); +#else + src += TclUtfToUniChar(src, &ch); +#endif + } +#if TCL_UTF_MAX <= 4 + if (!len) { + /* Index points at character following High Surrogate */ + src += TclUtfToUniChar(src, &ch); + } #endif + } return src; } @@ -842,7 +850,7 @@ Tcl_UtfAtIndex( *--------------------------------------------------------------------------- */ -int +size_t Tcl_UtfBackslash( const char *src, /* Points to the backslash character of a * backslash sequence. */ @@ -852,8 +860,7 @@ Tcl_UtfBackslash( * backslash sequence. */ { #define LINE_LENGTH 128 - int numRead; - int result; + size_t numRead, result; result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst); if (numRead == LINE_LENGTH) { @@ -861,7 +868,7 @@ Tcl_UtfBackslash( * We ate a whole line. Pay the price of a strlen() */ - result = TclParseBackslash(src, (int)strlen(src), &numRead, dst); + result = TclParseBackslash(src, strlen(src), &numRead, dst); } if (readPtr != NULL) { *readPtr = numRead; @@ -1100,7 +1107,7 @@ int TclpUtfNcmp2( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numBytes) /* Number of *bytes* to compare. */ + size_t numBytes) /* Number of *bytes* to compare. */ { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to @@ -1147,7 +1154,7 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1205,7 +1212,7 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1451,11 +1458,11 @@ Tcl_UniCharToTitle( *---------------------------------------------------------------------- */ -int +size_t Tcl_UniCharLen( const Tcl_UniChar *uniStr) /* Unicode string to find length of. */ { - int len = 0; + size_t len = 0; while (*uniStr != '\0') { len++; @@ -1485,7 +1492,7 @@ int Tcl_UniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - unsigned long numChars) /* Number of unichars to compare. */ + size_t numChars) /* Number of unichars to compare. */ { #ifdef WORDS_BIGENDIAN /* @@ -1530,7 +1537,7 @@ int Tcl_UniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - unsigned long numChars) /* Number of unichars to compare. */ + size_t numChars) /* Number of unichars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { @@ -2068,10 +2075,10 @@ Tcl_UniCharCaseMatch( int TclUniCharMatch( const Tcl_UniChar *string, /* Unicode String. */ - int strLen, /* Length of String */ + size_t strLen, /* Length of String */ const Tcl_UniChar *pattern, /* Pattern, which may contain special * characters. */ - int ptnLen, /* Length of Pattern */ + size_t ptnLen, /* Length of Pattern */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { const Tcl_UniChar *stringEnd, *patternEnd; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 3d4298e..6481283 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -95,13 +95,6 @@ static ProcessGlobalValue executableName = { #define CONVERT_ANY 16 /* - * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to - * access the precision to be used for double formatting. - */ - -static Tcl_ThreadDataKey precisionKey; - -/* * Prototypes for functions defined later in this file. */ @@ -116,7 +109,7 @@ static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, static int FindElement(Tcl_Interp *interp, const char *string, int stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, - const char **nextPtr, int *sizePtr, + const char **nextPtr, size_t *sizePtr, int *literalPtr); /* * The following is the Tcl object type definition for an object that @@ -394,12 +387,12 @@ static const Tcl_ObjType endOffsetType = { int TclMaxListLength( const char *bytes, - int numBytes, + size_t numBytes, const char **endPtr) { - int count = 0; + size_t count = 0; - if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) { + if ((numBytes == 0) || ((numBytes == TCL_AUTO_LENGTH) && (*bytes == '\0'))) { /* Empty string case - quick exit */ goto done; } @@ -415,7 +408,7 @@ TclMaxListLength( */ while (numBytes) { - if ((numBytes == -1) && (*bytes == '\0')) { + if ((numBytes == TCL_AUTO_LENGTH) && (*bytes == '\0')) { break; } if (TclIsSpaceProc(*bytes)) { @@ -426,9 +419,9 @@ TclMaxListLength( count++; do { bytes++; - numBytes -= (numBytes != -1); + numBytes -= (numBytes != TCL_AUTO_LENGTH); } while (numBytes && TclIsSpaceProc(*bytes)); - if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) { + if ((numBytes == 0) || ((numBytes == TCL_AUTO_LENGTH) && (*bytes == '\0'))) { break; } @@ -437,7 +430,7 @@ TclMaxListLength( */ } bytes++; - numBytes -= (numBytes != -1); + numBytes -= (numBytes != TCL_AUTO_LENGTH); } /* @@ -506,7 +499,7 @@ TclFindElement( const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list). */ - int *sizePtr, /* If non-zero, fill in with size of + size_t *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -535,7 +528,7 @@ TclFindDictElement( const char **nextPtr, /* Fill in with location of character just * after all white space following end of * element (next arg or end of list). */ - int *sizePtr, /* If non-zero, fill in with size of + size_t *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -567,7 +560,7 @@ FindElement( const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list/dict). */ - int *sizePtr, /* If non-zero, fill in with size of + size_t *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -582,7 +575,7 @@ FindElement( int openBraces = 0; /* Brace nesting level during parse. */ int inQuotes = 0; int size = 0; /* lint. */ - int numChars; + size_t numChars; int literal = 1; const char *p2; @@ -793,20 +786,20 @@ FindElement( *---------------------------------------------------------------------- */ -int +size_t TclCopyAndCollapse( - int count, /* Number of byte to copy from src. */ + size_t count, /* Number of byte to copy from src. */ const char *src, /* Copy from here... */ char *dst) /* ... to here. */ { - int newCount = 0; + size_t newCount = 0; while (count > 0) { char c = *src; if (c == '\\') { - int numRead; - int backslashCount = TclParseBackslash(src, count, &numRead, dst); + size_t numRead; + size_t backslashCount = TclParseBackslash(src, count, &numRead, dst); dst += backslashCount; newCount += backslashCount; @@ -864,7 +857,8 @@ Tcl_SplitList( { const char **argv, *end, *element; char *p; - int length, size, i, result, elSize; + int length, size, i, result; + size_t elSize; /* * Allocate enough space to work in. A (const char *) for each (possible) @@ -876,7 +870,7 @@ Tcl_SplitList( size = TclMaxListLength(list, -1, &end) + 1; length = end - list; - argv = ckalloc((size * sizeof(char *)) + length + 1); + argv = Tcl_Alloc((size * sizeof(char *)) + length + 1); for (i = 0, p = ((char *) argv) + size*sizeof(char *); *list != 0; i++) { @@ -887,14 +881,14 @@ Tcl_SplitList( &elSize, &literal); length -= (list - prevList); if (result != TCL_OK) { - ckfree(argv); + Tcl_Free(argv); return result; } if (*element == 0) { break; } if (i >= size) { - ckfree(argv); + Tcl_Free(argv); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "internal error in Tcl_SplitList", -1)); @@ -905,7 +899,7 @@ Tcl_SplitList( } argv[i] = p; if (literal) { - memcpy(p, element, (size_t) elSize); + memcpy(p, element, elSize); p += elSize; *p = 0; p++; @@ -941,11 +935,11 @@ Tcl_SplitList( *---------------------------------------------------------------------- */ -int +size_t Tcl_ScanElement( - register const char *src, /* String to convert to list element. */ - register int *flagPtr) /* Where to store information to guide - * Tcl_ConvertCountedElement. */ + const char *src, /* String to convert to list element. */ + int *flagPtr) /* Where to store information to guide + * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); } @@ -973,10 +967,10 @@ Tcl_ScanElement( *---------------------------------------------------------------------- */ -int +size_t Tcl_ScanCountedElement( const char *src, /* String to convert to Tcl list element. */ - int length, /* Number of bytes in src, or -1. */ + size_t length, /* Number of bytes in src, or -1. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { @@ -1017,10 +1011,10 @@ Tcl_ScanCountedElement( *---------------------------------------------------------------------- */ -int +size_t TclScanElement( const char *src, /* String to convert to Tcl list element. */ - int length, /* Number of bytes in src, or -1. */ + size_t length, /* Number of bytes in src, or -1. */ char *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { @@ -1041,7 +1035,7 @@ TclScanElement( int braceCount = 0; /* Count of all braces '{' '}' seen. */ #endif /* COMPAT */ - if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) { + if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == TCL_AUTO_LENGTH))) { /* * Empty string element must be brace quoted. */ @@ -1130,7 +1124,7 @@ TclScanElement( break; case '\\': /* TYPE_SUBS */ extra++; /* Escape '\' => '\\' */ - if ((length == 1) || ((length == -1) && (p[1] == '\0'))) { + if ((length == 1) || ((length == TCL_AUTO_LENGTH) && (p[1] == '\0'))) { /* * Final backslash. Cannot format with brace quoting. */ @@ -1161,14 +1155,14 @@ TclScanElement( #endif /* COMPAT */ break; case '\0': /* TYPE_SUBS */ - if (length == -1) { + if (length == TCL_AUTO_LENGTH) { goto endOfString; } /* TODO: Panic on improper encoding? */ break; } } - length -= (length > 0); + length -= (length+1 > 1); p++; } @@ -1321,11 +1315,11 @@ TclScanElement( *---------------------------------------------------------------------- */ -int +size_t Tcl_ConvertElement( - register const char *src, /* Source information for list element. */ - register char *dst, /* Place to put list-ified element. */ - register int flags) /* Flags produced by Tcl_ScanElement. */ + const char *src, /* Source information for list element. */ + char *dst, /* Place to put list-ified element. */ + int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } @@ -1351,14 +1345,14 @@ Tcl_ConvertElement( *---------------------------------------------------------------------- */ -int +size_t Tcl_ConvertCountedElement( register const char *src, /* Source information for list element. */ - int length, /* Number of bytes in src, or -1. */ + size_t length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { - int numBytes = TclConvertElement(src, length, dst, flags); + size_t numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; return numBytes; } @@ -1384,10 +1378,10 @@ Tcl_ConvertCountedElement( *---------------------------------------------------------------------- */ -int +size_t TclConvertElement( register const char *src, /* Source information for list element. */ - int length, /* Number of bytes in src, or -1. */ + size_t length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { @@ -1406,7 +1400,7 @@ TclConvertElement( * No matter what the caller demands, empty string must be braced! */ - if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) { + if ((src == NULL) || (length == 0) || (*src == '\0' && length == TCL_AUTO_LENGTH)) { p[0] = '{'; p[1] = '}'; return 2; @@ -1422,7 +1416,7 @@ TclConvertElement( p[1] = '#'; p += 2; src++; - length -= (length > 0); + length -= (length+1 > 1); } else { conversion = CONVERT_BRACE; } @@ -1433,7 +1427,7 @@ TclConvertElement( */ if (conversion == CONVERT_NONE) { - if (length == -1) { + if (length == TCL_AUTO_LENGTH) { /* TODO: INT_MAX overflow? */ while (*src) { *p++ = *src++; @@ -1452,7 +1446,7 @@ TclConvertElement( if (conversion == CONVERT_BRACE) { *p = '{'; p++; - if (length == -1) { + if (length == TCL_AUTO_LENGTH) { /* TODO: INT_MAX overflow? */ while (*src) { *p++ = *src++; @@ -1463,7 +1457,7 @@ TclConvertElement( } *p = '}'; p++; - return p - dst; + return (size_t)(p - dst); } /* conversion == CONVERT_ESCAPE or CONVERT_MASK */ @@ -1472,7 +1466,7 @@ TclConvertElement( * Formatted string is original string converted to escape sequences. */ - for ( ; length; src++, length -= (length > 0)) { + for ( ; length; src++, length -= (length+1 > 1)) { switch (*src) { case ']': case '[': @@ -1525,8 +1519,8 @@ TclConvertElement( p++; continue; case '\0': - if (length == -1) { - return p - dst; + if (length == TCL_AUTO_LENGTH) { + return (size_t)(p - dst); } /* @@ -1542,7 +1536,7 @@ TclConvertElement( *p = *src; p++; } - return p - dst; + return (size_t)(p - dst); } /* @@ -1572,7 +1566,8 @@ Tcl_Merge( { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; - int i, bytesNeeded = 0; + int i; + size_t bytesNeeded = 0; char *result, *dst; /* @@ -1581,7 +1576,7 @@ Tcl_Merge( */ if (argc == 0) { - result = ckalloc(1); + result = Tcl_Alloc(1); result[0] = '\0'; return result; } @@ -1593,17 +1588,11 @@ Tcl_Merge( if (argc <= LOCAL_SIZE) { flagPtr = localFlags; } else { - flagPtr = ckalloc(argc); + flagPtr = Tcl_Alloc(argc); } for (i = 0; i < argc; i++) { flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]); - if (bytesNeeded < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - } - if (bytesNeeded > INT_MAX - argc + 1) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += argc; @@ -1611,7 +1600,7 @@ Tcl_Merge( * Pass two: copy into the result area. */ - result = ckalloc(bytesNeeded); + result = Tcl_Alloc(bytesNeeded); dst = result; for (i = 0; i < argc; i++) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); @@ -1622,47 +1611,11 @@ Tcl_Merge( dst[-1] = 0; if (flagPtr != localFlags) { - ckfree(flagPtr); + Tcl_Free(flagPtr); } return result; } -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -/* - *---------------------------------------------------------------------- - * - * Tcl_Backslash -- - * - * Figure out how to handle a backslash sequence. - * - * Results: - * The return value is the character that should be substituted in place - * of the backslash sequence that starts at src. If readPtr isn't NULL - * then it is filled in with a count of the number of characters in the - * backslash sequence. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -char -Tcl_Backslash( - const char *src, /* Points to the backslash character of a - * backslash sequence. */ - int *readPtr) /* Fill in with number of characters read from - * src, unless NULL. */ -{ - char buf[TCL_UTF_MAX]; - Tcl_UniChar ch = 0; - - Tcl_UtfBackslash(src, readPtr, buf); - TclUtfToUniChar(buf, &ch); - return (char) ch; -} -#endif /* !TCL_NO_DEPRECATED */ - /* *---------------------------------------------------------------------- * @@ -1766,14 +1719,14 @@ TrimRight( return numBytes - (p - bytes); } -int +size_t TclTrimRight( const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ + size_t numBytes, /* ...and its length in bytes */ const char *trim, /* String of trim characters... */ - int numTrim) /* ...and its length in bytes */ + size_t numTrim) /* ...and its length in bytes */ { - int res; + size_t res; Tcl_DString bytesBuf, trimBuf; /* Empty strings -> nothing to do */ @@ -1815,12 +1768,12 @@ TclTrimRight( *---------------------------------------------------------------------- */ -static inline int +static inline size_t TrimLeft( const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ + size_t numBytes, /* ...and its length in bytes */ const char *trim, /* String of trim characters... */ - int numTrim) /* ...and its length in bytes */ + size_t numTrim) /* ...and its length in bytes */ { const char *p = bytes; Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1864,14 +1817,14 @@ TrimLeft( return p - bytes; } -int +size_t TclTrimLeft( const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ + size_t numBytes, /* ...and its length in bytes */ const char *trim, /* String of trim characters... */ - int numTrim) /* ...and its length in bytes */ + size_t numTrim) /* ...and its length in bytes */ { - int res; + size_t res; Tcl_DString bytesBuf, trimBuf; /* Empty strings -> nothing to do */ @@ -1911,15 +1864,15 @@ TclTrimLeft( *---------------------------------------------------------------------- */ -int +size_t TclTrim( const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ + size_t numBytes, /* ...and its length in bytes */ const char *trim, /* String of trim characters... */ - int numTrim, /* ...and its length in bytes */ - int *trimRight) /* Offset from the end of the string. */ + size_t numTrim, /* ...and its length in bytes */ + size_t *trimRight) /* Offset from the end of the string. */ { - int trimLeft; + size_t trimLeft; Tcl_DString bytesBuf, trimBuf; *trimRight = 0; @@ -1973,14 +1926,15 @@ TclTrim( */ /* The whitespace characters trimmed during [concat] operations */ -#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1) +#define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1) char * Tcl_Concat( int argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { - int i, needSpace = 0, bytesNeeded = 0; + int i; + size_t needSpace = 0, bytesNeeded = 0; char *result, *p; /* @@ -1988,7 +1942,7 @@ Tcl_Concat( */ if (argc == 0) { - result = (char *) ckalloc(1); + result = (char *) Tcl_Alloc(1); result[0] = '\0'; return result; } @@ -1999,27 +1953,16 @@ Tcl_Concat( for (i = 0; i < argc; i++) { bytesNeeded += strlen(argv[i]); - if (bytesNeeded < 0) { - Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); - } - } - if (bytesNeeded + argc - 1 < 0) { - /* - * Panic test could be tighter, but not going to bother for this - * legacy routine. - */ - - Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); } /* * All element bytes + (argc - 1) spaces + 1 terminating NULL. */ - result = ckalloc(bytesNeeded + argc); + result = Tcl_Alloc(bytesNeeded + argc); for (p = result, i = 0; i < argc; i++) { - int triml, trimr, elemLength; + size_t triml, trimr, elemLength; const char *element; element = argv[i]; @@ -2080,7 +2023,8 @@ Tcl_ConcatObj( int objc, /* Number of objects to concatenate. */ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */ { - int i, elemLength, needSpace = 0, bytesNeeded = 0; + int i, needSpace = 0; + size_t bytesNeeded = 0, elemLength; const char *element; Tcl_Obj *objPtr, *resPtr; @@ -2091,13 +2035,14 @@ Tcl_ConcatObj( */ for (i = 0; i < objc; i++) { - int length; + size_t length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { continue; } - TclGetStringFromObj(objPtr, &length); + TclGetString(objPtr); + length = objPtr->length; if (length > 0) { break; } @@ -2134,11 +2079,9 @@ Tcl_ConcatObj( */ for (i = 0; i < objc; i++) { - element = TclGetStringFromObj(objv[i], &elemLength); + element = TclGetString(objv[i]); + elemLength = objv[i]->length; bytesNeeded += elemLength; - if (bytesNeeded < 0) { - break; - } } /* @@ -2152,9 +2095,10 @@ Tcl_ConcatObj( Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { - int triml, trimr; + size_t triml, trimr; - element = TclGetStringFromObj(objv[i], &elemLength); + element = TclGetString(objv[i]); + elemLength = objv[i]->length; /* Trim away the leading/trailing whitespace. */ triml = TclTrim(element, elemLength, CONCAT_TRIM_SET, @@ -2468,11 +2412,11 @@ Tcl_StringCaseMatch( int TclByteArrayMatch( const unsigned char *string,/* String. */ - int strLen, /* Length of String */ + size_t strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ - int ptnLen, /* Length of Pattern */ + size_t ptnLen, /* Length of Pattern */ int flags) { const unsigned char *stringEnd, *patternEnd; @@ -2649,7 +2593,8 @@ TclStringMatchObj( int flags) /* Only TCL_MATCH_NOCASE should be passed, or * 0. */ { - int match, length, plen; + int match; + size_t length, plen; /* * Promote based on the type of incoming object. @@ -2661,15 +2606,15 @@ TclStringMatchObj( if ((strObj->typePtr == &tclStringType) || (strObj->typePtr == NULL)) { Tcl_UniChar *udata, *uptn; - udata = Tcl_GetUnicodeFromObj(strObj, &length); - uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen); + udata = TclGetUnicodeFromObj(strObj, &length); + uptn = TclGetUnicodeFromObj(ptnObj, &plen); match = TclUniCharMatch(udata, length, uptn, plen, flags); } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj) && !flags) { unsigned char *data, *ptn; - data = Tcl_GetByteArrayFromObj(strObj, &length); - ptn = Tcl_GetByteArrayFromObj(ptnObj, &plen); + data = TclGetByteArrayFromObj(strObj, &length); + ptn = TclGetByteArrayFromObj(ptnObj, &plen); match = TclByteArrayMatch(data, length, ptn, plen, 0); } else { match = Tcl_StringCaseMatch(TclGetString(strObj), @@ -2729,13 +2674,13 @@ Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *bytes, /* String to append. If length is -1 then this * must be null-terminated. */ - int length) /* Number of bytes from "bytes" to append. If - * < 0, then append all of bytes, up to null + size_t length) /* Number of bytes from "bytes" to append. If + * -1, then append all of bytes, up to null * at end. */ { - int newSize; + size_t newSize; - if (length < 0) { + if (length == TCL_AUTO_LENGTH) { length = strlen(bytes); } newSize = length + dsPtr->length; @@ -2749,12 +2694,12 @@ Tcl_DStringAppend( if (newSize >= dsPtr->spaceAvl) { dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { - char *newString = ckalloc(dsPtr->spaceAvl); + char *newString = Tcl_Alloc(dsPtr->spaceAvl); - memcpy(newString, dsPtr->string, (size_t) dsPtr->length); + memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { - int offset = -1; + size_t offset = TCL_AUTO_LENGTH; /* See [16896d49fd] */ if (bytes >= dsPtr->string @@ -2762,9 +2707,9 @@ Tcl_DStringAppend( offset = bytes - dsPtr->string; } - dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl); + dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); - if (offset >= 0) { + if (offset != TCL_AUTO_LENGTH) { bytes = dsPtr->string + offset; } } @@ -2796,10 +2741,9 @@ TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { - int length; - char *bytes = TclGetStringFromObj(objPtr, &length); + char *bytes = TclGetString(objPtr); - return Tcl_DStringAppend(dsPtr, bytes, length); + return Tcl_DStringAppend(dsPtr, bytes, objPtr->length); } char * @@ -2838,7 +2782,7 @@ Tcl_DStringAppendElement( char *dst = dsPtr->string + dsPtr->length; int needSpace = TclNeedSpace(dsPtr->string, dst); char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0; - int newSize = dsPtr->length + needSpace + size_t newSize = dsPtr->length + needSpace + TclScanElement(element, -1, &flags); /* @@ -2852,9 +2796,9 @@ Tcl_DStringAppendElement( if (newSize >= dsPtr->spaceAvl) { dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { - char *newString = ckalloc(dsPtr->spaceAvl); + char *newString = Tcl_Alloc(dsPtr->spaceAvl); - memcpy(newString, dsPtr->string, (size_t) dsPtr->length); + memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { int offset = -1; @@ -2865,7 +2809,7 @@ Tcl_DStringAppendElement( offset = element - dsPtr->string; } - dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl); + dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); if (offset >= 0) { element = dsPtr->string + offset; @@ -2910,8 +2854,7 @@ Tcl_DStringAppendElement( * * Side effects: * The length of dsPtr is changed to length and a null byte is stored at - * that position in the string. If length is larger than the space - * allocated for dsPtr, then a panic occurs. + * that position in the string. * *---------------------------------------------------------------------- */ @@ -2919,13 +2862,10 @@ Tcl_DStringAppendElement( void Tcl_DStringSetLength( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - int length) /* New length for dynamic string. */ + size_t length) /* New length for dynamic string. */ { - int newsize; + size_t newsize; - if (length < 0) { - length = 0; - } if (length >= dsPtr->spaceAvl) { /* * There are two interesting cases here. In the first case, the user @@ -2946,12 +2886,12 @@ Tcl_DStringSetLength( dsPtr->spaceAvl = length + 1; } if (dsPtr->string == dsPtr->staticSpace) { - char *newString = ckalloc(dsPtr->spaceAvl); + char *newString = Tcl_Alloc(dsPtr->spaceAvl); - memcpy(newString, dsPtr->string, (size_t) dsPtr->length); + memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { - dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl); + dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); } } dsPtr->length = length; @@ -2981,7 +2921,7 @@ Tcl_DStringFree( Tcl_DString *dsPtr) /* Structure describing dynamic string. */ { if (dsPtr->string != dsPtr->staticSpace) { - ckfree(dsPtr->string); + Tcl_Free(dsPtr->string); } dsPtr->string = dsPtr->staticSpace; dsPtr->length = 0; @@ -3043,86 +2983,12 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { -#ifdef TCL_NO_DEPRECATED Tcl_Obj *obj = Tcl_GetObjResult(interp); - const char *bytes = TclGetString(obj); + char *bytes = TclGetString(obj); Tcl_DStringFree(dsPtr); Tcl_DStringAppend(dsPtr, bytes, obj->length); Tcl_ResetResult(interp); -#else - Interp *iPtr = (Interp *) interp; - - if (dsPtr->string != dsPtr->staticSpace) { - ckfree(dsPtr->string); - } - - /* - * Do more efficient transfer when we know the result is a Tcl_Obj. When - * there's no string result, we only have to deal with two cases: - * - * 1. When the string rep is the empty string, when we don't copy but - * instead use the staticSpace in the DString to hold an empty string. - - * 2. When the string rep is not there or there's a real string rep, when - * we use Tcl_GetString to fetch (or generate) the string rep - which - * we know to have been allocated with ckalloc() - and use it to - * populate the DString space. Then, we free the internal rep. and set - * the object's string representation back to the canonical empty - * string. - */ - - if (!iPtr->result[0] && iPtr->objResultPtr - && !Tcl_IsShared(iPtr->objResultPtr)) { - if (iPtr->objResultPtr->bytes == &tclEmptyString) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->string[0] = 0; - dsPtr->length = 0; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = TclGetString(iPtr->objResultPtr); - dsPtr->length = iPtr->objResultPtr->length; - dsPtr->spaceAvl = dsPtr->length + 1; - TclFreeIntRep(iPtr->objResultPtr); - iPtr->objResultPtr->bytes = &tclEmptyString; - iPtr->objResultPtr->length = 0; - } - return; - } - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - dsPtr->length = strlen(iPtr->result); - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - dsPtr->string = iPtr->result; - dsPtr->spaceAvl = dsPtr->length+1; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - memcpy(dsPtr->string, iPtr->result, dsPtr->length+1); - iPtr->freeProc(iPtr->result); - } - dsPtr->spaceAvl = dsPtr->length+1; - iPtr->freeProc = NULL; - } else { - if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - dsPtr->spaceAvl = dsPtr->length + 1; - } - memcpy(dsPtr->string, iPtr->result, dsPtr->length+1); - } - - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif /* !TCL_NO_DEPRECATED */ } /* @@ -3248,10 +3114,9 @@ Tcl_DStringEndSublist( * string using. * * Results: - * The ASCII equivalent of "value" is written at "dst". It is written - * using the current precision, and it is guaranteed to contain a decimal - * point or exponent, so that it looks like a floating-point value and - * not an integer. + * The ASCII equivalent of "value" is written at "dst". It is guaranteed + * to contain a decimal point or exponent, so that it looks like a + * floating-point value and not an integer. * * Side effects: * None. @@ -3261,9 +3126,7 @@ Tcl_DStringEndSublist( void Tcl_PrintDouble( - Tcl_Interp *interp, /* Interpreter whose tcl_precision variable - * used to be used to control printing. It's - * ignored now. */ + Tcl_Interp *interp, /* Not used */ double value, /* Value to print as string. */ char *dst) /* Where to store converted value; must have * at least TCL_DOUBLE_SPACE characters. */ @@ -3273,7 +3136,6 @@ Tcl_PrintDouble( int signum; char *digits; char *end; - int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int)); /* * Handle NaN. @@ -3305,53 +3167,8 @@ Tcl_PrintDouble( * Ordinary (normal and denormal) values. */ - if (*precisionPtr == 0) { - digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST, - &exponent, &signum, &end); - } else { - /* - * There are at least two possible interpretations for tcl_precision. - * - * The first is, "choose the decimal representation having - * $tcl_precision digits of significance that is nearest to the given - * number, breaking ties by rounding to even, and then trimming - * trailing zeros." This gives the greatest possible precision in the - * decimal string, but offers the anomaly that [expr 0.1] will be - * "0.10000000000000001". - * - * The second is "choose the decimal representation having at most - * $tcl_precision digits of significance that is nearest to the given - * number. If no such representation converts exactly to the given - * number, choose the one that is closest, breaking ties by rounding - * to even. If more than one such representation converts exactly to - * the given number, choose the shortest, breaking ties in favour of - * the nearest, breaking remaining ties in favour of the one ending in - * an even digit." - * - * Tcl 8.4 implements the first of these, which gives rise to - * anomalies in formatting: - * - * % expr 0.1 - * 0.10000000000000001 - * % expr 0.01 - * 0.01 - * % expr 1e-7 - * 9.9999999999999995e-08 - * - * For human readability, it appears better to choose the second rule, - * and let [expr 0.1] return 0.1. But for 8.4 compatibility, we prefer - * the first (the recommended zero value for tcl_precision avoids the - * problem entirely). - * - * Uncomment TCL_DD_SHORTEN_FLAG in the next call to prefer the method - * that allows floating point values to be shortened if it can be done - * without loss of precision. - */ - - digits = TclDoubleDigits(value, *precisionPtr, - TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */, - &exponent, &signum, &end); - } + digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST, + &exponent, &signum, &end); if (signum) { *dst++ = '-'; } @@ -3371,16 +3188,7 @@ Tcl_PrintDouble( } } - /* - * Tcl 8.4 appears to format with at least a two-digit exponent; - * preserve that behaviour when tcl_precision != 0 - */ - - if (*precisionPtr == 0) { - sprintf(dst, "e%+d", exponent); - } else { - sprintf(dst, "e%+03d", exponent); - } + sprintf(dst, "e%+d", exponent); } else { /* * F format for others. @@ -3412,88 +3220,8 @@ Tcl_PrintDouble( } *dst++ = '\0'; } - ckfree(digits); -} - -/* - *---------------------------------------------------------------------- - * - * TclPrecTraceProc -- - * - * This function is invoked whenever the variable "tcl_precision" is - * written. - * - * Results: - * Returns NULL if all went well, or an error message if the new value - * for the variable doesn't make sense. - * - * Side effects: - * If the new value doesn't make sense then this function undoes the - * effect of the variable modification. Otherwise it modifies the format - * string that's used by Tcl_PrintDouble. - * - *---------------------------------------------------------------------- - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - /* ARGSUSED */ -char * -TclPrecTraceProc( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *name1, /* Name of variable. */ - const char *name2, /* Second part of variable name. */ - int flags) /* Information about what happened. */ -{ - Tcl_Obj *value; - int prec; - int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int)); - - /* - * If the variable is unset, then recreate the trace. - */ - - if (flags & TCL_TRACE_UNSETS) { - if ((flags & TCL_TRACE_DESTROYED) && !Tcl_InterpDeleted(interp)) { - Tcl_TraceVar2(interp, name1, name2, - TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES - |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData); - } - return NULL; - } - - /* - * When the variable is read, reset its value from our shared value. This - * is needed in case the variable was modified in some other interpreter - * so that this interpreter's value is out of date. - */ - - - if (flags & TCL_TRACE_READS) { - Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewWideIntObj(*precisionPtr), - flags & TCL_GLOBAL_ONLY); - return NULL; - } - - /* - * The variable is being written. Check the new value and disallow it if - * it isn't reasonable or if this is a safe interpreter (we don't want - * safe interpreters messing up the precision of other interpreters). - */ - - if (Tcl_IsSafe(interp)) { - return (char *) "can't modify precision from a safe interpreter"; - } - value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY); - if (value == NULL - || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK - || prec < 0 || prec > TCL_MAX_PREC) { - return (char *) "improper value for precision"; - } - *precisionPtr = prec; - return NULL; + Tcl_Free(digits); } -#endif /* !TCL_NO_DEPRECATED)*/ /* *---------------------------------------------------------------------- @@ -3607,15 +3335,14 @@ TclNeedSpace( *---------------------------------------------------------------------- */ -int +size_t TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ Tcl_WideInt n) /* The integer to format. */ { - Tcl_WideInt intVal; - int i; - int numFormatted, j; + Tcl_WideInt intVal; + size_t i, numFormatted, j; const char *digits = "0123456789"; /* @@ -3699,11 +3426,11 @@ TclFormatInt( static int GetWideForIndex( Tcl_Interp *interp, /* Interpreter to use for error reporting. If - * NULL, then no error message is left after - * errors. */ + * NULL, then no error message is left after + * errors. */ Tcl_Obj *objPtr, /* Points to the value to be parsed */ size_t endValue, /* The value to be stored at *widePtr if - * objPtr holds "end". + * objPtr holds "end". * NOTE: this value may be TCL_INDEX_NONE. */ Tcl_WideInt *widePtr) /* Location filled in with a wide integer * representing an index. */ @@ -3861,7 +3588,6 @@ GetWideForIndex( if (!strncmp(bytes, "end-", 4)) { bytes += 4; } - TclCheckBadOctal(interp, bytes); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } return TCL_ERROR; @@ -3872,21 +3598,26 @@ GetWideForIndex( * * TclGetIntForIndex -- * - * This function returns an integer corresponding to the list index held - * in a Tcl object. The Tcl object's value is expected to be in the - * format integer([+-]integer)? or the format end([+-]integer)?. + * Provides an integer corresponding to the list index held in a Tcl + * object. The string value 'objPtr' is expected have the format + * integer([+-]integer)? or end([+-]integer)?. * - * Results: - * The return value is normally TCL_OK, which means that the index was - * successfully stored into the location referenced by "indexPtr". If the - * Tcl object referenced by "objPtr" has the value "end", the value - * stored is "endValue". If "objPtr"s values is not of one of the - * expected formats, TCL_ERROR is returned and, if "interp" is non-NULL, - * an error message is left in the interpreter's result object. + * Value + * TCL_OK * - * Side effects: - * The object referenced by "objPtr" might be converted to an integer, - * wide integer, or end-based-index object. + * The index is stored at the address given by by 'indexPtr'. If + * 'objPtr' has the value "end", the value stored is 'endValue'. + * + * TCL_ERROR + * + * The value of 'objPtr' does not have one of the expected formats. If + * 'interp' is non-NULL, an error message is left in the interpreter's + * result object. + * + * Effect + * + * The object referenced by 'objPtr' is converted, as needed, to an + * integer, wide integer, or end-based-index object. * *---------------------------------------------------------------------- */ @@ -3898,14 +3629,17 @@ TclGetIntForIndex( * errors. */ Tcl_Obj *objPtr, /* Points to an object containing either "end" * or an integer. */ - int endValue, /* The value to be stored at "indexPtr" if + size_t endValue, /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ int *indexPtr) /* Location filled in with an integer * representing an index. */ { Tcl_WideInt wide; - if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) { + /* Use platform-related size_t to wide-int to consider negative value + * ((size_t)-1) if wide-int and size_t have different dimensions. */ + if (GetWideForIndex(interp, objPtr, TclWideIntFromSize(endValue), + &wide) == TCL_ERROR) { return TCL_ERROR; } if (wide < 0) { @@ -3947,7 +3681,7 @@ GetEndOffsetFromObj( while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) { Tcl_ObjIntRep ir; - int length; + size_t length; const char *bytes = TclGetStringFromObj(objPtr, &length); if ((length < 3) || (length == 4)) { @@ -4079,8 +3813,8 @@ int TclIndexEncode( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* Index value to parse */ - int before, /* Value to return for index before beginning */ - int after, /* Value to return for index after end */ + size_t before, /* Value to return for index before beginning */ + size_t after, /* Value to return for index after end */ int *indexPtr) /* Where to write the encoded answer, not NULL */ { ClientData cd; @@ -4108,7 +3842,7 @@ TclIndexEncode( */ if (wide > 0) { /* - * All end+postive or end-negative expressions + * All end+positive or end-negative expressions * always indicate "after the end". */ idx = after; @@ -4151,17 +3885,16 @@ TclIndexEncode( *---------------------------------------------------------------------- */ -int +size_t TclIndexDecode( int encoded, /* Value to decode */ - int endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ + size_t endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ { if (encoded > TCL_INDEX_END) { return encoded; } - endValue += encoded - TCL_INDEX_END; - if (endValue >= 0) { - return endValue; + if (endValue >= TCL_INDEX_END - (size_t)encoded) { + return endValue + encoded - TCL_INDEX_END; } return TCL_INDEX_NONE; } @@ -4169,73 +3902,6 @@ TclIndexDecode( /* *---------------------------------------------------------------------- * - * TclCheckBadOctal -- - * - * This function checks for a bad octal value and appends a meaningful - * error to the interp's result. - * - * Results: - * 1 if the argument was a bad octal, else 0. - * - * Side effects: - * The interpreter's result is modified. - * - *---------------------------------------------------------------------- - */ - -int -TclCheckBadOctal( - Tcl_Interp *interp, /* Interpreter to use for error reporting. If - * NULL, then no error message is left after - * errors. */ - const char *value) /* String to check. */ -{ - register const char *p = value; - - /* - * A frequent mistake is invalid octal values due to an unwanted leading - * zero. Try to generate a meaningful error message. - */ - - while (TclIsSpaceProc(*p)) { - p++; - } - if (*p == '+' || *p == '-') { - p++; - } - if (*p == '0') { - if ((p[1] == 'o') || p[1] == 'O') { - p += 2; - } - while (isdigit(UCHAR(*p))) { /* INTL: digit. */ - p++; - } - while (TclIsSpaceProc(*p)) { - p++; - } - if (*p == '\0') { - /* - * Reached end of string. - */ - - if (interp != NULL) { - /* - * Don't reset the result here because we want this result to - * be added to an existing error message as extra info. - */ - - Tcl_AppendToObj(Tcl_GetObjResult(interp), - " (looks like invalid octal number)", -1); - } - return 1; - } - } - return 0; -} - -/* - *---------------------------------------------------------------------- - * * ClearHash -- * * Remove all the entries in the hash table *tablePtr. @@ -4285,7 +3951,7 @@ GetThreadHash( Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); if (NULL == *tablePtrPtr) { - *tablePtrPtr = ckalloc(sizeof(Tcl_HashTable)); + *tablePtrPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr); Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS); } @@ -4314,7 +3980,7 @@ FreeThreadHash( ClearHash(tablePtr); Tcl_DeleteHashTable(tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); } /* @@ -4336,7 +4002,7 @@ FreeProcessGlobalValue( pgvPtr->epoch++; pgvPtr->numBytes = 0; - ckfree(pgvPtr->value); + Tcl_Free(pgvPtr->value); pgvPtr->value = NULL; if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); @@ -4375,13 +4041,13 @@ TclSetProcessGlobalValue( pgvPtr->epoch++; if (NULL != pgvPtr->value) { - ckfree(pgvPtr->value); + Tcl_Free(pgvPtr->value); } else { Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr); } bytes = TclGetString(newValue); pgvPtr->numBytes = newValue->length; - pgvPtr->value = ckalloc(pgvPtr->numBytes + 1); + pgvPtr->value = Tcl_Alloc(pgvPtr->numBytes + 1); memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); @@ -4397,7 +4063,7 @@ TclSetProcessGlobalValue( Tcl_IncrRefCount(newValue); cacheMap = GetThreadHash(&pgvPtr->key); ClearHash(cacheMap); - hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(size_t)(pgvPtr->epoch), &dummy); + hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(pgvPtr->epoch), &dummy); Tcl_SetHashValue(hPtr, newValue); Tcl_MutexUnlock(&pgvPtr->mutex); } @@ -4423,7 +4089,7 @@ TclGetProcessGlobalValue( Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; - unsigned int epoch = pgvPtr->epoch; + size_t epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4444,8 +4110,8 @@ TclGetProcessGlobalValue( Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native), Tcl_DStringLength(&native), &newValue); Tcl_DStringFree(&native); - ckfree(pgvPtr->value); - pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1); + Tcl_Free(pgvPtr->value); + pgvPtr->value = Tcl_Alloc(Tcl_DStringLength(&newValue) + 1); memcpy(pgvPtr->value, Tcl_DStringValue(&newValue), Tcl_DStringLength(&newValue) + 1); Tcl_DStringFree(&newValue); @@ -4457,7 +4123,7 @@ TclGetProcessGlobalValue( } } cacheMap = GetThreadHash(&pgvPtr->key); - hPtr = Tcl_FindHashEntry(cacheMap, (void *)(size_t)epoch); + hPtr = Tcl_FindHashEntry(cacheMap, (void *) (epoch)); if (NULL == hPtr) { int dummy; @@ -4490,7 +4156,7 @@ TclGetProcessGlobalValue( value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); hPtr = Tcl_CreateHashEntry(cacheMap, - (void *)(size_t)(pgvPtr->epoch), &dummy); + (void *)(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); Tcl_SetHashValue(hPtr, value); Tcl_IncrRefCount(value); @@ -4585,31 +4251,6 @@ Tcl_GetNameOfExecutable(void) /* *---------------------------------------------------------------------- * - * TclpGetTime -- - * - * Deprecated synonym for Tcl_GetTime. This function is provided for the - * benefit of extensions written before Tcl_GetTime was exported from the - * library. - * - * Results: - * None. - * - * Side effects: - * Stores current time in the buffer designated by "timePtr" - * - *---------------------------------------------------------------------- - */ - -void -TclpGetTime( - Tcl_Time *timePtr) -{ - Tcl_GetTime(timePtr); -} - -/* - *---------------------------------------------------------------------- - * * TclGetPlatform -- * * This is a kludge that allows the test library to get access the @@ -4654,7 +4295,7 @@ int TclReToGlob( Tcl_Interp *interp, const char *reStr, - int reStrLen, + size_t reStrLen, Tcl_DString *dsPtr, int *exactPtr, int *quantifiersFoundPtr) diff --git a/generic/tclVar.c b/generic/tclVar.c index 6b88344..c4d95b6 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -385,7 +385,7 @@ CleanupVar( && (VarHashRefCount(varPtr) == (unsigned) !TclIsVarDeadHash(varPtr))) { if (VarHashRefCount(varPtr) == 0) { - ckfree(varPtr); + Tcl_Free(varPtr); } else { VarHashDeleteEntry(varPtr); } @@ -395,7 +395,7 @@ CleanupVar( (VarHashRefCount(arrayPtr) == (unsigned) !TclIsVarDeadHash(arrayPtr))) { if (VarHashRefCount(arrayPtr) == 0) { - ckfree(arrayPtr); + Tcl_Free(arrayPtr); } else { VarHashDeleteEntry(arrayPtr); } @@ -665,7 +665,7 @@ TclObjLookupVarEx( * part1Ptr is possibly an unparsed array element. */ - int len; + size_t len; const char *part1 = TclGetStringFromObj(part1Ptr, &len); if ((len > 1) && (part1[len - 1] == ')')) { @@ -840,7 +840,8 @@ TclLookupSimpleVar( * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; - int isNew, i, result, varLen; + int isNew, i, result; + size_t varLen; const char *varName = TclGetStringFromObj(varNamePtr, &varLen); varPtr = NULL; @@ -913,12 +914,8 @@ TclLookupSimpleVar( *indexPtr = -1; flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY; } else { - if (flags & TCL_AVOID_RESOLVERS) { - flags = (flags | TCL_NAMESPACE_ONLY); - } - if (flags & TCL_NAMESPACE_ONLY) { - *indexPtr = -2; - } + flags = (flags | TCL_NAMESPACE_ONLY); + *indexPtr = -2; } /* @@ -974,7 +971,7 @@ TclLookupSimpleVar( if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; - int localLen; + size_t localLen; for (i=0 ; i<localCt ; i++, objPtrPtr++) { register Tcl_Obj *objPtr = *objPtrPtr; @@ -993,7 +990,7 @@ TclLookupSimpleVar( tablePtr = varFramePtr->varTablePtr; if (create) { if (tablePtr == NULL) { - tablePtr = ckalloc(sizeof(TclVarHashTable)); + tablePtr = Tcl_Alloc(sizeof(TclVarHashTable)); TclInitVarHashTable(tablePtr, NULL); varFramePtr->varTablePtr = tablePtr; } @@ -1141,51 +1138,6 @@ TclLookupArrayElement( /* *---------------------------------------------------------------------- * - * Tcl_GetVar -- - * - * Return the value of a Tcl variable as a string. - * - * Results: - * The return value points to the current value of varName as a string. - * If the variable is not defined or can't be read because of a clash in - * array usage then a NULL pointer is returned and an error message is - * left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set. - * Note: the return value is only valid up until the next change to the - * variable; if you depend on the value lasting longer than that, then - * make yourself a private copy. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_GetVar -const char * -Tcl_GetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. */ - int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG - * bits. */ -{ - Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags); - - TclDecrRefCount(varNamePtr); - - if (resultPtr == NULL) { - return NULL; - } - return TclGetString(resultPtr); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetVar2 -- * * Return the value of a Tcl variable as a string, given a two-part name @@ -1552,53 +1504,6 @@ Tcl_SetObjCmd( /* *---------------------------------------------------------------------- * - * Tcl_SetVar -- - * - * Change the value of a variable. - * - * Results: - * Returns a pointer to the malloc'ed string which is the character - * representation of the variable's new value. The caller must not modify - * this string. If the write operation was disallowed then NULL is - * returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory - * message will be left in the interp's result. Note that the returned - * string may not be the same as newValue; this is because variable - * traces may modify the variable's value. - * - * Side effects: - * If varName is defined as a local or global variable in interp, its - * value is changed to newValue. If varName isn't currently defined, then - * a new global variable by that name is created. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_SetVar -const char * -Tcl_SetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. */ - const char *newValue, /* New value for varName. */ - int flags) /* Various flags that tell how to set value: - * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, - * TCL_LEAVE_ERR_MSG. */ -{ - Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, varName, NULL, - Tcl_NewStringObj(newValue, -1), flags); - - if (varValuePtr == NULL) { - return NULL; - } - return TclGetString(varValuePtr); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetVar2 -- * * Given a two-part variable name, which may refer either to a scalar @@ -2351,57 +2256,6 @@ TclPtrIncrObjVarIdx( /* *---------------------------------------------------------------------- * - * Tcl_UnsetVar -- - * - * Delete a variable, so that it may not be accessed anymore. - * - * Results: - * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if - * the variable can't be unset. In the event of an error, if the - * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the - * interp's result. - * - * Side effects: - * If varName is defined as a local or global variable in interp, it is - * deleted. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_UnsetVar -int -Tcl_UnsetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. May be either - * a scalar name or an array name or an - * element in an array. */ - int flags) /* OR-ed combination of any of - * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or - * TCL_LEAVE_ERR_MSG. */ -{ - int result; - Tcl_Obj *varNamePtr; - - varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_IncrRefCount(varNamePtr); - - /* - * Filter to pass through only the flags this interface supports. - */ - - flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); - result = TclObjUnsetVar2(interp, varNamePtr, NULL, flags); - - Tcl_DecrRefCount(varNamePtr); - return result; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_UnsetVar2 -- * * Delete a variable, given a 2-part name. @@ -3214,7 +3068,7 @@ ArrayForNRCmd( * Make a new array search, put it on the stack. */ - searchPtr = ckalloc(sizeof(ArraySearch)); + searchPtr = Tcl_Alloc(sizeof(ArraySearch)); ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr); /* @@ -3335,7 +3189,7 @@ ArrayForLoopCallback( ArrayDoneSearch(iPtr, varPtr, searchPtr); Tcl_DecrRefCount(searchPtr->name); - ckfree(searchPtr); + Tcl_Free(searchPtr); } TclDecrRefCount(varListObj); @@ -3423,7 +3277,7 @@ ArrayStartSearchCmd( * Make a new array search with a free name. */ - searchPtr = ckalloc(sizeof(ArraySearch)); + searchPtr = Tcl_Alloc(sizeof(ArraySearch)); ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr); Tcl_SetObjResult(interp, searchPtr->name); return TCL_OK; @@ -3690,7 +3544,7 @@ ArrayDoneSearchCmd( ArrayDoneSearch(iPtr, varPtr, searchPtr); Tcl_DecrRefCount(searchPtr->name); - ckfree(searchPtr); + Tcl_Free(searchPtr); return TCL_OK; } @@ -4350,7 +4204,7 @@ ArrayStatsCmd( return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); - ckfree(stats); + Tcl_Free(stats); return TCL_OK; } @@ -4810,63 +4664,6 @@ TclPtrObjMakeUpvarIdx( /* *---------------------------------------------------------------------- * - * Tcl_UpVar -- - * - * This function links one variable to another, just like the "upvar" - * command. - * - * Results: - * A standard Tcl completion code. If an error occurs then an error - * message is left in the interp's result. - * - * Side effects: - * The variable in frameName whose name is given by varName becomes - * accessible under the name localNameStr, so that references to - * localNameStr are redirected to the other variable like a symbolic - * link. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_UpVar -int -Tcl_UpVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *frameName, /* Name of the frame containing the source - * variable, such as "1" or "#0". */ - const char *varName, /* Name of a variable in interp to link to. - * May be either a scalar name or an element - * in an array. */ - const char *localNameStr, /* Name of link variable. */ - int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: - * indicates scope of localNameStr. */ -{ - int result; - CallFrame *framePtr; - Tcl_Obj *varNamePtr, *localNamePtr; - - if (TclGetFrame(interp, frameName, &framePtr) == -1) { - return TCL_ERROR; - } - - varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_IncrRefCount(varNamePtr); - localNamePtr = Tcl_NewStringObj(localNameStr, -1); - Tcl_IncrRefCount(localNamePtr); - - result = ObjMakeUpvar(interp, framePtr, varNamePtr, NULL, 0, - localNamePtr, flags, -1); - Tcl_DecrRefCount(varNamePtr); - Tcl_DecrRefCount(localNamePtr); - return result; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_UpVar2 -- * * This function links one variable to another, just like the "upvar" @@ -5415,7 +5212,7 @@ DeleteSearches( searchPtr = nextPtr) { nextPtr = searchPtr->nextPtr; Tcl_DecrRefCount(searchPtr->name); - ckfree(searchPtr); + Tcl_Free(searchPtr); } arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE; Tcl_DeleteHashEntry(sPtr); @@ -5991,6 +5788,10 @@ ObjFindNamespaceVar( * Find the namespace(s) that contain the variable. */ + if (!(flags & TCL_GLOBAL_ONLY)) { + flags |= TCL_NAMESPACE_ONLY; + } + TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); @@ -6551,11 +6352,11 @@ AllocVarEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { - Tcl_Obj *objPtr = keyPtr; + Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; Tcl_HashEntry *hPtr; Var *varPtr; - varPtr = ckalloc(sizeof(VarInHash)); + varPtr = Tcl_Alloc(sizeof(VarInHash)); varPtr->flags = VAR_IN_HASHTABLE; varPtr->value.objPtr = NULL; VarHashRefCount(varPtr) = 1; @@ -6577,7 +6378,7 @@ FreeVarEntry( if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr) && (VarHashRefCount(varPtr) == 1)) { - ckfree(varPtr); + Tcl_Free(varPtr); } else { VarHashInvalidateEntry(varPtr); TclSetVarUndefined(varPtr); @@ -6588,10 +6389,10 @@ FreeVarEntry( static int CompareVarKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - Tcl_Obj *objPtr1 = keyPtr; + Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; Tcl_Obj *objPtr2 = hPtr->key.objPtr; register const char *p1, *p2; register int l1, l2; @@ -6785,7 +6586,7 @@ void TclInitArrayVar( Var *arrayPtr) { - ArrayVarHashTable *tablePtr = ckalloc(sizeof(ArrayVarHashTable)); + ArrayVarHashTable *tablePtr = Tcl_Alloc(sizeof(ArrayVarHashTable)); /* * Mark the variable as an array. @@ -6829,7 +6630,7 @@ DeleteArrayVar( */ VarHashDeleteTable(arrayPtr->value.tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); } /* diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index d02a2da..c9a58df 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -458,12 +458,6 @@ static Tcl_ChannelType ZipChannelType = { NULL, /* Thread action function, NULL'able */ NULL, /* Truncate function, NULL'able */ }; - -/* - * Miscellaneous constants. - */ - -#define ERROR_LENGTH ((size_t) -1) /* *------------------------------------------------------------------------- @@ -910,12 +904,12 @@ ZipFSCloseArchive( ZipFile *zf) { if (zf->nameLength) { - ckfree(zf->name); + Tcl_Free(zf->name); } if (zf->isMemBuffer) { /* Pointer to memory */ if (zf->ptrToFree) { - ckfree(zf->ptrToFree); + Tcl_Free(zf->ptrToFree); zf->ptrToFree = NULL; } zf->data = NULL; @@ -938,7 +932,7 @@ ZipFSCloseArchive( #endif /* _WIN32 */ if (zf->ptrToFree) { - ckfree(zf->ptrToFree); + Tcl_Free(zf->ptrToFree); zf->ptrToFree = NULL; } if (zf->chan) { @@ -1116,7 +1110,7 @@ ZipFSOpenArchive( } if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) { zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); - if (zf->length == ERROR_LENGTH) { + if (zf->length == TCL_IO_FAILURE) { ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } @@ -1132,7 +1126,7 @@ ZipFSOpenArchive( ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } - zf->ptrToFree = zf->data = attemptckalloc(zf->length); + zf->ptrToFree = zf->data = Tcl_AttemptAlloc(zf->length); if (!zf->ptrToFree) { ZIPFS_ERROR(interp, "out of memory"); if (interp) { @@ -1175,7 +1169,7 @@ ZipFSOpenArchive( } #else /* !_WIN32 */ zf->length = lseek(PTR2INT(handle), 0, SEEK_END); - if (zf->length == ERROR_LENGTH || zf->length < ZIP_CENTRAL_END_LEN) { + if (zf->length == TCL_IO_FAILURE || zf->length < ZIP_CENTRAL_END_LEN) { ZIPFS_POSIX_ERROR(interp, "invalid file size"); goto error; } @@ -1272,7 +1266,7 @@ ZipFSCatalogFilesystem( ZipFSCloseArchive(interp, zf0); return TCL_ERROR; } - zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1); + zf = Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1); if (!zf) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); @@ -1288,7 +1282,7 @@ ZipFSCatalogFilesystem( zf->mountPoint = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); zf->mountPointLen = strlen(zf->mountPoint); zf->nameLength = strlen(zipname); - zf->name = ckalloc(zf->nameLength + 1); + zf->name = Tcl_Alloc(zf->nameLength + 1); memcpy(zf->name, zipname, zf->nameLength + 1); zf->entries = NULL; zf->topEnts = NULL; @@ -1307,7 +1301,7 @@ ZipFSCatalogFilesystem( if (mountPoint[0] != '\0') { hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mountPoint, &isNew); if (isNew) { - z = ckalloc(sizeof(ZipEntry)); + z = Tcl_Alloc(sizeof(ZipEntry)); Tcl_SetHashValue(hPtr, z); z->tnext = NULL; @@ -1402,7 +1396,7 @@ ZipFSCatalogFilesystem( } Tcl_DStringSetLength(&fpBuf, 0); fullpath = CanonicalPath(mountPoint, path, &fpBuf, 1); - z = ckalloc(sizeof(ZipEntry)); + z = Tcl_Alloc(sizeof(ZipEntry)); z->name = NULL; z->tnext = NULL; z->depth = CountSlashes(fullpath); @@ -1431,7 +1425,7 @@ ZipFSCatalogFilesystem( hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); if (!isNew) { /* should not happen but skip it anyway */ - ckfree(z); + Tcl_Free(z); } else { Tcl_SetHashValue(hPtr, z); z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); @@ -1456,7 +1450,7 @@ ZipFSCatalogFilesystem( if (!isNew) { break; } - zd = ckalloc(sizeof(ZipEntry)); + zd = Tcl_Alloc(sizeof(ZipEntry)); zd->name = NULL; zd->tnext = NULL; zd->depth = CountSlashes(dir); @@ -1670,7 +1664,7 @@ TclZipfs_Mount( return TCL_ERROR; } } - zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1); + zf = Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1); if (!zf) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); @@ -1743,7 +1737,7 @@ TclZipfs_MountBuffer( * Have both a mount point and data to mount there. */ - zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1); + zf = Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1); if (!zf) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); @@ -1754,7 +1748,7 @@ TclZipfs_MountBuffer( zf->isMemBuffer = 1; zf->length = datalen; if (copy) { - zf->data = attemptckalloc(datalen); + zf->data = Tcl_AttemptAlloc(datalen); if (!zf->data) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); @@ -1835,12 +1829,12 @@ TclZipfs_Unmount( Tcl_DeleteHashEntry(hPtr); } if (z->data) { - ckfree(z->data); + Tcl_Free(z->data); } - ckfree(z); + Tcl_Free(z); } ZipFSCloseArchive(interp, zf); - ckfree(zf); + Tcl_Free(zf); unmounted = 1; done: Unlock(); @@ -1909,7 +1903,7 @@ ZipFSMountBufferObjCmd( { const char *mountPoint; /* Mount point path. */ unsigned char *data; - int length; + size_t length; if (objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?"); @@ -1932,7 +1926,7 @@ ZipFSMountBufferObjCmd( return TCL_OK; } - data = Tcl_GetByteArrayFromObj(objv[2], &length); + data = TclGetByteArrayFromObj(objv[2], &length); return TclZipfs_MountBuffer(interp, mountPoint, data, length, 1); } @@ -2141,7 +2135,7 @@ ZipAddFile( nbyte = nbytecompr = 0; while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_IO_FAILURE) { if (nbyte == 0 && errno == EISDIR) { Tcl_Close(interp, in); return TCL_OK; @@ -2167,7 +2161,7 @@ ZipAddFile( memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen); len = zpathlen + ZIP_LOCAL_HEADER_LEN; - if ((size_t) Tcl_Write(out, buf, len) != len) { + if (Tcl_Write(out, buf, len) != len) { wrerr: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on %s: %s", path, Tcl_PosixError(interp))); @@ -2186,7 +2180,7 @@ ZipAddFile( ZipWriteShort(abuf, 0xffff); ZipWriteShort(abuf + 2, align - 4); ZipWriteInt(abuf + 4, 0x03020100); - if ((size_t) Tcl_Write(out, (const char *) abuf, align) != align) { + if (Tcl_Write(out, (const char *) abuf, align) != align) { goto wrerr; } } @@ -2257,7 +2251,7 @@ ZipAddFile( } do { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_IO_FAILURE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "read error on %s: %s", path, Tcl_PosixError(interp))); deflateEnd(&stream); @@ -2288,7 +2282,7 @@ ZipAddFile( obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); } } - if (olen && ((size_t) Tcl_Write(out, obuf, olen) != olen)) { + if (olen && (Tcl_Write(out, obuf, olen) != olen)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); deflateEnd(&stream); @@ -2318,7 +2312,7 @@ ZipAddFile( nbytecompr = (passwd ? 12 : 0); while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_IO_FAILURE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "read error on \"%s\": %s", path, Tcl_PosixError(interp))); @@ -2335,7 +2329,7 @@ ZipAddFile( buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); } } - if ((size_t) Tcl_Write(out, buf, len) != len) { + if (Tcl_Write(out, buf, len) != len) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); Tcl_Close(interp, in); @@ -2358,7 +2352,7 @@ ZipAddFile( return TCL_ERROR; } - z = ckalloc(sizeof(ZipEntry)); + z = Tcl_Alloc(sizeof(ZipEntry)); Tcl_SetHashValue(hPtr, z); z->name = NULL; z->tnext = NULL; @@ -2392,14 +2386,14 @@ ZipAddFile( ZipWriteShort(buf + ZIP_LOCAL_EXTRALEN_OFFS, align); if (Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) { Tcl_DeleteHashEntry(hPtr); - ckfree(z); + Tcl_Free(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); return TCL_ERROR; } if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) { Tcl_DeleteHashEntry(hPtr); - ckfree(z); + Tcl_Free(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); return TCL_ERROR; @@ -2407,7 +2401,7 @@ ZipAddFile( Tcl_Flush(out); if (Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) { Tcl_DeleteHashEntry(hPtr); - ckfree(z); + Tcl_Free(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); return TCL_ERROR; @@ -2560,7 +2554,7 @@ ZipFSMkZipOrImgObjCmd( zf = &zf0; } if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) { - if ((size_t) Tcl_Write(out, (char *) zf->data, + if (Tcl_Write(out, (char *) zf->data, zf->passOffset) != zf->passOffset) { memset(passBuf, 0, sizeof(passBuf)); Tcl_DecrRefCount(list); @@ -2603,7 +2597,7 @@ ZipFSMkZipOrImgObjCmd( return TCL_ERROR; } i = Tcl_Seek(in, 0, SEEK_END); - if (i == ERROR_LENGTH) { + if (i == TCL_IO_FAILURE) { cperr: memset(passBuf, 0, sizeof(passBuf)); Tcl_DecrRefCount(list); @@ -2730,7 +2724,7 @@ ZipFSMkZipOrImgObjCmd( ZipWriteInt(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN) - || ((size_t) Tcl_Write(out, z->name, len) != len)) { + || (Tcl_Write(out, z->name, len) != len)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); goto done; @@ -2765,7 +2759,7 @@ ZipFSMkZipOrImgObjCmd( for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { z = Tcl_GetHashValue(hPtr); - ckfree(z); + Tcl_Free(z); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&fileHash); @@ -3320,7 +3314,7 @@ ZipChannelClose( ZipChannel *info = instanceData; if (info->iscompr && info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); info->ubuf = NULL; } if (info->isEncrypted) { @@ -3329,11 +3323,11 @@ ZipChannelClose( } if (info->isWriting) { ZipEntry *z = info->zipEntryPtr; - unsigned char *newdata = attemptckrealloc(info->ubuf, info->numRead); + unsigned char *newdata = Tcl_AttemptRealloc(info->ubuf, info->numRead); if (newdata) { if (z->data) { - ckfree(z->data); + Tcl_Free(z->data); } z->data = newdata; z->numBytes = z->numCompressedBytes = info->numBytes; @@ -3344,13 +3338,13 @@ ZipChannelClose( z->offset = 0; z->crc32 = 0; } else { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); } } WriteLock(); info->zipFilePtr->numOpen--; Unlock(); - ckfree(info); + Tcl_Free(info); return TCL_OK; } @@ -3680,7 +3674,7 @@ ZipChannelOpen( } else { flags = TCL_WRITABLE; } - info = attemptckalloc(sizeof(ZipChannel)); + info = Tcl_AttemptAlloc(sizeof(ZipChannel)); if (!info) { ZIPFS_ERROR(interp, "out of memory"); if (interp) { @@ -3698,13 +3692,13 @@ ZipChannelOpen( info->maxWrite = ZipFS.wrmax; info->iscompr = 0; info->isEncrypted = 0; - info->ubuf = attemptckalloc(info->maxWrite); + info->ubuf = Tcl_AttemptAlloc(info->maxWrite); if (!info->ubuf) { merror0: if (info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); } - ckfree(info); + Tcl_Free(info); ZIPFS_ERROR(interp, "out of memory"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); @@ -3756,7 +3750,7 @@ ZipChannelOpen( unsigned int j; stream.avail_in -= 12; - cbuf = attemptckalloc(stream.avail_in); + cbuf = Tcl_AttemptAlloc(stream.avail_in); if (!cbuf) { goto merror0; } @@ -3779,19 +3773,19 @@ ZipChannelOpen( || ((err == Z_OK) && (stream.avail_in == 0))) { if (cbuf) { memset(info->keys, 0, sizeof(info->keys)); - ckfree(cbuf); + Tcl_Free(cbuf); } goto wrapchan; } cerror0: if (cbuf) { memset(info->keys, 0, sizeof(info->keys)); - ckfree(cbuf); + Tcl_Free(cbuf); } if (info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); } - ckfree(info); + Tcl_Free(info); ZIPFS_ERROR(interp, "decompression error"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL); @@ -3856,7 +3850,7 @@ ZipChannelOpen( stream.avail_in = z->numCompressedBytes; if (info->isEncrypted) { stream.avail_in -= 12; - ubuf = attemptckalloc(stream.avail_in); + ubuf = Tcl_AttemptAlloc(stream.avail_in); if (!ubuf) { info->ubuf = NULL; goto merror; @@ -3869,15 +3863,15 @@ ZipChannelOpen( } else { stream.next_in = info->ubuf; } - stream.next_out = info->ubuf = attemptckalloc(info->numBytes); + stream.next_out = info->ubuf = Tcl_AttemptAlloc(info->numBytes); if (!info->ubuf) { merror: if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - ckfree(ubuf); + Tcl_Free(ubuf); } - ckfree(info); + Tcl_Free(info); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); @@ -3896,7 +3890,7 @@ ZipChannelOpen( if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - ckfree(ubuf); + Tcl_Free(ubuf); } goto wrapchan; } @@ -3904,12 +3898,12 @@ ZipChannelOpen( if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - ckfree(ubuf); + Tcl_Free(ubuf); } if (info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); } - ckfree(info); + Tcl_Free(info); ZIPFS_ERROR(interp, "decompression error"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL); @@ -3925,9 +3919,9 @@ ZipChannelOpen( */ len = z->numCompressedBytes - 12; - ubuf = (unsigned char *) attemptckalloc(len); + ubuf = (unsigned char *) Tcl_AttemptAlloc(len); if (ubuf == NULL) { - ckfree((char *) info); + Tcl_Free((char *) info); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); @@ -4301,7 +4295,7 @@ ZipFSMatchInDirectoryProc( } l = strlen(pattern); - pat = ckalloc(len + l + 2); + pat = Tcl_Alloc(len + l + 2); memcpy(pat, path, len); while ((len > 1) && (pat[len - 1] == '/')) { --len; @@ -4333,7 +4327,7 @@ ZipFSMatchInDirectoryProc( } } } - ckfree(pat); + Tcl_Free(pat); end: Unlock(); diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 32268af..34ea90c 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -64,7 +64,7 @@ typedef struct { Tcl_Obj *inData, *outData; /* Input / output buffers (lists) */ Tcl_Obj *currentInput; /* Pointer to what is currently being * inflated. */ - int outPos; + size_t outPos; int mode; /* Either TCL_ZLIB_STREAM_DEFLATE or * TCL_ZLIB_STREAM_INFLATE. */ int format; /* Flags from the TCL_ZLIB_FORMAT_* */ @@ -178,7 +178,7 @@ static void ConvertError(Tcl_Interp *interp, int code, uLong adler); static Tcl_Obj * ConvertErrorToList(int code, uLong adler); static inline int Deflate(z_streamp strm, void *bufferPtr, - int bufferSize, int flush, int *writtenPtr); + size_t bufferSize, int flush, size_t *writtenPtr); static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj); static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj, GzipHeader *headerPtr, int *extraSizePtr); @@ -440,8 +440,8 @@ GenerateHeader( if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { - valueStr = TclGetStringFromObj(value, &len); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, + valueStr = TclGetString(value); + Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, NULL); headerPtr->nativeCommentBuf[len] = '\0'; @@ -461,8 +461,8 @@ GenerateHeader( if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) { goto error; } else if (value != NULL) { - valueStr = TclGetStringFromObj(value, &len); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, + valueStr = TclGetString(value); + Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL, headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL); headerPtr->nativeFilenameBuf[len] = '\0'; headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf; @@ -590,8 +590,8 @@ SetInflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - int length; - unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); + size_t length; + unsigned char *bytes = TclGetByteArrayFromObj(compDictObj, &length); return inflateSetDictionary(strm, bytes, length); } @@ -604,8 +604,8 @@ SetDeflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - int length; - unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); + size_t length; + unsigned char *bytes = TclGetByteArrayFromObj(compDictObj, &length); return deflateSetDictionary(strm, bytes, length); } @@ -616,9 +616,9 @@ static inline int Deflate( z_streamp strm, void *bufferPtr, - int bufferSize, + size_t bufferSize, int flush, - int *writtenPtr) + size_t *writtenPtr) { int e; @@ -635,7 +635,7 @@ static inline void AppendByteArray( Tcl_Obj *listObj, void *buffer, - int size) + size_t size) { if (size > 0) { Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size); @@ -697,11 +697,11 @@ Tcl_ZlibStreamInit( case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; if (dictObj) { - gzHeaderPtr = ckalloc(sizeof(GzipHeader)); + gzHeaderPtr = Tcl_Alloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); if (GenerateHeader(interp, dictObj, gzHeaderPtr, NULL) != TCL_OK) { - ckfree(gzHeaderPtr); + Tcl_Free(gzHeaderPtr); return TCL_ERROR; } } @@ -731,7 +731,7 @@ Tcl_ZlibStreamInit( break; case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; - gzHeaderPtr = ckalloc(sizeof(GzipHeader)); + gzHeaderPtr = Tcl_Alloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); gzHeaderPtr->header.name = (Bytef *) gzHeaderPtr->nativeFilenameBuf; @@ -757,7 +757,7 @@ Tcl_ZlibStreamInit( " TCL_ZLIB_STREAM_INFLATE"); } - zshPtr = ckalloc(sizeof(ZlibStreamHandle)); + zshPtr = Tcl_Alloc(sizeof(ZlibStreamHandle)); zshPtr->interp = interp; zshPtr->mode = mode; zshPtr->format = format; @@ -857,9 +857,9 @@ Tcl_ZlibStreamInit( Tcl_DecrRefCount(zshPtr->compDictObj); } if (zshPtr->gzHeaderPtr) { - ckfree(zshPtr->gzHeaderPtr); + Tcl_Free(zshPtr->gzHeaderPtr); } - ckfree(zshPtr); + Tcl_Free(zshPtr); return TCL_ERROR; } @@ -970,10 +970,10 @@ ZlibStreamCleanup( Tcl_DecrRefCount(zshPtr->compDictObj); } if (zshPtr->gzHeaderPtr) { - ckfree(zshPtr->gzHeaderPtr); + Tcl_Free(zshPtr->gzHeaderPtr); } - ckfree(zshPtr); + Tcl_Free(zshPtr); } /* @@ -1188,7 +1188,8 @@ Tcl_ZlibStreamPut( { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; char *dataTmp = NULL; - int e, size, outSize, toStore; + int e; + size_t size, outSize, toStore; if (zshPtr->streamEnd) { if (zshPtr->interp) { @@ -1200,7 +1201,7 @@ Tcl_ZlibStreamPut( } if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { - zshPtr->stream.next_in = Tcl_GetByteArrayFromObj(data, &size); + zshPtr->stream.next_in = TclGetByteArrayFromObj(data, &size); zshPtr->stream.avail_in = size; /* @@ -1231,7 +1232,7 @@ Tcl_ZlibStreamPut( if (outSize > BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; } - dataTmp = ckalloc(outSize); + dataTmp = Tcl_Alloc(outSize); while (1) { e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore); @@ -1265,7 +1266,7 @@ Tcl_ZlibStreamPut( if (outSize < BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; /* There may be *lots* of data left to output... */ - dataTmp = ckrealloc(dataTmp, outSize); + dataTmp = Tcl_Realloc(dataTmp, outSize); } } @@ -1274,7 +1275,7 @@ Tcl_ZlibStreamPut( */ AppendByteArray(zshPtr->outData, dataTmp, toStore); - ckfree(dataTmp); + Tcl_Free(dataTmp); } else { /* * This is easy. Just append to the inData list. @@ -1307,14 +1308,15 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ Tcl_Obj *data, /* A place to append the data. */ - int count) /* Number of bytes to grab as a maximum, you + size_t count) /* Number of bytes to grab as a maximum, you * may get less! */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; - int e, i, listLen, itemLen, dataPos = 0; + int e, i, listLen; + size_t itemLen, dataPos = 0; Tcl_Obj *itemObj; unsigned char *dataPtr, *itemPtr; - int existing; + size_t existing; /* * Getting beyond the of stream, just return empty string. @@ -1324,10 +1326,10 @@ Tcl_ZlibStreamGet( return TCL_OK; } - (void) Tcl_GetByteArrayFromObj(data, &existing); + (void) TclGetByteArrayFromObj(data, &existing); if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) { - if (count == -1) { + if (count == TCL_AUTO_LENGTH) { /* * The only safe thing to do is restict to 65k. We might cause a * panic for out of memory if we just kept growing the buffer. @@ -1367,7 +1369,7 @@ Tcl_ZlibStreamGet( if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); + itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen); Tcl_IncrRefCount(itemObj); zshPtr->currentInput = itemObj; zshPtr->stream.next_in = itemPtr; @@ -1439,7 +1441,7 @@ Tcl_ZlibStreamGet( if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); + itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen); Tcl_IncrRefCount(itemObj); zshPtr->currentInput = itemObj; zshPtr->stream.next_in = itemPtr; @@ -1484,11 +1486,11 @@ Tcl_ZlibStreamGet( } } else { Tcl_ListObjLength(NULL, zshPtr->outData, &listLen); - if (count == -1) { + if (count == TCL_AUTO_LENGTH) { count = 0; for (i=0; i<listLen; i++) { Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj); - (void) Tcl_GetByteArrayFromObj(itemObj, &itemLen); + (void) TclGetByteArrayFromObj(itemObj, &itemLen); if (i == 0) { count += itemLen - zshPtr->outPos; } else { @@ -1513,8 +1515,8 @@ Tcl_ZlibStreamGet( */ Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj); - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); - if (itemLen-zshPtr->outPos >= count-dataPos) { + itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen); + if (itemLen-zshPtr->outPos >= (size_t)(count-dataPos)) { size_t len = count - dataPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); @@ -1560,7 +1562,8 @@ Tcl_ZlibDeflate( int level, Tcl_Obj *gzipHeaderDictObj) { - int wbits = 0, inLen = 0, e = 0, extraSize = 0; + int wbits = 0, e = 0, extraSize = 0; + size_t inLen = 0; Byte *inData = NULL; z_stream stream; GzipHeader header; @@ -1620,9 +1623,9 @@ Tcl_ZlibDeflate( * to the deflate command. */ - inData = Tcl_GetByteArrayFromObj(data, &inLen); + inData = TclGetByteArrayFromObj(data, &inLen); memset(&stream, 0, sizeof(z_stream)); - stream.avail_in = (uInt) inLen; + stream.avail_in = inLen; stream.next_in = inData; /* @@ -1707,10 +1710,11 @@ Tcl_ZlibInflate( Tcl_Interp *interp, int format, Tcl_Obj *data, - int bufferSize, + size_t bufferSize, Tcl_Obj *gzipHeaderDictObj) { - int wbits = 0, inLen = 0, e = 0, newBufferSize; + int wbits = 0, e = 0; + size_t inLen = 0, newBufferSize; Byte *inData = NULL, *outData = NULL, *newOutData = NULL; z_stream stream; gz_header header, *headerPtr = NULL; @@ -1750,15 +1754,15 @@ Tcl_ZlibInflate( if (gzipHeaderDictObj) { headerPtr = &header; memset(headerPtr, 0, sizeof(gz_header)); - nameBuf = ckalloc(MAXPATHLEN); + nameBuf = Tcl_Alloc(MAXPATHLEN); header.name = (Bytef *) nameBuf; header.name_max = MAXPATHLEN - 1; - commentBuf = ckalloc(MAX_COMMENT_LEN); + commentBuf = Tcl_Alloc(MAX_COMMENT_LEN); header.comment = (Bytef *) commentBuf; header.comm_max = MAX_COMMENT_LEN - 1; } - inData = Tcl_GetByteArrayFromObj(data, &inLen); + inData = TclGetByteArrayFromObj(data, &inLen); if (bufferSize < 1) { /* * Start with a buffer (up to) 3 times the size of the input data. @@ -1776,7 +1780,7 @@ Tcl_ZlibInflate( TclNewObj(obj); outData = Tcl_SetByteArrayLength(obj, bufferSize); memset(&stream, 0, sizeof(z_stream)); - stream.avail_in = (uInt) inLen+1; /* +1 because zlib can "over-request" + stream.avail_in = inLen+1; /* +1 because zlib can "over-request" * input (but ignore it!) */ stream.next_in = inData; stream.avail_out = bufferSize; @@ -1859,8 +1863,8 @@ Tcl_ZlibInflate( ExtractHeader(&header, gzipHeaderDictObj); SetValue(gzipHeaderDictObj, "size", Tcl_NewWideIntObj(stream.total_out)); - ckfree(nameBuf); - ckfree(commentBuf); + Tcl_Free(nameBuf); + Tcl_Free(commentBuf); } Tcl_SetObjResult(interp, obj); return TCL_OK; @@ -1869,10 +1873,10 @@ Tcl_ZlibInflate( TclDecrRefCount(obj); ConvertError(interp, e, stream.adler); if (nameBuf) { - ckfree(nameBuf); + Tcl_Free(nameBuf); } if (commentBuf) { - ckfree(commentBuf); + Tcl_Free(commentBuf); } return TCL_ERROR; } @@ -1891,7 +1895,7 @@ unsigned int Tcl_ZlibCRC32( unsigned int crc, const unsigned char *buf, - int len) + size_t len) { /* Nothing much to do, just wrap the crc32(). */ return crc32(crc, (Bytef *) buf, len); @@ -1901,7 +1905,7 @@ unsigned int Tcl_ZlibAdler32( unsigned int adler, const unsigned char *buf, - int len) + size_t len) { return adler32(adler, (Bytef *) buf, len); } @@ -1923,8 +1927,9 @@ ZlibCmd( int objc, Tcl_Obj *const objv[]) { - int command, dlen, i, option, level = -1; - unsigned start, buffersize = 0; + int command, i, option, level = -1; + size_t dlen, start, buffersize = 0; + Tcl_WideInt wideLen; Byte *data; Tcl_Obj *headerDictObj; const char *extraInfoStr = NULL; @@ -1961,7 +1966,7 @@ ZlibCmd( if (objc < 4) { start = Tcl_ZlibAdler32(0, NULL, 0); } - data = Tcl_GetByteArrayFromObj(objv[2], &dlen); + data = TclGetByteArrayFromObj(objv[2], &dlen); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibAdler32(start, data, dlen))); return TCL_OK; @@ -1978,7 +1983,7 @@ ZlibCmd( if (objc < 4) { start = Tcl_ZlibCRC32(0, NULL, 0); } - data = Tcl_GetByteArrayFromObj(objv[2], &dlen); + data = TclGetByteArrayFromObj(objv[2], &dlen); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibCRC32(start, data, dlen))); return TCL_OK; @@ -2071,14 +2076,15 @@ ZlibCmd( return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetIntFromObj(interp, objv[3], - (int *) &buffersize) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[3], + &wideLen) != TCL_OK) { return TCL_ERROR; } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { + if (wideLen < MIN_NONSTREAM_BUFFER_SIZE + || wideLen > MAX_BUFFER_SIZE) { goto badBuffer; } + buffersize = wideLen; } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], buffersize, NULL); @@ -2090,14 +2096,15 @@ ZlibCmd( return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetIntFromObj(interp, objv[3], - (int *) &buffersize) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[3], + &wideLen) != TCL_OK) { return TCL_ERROR; } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { + if (wideLen < MIN_NONSTREAM_BUFFER_SIZE + || wideLen > MAX_BUFFER_SIZE) { goto badBuffer; } + buffersize = wideLen; } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], buffersize, NULL); @@ -2121,14 +2128,15 @@ ZlibCmd( } switch (option) { case 0: - if (Tcl_GetIntFromObj(interp, objv[i+1], - (int *) &buffersize) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[i+1], + &wideLen) != TCL_OK) { return TCL_ERROR; } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { + if (wideLen < MIN_NONSTREAM_BUFFER_SIZE + || wideLen > MAX_BUFFER_SIZE) { goto badBuffer; } + buffersize = wideLen; break; case 1: headerVarObj = objv[i+1]; @@ -2731,9 +2739,9 @@ ZlibStreamAddCmd( */ if (compDictObj != NULL) { - int len; + size_t len; - (void) Tcl_GetByteArrayFromObj(compDictObj, &len); + (void) TclGetByteArrayFromObj(compDictObj, &len); if (len == 0) { compDictObj = NULL; } @@ -2835,9 +2843,9 @@ ZlibStreamPutCmd( */ if (compDictObj != NULL) { - int len; + size_t len; - (void) Tcl_GetByteArrayFromObj(compDictObj, &len); + (void) TclGetByteArrayFromObj(compDictObj, &len); if (len == 0) { compDictObj = NULL; } @@ -2896,7 +2904,8 @@ ZlibTransformClose( Tcl_Interp *interp) { ZlibChannelData *cd = instanceData; - int e, written, result = TCL_OK; + int e, result = TCL_OK; + size_t written; /* * Delete the support timer. @@ -2960,14 +2969,14 @@ ZlibTransformClose( Tcl_DStringFree(&cd->decompressed); if (cd->inBuffer) { - ckfree(cd->inBuffer); + Tcl_Free(cd->inBuffer); cd->inBuffer = NULL; } if (cd->outBuffer) { - ckfree(cd->outBuffer); + Tcl_Free(cd->outBuffer); cd->outBuffer = NULL; } - ckfree(cd); + Tcl_Free(cd); return result; } @@ -3033,13 +3042,13 @@ ZlibTransformInput( * Three cases here: * 1. Got some data from the underlying channel (readBytes > 0) so * it should be fed through the decompression engine. - * 2. Got an error (readBytes < 0) which we should report up except + * 2. Got an error (readBytes == -1) which we should report up except * for the case where we can convert it to a short read. * 3. Got an end-of-data from EOF or blocking (readBytes == 0). If * it is EOF, try flushing the data out of the decompressor. */ - if (readBytes < 0) { + if (readBytes == -1) { /* See ReflectInput() in tclIORTrans.c */ if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) { @@ -3105,7 +3114,8 @@ ZlibTransformOutput( ZlibChannelData *cd = instanceData; Tcl_DriverOutputProc *outProc = Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent)); - int e, produced; + int e; + size_t produced; Tcl_Obj *errObj; if (cd->mode == TCL_ZLIB_STREAM_INFLATE) { @@ -3167,7 +3177,8 @@ ZlibTransformFlush( ZlibChannelData *cd, int flushType) { - int e, len; + int e; + size_t len; cd->outStream.avail_in = 0; do { @@ -3239,7 +3250,7 @@ ZlibTransformSetOption( /* not used */ TclNewStringObj(compDictObj, value, strlen(value)); Tcl_IncrRefCount(compDictObj); - (void) Tcl_GetByteArrayFromObj(compDictObj, NULL); + Tcl_GetByteArrayFromObj(compDictObj, NULL); if (cd->compDictObj) { TclDecrRefCount(cd->compDictObj); } @@ -3386,10 +3397,9 @@ ZlibTransformGetOption( } } else { if (cd->compDictObj) { - int len; - const char *str = TclGetStringFromObj(cd->compDictObj, &len); + const char *str = TclGetString(cd->compDictObj); - Tcl_DStringAppend(dsPtr, str, len); + Tcl_DStringAppend(dsPtr, str, cd->compDictObj->length); } return TCL_OK; } @@ -3590,7 +3600,7 @@ ZlibStackChannelTransform( * dictionary (not dictObj!) to use if * necessary. */ { - ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData)); + ZlibChannelData *cd = Tcl_Alloc(sizeof(ZlibChannelData)); Tcl_Channel chan; int wbits = 0; @@ -3650,7 +3660,7 @@ ZlibStackChannelTransform( goto error; } cd->inAllocated = DEFAULT_BUFFER_SIZE; - cd->inBuffer = ckalloc(cd->inAllocated); + cd->inBuffer = Tcl_Alloc(cd->inAllocated); if (cd->flags & IN_HEADER) { if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) { goto error; @@ -3667,7 +3677,7 @@ ZlibStackChannelTransform( goto error; } cd->outAllocated = DEFAULT_BUFFER_SIZE; - cd->outBuffer = ckalloc(cd->outAllocated); + cd->outBuffer = Tcl_Alloc(cd->outAllocated); if (cd->flags & OUT_HEADER) { if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) { goto error; @@ -3694,17 +3704,17 @@ ZlibStackChannelTransform( error: if (cd->inBuffer) { - ckfree(cd->inBuffer); + Tcl_Free(cd->inBuffer); inflateEnd(&cd->inStream); } if (cd->outBuffer) { - ckfree(cd->outBuffer); + Tcl_Free(cd->outBuffer); deflateEnd(&cd->outStream); } if (cd->compDictObj) { Tcl_DecrRefCount(cd->compDictObj); } - ckfree(cd); + Tcl_Free(cd); return NULL; } @@ -4018,7 +4028,7 @@ Tcl_ZlibInflate( Tcl_Interp *interp, int format, Tcl_Obj *data, - int bufferSize, + size_t bufferSize, Tcl_Obj *gzipHeaderDictObj) { if (interp) { @@ -4032,7 +4042,7 @@ unsigned int Tcl_ZlibCRC32( unsigned int crc, const char *buf, - int len) + size_t len) { return 0; } @@ -4041,7 +4051,7 @@ unsigned int Tcl_ZlibAdler32( unsigned int adler, const char *buf, - int len) + size_t len) { return 0; } |