From 949c30336f1aea82abdd123ddbdf9d66161c2c56 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 12 Dec 2012 05:01:04 +0000 Subject: Rename the memory routines so that Tcl_Alloc/Tcl_Free/etc become the recommended things for extensions and embedders to call, instead of ckalloc/ckfree/etc. Tcl_Alloc, etc. are macros that can be configured for memory debuggin, as ckalloc, etc. have been and continue to be. --- generic/tcl.decls | 10 +++++----- generic/tcl.h | 18 ++++++++++++------ generic/tclCkalloc.c | 30 ++++++++++++++---------------- generic/tclDecls.h | 40 ++++++++++++++++++++-------------------- generic/tclInt.h | 6 +++--- generic/tclInterp.c | 2 +- generic/tclStubInit.c | 16 ++++++++-------- win/tclAppInit.c | 2 +- 8 files changed, 64 insertions(+), 60 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index ad725f5..88567e3 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -40,13 +40,13 @@ declare 2 { void Tcl_Panic(const char *format, ...) } declare 3 { - char *Tcl_Alloc(unsigned int size) + char *Tcl_MemAlloc(unsigned int size) } declare 4 { - void Tcl_Free(char *ptr) + void Tcl_MemFree(char *ptr) } declare 5 { - char *Tcl_Realloc(char *ptr, unsigned int size) + char *Tcl_MemRealloc(char *ptr, unsigned int size) } declare 6 { char *Tcl_DbCkalloc(unsigned int size, const char *file, int line) @@ -1527,13 +1527,13 @@ declare 427 { int flags, Tcl_CommandTraceProc *proc, ClientData clientData) } declare 428 { - char *Tcl_AttemptAlloc(unsigned int size) + char *Tcl_AttemptMemAlloc(unsigned int size) } declare 429 { char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line) } declare 430 { - char *Tcl_AttemptRealloc(char *ptr, unsigned int size) + char *Tcl_AttemptMemRealloc(char *ptr, unsigned int size) } declare 431 { char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, diff --git a/generic/tcl.h b/generic/tcl.h index 162983b..121ab5c 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2255,6 +2255,12 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); * defined in tclCkalloc.c. */ +#define Tcl_Alloc(x) ckalloc(x) +#define Tcl_Free(x) ckfree(x) +#define Tcl_Realloc(x, y) ckrealloc(x, y) +#define Tcl_AttemptAlloc(x) attemptckalloc(x) +#define Tcl_AttemptRealloc(x, y) attemptckrealloc(x, y) + #ifdef TCL_MEM_DEBUG # define ckalloc(x) \ @@ -2271,21 +2277,21 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #else /* !TCL_MEM_DEBUG */ /* - * If we are not using the debugging allocator, we should call the Tcl_Alloc, + * If we are not using the debugging allocator, we should call the Tcl_MemAlloc, * et al. routines in order to guarantee that every module is using the same * memory allocator both inside and outside of the Tcl library. */ # define ckalloc(x) \ - ((void *) Tcl_Alloc((unsigned)(x))) + ((void *) Tcl_MemAlloc((unsigned)(x))) # define ckfree(x) \ - Tcl_Free((char *)(x)) + Tcl_MemFree((char *)(x)) # define ckrealloc(x,y) \ - ((void *) Tcl_Realloc((char *)(x), (unsigned)(y))) + ((void *) Tcl_MemRealloc((char *)(x), (unsigned)(y))) # define attemptckalloc(x) \ - ((void *) Tcl_AttemptAlloc((unsigned)(x))) + ((void *) Tcl_AttemptMemAlloc((unsigned)(x))) # define attemptckrealloc(x,y) \ - ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) + ((void *) Tcl_AttemptMemRealloc((char *)(x), (unsigned)(y))) # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index ab977cb..71dc45d 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -20,11 +20,9 @@ #define FALSE 0 #define TRUE 1 -#undef Tcl_Alloc -#undef Tcl_Free -#undef Tcl_Realloc -#undef Tcl_AttemptAlloc -#undef Tcl_AttemptRealloc +#undef Tcl_MemFree +#undef Tcl_AttemptMemAlloc +#undef Tcl_AttemptMemRealloc #ifdef TCL_MEM_DEBUG @@ -747,35 +745,35 @@ Tcl_AttemptDbCkrealloc( */ char * -Tcl_Alloc( +Tcl_MemAlloc( unsigned int size) { return Tcl_DbCkalloc(size, "unknown", 0); } char * -Tcl_AttemptAlloc( +Tcl_AttemptMemAlloc( unsigned int size) { return Tcl_AttemptDbCkalloc(size, "unknown", 0); } void -Tcl_Free( +Tcl_MemFree( char *ptr) { Tcl_DbCkfree(ptr, "unknown", 0); } char * -Tcl_Realloc( +Tcl_MemRealloc( char *ptr, unsigned int size) { return Tcl_DbCkrealloc(ptr, size, "unknown", 0); } char * -Tcl_AttemptRealloc( +Tcl_AttemptMemRealloc( char *ptr, unsigned int size) { @@ -1038,7 +1036,7 @@ Tcl_InitMemory( /* *---------------------------------------------------------------------- * - * Tcl_Alloc -- + * Tcl_MemAlloc -- * * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check * that memory was actually allocated. @@ -1047,7 +1045,7 @@ Tcl_InitMemory( */ char * -Tcl_Alloc( +Tcl_MemAlloc( unsigned int size) { char *result; @@ -1099,7 +1097,7 @@ Tcl_DbCkalloc( */ char * -Tcl_AttemptAlloc( +Tcl_AttemptMemAlloc( unsigned int size) { char *result; @@ -1132,7 +1130,7 @@ Tcl_AttemptDbCkalloc( */ char * -Tcl_Realloc( +Tcl_MemRealloc( char *ptr, unsigned int size) { @@ -1176,7 +1174,7 @@ Tcl_DbCkrealloc( */ char * -Tcl_AttemptRealloc( +Tcl_AttemptMemRealloc( char *ptr, unsigned int size) { @@ -1212,7 +1210,7 @@ Tcl_AttemptDbCkrealloc( */ void -Tcl_Free( +Tcl_MemFree( char *ptr) { TclpFree(ptr); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index d38296d..cf75bb6 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -35,11 +35,11 @@ TCLAPI const char * Tcl_PkgRequireEx(Tcl_Interp *interp, /* 2 */ TCLAPI void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 3 */ -TCLAPI char * Tcl_Alloc(unsigned int size); +TCLAPI char * Tcl_MemAlloc(unsigned int size); /* 4 */ -TCLAPI void Tcl_Free(char *ptr); +TCLAPI void Tcl_MemFree(char *ptr); /* 5 */ -TCLAPI char * Tcl_Realloc(char *ptr, unsigned int size); +TCLAPI char * Tcl_MemRealloc(char *ptr, unsigned int size); /* 6 */ TCLAPI char * Tcl_DbCkalloc(unsigned int size, const char *file, int line); @@ -1201,12 +1201,12 @@ TCLAPI void Tcl_UntraceCommand(Tcl_Interp *interp, Tcl_CommandTraceProc *proc, ClientData clientData); /* 428 */ -TCLAPI char * Tcl_AttemptAlloc(unsigned int size); +TCLAPI char * Tcl_AttemptMemAlloc(unsigned int size); /* 429 */ TCLAPI char * Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line); /* 430 */ -TCLAPI char * Tcl_AttemptRealloc(char *ptr, unsigned int size); +TCLAPI char * Tcl_AttemptMemRealloc(char *ptr, unsigned int size); /* 431 */ TCLAPI char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, const char *file, int line); @@ -1782,9 +1782,9 @@ 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 */ 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_MemAlloc) (unsigned int size); /* 3 */ + void (*tcl_MemFree) (char *ptr); /* 4 */ + char * (*tcl_MemRealloc) (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 */ @@ -2231,9 +2231,9 @@ typedef struct TclStubs { 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_AttemptMemAlloc) (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_AttemptMemRealloc) (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 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ @@ -2456,12 +2456,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_PkgRequireEx) /* 1 */ #define Tcl_Panic \ (tclStubsPtr->tcl_Panic) /* 2 */ -#define Tcl_Alloc \ - (tclStubsPtr->tcl_Alloc) /* 3 */ -#define Tcl_Free \ - (tclStubsPtr->tcl_Free) /* 4 */ -#define Tcl_Realloc \ - (tclStubsPtr->tcl_Realloc) /* 5 */ +#define Tcl_MemAlloc \ + (tclStubsPtr->tcl_MemAlloc) /* 3 */ +#define Tcl_MemFree \ + (tclStubsPtr->tcl_MemFree) /* 4 */ +#define Tcl_MemRealloc \ + (tclStubsPtr->tcl_MemRealloc) /* 5 */ #define Tcl_DbCkalloc \ (tclStubsPtr->tcl_DbCkalloc) /* 6 */ #define Tcl_DbCkfree \ @@ -3311,12 +3311,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_TraceCommand) /* 426 */ #define Tcl_UntraceCommand \ (tclStubsPtr->tcl_UntraceCommand) /* 427 */ -#define Tcl_AttemptAlloc \ - (tclStubsPtr->tcl_AttemptAlloc) /* 428 */ +#define Tcl_AttemptMemAlloc \ + (tclStubsPtr->tcl_AttemptMemAlloc) /* 428 */ #define Tcl_AttemptDbCkalloc \ (tclStubsPtr->tcl_AttemptDbCkalloc) /* 429 */ -#define Tcl_AttemptRealloc \ - (tclStubsPtr->tcl_AttemptRealloc) /* 430 */ +#define Tcl_AttemptMemRealloc \ + (tclStubsPtr->tcl_AttemptMemRealloc) /* 430 */ #define Tcl_AttemptDbCkrealloc \ (tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */ #define Tcl_AttemptSetObjLength \ diff --git a/generic/tclInt.h b/generic/tclInt.h index 0efb1b6..eeb685a 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4776,9 +4776,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_AttemptMemAlloc(size) TclpAlloc(size) +#define Tcl_AttemptMemRealloc(ptr, size) TclpRealloc((ptr), (size)) +#define Tcl_MemFree(ptr) TclpFree(ptr) #endif #endif /* _TCLINT */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 0b0f652..f1faccd 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -3466,7 +3466,7 @@ Tcl_LimitAddHandler( */ if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) { - deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free; + deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_MemFree; } if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_STATIC) { deleteProc = NULL; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index c836f45..d78d7f1 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -22,9 +22,9 @@ * Remove macros that will interfere with the definitions below. */ -#undef Tcl_Alloc -#undef Tcl_Free -#undef Tcl_Realloc +#undef Tcl_MemAlloc +#undef Tcl_MemFree +#undef Tcl_MemRealloc #undef Tcl_NewBooleanObj #undef Tcl_NewByteArrayObj #undef Tcl_NewDoubleObj @@ -625,9 +625,9 @@ const TclStubs tclStubs = { Tcl_PkgProvideEx, /* 0 */ Tcl_PkgRequireEx, /* 1 */ Tcl_Panic, /* 2 */ - Tcl_Alloc, /* 3 */ - Tcl_Free, /* 4 */ - Tcl_Realloc, /* 5 */ + Tcl_MemAlloc, /* 3 */ + Tcl_MemFree, /* 4 */ + Tcl_MemRealloc, /* 5 */ Tcl_DbCkalloc, /* 6 */ Tcl_DbCkfree, /* 7 */ Tcl_DbCkrealloc, /* 8 */ @@ -1074,9 +1074,9 @@ const TclStubs tclStubs = { Tcl_CommandTraceInfo, /* 425 */ Tcl_TraceCommand, /* 426 */ Tcl_UntraceCommand, /* 427 */ - Tcl_AttemptAlloc, /* 428 */ + Tcl_AttemptMemAlloc, /* 428 */ Tcl_AttemptDbCkalloc, /* 429 */ - Tcl_AttemptRealloc, /* 430 */ + Tcl_AttemptMemRealloc, /* 430 */ Tcl_AttemptDbCkrealloc, /* 431 */ Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 5ecebea..917cf00 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -255,7 +255,7 @@ setargv( } /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ - #undef Tcl_Alloc + #undef Tcl_MemAlloc #undef Tcl_DbCkalloc argSpace = ckalloc(size * sizeof(char *) -- cgit v0.12 From 88eafacc822a9e546b2d075195d179e223a32296 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 12 Dec 2012 21:21:10 +0000 Subject: More memory API changes, mainly char* -> void* and unsigned -> size_t --- generic/tcl.decls | 20 +++++++-------- generic/tcl.h | 52 +++++++++++++++++++------------------- generic/tclBinary.c | 2 +- generic/tclCkalloc.c | 66 ++++++++++++++++++++++++------------------------ generic/tclDecls.h | 42 +++++++++++++++--------------- generic/tclIO.c | 2 +- generic/tclIO.h | 2 +- generic/tclIORChan.c | 2 +- generic/tclInt.decls | 6 ++--- generic/tclInt.h | 10 ++++---- generic/tclIntDecls.h | 12 ++++----- generic/tclObj.c | 4 +-- generic/tclTest.c | 15 ++++++----- generic/tclThreadAlloc.c | 16 ++++++------ generic/tclThreadTest.c | 8 +++--- win/tclWin32Dll.c | 2 +- 16 files changed, 131 insertions(+), 130 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 88567e3..87106ef 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -40,22 +40,22 @@ declare 2 { void Tcl_Panic(const char *format, ...) } declare 3 { - char *Tcl_MemAlloc(unsigned int size) + void *Tcl_MemAlloc(size_t size) } declare 4 { - void Tcl_MemFree(char *ptr) + void Tcl_MemFree(void *ptr) } declare 5 { - char *Tcl_MemRealloc(char *ptr, unsigned int size) + void *Tcl_MemRealloc(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) } @@ -1527,16 +1527,16 @@ declare 427 { int flags, Tcl_CommandTraceProc *proc, ClientData clientData) } declare 428 { - char *Tcl_AttemptMemAlloc(unsigned int size) + void *Tcl_AttemptMemAlloc(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_AttemptMemRealloc(char *ptr, unsigned int size) + void *Tcl_AttemptMemRealloc(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 { diff --git a/generic/tcl.h b/generic/tcl.h index 121ab5c..e46fccf 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -568,16 +568,16 @@ typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, typedef int (Tcl_EncodingConvertProc) (ClientData 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); 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_FreeInternalRepProc) (struct Tcl_Obj *objPtr); -typedef void (Tcl_FreeProc) (char *blockPtr); +typedef void (Tcl_FreeProc) (void *blockPtr); +#define Tcl_EncodingFreeProc Tcl_FreeProc +#define Tcl_ExitProc Tcl_FreeProc +#define Tcl_FileFreeProc Tcl_FreeProc typedef void (Tcl_IdleProc) (ClientData clientData); typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); @@ -1511,7 +1511,7 @@ typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr, ClientData *clientDataPtr); typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr); typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr); -typedef void (Tcl_FSFreeInternalRepProc) (ClientData clientData); +#define Tcl_FSFreeInternalRepProc Tcl_FreeProc typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData); typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData); typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); @@ -1917,7 +1917,7 @@ 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 @@ -2255,24 +2255,24 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); * defined in tclCkalloc.c. */ -#define Tcl_Alloc(x) ckalloc(x) -#define Tcl_Free(x) ckfree(x) -#define Tcl_Realloc(x, y) ckrealloc(x, y) -#define Tcl_AttemptAlloc(x) attemptckalloc(x) -#define Tcl_AttemptRealloc(x, y) attemptckrealloc(x, y) +#define Tcl_Alloc ckalloc +#define Tcl_Free ckfree +#define Tcl_Realloc ckrealloc +#define Tcl_AttemptAlloc attemptckalloc +#define Tcl_AttemptRealloc attemptckrealloc #ifdef TCL_MEM_DEBUG # define ckalloc(x) \ - ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) + (Tcl_DbCkalloc((x), __FILE__, __LINE__)) # define ckfree(x) \ - Tcl_DbCkfree((char *)(x), __FILE__, __LINE__) + Tcl_DbCkfree((x), __FILE__, __LINE__) # define ckrealloc(x,y) \ - ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + (Tcl_DbCkrealloc((x), (y), __FILE__, __LINE__)) # define attemptckalloc(x) \ - ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) + (Tcl_AttemptDbCkalloc((x), __FILE__, __LINE__)) # define attemptckrealloc(x,y) \ - ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + (Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__)) #else /* !TCL_MEM_DEBUG */ @@ -2282,16 +2282,16 @@ TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); * memory allocator both inside and outside of the Tcl library. */ -# define ckalloc(x) \ - ((void *) Tcl_MemAlloc((unsigned)(x))) -# define ckfree(x) \ - Tcl_MemFree((char *)(x)) -# define ckrealloc(x,y) \ - ((void *) Tcl_MemRealloc((char *)(x), (unsigned)(y))) -# define attemptckalloc(x) \ - ((void *) Tcl_AttemptMemAlloc((unsigned)(x))) -# define attemptckrealloc(x,y) \ - ((void *) Tcl_AttemptMemRealloc((char *)(x), (unsigned)(y))) +# define ckalloc \ + Tcl_MemAlloc +# define ckfree \ + Tcl_MemFree +# define ckrealloc \ + Tcl_MemRealloc +# define attemptckalloc \ + Tcl_AttemptMemAlloc +# define attemptckrealloc \ + Tcl_AttemptMemRealloc # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 5c33308..caa5db7 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -178,7 +178,7 @@ typedef struct ByteArray { } ByteArray; #define BYTEARRAY_SIZE(len) \ - ((unsigned) (TclOffset(ByteArray, bytes) + (len))) + ((TclOffset(ByteArray, bytes) + (len))) #define GET_BYTEARRAY(objPtr) \ ((ByteArray *) (objPtr)->internalRep.otherValuePtr) #define SET_BYTEARRAY(objPtr, baPtr) \ diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 71dc45d..ca26b7f 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -1044,11 +1044,11 @@ Tcl_InitMemory( *---------------------------------------------------------------------- */ -char * +void * Tcl_MemAlloc( - unsigned int size) + size_t size) { - char *result; + void *result; result = TclpAlloc(size); @@ -1068,15 +1068,15 @@ Tcl_MemAlloc( 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); @@ -1096,25 +1096,25 @@ Tcl_DbCkalloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_AttemptMemAlloc( - 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; } @@ -1129,10 +1129,10 @@ Tcl_AttemptDbCkalloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_MemRealloc( - char *ptr, - unsigned int size) + void *ptr, + size_t size) { char *result; @@ -1144,16 +1144,16 @@ Tcl_MemRealloc( 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); @@ -1173,27 +1173,27 @@ Tcl_DbCkrealloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_AttemptMemRealloc( - 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; } @@ -1211,14 +1211,14 @@ Tcl_AttemptDbCkrealloc( void Tcl_MemFree( - char *ptr) + void *ptr) { TclpFree(ptr); } void Tcl_DbCkfree( - char *ptr, + void *ptr, const char *file, int line) { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index cf75bb6..fc3cf96 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -35,18 +35,18 @@ TCLAPI const char * Tcl_PkgRequireEx(Tcl_Interp *interp, /* 2 */ TCLAPI void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 3 */ -TCLAPI char * Tcl_MemAlloc(unsigned int size); +TCLAPI void * Tcl_MemAlloc(size_t size); /* 4 */ -TCLAPI void Tcl_MemFree(char *ptr); +TCLAPI void Tcl_MemFree(void *ptr); /* 5 */ -TCLAPI char * Tcl_MemRealloc(char *ptr, unsigned int size); +TCLAPI void * Tcl_MemRealloc(void *ptr, size_t size); /* 6 */ -TCLAPI char * Tcl_DbCkalloc(unsigned int size, const char *file, +TCLAPI void * Tcl_DbCkalloc(size_t size, const char *file, int line); /* 7 */ -TCLAPI void Tcl_DbCkfree(char *ptr, const char *file, int line); +TCLAPI void Tcl_DbCkfree(void *ptr, const char *file, int line); /* 8 */ -TCLAPI char * Tcl_DbCkrealloc(char *ptr, unsigned int size, +TCLAPI void * Tcl_DbCkrealloc(void *ptr, size_t size, const char *file, int line); #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 9 */ @@ -1201,14 +1201,14 @@ TCLAPI void Tcl_UntraceCommand(Tcl_Interp *interp, Tcl_CommandTraceProc *proc, ClientData clientData); /* 428 */ -TCLAPI char * Tcl_AttemptMemAlloc(unsigned int size); +TCLAPI void * Tcl_AttemptMemAlloc(size_t size); /* 429 */ -TCLAPI char * Tcl_AttemptDbCkalloc(unsigned int size, - const char *file, int line); +TCLAPI void * Tcl_AttemptDbCkalloc(size_t size, const char *file, + int line); /* 430 */ -TCLAPI char * Tcl_AttemptMemRealloc(char *ptr, unsigned int size); +TCLAPI void * Tcl_AttemptMemRealloc(void *ptr, size_t size); /* 431 */ -TCLAPI char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, +TCLAPI void * Tcl_AttemptDbCkrealloc(void *ptr, size_t size, const char *file, int line); /* 432 */ TCLAPI int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); @@ -1782,12 +1782,12 @@ 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 */ void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ - char * (*tcl_MemAlloc) (unsigned int size); /* 3 */ - void (*tcl_MemFree) (char *ptr); /* 4 */ - char * (*tcl_MemRealloc) (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_MemAlloc) (size_t size); /* 3 */ + void (*tcl_MemFree) (void *ptr); /* 4 */ + void * (*tcl_MemRealloc) (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 */ #endif /* UNIX */ @@ -2231,10 +2231,10 @@ typedef struct TclStubs { 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_AttemptMemAlloc) (unsigned int size); /* 428 */ - char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */ - char * (*tcl_AttemptMemRealloc) (char *ptr, unsigned int size); /* 430 */ - char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */ + void * (*tcl_AttemptMemAlloc) (size_t size); /* 428 */ + void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */ + void * (*tcl_AttemptMemRealloc) (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, int length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ diff --git a/generic/tclIO.c b/generic/tclIO.c index 0568d77..24e7823 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2717,7 +2717,7 @@ CloseChannel( if (chanPtr == statePtr->bottomChanPtr) { if (statePtr->channelName != NULL) { - ckfree(statePtr->channelName); + ckfree((char *)statePtr->channelName); statePtr->channelName = NULL; } diff --git a/generic/tclIO.h b/generic/tclIO.h index 1e89878..956ed15 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -156,7 +156,7 @@ typedef struct Channel { */ typedef struct ChannelState { - const char *channelName; /* The name of the channel instance in Tcl + char *channelName; /* The name of the channel instance in Tcl * commands. Storage is owned by the generic * IO code, is dynamically allocated. */ int flags; /* ORed combination of the flags defined diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index cb0282a..85d9a46 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -2303,7 +2303,7 @@ FreeReflectedChannel( * Delete a cloned ChannelType structure. */ - ckfree(chanPtr->typePtr); + ckfree((void *) chanPtr->typePtr); chanPtr->typePtr = NULL; } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 8c46e55..57040a9 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -291,7 +291,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) @@ -307,7 +307,7 @@ declare 69 { # int TclpDeleteFile(const char *path) #} declare 74 { - void TclpFree(char *ptr) + void TclpFree(void *ptr) } declare 75 { unsigned long TclpGetClicks(void) @@ -334,7 +334,7 @@ declare 76 { # 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, diff --git a/generic/tclInt.h b/generic/tclInt.h index eeb685a..d6b1320 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4103,7 +4103,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (objPtr)->bytes = tclEmptyStringRep; \ (objPtr)->length = 0; \ } else { \ - (objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \ + (objPtr)->bytes = ckalloc((unsigned) ((len) + 1)); \ memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ @@ -4553,9 +4553,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 /* @@ -4761,8 +4761,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((char *) (ptr)) + (ptr = (ckalloc(sizeof(NRE_callback)))) +#define TCLNR_FREE(interp, ptr) ckfree(ptr) #endif #if NRE_ENABLE_ASSERTS diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 65b1888..8db3831 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -187,13 +187,13 @@ TCLAPI int TclObjInvoke(Tcl_Interp *interp, int objc, /* Slot 67 is reserved */ /* Slot 68 is reserved */ /* 69 */ -TCLAPI char * TclpAlloc(unsigned int size); +TCLAPI void * TclpAlloc(size_t size); /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* 74 */ -TCLAPI void TclpFree(char *ptr); +TCLAPI void TclpFree(void *ptr); /* 75 */ TCLAPI unsigned long TclpGetClicks(void); /* 76 */ @@ -203,7 +203,7 @@ TCLAPI unsigned long TclpGetSeconds(void); /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ -TCLAPI char * TclpRealloc(char *ptr, unsigned int size); +TCLAPI void * TclpRealloc(void *ptr, size_t size); /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ @@ -654,19 +654,19 @@ typedef struct TclIntStubs { 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 */ + void (*tclpFree) (void *ptr); /* 74 */ unsigned long (*tclpGetClicks) (void); /* 75 */ unsigned long (*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); diff --git a/generic/tclObj.c b/generic/tclObj.c index 74cb29e..0bbb08d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -97,7 +97,7 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; -static void ContLineLocFree(char *clientData); +static void ContLineLocFree(void *clientData); static void TclThreadFinalizeContLines(ClientData clientData); static ThreadSpecificData *TclGetContLineTable(void); @@ -840,7 +840,7 @@ TclThreadFinalizeContLines( static void ContLineLocFree( - char *clientData) + void *clientData) { ckfree(clientData); } diff --git a/generic/tclTest.c b/generic/tclTest.c index 9b958dd..d69e04c 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -200,7 +200,7 @@ static int ObjTraceProc(ClientData clientData, Tcl_Obj *const objv[]); static void ObjTraceDeleteProc(ClientData 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(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); @@ -309,7 +309,7 @@ static void TestregexpXflags(const char *string, static int TestsaveresultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static void TestsaveresultFree(char *blockPtr); +static void TestsaveresultFree(void *blockPtr); static int TestsetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(ClientData dummy, @@ -893,7 +893,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); @@ -1839,9 +1840,9 @@ TestdstringCmd( */ static void SpecialFree(blockPtr) - char *blockPtr; /* Block to free. */ + void *blockPtr; /* Block to free. */ { - ckfree(blockPtr - 16); + ckfree(((char *)blockPtr) - 16); } /* @@ -4364,7 +4365,7 @@ TestpanicCmd( int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - const char *argString; + char *argString; /* * Put the arguments into a var args structure @@ -4960,7 +4961,7 @@ TestsaveresultCmd( static void TestsaveresultFree( - char *blockPtr) + void *blockPtr) { /* empty... */ } diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index e4261d6..09826cb 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -306,9 +306,9 @@ TclFreeAllocCache( *---------------------------------------------------------------------- */ -char * +void * TclpAlloc( - unsigned int reqSize) + size_t reqSize) { Cache *cachePtr; Block *blockPtr; @@ -321,7 +321,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; } @@ -385,7 +385,7 @@ TclpAlloc( void TclpFree( - char *ptr) + void *ptr) { Cache *cachePtr; Block *blockPtr; @@ -439,10 +439,10 @@ TclpFree( *---------------------------------------------------------------------- */ -char * +void * TclpRealloc( - char *ptr, - unsigned int reqSize) + void *ptr, + size_t reqSize) { Cache *cachePtr; Block *blockPtr; @@ -460,7 +460,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; } diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index c1828bb..3a006db 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -62,7 +62,7 @@ static ThreadSpecificData *threadList = NULL; */ typedef struct ThreadCtrl { - const char *script; /* The Tcl command this thread should + char *script; /* The Tcl command this thread should * execute */ int flags; /* Initial value of the "flags" field in the * ThreadSpecificData structure for the new @@ -122,7 +122,7 @@ TCL_DECLARE_MUTEX(threadMutex) static int ThreadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ThreadCreate(Tcl_Interp *interp, const char *script, +static int ThreadCreate(Tcl_Interp *interp, char *script, int joinable); static int ThreadList(Tcl_Interp *interp); static int ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, @@ -276,7 +276,7 @@ ThreadObjCmd( return ThreadCancel(interp, (Tcl_ThreadId) (size_t) id, result, flags); } case THREAD_CREATE: { - const char *script; + char *script; int joinable, len; if (objc == 2) { @@ -496,7 +496,7 @@ ThreadObjCmd( static int ThreadCreate( Tcl_Interp *interp, /* Current interpreter. */ - const char *script, /* Script to execute */ + char *script, /* Script to execute */ int joinable) /* Flag, joinable thread or not */ { ThreadCtrl ctrl; diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 019d76f..ae025e8 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -66,7 +66,7 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, */ typedef struct MountPointMap { - const TCHAR *volumeName; /* Native wide string volume name. */ + TCHAR *volumeName; /* Native wide string volume name. */ TCHAR driveLetter; /* Drive letter corresponding to the volume * name. */ struct MountPointMap *nextPtr; -- cgit v0.12 From 342be44f4da2cc09411fd0dc070ddcab26d87355 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 3 Jan 2013 10:17:14 +0000 Subject: don't use iPtr->legacyResult for Tcl >= 8.1, because it doesn't work. Use Tcl_AppendResult in stead. --- generic/tclStubLib.c | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index fc07c26..fb9c132 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -108,8 +108,18 @@ TclInitStubs( * This is quicker to check for than calling Tcl_GetVersion() */ if (sizeof(size_t) != sizeof(int)) { if (stubsPtr->reserved77 != NULL) { - iPtr->legacyResult = "incompatible stub library: have 9, need 8"; - iPtr->legacyFreeProc = 0; /* TCL_STATIC */ + /* Accessing iPtr->legacyResult doesn't work here as Tcl 8 doesn't + * check this field after the Xxx_Init call. */ + char stripped[32]; /* Requested version stripped starting with '-' */ + char *p = stripped; + + while (*version && (*version != '-')) { + *p++ = *version++; + } + *p = '\0'; + stubsPtr->tcl_ResetResult(interp); + stubsPtr->tcl_AppendResult(interp, "incompatible stub library: have ", + tclversion, ", need ", stripped, NULL); return NULL; } } -- cgit v0.12 From 1d5118fd6cf705d79ec670284492d9eff6637965 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 26 Jan 2013 16:11:33 +0000 Subject: macros for Tcl_GetString and Tcl_GetStringFromObj --- generic/tclCkalloc.c | 10 +++--- generic/tclDecls.h | 10 ++++++ generic/tclEncoding.c | 10 +++--- generic/tclInt.h | 6 ++-- generic/tclObj.c | 3 +- generic/tclUtil.c | 82 +++++++++++++++++++++++++------------------------- generic/tclZlib.c | 15 +++++---- macosx/tclMacOSXFCmd.c | 6 ++-- unix/dltest/pkga.c | 2 +- unix/dltest/pkgua.c | 2 +- unix/tclUnixFCmd.c | 27 +++++++++++------ unix/tclUnixFile.c | 17 ++++++----- unix/tclUnixInit.c | 7 +++-- unix/tclUnixSock.c | 46 ++++++++++++++-------------- win/tclWinDde.c | 52 +++++++++----------------------- win/tclWinFCmd.c | 14 ++++----- win/tclWinFile.c | 25 ++++++++------- win/tclWinInit.c | 15 ++++----- win/tclWinPipe.c | 7 ++--- win/tclWinReg.c | 70 ++++++++++++++++++++++++------------------ win/tclWinSock.c | 4 +-- 21 files changed, 221 insertions(+), 209 deletions(-) diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index c25ed11..800e272 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -1067,7 +1067,7 @@ Tcl_MemAlloc( */ if ((result == NULL) && size) { - Tcl_Panic("unable to alloc %u bytes", size); + Tcl_Panic("unable to alloc %" TCL_LL_MODIFIER "u bytes", (Tcl_WideInt)size); } return result; } @@ -1084,7 +1084,8 @@ Tcl_DbCkalloc( 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_LL_MODIFIER "u bytes, %s line %d", + (Tcl_WideInt)size, file, line); } return result; } @@ -1143,7 +1144,7 @@ Tcl_MemRealloc( result = TclpRealloc(ptr, size); if ((result == NULL) && size) { - Tcl_Panic("unable to realloc %u bytes", size); + Tcl_Panic("unable to realloc %" TCL_LL_MODIFIER "u bytes", (Tcl_WideInt)size); } return result; } @@ -1161,7 +1162,8 @@ Tcl_DbCkrealloc( 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_LL_MODIFIER "u bytes, %s line %d", + (Tcl_WideInt)size, file, line); } return result; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index ca3d5c6..6821a4e 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3749,4 +3749,14 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, # define Tcl_GlobalEvalObj(interp,objPtr) \ Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) #endif /* !TCL_NO_DEPRECATED */ + +#if defined(USE_TCL_STUBS) && !defined(TCL_COMPAT_8) +# undef Tcl_GetString +# define Tcl_GetString(obj) \ + ((obj)->bytes?(obj)->bytes:tclStubsPtr->tcl_GetString(obj)) +# undef Tcl_GetStringFromObj +# define Tcl_GetStringFromObj(obj, lengthPtr) \ + (Tcl_GetString(obj),(*(lengthPtr) = (obj)->length), (obj)->bytes) +#endif + #endif /* _TCLDECLS */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 757f771..a5b4d74 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -3473,11 +3473,12 @@ unilen( static void InitializeEncodingSearchPath( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { const char *bytes; - int i, numDirs, numBytes; + int i, numDirs; + size_t numBytes; Tcl_Obj *libPathObj, *encodingObj, *searchPathObj; TclNewLiteralStringObj(encodingObj, "encoding"); @@ -3507,11 +3508,12 @@ InitializeEncodingSearchPath( if (*encodingPtr) { ((Encoding *)(*encodingPtr))->refCount++; } - bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes); + bytes = Tcl_GetString(searchPathObj); + numBytes = searchPathObj->length; *lengthPtr = numBytes; *valuePtr = ckalloc(numBytes + 1); - memcpy(*valuePtr, bytes, (size_t) numBytes + 1); + memcpy(*valuePtr, bytes, numBytes + 1); Tcl_DecrRefCount(searchPathObj); } diff --git a/generic/tclInt.h b/generic/tclInt.h index 0f862e8..1afda26 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2597,7 +2597,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType; *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr, Tcl_Encoding *encodingPtr); /* @@ -2611,7 +2611,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr, typedef struct ProcessGlobalValue { int epoch; /* Epoch counter to detect changes in the * master value. */ - 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. */ @@ -3042,7 +3042,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, int stackSize, int flags); MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, - 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); diff --git a/generic/tclObj.c b/generic/tclObj.c index 5f653a4..1eaf54a 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1664,7 +1664,6 @@ Tcl_GetString( *---------------------------------------------------------------------- */ -#undef Tcl_GetStringFromObj char * Tcl_GetStringFromObj( register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should @@ -1676,7 +1675,7 @@ Tcl_GetStringFromObj( (void) TclGetString(objPtr); if (lengthPtr != NULL) { - *lengthPtr = objPtr->length; + *lengthPtr = (objPtr->length < INT_MAX)? objPtr->length: INT_MAX; } return objPtr->bytes; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 68567b0..98c7c65 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -81,7 +81,7 @@ static ProcessGlobalValue executableName = { * in other cases this means an overestimate of the * required size. * - * For more details, see the comments on the Tcl*Scan*Element and + * For more details, see the comments on the Tcl*Scan*Element and * Tcl*Convert*Element routines. */ @@ -175,7 +175,7 @@ const Tcl_ObjType tclEndOffsetType = { * * NOTE: This means that if and when backslash substitution rules ever change * for command parsing, the interpretation of strings as lists also changes. - * + * * Backslash substitution replaces an "escape sequence" of one or more * characters starting with * \u005c \ BACKSLASH @@ -188,7 +188,7 @@ const Tcl_ObjType tclEndOffsetType = { * * * If the first character of a formatted substring is * \u007b { OPEN BRACE - * then the end of the substring is the matching + * then the end of the substring is the matching * \u007d } CLOSE BRACE * character, where matching is determined by counting nesting levels, and * not including any brace characters that are contained within a backslash @@ -210,7 +210,7 @@ const Tcl_ObjType tclEndOffsetType = { * includes an unbalanced brace not in a backslash escape sequence, and any * value that ends with a backslash not itself in a backslash escape * sequence. - * + * * * If the first character of a formatted substring is * \u0022 " QUOTE * then the end of the substring is the next QUOTE character, not counting @@ -337,7 +337,7 @@ const Tcl_ObjType tclEndOffsetType = { * directives. This makes it easy to experiment with eliminating this * formatting mode simply with "#define COMPAT 0" above. I believe this is * worth considering. - * + * * Another consideration is the treatment of QUOTE characters in list * elements. TclConvertElement() must have the ability to produce the escape * sequence \" so that when a list element begins with a QUOTE we do not @@ -397,7 +397,7 @@ TclMaxListLength( * No list element before leading white space. */ - count += 1 - TclIsSpaceProc(*bytes); + count += 1 - TclIsSpaceProc(*bytes); /* * Count white space runs as potential element separators. @@ -433,7 +433,7 @@ TclMaxListLength( * No list element following trailing white space. */ - count -= TclIsSpaceProc(bytes[-1]); + count -= TclIsSpaceProc(bytes[-1]); done: if (endPtr) { @@ -501,7 +501,7 @@ TclFindElement( * indicate that the substring of *sizePtr * bytes starting at **elementPtr is/is not * the literal list element and therefore - * does not/does require a call to + * does not/does require a call to * TclCopyAndCollapse() by the caller. */ { const char *p = list; @@ -968,7 +968,7 @@ TclScanElement( int preferBrace = 0; /* CONVERT_MASK mode. */ int braceCount = 0; /* Count of all braces '{' '}' seen. */ #endif /* COMPAT */ - + if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) { /* * Empty string element must be brace quoted. @@ -1046,7 +1046,7 @@ TclScanElement( * Final backslash. Cannot format with brace quoting. */ - requireEscape = 1; + requireEscape = 1; break; } if (p[1] == '\n') { @@ -1440,7 +1440,7 @@ TclConvertElement( return p - dst; } - /* + /* * If we reach this point, there's an embedded NULL in the string * range being processed, which should not happen when the * encoding rules for Tcl strings are properly followed. If the @@ -1768,7 +1768,7 @@ Tcl_Concat( for (p = result, i = 0; i < argc; i++) { int trim, elemLength; const char *element; - + element = argv[i]; elemLength = strlen(argv[i]); @@ -1835,7 +1835,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; @@ -1846,13 +1847,14 @@ Tcl_ConcatObj( */ for (i = 0; i < objc; i++) { - int length; + size_t length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { continue; } - Tcl_GetStringFromObj(objPtr, &length); + Tcl_GetString(objPtr); + length = objPtr->length; if (length > 0) { break; } @@ -1884,11 +1886,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; - } } /* @@ -1902,9 +1902,10 @@ Tcl_ConcatObj( Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { - int trim; - - element = TclGetStringFromObj(objv[i], &elemLength); + size_t trim; + + element = TclGetString(objv[i]); + elemLength = objv[i]->length; /* * Trim away the leading whitespace. @@ -2541,10 +2542,9 @@ TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { - int length; - char *bytes = Tcl_GetStringFromObj(objPtr, &length); + char *bytes = Tcl_GetString(objPtr); - return Tcl_DStringAppend(dsPtr, bytes, length); + return Tcl_DStringAppend(dsPtr, bytes, objPtr->length); } char * @@ -2776,11 +2776,11 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { - int length; - char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); + Tcl_Obj *obj = Tcl_GetObjResult(interp); + char *bytes = Tcl_GetString(obj); Tcl_DStringFree(dsPtr); - Tcl_DStringAppend(dsPtr, bytes, length); + Tcl_DStringAppend(dsPtr, bytes, obj->length); Tcl_ResetResult(interp); } @@ -2819,7 +2819,7 @@ TclDStringToObj( /* * Static buffer, so must copy. */ - + TclNewStringObj(result, dsPtr->string, dsPtr->length); } } else { @@ -2937,7 +2937,7 @@ Tcl_PrintDouble( /* * Handle NaN. */ - + if (TclIsNaN(value)) { TclFormatNaN(value, dst); return; @@ -2946,12 +2946,12 @@ Tcl_PrintDouble( /* * Handle infinities. */ - + if (TclIsInfinite(value)) { /* * Remember to copy the terminating NUL too. */ - + if (value < 0) { memcpy(dst, "-Inf", 5); } else { @@ -2963,7 +2963,7 @@ Tcl_PrintDouble( /* * Ordinary (normal and denormal) values. */ - + if (*precisionPtr == 0) { digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST, &exponent, &signum, &end); @@ -3008,7 +3008,7 @@ Tcl_PrintDouble( */ digits = TclDoubleDigits(value, *precisionPtr, - TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */, + TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */, &exponent, &signum, &end); } if (signum) { @@ -3019,7 +3019,7 @@ Tcl_PrintDouble( /* * E format for numbers < 1e-3 or >= 1e17. */ - + *dst++ = *p++; c = *p; if (c != '\0') { @@ -3044,7 +3044,7 @@ Tcl_PrintDouble( /* * F format for others. */ - + if (exponent < 0) { *dst++ = '0'; } @@ -3720,7 +3720,8 @@ TclSetProcessGlobalValue( } else { Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr); } - bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes); + bytes = Tcl_GetString(newValue); + pgvPtr->numBytes = newValue->length; pgvPtr->value = ckalloc(pgvPtr->numBytes + 1); memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1); if (pgvPtr->encoding) { @@ -3914,11 +3915,10 @@ TclGetObjNameOfExecutable(void) const char * Tcl_GetNameOfExecutable(void) { - int numBytes; - const char *bytes = - Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes); + Tcl_Obj *obj = TclGetObjNameOfExecutable(); + const char *bytes = Tcl_GetString(obj); - if (numBytes == 0) { + if (obj->length == 0) { return NULL; } return bytes; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index ea3b9cc..2c9c923 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -438,8 +438,8 @@ GenerateHeader( if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { - valueStr = Tcl_GetStringFromObj(value, &len); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, + valueStr = Tcl_GetString(value); + Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, NULL); headerPtr->nativeCommentBuf[len] = '\0'; @@ -459,8 +459,8 @@ GenerateHeader( if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) { goto error; } else if (value != NULL) { - valueStr = Tcl_GetStringFromObj(value, &len); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, + valueStr = Tcl_GetString(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; @@ -1535,7 +1535,7 @@ Tcl_ZlibDeflate( if (!interp) { return TCL_ERROR; } - + /* * Compressed format is specified by the wbits parameter. See zlib.h for * details. @@ -3338,10 +3338,9 @@ ZlibTransformGetOption( Tcl_DStringAppendElement(dsPtr, ""); } } else { - int len; - const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len); + const char *str = Tcl_GetString(cd->compDictObj); - Tcl_DStringAppend(dsPtr, str, len); + Tcl_DStringAppend(dsPtr, str, cd->compDictObj->length); } } diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index f266443..12459bc 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -636,12 +636,12 @@ SetOSTypeFromAny( Tcl_Obj *objPtr) /* Pointer to the object to convert */ { const char *string; - int length, result = TCL_OK; + int result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_UtfToExternalDString(encoding, string, length, &ds); + string = Tcl_GetString(objPtr); + Tcl_UtfToExternalDString(encoding, string, objPtr->length, &ds); if (Tcl_DStringLength(&ds) > 4) { if (interp) { diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index afa346a..6081e7b 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -48,7 +48,7 @@ Pkga_EqObjCmd( { int result; const char *str1, *str2; - int len1, len2; + size_t len1, len2; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string1 string2"); diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index b92b320..0fdf81d 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -124,7 +124,7 @@ PkguaEqObjCmd( { int result; const char *str1, *str2; - int len1, len2; + size_t len1, len2; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string1 string2"); diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index d9952b9..0e87cba 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1476,9 +1476,10 @@ SetGroupAttribute( Tcl_DString ds; struct group *groupPtr = NULL; const char *string; - int length; + size_t length; - string = Tcl_GetStringFromObj(attributePtr, &length); + string = Tcl_GetString(attributePtr); + length = attributePtr->length; native = Tcl_UtfToExternalDString(NULL, string, length, &ds); groupPtr = TclpGetGrNam(native); /* INTL: Native. */ @@ -1543,9 +1544,10 @@ SetOwnerAttribute( Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; - int length; + size_t length; - string = Tcl_GetStringFromObj(attributePtr, &length); + string = Tcl_GetString(attributePtr); + length = attributePtr->length; native = Tcl_UtfToExternalDString(NULL, string, length, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ @@ -1915,15 +1917,16 @@ TclpObjNormalizePath( int nextCheckpoint) { const char *currentPathEndPosition; - int pathLen; + size_t pathLen; char cur; - const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); + const char *path = Tcl_GetString(pathPtr); Tcl_DString ds; const char *nativePath; #ifndef NO_REALPATH char normPath[MAXPATHLEN]; #endif + pathLen = pathPtr->length; /* * We add '1' here because if nextCheckpoint is zero we know that '/' * exists, and if it isn't zero, it must point at a directory separator @@ -2146,14 +2149,16 @@ TclUnixOpenTemporaryFile( { Tcl_DString template, tmp; const char *string; - int len, fd; + size_t len; + int fd; /* * We should also check against making more then TMP_MAX of these. */ if (dirObj) { - string = Tcl_GetStringFromObj(dirObj, &len); + string = Tcl_GetString(dirObj); + len = dirObj->length; Tcl_UtfToExternalDString(NULL, string, len, &template); } else { Tcl_DStringInit(&template); @@ -2163,7 +2168,8 @@ TclUnixOpenTemporaryFile( TclDStringAppendLiteral(&template, "/"); if (basenameObj) { - string = Tcl_GetStringFromObj(basenameObj, &len); + string = Tcl_GetString(basenameObj); + len = basenameObj->length; Tcl_UtfToExternalDString(NULL, string, len, &tmp); TclDStringAppendDString(&template, &tmp); Tcl_DStringFree(&tmp); @@ -2175,7 +2181,8 @@ TclUnixOpenTemporaryFile( #ifdef HAVE_MKSTEMPS if (extensionObj) { - string = Tcl_GetStringFromObj(extensionObj, &len); + string = Tcl_GetString(extensionObj); + len = extensionObj->length; Tcl_UtfToExternalDString(NULL, string, len, &tmp); TclDStringAppendDString(&template, &tmp); fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp)); diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 5bfe5d9..a687731 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -259,14 +259,15 @@ TclpMatchInDirectory( DIR *d; Tcl_DirEntry *entryPtr; const char *dirName; - int dirLength, nativeDirLen; + size_t dirLength, nativeDirLen; int matchHidden, matchHiddenPat; Tcl_StatBuf statBuf; Tcl_DString ds; /* native encoding of dir */ Tcl_DString dsOrig; /* utf-8 encoding of dir */ Tcl_DStringInit(&dsOrig); - dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); + dirName = Tcl_GetString(fileNamePtr); + dirLength = fileNamePtr->length; Tcl_DStringAppend(&dsOrig, dirName, dirLength); /* @@ -934,7 +935,7 @@ TclpObjLink( */ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { - int targetLen; + size_t targetLen; Tcl_DString ds; Tcl_Obj *transPtr; @@ -948,7 +949,8 @@ TclpObjLink( if (transPtr == NULL) { return NULL; } - target = Tcl_GetStringFromObj(transPtr, &targetLen); + target = Tcl_GetString(transPtr); + targetLen = transPtr->length; target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds); Tcl_DecrRefCount(transPtr); @@ -1077,7 +1079,7 @@ TclNativeCreateNativeRep( const char *str; Tcl_DString ds; Tcl_Obj *validPathPtr; - int len; + size_t len; if (TclFSCwdIsNative()) { /* @@ -1102,12 +1104,13 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = Tcl_GetStringFromObj(validPathPtr, &len); + str = Tcl_GetString(validPathPtr); + len = validPathPtr->length; Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); Tcl_DecrRefCount(validPathPtr); nativePathPtr = ckalloc(len); - memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len); + memcpy(nativePathPtr, Tcl_DStringValue(&ds), len); Tcl_DStringFree(&ds); return nativePathPtr; diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 39be160..1d81310 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -458,7 +458,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 32 @@ -547,9 +547,10 @@ TclpInitLibraryPath( Tcl_DStringFree(&buffer); *encodingPtr = Tcl_GetEncoding(NULL, NULL); - str = Tcl_GetStringFromObj(pathPtr, lengthPtr); + str = Tcl_GetString(pathPtr); + *lengthPtr = pathPtr->length; *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1); + memcpy(*valuePtr, str, (*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); } diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 528f009..a964653 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -180,7 +180,7 @@ static ProcessGlobalValue hostName = static void InitializeHostName( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { const char *native = NULL; @@ -249,7 +249,7 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, NULL); *lengthPtr = strlen(native); *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, native, (size_t)(*lengthPtr)+1); + memcpy(*valuePtr, native, (*lengthPtr)+1); } /* @@ -545,7 +545,7 @@ TcpCloseProc( * handlers are already deleted in the generic IO channel closing code * that called this function, so we do not have to delete them here. */ - + for (fds = &statePtr->fds; fds != NULL; fds = fds->next) { if (fds->fd < 0) { continue; @@ -554,7 +554,7 @@ TcpCloseProc( if (close(fds->fd) < 0) { errorCode = errno; } - + } fds = statePtr->fds.next; while (fds != NULL) { @@ -858,7 +858,7 @@ TcpWatchProc( */ return; } - + if (statePtr->flags & TCP_ASYNC_CONNECT) { /* Async sockets use a FileHandler internally while connecting, so we * need to cache this request until the connection has succeeded. */ @@ -974,7 +974,7 @@ CreateClientSocket( for (state->myaddr = state->myaddrlist; state->myaddr != NULL; state->myaddr = state->myaddr->ai_next) { int reuseaddr; - + /* * No need to try combinations of local and remote addresses of * different families. @@ -1003,15 +1003,15 @@ CreateClientSocket( * Set the close-on-exec flag so that the socket will not get * inherited by child processes. */ - + fcntl(state->fds.fd, F_SETFD, FD_CLOEXEC); - + /* * Set kernel space buffering */ - + TclSockMinimumBuffers(INT2PTR(state->fds.fd), SOCKET_BUFSIZE); - + if (async) { status = TclUnixSetBlockingMode(state->fds.fd, TCL_MODE_NONBLOCKING); @@ -1035,7 +1035,7 @@ CreateClientSocket( * will set up a file handler on the socket if she is interested * in being informed when the connect completes. */ - + status = connect(state->fds.fd, state->addr->ai_addr, state->addr->ai_addrlen); if (status < 0 && errno == EINPROGRESS) { @@ -1305,28 +1305,28 @@ Tcl_OpenTcpServer( } continue; } - + /* * Set the close-on-exec flag so that the socket will not get * inherited by child processes. */ - + fcntl(sock, F_SETFD, FD_CLOEXEC); - + /* * Set kernel space buffering */ - + TclSockMinimumBuffers(INT2PTR(sock), SOCKET_BUFSIZE); - + /* * Set up to reuse server addresses automatically and bind to the * specified port. */ - + (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &reuseaddr, sizeof(reuseaddr)); - + /* * Make sure we use the same port number when opening two server * sockets for IPv4 and IPv6 on a random port. @@ -1355,7 +1355,7 @@ Tcl_OpenTcpServer( if (howfar < BIND) { howfar = BIND; my_errno = errno; - } + } close(sock); continue; } @@ -1385,7 +1385,7 @@ Tcl_OpenTcpServer( /* * Allocate a new TcpState for this socket. */ - + statePtr = ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->acceptProc = acceptProc; @@ -1400,12 +1400,12 @@ Tcl_OpenTcpServer( newfds->fd = sock; newfds->statePtr = statePtr; fds = newfds; - + /* * Set up the callback mechanism for accepting connections from new * clients. */ - + Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds); } @@ -1464,7 +1464,7 @@ TcpAccept( socklen_t len; /* For accept interface */ char channelName[SOCK_CHAN_LENGTH]; char host[NI_MAXHOST], port[NI_MAXSERV]; - + len = sizeof(addr); newsock = accept(fds->fd, &addr.sa, &len); if (newsock < 0) { diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 013b320..22f2216 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -17,15 +17,6 @@ #include #include -#ifndef UNICODE -# undef CP_WINUNICODE -# define CP_WINUNICODE CP_WINANSI -# undef Tcl_WinTCharToUtf -# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) -# undef Tcl_WinUtfToTChar -# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) -#endif - #if !defined(NDEBUG) /* test POKE server Implemented for debug mode only */ # undef CBF_FAIL_POKES @@ -379,11 +370,10 @@ DdeSetServerName( Tcl_Obj* namePtr; Tcl_DString ds; const char *nameStr; - int len; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - nameStr = Tcl_GetStringFromObj(namePtr, &len); - Tcl_WinUtfToTChar(nameStr, len, &ds); + nameStr = Tcl_GetString(namePtr); + Tcl_WinUtfToTChar(nameStr, namePtr->length, &ds); if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); @@ -621,7 +611,7 @@ DdeServerProc( /* Transaction-dependent data. */ { Tcl_DString dString; - int len; + size_t len; DWORD dlen; TCHAR *utilString; Tcl_Obj *ddeObjectPtr; @@ -738,11 +728,13 @@ DdeServerProc( if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { if (uFmt == CF_TEXT) { returnString = - Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + Tcl_GetString(convPtr->returnPackagePtr); + len = convPtr->returnPackagePtr->length; } else { + int tmp; returnString = (char *) - Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); - len = 2 * len + 1; + Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &tmp); + len = 2 * tmp + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); @@ -758,12 +750,14 @@ DdeServerProc( TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { if (uFmt == CF_TEXT) { - returnString = Tcl_GetStringFromObj( - variableObjPtr, &len); + returnString = Tcl_GetString( + variableObjPtr); + len = variableObjPtr->length; } else { + int tmp; returnString = (char *) Tcl_GetUnicodeFromObj( - variableObjPtr, &len); - len = 2 * len + 1; + variableObjPtr, &tmp); + len = 2 * tmp + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, @@ -1433,11 +1427,7 @@ DdeObjCmd( Initialize(); if (firstArg != 1) { -#ifdef UNICODE serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length); -#else - serviceName = Tcl_GetStringFromObj(objv[firstArg], &length); -#endif } else { length = 0; } @@ -1450,11 +1440,7 @@ DdeObjCmd( } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { -#ifdef UNICODE topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length); -#else - topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length); -#endif if (length == 0) { topicName = NULL; } else { @@ -1531,13 +1517,8 @@ DdeObjCmd( break; } case DDE_REQUEST: { -#ifdef UNICODE const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], &length); -#else - const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], - &length); -#endif if (length == 0) { Tcl_SetObjResult(interp, @@ -1591,13 +1572,8 @@ DdeObjCmd( break; } case DDE_POKE: { -#ifdef UNICODE const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], &length); -#else - const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], - &length); -#endif BYTE *dataString; if (length == 0) { diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index ac88861..4ec6714 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1582,8 +1582,8 @@ GetWinFileAttributes( * We test for, and fix that case, here. */ - int len; - const char *str = Tcl_GetStringFromObj(fileName,&len); + const char *str = Tcl_GetString(fileName); + size_t len = fileName->length; if (len < 4) { if (len == 0) { @@ -1668,12 +1668,11 @@ ConvertFileNameFormat( for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; - int pathLen; Tcl_ListObjIndex(NULL, splitPath, i, &elt); - pathv = Tcl_GetStringFromObj(elt, &pathLen); - if ((pathv[0] == '/') || ((pathLen == 3) && (pathv[1] == ':')) + pathv = Tcl_GetString(elt); + if ((pathv[0] == '/') || ((elt->length == 3) && (pathv[1] == ':')) || (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) { /* * Handle "/", "//machine/export", "c:/", "." or ".." by just @@ -1696,7 +1695,6 @@ ConvertFileNameFormat( Tcl_DString dsTemp; const TCHAR *nativeName; const char *tempString; - int tempLen; WIN32_FIND_DATA data; HANDLE handle; DWORD attr; @@ -1710,8 +1708,8 @@ ConvertFileNameFormat( */ Tcl_DStringInit(&ds); - tempString = Tcl_GetStringFromObj(tempPath,&tempLen); - nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds); + tempString = Tcl_GetString(tempPath); + nativeName = Tcl_WinUtfToTChar(tempString, tempPath->length, &ds); Tcl_DecrRefCount(tempPath); handle = FindFirstFile(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 42405d4..9250cb4 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -928,11 +928,12 @@ TclpMatchInDirectory( * Match a single file directly. */ - int len; + size_t len; DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; - const char *str = Tcl_GetStringFromObj(norm,&len); + const char *str = Tcl_GetString(norm); + len = norm->length; native = Tcl_FSGetNativePath(pathPtr); if (GetFileAttributesEx(native, @@ -952,7 +953,7 @@ TclpMatchInDirectory( WIN32_FIND_DATA data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ - int dirLength; + size_t dirLength; int matchSpecialDots; Tcl_DString ds; /* Native encoding of dir, also used * temporarily for other things. */ @@ -991,7 +992,8 @@ TclpMatchInDirectory( */ Tcl_DStringInit(&dsOrig); - dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); + dirName = Tcl_GetString(fileNamePtr); + dirLength = fileNamePtr->length; Tcl_DStringAppend(&dsOrig, dirName, dirLength); lastChar = dirName[dirLength -1]; @@ -2820,15 +2822,14 @@ TclpObjNormalizePath( * Not the end of the string. */ - int len; char *path; Tcl_Obj *tmpPathPtr; tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); - path = Tcl_GetStringFromObj(tmpPathPtr, &len); - Tcl_SetStringObj(pathPtr, path, len); + path = Tcl_GetString(tmpPathPtr); + Tcl_SetStringObj(pathPtr, path, tmpPathPtr->length); Tcl_DecrRefCount(tmpPathPtr); } else { /* @@ -2911,11 +2912,12 @@ TclWinVolumeRelativeNormalize( * also on drive C. */ - int cwdLen; + size_t cwdLen; const char *drive = - Tcl_GetStringFromObj(useThisCwd, &cwdLen); + Tcl_GetString(useThisCwd); char drive_cur = path[0]; + cwdLen = useThisCwd->length; if (drive_cur >= 'a') { drive_cur -= ('a' - 'A'); } @@ -3048,7 +3050,7 @@ TclNativeCreateNativeRep( char *nativePathPtr, *str; Tcl_DString ds; Tcl_Obj *validPathPtr; - int len; + size_t len; if (TclFSCwdIsNative()) { /* @@ -3073,7 +3075,8 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = Tcl_GetStringFromObj(validPathPtr, &len); + str = Tcl_GetString(validPathPtr); + len = validPathPtr->length; if (str[0] == '/' && str[1] == '/' && str[2] == '?' && str[3] == '/') { char *p; diff --git a/win/tclWinInit.c b/win/tclWinInit.c index f552e2c..e9b5697 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -176,7 +176,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 @@ -218,9 +218,10 @@ TclpInitLibraryPath( TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; - bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); + bytes = Tcl_GetString(pathPtr); + *lengthPtr = pathPtr->length; *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1); + memcpy(*valuePtr, bytes, (*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); } @@ -338,7 +339,7 @@ AppendEnvironment( static void InitializeDefaultLibraryDir( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); @@ -365,7 +366,7 @@ InitializeDefaultLibraryDir( *lengthPtr = strlen(name); *valuePtr = ckalloc(*lengthPtr + 1); *encodingPtr = NULL; - memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); + memcpy(*valuePtr, name, *lengthPtr + 1); } /* @@ -389,7 +390,7 @@ InitializeDefaultLibraryDir( static void InitializeSourceLibraryDir( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); @@ -416,7 +417,7 @@ InitializeSourceLibraryDir( *lengthPtr = strlen(name); *valuePtr = ckalloc(*lengthPtr + 1); *encodingPtr = NULL; - memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); + memcpy(*valuePtr, name, *lengthPtr + 1); } /* diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index f7ceabc..837f60b 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -2654,8 +2654,7 @@ Tcl_PidObjCmd( if (objc == 1) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); } else { - chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), - NULL); + chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } @@ -3107,9 +3106,9 @@ TclpOpenTemporaryFile( } namePtr += length * sizeof(TCHAR); if (basenameObj) { - const char *string = Tcl_GetStringFromObj(basenameObj, &length); + const char *string = Tcl_GetString(basenameObj); - Tcl_WinUtfToTChar(string, length, &buf); + Tcl_WinUtfToTChar(string, basenameObj->length, &buf); memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); namePtr += Tcl_DStringLength(&buf); Tcl_DStringFree(&buf); diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 643bd06..2ce6b83 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -281,7 +281,7 @@ RegistryObjCmd( return TCL_ERROR; } - if (Tcl_GetStringFromObj(objv[n], NULL)[0] == '-') { + if (Tcl_GetString(objv[n])[0] == '-') { if (Tcl_GetIndexFromObjStruct(interp, objv[n++], modes, sizeof(char *), "mode", 0, &index) != TCL_OK) { return TCL_ERROR; @@ -406,7 +406,7 @@ DeleteKey( const TCHAR *nativeTail; HKEY rootKey, subkey; DWORD result; - int length; + size_t length; Tcl_DString buf; REGSAM saveMode = mode; @@ -414,7 +414,8 @@ DeleteKey( * Find the parent of the key being deleted and open it. */ - keyName = Tcl_GetStringFromObj(keyNameObj, &length); + keyName = Tcl_GetString(keyNameObj); + length = keyNameObj->length; buffer = ckalloc(length + 1); strcpy(buffer, keyName); @@ -500,7 +501,7 @@ DeleteValue( { HKEY key; char *valueName; - int length; + size_t length; DWORD result; Tcl_DString ds; @@ -513,15 +514,16 @@ DeleteValue( return TCL_ERROR; } - valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_GetString(valueNameObj); + length = valueNameObj->length; Tcl_WinUtfToTChar(valueName, length, &ds); result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to delete value \"%s\" from key \"%s\": ", - Tcl_GetStringFromObj(valueNameObj, NULL), - Tcl_GetStringFromObj(keyNameObj, NULL))); + Tcl_GetString(valueNameObj), + Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -569,7 +571,7 @@ GetKeyNames( Tcl_DString ds; /* Buffer to translate subkey name to UTF-8 */ if (patternObj) { - pattern = Tcl_GetStringFromObj(patternObj, NULL); + pattern = Tcl_GetString(patternObj); } else { pattern = NULL; } @@ -598,7 +600,7 @@ GetKeyNames( } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to enumerate subkeys of \"%s\": ", - Tcl_GetStringFromObj(keyNameObj, NULL))); + Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } @@ -656,7 +658,7 @@ GetType( Tcl_DString ds; const char *valueName; const TCHAR *nativeValue; - int length; + size_t length; /* * Attempt to open the key for reading. @@ -671,7 +673,8 @@ GetType( * Get the type of the value. */ - valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_GetString(valueNameObj); + length = valueNameObj->length; nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds); result = RegQueryValueEx(key, nativeValue, NULL, &type, NULL, NULL); @@ -681,8 +684,8 @@ GetType( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to get type of value \"%s\" from key \"%s\": ", - Tcl_GetStringFromObj(valueNameObj, NULL), - Tcl_GetStringFromObj(keyNameObj, NULL))); + Tcl_GetString(valueNameObj), + Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); return TCL_ERROR; } @@ -729,7 +732,7 @@ GetValue( const TCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; - int nameLen; + size_t nameLen; /* * Attempt to open the key for reading. @@ -754,7 +757,8 @@ GetValue( Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; - valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); + valueName = Tcl_GetString(valueNameObj); + nameLen = valueNameObj->length; nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); result = RegQueryValueEx(key, nativeValue, NULL, &type, @@ -776,8 +780,8 @@ GetValue( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to get value \"%s\" from key \"%s\": ", - Tcl_GetStringFromObj(valueNameObj, NULL), - Tcl_GetStringFromObj(keyNameObj, NULL))); + Tcl_GetString(valueNameObj), + Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; @@ -881,7 +885,7 @@ GetValueNames( result = TCL_OK; if (patternObj) { - pattern = Tcl_GetStringFromObj(patternObj, NULL); + pattern = Tcl_GetString(patternObj); } else { pattern = NULL; } @@ -945,11 +949,12 @@ OpenKey( HKEY *keyPtr) /* Returned HKEY. */ { char *keyName, *buffer, *hostName; - int length; + size_t length; HKEY rootKey; DWORD result; - keyName = Tcl_GetStringFromObj(keyNameObj, &length); + keyName = Tcl_GetString(keyNameObj); + length = keyNameObj->length; buffer = ckalloc(length + 1); strcpy(buffer, keyName); @@ -1249,7 +1254,8 @@ SetValue( Tcl_Obj *typeObj, /* Type of data to be written. */ REGSAM mode) /* Mode flags to pass. */ { - int type, length; + int type; + size_t length; DWORD result; HKEY key; const char *valueName; @@ -1269,7 +1275,8 @@ SetValue( return TCL_ERROR; } - valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_GetString(valueNameObj); + length = valueNameObj->length; valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { @@ -1303,8 +1310,9 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - const char *bytes = Tcl_GetStringFromObj(objv[i], &length); + const char *bytes = Tcl_GetString(objv[i]); + length = objv[i]->length; Tcl_DStringAppend(&data, bytes, length); /* @@ -1323,8 +1331,9 @@ SetValue( Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; - const char *data = Tcl_GetStringFromObj(dataObj, &length); + const char *data = Tcl_GetString(dataObj); + length = dataObj->length; data = (char *) Tcl_WinUtfToTChar(data, length, &buf); /* @@ -1339,14 +1348,15 @@ SetValue( Tcl_DStringFree(&buf); } else { BYTE *data; + int bytelength; /* * Store binary data in the registry. */ - data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length); + data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength); result = RegSetValueEx(key, (TCHAR *) valueName, 0, - (DWORD) type, data, (DWORD) length); + (DWORD) type, data, (DWORD) bytelength); } Tcl_DStringFree(&nameBuf); @@ -1387,12 +1397,13 @@ BroadcastValue( LRESULT result; DWORD_PTR sendResult; UINT timeout = 3000; - int len; + size_t len; const char *str; Tcl_Obj *objPtr; if (objc == 3) { - str = Tcl_GetStringFromObj(objv[1], &len); + str = Tcl_GetString(objv[1]); + len = objv[1]->length; if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", (size_t) len)) { return TCL_BREAK; @@ -1402,7 +1413,8 @@ BroadcastValue( } } - str = Tcl_GetStringFromObj(objv[0], &len); + str = Tcl_GetString(objv[0]); + len = objv[0]->length; if (len == 0) { str = NULL; } diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 1a74354..f0dfcb8 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -2632,7 +2632,7 @@ Tcl_GetHostName(void) void InitializeHostName( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; @@ -2670,7 +2670,7 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1); + memcpy(*valuePtr, Tcl_DStringValue(&ds), (*lengthPtr)+1); Tcl_DStringFree(&ds); } -- cgit v0.12 From d7b8af55e7a45674c4feb7b912bf4c7ef214855e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 2 May 2014 07:39:44 +0000 Subject: int -> size_t for hash tables --- generic/tcl.h | 6 +++--- generic/tclHash.c | 15 ++++++++------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index d695ec8..a3f02f7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1072,11 +1072,11 @@ 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. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of diff --git a/generic/tclHash.c b/generic/tclHash.c index 90be511..e75749b 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -640,7 +640,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; @@ -675,16 +675,17 @@ Tcl_HashStats( */ result = ckalloc((NUM_COUNTERS * 60) + 300); - sprintf(result, "%d entries in table, %d buckets\n", - tablePtr->numEntries, tablePtr->numBuckets); + sprintf(result, "%" TCL_LL_MODIFIER "d entries in table, %" + TCL_LL_MODIFIER "d buckets\n", + (Tcl_WideInt) tablePtr->numEntries, (Tcl_WideInt)tablePtr->numBuckets); p = result + strlen(result); for (i = 0; i < NUM_COUNTERS; i++) { - sprintf(p, "number of buckets with %d entries: %d\n", - i, count[i]); + sprintf(p, "number of buckets with %" TCL_LL_MODIFIER "d entries: %" TCL_LL_MODIFIER "d\n", + (Tcl_WideInt) i, (Tcl_WideInt) count[i]); p += strlen(p); } - sprintf(p, "number of buckets with %d or more entries: %d\n", - NUM_COUNTERS, overflow); + sprintf(p, "number of buckets with %" TCL_LL_MODIFIER "d or more entries: %" TCL_LL_MODIFIER "d\n", + (Tcl_WideInt) NUM_COUNTERS, (Tcl_WideInt) overflow); p += strlen(p); sprintf(p, "average search distance for entry: %.1f", average); return result; -- cgit v0.12 From 5821708a49af0c4260a0ca87452b1eb8abd61e3e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 18 Jun 2015 20:58:00 +0000 Subject: Fix win compile --- win/tclWinSock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 08de678..2e4df0a 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -340,7 +340,7 @@ void printaddrinfolist(struct addrinfo *addrlist, char *prefix) void InitializeHostName( char **valuePtr, - int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; -- cgit v0.12