Index: generic/tcl.h ================================================================== --- generic/tcl.h +++ generic/tcl.h @@ -246,11 +246,12 @@ # undef TCL_CFG_DO64BIT # endif /* __LP64__ */ # undef HAVE_STRUCT_STAT64 #endif /* __APPLE__ */ -/* Cross-compiling 32-bit on a 64-bit platform? Then our +/* + * Cross-compiling 32-bit on a 64-bit platform? Then our * configure script does the wrong thing. Correct that here. */ #if defined(__GNUC__) && !defined(_WIN32) && !defined(__LP64__) # undef TCL_WIDE_INT_IS_LONG #endif @@ -462,26 +463,26 @@ * string. */ typedef struct Tcl_RegExpIndices { #if TCL_MAJOR_VERSION > 8 - Tcl_Size start; /* Character offset of first character in + Tcl_Size start; /* Character offset of first character in * match. */ - Tcl_Size end; /* Character offset of first character after + Tcl_Size end; /* Character offset of first character after * the match. */ #else long start; long end; #endif } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { - Tcl_Size nsubs; /* Number of subexpressions in the compiled + Tcl_Size nsubs; /* Number of subexpressions in the compiled * expression. */ Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ #if TCL_MAJOR_VERSION > 8 - Tcl_Size extendStart; /* The offset at which a subsequent match + Tcl_Size extendStart; /* The offset at which a subsequent match * might begin. */ #else long extendStart; long reserved; /* Reserved for later use. */ #endif @@ -615,30 +616,27 @@ typedef void *(Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); /* Abstract List functions */ -typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr); -typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size index, struct Tcl_Obj** elemObj); -typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size fromIdx, Tcl_Size toIdx, - struct Tcl_Obj **newObjPtr); -typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - struct Tcl_Obj **newObjPtr); -typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); -typedef struct Tcl_Obj* (Tcl_ObjTypeSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size indexCount, - struct Tcl_Obj *const indexArray[], - struct Tcl_Obj *valueObj); -typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj, - Tcl_Size first, Tcl_Size numToDelete, - Tcl_Size numToInsert, - struct Tcl_Obj *const insertObjs[]); -typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj, - struct Tcl_Obj *listObj, int *boolResult); +typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr); +typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size index, struct Tcl_Obj** elemObj); +typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size fromIdx, Tcl_Size toIdx, struct Tcl_Obj **newObjPtr); +typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + struct Tcl_Obj **newObjPtr); +typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); +typedef struct Tcl_Obj* (Tcl_ObjTypeSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size indexCount, struct Tcl_Obj *const indexArray[], + struct Tcl_Obj *valueObj); +typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj, + Tcl_Size first, Tcl_Size numToDelete, Tcl_Size numToInsert, + struct Tcl_Obj *const insertObjs[]); +typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj, + struct Tcl_Obj *listObj, int *boolResult); #ifndef TCL_NO_DEPRECATED # define Tcl_PackageInitProc Tcl_LibraryInitProc # define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc #endif @@ -668,27 +666,31 @@ * old type. Returns TCL_ERROR on failure. */ #if TCL_MAJOR_VERSION > 8 size_t version; /* List emulation functions - ObjType Version 1 */ - Tcl_ObjTypeLengthProc *lengthProc; /* Return the [llength] of the - ** AbstractList */ - Tcl_ObjTypeIndexProc *indexProc; /* Return a value (Tcl_Obj) for - ** [lindex $al $index] */ - Tcl_ObjTypeSliceProc *sliceProc; /* Return an AbstractList for - ** [lrange $al $start $end] */ - Tcl_ObjTypeReverseProc *reverseProc; /* Return an AbstractList for - ** [lreverse $al] */ - Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in - ** the list */ - Tcl_ObjTypeSetElement *setElementProc; /* Replace the element at the indicie - ** with the given valueObj. */ - Tcl_ObjTypeReplaceProc *replaceProc; /* Replace subset with subset */ - Tcl_ObjTypeInOperatorProc *inOperProc; /* "in" and "ni" expr list - ** operation Determine if the given - ** string value matches an element in - ** the list */ + Tcl_ObjTypeLengthProc *lengthProc; + /* Return the [llength] of the AbstractList */ + Tcl_ObjTypeIndexProc *indexProc; + /* Return a value (Tcl_Obj) for + * [lindex $al $index] */ + Tcl_ObjTypeSliceProc *sliceProc; + /* Return an AbstractList for + * [lrange $al $start $end] */ + Tcl_ObjTypeReverseProc *reverseProc; + /* Return an AbstractList for [lreverse $al] */ + Tcl_ObjTypeGetElements *getElementsProc; + /* Return an objv[] of all elements in the list. */ + Tcl_ObjTypeSetElement *setElementProc; + /* Replace the element at the index with the + * given valueObj. */ + Tcl_ObjTypeReplaceProc *replaceProc; + /* Replace subsequence with elements. */ + Tcl_ObjTypeInOperatorProc *inOperProc; + /* "in" and "ni" expr list operation. Determines + * if the given string value matches an element + * in the list. */ #endif } Tcl_ObjType; #if TCL_MAJOR_VERSION > 8 # define TCL_OBJTYPE_V0 0, \ @@ -747,11 +749,12 @@ * including the terminating null. */ const Tcl_ObjType *typePtr; /* Denotes the object's type. Always * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ - Tcl_ObjInternalRep internalRep; /* The internal representation: */ + Tcl_ObjInternalRep internalRep; + /* The internal representation: */ } Tcl_Obj; /* *---------------------------------------------------------------------------- @@ -765,11 +768,11 @@ * namespace. This contains no ::'s. The name * of the global namespace is "" although "::" * is an synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* Arbitrary value associated with this + void *clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Function invoked when deleting the * namespace to, e.g., free clientData. */ struct Tcl_Namespace *parentPtr; @@ -839,15 +842,15 @@ * a call to Tcl_CreateObjCommand2; 0 otherwise. * Tcl_SetCmdInfo does not modify this field. */ Tcl_ObjCmdProc *objProc; /* Command's object-based function. */ void *objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based function. */ - void *clientData; /* ClientData for string proc. */ + void *clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Function to call when command is * deleted. */ - void *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 * change a command's namespace; use * TclRenameCommand or Tcl_Eval (of 'rename') @@ -903,14 +906,14 @@ * TCL_NUMBER_BIG Representation is an mp_int * TCL_NUMBER_DOUBLE Representation is a double * TCL_NUMBER_NAN Value is NaN. */ -#define TCL_NUMBER_INT 2 -#define TCL_NUMBER_BIG 3 -#define TCL_NUMBER_DOUBLE 4 -#define TCL_NUMBER_NAN 5 +#define TCL_NUMBER_INT 2 +#define TCL_NUMBER_BIG 3 +#define TCL_NUMBER_DOUBLE 4 +#define TCL_NUMBER_NAN 5 /* * Flag values passed to Tcl_ConvertElement. * TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to * use backslash quoting instead. @@ -925,13 +928,13 @@ /* * Flags that may be passed to Tcl_GetIndexFromObj. * TCL_EXACT disallows abbreviated strings. * TCL_NULL_OK allows the empty string or NULL to return TCL_OK. - * The returned value will be -1; + * The returned value will be -1; * TCL_INDEX_TEMP_TABLE disallows caching of lookups. A possible use case is - * a table that will not live long enough to make it worthwhile. + * a table that will not live long enough to make it worthwhile. */ #define TCL_EXACT 1 #define TCL_NULL_OK 32 #define TCL_INDEX_TEMP_TABLE 64 @@ -962,20 +965,20 @@ * o Don't reset the flags controlling ensemble * error message rewriting. * TCL_CANCEL_UNWIND: Magical Tcl_CancelEval mode that causes the * stack for the script in progress to be * completely unwound. - * TCL_EVAL_NOERR: Do no exception reporting at all, just return + * TCL_EVAL_NOERR: Do no exception reporting at all, just return * as the caller will report. */ #define TCL_NO_EVAL 0x010000 #define TCL_EVAL_GLOBAL 0x020000 #define TCL_EVAL_DIRECT 0x040000 #define TCL_EVAL_INVOKE 0x080000 #define TCL_CANCEL_UNWIND 0x100000 -#define TCL_EVAL_NOERR 0x200000 +#define TCL_EVAL_NOERR 0x200000 /* * Special freeProc values that may be passed to Tcl_SetResult (see the man * page for details): */ @@ -1075,11 +1078,11 @@ 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. */ size_t hash; /* Hash value. */ - void *clientData; /* Application stores something here with + void *clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ Tcl_Obj *objPtr; /* Tcl_Obj * key value. */ int words[1]; /* Multiple integer words for key. The actual @@ -1099,19 +1102,19 @@ * the lower bits. If this flag is set then the * hash table will attempt to rectify this by * randomising the bits and then using the upper * N bits as the index into the table. * TCL_HASH_KEY_SYSTEM_HASH - If this flag is set then all memory internally - * allocated for the hash table that is not for an - * entry will use the system heap. + * allocated for the hash table that is not for an + * entry will use the system heap. * TCL_HASH_KEY_DIRECT_COMPARE - - * Allows fast comparison for hash keys directly - * by compare of their key.oneWordValue values, - * before call of compareKeysProc (much slower - * than a direct compare, so it is speed-up only - * flag). Don't use it if keys contain values rather - * than pointers. + * Allows fast comparison for hash keys directly + * by compare of their key.oneWordValue values, + * before call of compareKeysProc (much slower + * than a direct compare, so it is speed-up only + * flag). Don't use it if keys contain values rather + * than pointers. */ #define TCL_HASH_KEY_RANDOMIZE_HASH 0x1 #define TCL_HASH_KEY_SYSTEM_HASH 0x2 #define TCL_HASH_KEY_DIRECT_COMPARE 0x4 @@ -1171,24 +1174,24 @@ * points to first entry in bucket's hash * chain, or NULL. */ Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - Tcl_Size numBuckets; /* Total number of buckets allocated at + Tcl_Size numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - Tcl_Size numEntries; /* Total number of entries present in + Tcl_Size numEntries; /* Total number of entries present in * table. */ - Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be + Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ #if TCL_MAJOR_VERSION > 8 size_t mask; /* Mask value used in hashing function. */ #endif int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ #if TCL_MAJOR_VERSION < 9 - int mask; /* Mask value used in hashing function. */ + int mask; /* Mask value used in hashing function. */ #endif 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 * number of ints that is the size of the @@ -1774,12 +1777,12 @@ 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. */ - Tcl_Size size; /* Number of bytes in token. */ - Tcl_Size numComponents; /* If this token is composed of other tokens, + Tcl_Size size; /* Number of bytes in token. */ + Tcl_Size 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 * this one. */ } Tcl_Token; @@ -1889,17 +1892,17 @@ #define NUM_STATIC_TOKENS 20 typedef struct Tcl_Parse { const char *commentStart; /* Pointer to # that begins the first of one * or more comments preceding the command. */ - Tcl_Size commentSize; /* Number of bytes in comments (up through + Tcl_Size commentSize; /* Number of bytes in comments (up through * newline character that terminates the last * comment). If there were no comments, this * field is 0. */ const char *commandStart; /* First character in first word of * command. */ - Tcl_Size commandSize; /* Number of bytes in command, including first + Tcl_Size commandSize; /* Number of bytes in command, including first * character of first word, up through the * terminating newline, close bracket, or * semicolon. */ Tcl_Size numWords; /* Total number of words in command. May be * 0. */ @@ -1965,11 +1968,11 @@ /* Function to convert from UTF-8 into * external encoding. */ Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - void *clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ Tcl_Size nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This number * is used to determine the source string * length when the srcLen argument is @@ -2171,11 +2174,11 @@ * depends on type.*/ void *dstPtr; /* Address of value to be modified; usage * depends on type.*/ const char *helpStr; /* Documentation message describing this * option. */ - void *clientData; /* Word to pass to function callbacks. */ + void *clientData; /* Word to pass to function callbacks. */ } Tcl_ArgvInfo; /* * Legal values for the type field of a Tcl_ArgInfo: see the user * documentation for details. @@ -2499,15 +2502,19 @@ * This will free the obj if there are no references to the obj. */ # define Tcl_BounceRefCount(objPtr) \ TclBounceRefCount(objPtr, __FILE__, __LINE__) -static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) +static inline void +TclBounceRefCount( + Tcl_Obj *objPtr, + const char *fn, + int line) { if (objPtr) { - if ((objPtr)->refCount == 0) { - Tcl_DbDecrRefCount(objPtr, fn, line); + if ((objPtr)->refCount == 0) { + Tcl_DbDecrRefCount(objPtr, fn, line); } } } #else # undef Tcl_IncrRefCount @@ -2517,15 +2524,15 @@ * Use do/while0 idiom for optimum correctness without compiler warnings. * https://wiki.c2.com/?TrivialDoWhileLoop */ # undef Tcl_DecrRefCount # define Tcl_DecrRefCount(objPtr) \ - do { \ - Tcl_Obj *_objPtr = (objPtr); \ - if (_objPtr->refCount-- <= 1) { \ - TclFreeObj(_objPtr); \ - } \ + do { \ + Tcl_Obj *_objPtr = (objPtr); \ + if (_objPtr->refCount-- <= 1) { \ + TclFreeObj(_objPtr); \ + } \ } while(0) # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ ((objPtr)->refCount > 1) @@ -2535,15 +2542,17 @@ * otherwise let it be. */ # define Tcl_BounceRefCount(objPtr) \ TclBounceRefCount(objPtr); -static inline void TclBounceRefCount(Tcl_Obj* objPtr) +static inline void +TclBounceRefCount( + Tcl_Obj* objPtr) { if (objPtr) { - if ((objPtr)->refCount == 0) { - Tcl_DecrRefCount(objPtr); + if ((objPtr)->refCount == 0) { + Tcl_DecrRefCount(objPtr); } } } #endif Index: generic/tclAlloc.c ================================================================== --- generic/tclAlloc.c +++ generic/tclAlloc.c @@ -45,30 +45,30 @@ * critical: ov.magic must overlay the low order bits of ov.next, and ov.magic * can not be a valid ov.next bit pattern. */ union overhead { - union overhead *next; /* when free */ - unsigned char padding[TCL_ALLOCALIGN]; /* align struct to TCL_ALLOCALIGN bytes */ + union overhead *next; /* when free */ + unsigned char padding[TCL_ALLOCALIGN]; + /* align struct to TCL_ALLOCALIGN bytes */ struct { - unsigned char magic0; /* magic number */ - unsigned char index; /* bucket # */ - unsigned char unused; /* unused */ - unsigned char magic1; /* other magic number */ + unsigned char magic0; /* magic number */ + unsigned char index; /* bucket # */ + unsigned char unused; /* unused */ + unsigned char magic1; /* other magic number */ #ifndef NDEBUG - unsigned short rmagic; /* range magic number */ + unsigned short rmagic; /* range magic number */ size_t size; /* actual block size */ - unsigned short unused2; /* padding to 8-byte align */ + unsigned short unused2; /* padding to 8-byte align */ #endif } ovu; #define overMagic0 ovu.magic0 #define overMagic1 ovu.magic1 #define bucketIndex ovu.index #define rangeCheckMagic ovu.rmagic #define realBlockSize ovu.size }; - #define MAGIC 0xEF /* magic # on accounting info */ #define RMAGIC 0x5555 /* magic # on range info */ #ifndef NDEBUG @@ -249,11 +249,11 @@ *---------------------------------------------------------------------- */ void * TclpAlloc( - size_t numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { union overhead *overPtr; size_t bucket; size_t amount; struct block *bigBlockPtr = NULL; @@ -383,14 +383,14 @@ *---------------------------------------------------------------------- */ static void MoreCore( - size_t bucket) /* What bucket to allocate to. */ + size_t bucket) /* What bucket to allocate to. */ { union overhead *overPtr; - size_t size; /* size of desired block */ + size_t size; /* size of desired block */ size_t amount; /* amount to allocate */ size_t numBlocks; /* how many blocks we get */ struct block *blockPtr; /* @@ -509,11 +509,11 @@ */ void * TclpRealloc( void *oldPtr, /* Pointer to alloc'ed block. */ - size_t numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { int i; union overhead *overPtr; struct block *bigBlockPtr; int expensive; @@ -692,11 +692,11 @@ */ #undef TclpAlloc void * TclpAlloc( - size_t numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { return malloc(numBytes); } /* @@ -741,11 +741,11 @@ */ void * TclpRealloc( void *oldPtr, /* Pointer to alloced block. */ - size_t numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { return realloc(oldPtr, numBytes); } #endif /* !USE_TCLALLOC */ Index: generic/tclArithSeries.c ================================================================== --- generic/tclArithSeries.c +++ generic/tclArithSeries.c @@ -95,24 +95,24 @@ Tcl_Obj **stepObj); /* ------------------------ ArithSeries object type -------------------------- */ static const Tcl_ObjType arithSeriesType = { - "arithseries", /* name */ - FreeArithSeriesInternalRep, /* freeIntRepProc */ - DupArithSeriesInternalRep, /* dupIntRepProc */ - UpdateStringOfArithSeries, /* updateStringProc */ - SetArithSeriesFromAny, /* setFromAnyProc */ + "arithseries", /* name */ + FreeArithSeriesInternalRep, /* freeIntRepProc */ + DupArithSeriesInternalRep, /* dupIntRepProc */ + UpdateStringOfArithSeries, /* updateStringProc */ + SetArithSeriesFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V2( ArithSeriesObjLength, TclArithSeriesObjIndex, TclArithSeriesObjRange, TclArithSeriesObjReverse, TclArithSeriesGetElements, - NULL, // SetElement - NULL, // Replace - ArithSeriesInOperation) // "in" operator + NULL, // SetElement + NULL, // Replace + ArithSeriesInOperation) // "in" operator }; /* * Helper functions * @@ -547,30 +547,28 @@ * Creates a new ArithSeries object. Some arguments may be NULL and will * be computed based on the other given arguments. * refcount = 0. * * Results: - * * A Tcl_Obj pointer to the created ArithSeries object. * An empty Tcl_Obj if the range is invalid. * * Side Effects: - * * None. + * *---------------------------------------------------------------------- */ - int TclNewArithSeriesObj( - Tcl_Interp *interp, /* For error reporting */ - Tcl_Obj **arithSeriesObj, /* return value */ - int useDoubles, /* Flag indicates values start, - ** end, step, are treated as doubles */ - Tcl_Obj *startObj, /* Starting value */ - Tcl_Obj *endObj, /* Ending limit */ - Tcl_Obj *stepObj, /* increment value */ - Tcl_Obj *lenObj) /* Number of elements */ + Tcl_Interp *interp, /* For error reporting */ + Tcl_Obj **arithSeriesObj, /* return value */ + int useDoubles, /* Flag indicates values start, + * end, step, are treated as doubles */ + Tcl_Obj *startObj, /* Starting value */ + Tcl_Obj *endObj, /* Ending limit */ + Tcl_Obj *stepObj, /* increment value */ + Tcl_Obj *lenObj) /* Number of elements */ { double dstart, dend, dstep; Tcl_WideInt start, end, step; Tcl_WideInt len = -1; @@ -662,15 +660,13 @@ * If the index is out of range, TCL_ERROR is returned, * otherwise TCL_OK is returned and the integer value of the * element is stored in *element. * * Results: - * * TCL_OK on success. * * Side Effects: - * * On success, the integer pointed by *element is modified. * An empty string ("") is assigned if index is out-of-bounds. * *---------------------------------------------------------------------- */ @@ -703,15 +699,13 @@ * ArithSeriesObjLength * * Returns the length of the arithmetic series. * * Results: - * * The length of the series as Tcl_WideInt. * * Side Effects: - * * None. * *---------------------------------------------------------------------- */ Tcl_Size @@ -730,20 +724,18 @@ * * Return a Tcl_Obj with the step value from the give ArithSeries Obj. * refcount = 0. * * Results: - * * A Tcl_Obj pointer to the created ArithSeries object. * A NULL pointer of the range is invalid. * * Side Effects: - * * None. + * *---------------------------------------------------------------------- */ - int TclArithSeriesObjStep( Tcl_Obj *arithSeriesObj, Tcl_Obj **stepObj) { @@ -767,24 +759,21 @@ * a string to an Arithmetic Series object. * * This function is here just to populate the Type structure. * * Results: - * * The result is always TCL_ERROR. But see Side Effects. * * Side effects: - * * Tcl Panic if called. * *---------------------------------------------------------------------- */ - static int SetArithSeriesFromAny( - TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */ - TCL_UNUSED(Tcl_Obj *)) /* The object to convert. */ + TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */ + TCL_UNUSED(Tcl_Obj *)) /* The object to convert. */ { Tcl_Panic("SetArithSeriesFromAny: should never be called"); return TCL_ERROR; } @@ -792,11 +781,11 @@ *---------------------------------------------------------------------- * * TclArithSeriesObjRange -- * * Makes a slice of an ArithSeries value. - * *arithSeriesObj must be known to be a valid list. + * *arithSeriesObj must be known to be a valid list. * * Results: * Returns a pointer to the sliced series. * This may be a new object or the same object if not shared. * @@ -807,15 +796,15 @@ *---------------------------------------------------------------------- */ int TclArithSeriesObjRange( - Tcl_Interp *interp, /* For error message(s) */ + Tcl_Interp *interp, /* For error message(s) */ Tcl_Obj *arithSeriesObj, /* List object to take a range from. */ Tcl_Size fromIdx, /* Index of first element to include. */ Tcl_Size toIdx, /* Index of last element to include. */ - Tcl_Obj **newObjPtr) /* return value */ + Tcl_Obj **newObjPtr) /* return value */ { ArithSeries *arithSeriesRepPtr; Tcl_Obj *startObj, *endObj, *stepObj; (void)interp; /* silence compiler */ @@ -1014,11 +1003,11 @@ * *---------------------------------------------------------------------- */ int TclArithSeriesObjReverse( - Tcl_Interp *interp, /* For error message(s) */ + Tcl_Interp *interp, /* For error message(s) */ Tcl_Obj *arithSeriesObj, /* List object to reverse. */ Tcl_Obj **newObjPtr) { ArithSeries *arithSeriesRepPtr; Tcl_Obj *startObj, *endObj, *stepObj; @@ -1200,11 +1189,10 @@ * Side effects: * None * *---------------------------------------------------------------------- */ - static int ArithSeriesInOperation( Tcl_Interp *interp, Tcl_Obj *valueObj, Tcl_Obj *arithSeriesObjPtr, Index: generic/tclAssembly.c ================================================================== --- generic/tclAssembly.c +++ generic/tclAssembly.c @@ -220,13 +220,13 @@ * generation */ Tcl_Parse* parsePtr; /* Parse of the current line of source */ Tcl_HashTable labelHash; /* Hash table whose keys are labels and whose * values are 'label' objects storing the code * offsets of the labels. */ - Tcl_Size cmdLine; /* Current line number within the assembly + Tcl_Size cmdLine; /* Current line number within the assembly * code */ - Tcl_Size* clNext; /* Invisible continuation line for + Tcl_Size* clNext; /* Invisible continuation line for * [info frame] */ BasicBlock* head_bb; /* First basic block in the code */ BasicBlock* curr_bb; /* Current basic block */ int maxDepth; /* Maximum stack depth encountered */ int curCatchDepth; /* Current depth of catches */ @@ -275,11 +275,11 @@ static int DefineLabel(AssemblyEnv* envPtr, const char* label); static void DeleteMirrorJumpTable(JumptableInfo* jtPtr); static void FillInJumpOffsets(AssemblyEnv*); static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, Tcl_Obj* jumpTable); -static size_t FindLocalVar(AssemblyEnv* envPtr, +static size_t FindLocalVar(AssemblyEnv* envPtr, Tcl_Token** tokenPtrPtr); static int FinishAssembly(AssemblyEnv*); static void FreeAssemblyEnv(AssemblyEnv*); static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*); @@ -1269,11 +1269,11 @@ /* First operand to the instruction */ const char* operand1; /* String rep of the operand */ Tcl_Size operand1Len; /* String length of the operand */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ - Tcl_Size localVar; /* LVT index of a local variable */ + Tcl_Size localVar; /* LVT index of a local variable */ int flags; /* Flags for a basic block */ JumptableInfo* jtPtr; /* Pointer to a jumptable */ int infoIndex; /* Index of the jumptable in auxdata */ int status = TCL_ERROR; /* Return value from this function */ @@ -1300,11 +1300,10 @@ * Vector on the type of instruction being processed. */ instType = TalInstructionTable[tblIdx].instType; switch (instType) { - case ASSEM_PUSH: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "value"); goto cleanup; } @@ -1966,11 +1965,11 @@ static int CreateMirrorJumpTable( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Obj* jumps) /* List of alternating keywords and labels */ { - Tcl_Size objc; /* Number of elements in the 'jumps' list */ + Tcl_Size objc; /* Number of elements in the 'jumps' list */ Tcl_Obj** objv; /* Pointers to the elements in the list */ CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Index: generic/tclAsync.c ================================================================== --- generic/tclAsync.c +++ generic/tclAsync.c @@ -28,19 +28,19 @@ struct AsyncHandler *nextPtr, *prevPtr; /* Next, previous in list of all handlers * for the process. */ Tcl_AsyncProc *proc; /* Procedure to call when handler is * invoked. */ - void *clientData; /* Value to pass to handler when it is + void *clientData; /* Value to pass to handler when it is * invoked. */ struct ThreadSpecificData *originTsd; /* Used in Tcl_AsyncMark to modify thread- * specific data from outside the thread it is * associated to. */ Tcl_ThreadId originThrdId; /* Origin thread where this token was created * and where it will be yielded. */ - void *notifierData; /* Platform notifier data or NULL. */ + void *notifierData; /* Platform notifier data or NULL. */ } AsyncHandler; typedef struct ThreadSpecificData { int asyncReady; /* This is set to 1 whenever a handler becomes * ready and it is cleared to zero whenever @@ -140,11 +140,11 @@ Tcl_AsyncHandler Tcl_AsyncCreate( Tcl_AsyncProc *proc, /* Procedure to call when handler is * invoked. */ - void *clientData) /* Argument to pass to handler. */ + void *clientData) /* Argument to pass to handler. */ { AsyncHandler *asyncPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); asyncPtr = (AsyncHandler*)Tcl_Alloc(sizeof(AsyncHandler)); @@ -188,11 +188,11 @@ *---------------------------------------------------------------------- */ void Tcl_AsyncMark( - Tcl_AsyncHandler async) /* Token for handler. */ + Tcl_AsyncHandler async) /* Token for handler. */ { AsyncHandler *token = (AsyncHandler *) async; Tcl_MutexLock(&asyncMutex); token->ready = 1; @@ -199,11 +199,10 @@ if (!token->originTsd->asyncActive) { token->originTsd->asyncReady = 1; Tcl_ThreadAlert(token->originThrdId); } Tcl_MutexUnlock(&asyncMutex); - } /* *---------------------------------------------------------------------- * @@ -222,12 +221,12 @@ *---------------------------------------------------------------------- */ int Tcl_AsyncMarkFromSignal( - Tcl_AsyncHandler async, /* Token for handler. */ - int sigNumber) /* Signal number. */ + Tcl_AsyncHandler async, /* Token for handler. */ + int sigNumber) /* Signal number. */ { #if TCL_THREADS AsyncHandler *token = (AsyncHandler *) async; return TclAsyncNotifier(sigNumber, token->originThrdId, @@ -376,11 +375,11 @@ *---------------------------------------------------------------------- */ void Tcl_AsyncDelete( - Tcl_AsyncHandler async) /* Token for handler to delete. */ + Tcl_AsyncHandler async) /* Token for handler to delete. */ { AsyncHandler *asyncPtr = (AsyncHandler *) async; /* * Assure early handling of the constraint Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -28,27 +28,35 @@ * TCL_FPCLASSIFY_MODE: * 0 - fpclassify * 1 - _fpclass * 2 - simulate * 3 - __builtin_fpclassify + * + * Not directly used; handled by preprocessor. */ +enum ClassifyModes { + MODE_FPCLASSIFY = 0, /* Use fpclassify(), C99 standard */ + MODE_FPCLASS = 1, /* Use _fpclass() */ + MODE_SIMULATE = 2, /* Simulate */ + MODE_BUILTIN = 3 /* Use __builtin_fpclassify() */ +}; #ifndef TCL_FPCLASSIFY_MODE #if defined(__MINGW32__) && defined(_X86_) /* mingw 32-bit */ /* * MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify, * [fpclassify 1e-314], x86 => normal, x64 => subnormal, so switch to using a * version using a compiler built-in. */ #define TCL_FPCLASSIFY_MODE 1 -#elif defined(fpclassify) /* fpclassify */ +#elif defined(fpclassify) /* fpclassify */ /* * This is the C99 standard. */ #include #define TCL_FPCLASSIFY_MODE 0 -#elif defined(_FPCLASS_NN) /* _fpclass */ +#elif defined(_FPCLASS_NN) /* _fpclass */ /* * This case handles newer MSVC on Windows, which doesn't have the standard * operation but does have something that can tell us the same thing. */ #define TCL_FPCLASSIFY_MODE 1 @@ -60,11 +68,10 @@ */ #define TCL_FPCLASSIFY_MODE 2 #endif /* !fpclassify */ /* actually there is no fallback to builtin fpclassify */ #endif /* !TCL_FPCLASSIFY_MODE */ - /* * Bug 7371b6270b: to check C call stack depth, prefer an approach which is * compatible with AddressSanitizer (ASan) use-after-return detection. */ @@ -269,16 +276,18 @@ CompileProc *compileProc; /* Function called to compile command. */ Tcl_ObjCmdProc *nreProc; /* NR-based function for command */ int flags; /* Various flag bits, as defined below. */ } CmdInfo; -#define CMD_IS_SAFE 1 /* Whether this command is part of the set of - * commands present by default in a safe - * interpreter. */ +enum CmdInfoFlags { + CMD_IS_SAFE = 1 /* Whether this command is part of the set of + * commands present by default in a safe + * interpreter. */ /* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle * expansion for itself rather than needing the generic layer to take care of * it for it. Defined in tclInt.h. */ +}; /* * The following struct states that the command it talks about (a subcommand * of one of Tcl's built-in ensembles) is unsafe and must be hidden when an * interpreter is made safe. (TclHideUnsafeCommands accesses an array of these @@ -286,16 +295,16 @@ * the commands. */ typedef struct { const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for - * the end of the list of commands to hide. */ + * the end of the list of commands to hide. */ const char *commandName; /* The name of the command within the - * ensemble. If this is NULL, we want to also - * make the overall command be hidden, an ugly - * hack because it is expected by security - * policies in the wild. */ + * ensemble. If this is NULL, we want to also + * make the overall command be hidden, an ugly + * hack because it is expected by security + * policies in the wild. */ } UnsafeEnsembleInfo; /* * The built-in commands, and the functions that implement them: */ @@ -626,12 +635,12 @@ } Tcl_MutexUnlock(&cancelLock); Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_DeleteHashTable(&commandTypeTable); - commandTypeInit = 0; + Tcl_DeleteHashTable(&commandTypeTable); + commandTypeInit = 0; } Tcl_MutexUnlock(&commandTypeLock); } /* @@ -817,20 +826,20 @@ Tcl_MutexUnlock(&cancelLock); } #undef TclObjInterpProc if (commandTypeInit == 0) { - TclRegisterCommandTypeName(TclObjInterpProc, "proc"); - TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); - TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclChildObjCmd, "interp"); - TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); - TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); - TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); - TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); - TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); + TclRegisterCommandTypeName(TclObjInterpProc, "proc"); + TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); + TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclChildObjCmd, "interp"); + TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); + TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); + TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); + TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); + TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); } /* * Initialize support for namespaces and create the global namespace * (whose name is ""; an alias is "::"). This also initializes the Tcl @@ -939,11 +948,11 @@ /* TIP #378 */ #ifdef TCL_INTERP_DEBUG_FRAME iPtr->flags |= INTERP_DEBUG_FRAME; #else if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) { - iPtr->flags |= INTERP_DEBUG_FRAME; + iPtr->flags |= INTERP_DEBUG_FRAME; } #endif /* * Initialise the tables for variable traces and searches *before* @@ -1096,13 +1105,13 @@ cmdPtr->objProc = cmdInfoPtr->objProc; cmdPtr->objClientData = NULL; cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; - if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { - cmdPtr->flags |= CMD_COMPILES_EXPANDED; - } + if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { + cmdPtr->flags |= CMD_COMPILES_EXPANDED; + } cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = cmdInfoPtr->nreProc; Tcl_SetHashValue(hPtr, cmdPtr); } @@ -1158,26 +1167,25 @@ Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation", Tcl_RepresentationCmd, NULL, NULL); /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, - "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, - TclNRAssembleObjCmd, NULL, NULL); + "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, + TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRInjectObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", - CoroTypeObjCmd, NULL, NULL); + CoroTypeObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); if (nsPtr) { Tcl_Export(interp, nsPtr, "*", 1); } - #ifdef USE_DTRACE /* * Register the tcl::dtrace command. */ @@ -1346,25 +1354,25 @@ { Tcl_HashEntry *hPtr; Tcl_MutexLock(&commandTypeLock); if (commandTypeInit == 0) { - Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); - commandTypeInit = 1; + Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); + commandTypeInit = 1; } if (nameStr != NULL) { - int isNew; + int isNew; - hPtr = Tcl_CreateHashEntry(&commandTypeTable, - implementationProc, &isNew); - Tcl_SetHashValue(hPtr, (void *) nameStr); + hPtr = Tcl_CreateHashEntry(&commandTypeTable, + implementationProc, &isNew); + Tcl_SetHashValue(hPtr, (void *) nameStr); } else { - hPtr = Tcl_FindHashEntry(&commandTypeTable, - implementationProc); - if (hPtr != NULL) { - Tcl_DeleteHashEntry(hPtr); - } + hPtr = Tcl_FindHashEntry(&commandTypeTable, + implementationProc); + if (hPtr != NULL) { + Tcl_DeleteHashEntry(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); } const char * @@ -1374,19 +1382,19 @@ Command *cmdPtr = (Command *) command; Tcl_ObjCmdProc *procPtr = cmdPtr->objProc; const char *name = "native"; if (procPtr == NULL) { - procPtr = cmdPtr->nreProc; + procPtr = cmdPtr->nreProc; } Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); - if (hPtr && Tcl_GetHashValue(hPtr)) { - name = (const char *) Tcl_GetHashValue(hPtr); - } + if (hPtr && Tcl_GetHashValue(hPtr)) { + name = (const char *) Tcl_GetHashValue(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); return name; } @@ -1422,45 +1430,45 @@ Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name); } } for (unsafePtr = unsafeEnsembleCommands; - unsafePtr->ensembleNsName; unsafePtr++) { - if (unsafePtr->commandName) { - /* - * Hide an ensemble subcommand. - */ - - Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - - if (TclRenameCommand(interp, TclGetString(cmdName), - "___tmp") != TCL_OK - || Tcl_HideCommand(interp, "___tmp", - TclGetString(hideName)) != TCL_OK) { - Tcl_Panic("problem making '%s %s' safe: %s", - unsafePtr->ensembleNsName, unsafePtr->commandName, - Tcl_GetStringResult(interp)); - } - Tcl_CreateObjCommand(interp, TclGetString(cmdName), - BadEnsembleSubcommand, (void *)unsafePtr, NULL); - TclDecrRefCount(cmdName); - TclDecrRefCount(hideName); - } else { - /* - * Hide an ensemble main command (for compatibility). - */ - - if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, - unsafePtr->ensembleNsName) != TCL_OK) { - Tcl_Panic("problem making '%s' safe: %s", - unsafePtr->ensembleNsName, - Tcl_GetStringResult(interp)); - } - } + unsafePtr->ensembleNsName; unsafePtr++) { + if (unsafePtr->commandName) { + /* + * Hide an ensemble subcommand. + */ + + Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + + if (TclRenameCommand(interp, TclGetString(cmdName), + "___tmp") != TCL_OK + || Tcl_HideCommand(interp, "___tmp", + TclGetString(hideName)) != TCL_OK) { + Tcl_Panic("problem making '%s %s' safe: %s", + unsafePtr->ensembleNsName, unsafePtr->commandName, + Tcl_GetStringResult(interp)); + } + Tcl_CreateObjCommand(interp, TclGetString(cmdName), + BadEnsembleSubcommand, (void *)unsafePtr, NULL); + TclDecrRefCount(cmdName); + TclDecrRefCount(hideName); + } else { + /* + * Hide an ensemble main command (for compatibility). + */ + + if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, + unsafePtr->ensembleNsName) != TCL_OK) { + Tcl_Panic("problem making '%s' safe: %s", + unsafePtr->ensembleNsName, + Tcl_GetStringResult(interp)); + } + } } return TCL_OK; } @@ -1490,12 +1498,12 @@ TCL_UNUSED(Tcl_Obj *const *) /* objv */) { const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData; Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "not allowed to invoke subcommand %s of %s", - infoPtr->commandName, infoPtr->ensembleNsName)); + "not allowed to invoke subcommand %s of %s", + infoPtr->commandName, infoPtr->ensembleNsName)); Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL); return TCL_ERROR; } /* @@ -1522,11 +1530,11 @@ void Tcl_CallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; int *assocDataCounterPtr = (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); @@ -1570,11 +1578,11 @@ void Tcl_DontCallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTablePtr; Tcl_HashSearch hSearch; Tcl_HashEntry *hPtr; @@ -1618,11 +1626,11 @@ Tcl_SetAssocData( Tcl_Interp *interp, /* Interpreter to associate with. */ const char *name, /* Name for association. */ Tcl_InterpDeleteProc *proc, /* Proc to call when interpreter is about to * be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; AssocData *dPtr; Tcl_HashEntry *hPtr; int isNew; @@ -1935,11 +1943,10 @@ } Tcl_DeleteHashTable(hTablePtr); Tcl_Free(hTablePtr); } - if (iPtr->assocData != NULL) { AssocData *dPtr; hTablePtr = iPtr->assocData; /* @@ -2188,11 +2195,11 @@ if (strstr(hiddenCmdToken, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" " token (rename)", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); return TCL_ERROR; } /* * Find the command to hide. An error is returned if cmdName can't be @@ -2211,13 +2218,13 @@ * Check that the command is really in global namespace */ if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only hide global namespace commands (use rename then hide)", - -1)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); + "can only hide global namespace commands (use rename then hide)", + -1)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } /* * Initialize the hidden command table if necessary. @@ -2237,13 +2244,13 @@ */ hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "hidden command named \"%s\" already exists", - hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); + "hidden command named \"%s\" already exists", + hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); return TCL_ERROR; } /* * NB: This code is currently 'like' a rename to a special separate name @@ -2341,13 +2348,13 @@ * time). */ if (strstr(cmdName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot expose to a namespace (use expose to toplevel, then rename)", - -1)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); + "cannot expose to a namespace (use expose to toplevel, then rename)", + -1)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } /* * Get the command from the hidden command table: @@ -2358,13 +2365,13 @@ if (hiddenCmdTablePtr != NULL) { hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken); } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown hidden command \"%s\"", hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", - hiddenCmdToken, (char *)NULL); + "unknown hidden command \"%s\"", hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", + hiddenCmdToken, (char *)NULL); return TCL_ERROR; } cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* @@ -2397,12 +2404,12 @@ */ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "exposed command \"%s\" already exists", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); + "exposed command \"%s\" already exists", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); return TCL_ERROR; } /* * Command resolvers (per-interp, per-namespace) might have resolved to a @@ -2495,11 +2502,11 @@ const char *cmdName, /* Name of command. If it contains namespace * qualifiers, the new command is put in the * specified namespace; otherwise it is put in * the global namespace. */ Tcl_CmdProc *proc, /* Function to associate with cmdName. */ - void *clientData, /* Arbitrary value passed to string proc. */ + void *clientData, /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { Interp *iPtr = (Interp *) interp; @@ -2526,30 +2533,30 @@ * Loop until we no longer find an existing command in the way, or * until we've deleted one command and that didn't finish the job. */ while (1) { - /* - * Determine where the command should reside. If its name contains - * namespace qualifiers, we put it in the specified namespace; + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; * otherwise, we always put it in the global namespace. - */ + */ - if (strstr(cmdName, "::") != NULL) { + if (strstr(cmdName, "::") != NULL) { Namespace *dummy1, *dummy2; TclGetNamespaceForQualName(interp, cmdName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { - return (Tcl_Command) NULL; + return (Tcl_Command) NULL; } - } else { + } else { nsPtr = iPtr->globalNsPtr; tail = cmdName; - } + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); if (isNew || deleted) { /* * isNew - No conflict with existing command. * deleted - We've already deleted a conflicting command @@ -2556,12 +2563,12 @@ */ break; } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Be careful to preserve any existing import links so we can restore @@ -2684,16 +2691,15 @@ *---------------------------------------------------------------------- */ typedef struct { Tcl_ObjCmdProc2 *proc; - void *clientData; /* Arbitrary value to pass to proc function. */ + void *clientData; /* Arbitrary value to pass to proc function. */ Tcl_CmdDeleteProc *deleteProc; - void *deleteData; /* Arbitrary value to pass to deleteProc function. */ + void *deleteData; /* Arbitrary value to pass to deleteProc function. */ Tcl_ObjCmdProc2 *nreProc; } CmdWrapperInfo; - static int cmdWrapperProc( void *clientData, Tcl_Interp *interp, @@ -2729,16 +2735,15 @@ * qualifiers, the new command is put in the * specified namespace; otherwise it is put in * the global namespace. */ Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc + Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ -) { CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; info->clientData = clientData; info->deleteProc = deleteProc; @@ -2757,16 +2762,15 @@ * qualifiers, the new command is put in the * specified namespace; otherwise it is put in * the global namespace. */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc + Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ -) { Interp *iPtr = (Interp *) interp; Namespace *nsPtr; const char *tail; @@ -2786,11 +2790,11 @@ if (strstr(cmdName, "::") != NULL) { Namespace *dummy1, *dummy2; TclGetNamespaceForQualName(interp, cmdName, NULL, - TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); + TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { return (Tcl_Command) NULL; } } else { nsPtr = iPtr->globalNsPtr; @@ -2803,15 +2807,15 @@ Tcl_Command TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace - * components. */ - Tcl_Namespace *namesp, /* The namespace to create the command in */ + * components. */ + Tcl_Namespace *namesp, /* The namespace to create the command in */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { @@ -2839,12 +2843,12 @@ */ break; } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Command already exists; delete it. Be careful to preserve any @@ -2857,18 +2861,18 @@ if (cmdPtr->importRefPtr) { cmdPtr->flags |= CMD_REDEF_IN_PROGRESS; } /* - * Make sure namespace doesn't get deallocated. - */ + * Make sure namespace doesn't get deallocated. + */ cmdPtr->nsPtr->refCount++; Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); nsPtr = (Namespace *) TclEnsureNamespace(interp, - (Tcl_Namespace *) cmdPtr->nsPtr); + (Tcl_Namespace *) cmdPtr->nsPtr); TclNsDecrRefCount(cmdPtr->nsPtr); if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) { oldRefPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = NULL; @@ -2976,13 +2980,13 @@ *---------------------------------------------------------------------- */ int InvokeStringCommand( - void *clientData, /* Points to command's Command structure. */ + void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr = (Command *)clientData; int i, result; const char **argv = (const char **) @@ -3050,14 +3054,14 @@ cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0); cmdPtr = (Command *) cmd; if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't %s \"%s\": command doesn't exist", + "can't %s \"%s\": command doesn't exist", ((newName == NULL)||(*newName == '\0'))? "delete":"rename", oldName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); return TCL_ERROR; } /* * If the new command name is NULL or empty, delete the command. Do this @@ -3083,20 +3087,20 @@ TclGetNamespaceForQualName(interp, newName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail); if ((newNsPtr == NULL) || (newTail == NULL)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": bad command name", newName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); + "can't rename to \"%s\": bad command name", newName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); result = TCL_ERROR; goto done; } if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": command already exists", newName)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", - "TARGET_EXISTS", (char *)NULL); + "can't rename to \"%s\": command already exists", newName)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", + "TARGET_EXISTS", (char *)NULL); result = TCL_ERROR; goto done; } /* @@ -3264,11 +3268,11 @@ *---------------------------------------------------------------------- */ static int invokeObj2Command( - void *clientData, /* Points to command's Command structure. */ + void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; @@ -3918,11 +3922,11 @@ *---------------------------------------------------------------------- */ static int CancelEvalProc( - void *clientData, /* Interp to cancel the script in progress. */ + void *clientData, /* Interp to cancel the script in progress. */ TCL_UNUSED(Tcl_Interp *), int code) /* Current return code from command. */ { CancelInfo *cancelInfo = (CancelInfo *)clientData; Interp *iPtr; @@ -3996,11 +4000,11 @@ *---------------------------------------------------------------------- */ void TclCleanupCommand( - Command *cmdPtr) /* Points to the Command structure to + Command *cmdPtr) /* Points to the Command structure to * be freed. */ { if (cmdPtr->refCount-- <= 1) { Tcl_Free(cmdPtr); } @@ -4148,11 +4152,11 @@ * Has the current script in progress for this interpreter been canceled * or is the stack being unwound due to the previous script cancellation? */ if (!TclCanceled(iPtr)) { - return TCL_OK; + return TCL_OK; } /* * The CANCELED flag is a one-shot flag that is reset immediately upon * being detected; however, if the TCL_CANCEL_UNWIND flag is set we will @@ -4169,47 +4173,47 @@ * (indicating that the script in progress has been canceled) if the * evaluation stack for the interp is being fully unwound. */ if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) { - return TCL_OK; + return TCL_OK; } /* * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the * interp's result; otherwise, we leave it alone. */ if (flags & TCL_LEAVE_ERR_MSG) { - const char *id, *message = NULL; - Tcl_Size length; - - /* - * Setup errorCode variables so that we can differentiate between - * being canceled and unwound. - */ - - if (iPtr->asyncCancelMsg != NULL) { - message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); - } else { - length = 0; - } - - if (iPtr->flags & TCL_CANCEL_UNWIND) { - id = "IUNWIND"; - if (length == 0) { - message = "eval unwound"; - } - } else { - id = "ICANCEL"; - if (length == 0) { - message = "eval canceled"; - } - } - - Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); - Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); + const char *id, *message = NULL; + Tcl_Size length; + + /* + * Setup errorCode variables so that we can differentiate between + * being canceled and unwound. + */ + + if (iPtr->asyncCancelMsg != NULL) { + message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); + } else { + length = 0; + } + + if (iPtr->flags & TCL_CANCEL_UNWIND) { + id = "IUNWIND"; + if (length == 0) { + message = "eval unwound"; + } + } else { + id = "ICANCEL"; + if (length == 0) { + message = "eval canceled"; + } + } + + Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); + Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); } /* * Return TCL_ERROR to the caller (not necessarily just the Tcl core * itself) that indicates further processing of the script or command in @@ -4244,11 +4248,11 @@ Tcl_CancelEval( Tcl_Interp *interp, /* Interpreter in which to cancel the * script. */ Tcl_Obj *resultObjPtr, /* The script cancellation error message or * NULL for a default error message. */ - void *clientData, /* Passed to CancelEvalProc. */ + void *clientData, /* Passed to CancelEvalProc. */ int flags) /* Collection of OR-ed bits that control * the cancellation of the script. Only * TCL_CANCEL_UNWIND is currently * supported. */ { @@ -4390,11 +4394,11 @@ * this callback (that marks the end of the target command) and goes back * to the end of the source command. */ if (iPtr->deferredCallbacks) { - iPtr->deferredCallbacks = NULL; + iPtr->deferredCallbacks = NULL; } else { TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); } iPtr->numLevels++; @@ -4441,11 +4445,10 @@ /* * Configure evaluation context to match the requested flags. */ if (iPtr->lookupNsPtr) { - /* * Capture the namespace we should do command name resolution in, as * instructed by our caller sneaking it in to us in a private interp * field. Clear that field right away so we cannot possibly have its * use leak where it should not. The sneaky message pass is done. @@ -4457,11 +4460,10 @@ lookupNsPtr = iPtr->lookupNsPtr; iPtr->lookupNsPtr = NULL; } else if (flags & TCL_EVAL_INVOKE) { lookupNsPtr = iPtr->globalNsPtr; } else { - /* * TCL_EVAL_INVOKE was not set: clear rewrite rules */ TclResetRewriteEnsemble(interp, 1); @@ -4478,17 +4480,17 @@ reresolve: assert(cmdPtr == NULL); if (preCmdPtr) { /* - * Caller gave it to us. - */ + * Caller gave it to us. + */ if (!(preCmdPtr->flags & CMD_DEAD)) { /* - * So long as it exists, use it. - */ + * So long as it exists, use it. + */ cmdPtr = preCmdPtr; } else if (flags & TCL_EVAL_NORESOLVE) { /* * When it's been deleted, and we're told not to attempt resolving @@ -4615,12 +4617,12 @@ struct NRE_callback *rootPtr) /* All callbacks down to rootPtr not inclusive * are to be run. */ { while (TOP_CB(interp) != rootPtr) { - NRE_callback *callbackPtr = TOP_CB(interp); - Tcl_NRPostProc *procPtr = callbackPtr->procPtr; + NRE_callback *callbackPtr = TOP_CB(interp); + Tcl_NRPostProc *procPtr = callbackPtr->procPtr; TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); TCLNR_FREE(interp, callbackPtr); } @@ -4636,13 +4638,13 @@ Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr; iPtr->numLevels--; - /* - * If there is a tailcall, schedule it next - */ + /* + * If there is a tailcall, schedule it next + */ if (data[1] && (data[1] != INT2PTR(1))) { listPtr = (Tcl_Obj *)data[1]; data[1] = NULL; @@ -4868,13 +4870,13 @@ */ cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr); if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", TclGetString(objv[0]))); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", - TclGetString(objv[0]), (char *)NULL); + "invalid command name \"%s\"", TclGetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", + TclGetString(objv[0]), (char *)NULL); /* * Release any resources we locked and allocated during the handler * call. */ @@ -5069,11 +5071,11 @@ 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. */ - Tcl_Size count) /* Number of tokens to consider at tokenPtr. + Tcl_Size count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, NULL, NULL); } @@ -5124,11 +5126,11 @@ * first NUL character. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ Tcl_Size line, /* The line the script starts on. */ - Tcl_Size *clNextOuter, /* Information about an outer context for */ + Tcl_Size *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set only in * TclSubstTokens(), to properly handle * [...]-nested commands. The 'outerScript' * refers to the most-outer script containing * the embedded command, which is referred to @@ -5155,12 +5157,11 @@ Tcl_Size bytesLeft, commandLength; CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); int gotParse = 0; - Tcl_Size i, objectsUsed = 0; - /* These variables keep track of how much + Tcl_Size i, objectsUsed = 0;/* These variables keep track of how much * state has been allocated while evaluating * the script, so that it can be freed * properly if an error occurs. */ Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); @@ -5168,11 +5169,11 @@ TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size)); /* TIP #280 Structures for tracking of command * locations. */ - Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible + Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible * continuation lines. Initialized only if the * caller gave us a table of locations to * track, via scriptCLLocPtr. It always refers * to the table entry holding the location of * the next invisible continuation line to @@ -5365,11 +5366,10 @@ } expandRequested = 1; expand[objectsUsed] = 1; additionalObjsCount = (numElements ? numElements : 1); - } else { expand[objectsUsed] = 0; additionalObjsCount = 1; } @@ -5846,11 +5846,11 @@ * shenanigans. This means that we don't have to tend to the * housekeeping, and can escape now. */ if (ePtr->nline != objc) { - return; + return; } /* * Having disposed of the ensemble cases, we can state... * A few truths ... @@ -6054,11 +6054,11 @@ int Tcl_EvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - Tcl_Obj *objPtr, /* Pointer to object containing commands to + Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ { @@ -6067,11 +6067,11 @@ int TclEvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - Tcl_Obj *objPtr, /* Pointer to object containing commands to + Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ const CmdFrame *invoker, /* Frame of the command doing the eval. */ @@ -6086,11 +6086,11 @@ int TclNREvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - Tcl_Obj *objPtr, /* Pointer to object containing commands to + Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ const CmdFrame *invoker, /* Frame of the command doing the eval. */ @@ -6171,11 +6171,11 @@ flags |= TCL_EVAL_SOURCE_IN_FRAME; } TclMarkTailcall(interp); - TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, + TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); } @@ -6192,23 +6192,23 @@ ByteCode *codePtr; CallFrame *savedVarFramePtr = NULL; /* Saves old copy of * iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ - if (TclInterpReady(interp) != TCL_OK) { - return TCL_ERROR; - } + if (TclInterpReady(interp) != TCL_OK) { + return TCL_ERROR; + } if (flags & TCL_EVAL_GLOBAL) { savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; } Tcl_IncrRefCount(objPtr); codePtr = TclCompileObj(interp, objPtr, invoker, word); TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, objPtr, INT2PTR(allowExceptions), NULL); - return TclNRExecuteByteCode(interp, codePtr); + return TclNRExecuteByteCode(interp, codePtr); } { /* * We're not supposed to use the compiler or byte-code @@ -6487,11 +6487,11 @@ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; int result, type; double d; @@ -6534,11 +6534,11 @@ int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; int result, type; void *internalPtr; @@ -6610,11 +6610,11 @@ int TclObjInvokeNamespace( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ Tcl_Namespace *nsPtr, /* The namespace to use. */ int flags) /* Combination of flags controlling the call: * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN, @@ -6654,11 +6654,11 @@ int TclObjInvoke( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ int flags) /* Combination of flags controlling the call: * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN, * or TCL_INVOKE_NO_TRACEBACK. */ @@ -6666,11 +6666,11 @@ if (interp == NULL) { return TCL_ERROR; } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal argument vector", -1)); + "illegal argument vector", -1)); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN"); } @@ -6695,13 +6695,13 @@ if (hTblPtr != NULL) { hPtr = Tcl_FindHashEntry(hTblPtr, cmdName); } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid hidden command name \"%s\"", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, - (char *)NULL); + "invalid hidden command name \"%s\"", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, + (char *)NULL); return TCL_ERROR; } cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* @@ -7185,11 +7185,11 @@ } return TCL_OK; negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "square root of negative argument", -1)); + "square root of negative argument", -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", (char *)NULL); return TCL_ERROR; } @@ -7245,11 +7245,11 @@ return TCL_OK; } static int ExprUnaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes one double argument and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count */ @@ -7309,11 +7309,11 @@ return TCL_OK; } static int ExprBinaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes two double arguments and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ @@ -7613,24 +7613,24 @@ MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } res = objv[1]; for (i = 1; i < objc; i++) { - if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { - return TCL_ERROR; - } - if (type == TCL_NUMBER_NAN) { - /* - * Get the error message for NaN. - */ - - Tcl_GetDoubleFromObj(interp, objv[i], &d); - return TCL_ERROR; - } - if (TclCompareTwoNumbers(objv[i], res) == op) { - res = objv[i]; - } + if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type == TCL_NUMBER_NAN) { + /* + * Get the error message for NaN. + */ + + Tcl_GetDoubleFromObj(interp, objv[i], &d); + return TCL_ERROR; + } + if (TclCompareTwoNumbers(objv[i], res) == op) { + res = objv[i]; + } } Tcl_SetObjResult(interp, res); return TCL_OK; } @@ -7914,50 +7914,50 @@ /* * If we don't have fpclassify(), we also don't have the values it returns. * Hence we define those here. */ #ifndef FP_NAN -# define FP_NAN 1 /* Value is NaN */ -# define FP_INFINITE 2 /* Value is an infinity */ -# define FP_ZERO 3 /* Value is a zero */ -# define FP_NORMAL 4 /* Value is a normal float */ -# define FP_SUBNORMAL 5 /* Value has lost accuracy */ +# define FP_NAN 1 /* Value is NaN */ +# define FP_INFINITE 2 /* Value is an infinity */ +# define FP_ZERO 3 /* Value is a zero */ +# define FP_NORMAL 4 /* Value is a normal float */ +# define FP_SUBNORMAL 5 /* Value has lost accuracy */ #endif /* !FP_NAN */ #if TCL_FPCLASSIFY_MODE == 3 return __builtin_fpclassify( - FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); + FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); #elif TCL_FPCLASSIFY_MODE == 2 /* * We assume this hack is only needed on little-endian systems. * Specifically, x86 running Windows. It's fairly easy to enable for * others if they need it (because their libc/libm is broken) but we'll * jump that hurdle when requred. We can solve the word ordering then. */ union { - double d; /* Interpret as double */ - struct { - unsigned int low; /* Lower 32 bits */ - unsigned int high; /* Upper 32 bits */ - } w; /* Interpret as unsigned integer words */ - } doubleMeaning; /* So we can look at the representation of a - * double directly. Platform (i.e., processor) - * specific; this is for x86 (and most other - * little-endian processors, but those are - * untested). */ + double d; /* Interpret as double */ + struct { + unsigned int low; /* Lower 32 bits */ + unsigned int high; /* Upper 32 bits */ + } w; /* Interpret as unsigned integer words */ + } doubleMeaning; /* So we can look at the representation of a + * double directly. Platform (i.e., processor) + * specific; this is for x86 (and most other + * little-endian processors, but those are + * untested). */ unsigned int exponent, mantissaLow, mantissaHigh; - /* The pieces extracted from the double. */ - int zeroMantissa; /* Was the mantissa zero? That's special. */ + /* The pieces extracted from the double. */ + int zeroMantissa; /* Was the mantissa zero? That's special. */ /* * Shifts and masks to use with the doubleMeaning variable above. */ -#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ -#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ -#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ +#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ +#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ +#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we * totally ignore the sign bit. */ @@ -7972,47 +7972,47 @@ * Look for the special cases of exponent. */ switch (exponent) { case 0: - /* - * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. - */ + /* + * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. + */ - return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; + return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; case EXPONENT_MASK: - /* - * When the exponent is all ones, it's an INF or a NAN. - */ + /* + * When the exponent is all ones, it's an INF or a NAN. + */ - return zeroMantissa ? FP_INFINITE : FP_NAN; + return zeroMantissa ? FP_INFINITE : FP_NAN; default: - /* - * Everything else is a NORMAL double precision float. - */ + /* + * Everything else is a NORMAL double precision float. + */ - return FP_NORMAL; + return FP_NORMAL; } #elif TCL_FPCLASSIFY_MODE == 1 switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: - return FP_ZERO; + return FP_ZERO; case _FPCLASS_NN: case _FPCLASS_PN: - return FP_NORMAL; + return FP_NORMAL; case _FPCLASS_ND: case _FPCLASS_PD: - return FP_SUBNORMAL; + return FP_SUBNORMAL; case _FPCLASS_NINF: case _FPCLASS_PINF: - return FP_INFINITE; + return FP_INFINITE; default: - Tcl_Panic("result of _fpclass() outside documented range!"); + Tcl_Panic("result of _fpclass() outside documented range!"); case _FPCLASS_QNAN: case _FPCLASS_SNAN: - return FP_NAN; + return FP_NAN; } #else /* TCL_FPCLASSIFY_MODE not in (0..3) */ #error "unknown or unexpected TCL_FPCLASSIFY_MODE" #endif /* TCL_FPCLASSIFY_MODE */ #endif /* !fpclassify */ @@ -8034,18 +8034,18 @@ MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - type = ClassifyDouble(d); - result = (type != FP_INFINITE && type != FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + type = ClassifyDouble(d); + result = (type != FP_INFINITE && type != FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } @@ -8065,17 +8065,17 @@ MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_INFINITE); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_INFINITE); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } @@ -8095,17 +8095,17 @@ MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } @@ -8125,17 +8125,17 @@ MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } @@ -8155,17 +8155,17 @@ MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_SUBNORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_SUBNORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } @@ -8185,27 +8185,27 @@ MathFuncWrongNumArgs(interp, 3, objc, objv); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result = 1; + result = 1; } else { - d = *((const double *) ptr); - result = (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result = (ClassifyDouble(d) == FP_NAN); } if (Tcl_GetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result |= 1; + result |= 1; } else { - d = *((const double *) ptr); - result |= (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result |= (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } @@ -8222,43 +8222,43 @@ Tcl_Obj *objPtr; void *ptr; int type; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); + Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - goto gotNaN; + goto gotNaN; } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } switch (ClassifyDouble(d)) { case FP_INFINITE: - TclNewLiteralStringObj(objPtr, "infinite"); - break; + TclNewLiteralStringObj(objPtr, "infinite"); + break; case FP_NAN: gotNaN: - TclNewLiteralStringObj(objPtr, "nan"); - break; + TclNewLiteralStringObj(objPtr, "nan"); + break; case FP_NORMAL: - TclNewLiteralStringObj(objPtr, "normal"); - break; + TclNewLiteralStringObj(objPtr, "normal"); + break; case FP_SUBNORMAL: - TclNewLiteralStringObj(objPtr, "subnormal"); - break; + TclNewLiteralStringObj(objPtr, "subnormal"); + break; case FP_ZERO: - TclNewLiteralStringObj(objPtr, "zero"); - break; + TclNewLiteralStringObj(objPtr, "zero"); + break; default: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to classify number: %f", d)); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to classify number: %f", d)); + return TCL_ERROR; } Tcl_SetObjResult(interp, objPtr); return TCL_OK; } @@ -8573,11 +8573,11 @@ Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with * name, provides direct access for direct * calls. */ Tcl_ObjCmdProc2 *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { @@ -8604,19 +8604,19 @@ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name, provides direct access for direct * calls. */ Tcl_ObjCmdProc *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { Command *cmdPtr = (Command *) Tcl_CreateObjCommand(interp, cmdName, proc, clientData, - deleteProc); + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; } @@ -8629,12 +8629,12 @@ Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc) { Command *cmdPtr = (Command *) - TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, - deleteProc); + TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; } @@ -8653,11 +8653,11 @@ int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - Tcl_Size objc, /* Number of words in command. */ + Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and @@ -8712,12 +8712,12 @@ { Interp *iPtr = (Interp *) interp; if (iPtr->deferredCallbacks == NULL) { TclNRAddCallback(interp, NRCommand, NULL, NULL, - NULL, NULL); - iPtr->deferredCallbacks = TOP_CB(interp); + NULL, NULL); + iPtr->deferredCallbacks = TOP_CB(interp); } } void TclSkipTailcall( @@ -8760,16 +8760,16 @@ */ NRE_callback *runPtr; for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { - if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { - break; - } + if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { + break; + } } if (!runPtr) { - Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); + Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } runPtr->data[1] = listPtr; } /* @@ -8801,46 +8801,46 @@ Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?"); return TCL_ERROR; } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc, lambda or method", -1)); - Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "tailcall can only be called from a proc, lambda or method", -1)); + Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); return TCL_ERROR; } /* * Invocation without args just clears a scheduled tailcall; invocation * with an argument replaces any previously scheduled tailcall. */ if (iPtr->varFramePtr->tailcallPtr) { - Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); - iPtr->varFramePtr->tailcallPtr = NULL; + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); + iPtr->varFramePtr->tailcallPtr = NULL; } /* * Create the callback to actually evaluate the tailcalled * command, then set it in the varFrame so that PopCallFrame can use it * at the proper time. */ if (objc > 1) { - Tcl_Obj *listPtr, *nsObjPtr; - Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; - - /* - * The tailcall data is in a Tcl list: the first element is the - * namespace, the rest the command to be tailcalled. - */ - - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); - listPtr = Tcl_NewListObj(objc, objv); + Tcl_Obj *listPtr, *nsObjPtr; + Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; + + /* + * The tailcall data is in a Tcl list: the first element is the + * namespace, the rest the command to be tailcalled. + */ + + nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); + listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); - iPtr->varFramePtr->tailcallPtr = listPtr; + iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } /* @@ -8871,17 +8871,17 @@ if (result == TCL_OK) { result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); } if (result != TCL_OK) { - /* - * Tailcall execution was preempted, eg by an intervening catch or by - * a now-gone namespace: cleanup and return. - */ + /* + * Tailcall execution was preempted, eg by an intervening catch or by + * a now-gone namespace: cleanup and return. + */ Tcl_DecrRefCount(listPtr); - return result; + return result; } /* * Perform the tailcall */ @@ -8964,11 +8964,11 @@ return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yield can only be called in a coroutine", -1)); + "yield can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (objc == 2) { @@ -8975,11 +8975,11 @@ Tcl_SetObjResult(interp, objv[1]); } NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - clientData, NULL, NULL); + clientData, NULL, NULL); return TCL_OK; } int TclNRYieldToObjCmd( @@ -8997,21 +8997,21 @@ return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto can only be called in a coroutine", -1)); + "yieldto can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto called in deleted namespace", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", (char *)NULL); - return TCL_ERROR; + return TCL_ERROR; } /* * Add the tailcall in the caller env, then just yield. * @@ -9194,39 +9194,39 @@ { CoroutineData *corPtr = (CoroutineData *)data[0]; void *stackLevel = TclGetCStackPtr(); if (!corPtr->stackLevel) { - /* - * -- Coroutine is suspended -- - * Push the callback to restore the caller's context on yield or - * return. - */ - - TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); - - /* - * Record the stackLevel at which the resume is happening, then swap - * the interp's environment to make it suitable to run this coroutine. - */ - - corPtr->stackLevel = stackLevel; - Tcl_Size numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = iPtr->numLevels; - - SAVE_CONTEXT(corPtr->caller); - corPtr->callerEEPtr = iPtr->execEnvPtr; - RESTORE_CONTEXT(corPtr->running); - iPtr->execEnvPtr = corPtr->eePtr; - iPtr->numLevels += numLevels; + /* + * -- Coroutine is suspended -- + * Push the callback to restore the caller's context on yield or + * return. + */ + + TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, + NULL, NULL, NULL); + + /* + * Record the stackLevel at which the resume is happening, then swap + * the interp's environment to make it suitable to run this coroutine. + */ + + corPtr->stackLevel = stackLevel; + Tcl_Size numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = iPtr->numLevels; + + SAVE_CONTEXT(corPtr->caller); + corPtr->callerEEPtr = iPtr->execEnvPtr; + RESTORE_CONTEXT(corPtr->running); + iPtr->execEnvPtr = corPtr->eePtr; + iPtr->numLevels += numLevels; } else { - /* - * Coroutine is active: yield - */ + /* + * Coroutine is active: yield + */ - if (corPtr->stackLevel != stackLevel) { + if (corPtr->stackLevel != stackLevel) { NRE_callback *runPtr; iPtr->execEnvPtr = corPtr->callerEEPtr; if (corPtr->yieldPtr) { for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { @@ -9238,35 +9238,34 @@ } } } iPtr->execEnvPtr = corPtr->eePtr; - - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot yield: C stack busy", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", - (char *)NULL); - return TCL_ERROR; - } - - void *type = data[1]; - if (type == CORO_ACTIVATE_YIELD) { - corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; - } else if (type == CORO_ACTIVATE_YIELDM) { - corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; - } else { - Tcl_Panic("Yield received an option which is not implemented"); - } + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot yield: C stack busy", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", + (char *)NULL); + return TCL_ERROR; + } + + void *type = data[1]; + if (type == CORO_ACTIVATE_YIELD) { + corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; + } else if (type == CORO_ACTIVATE_YIELDM) { + corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; + } else { + Tcl_Panic("Yield received an option which is not implemented"); + } corPtr->yieldPtr = NULL; - corPtr->stackLevel = NULL; + corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return TCL_OK; } @@ -9328,45 +9327,45 @@ * Look up the coroutine. */ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only get coroutine type of a coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objv[1]), (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only get coroutine type of a coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objv[1]), (char *)NULL); + return TCL_ERROR; } /* * An active coroutine is "active". Can't tell what it might do in the * future. */ corPtr = (CoroutineData *)cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); + return TCL_OK; } /* * Inactive coroutines are classified by the (effective) command used to * suspend them, which matters when you're injecting a probe. */ switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); + return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); + return TCL_OK; default: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown coroutine type", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unknown coroutine type", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); + return TCL_ERROR; } } /* *---------------------------------------------------------------------- @@ -9389,14 +9388,14 @@ */ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objPtr), (char *)NULL); - return NULL; + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objPtr), (char *)NULL); + return NULL; } return (CoroutineData *)cmdPtr->objClientData; } static int @@ -9417,19 +9416,19 @@ Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?"); return TCL_ERROR; } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. @@ -9436,11 +9435,11 @@ */ ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; } @@ -9462,20 +9461,20 @@ Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?"); return TCL_ERROR; } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a probe command into a coroutine"); + "can only inject a probe command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a probe command into a suspended coroutine", - -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a probe command into a suspended coroutine", + -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. @@ -9482,11 +9481,11 @@ */ ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); iPtr->execEnvPtr = savedEEPtr; /* * Now we immediately transfer control to the coroutine to run our probe. * TRICKY STUFF copied from the [yield] implementation. @@ -9493,11 +9492,11 @@ * * Push the callback to restore the caller's context on yield back. */ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); /* * Record the stackLevel at which the resume is happening, then swap * the interp's environment to make it suitable to run this coroutine. */ @@ -9579,11 +9578,11 @@ */ Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr, - INT2PTR(nargs), isProbe); + INT2PTR(nargs), isProbe); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } static int @@ -9609,20 +9608,20 @@ * * Code from guts of [yield] implementation. */ if (isProbe) { - if (result == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (injected coroutine probe command)"); - } - corPtr->nargs = nargs; - corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + if (result == TCL_ERROR) { + Tcl_AddErrorInfo(interp, + "\n (injected coroutine probe command)"); + } + corPtr->nargs = nargs; + corPtr->stackLevel = NULL; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return result; } /* @@ -9654,19 +9653,19 @@ Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?"); return TCL_ERROR; } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. @@ -9689,12 +9688,12 @@ { CoroutineData *corPtr = (CoroutineData *)clientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "coroutine \"%s\" is already running", - TclGetString(objv[0]))); + "coroutine \"%s\" is already running", + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL); return TCL_ERROR; } /* @@ -9703,35 +9702,35 @@ * is deleted! */ switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - if (objc == 2) { - Tcl_SetObjResult(interp, objv[1]); - } else if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); - return TCL_ERROR; - } - break; + if (objc == 2) { + Tcl_SetObjResult(interp, objv[1]); + } else if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); + return TCL_ERROR; + } + break; default: - if (corPtr->nargs + 1 != objc) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong coro nargs; how did we get here? " - "not implemented!", -1)); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); - return TCL_ERROR; - } - /* fallthrough */ + if (corPtr->nargs + 1 != objc) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong coro nargs; how did we get here? " + "not implemented!", -1)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); + return TCL_ERROR; + } + /* fallthrough */ case COROUTINE_ARGUMENTS_ARBITRARY: - if (objc > 1) { - Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); - } - break; + if (objc > 1) { + Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); + } + break; } TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -9767,20 +9766,20 @@ TclGetNamespaceForQualName(interp, procName, inNsPtr, 0, &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName); if (nsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": unknown namespace", - procName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); + "can't create procedure \"%s\": unknown namespace", + procName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); return TCL_ERROR; } if (simpleName == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": bad procedure name", - procName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); + "can't create procedure \"%s\": bad procedure name", + procName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); return TCL_ERROR; } /* * We ARE creating the coroutine command: allocate the corresponding @@ -9868,11 +9867,11 @@ /* * Now just resume the coroutine. */ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } /* * This is used in the [info] ensemble Index: generic/tclBinary.c ================================================================== --- generic/tclBinary.c +++ generic/tclBinary.c @@ -26,13 +26,14 @@ #define BINARY_NOCOUNT -2 /* No count was specified in format. */ /* * The following flags may be OR'ed together and returned by GetFormatSpec */ - -#define BINARY_SIGNED 0 /* Field to be read as signed data */ -#define BINARY_UNSIGNED 1 /* Field to be read as unsigned data */ +enum BinaryFormatFlags { + BINARY_SIGNED = 0, /* Field to be read as signed data */ + BINARY_UNSIGNED = 1 /* Field to be read as unsigned data */ +}; /* * The following defines the maximum number of different (integer) numbers * placed in the object cache by 'binary scan' before it bails out and * switches back to Plan A (creating a new object for each value.) @@ -183,11 +184,11 @@ * above. */ } ByteArray; #define BYTEARRAY_MAX_LEN (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes)) #define BYTEARRAY_SIZE(len) \ - ( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \ + ( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \ ? (Tcl_Panic("negative length specified or max size of a Tcl value exceeded"), 0) \ : (offsetof(ByteArray, bytes) + (len)) ) #define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) #define SET_BYTEARRAY(irPtr, baPtr) \ (irPtr)->twoPtrValue.ptr1 = (baPtr) @@ -438,11 +439,11 @@ unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ Tcl_Size numBytes) /* Number of bytes in resized array - * Must be >= 0 */ + * Must be >= 0 */ { ByteArray *byteArrayPtr; Tcl_ObjInternalRep *irPtr; assert(numBytes >= 0); @@ -769,16 +770,14 @@ Tcl_Panic("max size of a byte array exceeded"); } needed = byteArrayPtr->used + len; if (needed > byteArrayPtr->allocated) { Tcl_Size newCapacity; - byteArrayPtr = - (ByteArray *)TclReallocElemsEx(byteArrayPtr, - needed, - 1, - offsetof(ByteArray, bytes), - &newCapacity); + + byteArrayPtr = (ByteArray *) + TclReallocElemsEx(byteArrayPtr, needed, 1, + offsetof(ByteArray, bytes), &newCapacity); byteArrayPtr->allocated = newCapacity; SET_BYTEARRAY(irPtr, byteArrayPtr); } if (bytes) { Index: generic/tclCkalloc.c ================================================================== --- generic/tclCkalloc.c +++ generic/tclCkalloc.c @@ -169,11 +169,11 @@ int flags) { char buf[1024]; if (clientData == NULL) { - return 0; + return 0; } snprintf(buf, sizeof(buf), "total mallocs %10" TCL_Z_MODIFIER "u\n" "total frees %10" TCL_Z_MODIFIER "u\n" "current packets allocated %10" TCL_Z_MODIFIER "u\n" @@ -274,11 +274,10 @@ if (nukeGuards) { memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE); memset(hiPtr, 0, HIGH_GUARD_SIZE); } - } /* *---------------------------------------------------------------------- * @@ -825,11 +824,11 @@ } result = Tcl_DumpActiveMemory(fileName); Tcl_DStringFree(&buffer); if (result != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s", - TclGetString(objv[2]), Tcl_PosixError(interp))); + TclGetString(objv[2]), Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; } if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) { @@ -870,12 +869,12 @@ return TCL_ERROR; } fileP = fopen(fileName, "w"); if (fileP == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot open output file: %s", - Tcl_PosixError(interp))); + "cannot open output file: %s", + Tcl_PosixError(interp))); return TCL_ERROR; } TclDbDumpActiveObjects(fileP); fclose(fileP); Tcl_DStringFree(&buffer); @@ -935,13 +934,13 @@ validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": should be active, break_on_malloc, info, " - "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", - TclGetString(objv[1]))); + "bad option \"%s\": should be active, break_on_malloc, info, " + "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", + TclGetString(objv[1]))); return TCL_ERROR; argError: Tcl_WrongNumArgs(interp, 2, objv, "count"); return TCL_ERROR; @@ -1007,11 +1006,10 @@ { TclInitDbCkalloc(); Tcl_CreateObjCommand(interp, "memory", MemoryCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); } - #else /* TCL_MEM_DEBUG */ /* This is the !TCL_MEM_DEBUG case */ @@ -1251,15 +1249,15 @@ * *------------------------------------------------------------------------ */ void * TclAllocElemsEx( - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if + * non-NULL. Only modified on success */ { void *ptr = TclAttemptReallocElemsEx( NULL, elemCount, elemSize, leadSize, capacityPtr); if (ptr == NULL) { Tcl_Panic("Failed to allocate %" TCL_SIZE_MODIFIER @@ -1286,17 +1284,17 @@ * *------------------------------------------------------------------------ */ void * TclAttemptReallocElemsEx( - void *oldPtr, /* Pointer to memory block to reallocate or - * NULL to indicate this is a new allocation */ - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + void *oldPtr, /* Pointer to memory block to reallocate or + * NULL to indicate this is a new allocation */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored + * here if non-NULL. Only modified on success */ { void *ptr; Tcl_Size limit; Tcl_Size attempt; Index: generic/tclClock.c ================================================================== --- generic/tclClock.c +++ generic/tclClock.c @@ -122,11 +122,11 @@ struct ClockCommand { const char *name; /* The tail of the command name. The full name * is "::tcl::clock::". When NULL marks * the end of the table. */ - Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This + Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This * will always have the ClockClientData sent * to it, but may well ignore this data. */ CompileProc *compileProc; /* The compiler for the command. */ void *clientData; /* Any clientData to give the command (if NULL * a reference to ClockClientData will be sent) */ @@ -253,11 +253,11 @@ /* * Install the commands. */ -#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */ +#define TCL_CLOCK_PREFIX_LEN 14 // == strlen("::tcl::clock::") memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN); for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) { void *clientData; strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name); @@ -347,11 +347,11 @@ * *---------------------------------------------------------------------- */ static void ClockDeleteCmdProc( - void *clientData) /* Opaque pointer to the client data */ + void *clientData) /* Opaque pointer to the client data */ { ClockClientData *data = (ClockClientData *)clientData; int i; if (data->refCount-- <= 1) { @@ -644,30 +644,30 @@ *mcDictObj = dataPtr->prevUsedLocaleDict; TclSetObjRef(dataPtr->prevUsedLocaleUnnorm, localeObj); return dataPtr->prevUsedLocale; } - if ((localeObj->length == 1 /* C */ + if ((localeObj->length == 1 // C && strcasecmp(loc, Literals[LIT_C]) == 0) || (dataPtr->defaultLocale && (loc2 = TclGetString(dataPtr->defaultLocale)) && localeObj->length == dataPtr->defaultLocale->length && strcasecmp(loc, loc2) == 0)) { *mcDictObj = dataPtr->defaultLocaleDict; return dataPtr->defaultLocale ? dataPtr->defaultLocale : dataPtr->literals[LIT_C]; } - if (localeObj->length == 7 /* current */ + if (localeObj->length == 7 // current && strcasecmp(loc, Literals[LIT_CURRENT]) == 0) { if (dataPtr->currentLocale == NULL) { ClockGetCurrentLocale(dataPtr, interp); } *mcDictObj = dataPtr->currentLocaleDict; return dataPtr->currentLocale; } - if ((localeObj->length == 6 /* system */ + if ((localeObj->length == 6 // system && strcasecmp(loc, Literals[LIT_SYSTEM]) == 0)) { SavePrevLocaleObj(dataPtr); TclSetObjRef(dataPtr->lastUsedLocaleUnnorm, localeObj); localeObj = ClockGetSystemLocale(dataPtr, interp); TclSetObjRef(dataPtr->lastUsedLocale, localeObj); @@ -702,11 +702,10 @@ { ClockClientData *dataPtr = opts->dataPtr; /* if dict not yet retrieved */ if (opts->mcDictObj == NULL) { - /* if locale was not yet used */ if (!(opts->flags & CLF_LOCALE_USED)) { opts->localeObj = NormLocaleObj(dataPtr, opts->interp, opts->localeObj, &opts->mcDictObj); @@ -754,21 +753,25 @@ return NULL; } opts->mcDictObj = Tcl_GetObjResult(opts->interp); Tcl_ResetResult(opts->interp); - ref = 0; /* new object is not yet referenced */ + ref = 0; // new object is not yet referenced } - /* be sure that object reference doesn't increase (dict changeable) */ + /* + * Be sure that object reference doesn't increase (dict changeable). + */ if (opts->mcDictObj->refCount > ref) { /* smart reference (shared dict as object with no ref-counter) */ opts->mcDictObj = TclDictObjSmartRef(opts->interp, opts->mcDictObj); } - /* create exactly one reference to catalog / make it searchable for future */ + /* + * Create exactly one reference to catalog / make it searchable for future. + */ Tcl_DictObjPut(NULL, dataPtr->mcDicts, opts->localeObj, opts->mcDictObj); if (opts->localeObj == dataPtr->literals[LIT_C] || opts->localeObj == dataPtr->defaultLocale) { @@ -819,11 +822,11 @@ } } Tcl_DictObjGet(opts->interp, opts->mcDictObj, opts->dataPtr->mcLiterals[mcKey], &valObj); - return valObj; /* or NULL in obscure case if Tcl_DictObjGet failed */ + return valObj; // or NULL in obscure case if Tcl_DictObjGet failed } /* *---------------------------------------------------------------------- * @@ -1943,29 +1946,28 @@ } seconds = fields->seconds; /* Cache the last conversion */ - if (ltzoc != NULL) { /* slot was found above */ + if (ltzoc != NULL) { // slot was found above /* timezoneObj and changeover are the same */ - TclSetObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */ + TclSetObjRef(ltzoc->tzName, fields->tzName); // may be NULL } else { /* no TZ in cache - just move second slot down and use the first one */ ltzoc = &dataPtr->lastTZOffsCache[0]; TclUnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj); TclUnsetObjRef(dataPtr->lastTZOffsCache[1].tzName); memcpy(&dataPtr->lastTZOffsCache[1], ltzoc, sizeof(*ltzoc)); TclInitObjRef(ltzoc->timezoneObj, timezoneObj); ltzoc->changeover = changeover; - TclInitObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */ + TclInitObjRef(ltzoc->tzName, fields->tzName); // may be NULL } ltzoc->localSeconds = fields->localSeconds; ltzoc->rangesVal[0] = rangesVal[0]; ltzoc->rangesVal[1] = rangesVal[1]; ltzoc->tzOffset = fields->tzOffset; } - /* check DST-hole: if retrieved seconds is out of range */ if (ltzoc->rangesVal[0] > seconds || seconds >= ltzoc->rangesVal[1]) { dstHole: #if 0 @@ -1974,11 +1976,11 @@ (int)fields->localSeconds, fields->tzOffset, (int)ltzoc->rangesVal[0], (int)seconds, (int)ltzoc->rangesVal[1]); #endif /* because we don't know real TZ (we're outsize), just invalidate local * time (which could be verified in ClockValidDate later) */ - fields->localSeconds = TCL_INV_SECONDS; /* not valid seconds */ + fields->localSeconds = TCL_INV_SECONDS; // not valid seconds } return TCL_OK; } /* @@ -2241,15 +2243,19 @@ /* converted using table (TZ isn't :localtime) */ fields->flags &= ~CLF_CTZ; /* Cache the last conversion */ - if (ltzoc != NULL) { /* slot was found above */ + if (ltzoc != NULL) { // slot was found above /* timezoneObj and changeover are the same */ TclSetObjRef(ltzoc->tzName, fields->tzName); } else { - /* no TZ in cache - just move second slot down and use the first one */ + /* + * No TZ in cache - just move second slot down and use the first + * one. + */ + ltzoc = &dataPtr->lastTZOffsCache[0]; TclUnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj); TclUnsetObjRef(dataPtr->lastTZOffsCache[1].tzName); memcpy(&dataPtr->lastTZOffsCache[1], ltzoc, sizeof(*ltzoc)); TclInitObjRef(ltzoc->timezoneObj, timezoneObj); @@ -2698,11 +2704,14 @@ /* * Estimate month by calculating `dayOfYear / (365/12)` */ month = (day*12) / dipm[12]; - /* then do forwards backwards correction */ + + /* + * then do forwards backwards correction + */ while (1) { if (day > dipm[month]) { if (month >= 11 || day <= dipm[month + 1]) { break; } @@ -2834,11 +2843,11 @@ /* * Try an initial conversion in the Gregorian calendar. */ -#if 0 /* BUG https://core.tcl-lang.org/tcl/tktview?name=da340d4f32 */ +#if 0 // BUG https://core.tcl-lang.org/tcl/tktview?name=da340d4f32 ym1o4 = ym1 / 4; #else /* * Have to make sure quotient is truncated towards 0 when negative. * See above bug for details. The casts are necessary. @@ -2898,11 +2907,10 @@ * Stores day number in 'julianDay' * *---------------------------------------------------------------------- */ - void GetJulianDayFromEraYearDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Gregorian transition date as a Julian Day */ { @@ -3287,11 +3295,11 @@ static int ClockParseFmtScnArgs( ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ TclDateFields *date, /* Extracted date-time corresponding base * (by scan or add) resp. clockval (by format) */ - Tcl_Size objc, /* Parameter count */ + Tcl_Size objc, /* Parameter count */ Tcl_Obj *const objv[], /* Parameter vector */ ClockOperation operation, /* What operation are we doing: format, scan, add */ const char *syntax) /* Syntax of the current command */ { Tcl_Interp *interp = opts->interp; @@ -3312,11 +3320,12 @@ if (operation == CLC_OP_SCN) { /* default flags (from configure) */ opts->flags |= dataPtr->defFlags & CLF_VALIDATE; } else { /* clock value (as current base) */ - opts->baseObj = objv[(baseIdx = 1)]; + baseIdx = 1; + opts->baseObj = objv[1]; saw |= 1 << CLC_ARGS_BASE; } /* * Extract values for the keywords. @@ -3363,11 +3372,12 @@ break; case CLC_ARGS_TIMEZONE: opts->timezoneObj = objv[i + 1]; break; case CLC_ARGS_BASE: - opts->baseObj = objv[(baseIdx = i + 1)]; + baseIdx = i + 1; + opts->baseObj = objv[i + 1]; break; case CLC_ARGS_VALIDATE: if (operation != CLC_OP_SCN) { goto badOptionMsg; } else { @@ -3480,11 +3490,11 @@ memcpy(date, &dataPtr->lastBase.date, ClockCacheableDateFieldsSize); } else { /* extact fields from base */ date->seconds = baseVal; if (ClockGetDateFields(dataPtr, interp, date, opts->timezoneObj, - GREGORIAN_CHANGE_DATE) != TCL_OK) { + GREGORIAN_CHANGE_DATE) != TCL_OK) { /* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */ return TCL_ERROR; } /* cache last base */ memcpy(&dataPtr->lastBase.date, date, ClockCacheableDateFieldsSize); @@ -3717,12 +3727,12 @@ { /* If needed assemble julianDay using year, month, etc. */ if (info->flags & CLF_ASSEMBLE_JULIANDAY) { if (info->flags & CLF_ISO8601WEEK) { GetJulianDayFromEraYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); - } else if (!(info->flags & CLF_DAYOFYEAR) /* no day of year */ - || (info->flags & (CLF_DAYOFMONTH|CLF_MONTH)) /* yymmdd over yyddd */ + } else if (!(info->flags & CLF_DAYOFYEAR) // no day of year + || (info->flags & (CLF_DAYOFMONTH|CLF_MONTH)) // yymmdd over yyddd == (CLF_DAYOFMONTH|CLF_MONTH)) { GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); } else { GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); } @@ -3799,11 +3809,11 @@ #endif if (!(stage & CLF_VALIDATE_S1) || !(opts->flags & CLF_VALIDATE_S1)) { goto stage_2; } - opts->flags &= ~CLF_VALIDATE_S1; /* stage 1 is done */ + opts->flags &= ~CLF_VALIDATE_S1; // stage 1 is done /* first year (used later in hath / daysInPriorMonths) */ if ((info->flags & (CLF_YEAR | CLF_ISO8601YEAR))) { if ((info->flags & CLF_ISO8601YEAR)) { if (yydate.iso8601Year < dataPtr->validMinYear @@ -3819,11 +3829,11 @@ errMsg = "invalid year"; errCode = "year"; goto error; } } else if ((info->flags & CLF_ISO8601YEAR)) { - yyYear = yydate.iso8601Year; /* used to recognize leap */ + yyYear = yydate.iso8601Year; // used to recognize leap } if ((info->flags & (CLF_ISO8601YEAR | CLF_YEAR)) == (CLF_ISO8601YEAR | CLF_YEAR)) { if (yyYear != yydate.iso8601Year) { errMsg = "ambiguous year"; @@ -3901,11 +3911,11 @@ } if (!(stage & CLF_VALIDATE_S2) || !(opts->flags & CLF_VALIDATE_S2)) { return TCL_OK; } - opts->flags &= ~CLF_VALIDATE_S2; /* stage 2 is done */ + opts->flags &= ~CLF_VALIDATE_S2; // stage 2 is done /* * Further tests expected ready calculated julianDay (inclusive relative), * and time-zone conversion (local to UTC time). */ @@ -4307,12 +4317,10 @@ offs += 2; } return offs; } - - /*---------------------------------------------------------------------- * * ClockAddObjCmd -- , clock add -- * @@ -4569,15 +4577,15 @@ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { typedef struct { - int status; /* return code status */ - int flags; /* Each remaining field saves the */ - int returnLevel; /* corresponding field of the Interp */ - int returnCode; /* struct. These fields taken together are */ - Tcl_Obj *errorInfo; /* the "state" of the interp. */ + int status; /* return code status */ + int flags; /* Each remaining field saves the */ + int returnLevel; /* corresponding field of the Interp */ + int returnCode; /* struct. These fields taken together are */ + Tcl_Obj *errorInfo; /* the "state" of the interp. */ Tcl_Obj *errorCode; Tcl_Obj *returnOpts; Tcl_Obj *objResult; Tcl_Obj *errorStack; int resetErrorStack; Index: generic/tclClockFmt.c ================================================================== --- generic/tclClockFmt.c +++ generic/tclClockFmt.c @@ -1146,11 +1146,10 @@ if (end > info->dateEnd) { end = info->dateEnd; } p += tok->lookAhMin; if (laTok->map && p < end) { - /* try to find laTok between [lookAhMin, lookAhMax] */ while (minLen < maxLen) { const char *f = FindTokenBegin(p, end, laTok, TCL_CLOCK_FULL_COMPAT ? opts->flags : CLF_STRICT); /* if found (not below lookAhMax) */ @@ -1861,11 +1860,11 @@ if (maxLen > 4) { maxLen = 4; } while (len < maxLen) { if ((*p & 0x80) - || (!isalpha(UCHAR(*p)) && !isdigit(UCHAR(*p)))) { /* INTL: ISO only. */ + || (!isalpha(UCHAR(*p)) && !isdigit(UCHAR(*p)))) { // INTL: ISO only break; } p++; len++; } @@ -2583,11 +2582,10 @@ flags |= info->flags; /* seconds token (%s) take precedence over all other tokens */ if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_POSIXSEC)) { if (flags & CLF_DATE) { - if (!(flags & CLF_JULIANDAY)) { info->flags |= CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY; /* dd precedence below ddd */ switch (flags & (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH)) { Index: generic/tclCmdAH.c ================================================================== --- generic/tclCmdAH.c +++ generic/tclCmdAH.c @@ -423,18 +423,17 @@ * *------------------------------------------------------------------------ */ static int EncodingConvertParseOptions( - Tcl_Interp *interp, /* For error messages. May be NULL */ - int objc, /* Number of arguments */ - Tcl_Obj *const objv[], /* Argument objects as passed to command. */ - Tcl_Encoding *encPtr, /* Where to store the encoding */ - Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */ - int *profilePtr, /* Bit mask of encoding option profile */ - Tcl_Obj **failVarPtr /* Where to store -failindex option value */ -) + Tcl_Interp *interp, /* For error messages. May be NULL */ + int objc, /* Number of arguments */ + Tcl_Obj *const objv[], /* Argument objects as passed to command. */ + Tcl_Encoding *encPtr, /* Where to store the encoding */ + Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */ + int *profilePtr, /* Bit mask of encoding option profile */ + Tcl_Obj **failVarPtr) /* Where to store -failindex option value */ { static const char *const options[] = {"-profile", "-failindex", NULL}; enum convertfromOptions { PROFILE, FAILINDEX } optIndex; Tcl_Encoding encoding; Tcl_Obj *dataObj; @@ -498,11 +497,11 @@ *profilePtr = profile; *failVarPtr = failVarObj; return TCL_OK; } - + /* *---------------------------------------------------------------------- * * EncodingConvertfromObjCmd -- * @@ -523,11 +522,11 @@ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ - Tcl_Size length = 0; /* Length of the byte array being converted */ + Tcl_Size length = 0; /* Length of the byte array being converted */ const char *bytesPtr; /* Pointer to the first byte of the array */ int flags; int result; Tcl_Obj *failVarObj; Tcl_Size errorLocation; @@ -592,11 +591,10 @@ /* We're done with the encoding */ Tcl_FreeEncoding(encoding); return TCL_OK; - } /* *---------------------------------------------------------------------- * @@ -685,11 +683,10 @@ /* We're done with the encoding */ Tcl_FreeEncoding(encoding); return TCL_OK; - } /* *---------------------------------------------------------------------- * @@ -751,13 +748,13 @@ */ int EncodingNamesObjCmd( TCL_UNUSED(void *), - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Number of command line args */ - Tcl_Obj* const objv[]) /* Vector of command line args */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Number of command line args */ + Tcl_Obj *const objv[]) /* Vector of command line args */ { if (objc > 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } @@ -779,13 +776,13 @@ */ int EncodingProfilesObjCmd( TCL_UNUSED(void *), - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Number of command line args */ - Tcl_Obj* const objv[]) /* Vector of command line args */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Number of command line args */ + Tcl_Obj *const objv[]) /* Vector of command line args */ { if (objc > 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } @@ -810,13 +807,13 @@ */ int EncodingSystemObjCmd( TCL_UNUSED(void *), - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Number of command line args */ - Tcl_Obj* const objv[]) /* Vector of command line args */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Number of command line args */ + Tcl_Obj *const objv[]) /* Vector of command line args */ { if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?encoding?"); return TCL_ERROR; } @@ -2345,32 +2342,32 @@ unsigned short mode; if (varName == NULL) { TclNewObj(result); Tcl_IncrRefCount(result); -#define DOBJPUT(key, objValue) \ - Tcl_DictObjPut(NULL, result, \ - Tcl_NewStringObj((key), -1), \ - (objValue)); - DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev)); - DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino)); - DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink)); - DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid)); - DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid)); - DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size)); +#define DOBJPUT(key, objValue) \ + Tcl_DictObjPut(NULL, result, \ + Tcl_NewStringObj((key), TCL_AUTO_LENGTH), \ + (objValue)); + DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev)); + DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino)); + DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink)); + DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid)); + DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid)); + DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size)); #ifdef HAVE_STRUCT_STAT_ST_BLOCKS - DOBJPUT("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks)); + DOBJPUT("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks)); #endif #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize)); #endif - DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); - DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); - DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); + DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); + DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); + DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); mode = (unsigned short) statPtr->st_mode; - DOBJPUT("mode", Tcl_NewWideIntObj(mode)); - DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); + DOBJPUT("mode", Tcl_NewWideIntObj(mode)); + DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); #undef DOBJPUT Tcl_SetObjResult(interp, result); Tcl_DecrRefCount(result); return TCL_OK; } @@ -2812,11 +2809,11 @@ if (statePtr->vCopyList[i] == NULL) { result = TCL_ERROR; goto done; } result = TclListObjLength(interp, statePtr->vCopyList[i], - &statePtr->varcList[i]); + &statePtr->varcList[i]); if (result != TCL_OK) { result = TCL_ERROR; goto done; } if (statePtr->varcList[i] < 1) { @@ -2828,11 +2825,11 @@ "NEEDVARS", (void *)NULL); result = TCL_ERROR; goto done; } TclListObjGetElements(NULL, statePtr->vCopyList[i], - &statePtr->varcList[i], &statePtr->varvList[i]); + &statePtr->varcList[i], &statePtr->varvList[i]); /* Values */ if (TclObjTypeHasProc(objv[2+i*2],indexProc)) { /* Special case for AbstractList */ statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]); Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -86,17 +86,18 @@ /* * The "sortMode" field of the SortInfo structure can take on any of the * following values. */ - -#define SORTMODE_ASCII 0 -#define SORTMODE_INTEGER 1 -#define SORTMODE_REAL 2 -#define SORTMODE_COMMAND 3 -#define SORTMODE_DICTIONARY 4 -#define SORTMODE_ASCII_NC 8 +enum SortModes { + SORTMODE_ASCII = 0, + SORTMODE_INTEGER = 1, + SORTMODE_REAL = 2, + SORTMODE_COMMAND = 3, + SORTMODE_DICTIONARY = 4, + SORTMODE_ASCII_NC = 8 +}; /* * Definitions for [lseq] command */ static const char *const seq_operations[] = { @@ -1261,11 +1262,11 @@ Tcl_Interp *interp, /* Current interpreter. */ CmdFrame *framePtr) /* Frame to get info for. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *tmpObj; - Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to + Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to * the dict. */ int lc = 0; /* * This array is indexed by the TCL_LOCATION_... values, except * for _LAST. @@ -2212,11 +2213,10 @@ Tcl_Size i; TclNewObj(resObjPtr); for (i = 0; i < listLen; i++) { if (i > 0) { - /* * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT** * to shimmer joinObjPtr. If it did, then the case where * objv[1] and objv[2] are the same value would not be safe. * Accessing elemPtrs would crash. @@ -2424,11 +2424,11 @@ int Tcl_LinsertObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; Tcl_Size len, index; int copied = 0, result; @@ -2517,13 +2517,12 @@ int Tcl_ListObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) - /* The argument objects. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ { /* * If there are no list elements, the result is an empty object. * Otherwise set the interpreter's result object to be a list object. */ @@ -2554,12 +2553,11 @@ int Tcl_LlengthObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) - /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size listLen; int result; Tcl_Obj *objPtr; @@ -2603,12 +2601,11 @@ int Tcl_LpopObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) - /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size listLen; int copied = 0, result; Tcl_Obj *elemPtr, *stored; Tcl_Obj *listPtr; @@ -2723,12 +2720,11 @@ int Tcl_LrangeObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) - /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int result; Tcl_Size listLen, first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); @@ -2935,13 +2931,12 @@ int Tcl_LrepeatObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) - /* The argument objects. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_WideInt elementCount, i; Tcl_Size totalElems; Tcl_Obj *listPtr, **dataArray = NULL; @@ -3216,11 +3211,10 @@ Tcl_IncrRefCount(elemv[i]); } Tcl_SetObjResult(interp, resultObj); } else { - /* * Not shared, so swap "in place". This relies on Tcl_LOGE above * returning a pointer to the live array of Tcl_Obj values. */ @@ -4167,61 +4161,59 @@ * Create a decoding key by looping through the arguments and identify * what kind of argument each one is. Encode each argument as a decimal * digit. */ if (objc > 6) { - /* Too many arguments */ - arg_key=0; + /* Too many arguments */ + arg_key=0; } else for (i=1; icollationKey.objValuePtr; objPtr2 = elemPtr2->collationKey.objValuePtr; paramObjv[0] = objPtr1; paramObjv[1] = objPtr2; @@ -5366,11 +5357,11 @@ int uniLeft = 0, uniRight = 0, uniLeftLower, uniRightLower; int diff, zeros; int secondaryDiff = 0; while (1) { - if (isdigit(UCHAR(*right)) /* INTL: digit */ + if (isdigit(UCHAR(*right)) /* INTL: digit */ && isdigit(UCHAR(*left))) { /* INTL: digit */ /* * There are decimal numbers embedded in the two strings. Compare * them as numbers, rather than strings. If one number has more * leading zeros than the other, the number with more leading Index: generic/tclCmdMZ.c ================================================================== --- generic/tclCmdMZ.c +++ generic/tclCmdMZ.c @@ -724,11 +724,10 @@ * empty. */ numMatches = 0; for ( ; offset <= wlen; ) { - /* * The flags argument is set if string is part of a larger string, so * that "^" won't match. */ @@ -1234,11 +1233,10 @@ objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); } Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } Tcl_DeleteHashTable(&charReuseTable); - } else if (splitCharLen == 1) { const char *p; /* * Handle the special case of splitting on a single character. This is @@ -2405,11 +2403,11 @@ * The following test screens out most empty substrings as candidates for * replacement. When they are detected, no replacement is done, and the * result is the original string. */ - if ((last < 0) || /* Range ends before start of string */ + if ((last < 0) || /* Range ends before start of string */ (first > end) || /* Range begins after end of string */ (last < first)) { /* Range begins after it starts */ /* * BUT!!! when (end < 0) -- an empty original string -- we can * have (first <= end < 0 <= last) and an empty string is permitted Index: generic/tclCompCmds.c ================================================================== --- generic/tclCompCmds.c +++ generic/tclCompCmds.c @@ -197,11 +197,11 @@ * there are multiple values to append. Fortunately, this is common. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - localIndex = LocalScalarFromToken(varTokenPtr, envPtr); + localIndex = TclLocalScalarFromToken(varTokenPtr, envPtr); if (localIndex < 0) { return TCL_ERROR; } /* @@ -377,13 +377,13 @@ */ localIndex = TclFindCompiledLocal(varTokenPtr->start, varTokenPtr->size, 1, envPtr); PushStringLiteral(envPtr, "0"); - TclEmitInstInt4(INST_REVERSE, 2, envPtr); + TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitInstInt4(INST_UPVAR, localIndex, envPtr); - TclEmitOpcode(INST_POP, envPtr); + TclEmitOpcode(INST_POP, envPtr); } /* * Prepare for the internal foreach. */ @@ -605,19 +605,19 @@ resultIndex = optsIndex = -1; cmdTokenPtr = TokenAfter(parsePtr->tokenPtr); if ((int)parsePtr->numWords >= 3) { resultNameTokenPtr = TokenAfter(cmdTokenPtr); /* DGP */ - resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr); + resultIndex = TclLocalScalarFromToken(resultNameTokenPtr, envPtr); if (resultIndex < 0) { return TCL_ERROR; } /* DKF */ if (parsePtr->numWords == 4) { optsNameTokenPtr = TokenAfter(resultNameTokenPtr); - optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr); + optsIndex = TclLocalScalarFromToken(optsNameTokenPtr, envPtr); if (optsIndex < 0) { return TCL_ERROR; } } } @@ -655,11 +655,10 @@ TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_POP, envPtr); } ExceptionRangeEnds(envPtr, range); - /* * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result, * and jump around the "error case" code. */ @@ -676,11 +675,10 @@ TclSetStackDepth(depth + dropScript, envPtr); if (dropScript) { TclEmitOpcode( INST_POP, envPtr); } - /* Stack at this point is empty */ TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); @@ -968,11 +966,11 @@ /* * If the user specified an array element, we don't bother handling * that. */ if (!isScalar) { - return TCL_ERROR; + return TCL_ERROR; } /* * We are doing an assignment to set the value of the constant. This will * need to be extended to push a value for each argument. @@ -1100,11 +1098,11 @@ * compile time; anything else exceeds the complexity of the opcode. So * discover what the index is. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); + dictVarIndex = TclLocalScalarFromToken(varTokenPtr, envPtr); if (dictVarIndex < 0) { return TCL_ERROR; } /* @@ -1183,11 +1181,11 @@ * The dictionary variable must be a local scalar that is knowable at * compile time; anything else exceeds the complexity of the opcode. So * discover what the index is. */ - dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); + dictVarIndex = TclLocalScalarFromToken(varTokenPtr, envPtr); if (dictVarIndex < 0) { return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* @@ -1331,11 +1329,11 @@ * compile time; anything else exceeds the complexity of the opcode. So * discover what the index is. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr); + dictVarIndex = TclLocalScalarFromToken(tokenPtr, envPtr); if (dictVarIndex < 0) { return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* @@ -1658,13 +1656,13 @@ Tcl_Free((void *)argv); return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } nameChars = strlen(argv[0]); - keyVarIndex = LocalScalar(argv[0], nameChars, envPtr); + keyVarIndex = TclLocalScalar(argv[0], nameChars, envPtr); nameChars = strlen(argv[1]); - valueVarIndex = LocalScalar(argv[1], nameChars, envPtr); + valueVarIndex = TclLocalScalar(argv[1], nameChars, envPtr); Tcl_Free((void *)argv); if ((keyVarIndex < 0) || (valueVarIndex < 0)) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } @@ -1858,11 +1856,11 @@ * compile time; anything else exceeds the complexity of the opcode. So * discover what the index is. */ dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr); - dictIndex = LocalScalarFromToken(dictVarTokenPtr, envPtr); + dictIndex = TclLocalScalarFromToken(dictVarTokenPtr, envPtr); if (dictIndex < 0) { goto issueFallback; } /* @@ -1887,11 +1885,11 @@ /* * Stash the index in the auxiliary data (if it is indeed a local * scalar that is resolvable at compile-time). */ - duiPtr->varIndices[i] = LocalScalarFromToken(tokenPtr, envPtr); + duiPtr->varIndices[i] = TclLocalScalarFromToken(tokenPtr, envPtr); if (duiPtr->varIndices[i] == TCL_INDEX_NONE) { goto failedUpdateInfoAssembly; } tokenPtr = TokenAfter(tokenPtr); } @@ -1998,11 +1996,11 @@ /* * Get the index of the local variable that we will be working with. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr); + dictVarIndex = TclLocalScalarFromToken(tokenPtr, envPtr); if (dictVarIndex < 0) { return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr); } /* @@ -2054,11 +2052,11 @@ */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); keyTokenPtr = TokenAfter(varTokenPtr); valueTokenPtr = TokenAfter(keyTokenPtr); - dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); + dictVarIndex = TclLocalScalarFromToken(varTokenPtr, envPtr); if (dictVarIndex < 0) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* @@ -2130,11 +2128,11 @@ /* * Determine if we're manipulating a dict in a simple local variable. */ gotPath = ((int)parsePtr->numWords > 3); - dictVar = LocalScalarFromToken(varTokenPtr, envPtr); + dictVar = TclLocalScalarFromToken(varTokenPtr, envPtr); /* * Special case: an empty body means we definitely have no need to issue * try-finally style code or to allocate local variable table entries for * storing temporaries. Still need to do both INST_DICT_EXPAND and @@ -2849,14 +2847,13 @@ Tcl_Obj *varNameObj; const char *bytes; int varIndex; Tcl_Size length; - Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); bytes = TclGetStringFromObj(varNameObj, &length); - varIndex = LocalScalar(bytes, length, envPtr); + varIndex = TclLocalScalar(bytes, length, envPtr); if (varIndex < 0) { code = TCL_ERROR; goto done; } varListPtr->varIndexes[j] = varIndex; @@ -2967,11 +2964,11 @@ *---------------------------------------------------------------------- */ static void * DupForeachInfo( - void *clientData) /* The foreach command's compilation auxiliary + void *clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { ForeachInfo *srcPtr = (ForeachInfo *)clientData; ForeachInfo *dupPtr; ForeachVarList *srcListPtr, *dupListPtr; @@ -3016,11 +3013,11 @@ *---------------------------------------------------------------------- */ static void FreeForeachInfo( - void *clientData) /* The foreach command's compilation auxiliary + void *clientData) /* The foreach command's compilation auxiliary * data to free. */ { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *listPtr; size_t i, numLists = infoPtr->numLists; @@ -3350,11 +3347,11 @@ j = 2; /* The index into the argument tokens, for * TIP#280 handling. */ start = TclGetString(formatObj); /* The start of the currently-scanned literal * in the format string. */ - TclNewObj(tmpObj); /* The buffer used to accumulate the literal + TclNewObj(tmpObj); /* The buffer used to accumulate the literal * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { Tcl_AppendToObj(tmpObj, start, bytes - start); if (*++bytes == '%') { @@ -3452,11 +3449,11 @@ size_t numBytes, CompileEnv *envPtr) { Tcl_Token token[2] = { {TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, - {TCL_TOKEN_TEXT, NULL, 0, 0} + {TCL_TOKEN_TEXT, NULL, 0, 0} }; token[1].start = bytes; token[1].size = numBytes; return TclLocalScalarFromToken(token, envPtr); @@ -3600,38 +3597,38 @@ elName = p + 1; remainingLen = (varTokenPtr[2].start - p) - 1; elNameLen = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1; if (!(flags & TCL_NO_ELEMENT)) { - if (remainingLen) { - /* - * Make a first token with the extra characters in the first - * token. - */ - - elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token)); - allocedTokens = 1; - elemTokenPtr->type = TCL_TOKEN_TEXT; - elemTokenPtr->start = elName; - elemTokenPtr->size = remainingLen; - elemTokenPtr->numComponents = 0; - elemTokenCount = n; - - /* - * Copy the remaining tokens. - */ - - memcpy(elemTokenPtr+1, varTokenPtr+2, - (n-1) * sizeof(Tcl_Token)); - } else { - /* - * Use the already available tokens. - */ - - elemTokenPtr = &varTokenPtr[2]; - elemTokenCount = n - 1; - } + if (remainingLen) { + /* + * Make a first token with the extra characters in the first + * token. + */ + + elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token)); + allocedTokens = 1; + elemTokenPtr->type = TCL_TOKEN_TEXT; + elemTokenPtr->start = elName; + elemTokenPtr->size = remainingLen; + elemTokenPtr->numComponents = 0; + elemTokenCount = n; + + /* + * Copy the remaining tokens. + */ + + memcpy(elemTokenPtr+1, varTokenPtr+2, + (n-1) * sizeof(Tcl_Token)); + } else { + /* + * Use the already available tokens. + */ + + elemTokenPtr = &varTokenPtr[2]; + elemTokenCount = n - 1; + } } } } if (simpleVarName) { Index: generic/tclCompCmdsGR.c ================================================================== --- generic/tclCompCmdsGR.c +++ generic/tclCompCmdsGR.c @@ -521,11 +521,11 @@ /* * Emit the instruction to increment the variable. */ - if (isScalar) { /* Simple scalar variable. */ + if (isScalar) { /* Simple scalar variable. */ if (localIndex >= 0) { if (haveImmValue) { TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr); TclEmitInt1(immValue, envPtr); } else { @@ -1833,11 +1833,11 @@ for (i=2; i end) */ - /* * Tricky to determine when runtime (last < first) can be * certainly known based on the encoded values. Consider the * cases... * @@ -1106,11 +1104,11 @@ * (first <= TCL_INDEX_END) && * (last <= TCL_INDEX END) && (last < first) => ACCEPT * else => cannot tell REJECT */ || ((first <= (int)TCL_INDEX_END) && (last <= (int)TCL_INDEX_END) - && (last < first)) /* Know (last < first) */ + && (last < first)) /* Know (last < first) */ /* * (first == TCL_INDEX_NONE) && * (last <= TCL_INDEX_END) => cannot tell REJECT * else => (first < last) REJECT * @@ -1117,11 +1115,11 @@ * else [[first >= TCL_INDEX_START]] && * (last <= TCL_INDEX_END) => cannot tell REJECT * else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT */ || ((first >= (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START) - && (last < first))) { /* Know (last < first) */ + && (last < first))) { /* Know (last < first) */ if (parsePtr->numWords == 5) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 4); OP( POP); /* Pop newString */ } @@ -1128,70 +1126,70 @@ /* Original string argument now on TOS as result */ return TCL_OK; } if (parsePtr->numWords == 5) { - /* - * When we have a string replacement, we have to take care about - * not replacing empty substrings that [string replace] promises - * not to replace - * - * The remaining index values might be suitable for conventional - * string replacement, but only if they cannot possibly meet the - * conditions described above at runtime. If there's a chance they - * might, we would have to emit bytecode to check and at that point - * we're paying more in bytecode execution time than would make - * things worthwhile. Trouble is we are very limited in - * how much we can detect that at compile time. After decoding, - * we need, first: - * - * (first <= end) - * - * The encoded indices (first <= TCL_INDEX END) and - * (first == TCL_INDEX_NONE) always meets this condition, but - * any other encoded first index has some list for which it fails. - * - * We also need, second: - * - * (last >= 0) - * - * The encoded index (last >= TCL_INDEX_START) always meet this - * condition but any other encoded last index has some list for - * which it fails. - * - * Finally we need, third: - * - * (first <= last) - * - * Considered in combination with the constraints we already have, - * we see that we can proceed when (first == TCL_INDEX_NONE). - * These also permit simplification of the prefix|replace|suffix - * construction. The other constraints, though, interfere with - * getting a guarantee that first <= last. - */ - - if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) { - /* empty prefix */ - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 4); - OP4( REVERSE, 2); - if (last == INT_MAX) { - OP( POP); /* Pop original */ - } else { - OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END); - OP1( STR_CONCAT1, 2); - } - return TCL_OK; - } - - if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) { - OP44( STR_RANGE_IMM, 0, first-1); - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 4); - OP1( STR_CONCAT1, 2); - return TCL_OK; - } + /* + * When we have a string replacement, we have to take care about + * not replacing empty substrings that [string replace] promises + * not to replace + * + * The remaining index values might be suitable for conventional + * string replacement, but only if they cannot possibly meet the + * conditions described above at runtime. If there's a chance they + * might, we would have to emit bytecode to check and at that point + * we're paying more in bytecode execution time than would make + * things worthwhile. Trouble is we are very limited in + * how much we can detect that at compile time. After decoding, + * we need, first: + * + * (first <= end) + * + * The encoded indices (first <= TCL_INDEX END) and + * (first == TCL_INDEX_NONE) always meets this condition, but + * any other encoded first index has some list for which it fails. + * + * We also need, second: + * + * (last >= 0) + * + * The encoded index (last >= TCL_INDEX_START) always meet this + * condition but any other encoded last index has some list for + * which it fails. + * + * Finally we need, third: + * + * (first <= last) + * + * Considered in combination with the constraints we already have, + * we see that we can proceed when (first == TCL_INDEX_NONE). + * These also permit simplification of the prefix|replace|suffix + * construction. The other constraints, though, interfere with + * getting a guarantee that first <= last. + */ + + if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) { + /* empty prefix */ + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 4); + OP4( REVERSE, 2); + if (last == INT_MAX) { + OP( POP); /* Pop original */ + } else { + OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END); + OP1( STR_CONCAT1, 2); + } + return TCL_OK; + } + + if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) { + OP44( STR_RANGE_IMM, 0, first-1); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 4); + OP1( STR_CONCAT1, 2); + return TCL_OK; + } /* FLOW THROUGH TO genericReplace */ } else { /* @@ -1204,11 +1202,11 @@ /* empty prefix - build suffix only */ if (last == (int)TCL_INDEX_END) { /* empty suffix too => empty result */ OP( POP); /* Pop original */ - PUSH ( ""); + PUSH( ""); return TCL_OK; } OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END); return TCL_OK; } else { @@ -1224,23 +1222,23 @@ OP1( STR_CONCAT1, 2); return TCL_OK; } } - genericReplace: - tokenPtr = TokenAfter(valueTokenPtr); - CompileWord(envPtr, tokenPtr, interp, 2); - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 3); - if (parsePtr->numWords == 5) { - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 4); - } else { - PUSH( ""); - } - OP( STR_REPLACE); - return TCL_OK; + genericReplace: + tokenPtr = TokenAfter(valueTokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 3); + if (parsePtr->numWords == 5) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 4); + } else { + PUSH( ""); + } + OP( STR_REPLACE); + return TCL_OK; } int TclCompileStringTrimLCmd( Tcl_Interp *interp, /* Used for error reporting. */ @@ -1480,15 +1478,16 @@ toSubst = objv[numOpts]; Tcl_IncrRefCount(toSubst); } */ - /* TODO: Figure out expansion to cover WordKnownAtCompileTime - * The difficulty is that WKACT makes a copy, and if TclSubstParse - * below parses the copy of the original source string, some deep - * parts of the compile machinery get upset. They want all pointers - * stored in Tcl_Tokens to point back to the same original string. + /* + * TODO: Figure out expansion to cover WordKnownAtCompileTime + * The difficulty is that WKACT makes a copy, and if TclSubstParse + * below parses the copy of the original source string, some deep + * parts of the compile machinery get upset. They want all pointers + * stored in Tcl_Tokens to point back to the same original string. */ if (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { code = TclSubstOptions(NULL, numOpts, objv, &flags); } @@ -1503,11 +1502,11 @@ SetLineInformation(numArgs); TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size, flags, mapPtr->loc[eclIndex].line[numArgs], envPtr); -/* TclDecrRefCount(toSubst);*/ + // TclDecrRefCount(toSubst); return TCL_OK; } void TclSubstCompile( @@ -2114,11 +2113,11 @@ int noCase, /* Case-insensitivity flag. */ Tcl_Size numBodyTokens, /* Number of tokens describing things the * switch can match against and bodies to * execute when the match succeeds. */ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */ - Tcl_Size *bodyLines, /* Array of line numbers for body list + Tcl_Size *bodyLines, /* Array of line numbers for body list * items. */ Tcl_Size **bodyContLines) /* Array of continuation line info. */ { enum {Switch_Exact, Switch_Glob, Switch_Regexp}; int foundDefault; /* Flag to indicate whether a "default" clause @@ -2362,11 +2361,11 @@ CompileEnv *envPtr, /* Holds resulting instructions. */ int numBodyTokens, /* Number of tokens describing things the * switch can match against and bodies to * execute when the match succeeds. */ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */ - Tcl_Size *bodyLines, /* Array of line numbers for body list + Tcl_Size *bodyLines, /* Array of line numbers for body list * items. */ Tcl_Size **bodyContLines) /* Array of continuation line info. */ { JumptableInfo *jtPtr; int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation; @@ -2919,11 +2918,11 @@ } if (objc > 0) { Tcl_Size len; const char *varname = TclGetStringFromObj(objv[0], &len); - resultVarIndices[i] = LocalScalar(varname, len, envPtr); + resultVarIndices[i] = TclLocalScalar(varname, len, envPtr); if (resultVarIndices[i] < 0) { TclDecrRefCount(tmpObj); goto failedToCompile; } } else { @@ -2931,11 +2930,11 @@ } if (objc == 2) { Tcl_Size len; const char *varname = TclGetStringFromObj(objv[1], &len); - optionVarIndices[i] = LocalScalar(varname, len, envPtr); + optionVarIndices[i] = TclLocalScalar(varname, len, envPtr); if (optionVarIndices[i] < 0) { TclDecrRefCount(tmpObj); goto failedToCompile; } } else { Index: generic/tclCompExpr.c ================================================================== --- generic/tclCompExpr.c +++ generic/tclCompExpr.c @@ -131,68 +131,63 @@ * which of the other three categories is correct, or for lexemes like * INVALID, which aren't really lexemes at all, but indicators of a parsing * error. Note that the codes must be distinct to distinguish categories, but * need not take the form of a bit array. */ - -#define BINARY 0x40 /* This lexeme is a binary operator. An OpNode +enum NodeCategories { + BINARY = 0x40, /* This lexeme is a binary operator. An OpNode * representing it should go into the parse * tree, and two operands should be parsed for * it in the expression. */ -#define UNARY 0x80 /* This lexeme is a unary operator. An OpNode + UNARY = 0x80, /* This lexeme is a unary operator. An OpNode * representing it should go into the parse * tree, and one operand should be parsed for * it in the expression. */ -#define LEAF 0xC0 /* This lexeme is a leaf operand in the parse + LEAF = 0xC0 /* This lexeme is a leaf operand in the parse * tree. No OpNode will be placed in the tree * for it. Either a literal value will be * appended to the list of literals in this * expression, or appropriate Tcl_Tokens will * be appended in a Tcl_Parse struct to * represent those leaves that require some * form of substitution. */ +}; -/* Uncategorized lexemes */ +enum TclLexemes { + /* Uncategorized lexemes */ -#define PLUS 1 /* Ambiguous. Resolves to UNARY_PLUS or + PLUS = 1, /* Ambiguous. Resolves to UNARY_PLUS or * BINARY_PLUS according to context. */ -#define MINUS 2 /* Ambiguous. Resolves to UNARY_MINUS or + MINUS = 2, /* Ambiguous. Resolves to UNARY_MINUS or * BINARY_MINUS according to context. */ -#define BAREWORD 3 /* Ambiguous. Resolves to BOOLEAN or to + BAREWORD = 3, /* Ambiguous. Resolves to BOOLWORD or to * FUNCTION or a parse error according to * context and value. */ -#define INCOMPLETE 4 /* A parse error. Used only when the single + INCOMPLETE = 4, /* A parse error. Used only when the single * "=" is encountered. */ -#define INVALID 5 /* A parse error. Used when any punctuation + INVALID = 5, /* A parse error. Used when any punctuation * appears that's not a supported operator. */ -#define COMMENT 6 /* Comment. Lasts to end of line or end of + COMMENT = 6, /* Comment. Lasts to end of line or end of * expression, whichever comes first. */ -/* Leaf lexemes */ - -#define NUMBER (LEAF | 1) - /* For literal numbers */ -#define SCRIPT (LEAF | 2) - /* Script substitution; [foo] */ -#define BOOLEAN (LEAF | BAREWORD) - /* For literal booleans */ -#define BRACED (LEAF | 4) - /* Braced string; {foo bar} */ -#define VARIABLE (LEAF | 5) - /* Variable substitution; $x */ -#define QUOTED (LEAF | 6) - /* Quoted string; "foo $bar [soom]" */ -#define EMPTY (LEAF | 7) - /* Used only for an empty argument list to a + /* Leaf lexemes */ + + NUMBER = (LEAF | 1), /* For literal numbers */ + SCRIPT = (LEAF | 2), /* Script substitution; [foo] */ + BOOLWORD = (LEAF | BAREWORD),/* For literal booleans (false, true, etc.) */ + BRACED = (LEAF | 4), /* Braced string; {foo bar} */ + VARIABLE = (LEAF | 5), /* Variable substitution; $x */ + QUOTED = (LEAF | 6), /* Quoted string; "foo $bar [soom]" */ + EMPTY = (LEAF | 7), /* Used only for an empty argument list to a * function. Represents the empty string * within parens in the expression: rand() */ -/* Unary operator lexemes */ + /* Unary operator lexemes */ -#define UNARY_PLUS (UNARY | PLUS) -#define UNARY_MINUS (UNARY | MINUS) -#define FUNCTION (UNARY | BAREWORD) + UNARY_PLUS = (UNARY | PLUS), + UNARY_MINUS = (UNARY | MINUS), + FUNCTION = (UNARY | BAREWORD), /* This is a bit of "creative interpretation" * on the part of the parser. A function call * is parsed into the parse tree according to * the perspective that the function name is a * unary operator and its argument list, @@ -204,73 +199,66 @@ * coded in the relevant portions of * ParseExpr(). We trade off the need to * include such exceptional handling in the * code against the need we would otherwise * have for more lexeme categories. */ -#define START (UNARY | 4) - /* This lexeme isn't parsed from the + START = (UNARY | 4), /* This lexeme isn't parsed from the * expression text at all. It represents the * start of the expression and sits at the * root of the parse tree where it serves as * the start/end point of traversals. */ -#define OPEN_PAREN (UNARY | 5) - /* Another bit of creative interpretation, + OPEN_PAREN = (UNARY | 5), /* Another bit of creative interpretation, * where we treat "(" as a unary operator with * the sub-expression between it and its * matching ")" as its operand. See * CLOSE_PAREN below. */ -#define NOT (UNARY | 6) -#define BIT_NOT (UNARY | 7) - -/* Binary operator lexemes */ - -#define BINARY_PLUS (BINARY | PLUS) -#define BINARY_MINUS (BINARY | MINUS) -#define COMMA (BINARY | 3) - /* The "," operator is a low precedence binary + NOT = (UNARY | 6), + BIT_NOT = (UNARY | 7), + + /* Binary operator lexemes */ + + BINARY_PLUS = (BINARY | PLUS), + BINARY_MINUS = (BINARY | MINUS), + COMMA = (BINARY | 3), /* The "," operator is a low precedence binary * operator that separates the arguments in a * function call. The additional constraint * that this operator can only legally appear * at the right places within a function call * argument list are hard coded within - * ParseExpr(). */ -#define MULT (BINARY | 4) -#define DIVIDE (BINARY | 5) -#define MOD (BINARY | 6) -#define LESS (BINARY | 7) -#define GREATER (BINARY | 8) -#define BIT_AND (BINARY | 9) -#define BIT_XOR (BINARY | 10) -#define BIT_OR (BINARY | 11) -#define QUESTION (BINARY | 12) - /* These two lexemes make up the */ -#define COLON (BINARY | 13) - /* ternary conditional operator, $x ? $y : $z. + * ParseExpr(). */ + MULT = (BINARY | 4), + DIVIDE = (BINARY | 5), + MOD = (BINARY | 6), + LESS = (BINARY | 7), + GREATER = (BINARY | 8), + BIT_AND = (BINARY | 9), + BIT_XOR = (BINARY | 10), + BIT_OR = (BINARY | 11), + QUESTION = (BINARY | 12), /* These two lexemes make up the */ + COLON = (BINARY | 13), /* ternary conditional operator, $x ? $y : $z. * We treat them as two binary operators to * avoid another lexeme category, and code the * additional constraints directly in * ParseExpr(). For instance, the right * operand of a "?" operator must be a ":" * operator. */ -#define LEFT_SHIFT (BINARY | 14) -#define RIGHT_SHIFT (BINARY | 15) -#define LEQ (BINARY | 16) -#define GEQ (BINARY | 17) -#define EQUAL (BINARY | 18) -#define NEQ (BINARY | 19) -#define AND (BINARY | 20) -#define OR (BINARY | 21) -#define STREQ (BINARY | 22) -#define STRNEQ (BINARY | 23) -#define EXPON (BINARY | 24) - /* Unlike the other binary operators, EXPON is + LEFT_SHIFT = (BINARY | 14), + RIGHT_SHIFT = (BINARY | 15), + LEQ = (BINARY | 16), + GEQ = (BINARY | 17), + EQUAL = (BINARY | 18), + NEQ = (BINARY | 19), + AND = (BINARY | 20), + OR = (BINARY | 21), + STREQ = (BINARY | 22), + STRNEQ = (BINARY | 23), + EXPON = (BINARY | 24), /* Unlike the other binary operators, EXPON is * right associative and this distinction is * coded directly in ParseExpr(). */ -#define IN_LIST (BINARY | 25) -#define NOT_IN_LIST (BINARY | 26) -#define CLOSE_PAREN (BINARY | 27) - /* By categorizing the CLOSE_PAREN lexeme as a + IN_LIST = (BINARY | 25), + NOT_IN_LIST = (BINARY | 26), + CLOSE_PAREN = (BINARY | 27),/* By categorizing the CLOSE_PAREN lexeme as a * BINARY operator, the normal parsing rules * for binary operators assure that a close * paren will not directly follow another * operator, and the machinery already in * place to connect operands to operators @@ -281,21 +269,21 @@ * special coding in ParseExpr() make sure we * never put an actual CLOSE_PAREN node in the * parse tree. The sub-expression between * parens becomes the single argument of the * matching OPEN_PAREN unary operator. */ -#define STR_LT (BINARY | 28) -#define STR_GT (BINARY | 29) -#define STR_LEQ (BINARY | 30) -#define STR_GEQ (BINARY | 31) -#define END (BINARY | 32) - /* This lexeme represents the end of the + STR_LT = (BINARY | 28), + STR_GT = (BINARY | 29), + STR_LEQ = (BINARY | 30), + STR_GEQ = (BINARY | 31), + END = (BINARY | 32) /* This lexeme represents the end of the * string being parsed. Treating it as a * binary operator follows the same logic as * the CLOSE_PAREN lexeme and END pairs with * START, in the same way that CLOSE_PAREN * pairs with OPEN_PAREN. */ +}; /* * When ParseExpr() builds the parse tree it must choose which operands to * connect to which operators. This is done according to operator precedence. * The greater an operator's precedence the greater claim it has to link to an @@ -745,11 +733,11 @@ * names we've parsed in the order we found them. */ Tcl_ListObjAppendElement(NULL, funcList, literal); } else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) { - lexeme = BOOLEAN; + lexeme = BOOLWORD; } else { /* * Tricky case: see test expr-62.10 */ @@ -871,19 +859,19 @@ /* * Free any literal to avoid a memleak. */ - if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) { + if ((lexeme == NUMBER) || (lexeme == BOOLWORD)) { Tcl_DecrRefCount(literal); } goto error; } switch (lexeme) { case NUMBER: - case BOOLEAN: + case BOOLWORD: /* * TODO: Consider using a dict or hash to collapse all * duplicate literals into a single representative value. * (Like what is done with [split $s {}]). * Pro: ~75% memory saving on expressions like @@ -1054,11 +1042,10 @@ complete = lastParsed = OT_TOKENS; break; } /* case LEAF */ case UNARY: - /* * A unary operator appearing just after something that's not an * operator is a syntax error -- something trying to be the left * operand of an operator that doesn't take one. */ @@ -1537,16 +1524,14 @@ * Handle next child node or leaf. */ switch (next) { case OT_EMPTY: - /* No tokens and no characters for the OT_EMPTY leaf. */ break; case OT_LITERAL: - /* * Skip any white space that comes before the literal. */ scanned = TclParseAllWhiteSpace(start, numBytes); @@ -1628,11 +1613,10 @@ tokenPtr += toCopy; break; } default: - /* * Advance to the child node, which is an operator. */ nodePtr = nodes + next; @@ -1651,20 +1635,18 @@ switch (nodePtr->lexeme) { case OPEN_PAREN: case COMMA: case COLON: - /* * Historical practice has been to have no Tcl_Tokens for * these operators. */ break; - default: { - + default: /* * Remember the index of the last subexpression we were * working on -- that of our parent. We'll stack it later. */ @@ -1698,11 +1680,10 @@ * stack of subexpressions we have pending. */ subExprTokenPtr[1].numComponents = parentIdx; break; - } } break; } /* Determine which way to exit the node on this pass. */ @@ -1759,22 +1740,19 @@ break; case MARK_PARENT: switch (nodePtr->lexeme) { case START: - /* When we get back to the START node, we're done. */ return; case COMMA: case COLON: - /* No tokens for these lexemes -> nothing to do. */ break; case OPEN_PAREN: - /* * Skip past matching close paren. */ scanned = TclParseAllWhiteSpace(start, numBytes); @@ -1867,12 +1845,12 @@ * the parsed expression; any previous * information in the structure is ignored. */ { int code; OpNode *opTree = NULL; /* Will point to the tree of operators. */ - Tcl_Obj *litList; /* List to hold the literals. */ - Tcl_Obj *funcList; /* List to hold the functon names. */ + Tcl_Obj *litList; /* List to hold the literals. */ + Tcl_Obj *funcList; /* List to hold the functon names. */ Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */ TclNewObj(litList); TclNewObj(funcList); @@ -2089,11 +2067,10 @@ TclNewObj(literal); if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end, TCL_PARSE_NO_WHITESPACE) == TCL_OK) { if (end < start + numBytes && !TclIsBareword(*end)) { - number: *lexemePtr = NUMBER; if (literalPtr) { TclInitStringRep(literal, start, end-start); *literalPtr = literal; @@ -2681,13 +2658,14 @@ if (objc < 3) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); } else { TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; - Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp, - 2 * (objc-2) * sizeof(Tcl_Obj *)); - OpNode *nodes = (OpNode *)TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode)); + Tcl_Obj **litObjv = (Tcl_Obj **) + TclStackAlloc(interp, 2 * (objc-2) * sizeof(Tcl_Obj *)); + OpNode *nodes = (OpNode *) + TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode)); unsigned char lexeme; int i, lastAnd = 1; Tcl_Obj *const *litObjPtrPtr = litObjv; ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL); Index: generic/tclCompile.c ================================================================== --- generic/tclCompile.c +++ generic/tclCompile.c @@ -679,11 +679,11 @@ * Prototypes for procedures defined later in this file: */ static void CleanupByteCode(ByteCode *codePtr); static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - int flags); + unsigned long flags); static void DupByteCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr); static void EnterCmdExtentData(CompileEnv *envPtr, @@ -738,18 +738,24 @@ DupByteCodeInternalRep, /* dupIntRepProc - shared with bytecode */ NULL, /* updateStringProc */ NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; -#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2 +#define SubstFlags(objPtr) \ + ((objPtr)->internalRep.ptrAndLongRep.value) /* - * Helper macros. + * Add a delta to an unsigned value stored at a particular address. + * No alignment is assumed. */ - -#define TclIncrUInt4AtPtr(ptr, delta) \ - TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr)) +static inline void +TclIncrUInt4AtPtr( + unsigned char *ptr, + int delta) +{ + TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr) + delta, ptr); +} /* *---------------------------------------------------------------------- * * TclSetByteCodeFromAny -- @@ -777,11 +783,11 @@ TclSetByteCodeFromAny( Tcl_Interp *interp, /* The interpreter for which the code is being * compiled. Must not be NULL. */ Tcl_Obj *objPtr, /* The object to make a ByteCode object. */ CompileHookProc *hookProc, /* Procedure to invoke after compilation. */ - void *clientData) /* Hook procedure private data. */ + void *clientData) /* Hook procedure private data. */ { Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ Tcl_Size length; @@ -994,11 +1000,11 @@ *---------------------------------------------------------------------- */ static void FreeByteCodeInternalRep( - Tcl_Obj *objPtr) /* Object whose internal rep to free. */ + Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr); assert(codePtr != NULL); @@ -1044,11 +1050,11 @@ CleanupByteCode(codePtr); } static void CleanupByteCode( - ByteCode *codePtr) /* Points to the ByteCode to free. */ + ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; Interp *iPtr = (Interp *) interp; int numLitObjects = codePtr->numLitObjects; int numAuxDataItems = codePtr->numAuxDataItems; @@ -1113,11 +1119,10 @@ * anyway, avoid the extra cost of updating it for each literal being * released. */ if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { - objArrayPtr = codePtr->objArrayPtr; for (i = 0; i < numLitObjects; i++) { objPtr = *objArrayPtr; if (objPtr) { Tcl_DecrRefCount(objPtr); @@ -1323,21 +1328,21 @@ static ByteCode * CompileSubstObj( Tcl_Interp *interp, Tcl_Obj *objPtr, - int flags) + unsigned long flags) { Interp *iPtr = (Interp *) interp; ByteCode *codePtr = NULL; ByteCodeGetInternalRep(objPtr, &substCodeType, codePtr); if (codePtr != NULL) { Namespace *nsPtr = iPtr->varFramePtr->nsPtr; - if (flags != PTR2INT(SubstFlags(objPtr)) + if (flags != SubstFlags(objPtr) || ((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != nsPtr) || (codePtr->nsEpoch != nsPtr->resolverEpoch) || (codePtr->localCachePtr != @@ -1358,11 +1363,11 @@ TclEmitOpcode(INST_DONE, &compEnv); codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv); TclFreeCompileEnv(&compEnv); - SubstFlags(objPtr) = INT2PTR(flags); + SubstFlags(objPtr) = flags; if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; } #ifdef TCL_COMPILE_DEBUG @@ -1395,11 +1400,11 @@ *---------------------------------------------------------------------- */ static void FreeSubstCodeInternalRep( - Tcl_Obj *objPtr) /* Object whose internal rep to free. */ + Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; ByteCodeGetInternalRep(objPtr, &substCodeType, codePtr); assert(codePtr != NULL); @@ -1446,11 +1451,11 @@ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ - CompileEnv *envPtr,/* Points to the CompileEnv structure to + CompileEnv *envPtr, /* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ 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 @@ -2218,12 +2223,12 @@ do { const char *next; if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) { /* - * Compile bytecodes to report the parsePtr error at runtime. - */ + * Compile bytecodes to report the parsePtr error at runtime. + */ Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, parsePtr->term + 1 - parsePtr->commandStart); TclCompileSyntaxError(interp, envPtr); Tcl_Free(parsePtr); @@ -2647,11 +2652,11 @@ void TclCompileCmdWord( Tcl_Interp *interp, /* Used for error and status reporting. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens for * a command word to compile inline. */ - size_t count1, /* Number of tokens to consider at tokenPtr. + size_t count1, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { int count = count1; @@ -2987,11 +2992,11 @@ TclInitByteCodeObj( Tcl_Obj *objPtr, /* Points object that should be initialized, * and whose string rep contains the source * code. */ const Tcl_ObjType *typePtr, - CompileEnv *envPtr)/* Points to the CompileEnv structure from + CompileEnv *envPtr) /* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { ByteCode *codePtr; PreventCycle(objPtr, envPtr); @@ -3032,11 +3037,11 @@ *---------------------------------------------------------------------- */ Tcl_Size TclFindCompiledLocal( - const char *name, /* Points to first character of the name of a + const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ Tcl_Size nameBytes, /* Number of bytes in the name. */ int create, /* If 1, allocate a local frame entry for the * variable if it is new. */ @@ -3211,11 +3216,11 @@ * structure in which to enter command * location information. */ Tcl_Size cmdIndex, /* Index of the command whose start data is * being set. */ Tcl_Size srcOffset, /* Offset of first char of the command. */ - Tcl_Size codeOffset) /* Offset of first byte of command code. */ + Tcl_Size codeOffset) /* Offset of first byte of command code. */ { CmdLocation *cmdLocPtr; if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) { Tcl_Panic("EnterCmdStartData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex); @@ -3289,12 +3294,12 @@ CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ Tcl_Size cmdIndex, /* Index of the command whose source and code * length data is being set. */ - Tcl_Size numSrcBytes, /* Number of command source chars. */ - Tcl_Size numCodeBytes) /* Offset of last byte of command code. */ + Tcl_Size numSrcBytes, /* Number of command source chars. */ + Tcl_Size numCodeBytes) /* Offset of last byte of command code. */ { CmdLocation *cmdLocPtr; if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) { Tcl_Panic("EnterCmdExtentData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex); @@ -3413,11 +3418,11 @@ */ Tcl_Size TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ - CompileEnv *envPtr)/* Points to CompileEnv for which to create a + CompileEnv *envPtr) /* Points to CompileEnv for which to create a * new ExceptionRange structure. */ { ExceptionRange *rangePtr; ExceptionAux *auxPtr; Tcl_Size index = envPtr->exceptArrayNext; @@ -3511,11 +3516,10 @@ if (CurrentOffset(envPtr) >= (int)rangePtr->codeOffset && (rangePtr->numCodeBytes == TCL_INDEX_NONE || CurrentOffset(envPtr) < (int)rangePtr->codeOffset+(int)rangePtr->numCodeBytes) && (returnCode != TCL_CONTINUE || envPtr->exceptAuxArrayPtr[i].supportsContinue)) { - if (auxPtrPtr) { *auxPtrPtr = envPtr->exceptAuxArrayPtr + i; } return rangePtr; } @@ -3773,15 +3777,15 @@ *---------------------------------------------------------------------- */ Tcl_Size TclCreateAuxData( - void *clientData, /* The compilation auxiliary data to store in + void *clientData, /* The compilation auxiliary data to store in * the new aux data record. */ const AuxDataType *typePtr, /* Pointer to the type to attach to this * AuxData */ - CompileEnv *envPtr)/* Points to the CompileEnv for which a new + CompileEnv *envPtr) /* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { Tcl_Size index; /* Index for the new AuxData structure. */ AuxData *auxDataPtr; /* Points to the new AuxData structure */ Index: generic/tclCompile.h ================================================================== --- generic/tclCompile.h +++ generic/tclCompile.h @@ -13,11 +13,14 @@ #ifndef _TCLCOMPILATION #define _TCLCOMPILATION 1 #include "tclInt.h" -struct ByteCode; /* Forward declaration. */ +/* Forward declarations. */ + +struct ByteCode; +static inline unsigned TclGetUInt4AtPtr(const unsigned char *p); /* *------------------------------------------------------------------------ * Variables related to compilation. These are used in tclCompile.c, * tclExecute.c, tclBasic.c, and their clients. @@ -76,35 +79,35 @@ * for the "next" subcommands of for loops since a break there terminates the * for command. This means a for command actually generates two LoopInfo * structures. */ -typedef enum { +typedef enum ExceptionRangeType { LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop. Break * and continue "exceptions" cause jumps to * appropriate PC offsets. */ CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a catch * command. Errors in the range cause a jump * to a catch PC offset. */ } ExceptionRangeType; -typedef struct { +typedef struct ExceptionRange { ExceptionRangeType type; /* The kind of ExceptionRange. */ - Tcl_Size nestingLevel; /* Static depth of the exception range. Used + Tcl_Size nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range * surrounding a PC at runtime. */ - Tcl_Size codeOffset; /* Offset of the first instruction byte of the + Tcl_Size codeOffset; /* Offset of the first instruction byte of the * code range. */ - Tcl_Size numCodeBytes; /* Number of bytes in the code range. */ - Tcl_Size breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC + Tcl_Size numCodeBytes; /* Number of bytes in the code range. */ + Tcl_Size breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC * offset for a break command in the range. */ - Tcl_Size continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, the + Tcl_Size continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, the * target PC offset for a continue command in * the code range. Otherwise, ignore this * range when processing a continue * command. */ - Tcl_Size catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC + Tcl_Size catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC * offset for any "exception" in range. */ } ExceptionRange; /* * Auxiliary data used when issuing (currently just loop) exception ranges, @@ -116,15 +119,15 @@ * continueOffset created for it; if it is a * loop exception range that *doesn't* have * one (see [for] next-clause) then we must * not pick up the range when scanning for a * target to continue to. */ - Tcl_Size stackDepth; /* The stack depth at the point where the + Tcl_Size stackDepth; /* The stack depth at the point where the * exception range was created. This is used * to calculate the number of POPs required to * restore the stack to its prior state. */ - Tcl_Size expandTarget; /* The number of expansions expected on the + Tcl_Size expandTarget; /* The number of expansions expected on the * auxData stack at the time the loop starts; * we can't currently discard them except by * doing INST_INVOKE_EXPANDED; this is a known * problem. */ Tcl_Size expandTargetDepth; /* The stack depth expected at the outermost @@ -133,27 +136,28 @@ * looping level and the point of jump * issue. */ Tcl_Size numBreakTargets; /* The number of [break]s that want to be * targeted to the place where this loop * exception will be bound to. */ - TCL_HASH_TYPE *breakTargets; /* The offsets of the INST_JUMP4 instructions + TCL_HASH_TYPE *breakTargets;/* The offsets of the INST_JUMP4 instructions * issued by the [break]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numBreakTargets==0, this is NULL. */ Tcl_Size allocBreakTargets; /* The size of the breakTargets array. */ - Tcl_Size numContinueTargets; /* The number of [continue]s that want to be + Tcl_Size numContinueTargets;/* The number of [continue]s that want to be * targeted to the place where this loop * exception will be bound to. */ TCL_HASH_TYPE *continueTargets; /* The offsets of the INST_JUMP4 instructions * issued by the [continue]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numContinueTargets==0, this is NULL. */ - Tcl_Size allocContinueTargets; /* The size of the continueTargets array. */ + Tcl_Size allocContinueTargets; + /* The size of the continueTargets array. */ } ExceptionAux; /* * Structure used to map between instruction pc and source locations. It * defines for each compiled Tcl command its code's starting offset and its @@ -160,15 +164,15 @@ * source's starting offset and length. Note that the code offset increases * monotonically: that is, the table is sorted in code offset order. The * source offset is not monotonic. */ -typedef struct { - Tcl_Size codeOffset; /* Offset of first byte of command code. */ - Tcl_Size numCodeBytes; /* Number of bytes for command's code. */ +typedef struct CmdLocation { + Tcl_Size codeOffset; /* Offset of first byte of command code. */ + Tcl_Size numCodeBytes; /* Number of bytes for command's code. */ Tcl_Size srcOffset; /* Offset of first char of the command. */ - Tcl_Size numSrcBytes; /* Number of command source chars. */ + Tcl_Size numSrcBytes; /* Number of command source chars. */ } CmdLocation; /* * TIP #280 * Structure to record additional location information for byte code. This @@ -178,30 +182,30 @@ * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC. * Also recorded is information coming from the context, i.e. type of the * frame and associated information, like the path of a sourced file. */ -typedef struct { +typedef struct ECommandLocation { Tcl_Size srcOffset; /* Command location to find the entry. */ - Tcl_Size nline; /* Number of words in the command */ - Tcl_Size *line; /* Line information for all words in the + Tcl_Size nline; /* Number of words in the command */ + Tcl_Size *line; /* Line information for all words in the * command. */ - Tcl_Size **next; /* Transient information used by the compiler + Tcl_Size **next; /* Transient information used by the compiler * for tracking of hidden continuation * lines. */ } ECL; -typedef struct { +typedef struct ExtCmdLoc { int type; /* Context type. */ Tcl_Size start; /* Starting line for compiled script. Needed * for the extended recompile check in * tclCompileObj. */ Tcl_Obj *path; /* Path of the sourced file the command is * in. */ ECL *loc; /* Command word locations (lines). */ - Tcl_Size nloc; /* Number of allocated entries in 'loc'. */ - Tcl_Size nuloc; /* Number of used entries in 'loc'. */ + Tcl_Size nloc; /* Number of allocated entries in 'loc'. */ + Tcl_Size nuloc; /* Number of used entries in 'loc'. */ } ExtCmdLoc; /* * CompileProcs need the ability to record information during compilation that * can be used by bytecode instructions during execution. The AuxData @@ -215,15 +219,15 @@ * to duplicate or free this auxiliary data when the containing ByteCode * objects are duplicated and freed. Pointers to these procedures are kept in * the AuxData structure. */ -typedef void *(AuxDataDupProc) (void *clientData); -typedef void (AuxDataFreeProc) (void *clientData); -typedef void (AuxDataPrintProc)(void *clientData, - Tcl_Obj *appendObj, struct ByteCode *codePtr, - TCL_HASH_TYPE pcOffset); +typedef void *(AuxDataDupProc) (void *clientData); +typedef void (AuxDataFreeProc) (void *clientData); +typedef void (AuxDataPrintProc) (void *clientData, + Tcl_Obj *appendObj, struct ByteCode *codePtr, + TCL_HASH_TYPE pcOffset); /* * We define a separate AuxDataType struct to hold type-related information * for the AuxData structure. This separation makes it possible for clients * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for @@ -264,11 +268,11 @@ */ typedef struct AuxData { const AuxDataType *type; /* Pointer to the AuxData type associated with * this ClientData. */ - void *clientData; /* The compilation data itself. */ + void *clientData; /* The compilation data itself. */ } AuxData; /* * Structure defining the compilation environment. After compilation, fields * describing bytecode instructions are copied out into the more compact @@ -288,25 +292,25 @@ * emitted will depend on the interpreter. */ const char *source; /* The source string being compiled by * SetByteCodeFromAny. This pointer is not * owned by the CompileEnv and must not be * freed or changed by it. */ - Tcl_Size numSrcBytes; /* Number of bytes in source. */ + Tcl_Size numSrcBytes; /* Number of bytes in source. */ Proc *procPtr; /* If a procedure is being compiled, a pointer * to its Proc structure; otherwise NULL. Used * to compile local variables. Set from * information provided by ObjInterpProc in * tclProc.c. */ - Tcl_Size numCommands; /* Number of commands compiled. */ - Tcl_Size exceptDepth; /* Current exception range nesting level; TCL_INDEX_NONE + Tcl_Size numCommands; /* Number of commands compiled. */ + Tcl_Size exceptDepth; /* Current exception range nesting level; TCL_INDEX_NONE * if not in any range currently. */ - Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges; TCL_INDEX_NONE + Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges; TCL_INDEX_NONE * if no ranges have been compiled. */ - Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to + Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to * execute the code. Set by compilation * procedures before returning. */ - Tcl_Size currStackDepth; /* Current stack depth. */ + Tcl_Size currStackDepth; /* Current stack depth. */ LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl * objects referenced by this compiled code. * Indexed by the string representations of * the literals. Used to avoid creating * duplicate objects. */ @@ -331,11 +335,11 @@ * array. */ Tcl_Size exceptArrayNext; /* Next free ExceptionRange array index. * exceptArrayNext is the number of ranges and * (exceptArrayNext-1) is the index of the * current range's array entry. */ - Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array + Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array * entry. */ #if TCL_MAJOR_VERSION < 9 int mallocedExceptArray; #endif ExceptionAux *exceptAuxArrayPtr; @@ -377,24 +381,24 @@ AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE]; /* Initial storage for aux data array. */ /* TIP #280 */ ExtCmdLoc *extCmdMapPtr; /* Extended command location information for * 'info frame'. */ - Tcl_Size line; /* First line of the script, based on the + Tcl_Size line; /* First line of the script, based on the * invoking context, then the line of the * command currently compiled. */ int atCmdStart; /* Flag to say whether an INST_START_CMD * should be issued; they should never be * issued repeatedly, as that is significantly * inefficient. If set to 2, that instruction * should not be issued at all (by the generic * part of the command compiler). */ - Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions + Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions * encountered that have not yet been paired * with a corresponding * INST_INVOKE_EXPANDED. */ - Tcl_Size *clNext; /* If not NULL, it refers to the next slot in + Tcl_Size *clNext; /* If not NULL, it refers to the next slot in * clLoc to check for an invisible * continuation line. */ } CompileEnv; /* @@ -403,33 +407,33 @@ * object is allocated to hold the ByteCode structure immediately followed by * the code bytes, the literal object array, the ExceptionRange array, the * CmdLocation map, and the compilation AuxData array. */ -/* - * A PRECOMPILED bytecode struct is one that was generated from a compiled - * image rather than implicitly compiled from source - */ - -#define TCL_BYTECODE_PRECOMPILED 0x0001 - -/* - * When a bytecode is compiled, interp or namespace resolvers have not been - * applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag. - */ - -#define TCL_BYTECODE_RESOLVE_VARS 0x0002 - -#define TCL_BYTECODE_RECOMPILE 0x0004 +enum ByteCodeFlags { + /* + * A PRECOMPILED bytecode struct is one that was generated from a compiled + * image rather than implicitly compiled from source + */ + TCL_BYTECODE_PRECOMPILED = 0x0001, + + /* + * When a bytecode is compiled, interp or namespace resolvers have not been + * applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag. + */ + TCL_BYTECODE_RESOLVE_VARS = 0x0002, + + TCL_BYTECODE_RECOMPILE = 0x0004 +}; typedef struct ByteCode { TclHandle interpHandle; /* Handle for interpreter containing the * compiled code. Commands and their compile * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ - Tcl_Size compileEpoch; /* Value of iPtr->compileEpoch when this + Tcl_Size compileEpoch; /* Value of iPtr->compileEpoch when this * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ Namespace *nsPtr; /* Namespace context in which this code was * compiled. If the code is executed if a @@ -457,21 +461,21 @@ * and must not be freed by it. */ size_t structureSize; /* Number of bytes in the ByteCode structure * itself. Does not include heap space for * literal Tcl objects or storage referenced * by AuxData entries. */ - Tcl_Size numCommands; /* Number of commands compiled. */ - Tcl_Size numSrcBytes; /* Number of source bytes compiled. */ - Tcl_Size numCodeBytes; /* Number of code bytes. */ - Tcl_Size numLitObjects; /* Number of objects in literal array. */ + Tcl_Size numCommands; /* Number of commands compiled. */ + Tcl_Size numSrcBytes; /* Number of source bytes compiled. */ + Tcl_Size numCodeBytes; /* Number of code bytes. */ + Tcl_Size numLitObjects; /* Number of objects in literal array. */ Tcl_Size numExceptRanges; /* Number of ExceptionRange array elems. */ Tcl_Size numAuxDataItems; /* Number of AuxData items. */ - Tcl_Size numCmdLocBytes; /* Number of bytes needed for encoded command + Tcl_Size numCmdLocBytes; /* Number of bytes needed for encoded command * location information. */ - Tcl_Size maxExceptDepth; /* Maximum nesting level of ExceptionRanges; + Tcl_Size maxExceptDepth; /* Maximum nesting level of ExceptionRanges; * TCL_INDEX_NONE if no ranges were compiled. */ - Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to + Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to * execute the code. */ unsigned char *codeStart; /* Points to the first byte of the code. This * is just after the final ByteCode member * cmdMapPtr. */ Tcl_Obj **objArrayPtr; /* Points to the start of the literal object @@ -523,25 +527,28 @@ Tcl_Time createTime; /* Absolute time when the ByteCode was * created. */ #endif /* TCL_COMPILE_STATS */ } ByteCode; -#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.twoPtrValue.ptr1 = (codePtr); \ - ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), (typePtr), &ir); \ - } while (0) - - - -#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \ - do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), (typePtr)); \ - (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ +static inline void +ByteCodeSetInternalRep( + Tcl_Obj *objPtr, + const Tcl_ObjType *typePtr, + ByteCode *codePtr) +{ + Tcl_ObjInternalRep ir; + + ir.ptrAndLongRep.ptr = codePtr; + ir.ptrAndLongRep.value = 0; + Tcl_StoreInternalRep(objPtr, typePtr, &ir); +} + +#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \ + do { \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), (typePtr)); \ + (codePtr) = irPtr ? (ByteCode*)irPtr->ptrAndLongRep.ptr : NULL; \ } while (0) /* * Opcodes for the Tcl bytecode instructions. These must correspond to the * entries in the table of instruction descriptions, tclInstructionTable, in @@ -827,15 +834,15 @@ INST_CLOCK_READ, INST_DICT_GET_DEF, - /* TIP 461 */ - INST_STR_LT, - INST_STR_GT, - INST_STR_LE, - INST_STR_GE, + /* TIP 461 */ + INST_STR_LT, + INST_STR_GT, + INST_STR_LE, + INST_STR_GE, INST_LREPLACE4, /* TIP 667: const */ INST_CONST_IMM, @@ -966,12 +973,12 @@ #define JUMPFIXUP_INIT_ENTRIES 10 typedef struct JumpFixupArray { JumpFixup *fixup; /* Points to start of jump fixup array. */ - Tcl_Size next; /* Index of next free array entry. */ - Tcl_Size end; /* Index of last usable entry in array. */ + Tcl_Size next; /* Index of next free array entry. */ + Tcl_Size end; /* Index of last usable entry in array. */ int mallocedArray; /* 1 if array was expanded and fixups points * into the heap, else 0. */ JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES]; /* Initial storage for jump fixup array. */ } JumpFixupArray; @@ -983,11 +990,12 @@ * only scalar variables are supported for inline-compiled foreach loops. */ typedef struct ForeachVarList { Tcl_Size numVars; /* The number of variables in the list. */ - Tcl_Size varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers") + Tcl_Size varIndexes[TCLFLEXARRAY]; + /* An array of the indexes ("slot numbers") * for each variable in the procedure's array * of local variables. Only scalar variables * are supported. The actual size of this * field will be large enough to numVars * indexes. THIS MUST BE THE LAST FIELD IN THE @@ -1001,17 +1009,18 @@ */ typedef struct ForeachInfo { Tcl_Size numLists; /* The number of both the variable and value * lists of the foreach command. */ - Tcl_Size firstValueTemp; /* Index of the first temp var in a proc frame + Tcl_Size firstValueTemp; /* Index of the first temp var in a proc frame * used to point to a value list. */ - Tcl_Size loopCtTemp; /* Index of temp var in a proc frame holding + Tcl_Size loopCtTemp; /* Index of temp var in a proc frame holding * the loop's iteration count. Used to * determine next value list element to assign * each loop var. */ - ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList + ForeachVarList *varLists[TCLFLEXARRAY]; + /* An array of pointers to ForeachVarList * structures describing each var list. The * actual size of this field will be large * enough to numVars indexes. THIS MUST BE THE * LAST FIELD IN THE STRUCTURE! */ } ForeachInfo; @@ -1027,22 +1036,30 @@ * offsets). */ } JumptableInfo; MODULE_SCOPE const AuxDataType tclJumptableInfoType; -#define JUMPTABLEINFO(envPtr, index) \ - ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData)) +/* Get the jump table whose index is at the given place in the bytecode. */ +static inline JumptableInfo * +JUMPTABLEINFO( + CompileEnv *envPtr, + const unsigned char *indexPtr) +{ + return (JumptableInfo *) + envPtr->auxDataArrayPtr[TclGetUInt4AtPtr(indexPtr)].clientData; +} /* * Structure used to hold information about a [dict update] command that is * needed during program execution. These structures are stored in CompileEnv * and ByteCode structures as auxiliary data. */ typedef struct { Tcl_Size length; /* Size of array */ - Tcl_Size varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when + Tcl_Size varIndices[TCLFLEXARRAY]; + /* Array of variable indices to manage when * processing the start and end of a [dict * update]. There is really more than one * entry, and the structure is allocated to * take account of this. MUST BE LAST FIELD IN * STRUCTURE. */ @@ -1205,11 +1222,10 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int isLambda); #endif /* TCL_MAJOR_VERSION > 8 */ - /* *---------------------------------------------------------------- * Macros and flag values used by Tcl bytecode compilation and execution * modules inside the Tcl core but not used outside. @@ -1216,134 +1232,151 @@ *---------------------------------------------------------------- */ /* * Simplified form to access AuxData. - * - * void *TclFetchAuxData(CompileEng *envPtr, int index); - */ - -#define TclFetchAuxData(envPtr, index) \ - (envPtr)->auxDataArrayPtr[(index)].clientData - -#define LITERAL_ON_HEAP 0x01 -#define LITERAL_CMD_NAME 0x02 -#define LITERAL_UNSHARED 0x04 - -/* - * Macro used to manually adjust the stack requirements; used in cases where - * the stack effect cannot be computed from the opcode and its operands, but - * is still known at compile time. - * - * void TclAdjustStackDepth(int delta, CompileEnv *envPtr); - */ - -#define TclAdjustStackDepth(delta, envPtr) \ - do { \ - if ((delta) < 0) { \ - if ((int)(envPtr)->maxStackDepth < (int)(envPtr)->currStackDepth) { \ - (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \ - } \ - } \ - (envPtr)->currStackDepth += (delta); \ - } while (0) - -#define TclGetStackDepth(envPtr) \ - ((envPtr)->currStackDepth) - -#define TclSetStackDepth(depth, envPtr) \ - (envPtr)->currStackDepth = (depth) - -#define TclCheckStackDepth(depth, envPtr) \ - do { \ - size_t _dd = (depth); \ - if (_dd != (size_t)(envPtr)->currStackDepth) { \ - Tcl_Panic("bad stack depth computations: is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", \ - (size_t)(envPtr)->currStackDepth, _dd); \ - } \ - } while (0) - -/* - * Macro used to update the stack requirements. It is called by the macros - * TclEmitOpCode, TclEmitInst1 and TclEmitInst4. + */ +static inline void * +TclFetchAuxData( + CompileEnv *envPtr, + int index) +{ + return envPtr->auxDataArrayPtr[index].clientData; +} + +enum LiteralFlags { + LITERAL_ON_HEAP = 0x01, + LITERAL_CMD_NAME = 0x02, + LITERAL_UNSHARED = 0x04 +}; + +/* + * Inline function used to manually adjust the stack requirements; used in + * cases where the stack effect cannot be computed from the opcode and its + * operands, but is still known at compile time. + */ +static inline void +TclAdjustStackDepth( + int delta, + CompileEnv *envPtr) +{ + if (delta < 0) { + if (envPtr->maxStackDepth < envPtr->currStackDepth) { + envPtr->maxStackDepth = envPtr->currStackDepth; + } + } + envPtr->currStackDepth += delta; +} + +static inline Tcl_Size +TclGetStackDepth( + CompileEnv *envPtr) +{ + return envPtr->currStackDepth; +} + +static inline void +TclSetStackDepth( + Tcl_Size depth, + CompileEnv *envPtr) +{ + envPtr->currStackDepth = depth; +} + +static inline void +TclCheckStackDepth( + size_t depth, + CompileEnv *envPtr) +{ + if (depth != (size_t) envPtr->currStackDepth) { + Tcl_Panic( + "bad stack depth computations: " + "is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", + (size_t) envPtr->currStackDepth, depth); + } +} + +/* + * Inline function used to update the stack requirements. It is called by the + * macros TclEmitOpCode, TclEmitInst1 and TclEmitInst4. * Remark that the very last instruction of a bytecode always reduces the * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always * updated. - * - * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr); - */ - -#define TclUpdateStackReqs(op, i, envPtr) \ - do { \ - int _delta = tclInstructionTable[(op)].stackEffect; \ - if (_delta) { \ - if (_delta == INT_MIN) { \ - _delta = 1 - (i); \ - } \ - TclAdjustStackDepth(_delta, envPtr); \ - } \ - } while (0) - -/* - * Macros used to update the flag that indicates if we are at the start of a - * command, based on whether the opcode is INST_START_COMMAND. - * - * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr); - */ - -#define TclUpdateAtCmdStart(op, envPtr) \ - if ((envPtr)->atCmdStart < 2) { \ - (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ - } - -/* - * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C - * "prototype" for this macro is: - * - * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr); - */ - -#define TclEmitOpcode(op, envPtr) \ - do { \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, 0, envPtr); \ - } while (0) - -/* - * Macros to emit an integer operand. The ANSI C "prototype" for these macros - * are: - * - * void TclEmitInt1(int i, CompileEnv *envPtr); - * void TclEmitInt4(int i, CompileEnv *envPtr); - */ - -#define TclEmitInt1(i, envPtr) \ - do { \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \ - } while (0) - -#define TclEmitInt4(i, envPtr) \ - do { \ - if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 24); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 16); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 8); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) ); \ - } while (0) + */ +static inline void +TclUpdateStackReqs( + unsigned char op, + int i, + CompileEnv *envPtr) +{ + int delta = tclInstructionTable[op].stackEffect; + if (delta) { + if (delta == INT_MIN) { + delta = 1 - i; + } + TclAdjustStackDepth(delta, envPtr); + } +} + +/* + * Inline function used to update the flag that indicates if we are at the + * start of a command, based on whether the opcode is INST_START_COMMAND. + */ +static inline void +TclUpdateAtCmdStart( + unsigned char op, + CompileEnv *envPtr) +{ + if (envPtr->atCmdStart < 2) { + envPtr->atCmdStart = (op == INST_START_CMD ? 1 : 0); + } +} + +/* + * Inline function to emit an opcode byte into a CompileEnv's code array. + */ +static inline void +TclEmitOpcode( + unsigned char op, + CompileEnv *envPtr) +{ + if (envPtr->codeNext == envPtr->codeEnd) { + TclExpandCodeArray(envPtr); + } + *envPtr->codeNext++ = op; + TclUpdateAtCmdStart(op, envPtr); + TclUpdateStackReqs(op, 0, envPtr); +} + +/* + * Inline functions to emit an integer operand. + */ + +static inline void +TclEmitInt1( + int i, + CompileEnv *envPtr) +{ + if (envPtr->codeNext == envPtr->codeEnd) { + TclExpandCodeArray(envPtr); + } + *envPtr->codeNext++ = (unsigned char) ((unsigned) i); +} + +static inline void +TclEmitInt4( + int i, + CompileEnv *envPtr) +{ + if (envPtr->codeNext + 4 > envPtr->codeEnd) { + TclExpandCodeArray(envPtr); + } + *envPtr->codeNext++ = (unsigned char) ((unsigned) i >> 24); + *envPtr->codeNext++ = (unsigned char) ((unsigned) i >> 16); + *envPtr->codeNext++ = (unsigned char) ((unsigned) i >> 8); + *envPtr->codeNext++ = (unsigned char) ((unsigned) i ); +} /* * Macros to emit an instruction with signed or unsigned integer operands. * Four byte integers are stored in "big-endian" order with the high order * byte stored at the lowest address. The ANSI C "prototypes" for these macros @@ -1351,155 +1384,179 @@ * * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr); * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr); */ -#define TclEmitInstInt1(op, i, envPtr) \ - do { \ - if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, i, envPtr); \ - } while (0) - -#define TclEmitInstInt4(op, i, envPtr) \ - do { \ - if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 24); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 16); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 8); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) ); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, i, envPtr); \ - } while (0) - -/* - * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the - * object's one or four byte array index into the CompileEnv's code array. - * These support, respectively, a maximum of 256 (2**8) and 2**32 objects in a - * CompileEnv. The ANSI C "prototype" for this macro is: - * - * void TclEmitPush(int objIndex, CompileEnv *envPtr); - */ - -#define TclEmitPush(objIndex, envPtr) \ - do { \ - int _objIndexCopy = (objIndex); \ - if (_objIndexCopy <= 255) { \ - TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ - } else { \ - TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ - } \ - } while (0) - -/* - * Macros to update a (signed or unsigned) integer starting at a pointer. The - * two variants depend on the number of bytes. The ANSI C "prototypes" for - * these macros are: - * - * void TclStoreInt1AtPtr(int i, unsigned char *p); - * void TclStoreInt4AtPtr(int i, unsigned char *p); - */ - -#define TclStoreInt1AtPtr(i, p) \ - *(p) = (unsigned char) ((unsigned int) (i)) - -#define TclStoreInt4AtPtr(i, p) \ - do { \ - *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ - *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ - *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ - *(p+3) = (unsigned char) ((unsigned int) (i) ); \ - } while (0) - -/* - * Macros to update instructions at a particular pc with a new op code and a - * (signed or unsigned) int operand. The ANSI C "prototypes" for these macros - * are: - * - * void TclUpdateInstInt1AtPc(unsigned char op, int i, unsigned char *pc); - * void TclUpdateInstInt4AtPc(unsigned char op, int i, unsigned char *pc); - */ - -#define TclUpdateInstInt1AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt1AtPtr((i), ((pc)+1)); \ - } while (0) - -#define TclUpdateInstInt4AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt4AtPtr((i), ((pc)+1)); \ - } while (0) - -/* - * Macro to fix up a forward jump to point to the current code-generation - * position in the bytecode being created (the most common case). The ANSI C - * "prototypes" for this macro is: - * - * int TclFixupForwardJumpToHere(CompileEnv *envPtr, JumpFixup *fixupPtr, - * int threshold); - */ - -#define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \ - TclFixupForwardJump((envPtr), (fixupPtr), \ - (envPtr)->codeNext-(envPtr)->codeStart-(int)(fixupPtr)->codeOffset, \ - (threshold)) - -/* - * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int +static inline void +TclEmitInstInt1( + unsigned char op, + int i, + CompileEnv *envPtr) +{ + if (envPtr->codeNext + 2 > envPtr->codeEnd) { + TclExpandCodeArray(envPtr); + } + *envPtr->codeNext++ = op; + *envPtr->codeNext++ = (unsigned char) ((unsigned) i); + TclUpdateAtCmdStart(op, envPtr); + TclUpdateStackReqs(op, i, envPtr); +} + +static inline void +TclEmitInstInt4( + unsigned char op, + int i, + CompileEnv *envPtr) +{ + if (envPtr->codeNext + 5 > envPtr->codeEnd) { + TclExpandCodeArray(envPtr); + } + *envPtr->codeNext++ = op; + *envPtr->codeNext++ = (unsigned char) ((unsigned) i >> 24); + *envPtr->codeNext++ = (unsigned char) ((unsigned) i >> 16); + *envPtr->codeNext++ = (unsigned char) ((unsigned) i >> 8); + *envPtr->codeNext++ = (unsigned char) ((unsigned) i ); + TclUpdateAtCmdStart(op, envPtr); + TclUpdateStackReqs(op, i, envPtr); +} + +/* + * Inline function to push a Tcl object onto the Tcl evaluation stack. It emits + * the object's one or four byte array index into the CompileEnv's code array. + * These support, respectively, a maximum of 256 (2**8) and 2**31 objects in a + * CompileEnv. + */ +static inline void +TclEmitPush( + int objIndex, + CompileEnv *envPtr) +{ + if (objIndex <= 255) { + TclEmitInstInt1(INST_PUSH1, objIndex, envPtr); + } else { + TclEmitInstInt4(INST_PUSH4, objIndex, envPtr); + } +} + +/* + * Inline functions to update a (signed or unsigned) integer starting at a + * pointer. The two variants depend on the number of bytes. + */ +static inline void +TclStoreInt1AtPtr( + int i, + unsigned char *p) +{ + *p = (unsigned char) ((unsigned) i); +} + +static inline void +TclStoreInt4AtPtr( + int i, + unsigned char *p) +{ + p[0] = (unsigned char) ((unsigned) i >> 24); + p[1] = (unsigned char) ((unsigned) i >> 16); + p[2] = (unsigned char) ((unsigned) i >> 8); + p[3] = (unsigned char) ((unsigned) i ); +} + +/* + * Inline functions to update instructions at a particular pc with a new op + * code and a (signed or unsigned) int operand. + */ +static inline void +TclUpdateInstInt1AtPc( + unsigned char op, + int i, + unsigned char *pc) +{ + *pc = op; + TclStoreInt1AtPtr(i, pc + 1); +} + +static inline void +TclUpdateInstInt4AtPc( + unsigned char op, + int i, + unsigned char *pc) +{ + *pc = op; + TclStoreInt4AtPtr(i, pc + 1); +} + +/* + * Inline function to fix up a forward jump to point to the current + * code-generation position in the bytecode being created (the most common + * case). + */ +static inline int +TclFixupForwardJumpToHere( + CompileEnv *envPtr, + JumpFixup *fixupPtr, + int threshold) +{ + return TclFixupForwardJump(envPtr, fixupPtr, + envPtr->codeNext - envPtr->codeStart - (int) fixupPtr->codeOffset, + threshold); +} + +/* + * Inline functions to get a signed integer (GET_INT{1,2}) or an unsigned int * (GET_UINT{1,2}) from a pointer. There are two variants for each return type - * that depend on the number of bytes fetched. The ANSI C "prototypes" for - * these macros are: - * - * int TclGetInt1AtPtr(unsigned char *p); - * int TclGetInt4AtPtr(unsigned char *p); - * unsigned int TclGetUInt1AtPtr(unsigned char *p); - * unsigned int TclGetUInt4AtPtr(unsigned char *p); + * that depend on the number of bytes fetched. */ /* - * The TclGetInt1AtPtr macro is tricky because we want to do sign extension on - * the 1-byte value. Unfortunately the "char" type isn't signed on all + * The TclGetInt1AtPtr function is tricky because we want to do sign extension + * on the 1-byte value. Unfortunately the "char" type isn't signed on all * platforms so sign-extension doesn't always happen automatically. Sometimes * we can explicitly declare the pointer to be signed, but other times we have * to explicitly sign-extend the value in software. */ +static inline int +TclGetInt1AtPtr( + const unsigned char *p) +{ #ifndef __CHAR_UNSIGNED__ -# define TclGetInt1AtPtr(p) ((int) *((char *) p)) + return (int) *((char *) p); #elif defined(HAVE_SIGNED_CHAR) -# define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) + return (int) *((signed char *) p); #else -# define TclGetInt1AtPtr(p) \ - ((int) ((*((char *) p)) | ((*(p) & 0200) ? (-256) : 0))) + return (int) ((*((char *) p)) | ((*p & 0200) ? (-256) : 0)); #endif - -#define TclGetInt4AtPtr(p) \ - ((int) ((TclGetUInt1AtPtr(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ - (*((p)+3)))) - -#define TclGetUInt1AtPtr(p) \ - ((unsigned int) *(p)) -#define TclGetUInt4AtPtr(p) \ - ((unsigned int) ((*(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ - (*((p)+3)))) +} + +static inline unsigned +TclGetUInt1AtPtr( + const unsigned char *p) +{ + return (unsigned) *p; +} + +static inline int +TclGetInt4AtPtr( + const unsigned char *p) +{ + return (int) ( + (TclGetUInt1AtPtr(p) << 24) + | (p[1] << 16) + | (p[2] << 8) + | (p[3] )); +} + +static inline unsigned +TclGetUInt4AtPtr( + const unsigned char *p) +{ + return (unsigned) ( + ( p[0] << 24) + | (p[1] << 16) + | (p[2] << 8) + | (p[3])); +} /* * Macros used to compute the minimum and maximum of two values. The ANSI C * "prototypes" for these macros are: * @@ -1515,11 +1572,11 @@ * "prototype" for these macros are: * * static void BODY(Tcl_Token *tokenPtr, int word); */ -#define BODY(tokenPtr, word) \ +#define BODY(tokenPtr, word) \ SetLineInformation((word)); \ TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \ envPtr) /* @@ -1527,14 +1584,14 @@ * "prototype" for this macro is: * * static void CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr, * Tcl_Interp *interp); */ - #define CompileTokens(envPtr, tokenPtr, interp) \ - TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ - (envPtr)); + TclCompileTokens(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \ + (envPtr)) + /* * Convenience macros for use when pushing literals. The ANSI C "prototype" for * these macros are: * * static void PushLiteral(CompileEnv *envPtr, @@ -1541,34 +1598,42 @@ * const char *string, Tcl_Size length); * static void PushStringLiteral(CompileEnv *envPtr, * const char *string); */ -#define PushLiteral(envPtr, string, length) \ - TclEmitPush(TclRegisterLiteral((envPtr), (string), (length), 0), (envPtr)) +static inline void +PushLiteral( + CompileEnv *envPtr, + const char *string, + Tcl_Size length) +{ + TclEmitPush(TclRegisterLiteral(envPtr, string, length, 0), envPtr); +} + #define PushStringLiteral(envPtr, string) \ PushLiteral((envPtr), (string), sizeof(string "") - 1) /* - * Macro to advance to the next token; it is more mnemonic than the address - * arithmetic that it replaces. The ANSI C "prototype" for this macro is: - * - * static Tcl_Token * TokenAfter(Tcl_Token *tokenPtr); + * Inline function to advance to the next token; it is more mnemonic than the + * address arithmetic that it replaces. */ - -#define TokenAfter(tokenPtr) \ - ((tokenPtr) + ((tokenPtr)->numComponents + 1)) +static inline Tcl_Token * +TokenAfter( + Tcl_Token *tokenPtr) +{ + return tokenPtr + (tokenPtr->numComponents + 1); +} /* - * Macro to get the offset to the next instruction to be issued. The ANSI C - * "prototype" for this macro is: - * - * static ptrdiff_t CurrentOffset(CompileEnv *envPtr); + * Inline function to get the offset to the next instruction to be issued. */ - -#define CurrentOffset(envPtr) \ - ((envPtr)->codeNext - (envPtr)->codeStart) +static inline ptrdiff_t +CurrentOffset( + CompileEnv *envPtr) +{ + return envPtr->codeNext - envPtr->codeStart; +} /* * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the * maximal depth of nested CATCH ranges in order to alloc runtime * memory. These macros should compute precisely that? OTOH, the nesting depth @@ -1578,38 +1643,70 @@ * static int ExceptionRangeStarts(CompileEnv *envPtr, Tcl_Size index); * static void ExceptionRangeEnds(CompileEnv *envPtr, Tcl_Size index); * static void ExceptionRangeTarget(CompileEnv *envPtr, Tcl_Size index, LABEL); */ -#define ExceptionRangeStarts(envPtr, index) \ - (((envPtr)->exceptDepth++), \ - ((envPtr)->maxExceptDepth = \ - TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \ - ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr))) -#define ExceptionRangeEnds(envPtr, index) \ - (((envPtr)->exceptDepth--), \ - ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \ - CurrentOffset(envPtr) - (int)(envPtr)->exceptArrayPtr[(index)].codeOffset)) +static inline int +ExceptionRangeStarts( + CompileEnv *envPtr, + Tcl_Size index) +{ + Tcl_Size off; + + envPtr->exceptDepth++; + envPtr->maxExceptDepth = TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth); + off = CurrentOffset(envPtr); + envPtr->exceptArrayPtr[index].codeOffset = off; + return off; +} + +static inline void +ExceptionRangeEnds( + CompileEnv *envPtr, + Tcl_Size index) +{ + envPtr->exceptDepth--; + envPtr->exceptArrayPtr[index].numCodeBytes = + CurrentOffset(envPtr) - (int) envPtr->exceptArrayPtr[index].codeOffset; +} + +/* + * static void ExceptionRangeTarget(CompileEnv *envPtr, Tcl_Size index, LABEL); + */ #define ExceptionRangeTarget(envPtr, index, targetType) \ ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr)) /* * Check if there is an LVT for compiled locals */ - -#define EnvHasLVT(envPtr) \ - (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr) +static inline int +EnvHasLVT( + CompileEnv *envPtr) +{ + return envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr; +} /* * Macros for making it easier to deal with tokens and DStrings. */ -#define TclDStringAppendToken(dsPtr, tokenPtr) \ - Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size) -#define TclRegisterDStringLiteral(envPtr, dsPtr) \ - TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \ - Tcl_DStringLength(dsPtr), /*flags*/ 0) +static inline void +TclDStringAppendToken( + Tcl_DString *dsPtr, + Tcl_Token *tokenPtr) +{ + Tcl_DStringAppend(dsPtr, tokenPtr->start, tokenPtr->size); +} + +static inline int +TclRegisterDStringLiteral( + CompileEnv *envPtr, + Tcl_DString *dsPtr) +{ + return TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), + Tcl_DStringLength(dsPtr), /*flags*/ 0); +} /* * Macro that encapsulates an efficiency trick that avoids a function call for * the simplest of compiles. The ANSI C "prototype" for this macro is: * @@ -1657,33 +1754,35 @@ } else { \ TclEmitInstInt4(nm##4,idx,envPtr); \ } /* - * How to get an anonymous local variable (used for holding temporary values - * off the stack) or a local simple scalar. + * Get an anonymous local variable (used for holding temporary values + * off the stack). */ - -#define AnonymousLocal(envPtr) \ - (TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr))) -#define LocalScalar(chars,len,envPtr) \ - TclLocalScalar(chars, len, envPtr) -#define LocalScalarFromToken(tokenPtr,envPtr) \ - TclLocalScalarFromToken(tokenPtr, envPtr) +static inline Tcl_Size +AnonymousLocal( + CompileEnv *envPtr) +{ + return TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, envPtr); +} /* * Flags bits used by TclPushVarName. */ - -#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ -#define TCL_NO_ELEMENT 2 /* Do not push the array element. */ +enum TclPushVarNameFlags { + TCL_NO_LARGE_INDEX = 1, /* Do not return localIndex value > 255 */ + TCL_NO_ELEMENT = 2 /* Do not push the array element. */ +}; /* * Flags bits used by lreplace4 instruction */ -#define TCL_LREPLACE4_END_IS_LAST 1 /* "end" refers to last element */ -#define TCL_LREPLACE4_SINGLE_INDEX 2 /* Second index absent (pure insert) */ +enum Lreplace4Flags { + TCL_LREPLACE4_END_IS_LAST = 1, /* "end" refers to last element */ + TCL_LREPLACE4_SINGLE_INDEX = 2 /* Second index absent (pure insert) */ +}; /* * DTrace probe macros (NOPs if DTrace support is not enabled). */ Index: generic/tclConfig.c ================================================================== --- generic/tclConfig.c +++ generic/tclConfig.c @@ -67,11 +67,12 @@ Tcl_Interp *interp, /* Interpreter the configuration command is * registered in. */ const char *pkgName, /* Name of the package registering the * embedded configuration. ASCII, thus in * UTF-8 too. */ - const Tcl_Config *configuration, /* Embedded configuration. */ + const Tcl_Config *configuration, + /* Embedded configuration. */ const char *valEncoding) /* Name of the encoding used to store the * configuration values, ASCII, thus UTF-8. */ { Tcl_Obj *pDB, *pkgDict; Tcl_DString cmdName; Index: generic/tclDate.h ================================================================== --- generic/tclDate.h +++ generic/tclDate.h @@ -18,12 +18,12 @@ */ #define JULIAN_DAY_POSIX_EPOCH 2440588 #define GREGORIAN_CHANGE_DATE 2361222 #define SECONDS_PER_DAY 86400 -#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \ - * SECONDS_PER_DAY) +#define JULIAN_SEC_POSIX_EPOCH \ + (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) * SECONDS_PER_DAY) #define FOUR_CENTURIES 146097 /* days */ #define JDAY_1_JAN_1_CE_JULIAN 1721424 #define JDAY_1_JAN_1_CE_GREGORIAN 1721426 #define ONE_CENTURY_GREGORIAN 36524 /* days */ #define FOUR_YEARS 1461 /* days */ @@ -484,12 +484,12 @@ ClockFmtScnStorage *nextPtr; ClockFmtScnStorage *prevPtr; #endif size_t fmtMinAlloc; #if 0 - Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry, - * stored by offset +sizeof(self) */ + Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry, + * stored by offset +sizeof(self) */ #endif }; /* * Clock macros. Index: generic/tclDictObj.c ================================================================== --- generic/tclDictObj.c +++ generic/tclDictObj.c @@ -129,11 +129,11 @@ * created. */ ChainEntry *entryChainTail; /* Other end of linked list of all entries in * the dictionary. Used for doing traversal of * the entries in the order that they are * created. */ - size_t 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 * dictionaries. */ } Dict; @@ -161,23 +161,23 @@ NULL, NULL, NULL) }; -#define DictSetInternalRep(objPtr, dictRepPtr) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.twoPtrValue.ptr1 = (dictRepPtr); \ - ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &tclDictType, &ir); \ +#define DictSetInternalRep(objPtr, dictRepPtr) \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.twoPtrValue.ptr1 = (dictRepPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreInternalRep((objPtr), &tclDictType, &ir); \ } while (0) -#define DictGetInternalRep(objPtr, dictRepPtr) \ - do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &tclDictType); \ - (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL; \ +#define DictGetInternalRep(objPtr, dictRepPtr) \ + do { \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &tclDictType); \ + (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * The type of the specially adapted version of the Tcl_Obj*-containing hash * table defined in the tclObj.c code. This version differs in that it @@ -188,11 +188,11 @@ * *this* file. Everything else should use the dict iterator API. */ static const Tcl_HashKeyType chainHashType = { TCL_HASH_KEY_TYPE_VERSION, - TCL_HASH_KEY_DIRECT_COMPARE, /* allows compare keys by pointers */ + TCL_HASH_KEY_DIRECT_COMPARE, /* allows compare keys by pointers */ TclHashObjKey, TclCompareObjKeys, AllocChainEntry, TclFreeObjEntry }; @@ -625,11 +625,10 @@ if (objc & 1) { goto missingValue; } for (i=0 ; iepoch) { searchPtr->epoch = 0; @@ -2102,14 +2101,14 @@ */ Tcl_Obj * TclDictObjSmartRef( Tcl_Interp *interp, - Tcl_Obj *dictPtr) + Tcl_Obj *dictPtr) { Tcl_Obj *result; - Dict *dict; + Dict *dict; if (!TclHasInternalRep(dictPtr, &tclDictType) && SetDictFromAny(interp, dictPtr) != TCL_OK) { return NULL; } @@ -3920,11 +3919,10 @@ llen++; } Tcl_DecrRefCount(elemPtr); return llen; } - /* *---------------------------------------------------------------------- * * DictAsListIndex -- Index: generic/tclDisassemble.c ================================================================== --- generic/tclDisassemble.c +++ generic/tclDisassemble.c @@ -43,25 +43,24 @@ UpdateStringOfInstName, /* updateStringProc */ NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; -#define InstNameSetInternalRep(objPtr, inst) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.wideValue = (inst); \ +#define InstNameSetInternalRep(objPtr, inst) \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.wideValue = (inst); \ Tcl_StoreInternalRep((objPtr), &instNameType, &ir); \ } while (0) -#define InstNameGetInternalRep(objPtr, inst) \ - do { \ +#define InstNameGetInternalRep(objPtr, inst) \ + do { \ const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &instNameType); \ - assert(irPtr != NULL); \ - (inst) = irPtr->wideValue; \ + irPtr = TclFetchInternalRep((objPtr), &instNameType); \ + assert(irPtr != NULL); \ + (inst) = irPtr->wideValue; \ } while (0) - /* *---------------------------------------------------------------------- * * GetLocationInformation -- @@ -277,11 +276,12 @@ /* * Print header lines describing the ByteCode. */ Tcl_AppendPrintfToObj(bufferObj, - "ByteCode %p, refCt %" TCL_SIZE_MODIFIER "d, epoch %" TCL_SIZE_MODIFIER "d, interp %p (epoch %" TCL_SIZE_MODIFIER "d)\n", + "ByteCode %p, refCt %" TCL_SIZE_MODIFIER "d, " + "epoch %" TCL_SIZE_MODIFIER "d, interp %p (epoch %" TCL_SIZE_MODIFIER "d)\n", codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); Tcl_AppendToObj(bufferObj, " Source ", -1); PrintSourceToObj(bufferObj, codePtr->source, TclMin(codePtr->numSrcBytes, 55)); GetLocationInformation(codePtr->procPtr, &fileObj, &line); @@ -288,11 +288,13 @@ if (line >= 0 && fileObj != NULL) { Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d", TclGetString(fileObj), line); } Tcl_AppendPrintfToObj(bufferObj, - "\n Cmds %d, src %" TCL_SIZE_MODIFIER "d, inst %" TCL_SIZE_MODIFIER "d, litObjs %" TCL_SIZE_MODIFIER "d, aux %" TCL_SIZE_MODIFIER "d, stkDepth %" TCL_SIZE_MODIFIER "d, code/src %.2f\n", + "\n Cmds %d, src %" TCL_SIZE_MODIFIER "d, inst %" TCL_SIZE_MODIFIER "d, " + "litObjs %" TCL_SIZE_MODIFIER "d, aux %" TCL_SIZE_MODIFIER "d, " + "stkDepth %" TCL_SIZE_MODIFIER "d, code/src %.2f\n", numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, #ifdef TCL_COMPILE_STATS codePtr->numSrcBytes? @@ -300,12 +302,14 @@ #endif 0.0); #ifdef TCL_COMPILE_STATS Tcl_AppendPrintfToObj(bufferObj, - " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_SIZE_MODIFIER "d+litObj %" - TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_SIZE_MODIFIER "d\n", + " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+" + "inst %" TCL_SIZE_MODIFIER "d+litObj %" TCL_Z_MODIFIER "u+" + "exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+" + "cmdMap %" TCL_SIZE_MODIFIER "d\n", codePtr->structureSize, offsetof(ByteCode, localCachePtr), codePtr->numCodeBytes, codePtr->numLitObjects * sizeof(Tcl_Obj *), codePtr->numExceptRanges*sizeof(ExceptionRange), @@ -322,11 +326,13 @@ if (codePtr->procPtr != NULL) { Proc *procPtr = codePtr->procPtr; Tcl_Size numCompiledLocals = procPtr->numCompiledLocals; Tcl_AppendPrintfToObj(bufferObj, - " Proc %p, refCt %" TCL_SIZE_MODIFIER "d, args %" TCL_SIZE_MODIFIER "d, compiled locals %" TCL_SIZE_MODIFIER "d\n", + " Proc %p, refCt %" TCL_SIZE_MODIFIER "d, " + "args %" TCL_SIZE_MODIFIER "d, " + "compiled locals %" TCL_SIZE_MODIFIER "d\n", procPtr, procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { CompiledLocal *localPtr = procPtr->firstLocalPtr; @@ -353,24 +359,27 @@ /* * Print the ExceptionRange array. */ if ((int)codePtr->numExceptRanges > 0) { - Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_SIZE_MODIFIER "d, depth %" TCL_SIZE_MODIFIER "d:\n", + Tcl_AppendPrintfToObj(bufferObj, + " Exception ranges %" TCL_SIZE_MODIFIER "d, depth %" TCL_SIZE_MODIFIER "d:\n", codePtr->numExceptRanges, codePtr->maxExceptDepth); for (i = 0; i < (int)codePtr->numExceptRanges; i++) { ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i]; Tcl_AppendPrintfToObj(bufferObj, - " %" TCL_SIZE_MODIFIER "d: level %" TCL_SIZE_MODIFIER "d, %s, pc %" TCL_SIZE_MODIFIER "d-%" TCL_SIZE_MODIFIER "d, ", + " %" TCL_SIZE_MODIFIER "d: level %" TCL_SIZE_MODIFIER "d, " + "%s, pc %" TCL_SIZE_MODIFIER "d-%" TCL_SIZE_MODIFIER "d, ", i, rangePtr->nestingLevel, (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"), rangePtr->codeOffset, (rangePtr->codeOffset + rangePtr->numCodeBytes - 1)); switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: - Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_SIZE_MODIFIER "d, break %" TCL_SIZE_MODIFIER "d\n", + Tcl_AppendPrintfToObj(bufferObj, + "continue %" TCL_SIZE_MODIFIER "d, break %" TCL_SIZE_MODIFIER "d\n", rangePtr->continueOffset, rangePtr->breakOffset); break; case CATCH_EXCEPTION_RANGE: Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_SIZE_MODIFIER "d\n", rangePtr->catchOffset); @@ -444,11 +453,12 @@ } else { srcLen = TclGetInt1AtPtr(srcLengthNext); srcLengthNext++; } - Tcl_AppendPrintfToObj(bufferObj, "%s%4" TCL_SIZE_MODIFIER "d: pc %d-%d, src %d-%d", + Tcl_AppendPrintfToObj(bufferObj, + "%s%4" TCL_SIZE_MODIFIER "d: pc %d-%d, src %d-%d", ((i % 2)? " " : "\n "), (i+1), codeOffset, (codeOffset + codeLen - 1), srcOffset, (srcOffset + srcLen - 1)); } if (numCmds > 0) { @@ -702,12 +712,12 @@ case INST_UMINUS: case INST_UPLUS: case INST_TRY_CVT_TO_NUMERIC: case INST_EXPAND_STKTOP: case INST_EXPR_STK: - objc = 1; - break; + objc = 1; + break; case INST_LIST_IN: case INST_LIST_NOT_IN: /* Basic list containment operators. */ case INST_STR_EQ: case INST_STR_NEQ: /* String (in)equality check */ @@ -730,65 +740,64 @@ case INST_EXPON: case INST_ADD: case INST_SUB: case INST_DIV: case INST_MULT: - objc = 2; - break; + objc = 2; + break; case INST_RETURN_STK: - /* early pop. TODO: dig out opt dict too :/ */ - objc = 1; - break; + /* early pop. TODO: dig out opt dict too :/ */ + objc = 1; + break; case INST_SYNTAX: case INST_RETURN_IMM: - objc = 2; - break; + objc = 2; + break; case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); - break; + break; case INST_INVOKE_STK1: objc = TclGetUInt1AtPtr(pc+1); break; } result = iPtr->innerContext; if (Tcl_IsShared(result)) { - Tcl_DecrRefCount(result); - iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); - Tcl_IncrRefCount(result); + Tcl_DecrRefCount(result); + iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); + Tcl_IncrRefCount(result); } else { - Tcl_Size len; + Tcl_Size len; - /* - * Reset while keeping the list internalrep as much as possible. - */ + /* + * Reset while keeping the list internalrep as much as possible. + */ TclListObjLength(interp, result, &len); - Tcl_ListObjReplace(interp, result, 0, len, 0, NULL); + Tcl_ListObjReplace(interp, result, 0, len, 0, NULL); } Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc)); for (; objc>0 ; objc--) { - Tcl_Obj *objPtr; + Tcl_Obj *objPtr = tosPtr[1 - objc]; - objPtr = tosPtr[1 - objc]; - if (!objPtr) { - Tcl_Panic("InnerContext: bad tos -- appending null object"); - } - if ((objPtr->refCount <= 0) + if (!objPtr) { + Tcl_Panic("InnerContext: bad tos -- appending null object"); + } + if ((objPtr->refCount <= 0) #ifdef TCL_MEM_DEBUG - || (objPtr->refCount == 0x61616161) + || (objPtr->refCount == 0x61616161) #endif - ) { - Tcl_Panic("InnerContext: bad tos -- appending freed object %p", - objPtr); - } - Tcl_ListObjAppendElement(NULL, result, objPtr); + ) { + Tcl_Panic("InnerContext: bad tos -- appending freed object %p", + objPtr); + } + Tcl_ListObjAppendElement(NULL, result, objPtr); } return result; } @@ -827,19 +836,19 @@ static void UpdateStringOfInstName( Tcl_Obj *objPtr) { - size_t inst; /* NOTE: We know this is really an unsigned char */ + size_t inst; /* NOTE: We know this is really an unsigned char */ char *dst; InstNameGetInternalRep(objPtr, inst); if (inst >= LAST_INST_OPCODE) { dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); TclOOM(dst, TCL_INTEGER_SPACE + 5); - snprintf(dst, TCL_INTEGER_SPACE + 5, "inst_%" TCL_Z_MODIFIER "u", inst); + snprintf(dst, TCL_INTEGER_SPACE + 5, "inst_%" TCL_Z_MODIFIER "u", inst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { const char *s = tclInstructionTable[inst].name; size_t len = strlen(s); dst = Tcl_InitStringRep(objPtr, s, len); @@ -1145,18 +1154,21 @@ ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i]; switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf( - "type %s level %" TCL_SIZE_MODIFIER "d from %" TCL_SIZE_MODIFIER "d to %" TCL_SIZE_MODIFIER "d break %" TCL_SIZE_MODIFIER "d continue %" TCL_SIZE_MODIFIER "d", + "type %s level %" TCL_SIZE_MODIFIER "d from %" TCL_SIZE_MODIFIER "d " + "to %" TCL_SIZE_MODIFIER "d break %" TCL_SIZE_MODIFIER "d " + "continue %" TCL_SIZE_MODIFIER "d", "loop", rangePtr->nestingLevel, rangePtr->codeOffset, rangePtr->codeOffset + rangePtr->numCodeBytes - 1, rangePtr->breakOffset, rangePtr->continueOffset)); break; case CATCH_EXCEPTION_RANGE: Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf( - "type %s level %" TCL_SIZE_MODIFIER "d from %" TCL_SIZE_MODIFIER "d to %" TCL_SIZE_MODIFIER "d catch %" TCL_SIZE_MODIFIER "d", + "type %s level %" TCL_SIZE_MODIFIER "d from %" TCL_SIZE_MODIFIER "d " + "to %" TCL_SIZE_MODIFIER "d catch %" TCL_SIZE_MODIFIER "d", "catch", rangePtr->nestingLevel, rangePtr->codeOffset, rangePtr->codeOffset + rangePtr->numCodeBytes - 1, rangePtr->catchOffset)); break; } @@ -1267,11 +1279,11 @@ *---------------------------------------------------------------------- */ int Tcl_DisassembleObjCmd( - void *clientData, /* What type of operation. */ + void *clientData, /* What type of operation. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const types[] = { Index: generic/tclEncoding.c ================================================================== --- generic/tclEncoding.c +++ generic/tclEncoding.c @@ -32,13 +32,13 @@ /* Function to convert from UTF-8 into * external encoding. */ Tcl_EncodingFreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - void *clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ - Tcl_Size nullSize; /* Number of 0x00 bytes that signify + Tcl_Size nullSize; /* Number of 0x00 bytes that signify * end-of-string in this encoding. This number * is used to determine the source string * length when the srcLen argument is * negative. This number can be 1, 2, or 4. */ LengthProc *lengthProc; /* Function to compute length of @@ -117,25 +117,27 @@ * character of one of the escape sequences in * the following array, the corresponding * entry in this array is 1, otherwise it is * 0. */ int numSubTables; /* Length of following array. */ - EscapeSubTable subTables[TCLFLEXARRAY];/* Information about each EscapeSubTable used + EscapeSubTable subTables[TCLFLEXARRAY]; + /* Information about each EscapeSubTable used * by this encoding type. The actual size is * as large as necessary to hold all * EscapeSubTables. */ } EscapeEncodingData; /* * Constants used when loading an encoding file to identify the type of the * file. */ - -#define ENCODING_SINGLEBYTE 0 -#define ENCODING_DOUBLEBYTE 1 -#define ENCODING_MULTIBYTE 2 -#define ENCODING_ESCAPE 3 +enum EncodingTypes { + ENCODING_SINGLEBYTE = 0, + ENCODING_DOUBLEBYTE = 1, + ENCODING_MULTIBYTE = 2, + ENCODING_ESCAPE = 3 +}; /* * A list of directories in which Tcl should look for *.enc files. This list * is shared by all threads. Access is governed by a mutex lock. */ @@ -199,23 +201,23 @@ {"replace", TCL_ENCODING_PROFILE_REPLACE}, {"strict", TCL_ENCODING_PROFILE_STRICT}, {"tcl8", TCL_ENCODING_PROFILE_TCL8}, }; -#define PROFILE_TCL8(flags_) \ +#define PROFILE_TCL8(flags_) \ (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8) -#define PROFILE_REPLACE(flags_) \ +#define PROFILE_REPLACE(flags_) \ (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) -#define PROFILE_STRICT(flags_) \ +#define PROFILE_STRICT(flags_) \ (!PROFILE_TCL8(flags_) && !PROFILE_REPLACE(flags_)) #define UNICODE_REPLACE_CHAR 0xFFFD -#define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800) -#define HIGH_SURROGATE(c_) (((c_) & ~0x3FF) == 0xD800) -#define LOW_SURROGATE(c_) (((c_) & ~0x3FF) == 0xDC00) +#define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800) +#define HIGH_SURROGATE(c_) (((c_) & ~0x3FF) == 0xD800) +#define LOW_SURROGATE(c_) (((c_) & ~0x3FF) == 0xDC00) /* * The following variable is used in the sparse matrix code for a * TableEncoding to represent a page in the table that has no entries. */ @@ -256,11 +258,10 @@ static Tcl_EncodingConvertProc UtfToUcs2Proc; static Tcl_EncodingConvertProc UtfToUtfProc; static Tcl_EncodingConvertProc Iso88591FromUtfProc; static Tcl_EncodingConvertProc Iso88591ToUtfProc; - /* * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field * of the internalrep. This should help the lifetime of encodings be more useful. * See concerns raised in [Bug 1077262]. */ @@ -272,25 +273,24 @@ NULL, NULL, TCL_OBJTYPE_V0 }; -#define EncodingSetInternalRep(objPtr, encoding) \ +#define EncodingSetInternalRep(objPtr, encoding) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (encoding); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \ + Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \ } while (0) -#define EncodingGetInternalRep(objPtr, encoding) \ +#define EncodingGetInternalRep(objPtr, encoding) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep ((objPtr), &encodingType); \ - (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &encodingType); \ + (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) - /* *---------------------------------------------------------------------- * * Tcl_GetEncodingFromObj -- @@ -510,13 +510,15 @@ * DEFINED IN tcl.h (TCL_ENCODING_* et al). Be cognizant of this * when adding bits. TODO - should really be defined in a single file. * * To prevent conflicting bits, only define bits within 0xff00 mask here. */ -#define TCL_ENCODING_LE 0x100 /* Used to distinguish LE/BE variants */ -#define ENCODING_UTF 0x200 /* For UTF-8 encoding, allow 4-byte output sequences */ -#define ENCODING_INPUT 0x400 /* For UTF-8/CESU-8 encoding, means external -> internal */ +enum EncodingFlags { + TCL_ENCODING_LE = 0x100, /* Used to distinguish LE/BE variants */ + ENCODING_UTF = 0x200, /* For UTF-8 encoding, allow 4-byte output sequences */ + ENCODING_INPUT = 0x400 /* For UTF-8/CESU-8 encoding, means external -> internal */ +}; void TclInitEncodingSubsystem(void) { Tcl_EncodingType type; @@ -1125,49 +1127,48 @@ * Possible flags values: * target encoding. It should be composed by OR-ing the following: * - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT} * * Results: - * The return value is one of - * TCL_OK: success. Converted string in *dstPtr - * TCL_ERROR: error in passed parameters. Error message in interp - * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence - * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition - * TCL_CONVERT_UNKNOWN: source contained a character that could not - * be represented in target encoding. + * The return value is one of + * TCL_OK: success. Converted string in *dstPtr + * TCL_ERROR: error in passed parameters. Error message in interp + * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence + * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition + * TCL_CONVERT_UNKNOWN: source contained a character that could not + * be represented in target encoding. * * Side effects: - * - * TCL_OK: The converted bytes are stored in the DString and NUL - * terminated in an encoding-specific manner. - * TCL_ERROR: an error, message is stored in the interp if not NULL. - * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored - * in the interpreter (if not NULL). If errorLocPtr is not NULL, - * no error message is stored as it is expected the caller is - * interested in whatever is decoded so far and not treating this - * as an error condition. - * - * In addition, *dstPtr is always initialized and must be cleared - * by the caller irrespective of the return code. + * TCL_OK: The converted bytes are stored in the DString and NUL + * terminated in an encoding-specific manner. + * TCL_ERROR: an error, message is stored in the interp if not NULL. + * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored + * in the interpreter (if not NULL). If errorLocPtr is not NULL, + * no error message is stored as it is expected the caller is + * interested in whatever is decoded so far and not treating this + * as an error condition. + * + * In addition, *dstPtr is always initialized and must be cleared + * by the caller irrespective of the return code. * *------------------------------------------------------------------------- */ int Tcl_ExternalToUtfDStringEx( - Tcl_Interp *interp, /* For error messages. May be NULL. */ + Tcl_Interp *interp, /* For error messages. May be NULL. */ Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - Tcl_Size srcLen, /* Source string length in bytes, or < 0 for + Tcl_Size srcLen, /* Source string length in bytes, or < 0 for * encoding-specific string length. */ int flags, /* Conversion control flags. */ Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ - Tcl_Size *errorLocPtr) /* Where to store the error location - (or TCL_INDEX_NONE if no error). May - be NULL. */ + Tcl_Size *errorLocPtr) /* Where to store the error location + * (or TCL_INDEX_NONE if no error). May + * be NULL. */ { char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; int result; @@ -1428,11 +1429,10 @@ { Tcl_UtfToExternalDStringEx( NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL); return Tcl_DStringValue(dstPtr); } - /* *------------------------------------------------------------------------- * * Tcl_UtfToExternalDStringEx -- @@ -1442,49 +1442,49 @@ * the source buffer are invalid or cannot be represented in the * target encoding. It should be composed by OR-ing the following: * - *At most one* of TCL_ENCODING_PROFILE_* * * Results: - * The return value is one of - * TCL_OK: success. Converted string in *dstPtr - * TCL_ERROR: error in passed parameters. Error message in interp - * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence - * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition - * TCL_CONVERT_UNKNOWN: source contained a character that could not - * be represented in target encoding. + * The return value is one of + * TCL_OK: success. Converted string in *dstPtr + * TCL_ERROR: error in passed parameters. Error message in interp + * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence + * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition + * TCL_CONVERT_UNKNOWN: source contained a character that could not + * be represented in target encoding. * * Side effects: * - * TCL_OK: The converted bytes are stored in the DString and NUL - * terminated in an encoding-specific manner - * TCL_ERROR: an error, message is stored in the interp if not NULL. - * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored - * in the interpreter (if not NULL). If errorLocPtr is not NULL, - * no error message is stored as it is expected the caller is - * interested in whatever is decoded so far and not treating this - * as an error condition. - * - * In addition, *dstPtr is always initialized and must be cleared - * by the caller irrespective of the return code. + * TCL_OK: The converted bytes are stored in the DString and NUL + * terminated in an encoding-specific manner + * TCL_ERROR: an error, message is stored in the interp if not NULL. + * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored + * in the interpreter (if not NULL). If errorLocPtr is not NULL, + * no error message is stored as it is expected the caller is + * interested in whatever is decoded so far and not treating this + * as an error condition. + * + * In addition, *dstPtr is always initialized and must be cleared + * by the caller irrespective of the return code. * *------------------------------------------------------------------------- */ int Tcl_UtfToExternalDStringEx( - Tcl_Interp *interp, /* For error messages. May be NULL. */ + Tcl_Interp *interp, /* For error messages. May be NULL. */ Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ Tcl_Size srcLen, /* Source string length in bytes, or < 0 for * strlen(). */ int flags, /* Conversion control flags. */ Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ - Tcl_Size *errorLocPtr) /* Where to store the error location - (or TCL_INDEX_NONE if no error). May - be NULL. */ + Tcl_Size *errorLocPtr) /* Where to store the error location + * (or TCL_INDEX_NONE if no error). May + * be NULL. */ { char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; int result; @@ -2460,11 +2460,10 @@ flags |= PTR2INT(clientData); dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6); profile = ENCODING_PROFILE_GET(flags); for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { - if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. */ @@ -2501,11 +2500,10 @@ * irrespective of the profile. */ *dst++ = 0; src += 2; } - } else if (!Tcl_UtfCharComplete(src, srcEnd - src)) { /* * Incomplete byte sequence. * Always check before using Tcl_UtfToUniChar. Not doing so can cause * it to run beyond the end of the buffer! If we happen on such an @@ -2515,12 +2513,12 @@ if (flags & ENCODING_INPUT) { /* Incomplete bytes for modified UTF-8 target */ if (PROFILE_STRICT(profile)) { result = (flags & TCL_ENCODING_CHAR_LIMIT) - ? TCL_CONVERT_MULTIBYTE - : TCL_CONVERT_SYNTAX; + ? TCL_CONVERT_MULTIBYTE + : TCL_CONVERT_SYNTAX; break; } } if (PROFILE_REPLACE(profile)) { ch = UNICODE_REPLACE_CHAR; @@ -2595,11 +2593,11 @@ *------------------------------------------------------------------------- */ static int Utf32ToUtfProc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in Unicode. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is @@ -2724,11 +2722,11 @@ *------------------------------------------------------------------------- */ static int UtfToUtf32Proc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is @@ -2823,11 +2821,11 @@ *------------------------------------------------------------------------- */ static int Utf16ToUtfProc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in Unicode. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is @@ -3001,11 +2999,11 @@ *------------------------------------------------------------------------- */ static int UtfToUtf16Proc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is @@ -3109,11 +3107,11 @@ *------------------------------------------------------------------------- */ static int UtfToUcs2Proc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is @@ -3213,11 +3211,11 @@ *------------------------------------------------------------------------- */ static int TableToUtfProc( - void *clientData, /* TableEncodingData that specifies + void *clientData, /* TableEncodingData that specifies * encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ TCL_UNUSED(Tcl_EncodingState *), @@ -3341,11 +3339,11 @@ *------------------------------------------------------------------------- */ static int TableFromUtfProc( - void *clientData, /* TableEncodingData that specifies + void *clientData, /* TableEncodingData that specifies * encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ TCL_UNUSED(Tcl_EncodingState *), @@ -3633,11 +3631,11 @@ *--------------------------------------------------------------------------- */ static void TableFreeProc( - void *clientData) /* TableEncodingData that specifies + void *clientData) /* TableEncodingData that specifies * encoding. */ { TableEncodingData *dataPtr = (TableEncodingData *)clientData; /* @@ -3668,11 +3666,11 @@ *------------------------------------------------------------------------- */ static int EscapeToUtfProc( - void *clientData, /* EscapeEncodingData that specifies + void *clientData, /* EscapeEncodingData that specifies * encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state @@ -3881,11 +3879,11 @@ *------------------------------------------------------------------------- */ static int EscapeFromUtfProc( - void *clientData, /* EscapeEncodingData that specifies + void *clientData, /* EscapeEncodingData that specifies * encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state @@ -4092,11 +4090,11 @@ *--------------------------------------------------------------------------- */ static void EscapeFreeProc( - void *clientData) /* EscapeEncodingData that specifies + void *clientData) /* EscapeEncodingData that specifies * encoding. */ { EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData; EscapeSubTable *subTablePtr; int i; @@ -4317,15 +4315,15 @@ for (i = 0; i < (numProfiles - 1); ++i) { Tcl_AppendStringsToObj( errorObj, " ", encodingProfiles[i].name, ",", (void *)NULL); } Tcl_AppendStringsToObj( - errorObj, " or ", encodingProfiles[numProfiles-1].name, (void *)NULL); + errorObj, " or ", encodingProfiles[numProfiles-1].name, (void *)NULL); Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode( - interp, "TCL", "ENCODING", "PROFILE", profileName, (void *)NULL); + interp, "TCL", "ENCODING", "PROFILE", profileName, (void *)NULL); } return TCL_ERROR; } /* @@ -4358,11 +4356,11 @@ if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Internal error. Bad profile id \"%d\".", profileValue)); Tcl_SetErrorCode( - interp, "TCL", "ENCODING", "PROFILEID", (void *)NULL); + interp, "TCL", "ENCODING", "PROFILEID", (void *)NULL); } return NULL; } /* @@ -4386,12 +4384,12 @@ size_t i, n; Tcl_Obj *objPtr; n = sizeof(encodingProfiles) / sizeof(encodingProfiles[0]); objPtr = Tcl_NewListObj(n, NULL); for (i = 0; i < n; ++i) { - Tcl_ListObjAppendElement( - interp, objPtr, Tcl_NewStringObj(encodingProfiles[i].name, TCL_INDEX_NONE)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj(encodingProfiles[i].name, TCL_INDEX_NONE)); } Tcl_SetObjResult(interp, objPtr); } /* Index: generic/tclEnsemble.c ================================================================== --- generic/tclEnsemble.c +++ generic/tclEnsemble.c @@ -83,39 +83,39 @@ NULL, /* updateStringProc */ NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; -#define ECRSetInternalRep(objPtr, ecRepPtr) \ +#define ECRSetInternalRep(objPtr, ecRepPtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (ecRepPtr); \ ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreInternalRep((objPtr), &ensembleCmdType, &ir); \ } while (0) -#define ECRGetInternalRep(objPtr, ecRepPtr) \ +#define ECRGetInternalRep(objPtr, ecRepPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &ensembleCmdType); \ - (ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &ensembleCmdType); \ + (ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * The internal rep for caching ensemble subcommand lookups and spelling * corrections. */ typedef struct { - Tcl_Size 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 - * structure is a cache of the resolution. */ - Tcl_Obj *fix; /* Corrected spelling, if needed. */ - Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash - * table. */ + Tcl_Size 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 + * structure is a cache of the resolution. */ + Tcl_Obj *fix; /* Corrected spelling, if needed. */ + Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash + * table. */ } EnsembleCmdRep; static inline Tcl_Obj * NewNsObj( Tcl_Namespace *namespacePtr) @@ -125,10 +125,22 @@ if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) { return Tcl_NewStringObj("::", 2); } return Tcl_NewStringObj(nsPtr->fullName, -1); } + +static inline int +ThrowNotEnsemble( + Tcl_Interp *interp) +{ + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", TCL_AUTO_LENGTH)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); + } + return TCL_ERROR; +} /* *---------------------------------------------------------------------- * * TclNamespaceEnsembleCmd -- @@ -795,14 +807,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - return TCL_ERROR; + return ThrowNotEnsemble(interp); } if (subcmdList != NULL) { Tcl_Size length; if (TclListObjLength(interp, subcmdList, &length) != TCL_OK) { @@ -871,14 +880,11 @@ EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; Tcl_Size length; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - return TCL_ERROR; + return ThrowNotEnsemble(interp); } if (paramList == NULL) { length = 0; } else { if (TclListObjLength(interp, paramList, &length) != TCL_OK) { @@ -947,14 +953,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldDict; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - return TCL_ERROR; + return ThrowNotEnsemble(interp); } if (mapDict != NULL) { Tcl_Size size; int done; Tcl_DictSearch search; @@ -1047,14 +1050,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - return TCL_ERROR; + return ThrowNotEnsemble(interp); } if (unknownList != NULL) { Tcl_Size length; if (TclListObjLength(interp, unknownList, &length) != TCL_OK) { @@ -1113,14 +1113,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; int wasCompiled; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - return TCL_ERROR; + return ThrowNotEnsemble(interp); } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE; @@ -1189,16 +1186,11 @@ { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - } - return TCL_ERROR; + return ThrowNotEnsemble(interp); } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *subcmdListPtr = ensemblePtr->subcmdList; return TCL_OK; @@ -1231,16 +1223,11 @@ { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - } - return TCL_ERROR; + return ThrowNotEnsemble(interp); } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *paramListPtr = ensemblePtr->parameterList; return TCL_OK; @@ -1273,16 +1260,11 @@ { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - } - return TCL_ERROR; + return ThrowNotEnsemble(interp); } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *mapDictPtr = ensemblePtr->subcommandDict; return TCL_OK; @@ -1314,16 +1296,11 @@ { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - } - return TCL_ERROR; + return ThrowNotEnsemble(interp); } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *unknownListPtr = ensemblePtr->unknownHandler; return TCL_OK; @@ -1355,16 +1332,11 @@ { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - } - return TCL_ERROR; + return ThrowNotEnsemble(interp); } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *flagsPtr = ensemblePtr->flags; return TCL_OK; @@ -1396,16 +1368,11 @@ { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); - Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); - } - return TCL_ERROR; + return ThrowNotEnsemble(interp); } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr; return TCL_OK; @@ -1797,11 +1764,10 @@ */ hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, TclGetString(subObj)); if (hPtr != NULL) { - /* * Cache ensemble in the subcommand object for later. */ MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, NULL); @@ -2482,19 +2448,19 @@ EnsembleConfig *ensemblePtr) { Tcl_HashTable *hash = &ensemblePtr->subcommandTable; if (hash->numEntries != 0) { - Tcl_HashSearch search; - Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search); - - while (hPtr != NULL) { - Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(prefixObj); - hPtr = Tcl_NextHashEntry(&search); - } - Tcl_Free(ensemblePtr->subcommandArrayPtr); + Tcl_HashSearch search; + Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search); + + while (hPtr != NULL) { + Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); + Tcl_DecrRefCount(prefixObj); + hPtr = Tcl_NextHashEntry(&search); + } + Tcl_Free(ensemblePtr->subcommandArrayPtr); } Tcl_DeleteHashTable(hash); } static void @@ -2593,104 +2559,104 @@ ClearTable(ensemblePtr); Tcl_InitHashTable(hash, TCL_STRING_KEYS); if (subList) { - Tcl_Size subc; - Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; - const char *name; - - /* - * There is a list of exactly what subcommands go in the table. - * Determine the target for each. - */ - - TclListObjGetElements(NULL, subList, &subc, &subv); - if (subList == mapDict) { - /* - * Unusual case where explicit list of subcommands is same value - * as the dict mapping to targets. - */ - - for (i = 0; i < subc; i += 2) { - name = TclGetString(subv[i]); - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - if (!isNew) { - cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(cmdObj); - } - Tcl_SetHashValue(hPtr, subv[i+1]); - Tcl_IncrRefCount(subv[i+1]); - - name = TclGetString(subv[i+1]); - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - if (isNew) { - cmdObj = Tcl_NewStringObj(name, -1); - cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); - Tcl_SetHashValue(hPtr, cmdPrefixObj); - Tcl_IncrRefCount(cmdPrefixObj); - } - } - } else { - /* + Tcl_Size subc; + Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; + const char *name; + + /* + * There is a list of exactly what subcommands go in the table. + * Determine the target for each. + */ + + TclListObjGetElements(NULL, subList, &subc, &subv); + if (subList == mapDict) { + /* + * Unusual case where explicit list of subcommands is same value + * as the dict mapping to targets. + */ + + for (i = 0; i < subc; i += 2) { + name = TclGetString(subv[i]); + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + if (!isNew) { + cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); + Tcl_DecrRefCount(cmdObj); + } + Tcl_SetHashValue(hPtr, subv[i+1]); + Tcl_IncrRefCount(subv[i+1]); + + name = TclGetString(subv[i+1]); + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + if (isNew) { + cmdObj = Tcl_NewStringObj(name, -1); + cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); + Tcl_SetHashValue(hPtr, cmdPrefixObj); + Tcl_IncrRefCount(cmdPrefixObj); + } + } + } else { + /* * Usual case where we can freely act on the list and dict. */ - for (i = 0; i < subc; i++) { - name = TclGetString(subv[i]); - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - if (!isNew) { - continue; - } - - /* + for (i = 0; i < subc; i++) { + name = TclGetString(subv[i]); + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + if (!isNew) { + continue; + } + + /* * Lookup target in the dictionary. */ - if (mapDict) { - Tcl_DictObjGet(NULL, mapDict, subv[i], &target); - if (target) { - Tcl_SetHashValue(hPtr, target); - Tcl_IncrRefCount(target); - continue; - } - } - - /* - * Target was not in the dictionary. Map onto the namespace. - * In this case there is no guarantee that the command - * is actually there. It is the responsibility of the + if (mapDict) { + Tcl_DictObjGet(NULL, mapDict, subv[i], &target); + if (target) { + Tcl_SetHashValue(hPtr, target); + Tcl_IncrRefCount(target); + continue; + } + } + + /* + * Target was not in the dictionary. Map onto the namespace. + * In this case there is no guarantee that the command + * is actually there. It is the responsibility of the * programmer (or [::unknown] of course) to provide the procedure. - */ - - cmdObj = Tcl_NewStringObj(name, -1); - cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); - Tcl_SetHashValue(hPtr, cmdPrefixObj); - Tcl_IncrRefCount(cmdPrefixObj); - } - } + */ + + cmdObj = Tcl_NewStringObj(name, -1); + cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); + Tcl_SetHashValue(hPtr, cmdPrefixObj); + Tcl_IncrRefCount(cmdPrefixObj); + } + } } else if (mapDict) { - /* - * No subcmd list, but there is a mapping dictionary, so - * use the keys of that. Convert the contents of the dictionary into the - * form required for the internal hashtable of the ensemble. - */ - - Tcl_DictSearch dictSearch; - Tcl_Obj *keyObj, *valueObj; - int done; - - Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, - &keyObj, &valueObj, &done); - while (!done) { - const char *name = TclGetString(keyObj); - - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - Tcl_SetHashValue(hPtr, valueObj); - Tcl_IncrRefCount(valueObj); - Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); - } + /* + * No subcmd list, but there is a mapping dictionary, so + * use the keys of that. Convert the contents of the dictionary into the + * form required for the internal hashtable of the ensemble. + */ + + Tcl_DictSearch dictSearch; + Tcl_Obj *keyObj, *valueObj; + int done; + + Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, + &keyObj, &valueObj, &done); + while (!done) { + const char *name = TclGetString(keyObj); + + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + Tcl_SetHashValue(hPtr, valueObj); + Tcl_IncrRefCount(valueObj); + Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); + } } else { /* * Use the array of patterns and the hash table whose keys are the * commands exported by the namespace. The corresponding values do not * matter here. Filter the commands in the namespace against the @@ -3191,13 +3157,13 @@ /* * Throw out any line information generated by the failed compile attempt. */ while (mapPtr->nuloc > eclIndex + 1) { - mapPtr->nuloc--; - Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); - mapPtr->loc[mapPtr->nuloc].line = NULL; + mapPtr->nuloc--; + Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); + mapPtr->loc[mapPtr->nuloc].line = NULL; } /* * Reset the index of next command. Toss out any from failed nested * partial compiles. Index: generic/tclEnv.c ================================================================== --- generic/tclEnv.c +++ generic/tclEnv.c @@ -34,21 +34,20 @@ # define utf2tenvirondstr(str, dsPtr) \ Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) # define techar char #endif - /* MODULE_SCOPE */ -size_t TclEnvEpoch = 0; /* Epoch of the tcl environment +size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ static struct { Tcl_Size cacheSize; /* Number of env strings in cache. */ char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ #ifndef USE_PUTENV - techar **ourEnviron; /* Cache of the array that we allocate. We + techar **ourEnviron; /* Cache of the array that we allocate. We * need to track this in case another * subsystem swaps around the environ array * like we do. */ Tcl_Size ourEnvironSize; /* Non-zero means that the environ array was * malloced and has this many total entries @@ -808,10 +807,11 @@ */ if (env.cache) { #ifdef PURIFY Tcl_Size i; + for (i = 0; i < env.cacheSize; i++) { Tcl_Free(env.cache[i]); } #endif Tcl_Free(env.cache); Index: generic/tclEvent.c ================================================================== --- generic/tclEvent.c +++ generic/tclEvent.c @@ -67,11 +67,11 @@ * there is a structure of the following type: */ typedef struct ExitHandler { Tcl_ExitProc *proc; /* Function to call when process exits. */ - void *clientData; /* One word of information to pass to proc. */ + void *clientData; /* One word of information to pass to proc. */ struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this * application, or NULL for end of list. */ } ExitHandler; /* @@ -117,11 +117,11 @@ static Tcl_ThreadDataKey dataKey; #if TCL_THREADS typedef struct { Tcl_ThreadCreateProc *proc; /* Main() function of the thread */ - void *clientData; /* The one argument to Main() */ + void *clientData; /* The one argument to Main() */ } ThreadClientData; static Tcl_ThreadCreateType NewThreadProc(void *clientData); #endif /* TCL_THREADS */ /* @@ -207,11 +207,11 @@ *---------------------------------------------------------------------- */ static void HandleBgErrors( - void *clientData) /* Pointer to ErrAssocData structure. */ + void *clientData) /* Pointer to ErrAssocData structure. */ { ErrAssocData *assocPtr = (ErrAssocData *)clientData; Tcl_Interp *interp = assocPtr->interp; BgError *errPtr; @@ -611,11 +611,11 @@ *---------------------------------------------------------------------- */ static void BgErrorDeleteProc( - void *clientData, /* Pointer to ErrAssocData structure. */ + void *clientData, /* Pointer to ErrAssocData structure. */ TCL_UNUSED(Tcl_Interp *)) { ErrAssocData *assocPtr = (ErrAssocData *)clientData; BgError *errPtr; @@ -650,11 +650,11 @@ */ void Tcl_CreateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; @@ -683,11 +683,11 @@ */ void TclCreateLateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; @@ -716,11 +716,11 @@ */ void Tcl_DeleteExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; Tcl_MutexLock(&exitMutex); for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL; @@ -759,11 +759,11 @@ */ void TclDeleteLateExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; Tcl_MutexLock(&exitMutex); for (prevPtr = NULL, exitPtr = firstLateExitPtr; exitPtr != NULL; @@ -802,11 +802,11 @@ */ void Tcl_CreateThreadExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler)); @@ -835,11 +835,11 @@ */ void Tcl_DeleteThreadExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL; @@ -875,11 +875,11 @@ *---------------------------------------------------------------------- */ Tcl_ExitProc * Tcl_SetExitProc( - TCL_NORETURN1 Tcl_ExitProc *proc) /* New exit handler for app or NULL */ + TCL_NORETURN1 Tcl_ExitProc *proc) /* New exit handler for app or NULL */ { Tcl_ExitProc *prevExitProc; /* * Swap the old exit proc for the new one, saving the old one for our @@ -972,25 +972,19 @@ * If subsystems are not (yet) initialized, proper Tcl-finalization is * impossible, so fallback to system exit, see bug-[f8a33ce3db5d8cc2]. */ if (currentAppExitPtr) { - currentAppExitPtr(INT2PTR(status)); - } else if (subsystemsInitialized) { - if (TclFullFinalizationRequested()) { - /* * Thorough finalization for Valgrind et al. */ Tcl_Finalize(); - } else { - /* * Fast and deterministic exit (default behavior) */ InvokeExitHandlers(); @@ -1133,12 +1127,11 @@ * this routine from some of the functions below. */ TclpInitLock(); if (subsystemsInitialized == 0) { - - /* + /* * Initialize locks used by the memory allocators before anything * interesting happens so we can use the allocators in the * implementation of self-initializing locks. */ @@ -2053,11 +2046,11 @@ int Tcl_CreateThread( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ void *clientData, /* The one argument to Main() */ - size_t 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 = (ThreadClientData *)Tcl_Alloc(sizeof(ThreadClientData)); Index: generic/tclExecute.c ================================================================== --- generic/tclExecute.c +++ generic/tclExecute.c @@ -190,21 +190,21 @@ */ /* Verify the stack depth, only when no expansion is in progress */ #ifdef TCL_COMPILE_DEBUG -#define CHECK_STACK() \ +#define CHECK_STACK() \ do { \ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \ /*checkStack*/ !(starting || auxObjList)); \ starting = 0; \ } while (0) #else #define CHECK_STACK() #endif -#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ +#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ do { \ TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ CHECK_STACK(); \ if (nCleanup == 0) { \ if (resultHandling != 0) { \ @@ -234,11 +234,11 @@ case 0: break; \ } \ } \ } while (0) -#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ +#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ CHECK_STACK(); \ do { \ pc += (pcAdjustment); \ cleanup = (nCleanup); \ if (resultHandling) { \ @@ -374,16 +374,27 @@ * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is * only used in TRACE* calls to get a string from an object. */ #ifdef TCL_COMPILE_DEBUG + +/* Factor out a large print so we only get warnings about it once. */ +static inline void +PrintTracePrefix( + Interp *iPtr, + int currDepth, + const ByteCode *codePtr, + const unsigned char *pc) +{ + fprintf(stdout, + "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", + iPtr->numLevels, currDepth, pc - codePtr->codeStart, GetOpcodeName(pc)); +} + # define TRACE(a) \ while (traceInstructions) { \ - fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ - GetOpcodeName(pc)); \ + PrintTracePrefix(iPtr, CURR_DEPTH, codePtr, pc); \ printf a; \ break; \ } # define TRACE_APPEND(a) \ while (traceInstructions) { \ @@ -392,14 +403,11 @@ } # define TRACE_ERROR(interp) \ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); # define TRACE_WITH_OBJ(a, objPtr) \ while (traceInstructions) { \ - fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ - GetOpcodeName(pc)); \ + PrintTracePrefix(iPtr, CURR_DEPTH, codePtr, pc); \ printf a; \ TclPrintObject(stdout, objPtr, 30); \ fprintf(stdout, "\n"); \ break; \ } @@ -601,11 +609,11 @@ */ #define DIVIDED_BY_ZERO ((Tcl_Obj *) -1) #define EXPONENT_OF_ZERO ((Tcl_Obj *) -2) #define GENERAL_ARITHMETIC_ERROR ((Tcl_Obj *) -3) -#define OUT_OF_MEMORY ((Tcl_Obj *) -4) +#define OUT_OF_MEMORY ((Tcl_Obj *) -4) /* * Declarations for local procedures to this file: */ @@ -1021,11 +1029,10 @@ if (move) { moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1; } needed = growth + moveWords + WALLOCALIGN; - /* * Check if there is enough room in the next stack (if there is one, it * should be both empty and the last one!) */ @@ -1561,11 +1568,11 @@ Tcl_Obj *objPtr, const CmdFrame *invoker, int word) { Interp *iPtr = (Interp *) interp; - ByteCode *codePtr; /* Tcl Internal type of bytecode. */ + ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; /* * If the object is not already of tclByteCodeType, compile it (and reset * the compilation flags in the interpreter; this should be done after any @@ -2025,21 +2032,21 @@ */ Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ const unsigned char *pc = (const unsigned char *)data[1]; - /* The current program counter. */ - unsigned char inst; /* The currently running instruction */ + /* The current program counter. */ + unsigned char inst; /* The currently running instruction */ /* * Transfer variables - needed only between opcodes, but not while * executing an instruction. */ int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; - int checkInterp = 0; /* Indicates when a check of interp readyness + int checkInterp = 0; /* Indicates when a check of interp readyness * is necessary. Set by CACHE_STACK_INFO() */ /* * Locals - variables that are used within opcodes or bounded sections of * the file (jumps between opcodes within a family). @@ -2089,11 +2096,11 @@ iPtr->objResultPtr = objPtr; } goto cleanup0; } else { - /* resume from invocation */ + /* resume from invocation */ CACHE_STACK_INFO(); NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); if (bcFramePtr->cmdObj) { Tcl_DecrRefCount(bcFramePtr->cmdObj); @@ -2522,11 +2529,10 @@ goto processExceptionReturn; } case INST_DONE: if (tosPtr > initTosPtr) { - if ((curEvalFlags & TCL_EVAL_DISCARD_RESULT) && (result == TCL_OK)) { /* simulate pop & fast done (like it does continue in loop) */ TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); @@ -4761,24 +4767,24 @@ */ { Tcl_Size value2Length; Tcl_Obj *indexListPtr = value2Ptr; + int code; if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK) && (!TclHasInternalRep(value2Ptr, &tclListType) || (Tcl_ListObjLength(interp, value2Ptr, &value2Length), value2Length == 1 ? (indexListPtr = TclListObjGetElement(value2Ptr, 0), 1) : 0))) { - int code; - - /* increment the refCount of value2Ptr because TclListObjGetElement may + /* + * Increment the refCount of value2Ptr because TclListObjGetElement may * have just extracted it from a list in the condition for this block. */ + Tcl_IncrRefCount(indexListPtr); - DECACHE_STACK_INFO(); code = TclGetIntForIndexM(interp, indexListPtr, objc-1, &index); TclDecrRefCount(indexListPtr); CACHE_STACK_INFO(); if (code == TCL_OK) { @@ -4923,11 +4929,11 @@ DECACHE_STACK_INFO(); if (TclObjTypeHasProc(valuePtr, setElementProc)) { objResultPtr = TclObjTypeSetElement(interp, valuePtr, numIndices, - &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); + &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } else { objResultPtr = TclLsetFlat(interp, valuePtr, numIndices, &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } if (!objResultPtr) { @@ -5072,64 +5078,63 @@ case INST_LIST_IN: case INST_LIST_NOT_IN: /* Basic list containment operators. */ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - s1 = TclGetStringFromObj(valuePtr, &s1len); - TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); - - if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) { - int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match); - if (status != TCL_OK) { - TRACE_ERROR(interp); - goto gotError; - } - } else { - - if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { - TRACE_ERROR(interp); - goto gotError; - } - match = 0; - if (length > 0) { - Tcl_Size i = 0; - Tcl_Obj *o; - int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL; - - /* - * An empty list doesn't match anything. - */ - - do { - if (isAbstractList) { - DECACHE_STACK_INFO(); - if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) { - CACHE_STACK_INFO(); - TRACE_ERROR(interp); - goto gotError; - } - CACHE_STACK_INFO(); - } else { - Tcl_ListObjIndex(NULL, value2Ptr, i, &o); - } - if (o != NULL) { - s2 = TclGetStringFromObj(o, &s2len); - } else { - s2 = ""; - s2len = 0; - } - if (s1len == s2len) { - match = (memcmp(s1, s2, s1len) == 0); - } - - /* Could be an ephemeral abstract obj */ - Tcl_BounceRefCount(o); - - i++; - } while (i < length && match == 0); - } - } + s1 = TclGetStringFromObj(valuePtr, &s1len); + TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); + + if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) { + int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match); + if (status != TCL_OK) { + TRACE_ERROR(interp); + goto gotError; + } + } else { + if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { + TRACE_ERROR(interp); + goto gotError; + } + match = 0; + if (length > 0) { + Tcl_Size i = 0; + Tcl_Obj *o; + int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL; + + /* + * An empty list doesn't match anything. + */ + + do { + if (isAbstractList) { + DECACHE_STACK_INFO(); + if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) { + CACHE_STACK_INFO(); + TRACE_ERROR(interp); + goto gotError; + } + CACHE_STACK_INFO(); + } else { + Tcl_ListObjIndex(NULL, value2Ptr, i, &o); + } + if (o != NULL) { + s2 = TclGetStringFromObj(o, &s2len); + } else { + s2 = ""; + s2len = 0; + } + if (s1len == s2len) { + match = (memcmp(s1, s2, s1len) == 0); + } + + /* Could be an ephemeral abstract obj */ + Tcl_BounceRefCount(o); + + i++; + } while (i < length && match == 0); + } + } if (*pc == INST_LIST_NOT_IN) { match = !match; } @@ -5561,11 +5566,11 @@ end = ustring1 + slength; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && /* Fix bug [69218ab7b]: restrict max compare length. */ ((end - ustring1) >= length2) && (length2 == 1 || - memcmp(ustring1, ustring2, + memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); p = ustring1 + length2; } else { @@ -5790,13 +5795,13 @@ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; /* - Try to determine, without triggering generation of a string - representation, whether one value is not a number. - */ + * Try to determine, without triggering generation of a string + * representation, whether one value is not a number. + */ if (TclCheckEmptyString(valuePtr) > 0 || TclCheckEmptyString(value2Ptr) > 0) { goto stringCompare; } if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK @@ -6601,11 +6606,10 @@ if (status != TCL_OK) { CACHE_STACK_INFO(); goto gotError; } CACHE_STACK_INFO(); - valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { if (valIndex >= listLen) { TclNewObj(valuePtr); @@ -7868,12 +7872,14 @@ * WidePwrSmallExpon -- * * Helper to calculate small powers of integers whose result is wide. */ static inline Tcl_WideInt -WidePwrSmallExpon(Tcl_WideInt w1, long exponent) { - +WidePwrSmallExpon( + Tcl_WideInt w1, + long exponent) +{ Tcl_WideInt wResult; wResult = w1 * w1; /* b**2 */ switch (exponent) { case 2: @@ -8373,11 +8379,10 @@ return constants[1]; } } } if (negativeExponent) { - /* * Integers with magnitude greater than 1 raise to a negative * power yield the answer zero (see TIP 123). */ return constants[0]; @@ -8958,11 +8963,11 @@ *---------------------------------------------------------------------- */ static void PrintByteCodeInfo( - 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; @@ -8982,11 +8987,11 @@ #endif 0.0); #ifdef TCL_COMPILE_STATS fprintf(stdout, " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER - "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n", + "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n", codePtr->structureSize, offsetof(ByteCode, localCachePtr), codePtr->numCodeBytes, codePtr->numLitObjects * sizeof(Tcl_Obj *), codePtr->numExceptRanges*sizeof(ExceptionRange), @@ -9022,11 +9027,11 @@ */ #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( - 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. */ size_t stackTop, /* Current stack top. Must be between * stackLowerBound and stackUpperBound @@ -9094,11 +9099,11 @@ static void IllegalExprOperandType( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ - const unsigned char *pc, /* Points to the instruction being executed + const unsigned char *pc, /* Points to the instruction being executed * when the illegal type was found. */ Tcl_Obj *opndPtr) /* Points to the operand holding the value * with the illegal type. */ { void *ptr; @@ -9158,25 +9163,25 @@ CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]) { if (cfPtr == NULL) { - return Tcl_NewListObj(objc, objv); + return Tcl_NewListObj(objc, objv); } if (cfPtr->cmdObj == NULL) { - if (cfPtr->cmd == NULL) { + if (cfPtr->cmd == NULL) { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; - cfPtr->cmd = GetSrcInfoForPc((unsigned char *) + cfPtr->cmd = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); - } + } if (cfPtr->cmd) { cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); } else { cfPtr->cmdObj = Tcl_NewListObj(objc, objv); } - Tcl_IncrRefCount(cfPtr->cmdObj); + Tcl_IncrRefCount(cfPtr->cmdObj); } return cfPtr->cmdObj; } void @@ -9186,11 +9191,10 @@ ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; assert(cfPtr->type == TCL_LOCATION_BC); if (cfPtr->cmd == NULL) { - cfPtr->cmd = GetSrcInfoForPc( (unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); } @@ -9544,11 +9548,11 @@ *---------------------------------------------------------------------- */ int TclLog2( - int value) /* The integer for which to compute the log + int value) /* The integer for which to compute the log * base 2. */ { int n = value; int result = 0; Index: generic/tclFCmd.c ================================================================== --- generic/tclFCmd.c +++ generic/tclFCmd.c @@ -260,11 +260,10 @@ target = Tcl_FSJoinPath(split, j + 1); Tcl_IncrRefCount(target); createDir: - /* * Call Tcl_FSStat() so that if target is a symlink that points to * a directory we will create subdirectories in that directory. */ @@ -427,23 +426,25 @@ } else { result = Tcl_FSDeleteFile(objv[i]); } if (result != TCL_OK) { - /* * Avoid possible race condition (file/directory deleted after call * of lstat), so bypass ENOENT because not an error, just a no-op */ + if (errno == ENOENT) { result = TCL_OK; continue; } + /* * It is important that we break on error, otherwise we might end * up owning reference counts on numerous errorBuffers. */ + result = TCL_ERROR; break; } } if (result != TCL_OK) { Index: generic/tclFileName.c ================================================================== --- generic/tclFileName.c +++ generic/tclFileName.c @@ -38,13 +38,14 @@ static int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *pathPrefix, int globFlags, Tcl_GlobTypeData *types); /* Flag values used by TclGlob() */ - -#define TCL_GLOBMODE_DIR 4 -#define TCL_GLOBMODE_TAILS 8 +enum TclGlobFlags { + TCL_GLOBMODE_DIR = 4, + TCL_GLOBMODE_TAILS = 8 +}; /* * When there is no support for getting the block size of a file in a stat() * call, use this as a guess. Allow it to be overridden in the platform- * specific files. @@ -249,19 +250,17 @@ if (path[4] == '\0') { abs = 4; } else if (path[4] == ':' && path[5] == '\0') { abs = 5; } - } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { /* * Have match for 'con'. */ abs = 3; } - } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { if (path[3] >= '1' && path[3] <= '9') { /* @@ -272,30 +271,27 @@ abs = 4; } else if (path[4] == ':' && path[5] == '\0') { abs = 5; } } - } else if ((path[0] == 'p' || path[0] == 'P') && (path[1] == 'r' || path[1] == 'R') && (path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { /* * Have match for 'prn'. */ abs = 3; - } else if ((path[0] == 'n' || path[0] == 'N') && (path[1] == 'u' || path[1] == 'U') && (path[2] == 'l' || path[2] == 'L') && path[3] == '\0') { /* * Have match for 'nul'. */ abs = 3; - } else if ((path[0] == 'a' || path[0] == 'A') && (path[1] == 'u' || path[1] == 'U') && (path[2] == 'x' || path[2] == 'X') && path[3] == '\0') { /* @@ -388,54 +384,54 @@ Tcl_PathType type = TCL_PATH_ABSOLUTE; const char *path = TclGetString(pathPtr); switch (tclPlatform) { case TCL_PLATFORM_UNIX: { - const char *origPath = path; - - /* - * Paths that begin with / are absolute. - */ - - if (path[0] == '/') { - ++path; - /* - * Check for "//" network path prefix - */ - if ((*path == '/') && path[1] && (path[1] != '/')) { - path += 2; - while (*path && *path != '/') { - ++path; - } - } - if (driveNameLengthPtr != NULL) { - /* - * We need this addition in case the "//" code was used. - */ - - *driveNameLengthPtr = (path - origPath); - } - } else { - type = TCL_PATH_RELATIVE; - } - break; + const char *origPath = path; + + /* + * Paths that begin with / are absolute. + */ + + if (path[0] == '/') { + ++path; + /* + * Check for "//" network path prefix + */ + if ((*path == '/') && path[1] && (path[1] != '/')) { + path += 2; + while (*path && *path != '/') { + ++path; + } + } + if (driveNameLengthPtr != NULL) { + /* + * We need this addition in case the "//" code was used. + */ + + *driveNameLengthPtr = (path - origPath); + } + } else { + type = TCL_PATH_RELATIVE; + } + break; } case TCL_PLATFORM_WINDOWS: { - Tcl_DString ds; - const char *rootEnd; - - Tcl_DStringInit(&ds); - rootEnd = ExtractWinRoot(path, &ds, 0, &type); - if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { - *driveNameLengthPtr = rootEnd - path; - if (driveNameRef != NULL) { - *driveNameRef = Tcl_DStringToObj(&ds); - Tcl_IncrRefCount(*driveNameRef); - } - } - Tcl_DStringFree(&ds); - break; + Tcl_DString ds; + const char *rootEnd; + + Tcl_DStringInit(&ds); + rootEnd = ExtractWinRoot(path, &ds, 0, &type); + if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { + *driveNameLengthPtr = rootEnd - path; + if (driveNameRef != NULL) { + *driveNameRef = Tcl_DStringToObj(&ds); + Tcl_IncrRefCount(*driveNameRef); + } + } + Tcl_DStringFree(&ds); + break; } } return type; } @@ -652,13 +648,13 @@ while ((*path != '\0') && (*path != '/')) { path++; } length = path - elementStart; if (length > 0) { - Tcl_Obj *nextElt; - nextElt = Tcl_NewStringObj(elementStart, length); - Tcl_ListObjAppendElement(NULL, result, nextElt); + Tcl_Obj *nextElt = Tcl_NewStringObj(elementStart, length); + + Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*path++ == '\0') { break; } } @@ -715,10 +711,11 @@ p++; } length = p - elementStart; if (length > 0) { Tcl_Obj *nextElt; + if ((elementStart != path) && isalpha(UCHAR(elementStart[0])) && (elementStart[1] == ':')) { TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); @@ -1160,17 +1157,17 @@ break; } } switch (index) { - case GLOB_NOCOMPLAIN: /* -nocomplain */ + case GLOB_NOCOMPLAIN: /* -nocomplain */ /* * Do nothing; This is normal operations in Tcl 9. * Keep accepting as a no-op option to accommodate old scripts. */ break; - case GLOB_DIR: /* -dir */ + case GLOB_DIR: /* -dir */ if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-directory\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL); return TCL_ERROR; @@ -1188,17 +1185,17 @@ dir = PATH_DIR; globFlags |= TCL_GLOBMODE_DIR; pathOrDir = objv[i+1]; i++; break; - case GLOB_JOIN: /* -join */ + case GLOB_JOIN: /* -join */ join = 1; break; - case GLOB_TAILS: /* -tails */ + case GLOB_TAILS: /* -tails */ globFlags |= TCL_GLOBMODE_TAILS; break; - case GLOB_PATH: /* -path */ + case GLOB_PATH: /* -path */ if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-path\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL); return TCL_ERROR; @@ -1215,11 +1212,11 @@ } dir = PATH_GENERAL; pathOrDir = objv[i+1]; i++; break; - case GLOB_TYPE: /* -types */ + case GLOB_TYPE: /* -types */ if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-types\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL); return TCL_ERROR; @@ -1228,11 +1225,11 @@ if (TclListObjLength(interp, typePtr, &length) != TCL_OK) { return TCL_ERROR; } i++; break; - case GLOB_LAST: /* -- */ + case GLOB_LAST: /* -- */ i++; goto endOfForLoop; } } @@ -1276,11 +1273,10 @@ /* * It's really a directory. */ dir = PATH_DIR; - } else { Tcl_DString pref; char *search, *find; Tcl_DStringInit(&pref); if (last == first) { @@ -1404,11 +1400,10 @@ globTypes->type |= TCL_GLOB_TYPE_SOCK; break; default: goto badTypesArg; } - } else if (len == 4) { /* * This is assumed to be a MacOS file type. */ @@ -1415,11 +1410,10 @@ if (globTypes->macType != NULL) { goto badMacTypesArg; } globTypes->macType = look; Tcl_IncrRefCount(look); - } else { Tcl_Obj *item; Tcl_Size llen; if ((TclListObjLength(NULL, look, &llen) == TCL_OK) @@ -1695,11 +1689,10 @@ * ':' no longer needed as a separator. It is only relevant to the * beginning of the path. */ separators = "/\\"; - } else if (tclPlatform == TCL_PLATFORM_UNIX) { if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') { pathPrefix = Tcl_NewStringObj(tail, 1); tail++; Tcl_IncrRefCount(pathPrefix); @@ -2005,26 +1998,23 @@ openBrace = closeBrace = NULL; quoted = 0; for (p = pattern; *p != '\0'; p++) { if (quoted) { quoted = 0; - } else if (*p == '\\') { quoted = 1; if (strchr(separators, p[1]) != NULL) { /* * Quoted directory separator. */ break; } - } else if (strchr(separators, *p) != NULL) { /* * Unquoted directory separator. */ break; - } else if (*p == '{') { openBrace = p; p++; if (SkipToChar(&p, '}')) { /* @@ -2037,11 +2027,10 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj( "unmatched open-brace in file name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", (void *)NULL); return TCL_ERROR; - } else if (*p == '}') { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unmatched close-brace in file name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", (void *)NULL); Index: generic/tclHash.c ================================================================== --- generic/tclHash.c +++ generic/tclHash.c @@ -284,11 +284,11 @@ if (hash != hPtr->hash) { continue; } /* if keys pointers or values are equal */ if ((key == hPtr->key.oneWordValue) - || compareKeysProc((void *) key, hPtr)) { + || compareKeysProc((void *) key, hPtr)) { if (newPtr) { *newPtr = 0; } return hPtr; } @@ -298,13 +298,12 @@ hPtr = hPtr->nextPtr) { if (hash != hPtr->hash) { continue; } /* if needle pointer equals content pointer or values equal */ - if ((key == hPtr->key.string) - || compareKeysProc((void *) key, hPtr) - ) { + if ((key == hPtr->key.string) + || compareKeysProc((void *) key, hPtr)) { if (newPtr) { *newPtr = 0; } return hPtr; } @@ -671,11 +670,11 @@ */ 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. */ { Tcl_HashEntry *hPtr; size_t count = tablePtr->keyType * sizeof(int); size_t size = offsetof(Tcl_HashEntry, key) + count; @@ -707,11 +706,11 @@ *---------------------------------------------------------------------- */ static int CompareArrayKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { size_t count = hPtr->tablePtr->keyType * sizeof(int); return !memcmp(keyPtr, hPtr->key.string, count); @@ -736,11 +735,11 @@ */ static size_t HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { const int *array = (const int *) keyPtr; size_t result; int count; @@ -768,11 +767,11 @@ */ static Tcl_HashEntry * AllocStringEntry( TCL_UNUSED(Tcl_HashTable *), - 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; size_t size, allocsize; @@ -804,11 +803,11 @@ *---------------------------------------------------------------------- */ static int CompareStringKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { return !strcmp((char *)keyPtr, hPtr->key.string); } @@ -830,11 +829,11 @@ */ static size_t HashStringKey( TCL_UNUSED(Tcl_HashTable *), - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { const char *string = (const char *)keyPtr; size_t result; char c; @@ -984,12 +983,12 @@ tablePtr->numBuckets *= 4; if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { tablePtr->buckets = (Tcl_HashEntry **)TclpSysAlloc( tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } else { - tablePtr->buckets = - (Tcl_HashEntry **)Tcl_Alloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); + tablePtr->buckets = (Tcl_HashEntry **) + Tcl_Alloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets; count > 0; count--, newChainPtr++) { *newChainPtr = NULL; } Index: generic/tclIO.c ================================================================== --- generic/tclIO.c +++ generic/tclIO.c @@ -103,11 +103,11 @@ Tcl_WideInt total; /* Total bytes transferred (written). */ Tcl_Interp *interp; /* Interp that started the copy. */ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ Tcl_Size bufSize; /* Size of appended buffer. */ char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last - * field. */ + * field. */ } CopyState; /* * All static variables used in this file are collected into a single instance * of the following structure. For multi-threaded implementations, there is @@ -228,11 +228,11 @@ static Tcl_Size Write(Channel *chanPtr, const char *src, Tcl_Size srcLen, Tcl_Encoding encoding); static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); static void CutChannel(Tcl_Channel chan); -static int WillRead(Channel *chanPtr); +static int WillRead(Channel *chanPtr); #define WriteChars(chanPtr, src, srcLen) \ Write(chanPtr, src, srcLen, chanPtr->state->encoding) #define WriteBytes(chanPtr, src, srcLen) \ Write(chanPtr, src, srcLen, tclIdentityEncoding) @@ -333,39 +333,39 @@ static void DupChannelInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void FreeChannelInternalRep(Tcl_Obj *objPtr); static const Tcl_ObjType chanObjType = { "channel", /* name for this type */ - FreeChannelInternalRep, /* freeIntRepProc */ - DupChannelInternalRep, /* dupIntRepProc */ + FreeChannelInternalRep, /* freeIntRepProc */ + DupChannelInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; #define GetIso88591() \ (binaryEncoding ? Tcl_GetEncoding(NULL, "iso8859-1") : binaryEncoding) -#define ChanSetInternalRep(objPtr, resPtr) \ +#define ChanSetInternalRep(objPtr, resPtr) \ do { \ Tcl_ObjInternalRep ir; \ (resPtr)->refCount++; \ ir.twoPtrValue.ptr1 = (resPtr); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &chanObjType, &ir); \ + Tcl_StoreInternalRep((objPtr), &chanObjType, &ir); \ } while (0) -#define ChanGetInternalRep(objPtr, resPtr) \ +#define ChanGetInternalRep(objPtr, resPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &chanObjType); \ - (resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL; \ + (resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) #define BUSY_STATE(st, fl) \ - ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ - (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) + ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ + (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) #define MAX_CHANNEL_BUFFER_SIZE (1024*1024) /* *--------------------------------------------------------------------------- @@ -429,16 +429,16 @@ * Each read op must set the blocked and eof states anew, not let * the effect of prior reads leak through. */ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { - chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; + chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; if (WillRead(chanPtr) == -1) { - return -1; + return -1; } bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize, &result); @@ -445,11 +445,11 @@ /* * Stop any flag leakage through stacked channel levels. */ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { - chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; + chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; if (bytesRead == -1) { if ((result == EWOULDBLOCK) || (result == EAGAIN)) { @@ -586,18 +586,18 @@ /* * Fetch the pre-TIP#398 compatibility flag. */ { - const char *s; - Tcl_DString ds; - - s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); - doflushnb = ((s != NULL) && strcmp(s, "0")); - if (s != NULL) { - Tcl_DStringFree(&ds); - } + const char *s; + Tcl_DString ds; + + s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); + doflushnb = ((s != NULL) && strcmp(s, "0")); + if (s != NULL) { + Tcl_DStringFree(&ds); + } } /* * Walk all channel state structures known to this thread and close * corresponding channels. @@ -613,16 +613,16 @@ active = 0; for (statePtr = tsdPtr->firstCSPtr; statePtr != NULL; statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; - if (GotFlag(statePtr, CHANNEL_DEAD)) { - continue; - } + if (GotFlag(statePtr, CHANNEL_DEAD)) { + continue; + } if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED ) || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { - ResetFlag(statePtr, BG_FLUSH_SCHEDULED); + ResetFlag(statePtr, BG_FLUSH_SCHEDULED); active = 1; break; } } @@ -633,24 +633,24 @@ if (active) { TclChannelPreserve((Tcl_Channel)chanPtr); /* * TIP #398: by default, we no longer set the channel back into - * blocking mode. To restore the old blocking behavior, the - * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set - * and not be "0". + * blocking mode. To restore the old blocking behavior, the + * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set + * and not be "0". */ - if (doflushnb) { - /* - * Set the channel back into blocking mode to ensure that we - * wait for all data to flush out. - */ - - (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, - "-blocking", "on"); - } + if (doflushnb) { + /* + * Set the channel back into blocking mode to ensure that we + * wait for all data to flush out. + */ + + (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, + "-blocking", "on"); + } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || (chanPtr == (Channel *) tsdPtr->stdoutChannel) || (chanPtr == (Channel *) tsdPtr->stderrChannel)) { /* @@ -847,11 +847,11 @@ Tcl_CreateCloseHandler( Tcl_Channel chan, /* The channel for which to create the close * callback. */ Tcl_CloseProc *proc, /* The callback routine to call when the * channel will be closed. */ - void *clientData) /* Arbitrary data to pass to the close + void *clientData) /* Arbitrary data to pass to the close * callback. */ { ChannelState *statePtr = ((Channel *) chan)->state; CloseCallback *cbPtr; @@ -885,11 +885,11 @@ Tcl_DeleteCloseHandler( Tcl_Channel chan, /* The channel for which to cancel the close * callback. */ Tcl_CloseProc *proc, /* The procedure for the callback to * remove. */ - void *clientData) /* The callback data for the callback to + void *clientData) /* The callback data for the callback to * remove. */ { ChannelState *statePtr = ((Channel *) chan)->state; CloseCallback *cbPtr, *cbPrevPtr; @@ -984,11 +984,11 @@ *---------------------------------------------------------------------- */ static void DeleteChannelTable( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { Tcl_HashTable *hTblPtr; /* The hash table. */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ @@ -1046,11 +1046,10 @@ if (statePtr->refCount-- <= 1) { if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { (void) Tcl_CloseEx(interp, (Tcl_Channel) chanPtr, 0); } } - } Tcl_DeleteHashTable(hTblPtr); Tcl_Free(hTblPtr); } @@ -1236,12 +1235,12 @@ statePtr = ((Channel *) chan)->state->bottomChanPtr->state; if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal recursive call to close through close-handler" - " of channel", -1)); + "illegal recursive call to close through close-handler" + " of channel", -1)); } return TCL_ERROR; } if (DetachChannel(interp, chan) != TCL_OK) { @@ -1464,11 +1463,11 @@ hTblPtr = GetChannelTable(interp); hPtr = Tcl_FindHashEntry(hTblPtr, name); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can not find channel named \"%s\"", chanName)); + "can not find channel named \"%s\"", chanName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, (char *)NULL); return NULL; } /* @@ -1553,18 +1552,18 @@ return TCL_ERROR; } if (resPtr && resPtr->refCount == 1) { /* - * Re-use the ResolvedCmdName struct. - */ + * Re-use the ResolvedCmdName struct. + */ Tcl_Release(resPtr->statePtr); } else { resPtr = (ResolvedChanName *) Tcl_Alloc(sizeof(ResolvedChanName)); resPtr->refCount = 0; - ChanSetInternalRep(objPtr, resPtr); /* Overwrites, if needed */ + ChanSetInternalRep(objPtr, resPtr); /* Overwrites, if needed */ } statePtr = ((Channel *)chan)->state; resPtr->statePtr = statePtr; Tcl_Preserve(statePtr); resPtr->interp = interp; @@ -1598,11 +1597,11 @@ Tcl_Channel Tcl_CreateChannel( const Tcl_ChannelType *typePtr, /* The channel type record. */ const char *chanName, /* Name of channel to record. */ - void *instanceData, /* Instance specific data. */ + void *instanceData, /* Instance specific data. */ int mask) /* TCL_READABLE & TCL_WRITABLE to indicate if * the channel is readable, writable. */ { Channel *chanPtr; /* The channel structure newly created. */ ChannelState *statePtr; /* The stack-level independent state info for @@ -1649,13 +1648,13 @@ if (chanName != NULL) { unsigned len = strlen(chanName) + 1; /* - * Make sure we allocate at least 7 bytes, so it fits for "stdout" - * later. - */ + * Make sure we allocate at least 7 bytes, so it fits for "stdout" + * later. + */ tmp = (char *)Tcl_Alloc((len < 7) ? 7 : len); strcpy(tmp, chanName); } else { tmp = (char *)Tcl_Alloc(7); @@ -1808,11 +1807,11 @@ Tcl_StackChannel( Tcl_Interp *interp, /* The interpreter we are working in */ const Tcl_ChannelType *typePtr, /* The channel type record for the new * channel. */ - void *instanceData, /* Instance specific data for the new + void *instanceData, /* Instance specific data for the new * channel. */ int mask, /* TCL_READABLE & TCL_WRITABLE to indicate if * the channel is readable, writable. */ Tcl_Channel prevChan) /* The channel structure to replace */ { @@ -1835,11 +1834,11 @@ } if (statePtr == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't find state for channel \"%s\"", + "couldn't find state for channel \"%s\"", Tcl_GetChannelName(prevChan))); } return NULL; } @@ -1886,11 +1885,11 @@ if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) { statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not flush channel \"%s\"", + "could not flush channel \"%s\"", Tcl_GetChannelName(prevChan))); } return NULL; } @@ -2081,11 +2080,11 @@ * bypasses. */ if (!TclChanCaughtErrorBypass(interp, chan) && interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not flush channel \"%s\"", + "could not flush channel \"%s\"", Tcl_GetChannelName((Tcl_Channel) chanPtr))); } return TCL_ERROR; } @@ -2406,21 +2405,21 @@ int Tcl_GetChannelHandle( Tcl_Channel chan, /* The channel to get file from. */ int direction, /* TCL_WRITABLE or TCL_READABLE. */ - void **handlePtr) /* Where to store handle */ + void **handlePtr) /* Where to store handle */ { Channel *chanPtr; /* The actual channel. */ void *handle; int result; chanPtr = ((Channel *) chan)->state->bottomChanPtr; if (!chanPtr->typePtr->getHandleProc) { - Tcl_SetChannelError(chan, Tcl_ObjPrintf( - "channel \"%s\" does not support OS handles", - Tcl_GetChannelName(chan))); + Tcl_SetChannelError(chan, Tcl_ObjPrintf( + "channel \"%s\" does not support OS handles", + Tcl_GetChannelName(chan))); return TCL_ERROR; } result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction, &handle); if (handlePtr) { @@ -2446,24 +2445,24 @@ *---------------------------------------------------------------------- */ int Tcl_RemoveChannelMode( - Tcl_Interp *interp, /* The interp for an error message. Allowed to be NULL. */ + Tcl_Interp *interp, /* The interp for an error message. Allowed to be NULL. */ Tcl_Channel chan, /* The channel which is modified. */ int mode) /* The access mode to drop from the channel */ { const char* emsg; ChannelState *statePtr = ((Channel *) chan)->state; /* State of actual channel. */ if ((mode != TCL_READABLE) && (mode != TCL_WRITABLE)) { - emsg = "Illegal mode value."; + emsg = "Illegal mode value."; goto error; } if (0 == (GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE) & ~mode)) { - emsg = "Bad mode, would make channel inacessible"; + emsg = "Bad mode, would make channel inacessible"; goto error; } ResetFlag(statePtr, mode); return TCL_OK; @@ -2501,11 +2500,11 @@ *--------------------------------------------------------------------------- */ static ChannelBuffer * AllocChannelBuffer( - Tcl_Size length) /* Desired length of channel buffer. */ + Tcl_Size length) /* Desired length of channel buffer. */ { ChannelBuffer *bufPtr; Tcl_Size n; n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING; @@ -2697,11 +2696,11 @@ } Tcl_SetErrno(EINVAL); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to access channel: invalid channel", -1)); + "unable to access channel: invalid channel", -1)); } return 1; } /* @@ -2946,11 +2945,10 @@ statePtr->outQueueTail = NULL; } RecycleBuffer(statePtr, bufPtr, 0); } } - } /* Closes "while". */ /* * If we wrote some data while flushing in the background, we are done. * We can't finish the background flush until we run out of data and the @@ -3008,11 +3006,11 @@ if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) && (statePtr->outQueueHead == NULL) && ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { errorCode = CloseChannelPart(interp, chanPtr, errorCode, - TCL_CLOSE_WRITE); + TCL_CLOSE_WRITE); goto done; } done: TclChannelRelease((Tcl_Channel)chanPtr); @@ -3153,11 +3151,10 @@ /* * Cancel any outstanding timer. */ DeleteTimerHandler(statePtr); - /* * Mark the channel as deleted by clearing the type structure. */ @@ -3424,11 +3421,11 @@ { CloseCallback *cbPtr; /* Iterate over close callbacks for this * channel. */ Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of real IO channel. */ - int result = 0; /* Of calling FlushChannel. */ + int result = 0; /* Of calling FlushChannel. */ int flushcode; int stickyError; if (chan == NULL) { return TCL_OK; @@ -3457,12 +3454,12 @@ } if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal recursive call to close through close-handler" - " of channel", -1)); + "illegal recursive call to close through close-handler" + " of channel", -1)); } return TCL_ERROR; } SetFlag(statePtr, CHANNEL_INCLOSE); @@ -3671,12 +3668,12 @@ msg = "read"; } else { msg = "write"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "Half-close of %s-side not possible, side not opened or" - " already closed", msg)); + "Half-close of %s-side not possible, side not opened or" + " already closed", msg)); return TCL_ERROR; } /* * A user may try to call half-close from within a channel close handler. @@ -3684,12 +3681,12 @@ */ if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal recursive call to close through close-handler" - " of channel", -1)); + "illegal recursive call to close through close-handler" + " of channel", -1)); } return TCL_ERROR; } if (flags & TCL_CLOSE_READ) { @@ -3746,22 +3743,22 @@ static int CloseWrite( Tcl_Interp *interp, /* Interpreter for errors. */ Channel *chanPtr) /* The channel whose write side is being - * closed. May still be used by some - * interpreter */ + * closed. May still be used by some + * interpreter */ { /* * Notes: clear-channel-handlers - write side only ? or keep around, just * not called. * * No close callbacks are run - channel is still open (read side) */ ChannelState *statePtr = chanPtr->state; - /* State of real IO channel. */ + /* State of real IO channel. */ int flushcode; int result = 0; /* * The call to FlushChannel will flush any queued output and invoke the @@ -4040,11 +4037,11 @@ Tcl_Size Tcl_Write( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ - Tcl_Size srcLen) /* Length of data in bytes, or TCL_INDEX_NONE for + Tcl_Size srcLen) /* Length of data in bytes, or TCL_INDEX_NONE for * strlen(). */ { /* * Always use the topmost channel of the stack */ @@ -4152,11 +4149,11 @@ Tcl_Size Tcl_WriteChars( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* UTF-8 characters to queue in output * buffer. */ - Tcl_Size len) /* Length of string in bytes, or TCL_INDEX_NONE for + Tcl_Size len) /* Length of string in bytes, or TCL_INDEX_NONE for * strlen(). */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ Tcl_Size result; @@ -4330,11 +4327,11 @@ static Tcl_Size Write( Channel *chanPtr, /* The channel to buffer output for. */ const char *src, /* UTF-8 string to write. */ - Tcl_Size srcLen, /* Length of UTF-8 string in bytes. */ + Tcl_Size srcLen, /* Length of UTF-8 string in bytes. */ Tcl_Encoding encoding) { ChannelState *statePtr = chanPtr->state; /* State info for channel */ char *nextNewLine = NULL; @@ -4342,11 +4339,11 @@ Tcl_Size saved = 0, total = 0, flushed = 0; char safe[BUFFER_PADDING]; int encodingError = 0; if (srcLen) { - WillWrite(chanPtr); + WillWrite(chanPtr); } /* * Write the terminated escape sequence even if srcLen is 0. */ @@ -5115,11 +5112,11 @@ * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new * CHANNEL_STICKY_EOF set in this routine leads to return before * coming back here. When we are not dealing with * CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an empty buffer. * Here the buffer is non-empty so we know we're a non-EOF. - */ + */ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); assert(!GotFlag(statePtr, CHANNEL_EOF)); } @@ -5410,11 +5407,11 @@ * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new * CHANNEL_STICKY_EOF set in this routine leads to return before * coming back here. When we are not dealing with CHANNEL_STICKY_EOF, * a CHANNEL_EOF implies an empty buffer. Here the buffer is * non-empty so we know we're a non-EOF. - */ + */ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); assert(!GotFlag(statePtr, CHANNEL_EOF)); } @@ -5694,11 +5691,11 @@ Tcl_Size Tcl_Read( Tcl_Channel chan, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ + Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ @@ -5739,11 +5736,11 @@ Tcl_Size Tcl_ReadRaw( Tcl_Channel chan, /* The channel from which to read. */ char *readBuf, /* Where to store input read. */ - Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ + Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ int copied = 0; @@ -5772,12 +5769,12 @@ copied += toCopy; readBuf += toCopy; bytesToRead -= toCopy; /* - * If the current buffer is empty recycle it. - */ + * If the current buffer is empty recycle it. + */ if (IsBufferEmpty(bufPtr)) { chanPtr->inQueueHead = bufPtr->nextPtr; if (chanPtr->inQueueHead == NULL) { chanPtr->inQueueTail = NULL; @@ -6100,20 +6097,20 @@ assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF) || GotFlag(statePtr, CHANNEL_ENCODING_ERROR) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) - == (CHANNEL_EOF|CHANNEL_BLOCKED))); + == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); /* This must comes after UpdateInterest(), which may set errno */ if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && (!copied || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { /* Channel either is blocking or is nonblocking with no data * succesfully red before the error. Return an error so that callers * like [read] can also return an error. - */ + */ ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR); Tcl_SetErrno(EILSEQ); copied = -1; } TclChannelRelease((Tcl_Channel)chanPtr); @@ -6445,11 +6442,10 @@ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; Tcl_SetObjLength(objPtr, numBytes + 1); return 1; } - } else if (GotFlag(statePtr, CHANNEL_EOF)) { /* * The bare \r is the only char and we will never read a * subsequent char to make the determination. */ @@ -6477,11 +6473,10 @@ */ numChars -= (dstRead - dstWrote); if (charsToRead > 0 && numChars > charsToRead) { - /* * TODO: This cannot happen anymore. * * We read more chars than allowed. Reset limits to prevent that * and try again. Don't forget the extra padding of TCL_UTF_MAX @@ -6790,11 +6785,11 @@ Tcl_Size Tcl_Ungets( Tcl_Channel chan, /* The channel for which to add the input. */ const char *str, /* The input itself. */ - Tcl_Size len, /* The length of the input. */ + Tcl_Size len, /* The length of the input. */ int atEnd) /* If non-zero, add at end of queue; otherwise * add at head of queue. */ { Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of actual channel. */ @@ -7052,11 +7047,11 @@ /* * Check the actual buffersize against the requested buffersize. * Saved buffers of the wrong size are squashed. This is done to honor * dynamic changes of the buffersize made by the user. - * + * * TODO: Tests to cover this. */ if ((bufPtr != NULL) && (bufPtr->bufLength != statePtr->bufSize + BUFFER_PADDING)) { @@ -7409,11 +7404,11 @@ */ WillWrite(chanPtr); if (WillRead(chanPtr) == -1) { - return TCL_ERROR; + return TCL_ERROR; } /* * We're all flushed to disk now and we also don't have any unfortunate * input baggage around either; can truncate with impunity. @@ -7736,11 +7731,11 @@ */ void Tcl_SetChannelBufferSize( Tcl_Channel chan, /* The channel whose buffer size to set. */ - Tcl_Size sz) /* The size to set. */ + Tcl_Size sz) /* The size to set. */ { ChannelState *statePtr; /* State of real channel structure. */ /* * Clip the buffer size to force it into the [1,1M] range @@ -7844,11 +7839,11 @@ const char *genericopt = "blocking buffering buffersize encoding eofchar profile translation"; const char **argv; Tcl_Size argc, i; Tcl_DString ds; - Tcl_Obj *errObj; + Tcl_Obj *errObj; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, genericopt, -1); if (optionList && (*optionList)) { TclDStringAppendLiteral(&ds, " "); @@ -7858,17 +7853,17 @@ &argc, &argv) != TCL_OK) { Tcl_Panic("malformed option list in channel driver"); } Tcl_ResetResult(interp); errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ", - optionName ? optionName : ""); + optionName ? optionName : ""); argc--; for (i = 0; i < argc; i++) { Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]); } Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]); - Tcl_SetObjResult(interp, errObj); + Tcl_SetObjResult(interp, errObj); Tcl_DStringFree(&ds); Tcl_Free((void *)argv); } Tcl_SetErrno(EINVAL); return TCL_ERROR; @@ -7986,11 +7981,11 @@ if (len == 0 || HaveOpt(2, "-encoding")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-encoding"); } Tcl_DStringAppendElement(dsPtr, - Tcl_GetEncodingName(statePtr->encoding)); + Tcl_GetEncodingName(statePtr->encoding)); if (len > 0) { return TCL_OK; } } if (len == 0 || HaveOpt(2, "-eofchar")) { @@ -8127,12 +8122,12 @@ */ if (statePtr->csPtrR || statePtr->csPtrW) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to set channel options: background copy in" - " progress", -1)); + "unable to set channel options: background copy in" + " progress", -1)); } return TCL_ERROR; } /* @@ -8177,14 +8172,14 @@ } else if ((newValue[0] == 'n') && (strncmp(newValue, "none", len) == 0)) { ResetFlag(statePtr, CHANNEL_LINEBUFFERED); SetFlag(statePtr, CHANNEL_UNBUFFERED); } else if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -buffering: must be one of" - " full, line, or none", -1)); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad value for -buffering: must be one of" + " full, line, or none", -1)); + return TCL_ERROR; } return TCL_OK; } else if (HaveOpt(7, "-buffersize")) { Tcl_WideInt newBufferSize; Tcl_Obj obj; @@ -8327,11 +8322,11 @@ translation = TCL_PLATFORM_TRANSLATION; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", -1)); + "auto, binary, cr, lf, crlf, or platform", -1)); } Tcl_Free((void *)argv); return TCL_ERROR; } @@ -8376,11 +8371,11 @@ statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", -1)); + "auto, binary, cr, lf, crlf, or platform", -1)); } Tcl_Free((void *)argv); return TCL_ERROR; } } @@ -8712,13 +8707,12 @@ if (!statePtr->timer && (mask & TCL_WRITABLE) && GotFlag(statePtr, CHANNEL_NONBLOCKING) && bufPtr - && !IsBufferEmpty(bufPtr) - && !IsBufferFull(bufPtr) - ) { + && !IsBufferEmpty(bufPtr) + && !IsBufferFull(bufPtr)) { TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, ChannelTimerProc,chanPtr); } @@ -8799,22 +8793,21 @@ } } static void DeleteTimerHandler( - ChannelState *statePtr -) + ChannelState *statePtr) { if (statePtr->timer != NULL) { Tcl_DeleteTimerHandler(statePtr->timer); CleanupTimerHandler(statePtr); } } static void CleanupTimerHandler( - ChannelState *statePtr -){ + ChannelState *statePtr) +{ TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); statePtr->timer = NULL; statePtr->timerChanPtr = NULL; } @@ -8847,11 +8840,11 @@ * conditions under which proc should be * called. Use 0 to disable a registered * handler. */ Tcl_ChannelProc *proc, /* Procedure to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ChannelHandler *chPtr; Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ @@ -8919,11 +8912,11 @@ void Tcl_DeleteChannelHandler( Tcl_Channel chan, /* The channel for which to remove the * callback. */ Tcl_ChannelProc *proc, /* The procedure in the callback to delete. */ - void *clientData) /* The client data in the callback to + void *clientData) /* The client data in the callback to * delete. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ChannelHandler *chPtr, *prevChPtr; Channel *chanPtr = (Channel *) chan; @@ -9125,11 +9118,11 @@ *---------------------------------------------------------------------- */ void TclChannelEventScriptInvoker( - void *clientData, /* The script+interp record. */ + void *clientData, /* The script+interp record. */ TCL_UNUSED(int) /*mask*/) { EventScriptRecord *esPtr = (EventScriptRecord *)clientData; /* The event script + interpreter to eval it * in. */ @@ -9338,18 +9331,18 @@ outStatePtr = outPtr->state; if (BUSY_STATE(inStatePtr, TCL_READABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "channel \"%s\" is busy", Tcl_GetChannelName(inChan))); + "channel \"%s\" is busy", Tcl_GetChannelName(inChan))); } return TCL_ERROR; } if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "channel \"%s\" is busy", Tcl_GetChannelName(outChan))); + "channel \"%s\" is busy", Tcl_GetChannelName(outChan))); } return TCL_ERROR; } readFlags = inStatePtr->flags; @@ -9416,12 +9409,12 @@ * Special handling of -size 0 async transfers, so that the -command is * still called asynchronously. */ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { - Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); - return 0; + Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); + return 0; } /* * Start copying data between the channels. */ @@ -9579,11 +9572,12 @@ } if (bufPtr) { /* Split the overflowing buffer in two */ int extra = (int) (inBytes - csPtr->toRead); - /* Note that going with int for extra assumes that inBytes is not too + /* + * Note that going with int for extra assumes that inBytes is not too * much over toRead to require a wide itself. If that gets violated * then the calculations involving extra must be made wide too. * * Noted with Win32/MSVC debug build treating the warning (possible of * data in long long to int conversion) as error. @@ -9638,12 +9632,14 @@ ChannelState *outStatePtr = csPtr->writePtr->state; ChannelBuffer *bufPtr = outStatePtr->curOutPtr; int errorCode; if (bufPtr && BytesLeft(bufPtr)) { - /* If we start with unflushed bytes in the destination - * channel, flush them out of the way first. */ + /* + * If we start with unflushed bytes in the destination + * channel, flush them out of the way first. + */ errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0); if (errorCode != 0) { MBError(csPtr, TCL_WRITABLE, errorCode); return TCL_ERROR; @@ -9671,11 +9667,11 @@ if (code == TCL_ERROR) { return TCL_ERROR; } /* code == TCL_CONTINUE --> continue the loop */ } - return TCL_OK; /* Silence compiler warnings */ + return TCL_OK; /* Silence compiler warnings */ } static int CopyData( CopyState *csPtr, /* State of copy operation. */ @@ -9754,23 +9750,23 @@ /* * Read up to bufSize characters. */ if ((csPtr->toRead == (Tcl_WideInt) -1) - || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) { + || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) { sizeb = csPtr->bufSize; } else { sizeb = csPtr->toRead; } if (moveBytes) { size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, - !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); + !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); } else { size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, - !GotFlag(inStatePtr, CHANNEL_NONBLOCKING) - ,0 /* No append */); + !GotFlag(inStatePtr, CHANNEL_NONBLOCKING), + 0 /* No append */); /* * In case of a recoverable encoding error, any data before * the error should be written. This data is in the bufObj. * Program flow for this case: * - Check, if there are any remaining bytes to write @@ -10032,11 +10028,11 @@ static Tcl_Size DoRead( Channel *chanPtr, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - Tcl_Size bytesToRead, /* Maximum number of bytes to read. */ + Tcl_Size bytesToRead, /* Maximum number of bytes to read. */ int allowShortReads) /* Allow half-blocking (pipes,sockets) */ { ChannelState *statePtr = chanPtr->state; char *p = dst; @@ -10299,24 +10295,16 @@ long long toRead) { return inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF && outStatePtr->outputTranslation == TCL_TRANSLATE_LF - && ( - ( - inStatePtr->encoding == GetBinaryEncoding() - && - outStatePtr->encoding == GetBinaryEncoding() - ) - || - ( - toRead == -1 + && ((inStatePtr->encoding == GetBinaryEncoding() + && outStatePtr->encoding == GetBinaryEncoding()) + || (toRead == -1 && inStatePtr->encoding == outStatePtr->encoding && ENCODING_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 - && ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 - ) - ); + && ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8)); } /* *---------------------------------------------------------------------- * @@ -10478,11 +10466,11 @@ * We still need the interp as the destination of the move. */ if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error setting blocking mode: %s", + "error setting blocking mode: %s", Tcl_PosixError(interp))); } } else { /* * TIP #219. @@ -11103,11 +11091,11 @@ } else { iPtr->chanMsg = NULL; } if (disposePtr != NULL) { - TclDecrRefCount(disposePtr); + TclDecrRefCount(disposePtr); } return; } /* @@ -11141,11 +11129,11 @@ } else { statePtr->chanMsg = NULL; } if (disposePtr != NULL) { - TclDecrRefCount(disposePtr); + TclDecrRefCount(disposePtr); } return; } /* @@ -11407,13 +11395,13 @@ *---------------------------------------------------------------------- */ static void DupChannelInternalRep( - Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have + Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have * an internal rep of type "Channel". */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not + Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { ResolvedChanName *resPtr; ChanGetInternalRep(srcPtr, resPtr); Index: generic/tclIO.h ================================================================== --- generic/tclIO.h +++ generic/tclIO.h @@ -32,21 +32,20 @@ /* * struct ChannelBuffer: * * Buffers data being sent to or from a channel. */ - typedef struct ChannelBuffer { Tcl_Size refCount; /* Current uses count */ Tcl_Size nextAdded; /* The next position into which a character * will be put in the buffer. */ - Tcl_Size nextRemoved; /* Position of next byte to be removed from + Tcl_Size nextRemoved; /* Position of next byte to be removed from * the buffer. */ Tcl_Size bufLength; /* How big is the buffer? */ struct ChannelBuffer *nextPtr; /* Next buffer in chain. */ - char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real + char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real * buffer occupies this space + bufSize-1 * bytes. This must be the last field in the * structure. */ } ChannelBuffer; @@ -69,11 +68,10 @@ /* * The following structure describes the information saved from a call to * "fileevent". This is used later when the event being waited for to invoke * the saved script in the interpreter designed in this record. */ - typedef struct EventScriptRecord { struct Channel *chanPtr; /* The channel for which this script is * registered. This is used only when an error * occurs during evaluation of the script, to * delete the handler. */ @@ -91,14 +89,13 @@ * One of these structures is allocated for each open channel. It contains * data specific to the channel but which belongs to the generic part of the * Tcl channel mechanism, and it points at an instance specific (and type * specific) instance data, and at a channel type structure. */ - typedef struct Channel { - struct ChannelState *state; /* Split out state information */ - void *instanceData; /* Instance-specific data provided by creator + struct ChannelState *state; /* Split out state information */ + void *instanceData; /* Instance-specific data provided by creator * of channel. */ const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */ struct Channel *downChanPtr;/* Refers to channel this one was stacked * upon. This reference is NULL for normal * channels. See Tcl_StackChannel. */ @@ -122,11 +119,10 @@ * One of these structures is allocated for each open channel. It contains * data specific to the channel but which belongs to the generic part of the * Tcl channel mechanism, and it points at an instance specific (and type * specific) instance data, and at a channel type structure. */ - typedef struct ChannelState { char *channelName; /* The name of the channel instance in Tcl * commands. Storage is owned by the generic * IO code, is dynamically allocated. */ int flags; /* OR'ed combination of the flags defined @@ -158,11 +154,12 @@ * of line sequences in output? */ int inEofChar; /* If nonzero, use this as a signal of EOF on * input. */ #if TCL_MAJOR_VERSION < 9 int outEofChar; /* If nonzero, append this to the channel when - * it is closed if it is open for writing. For Tcl 8.x only */ + * it is closed if it is open for writing. + * For Tcl 8.x only */ #endif int unreportedError; /* Non-zero if an error report was deferred * because it happened in the background. The * value is the POSIX error code. */ Tcl_Size refCount; /* How many interpreters hold references to @@ -189,12 +186,12 @@ /* Chain of all scripts registered for event * handlers ("fileevent") on this channel. */ Tcl_Size bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ Channel *timerChanPtr; /* Needed in order to decrement the refCount of - the right channel when the timer is - deleted. */ + * the right channel when the timer is + * deleted. */ struct CopyState *csPtrR; /* State of background copy for which channel * is input, or NULL. */ struct CopyState *csPtrW; /* State of background copy for which channel * is output, or NULL. */ Channel *topChanPtr; /* Refers to topmost channel in a stack. Never @@ -212,12 +209,12 @@ * Error message set by channel drivers, for the propagation of arbitrary * Tcl errors. This information, if present (chanMsg not NULL), takes * precedence over a Posix error code returned by a channel operation. */ - Tcl_Obj* chanMsg; - Tcl_Obj* unreportedMsg; /* Non-NULL if an error report was deferred + Tcl_Obj *chanMsg; + Tcl_Obj *unreportedMsg; /* Non-NULL if an error report was deferred * because it happened in the background. The * value is the chanMg, if any. #219's * companion to 'unreportedError'. */ size_t epoch; /* Used to test validity of stored channelname * lookup results. */ @@ -229,67 +226,60 @@ * Values for the flags field in Channel. Any OR'ed combination of the * following flags can be stored in the field. These flags record various * options and state bits about the channel. In addition to the flags below, * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set. */ - -#define CHANNEL_NONBLOCKING (1<<6) /* Channel is currently in nonblocking - * mode. */ -#define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the queued - * output buffers has been - * scheduled. */ -#define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No further - * Tcl-level IO on the channel is - * allowed. */ -#define CHANNEL_EOF (1<<9) /* EOF occurred on this channel. This - * bit is cleared before every input - * operation. */ -#define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel - * because we saw the input - * eofChar. This bit prevents clearing - * of the EOF bit before every input - * operation. */ -#define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred on - * this channel. This bit is cleared - * before every input or output - * operation. */ -#define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input - * translation mode and the last byte - * seen was a "\r". */ -#define CHANNEL_DEAD (1<<13) /* The channel has been closed by the - * exit handler (on exit) but not - * deallocated. When any IO operation - * sees this flag on a channel, it - * does not call driver level - * functions to avoid referring to - * deallocated data. */ -#define CHANNEL_NEED_MORE_DATA (1<<14) /* The last input operation failed - * because there was not enough data - * to complete the operation. This - * flag is set when gets fails to get - * a complete line or when read fails - * to get a complete character. When - * set, file events will not be - * delivered for buffered data until - * the state of the channel - * changes. */ -#define CHANNEL_ENCODING_ERROR (1<<15) /* set if channel - * encountered an encoding error */ -#define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is - * being used. */ -#define CHANNEL_LINEBUFFERED (1<<17) /* Output to the channel must be - * flushed after every newline. */ -#define CHANNEL_UNBUFFERED (1<<18) /* Output to the channel must always - * be flushed immediately. */ -#define CHANNEL_INCLOSE (1<<19) /* Channel is currently being closed. - * Its structures are still live and - * usable, but it may not be closed - * again from within the close - * handler. */ -#define CHANNEL_CLOSEDWRITE (1<<21) /* Channel write side has been closed. - * No further Tcl-level write IO on - * the channel is allowed. */ +enum ChannelStateFlags { + CHANNEL_NONBLOCKING = 1<<6, /* Channel is currently in nonblocking mode. */ + BG_FLUSH_SCHEDULED = 1<<7, /* A background flush of the queued output + * output buffers has been scheduled. */ + CHANNEL_CLOSED = 1<<8, /* Channel has been closed. No further + * Tcl-level IO on the channel is allowed. */ + CHANNEL_EOF = 1<<9, /* EOF occurred on this channel. This bit is + * cleared before every input operation. */ + CHANNEL_STICKY_EOF = 1<<10, /* EOF occurred on this channel because we + * saw the input eofChar. This bit prevents + * clearing of the EOF bit before every input + * operation. */ + CHANNEL_BLOCKED = 1<<11, /* EWOULDBLOCK or EAGAIN occurred on this + * channel. This bit is cleared before every + * input or output operation. */ + INPUT_SAW_CR = 1<<12, /* Channel is in CRLF eol input translation + * mode and the last byte seen was a "\r". */ + CHANNEL_DEAD = 1<<13, /* The channel has been closed by the exit + * handler (on exit) but not deallocated. + * When any IO operation sees this flag on a + * channel, it does not call driver level + * functions to avoid referring to deallocated + * data. */ + CHANNEL_NEED_MORE_DATA = 1<<14, + /* The last input operation failed because + * there was not enough data to complete the + * operation. This flag is set when gets fails + * to get a complete line or when read fails + * to get a complete character. When set, file + * events will not be delivered for buffered + * data until the state of the channel + * changes. */ + CHANNEL_ENCODING_ERROR = 1<<15, + /* Set if the channel encountered an encoding + * error. */ + CHANNEL_RAW_MODE = 1<<16, /* When set, notes that the Raw API is being + * used. */ + CHANNEL_LINEBUFFERED = 1<<17, + /* Output to the channel must be flushed + * after every newline. */ + CHANNEL_UNBUFFERED = 1<<18, /* Output to the channel must always be + * flushed immediately. */ + CHANNEL_INCLOSE = 1<<19, /* Channel is currently being closed. Its + * structures are still live and usable, but + * it may not be closed again from within the + * close handler. */ + CHANNEL_CLOSEDWRITE = 1<<21 /* Channel write side has been closed. No + * further Tcl-level write IO on the channel + * is allowed. */ +}; /* * The length of time to wait between synthetic timer events. Must be zero or * bad things tend to happen. */ Index: generic/tclIOCmd.c ================================================================== --- generic/tclIOCmd.c +++ generic/tclIOCmd.c @@ -367,12 +367,12 @@ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to read from. */ int newline, i; /* Discard newline at end? */ - Tcl_WideInt toRead; /* How many bytes to read? */ - Tcl_Size charactersRead; /* How many characters were read? */ + Tcl_WideInt toRead; /* How many bytes to read? */ + Tcl_Size charactersRead; /* How many characters were read? */ int mode; /* Mode in which channel is opened. */ Tcl_Obj *resultPtr, *chanObjPtr; if ((objc != 2) && (objc != 3)) { Interp *iPtr; @@ -603,11 +603,10 @@ /* * TIP #219. * Capture error messages put by the driver into the bypass area and put * them into the regular interpreter result. */ - code = TclChanCaughtErrorBypass(interp, chan); TclChannelRelease(chan); if (code) { return TCL_ERROR; @@ -1198,11 +1197,11 @@ *---------------------------------------------------------------------- */ static void TcpAcceptCallbacksDeleteProc( - void *clientData, /* Data which was passed when the assocdata + void *clientData, /* Data which was passed when the assocdata * was registered. */ TCL_UNUSED(Tcl_Interp *)) { Tcl_HashTable *hTblPtr = (Tcl_HashTable *)clientData; Tcl_HashEntry *hPtr; @@ -1326,11 +1325,11 @@ *---------------------------------------------------------------------- */ static void AcceptCallbackProc( - void *callbackData, /* The data stored when the callback was + void *callbackData, /* The data stored when the callback was * created in the call to * Tcl_OpenTcpServer. */ Tcl_Channel chan, /* Channel for the newly accepted * connection. */ char *address, /* Address of client that was accepted. */ @@ -1417,11 +1416,11 @@ *---------------------------------------------------------------------- */ static void TcpServerCloseProc( - void *callbackData) /* The data passed in the call to + void *callbackData) /* The data passed in the call to * Tcl_CreateCloseHandler. */ { AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData; /* The actual data. */ @@ -2036,17 +2035,17 @@ {"gets", Tcl_GetsObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"names", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"pending", ChanPendingObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #287 */ {"pipe", ChanPipeObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, /* TIP #304 */ {"pop", TclChanPopObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, /* TIP #230 */ - {"postevent", TclChanPostEventObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #219 */ + {"postevent", TclChanPostEventObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #219 */ {"push", TclChanPushObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #230 */ {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL, 0}, {"read", Tcl_ReadObjCmd, NULL, NULL, NULL, 0}, {"seek", Tcl_SeekObjCmd, TclCompileBasic2Or3ArgCmd, NULL, NULL, 0}, {"tell", Tcl_TellObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"truncate", ChanTruncateObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, /* TIP #208 */ + {"truncate", ChanTruncateObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, /* TIP #208 */ {NULL, NULL, NULL, NULL, NULL, 0} }; static const char *const extras[] = { "configure", "::fconfigure", NULL Index: generic/tclIOGT.c ================================================================== --- generic/tclIOGT.c +++ generic/tclIOGT.c @@ -61,23 +61,25 @@ /* * Action codes to give to 'ExecuteCallback' (argument 'transmit'), telling * the procedure what to do with the result of the script it calls. */ - -#define TRANSMIT_DONT 0 /* No transfer to do. */ -#define TRANSMIT_DOWN 1 /* Transfer to the underlying channel. */ -#define TRANSMIT_SELF 2 /* Transfer into our channel. */ -#define TRANSMIT_IBUF 3 /* Transfer to internal input buffer. */ -#define TRANSMIT_NUM 4 /* Transfer number to 'maxRead'. */ +enum ExecuteCallbackActionCodes { + TRANSMIT_DONT = 0, /* No transfer to do. */ + TRANSMIT_DOWN = 1, /* Transfer to the underlying channel. */ + TRANSMIT_SELF = 2, /* Transfer into our channel. */ + TRANSMIT_IBUF = 3, /* Transfer to internal input buffer. */ + TRANSMIT_NUM = 4 /* Transfer number to 'maxRead'. */ +}; /* * Codes for 'preserve' of 'ExecuteCallback'. */ - -#define P_PRESERVE 1 -#define P_NO_PRESERVE 0 +enum ExecuteCallbackPreserveFlags { + P_PRESERVE = 1, + P_NO_PRESERVE = 0 +}; /* * Strings for the action codes delivered to the script implementing a * transformation. Argument 'op' of 'ExecuteCallback'. */ @@ -115,19 +117,19 @@ */ static const Tcl_ChannelType transformChannelType = { "transform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. */ TransformInputProc, /* Input proc. */ TransformOutputProc, /* Output proc. */ NULL, /* Seek proc. */ TransformSetOptionProc, /* Set option proc. */ TransformGetOptionProc, /* Get option proc. */ TransformWatchProc, /* Initialize notifier. */ TransformGetFileHandleProc, /* Get OS handles out of channel. */ - TransformCloseProc, /* close2proc */ + TransformCloseProc, /* New close2proc */ TransformBlockModeProc, /* Set blocking/nonblocking mode.*/ NULL, /* Flush proc. */ TransformNotifyProc, /* Handling of events bubbling up. */ TransformWideSeekProc, /* Wide seek proc. */ NULL, /* Thread action. */ @@ -135,12 +137,13 @@ }; /* * Possible values for 'flags' field in control structure, see below. */ - -#define CHANNEL_ASYNC (1<<0) /* Non-blocking mode. */ +enum TransformChannelFlags { + CHANNEL_ASYNC = (1<<0) /* Non-blocking mode. */ +}; /* * Definition of the structure containing the information about the internal * input buffer. */ @@ -513,11 +516,11 @@ *---------------------------------------------------------------------- */ static int TransformBlockModeProc( - void *instanceData, /* State of transformation. */ + void *instanceData, /* State of transformation. */ int mode) /* New blocking mode. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; if (mode == TCL_MODE_NONBLOCKING) { @@ -736,11 +739,10 @@ *errorCodePtr = Tcl_GetErrno(); gotBytes = -1; break; } else if (read == 0) { - /* * Zero returned from Tcl_ReadRaw() always indicates EOF * on the down channel. */ @@ -848,11 +850,11 @@ *---------------------------------------------------------------------- */ static long long TransformWideSeekProc( - void *instanceData, /* The channel to manipulate. */ + void *instanceData, /* The channel to manipulate. */ long long offset, /* Size of movement. */ int mode, /* How to move. */ int *errorCodePtr) /* Location of error flag. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; @@ -1011,11 +1013,11 @@ *---------------------------------------------------------------------- */ static void TransformWatchProc( - void *instanceData, /* Channel to watch. */ + void *instanceData, /* Channel to watch. */ int mask) /* Events of interest. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel downChan; @@ -1089,13 +1091,13 @@ *---------------------------------------------------------------------- */ static int TransformGetFileHandleProc( - void *instanceData, /* Channel to query. */ + void *instanceData, /* Channel to query. */ int direction, /* Direction of interest. */ - void **handlePtr) /* Place to store the handle into. */ + void **handlePtr) /* Place to store the handle into. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; /* * Return the handle belonging to parent channel. IOW, pass the request @@ -1123,11 +1125,11 @@ *---------------------------------------------------------------------- */ static int TransformNotifyProc( - void *clientData, /* The state of the notified + void *clientData, /* The state of the notified * transformation. */ int mask) /* The mask of occurring events. */ { TransformChannelData *dataPtr = (TransformChannelData *)clientData; @@ -1168,11 +1170,11 @@ *---------------------------------------------------------------------- */ static void TransformChannelHandlerTimer( - void *clientData) /* Transformation to query. */ + void *clientData) /* Transformation to query. */ { TransformChannelData *dataPtr = (TransformChannelData *)clientData; dataPtr->timer = NULL; if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) { Index: generic/tclIORChan.c ================================================================== --- generic/tclIORChan.c +++ generic/tclIORChan.c @@ -60,71 +60,62 @@ /* * The C layer channel type/driver definition used by the reflection. */ static const Tcl_ChannelType tclRChannelType = { - "tclrchannel", /* Type name. */ - TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close channel, clean instance data */ - ReflectInput, /* Handle read request */ - ReflectOutput, /* Handle write request */ + "tclrchannel", /* Type name. */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ + NULL, /* Close channel, clean instance data */ + ReflectInput, /* Handle read request */ + ReflectOutput, /* Handle write request */ NULL, - ReflectSetOption, /* Set options. NULL'able */ - ReflectGetOption, /* Get options. NULL'able */ - ReflectWatch, /* Initialize notifier */ - NULL, /* Get OS handle from the channel. NULL'able */ - ReflectClose, /* No close2 support. NULL'able */ - ReflectBlock, /* Set blocking/nonblocking. NULL'able */ - NULL, /* Flush channel. Not used by core. NULL'able */ - NULL, /* Handle events. NULL'able */ - ReflectSeekWide, /* Move access point (64 bit). NULL'able */ + ReflectSetOption, /* Set options. */ + ReflectGetOption, /* Get options. */ + ReflectWatch, /* Initialize notifier */ + NULL, /* Get OS handle from the channel. Unsupported. */ + ReflectClose, /* Close channel, clean instance data. */ + ReflectBlock, /* Set blocking/nonblocking. */ + NULL, /* Flush channel. Not used by core. */ + NULL, /* Handle events. */ + ReflectSeekWide, /* Move access point (64 bit). */ #if TCL_THREADS - ReflectThread, /* thread action, tracking owner */ + ReflectThread, /* thread action, tracking owner */ #else - NULL, /* thread action */ + NULL, /* thread action */ #endif - ReflectTruncate /* Truncate. NULL'able */ + ReflectTruncate /* Truncate. */ }; /* - * Instance data for a reflected channel. =========================== + * Instance data for a reflected channel. */ - -typedef struct { +typedef struct ReflectedChannel { Tcl_Channel chan; /* Back reference to generic channel * structure. */ Tcl_Interp *interp; /* Reference to the interpreter containing the * Tcl level part of the channel. NULL here * signals the channel is dead because the * interpreter/thread containing its Tcl - * command is gone. - */ + * command is gone. */ #if TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ - Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ + Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif Tcl_Obj *cmd; /* Callback command prefix */ Tcl_Obj *methods; /* Methods to append to command prefix */ Tcl_Obj *name; /* Name of the channel as created */ - int mode; /* Mask of R/W mode */ int interest; /* Mask of events the channel is interested * in. */ - int dead; /* Boolean signal that some operations * should no longer be attempted. */ - - Tcl_TimerToken readTimer; /* - A token for the timer that is scheduled in - order to call Tcl_NotifyChannel when the - channel is readable - */ - Tcl_TimerToken writeTimer; /* - A token for the timer that is scheduled in - order to call Tcl_NotifyChannel when the - channel is writable - */ + Tcl_TimerToken readTimer; /* A token for the timer that is scheduled in + * order to call Tcl_NotifyChannel when the + * channel is readable. */ + Tcl_TimerToken writeTimer; /* A token for the timer that is scheduled in + * order to call Tcl_NotifyChannel when the + * channel is writable. */ /* * Note regarding the usage of timers. * * Most channel implementations need a timer in the C level to ensure that @@ -264,11 +255,11 @@ */ struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ - Tcl_Size toRead; /* I: #bytes to read, + Tcl_Size toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ const char *buf; /* I: Where the bytes to write come from */ @@ -356,10 +347,11 @@ * Note regarding 'dsti' above: Its information is also available via the * chain evPtr->rcPtr->interp, however, as can be seen, two more * indirections are needed to retrieve it. And the evPtr may be gone, * breaking the chain. */ + Tcl_Condition done; /* Condition variable the forwarder blocks * on. */ int result; /* TCL_OK or TCL_ERROR */ ForwardingEvent *evPtr; /* Event the result belongs to. */ ForwardingResult *prevPtr, *nextPtr; @@ -370,11 +362,10 @@ typedef struct { /* * Table of all reflected channels owned by this thread. This is the * per-thread version of the per-interpreter map. */ - ReflectedChannelMap *rcmPtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -401,30 +392,41 @@ ForwardedOperation op, const void *param); static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(void *clientData); #define FreeReceivedError(p) \ - if ((p)->base.mustFree) { \ - Tcl_Free((p)->base.msgStr); \ - } -#define PassReceivedErrorInterp(i,p) \ - if ((i) != NULL) { \ - Tcl_SetChannelErrorInterp((i), \ - Tcl_NewStringObj((p)->base.msgStr, -1)); \ - } \ - FreeReceivedError(p) -#define PassReceivedError(c,p) \ - Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \ - FreeReceivedError(p) -#define ForwardSetStaticError(p,emsg) \ - (p)->base.code = TCL_ERROR; \ - (p)->base.mustFree = 0; \ - (p)->base.msgStr = (char *) (emsg) -#define ForwardSetDynamicError(p,emsg) \ - (p)->base.code = TCL_ERROR; \ - (p)->base.mustFree = 1; \ - (p)->base.msgStr = (char *) (emsg) + do { \ + if ((p)->base.mustFree) { \ + Tcl_Free((p)->base.msgStr); \ + } \ + } while (0) +#define PassReceivedErrorInterp(interp, p) \ + do { \ + if ((interp) != NULL) { \ + Tcl_SetChannelErrorInterp((interp), \ + Tcl_NewStringObj((p)->base.msgStr, TCL_AUTO_LENGTH)); \ + } \ + FreeReceivedError(p); \ + } while (0) +#define PassReceivedError(c, p) \ + do { \ + Tcl_SetChannelError((c), \ + Tcl_NewStringObj((p)->base.msgStr, TCL_AUTO_LENGTH)); \ + FreeReceivedError(p); \ + } while (0) +#define ForwardSetStaticError(p, emsg) \ + do { \ + (p)->base.code = TCL_ERROR; \ + (p)->base.mustFree = 0; \ + (p)->base.msgStr = (char *) (emsg); \ + } while (0) +#define ForwardSetDynamicError(p, emsg) \ + do { \ + (p)->base.code = TCL_ERROR; \ + (p)->base.mustFree = 1; \ + (p)->base.msgStr = (char *) (emsg); \ + } while (0) static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); static ReflectedChannelMap * GetThreadReflectedChannelMap(void); static Tcl_ExitProc DeleteThreadReflectedChannelMap; @@ -503,43 +505,42 @@ TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { + /* + * Syntax: chan create MODE CMDPREFIX + * [0] [1] [2] [3] + * + * Actually: rCreate MODE CMDPREFIX + * [0] [1] [2] + */ + enum ArgumentIndices { + MODE = (1), /* MODE index */ + CMD = (2) /* CMDPREFIX index */ + }; ReflectedChannel *rcPtr; /* Instance data of the new channel */ Tcl_Obj *rcId; /* Handle of the new channel */ int mode; /* R/W mode of new channel. Has to match * abilities of handler commands */ Tcl_Obj *cmdObj; /* Command prefix, list of words */ Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Channel chan; /* Token for the new channel */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ Tcl_Obj *resObj; /* Result data for 'initialize' */ int methods; /* Bitmask for supported methods. */ Channel *chanPtr; /* 'chan' resolved to internal struct. */ Tcl_Obj *err; /* Error message */ - ReflectedChannelMap *rcmPtr; - /* Map of reflected channels with handlers in + ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in * this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ int isNew; /* Placeholder. */ - /* - * Syntax: chan create MODE CMDPREFIX - * [0] [1] [2] [3] - * - * Actually: rCreate MODE CMDPREFIX - * [0] [1] [2] - */ - -#define MODE (1) -#define CMD (2) - /* * Number of arguments... */ if (objc != 3) { @@ -611,13 +612,13 @@ * Check for non-optionals through the mask. * Compare open mode against optional r/w. */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s initialize\" returned non-list: %s", - TclGetString(cmdObj), TclGetString(resObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s initialize\" returned non-list: %s", + TclGetString(cmdObj), TclGetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } methods = 0; @@ -637,41 +638,41 @@ listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" does not support all required methods", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" does not support all required methods", + TclGetString(cmdObj))); goto error; } if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" lacks a \"read\" method", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" lacks a \"read\" method", + TclGetString(cmdObj))); goto error; } if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" lacks a \"write\" method", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" lacks a \"write\" method", + TclGetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", + TclGetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", + TclGetString(cmdObj))); goto error; } Tcl_ResetResult(interp); @@ -740,22 +741,19 @@ /* * Return handle as result of command. */ Tcl_SetObjResult(interp, - Tcl_NewStringObj(chanPtr->state->channelName, -1)); + Tcl_NewStringObj(chanPtr->state->channelName, -1)); return TCL_OK; error: Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); Tcl_DecrRefCount(rcPtr->cmd); Tcl_Free(rcPtr); return TCL_ERROR; - -#undef MODE -#undef CMD } /* *---------------------------------------------------------------------- * @@ -812,11 +810,11 @@ */ ReflectEvent *e = (ReflectEvent *) ev; if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) { - return 0; + return 0; } return 1; } #endif @@ -836,14 +834,14 @@ * Actually: rPostevent CHANNEL EVENTSPEC * [0] [1] [2] * * where EVENTSPEC = {read write ...} (Abbreviations allowed as well). */ - -#define CHAN (1) -#define EVENT (2) - + enum ArgumentIndices { + CHAN = (1), /* CHANNEL index */ + EVENT = (2) /* EVENTSPEC index */ + }; const char *chanId; /* Tcl level channel handle */ Tcl_Channel chan; /* Channel associated to the handle */ const Tcl_ChannelType *chanTypePtr; /* Its associated driver structure */ ReflectedChannel *rcPtr; /* Associated instance data */ @@ -871,11 +869,11 @@ rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can not find reflected channel named \"%s\"", chanId)); + "can not find reflected channel named \"%s\"", chanId)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, (char *)NULL); return TCL_ERROR; } /* @@ -925,22 +923,22 @@ if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) { return TCL_ERROR; } if (events == 0) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("bad event list: is empty", -1)); + Tcl_NewStringObj("bad event list: is empty", TCL_AUTO_LENGTH)); return TCL_ERROR; } /* * Check that the channel is actually interested in the provided events. */ if (events & ~rcPtr->interest) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "tried to post events channel \"%s\" is not interested in", - chanId)); + "tried to post events channel \"%s\" is not interested in", + chanId)); return TCL_ERROR; } /* * We have the channel and the events to post. @@ -961,40 +959,40 @@ TimerRunWrite, rcPtr); } } #if TCL_THREADS } else { - ReflectEvent *ev = (ReflectEvent *)Tcl_Alloc(sizeof(ReflectEvent)); - - ev->header.proc = ReflectEventRun; - ev->events = events; - ev->rcPtr = rcPtr; - - /* - * We are not preserving the structure here. When the channel is - * closed any pending events are deleted, see ReflectClose(), and - * ReflectEventDelete(). Trying to preserve and later release when the - * event is run may generate a situation where the channel structure - * is deleted but not our structure, crashing in - * FreeReflectedChannel(). - * - * Force creation of the RCM, for proper cleanup on thread teardown. - * The teardown of unprocessed events is currently coupled to the - * thread reflected channel map - */ - - (void) GetThreadReflectedChannelMap(); - - /* - * XXX Race condition !! - * XXX The destination thread may not exist anymore already. - * XXX (Delayed postevent executed after channel got removed). - * XXX Can we detect this ? (check the validity of the owner threadid ?) - * XXX Actually, in that case the channel should be dead also ! - */ - - Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, + ReflectEvent *ev = (ReflectEvent *)Tcl_Alloc(sizeof(ReflectEvent)); + + ev->header.proc = ReflectEventRun; + ev->events = events; + ev->rcPtr = rcPtr; + + /* + * We are not preserving the structure here. When the channel is + * closed any pending events are deleted, see ReflectClose(), and + * ReflectEventDelete(). Trying to preserve and later release when the + * event is run may generate a situation where the channel structure + * is deleted but not our structure, crashing in + * FreeReflectedChannel(). + * + * Force creation of the RCM, for proper cleanup on thread teardown. + * The teardown of unprocessed events is currently coupled to the + * thread reflected channel map + */ + + (void) GetThreadReflectedChannelMap(); + + /* + * XXX Race condition !! + * XXX The destination thread may not exist anymore already. + * XXX (Delayed postevent executed after channel got removed). + * XXX Can we detect this ? (check the validity of the owner threadid ?) + * XXX Actually, in that case the channel should be dead also ! + */ + + Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY); } #endif /* @@ -1001,13 +999,10 @@ * Squash interp results left by the event script. */ Tcl_ResetResult(interp); return TCL_OK; - -#undef CHAN -#undef EVENT } static void TimerRunRead( void *clientData) @@ -1205,15 +1200,15 @@ ForwardParam p; ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; - /* - * Now squash the pending reflection events for this channel. - */ + /* + * Now squash the pending reflection events for this channel. + */ - Tcl_DeleteEvents(ReflectEventDelete, rcPtr); + Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { FreeReceivedError(&p); } } @@ -1243,15 +1238,15 @@ ForwardParam p; ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; - /* - * Now squash the pending reflection events for this channel. - */ + /* + * Now squash the pending reflection events for this channel. + */ - Tcl_DeleteEvents(ReflectEventDelete, rcPtr); + Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); } } else { @@ -1382,15 +1377,15 @@ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; - goto error; + goto error; } Tcl_SetChannelError(rcPtr->chan, resObj); - goto invalid; + goto invalid; } bytev = Tcl_GetBytesFromObj(NULL, resObj, &bytec); if (bytev == NULL) { @@ -1466,13 +1461,13 @@ * No error message, this is an errno signal. */ *errorCodePtr = -p.base.code; } else { - PassReceivedError(rcPtr->chan, &p); - *errorCodePtr = EINVAL; - } + PassReceivedError(rcPtr->chan, &p); + *errorCodePtr = EINVAL; + } p.output.toWrite = -1; } else { *errorCodePtr = EOK; } @@ -1492,48 +1487,48 @@ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; - goto error; + goto error; } Tcl_SetChannelError(rcPtr->chan, resObj); - goto invalid; + goto invalid; } if (Tcl_InterpDeleted(rcPtr->interp)) { /* * The interp was destroyed during InvokeTclMethod(). */ SetChannelErrorStr(rcPtr->chan, msg_send_dstlost); - goto invalid; + goto invalid; } if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); - goto invalid; + goto invalid; } if ((written == 0) && (toWrite > 0)) { /* * The handler claims to have written nothing of what it was given. * That is bad. */ SetChannelErrorStr(rcPtr->chan, msg_write_nothing); - goto invalid; + goto invalid; } if (toWrite < written) { /* * The handler claims to have written more than it was given. That is * bad. Note that the I/O core would crash if we were to return this * information, trying to write -nnn bytes in the next iteration. */ SetChannelErrorStr(rcPtr->chan, msg_write_toomuch); - goto invalid; + goto invalid; } *errorCodePtr = EOK; stop: Tcl_DecrRefCount(bufObj); @@ -1605,28 +1600,28 @@ Tcl_Preserve(rcPtr); TclNewIntObj(offObj, offset); baseObj = Tcl_NewStringObj( - (seekMode == SEEK_SET) ? "start" : - (seekMode == SEEK_CUR) ? "current" : "end", -1); + (seekMode == SEEK_SET) ? "start" : + (seekMode == SEEK_CUR) ? "current" : "end", -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); - goto invalid; + goto invalid; } if (TclGetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); - goto invalid; + goto invalid; } if (newLoc < 0) { SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart); - goto invalid; + goto invalid; } *errorCodePtr = EOK; stop: Tcl_DecrRefCount(offObj); @@ -1803,18 +1798,18 @@ { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; switch (action) { case TCL_CHANNEL_THREAD_INSERT: - rcPtr->owner = Tcl_GetCurrentThread(); - break; + rcPtr->owner = Tcl_GetCurrentThread(); + break; case TCL_CHANNEL_THREAD_REMOVE: - rcPtr->owner = NULL; - break; + rcPtr->owner = NULL; + break; default: - Tcl_Panic("Unknown thread action code."); - break; + Tcl_Panic("Unknown thread action code."); + break; } } #endif /* @@ -1833,11 +1828,11 @@ *---------------------------------------------------------------------- */ static int ReflectSetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; @@ -1905,11 +1900,11 @@ *---------------------------------------------------------------------- */ static int ReflectGetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of reuqested option */ Tcl_DString *dsPtr) /* String to place the result into */ { /* @@ -1969,28 +1964,28 @@ * Retrieve the value of one option. */ method = METH_CGET; optionObj = Tcl_NewStringObj(optionName, -1); - Tcl_IncrRefCount(optionObj); + Tcl_IncrRefCount(optionObj); } Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) { UnmarshallErrorResult(interp, resObj); - goto error; + goto error; } /* * The result has to go into the 'dsPtr' for propagation to the caller of * the driver. */ if (optionObj != NULL) { TclDStringAppendObj(dsPtr, resObj); - goto ok; + goto ok; } /* * Extract the list and append each item as element. */ @@ -2001,11 +1996,11 @@ * the whole string rep might be faster. It also doesn't check if the * result is a valid list. Nor that the list has an even number elements. */ if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { - goto error; + goto error; } if ((listc % 2) == 1) { /* * Odd number of elements is wrong. @@ -2014,27 +2009,27 @@ Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Expected list with even number of " "elements, got %" TCL_SIZE_MODIFIER "d element%s instead", listc, (listc == 1 ? "" : "s"))); - goto error; + goto error; } else { Tcl_Size len; const char *str = TclGetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); } - goto ok; + goto ok; } ok: result = TCL_OK; stop: if (optionObj) { - Tcl_DecrRefCount(optionObj); + Tcl_DecrRefCount(optionObj); } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return result; error: @@ -2058,11 +2053,11 @@ *---------------------------------------------------------------------- */ static int ReflectTruncate( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ long long length) /* Length to truncate to. */ { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *lenObj; int errorNum; /* EINVAL or EOK (success). */ @@ -2141,11 +2136,11 @@ const char *objName, Tcl_Obj *obj, int *mask) { int events; /* Mask of events to post */ - Tcl_Size listc; /* #elements in eventspec list */ + Tcl_Size listc; /* #elements in eventspec list */ Tcl_Obj **listv; /* Elements of eventspec list */ int evIndex; /* Id of event for an element of the eventspec * list. */ if (TclListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) { @@ -2384,14 +2379,14 @@ resObj = Tcl_NewStringObj(msg_dstlost,-1); *resultObjPtr = resObj; Tcl_IncrRefCount(resObj); } - /* - * Not touching argOneObj, argTwoObj, they have not been used. - * See the contract as well. - */ + /* + * Not touching argOneObj, argTwoObj, they have not been used. + * See the contract as well. + */ return TCL_ERROR; } /* @@ -2563,11 +2558,12 @@ static ReflectedChannelMap * GetReflectedChannelMap( Tcl_Interp *interp) { - ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL); + ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *) + Tcl_GetAssocData(interp, RCMKEY, NULL); if (rcmPtr == NULL) { rcmPtr = (ReflectedChannelMap *)Tcl_Alloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS); Tcl_SetAssocData(interp, RCMKEY, DeleteReflectedChannelMap, rcmPtr); @@ -2617,17 +2613,17 @@ rcPtr->dead = 1; } static void DeleteReflectedChannelMap( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData; /* The map */ - Tcl_HashSearch hSearch; /* Search variable. */ - Tcl_HashEntry *hPtr; /* Search variable. */ + Tcl_HashSearch hSearch; /* Search variable. */ + Tcl_HashEntry *hPtr; /* Search variable. */ ReflectedChannel *rcPtr; Tcl_Channel chan; #if TCL_THREADS ForwardingResult *resultPtr; ForwardingEvent *evPtr; @@ -2683,15 +2679,15 @@ } /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. - * - * Attention: Results may have been detached already, by either the - * receiver, or this thread, as part of other parts in the thread - * teardown. Such results are ignored. See ticket [b47b176adf] for the - * identical race condition in Tcl 8.6 IORTrans. + * + * Attention: Results may have been detached already, by either the + * receiver, or this thread, as part of other parts in the thread + * teardown. Such results are ignored. See ticket [b47b176adf] for the + * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; /* @@ -2836,15 +2832,15 @@ } /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. - * - * Attention: Results may have been detached already, by either the - * receiver, or this thread, as part of other parts in the thread - * teardown. Such results are ignored. See ticket [b47b176adf] for the - * identical race condition in Tcl 8.6 IORTrans. + * + * Attention: Results may have been detached already, by either the + * receiver, or this thread, as part of other parts in the thread + * teardown. Such results are ignored. See ticket [b47b176adf] for the + * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; /* @@ -3049,11 +3045,11 @@ ReflectedChannel *rcPtr = evPtr->rcPtr; Tcl_Interp *interp = rcPtr->interp; ForwardParam *paramPtr = evPtr->param; Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in - * this interp. */ + * this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ /* * Ignore the event if no one is waiting for its result anymore. */ @@ -3092,16 +3088,16 @@ * 'postevent') from finding and dereferencing a dangling pointer. */ rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, - Tcl_GetChannelName(rcPtr->chan)); + Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); rcmPtr = GetThreadReflectedChannelMap(); hPtr = Tcl_FindHashEntry(&rcmPtr->map, - Tcl_GetChannelName(rcPtr->chan)); + Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); MarkDead(rcPtr); break; } @@ -3142,21 +3138,21 @@ memcpy(paramPtr->input.buf, bytev, bytec); } paramPtr->input.toRead = bytec; } } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(toReadObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(toReadObj); break; } case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) - paramPtr->output.buf, paramPtr->output.toWrite); - Tcl_IncrRefCount(bufObj); + paramPtr->output.buf, paramPtr->output.toWrite); + Tcl_IncrRefCount(bufObj); - Tcl_Preserve(rcPtr); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { paramPtr->base.code = code; @@ -3181,12 +3177,12 @@ paramPtr->output.toWrite = -1; } else { paramPtr->output.toWrite = written; } } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(bufObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(bufObj); break; } case ForwardedSeek: { Tcl_Obj *offObj; @@ -3224,56 +3220,56 @@ resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(offObj); - Tcl_DecrRefCount(baseObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(offObj); + Tcl_DecrRefCount(baseObj); break; } case ForwardedWatch: { Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask); - /* assert maskObj.refCount == 1 */ + /* assert maskObj.refCount == 1 */ - Tcl_Preserve(rcPtr); + Tcl_Preserve(rcPtr); rcPtr->interest = paramPtr->watch.mask; (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); - Tcl_Release(rcPtr); + Tcl_Release(rcPtr); break; } case ForwardedBlock: { Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking); - Tcl_IncrRefCount(blockObj); - Tcl_Preserve(rcPtr); + Tcl_IncrRefCount(blockObj); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, - &resObj) != TCL_OK) { + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(blockObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(blockObj); break; } case ForwardedSetOpt: { Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1); Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1); - Tcl_IncrRefCount(optionObj); - Tcl_IncrRefCount(valueObj); - Tcl_Preserve(rcPtr); + Tcl_IncrRefCount(optionObj); + Tcl_IncrRefCount(valueObj); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, - &resObj) != TCL_OK) { + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(optionObj); - Tcl_DecrRefCount(valueObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(optionObj); + Tcl_DecrRefCount(valueObj); break; } case ForwardedGetOpt: { /* @@ -3280,28 +3276,28 @@ * Retrieve the value of one option. */ Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1); - Tcl_IncrRefCount(optionObj); - Tcl_Preserve(rcPtr); + Tcl_IncrRefCount(optionObj); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { TclDStringAppendObj(paramPtr->getOpt.value, resObj); } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(optionObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(optionObj); break; } case ForwardedGetOptAll: /* * Retrieve all options. */ - Tcl_Preserve(rcPtr); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { /* * Extract list, validate that it is a list, and #elements. See @@ -3310,11 +3306,11 @@ Tcl_Size listc; Tcl_Obj **listv; if (TclListObjGetElements(interp, resObj, &listc, - &listv) != TCL_OK) { + &listv) != TCL_OK) { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); } else if ((listc % 2) == 1) { /* @@ -3335,11 +3331,11 @@ TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } } - Tcl_Release(rcPtr); + Tcl_Release(rcPtr); break; case ForwardedTruncate: { Tcl_Obj *lenObj = Tcl_NewWideIntObj(paramPtr->truncate.length); Index: generic/tclIORTrans.c ================================================================== --- generic/tclIORTrans.c +++ generic/tclIORTrans.c @@ -56,19 +56,19 @@ */ static const Tcl_ChannelType tclRTransformType = { "tclrtransform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel. */ - NULL, /* Close channel, clean instance data. */ + NULL, /* Close channel, clean instance data. */ ReflectInput, /* Handle read request. */ ReflectOutput, /* Handle write request. */ - NULL, /* Move location of access point. */ + NULL, /* Move location of access point. */ ReflectSetOption, /* Set options. */ ReflectGetOption, /* Get options. */ ReflectWatch, /* Initialize notifier. */ ReflectHandle, /* Get OS handle from the channel. */ - ReflectClose, /* No close2 support. NULL'able. */ + ReflectClose, /* No close2 support. NULL'able. */ ReflectBlock, /* Set blocking/nonblocking. */ NULL, /* Flush channel. Not used by core. * NULL'able. */ ReflectNotify, /* Handle events. */ ReflectSeekWide, /* Move access point (64 bit). */ @@ -466,12 +466,14 @@ /* * Operation codes for TransformFlush(). */ -#define FLUSH_WRITE 1 -#define FLUSH_DISCARD 0 +enum TransformFlushOpCodes { + FLUSH_WRITE = 1, + FLUSH_DISCARD = 0 +}; /* * Main methods to plug into the 'chan' ensemble'. ================== */ @@ -498,10 +500,21 @@ TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { + /* + * Syntax: chan push CHANNEL CMDPREFIX + * [0] [1] [2] [3] + * + * Actually: rPush CHANNEL CMDPREFIX + * [0] [1] [2] + */ + enum ArgumentIndices { + CHAN = (1), /* CHANNEL index */ + CMD = (2) /* CMDPREFIX index */ + }; ReflectedTransform *rtPtr; /* Instance data of the new (transform) * channel. */ Tcl_Obj *chanObj; /* Handle of parent channel */ Tcl_Channel parentChan; /* Token of parent channel */ int mode; /* R/W mode of parent, later the new channel. @@ -509,11 +522,11 @@ * commands */ Tcl_Obj *cmdObj; /* Command prefix, list of words */ Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Obj *rtId; /* Handle of the new transform (channel) */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ Tcl_Obj *resObj; /* Result data for 'initialize' */ int methods; /* Bitmask for supported methods. */ @@ -521,20 +534,10 @@ /* Map of reflected transforms with handlers * in this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ int isNew; /* Placeholder. */ - /* - * Syntax: chan push CHANNEL CMDPREFIX - * [0] [1] [2] [3] - * - * Actually: rPush CHANNEL CMDPREFIX - * [0] [1] [2] - */ - -#define CHAN (1) -#define CMD (2) /* * Number of arguments... */ @@ -598,13 +601,13 @@ * - List, of method names. Convert to mask. Check for non-optionals * through the mask. Compare open mode against optional r/w. */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s initialize\" returned non-list: %s", - TclGetString(cmdObj), TclGetString(resObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s initialize\" returned non-list: %s", + TclGetString(cmdObj), TclGetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } methods = 0; @@ -623,13 +626,13 @@ listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" does not support all required methods", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" does not support all required methods", + TclGetString(cmdObj))); goto error; } /* * Mode tell us what the parent channel supports. The methods tell us what @@ -645,31 +648,31 @@ if (!HAS(methods, METH_WRITE)) { mode &= ~TCL_WRITABLE; } if (!mode) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" makes the channel inaccessible", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" makes the channel inaccessible", + TclGetString(cmdObj))); goto error; } /* * The mode and support for it is ok, now check the internal constraints. */ if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"drain\" but not \"read\"", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"drain\" but not \"read\"", + TclGetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"flush\" but not \"write\"", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"flush\" but not \"write\"", + TclGetString(cmdObj))); goto error; } Tcl_ResetResult(interp); @@ -713,13 +716,10 @@ * structure. */ Tcl_EventuallyFree(rtPtr, FreeReflectedTransform); return TCL_ERROR; - -#undef CHAN -#undef CMD } /* *---------------------------------------------------------------------- * @@ -750,13 +750,13 @@ * [0] [1] [2] * * Actually: rPop CHANNEL * [0] [1] */ - -#define CHAN (1) - + enum ArgumentIndices { + CHAN = (1) /* CHANNEL index */ + }; const char *chanId; /* Tcl level channel handle */ Tcl_Channel chan; /* Channel associated to the handle */ int mode; /* Channel r/w mode */ /* @@ -785,12 +785,10 @@ * transformations. */ Tcl_UnstackChannel(interp, chan); return TCL_OK; - -#undef CHAN } /* * Channel error message marshalling utilities. */ @@ -1103,11 +1101,10 @@ if (rtPtr->eofPending) { goto stop; } - /* * The buffer is exhausted, but the caller wants even more. We now * have to go to the underlying channel, get more bytes and then * transform them for delivery. We may not get what we want (full EOF * or temporarily out of data). @@ -1139,16 +1136,14 @@ if (toRead <= 0) { goto stop; } - readBytes = Tcl_ReadRaw(rtPtr->parent, (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead); if (readBytes < 0) { if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) { - /* * Down channel is blocked and offers zero additional bytes. * The nonzero gotBytes already returned makes the total * operation a valid short read. Return to caller. */ @@ -1167,11 +1162,10 @@ *errorCodePtr = Tcl_GetErrno(); goto error; } if (readBytes == 0) { - /* * Zero returned from Tcl_ReadRaw() always indicates EOF * on the down channel. */ @@ -1490,11 +1484,11 @@ *---------------------------------------------------------------------- */ static int ReflectSetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; @@ -1532,11 +1526,11 @@ *---------------------------------------------------------------------- */ static int ReflectGetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ Tcl_DString *dsPtr) /* String to place the result into */ { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; @@ -1779,11 +1773,11 @@ Tcl_Obj *word = rtPtr->argv[i] = listv[i]; Tcl_IncrRefCount(word); } - i++; /* Skip placeholder for method */ + i++; /* Skip placeholder for method */ /* * See [x] in FreeReflectedTransform for release */ rtPtr->argv[i] = handleObj; @@ -2106,16 +2100,16 @@ *---------------------------------------------------------------------- */ static void DeleteReflectedTransformMap( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedTransformMap *rtmPtr; /* The map */ - Tcl_HashSearch hSearch; /* Search variable. */ - Tcl_HashEntry *hPtr; /* Search variable. */ + Tcl_HashSearch hSearch; /* Search variable. */ + Tcl_HashEntry *hPtr; /* Search variable. */ ReflectedTransform *rtPtr; #if TCL_THREADS ForwardingResult *resultPtr; ForwardingEvent *evPtr; ForwardParam *paramPtr; @@ -2991,11 +2985,11 @@ static inline size_t ResultCopy( ResultBuffer *rPtr, /* The buffer to read from */ unsigned char *buf, /* The buffer to copy into */ - size_t toRead) /* Number of requested bytes */ + size_t toRead) /* Number of requested bytes */ { int copied; if (rPtr->used == 0) { /* Index: generic/tclIOSock.c ================================================================== --- generic/tclIOSock.c +++ generic/tclIOSock.c @@ -259,11 +259,11 @@ *errorMsgPtr = #ifdef EAI_SYSTEM /* Doesn't exist on Windows */ (result == EAI_SYSTEM) ? Tcl_PosixError(interp) : #endif /* EAI_SYSTEM */ gai_strerror(result); - return 0; + return 0; } /* * Put IPv4 addresses before IPv6 addresses to maximize backwards * compatibility of [fconfigure -sockname] output. Index: generic/tclIOUtil.c ================================================================== --- generic/tclIOUtil.c +++ generic/tclIOUtil.c @@ -33,11 +33,11 @@ * * An item in a linked list of registered filesystems */ typedef struct FilesystemRecord { - void *clientData; /* Client-specific data for the filesystem + void *clientData; /* Client-specific data for the filesystem * (can be NULL) */ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ struct FilesystemRecord *nextPtr; /* The next registered filesystem, or NULL to * indicate the end of the list. */ @@ -45,22 +45,21 @@ /* The previous filesystem, or NULL to indicate * the ned of the list */ } FilesystemRecord; /* + * Information held per thread. */ - typedef struct { int initialized; size_t cwdPathEpoch; /* Compared with the global cwdPathEpoch to * determine whether cwdPathPtr is stale. */ size_t filesystemEpoch; Tcl_Obj *cwdPathPtr; /* A private copy of cwdPathPtr. Updated when * the value is accessed and cwdPathEpoch has - * changed. - */ + * changed. */ void *cwdClientData; FilesystemRecord *filesystemList; size_t claims; } ThreadSpecificData; @@ -103,11 +102,10 @@ * be used only here. */ MODULE_SCOPE const char *const tclpFileAttrStrings[]; MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; - /* * These these functions are not static either because routines in the native * (win/unix) directories call them or they are actually implemented in those * directories. They should be called from outside Tcl's native filesystem @@ -327,12 +325,12 @@ } /* Obsolete */ int Tcl_Access( - const char *path, /* Pathname of file to access (in current CP). - */ + const char *path, /* Pathname of file to access (in current + * CP). */ int mode) /* Permission setting. */ { int ret; Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); @@ -843,11 +841,11 @@ *---------------------------------------------------------------------- */ int Tcl_FSRegister( - void *clientData, /* Client-specific data for this filesystem. */ + void *clientData, /* Client-specific data for this filesystem. */ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */ { FilesystemRecord *newFilesystemPtr; if (fsPtr == NULL) { @@ -1103,12 +1101,11 @@ Tcl_Obj *resultPtr, /* The current list of matching pathnames. Must * not be shared. */ Tcl_Obj *pathPtr, /* The directory that was searched. */ const char *pattern, /* Pattern to match mounts against. */ Tcl_GlobTypeData *types) /* Acceptable types. May be NULL. The - * directory flag is particularly significant. - */ + * directory flag is particularly significant. */ { Tcl_Size mLength, gLength, i; int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); Tcl_Obj *mounts = FsListMounts(pathPtr, pattern); @@ -1168,11 +1165,10 @@ */ len--; } len++; /* account for '/' in the mElt [Bug 1602539] */ - mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len); Tcl_ListObjAppendElement(NULL, resultPtr, mElt); } /* @@ -1264,12 +1260,12 @@ *---------------------------------------------------------------------- */ void * Tcl_FSData( - const Tcl_Filesystem *fsPtr) /* The filesystem to find in the list of - * registered filesystems. */ + const Tcl_Filesystem *fsPtr)/* The filesystem to find in the list of + * registered filesystems. */ { void *retVal = NULL; FilesystemRecord *fsRecPtr = FsGetFirstFilesystem(); /* @@ -1363,11 +1359,10 @@ firstFsRecPtr = FsGetFirstFilesystem(); Claim(); if (!isVfsPath) { - /* * Find and call the native filesystem handler first if there is one * because the root of Tcl's filesystem is always a native filesystem * (i.e., '/' on unix is native). */ @@ -1602,11 +1597,10 @@ "access mode \"%s\" not supported by this system", flag)); } goto invAccessMode; #endif - } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) { #ifdef O_NONBLOCK if (mode & O_NONBLOCK) { goto accessFlagRepeated; } @@ -1691,11 +1685,11 @@ Tcl_Interp *interp, /* Interpreter that evaluates the script. */ Tcl_Obj *pathPtr, /* Pathname of the file to process. * Tilde-substitution is performed on this * pathname. */ const char *encodingName) /* Either the name of an encoding or NULL to - use the utf-8 encoding. */ + * use the utf-8 encoding. */ { Tcl_Size length; int result = TCL_ERROR; Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile; @@ -1829,11 +1823,11 @@ Tcl_Interp *interp, /* Interpreter in which to evaluate the script. */ Tcl_Obj *pathPtr, /* Pathname of a file containing the script to * evaluate. Tilde-substitution is performed on * this pathname. */ const char *encodingName) /* The name of an encoding to use, or NULL to - * use the utf-8 encoding. */ + * use the utf-8 encoding. */ { Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile, *objPtr; Interp *iPtr; Tcl_Channel chan; @@ -2084,13 +2078,13 @@ */ int Tcl_FSStat( Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in - * current CP). */ + * current CP). */ Tcl_StatBuf *buf) /* A buffer to hold the results of the call to - * stat. */ + * stat. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->statProc != NULL) { return fsPtr->statProc(pathPtr, buf); @@ -2119,11 +2113,11 @@ */ int Tcl_FSLstat( Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in - current CP). */ + * current CP). */ Tcl_StatBuf *buf) /* Filled with results of that call to stat. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { @@ -2193,15 +2187,14 @@ Tcl_Interp *interp, /* Interpreter for error reporting, or NULL */ Tcl_Obj *pathPtr, /* Pathname of file to open. */ const char *modeString, /* A list of POSIX open modes or a string such * as "rw". */ int permissions) /* What modes to use if opening the file - involves creating it. */ + * involves creating it. */ { const Tcl_Filesystem *fsPtr; Tcl_Channel retVal = NULL; - if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { /* * Return the correct error message. */ @@ -2915,15 +2908,14 @@ } else { Tcl_SetErrno(ENOENT); } if (retVal == 0) { - - /* Assume that the cwd was actually changed to the normalized value - * just calculated, and cache that information. */ - /* + * Assume that the cwd was actually changed to the normalized value + * just calculated, and cache that information. + * * If the filesystem epoch changed recently, the normalized pathname or * its internal handle may be different from what was found above. * This can easily be the case with scripted documents . Therefore get * the normalized pathname again. The correct value will have been * cached as a result of the Tcl_FSGetFileSystemForPath call, above. @@ -3018,12 +3010,12 @@ */ int Tcl_FSLoadFile( Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic shared object. - */ + Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic + * shared object. */ const char *sym1, const char *sym2, /* Names of two functions to find in the * dynamic shared object. */ Tcl_LibraryInitProc **proc1Ptr, Tcl_LibraryInitProc **proc2Ptr, /* Places to store pointers to the functions @@ -3113,11 +3105,10 @@ * set to true (an integer > 0) * * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS filesystem can be detected (using statfs, if available). * */ - #ifdef hpux (void)shlibFile; return 1; #else @@ -3653,13 +3644,11 @@ */ Tcl_Obj * Tcl_FSLink( Tcl_Obj *pathPtr, /* Pathaname of file. */ - Tcl_Obj *toPtr, /* - * NULL or the pathname of a file to link to. - */ + Tcl_Obj *toPtr, /* NULL or the pathname of a file to link to. */ int linkAction) /* Action to perform. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr) { @@ -3904,11 +3893,12 @@ Tcl_Obj *pathPtr, /* Pathname to determine type of. */ const Tcl_Filesystem **filesystemPtrPtr, /* If not NULL, a place in which to store a * pointer to the filesystem for this pathname * if it is absolute. */ - Tcl_Size *driveNameLengthPtr, /* If not NULL, a place in which to store the + Tcl_Size *driveNameLengthPtr, + /* If not NULL, a place in which to store the * length of the volume name. */ Tcl_Obj **driveNameRef) /* If not NULL, for an absolute pathname, a * place to store a pointer to an object with a * refCount of 1, and whose value is the name * of the volume. */ @@ -3959,12 +3949,11 @@ const Tcl_Filesystem **filesystemPtrPtr, /* If not NULL, a place to store a pointer to * the filesystem for this pathname when it is * an absolute pathname. */ Tcl_Size *driveNameLengthPtr,/* If not NULL, a place to store the length of - * the volume name if the pathname is absolute. - */ + * the volume name if the pathname is absolute. */ Tcl_Obj **driveNameRef) /* If not NULL, a place to store a pointer to * an object having its its refCount already * incremented, and contining the name of the * volume if the pathname is absolute. */ { @@ -4076,11 +4065,11 @@ */ int Tcl_FSRenameFile( Tcl_Obj *srcPathPtr, /* The pathname of a file or directory to be - renamed. */ + * renamed. */ Tcl_Obj *destPathPtr) /* The new pathname for the file. */ { int retVal = -1; const Tcl_Filesystem *fsPtr, *fsPtr2; @@ -4453,11 +4442,11 @@ Disclaim(); return NULL; } else if (retVal != NULL) { /* * Found the filesystem in the internal representation of pathPtr. - */ + */ Disclaim(); return retVal; } /* Index: generic/tclIndexObj.c ================================================================== --- generic/tclIndexObj.c +++ generic/tclIndexObj.c @@ -53,11 +53,11 @@ * Keep this structure declaration in sync with tclTestObj.c */ typedef struct { void *tablePtr; /* Pointer to the table of strings */ - Tcl_Size offset; /* Offset between table entries */ + Tcl_Size offset; /* Offset between table entries */ Tcl_Size index; /* Selected index into table. */ } IndexRep; /* * The following macros greatly simplify moving through a table... @@ -104,11 +104,10 @@ const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ Tcl_Size *indexPtr) /* Place to store resulting index. */ { - Tcl_Size objc, t; int result; Tcl_Obj **objv; const char **tablePtr; @@ -804,11 +803,11 @@ */ void Tcl_WrongNumArgs( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments to print from objv. */ + Tcl_Size objc, /* Number of arguments to print from objv. */ Tcl_Obj *const objv[], /* Initial argument objects, which should be * included in the error message. */ const char *message) /* Error message to print after the leading * objects in objv. The message may be * NULL. */ @@ -1000,24 +999,23 @@ { Tcl_Obj **leftovers; /* Array to write back to remObjv on * successful exit. Will include the name of * the command. */ Tcl_Size nrem; /* Size of leftovers.*/ - const Tcl_ArgvInfo *infoPtr; - /* Pointer to the current entry in the table + const Tcl_ArgvInfo *infoPtr;/* Pointer to the current entry in the table * of argument descriptions. */ const Tcl_ArgvInfo *matchPtr; /* Descriptor that matches current argument */ Tcl_Obj *curArg; /* Current argument */ const char *str = NULL; - char c; /* Second character of current arg (used for + char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. * because first char. will almost always be * '-'). */ - Tcl_Size srcIndex; /* Location from which to read next argument + Tcl_Size srcIndex; /* Location from which to read next argument * from objv. */ - Tcl_Size dstIndex; /* Used to keep track of current arguments + Tcl_Size dstIndex; /* Used to keep track of current arguments * being processed, primarily for error * reporting. */ Tcl_Size objc; /* # arguments in objv still to process. */ Tcl_Size length; /* Number of characters in current argument */ Tcl_Size gf_ret; /* Return value from Tcl_ArgvGenFuncProc*/ @@ -1171,11 +1169,10 @@ objc--; } break; } case TCL_ARGV_GENFUNC: { - if (objc > INT_MAX) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "too many (%" TCL_SIZE_MODIFIER "d) arguments for TCL_ARGV_GENFUNC", objc)); goto error; } Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -255,11 +255,11 @@ * This contains no ::'s. The name of the * global namespace is "" although "::" is an * synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* An arbitrary value associated with this + void *clientData; /* An arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Procedure invoked when deleting the * namespace to, e.g., free clientData. */ struct Namespace *parentPtr;/* Points to the namespace that contains this @@ -277,11 +277,11 @@ #if TCL_MAJOR_VERSION > 8 size_t nsId; /* Unique id for the namespace. */ #else unsigned long nsId; #endif - Tcl_Interp *interp; /* The interpreter containing this + 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. */ Tcl_Size activationCount; /* Number of "activations" or active call * frames for this namespace that are on the @@ -310,16 +310,16 @@ * registered. */ Tcl_Size numExportPatterns; /* Number of export patterns currently * registered using "namespace export". */ Tcl_Size maxExportPatterns; /* Number of export patterns for which space * is currently allocated. */ - Tcl_Size cmdRefEpoch; /* Incremented if a newly added command + Tcl_Size 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. */ - Tcl_Size resolverEpoch; /* Incremented whenever (a) the name + Tcl_Size 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 * invalidates all byte codes compiled in the * namespace, causing the code to be @@ -408,16 +408,17 @@ * will be freed. * NS_SUPPRESS_COMPILATION - * Marks the commands in this namespace for not being compiled, * forcing them to be looked up every time. */ - -#define NS_DYING 0x01 -#define NS_DEAD 0x02 -#define NS_TEARDOWN 0x04 -#define NS_KILLED 0x04 /* Same as NS_TEARDOWN (Deprecated) */ -#define NS_SUPPRESS_COMPILATION 0x08 +enum NamespaceFlags { + NS_DYING = 0x01, + NS_DEAD = 0x02, + NS_TEARDOWN = 0x04, + NS_KILLED = 0x04, /* Same as NS_TEARDOWN (Deprecated) */ + NS_SUPPRESS_COMPILATION = 0x08 +}; /* * Flags passed to TclGetNamespaceForQualName: * * TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns. @@ -425,14 +426,15 @@ * TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces. * TCL_FIND_ONLY_NS - The name sought is a namespace name. * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of * name is not simple name (contains ::). */ - -#define TCL_CREATE_NS_IF_UNKNOWN 0x800 -#define TCL_FIND_ONLY_NS 0x1000 -#define TCL_FIND_IF_NOT_SIMPLE 0x2000 +enum NamespaceQualNameFlags { + TCL_CREATE_NS_IF_UNKNOWN = 0x800, + TCL_FIND_ONLY_NS = 0x1000, + TCL_FIND_IF_NOT_SIMPLE = 0x2000 +}; /* * The client data for an ensemble command. This consists of the table of * commands that are actually exported by the namespace, and an epoch counter * that, combined with the exportLookupEpoch field of the namespace structure, @@ -445,11 +447,11 @@ Tcl_Command token; /* The token for the command that provides * ensemble support for the namespace, or NULL * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - Tcl_Size epoch; /* The epoch at which this ensemble's table of + Tcl_Size 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 * number of entries as there are entries in * the subcommandTable hash. */ @@ -502,24 +504,25 @@ * is TCL_CONTINUE in which case the * subcommand will be re-parsed by the ensemble * core, presumably because the ensemble * itself has been updated. */ Tcl_Obj *parameterList; /* List of ensemble parameter names. */ - Tcl_Size numParameters; /* Cached number of parameters. This is either + Tcl_Size numParameters; /* Cached number of parameters. This is either * 0 (if the parameterList field is NULL) or * the length of the list in the parameterList * field. */ } EnsembleConfig; /* * Various bits for the EnsembleConfig.flags field. */ - -#define ENSEMBLE_DEAD 0x1 /* Flag value to say that the ensemble is dead +enum EnsembleConfigFlags { + ENSEMBLE_DEAD = 0x1, /* Flag value to say that the ensemble is dead * and on its way out. */ -#define ENSEMBLE_COMPILE 0x4 /* Flag to enable bytecode compilation of an + ENSEMBLE_COMPILE = 0x4 /* Flag to enable bytecode compilation of an * ensemble. */ +}; /* *---------------------------------------------------------------- * Data structures related to variables. These are used primarily in tclVar.c *---------------------------------------------------------------- @@ -532,11 +535,11 @@ */ typedef struct VarTrace { Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by * flags are performed on variable. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS and TCL_TRACE_ARRAY. */ struct VarTrace *nextPtr; /* Next in list of traces associated with a @@ -551,11 +554,11 @@ typedef struct CommandTrace { Tcl_CommandTraceProc *traceProc; /* Procedure to call when operations given by * flags are performed on command. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ struct CommandTrace *nextPtr; /* Next in list of traces associated with a @@ -727,41 +730,42 @@ * TCL_TRACE_(READS/WRITES/UNSETS/ARRAY): makes code simpler in tclTrace.c * * Keep the flag values for VAR_ARGUMENT and VAR_TEMPORARY so that old values * in precompiled scripts keep working. */ - -/* Type of value (0 is scalar) */ -#define VAR_ARRAY 0x1 -#define VAR_LINK 0x2 -#define VAR_CONSTANT 0x10000 - -/* Type of storage (0 is compiled local) */ -#define VAR_IN_HASHTABLE 0x4 -#define VAR_DEAD_HASH 0x8 -#define VAR_ARRAY_ELEMENT 0x1000 -#define VAR_NAMESPACE_VAR 0x80 /* KEEP OLD VALUE for Itcl */ - -#define VAR_ALL_HASH \ - (VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT) - -/* Trace and search state. */ - -#define VAR_TRACED_READ 0x10 /* TCL_TRACE_READS */ -#define VAR_TRACED_WRITE 0x20 /* TCL_TRACE_WRITES */ -#define VAR_TRACED_UNSET 0x40 /* TCL_TRACE_UNSETS */ -#define VAR_TRACED_ARRAY 0x800 /* TCL_TRACE_ARRAY */ -#define VAR_TRACE_ACTIVE 0x2000 -#define VAR_SEARCH_ACTIVE 0x4000 -#define VAR_ALL_TRACES \ - (VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET) - -/* Special handling on initialisation (only CompiledLocal). */ -#define VAR_ARGUMENT 0x100 /* KEEP OLD VALUE! See tclProc.c */ -#define VAR_TEMPORARY 0x200 /* KEEP OLD VALUE! See tclProc.c */ -#define VAR_IS_ARGS 0x400 -#define VAR_RESOLVED 0x8000 +enum TclVarFlags { + /* Type of value (0 is scalar) */ + VAR_ARRAY = 0x1, + VAR_LINK = 0x2, + VAR_CONSTANT = 0x10000, + + /* Type of storage (0 is compiled local) */ + VAR_IN_HASHTABLE = 0x4, + VAR_DEAD_HASH = 0x8, + VAR_ARRAY_ELEMENT = 0x1000, + VAR_NAMESPACE_VAR = 0x80, /* KEEP OLD VALUE for Itcl */ + + VAR_ALL_HASH = + (VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT), + + /* Trace and search state. */ + + VAR_TRACED_READ = 0x10, /* TCL_TRACE_READS */ + VAR_TRACED_WRITE = 0x20, /* TCL_TRACE_WRITES */ + VAR_TRACED_UNSET = 0x40, /* TCL_TRACE_UNSETS */ + VAR_TRACED_ARRAY = 0x800, /* TCL_TRACE_ARRAY */ + VAR_TRACE_ACTIVE = 0x2000, + VAR_SEARCH_ACTIVE = 0x4000, + VAR_ALL_TRACES = + (VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET), + + /* Special handling on initialisation (only CompiledLocal). */ + VAR_ARGUMENT = 0x100, /* KEEP OLD VALUE! See tclProc.c */ + VAR_TEMPORARY = 0x200, /* KEEP OLD VALUE! See tclProc.c */ + VAR_IS_ARGS = 0x400, + VAR_RESOLVED = 0x8000 +}; /* * Macros to ensure that various flag bits are set properly for variables. * The ANSI C "prototypes" for these macros are: * @@ -808,15 +812,15 @@ ((VarInHash *)(varPtr))->refCount++;\ }\ } #define TclClearVarNamespaceVar(varPtr) \ - if (TclIsVarNamespaceVar(varPtr)) {\ - (varPtr)->flags &= ~VAR_NAMESPACE_VAR;\ - if (TclIsVarInHash(varPtr)) {\ - ((VarInHash *)(varPtr))->refCount--;\ - }\ + if (TclIsVarNamespaceVar(varPtr)) { \ + (varPtr)->flags &= ~VAR_NAMESPACE_VAR; \ + if (TclIsVarInHash(varPtr)) { \ + ((VarInHash *)(varPtr))->refCount--; \ + } \ } /* * Macros to read various flag bits of variables. * The ANSI C "prototypes" for these macros are: @@ -832,14 +836,14 @@ * MODULE_SCOPE int TclIsVarResolved(Var *varPtr); */ #define TclVarFindHiddenArray(varPtr,arrayPtr) \ do { \ - if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ - (TclVarParentArray(varPtr) != NULL)) { \ - arrayPtr = TclVarParentArray(varPtr); \ - } \ + if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) \ + && (TclVarParentArray(varPtr) != NULL)) { \ + arrayPtr = TclVarParentArray(varPtr); \ + } \ } while(0) #define TclIsVarScalar(varPtr) \ !((varPtr)->flags & (VAR_ARRAY|VAR_LINK)) @@ -901,27 +905,27 @@ * Macros for direct variable access by TEBC. */ #define TclIsVarTricky(varPtr,trickyFlags) \ ( ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags)) \ - || (TclIsVarInHash(varPtr) \ - && (TclVarParentArray(varPtr) != NULL) \ - && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) + || (TclIsVarInHash(varPtr) \ + && (TclVarParentArray(varPtr) != NULL) \ + && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) #define TclIsVarDirectReadable(varPtr) \ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ)) \ - && (varPtr)->value.objPtr) + && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT)) #define TclIsVarDirectUnsettable(varPtr) \ (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH|VAR_CONSTANT)) #define TclIsVarDirectModifyable(varPtr) \ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT)) \ - && (varPtr)->value.objPtr) + && (varPtr)->value.objPtr) #define TclIsVarDirectReadable2(varPtr, arrayPtr) \ (TclIsVarDirectReadable(varPtr) &&\ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ))) @@ -971,13 +975,13 @@ typedef struct CompiledLocal { struct CompiledLocal *nextPtr; /* Next compiler-recognized local variable for * this procedure, or NULL if this is the last * local. */ - Tcl_Size nameLength; /* The number of bytes in local variable's name. + Tcl_Size nameLength; /* The number of bytes in local variable's name. * Among others used to speed up var lookups. */ - Tcl_Size frameIndex; /* Index in the array of compiler-assigned + Tcl_Size frameIndex; /* Index in the array of compiler-assigned * variables in the procedure call frame. */ #if TCL_MAJOR_VERSION < 9 int flags; #endif Tcl_Obj *defValuePtr; /* Pointer to the default value of an @@ -994,11 +998,11 @@ int flags; /* Flag bits for the local variable. Same as * the flags for the Var structure above, * although only VAR_ARGUMENT, VAR_TEMPORARY, * and VAR_RESOLVED make sense. */ #endif - char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If + char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If * the name is NULL, this will just be '\0'. * The actual size of this field will be large * enough to hold the name. MUST BE THE LAST * FIELD IN THE STRUCTURE! */ } CompiledLocal; @@ -1056,11 +1060,11 @@ #if TCL_MAJOR_VERSION > 8 Tcl_CmdObjTraceProc2 *proc; /* Procedure to call to trace command. */ #else Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */ #endif - void *clientData; /* Arbitrary value to pass to proc. */ + void *clientData; /* Arbitrary value to pass to proc. */ struct Trace *nextPtr; /* Next in list of traces for this interp. */ int flags; /* Flags governing the trace - see * Tcl_CreateObjTrace for details. */ Tcl_CmdObjTraceDeleteProc *delProc; /* Procedure to call when trace is deleted. */ @@ -1095,13 +1099,14 @@ * "enterstep" traces. * TCL_TRACE_LEAVE_EXEC - triggers leave/leavestep traces. * - passed to Tcl_CreateObjTrace to set up * "leavestep" traces. */ - -#define TCL_TRACE_ENTER_EXEC 1 -#define TCL_TRACE_LEAVE_EXEC 2 +enum TclExecTraceTypeFlags { + TCL_TRACE_ENTER_EXEC = 1, + TCL_TRACE_LEAVE_EXEC = 2 +}; #if TCL_MAJOR_VERSION > 8 #define TclObjTypeHasProc(objPtr, proc) (((objPtr)->typePtr \ && ((offsetof(Tcl_ObjType, proc) < offsetof(Tcl_ObjType, version)) \ || (offsetof(Tcl_ObjType, proc) < (objPtr)->typePtr->version))) ? \ @@ -1115,17 +1120,18 @@ * * This structure provides the functions used in List operations to emulate a * List for AbstractList types. */ - static inline Tcl_Size -TclObjTypeLength(Tcl_Obj *objPtr) +TclObjTypeLength( + Tcl_Obj *objPtr) { Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc); return proc(objPtr); } + static inline int TclObjTypeIndex( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size index, @@ -1132,10 +1138,11 @@ Tcl_Obj **elemObjPtr) { Tcl_ObjTypeIndexProc *proc = TclObjTypeHasProc(objPtr, indexProc); return proc(interp, objPtr, index, elemObjPtr); } + static inline int TclObjTypeSlice( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size fromIdx, @@ -1143,19 +1150,21 @@ Tcl_Obj **newObjPtr) { Tcl_ObjTypeSliceProc *proc = TclObjTypeHasProc(objPtr, sliceProc); return proc(interp, objPtr, fromIdx, toIdx, newObjPtr); } + static inline int TclObjTypeReverse( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **newObjPtr) { Tcl_ObjTypeReverseProc *proc = TclObjTypeHasProc(objPtr, reverseProc); return proc(interp, objPtr, newObjPtr); } + static inline int TclObjTypeGetElements( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objCPtr, @@ -1162,10 +1171,11 @@ Tcl_Obj ***objVPtr) { Tcl_ObjTypeGetElements *proc = TclObjTypeHasProc(objPtr, getElementsProc); return proc(interp, objPtr, objCPtr, objVPtr); } + static inline Tcl_Obj* TclObjTypeSetElement( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size indexCount, @@ -1173,10 +1183,11 @@ Tcl_Obj *valueObj) { Tcl_ObjTypeSetElement *proc = TclObjTypeHasProc(objPtr, setElementProc); return proc(interp, objPtr, indexCount, indexArray, valueObj); } + static inline int TclObjTypeReplace( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size first, @@ -1185,19 +1196,22 @@ Tcl_Obj *const insertObjs[]) { Tcl_ObjTypeReplaceProc *proc = TclObjTypeHasProc(objPtr, replaceProc); return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs); } + static inline int -TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj, - struct Tcl_Obj *listObj, int *boolResult) +TclObjTypeInOperator( + Tcl_Interp *interp, + Tcl_Obj *valueObj, + Tcl_Obj *listObj, + int *boolResult) { Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc); return proc(interp, valueObj, listObj, boolResult); } #endif /* TCL_MAJOR_VERSION > 8 */ - /* * The structure below defines an entry in the assocData hash table which is * associated with an interpreter. The entry contains a pointer to a function * to call when the interpreter is deleted, and a pointer to a user-defined @@ -1204,11 +1218,11 @@ * piece of data. */ typedef struct AssocData { Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */ - void *clientData; /* Value to pass to proc. */ + void *clientData; /* Value to pass to proc. */ } AssocData; /* * The structure below defines a call frame. A call frame defines a naming * context for a procedure call: its local naming scope (for local variables) @@ -1248,25 +1262,24 @@ * treated as references to namespace vars; * varTablePtr and compiledLocals are ignored. * If FRAME_IS_PROC is set, the frame was * pushed to execute a Tcl procedure and may * have local vars. */ - Tcl_Size objc; /* This and objv below describe the arguments + Tcl_Size objc; /* This and objv below describe the arguments * for this procedure call. */ Tcl_Obj *const *objv; /* Array of argument objects. */ - struct CallFrame *callerPtr; - /* Value of interp->framePtr when this + struct CallFrame *callerPtr;/* Value of interp->framePtr when this * procedure was invoked (i.e. next higher in * stack of all active procedures). */ struct CallFrame *callerVarPtr; /* Value of interp->varFramePtr when this * procedure was invoked (i.e. determines * variable scoping within caller). Same as * callerPtr unless an "uplevel" command or * something equivalent was active in the * caller). */ - Tcl_Size level; /* Level of this procedure, for "uplevel" + Tcl_Size level; /* Level of this procedure, for "uplevel" * purposes (i.e. corresponds to nesting of * callerVarPtr's, not callerPtr's). 1 for * outermost procedure, 0 for top-level. */ Proc *procPtr; /* Points to the structure defining the called * procedure. Used to get information such as @@ -1282,38 +1295,39 @@ * by the compiler including arguments. */ Var *compiledLocals; /* Points to the array of local variables * recognized by the compiler. The compiler * emits code that refers to these variables * using an index into this array. */ - void *clientData; /* Pointer to some context that is used by + void *clientData; /* Pointer to some context that is used by * object systems. The meaning of the contents * of this field is defined by the code that * sets it, and it should only ever be set by * the code that is pushing the frame. In that * case, the code that sets it should also * have some means of discovering what the * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; - Tcl_Obj *tailcallPtr; - /* NULL if no tailcall is scheduled */ + Tcl_Obj *tailcallPtr; /* NULL if no tailcall is scheduled */ } CallFrame; -#define FRAME_IS_PROC 0x1 -#define FRAME_IS_LAMBDA 0x2 -#define FRAME_IS_METHOD 0x4 /* The frame is a method body, and the frame's +enum CallFrameFlags { + FRAME_IS_PROC = 0x1, + FRAME_IS_LAMBDA = 0x2, + FRAME_IS_METHOD = 0x4, /* The frame is a method body, and the frame's * clientData field contains a CallContext * reference. Part of TIP#257. */ -#define FRAME_IS_OO_DEFINE 0x8 /* The frame is part of the inside workings of + FRAME_IS_OO_DEFINE = 0x8, /* The frame is part of the inside workings of * the [oo::define] command; the clientData * field contains an Object reference that has * been confirmed to refer to a class. Part of * TIP#257. */ -#define FRAME_IS_PRIVATE_DEFINE 0x10 + FRAME_IS_PRIVATE_DEFINE = 0x10 /* Marks this frame as being used for private * declarations with [oo::define]. Usually * OR'd with FRAME_IS_OO_DEFINE. TIP#500. */ +}; /* * TIP #280 * The structure below defines a command frame. A command frame provides * location information for all commands executing a tcl script (source, eval, @@ -1382,30 +1396,30 @@ const char *pc; /* ... and instruction pointer. */ } tebc; } data; Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ - Tcl_Size len; /* ... and its length. */ + Tcl_Size len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by * TclArgumentBCEnter(). These will be removed * by TclArgumentBCRelease. */ } CmdFrame; typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ - Tcl_Size word; /* Index of the word in the command. */ + Tcl_Size word; /* Index of the word in the command. */ Tcl_Size refCount; /* Number of times the word is on the * stack. */ } CFWord; typedef struct CFWordBC { CmdFrame *framePtr; /* CmdFrame to access. */ - Tcl_Size pc; /* Instruction pointer of a command in + Tcl_Size pc; /* Instruction pointer of a command in * ExtCmdLoc.loc[.] */ - Tcl_Size word; /* Index of word in + Tcl_Size word; /* Index of word in * ExtCmdLoc.loc[cmd]->line[.] */ struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */ struct CFWordBC *nextPtr; /* Next entry for same command call. See * CmdFrame litarg field for the list start. */ Tcl_Obj *obj; /* Back reference to hash table key */ @@ -1430,13 +1444,13 @@ */ #define CLL_END (-1) typedef struct ContLineLoc { - Tcl_Size num; /* Number of entries in loc, not counting the + Tcl_Size num; /* Number of entries in loc, not counting the * final -1 marker entry. */ - Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets. + Tcl_Size loc[TCLFLEXARRAY]; /* Table of locations, as character offsets. * The table is allocated as part of the * structure, extending behind the nominal end * of the structure. An entry containing the * value -1 is put after the last location, as * end-marker/sentinel. */ @@ -1456,35 +1470,39 @@ * * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC * types, per the context of the byte code in execution. */ -#define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script. */ -#define TCL_LOCATION_BC (2) /* Location in byte code. */ -#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no - * location. */ -#define TCL_LOCATION_SOURCE (4) /* Location in a file. */ -#define TCL_LOCATION_PROC (5) /* Location in a dynamic proc. */ -#define TCL_LOCATION_LAST (6) /* Number of values in the enum. */ +enum TclCodeLocationTypes { + TCL_LOCATION_EVAL = 0, /* Location in a dynamic eval script. */ + TCL_LOCATION_BC = 2, /* Location in byte code. */ + TCL_LOCATION_PREBC = 3, /* Location in precompiled byte code, no + * location. */ + TCL_LOCATION_SOURCE = 4, /* Location in a file. */ + TCL_LOCATION_PROC = 5, /* Location in a dynamic proc. */ + TCL_LOCATION_LAST = 6 /* Number of values in the enum. */ +}; /* * Structure passed to describe procedure-like "procedures" that are not * procedures (e.g. a lambda) so that their details can be reported correctly * by [info frame]. Contains a sub-structure for each extra field. */ typedef Tcl_Obj * (GetFrameInfoValueProc)(void *clientData); + typedef struct { const char *name; /* Name of this field. */ - GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the + GetFrameInfoValueProc *proc;/* Function to generate a Tcl_Obj* from the * clientData, or just use the clientData * directly (after casting) if NULL. */ - void *clientData; /* Context for above function, or Tcl_Obj* if + void *clientData; /* Context for above function, or Tcl_Obj* if * proc field is NULL. */ } ExtraFrameInfoField; + typedef struct { - Tcl_Size length; /* Length of array. */ + Tcl_Size length; /* Length of array. */ ExtraFrameInfoField fields[2]; /* Really as long as necessary, but this is * long enough for nearly anything. */ } ExtraFrameInfo; @@ -1503,12 +1521,14 @@ * Experimental flag value passed to Tcl_GetRegExpFromObj. Intended for use * only by Expect. It will probably go away in a later release. *---------------------------------------------------------------- */ -#define TCL_REG_BOSONLY 002000 /* Prepend \A to pattern so it only matches at +enum TclGetRegExpFromObjFlags { + TCL_REG_BOSONLY = 002000 /* Prepend \A to pattern so it only matches at * the beginning of the string. */ +}; /* * These are a thin layer over TclpThreadKeyDataGet and TclpThreadKeyDataSet * when threads are used, or an emulation if there are no threads. These are * really internal and Tcl clients should use Tcl_GetThreadData. @@ -1589,14 +1609,14 @@ * increasing addresses. The member stackPtr points to the stackItems of the * currently active execution stack. */ typedef struct CorContext { - struct CallFrame *framePtr; - struct CallFrame *varFramePtr; - struct CmdFrame *cmdFramePtr; /* See Interp.cmdFramePtr */ - Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ + CallFrame *framePtr; + CallFrame *varFramePtr; + CmdFrame *cmdFramePtr; /* See Interp.cmdFramePtr */ + Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ } CorContext; typedef struct CoroutineData { struct Command *cmdPtr; /* The command handle for the coroutine. */ struct ExecEnv *eePtr; /* The special execution environment (stacks, @@ -1605,34 +1625,33 @@ * the coroutine, which might be the * interpreter global environment or another * coroutine. */ CorContext caller; CorContext running; - Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ + Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ void *stackLevel; - Tcl_Size auxNumLevels; /* While the coroutine is running the + Tcl_Size auxNumLevels; /* While the coroutine is running the * numLevels of the create/resume command is * stored here; for suspended coroutines it * holds the nesting numLevels at yield. */ - Tcl_Size nargs; /* Number of args required for resuming this + Tcl_Size nargs; /* Number of args required for resuming this * coroutine; COROUTINE_ARGUMENTS_SINGLE_OPTIONAL means "0 or 1" * (default), COROUTINE_ARGUMENTS_ARBITRARY means "any" */ Tcl_Obj *yieldPtr; /* The command to yield to. Stored here in * order to reset splice point in * TclNRCoroutineActivateCallback if the - * coroutine is busy. - */ + * coroutine is busy. */ } CoroutineData; typedef struct ExecEnv { ExecStack *execStackPtr; /* Points to the first item in the evaluation * stack on the heap. */ Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */ - struct Tcl_Interp *interp; + Tcl_Interp *interp; struct NRE_callback *callbackPtr; /* Top callback in NRE's stack. */ - struct CoroutineData *corPtr; + CoroutineData *corPtr; int rewind; } ExecEnv; #define COR_IS_SUSPENDED(corPtr) \ ((corPtr)->stackLevel == NULL) @@ -1675,15 +1694,15 @@ * points to first entry in bucket's hash * chain, or NULL. */ LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ - TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at + TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at * **buckets. */ - TCL_HASH_TYPE numEntries; /* Total number of entries present in + TCL_HASH_TYPE numEntries; /* Total number of entries present in * table. */ - TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be + TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ TCL_HASH_TYPE mask; /* Mask value used in hashing function. */ } LiteralTable; /* @@ -1692,22 +1711,23 @@ * interpreter's operation in that interpreter. */ #ifdef TCL_COMPILE_STATS typedef struct ByteCodeStats { - size_t numExecutions; /* Number of ByteCodes executed. */ + 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 + size_t instructionCount[256]; + /* Number of times each instruction was * executed. */ double totalSrcBytes; /* Total source bytes ever compiled. */ double totalByteCodeBytes; /* Total bytes for all ByteCodes. */ double currentSrcBytes; /* Src bytes for all current ByteCodes. */ double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */ - size_t 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). */ size_t byteCodeCount[32]; /* ByteCode size distribution. */ size_t lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ double currentInstBytes; /* Instruction bytes-current ByteCodes. */ @@ -1733,11 +1753,11 @@ typedef struct { const char *name; /* The name of the subcommand. */ Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */ CompileProc *compileProc; /* The compiler for the subcommand. */ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ - void *clientData; /* Any clientData to give the command. */ + void *clientData; /* Any clientData to give the command. */ int unsafe; /* Whether this command is to be hidden by * default in a safe interpreter. */ } EnsembleImplMap; /* @@ -1812,15 +1832,15 @@ CompileProc *compileProc; /* Procedure called to compile command. NULL * if no compile proc exists for command. */ Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */ void *objClientData; /* Arbitrary value passed to object proc. */ Tcl_CmdProc *proc; /* String-based command procedure. */ - void *clientData; /* Arbitrary value passed to string proc. */ + void *clientData; /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Procedure invoked when deleting command to, * e.g., free all client data. */ - void *deleteData; /* Arbitrary value passed to deleteProc. */ + void *deleteData; /* Arbitrary value passed to deleteProc. */ int flags; /* Miscellaneous bits of information about * command. See below for definitions. */ ImportRef *importRefPtr; /* List of each imported Command created in * another namespace when this command is * imported. These imported commands redirect @@ -1833,40 +1853,31 @@ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ } Command; /* * Flag bits for commands. - * - * CMD_DYING - If 1 the command is in the process of - * being deleted (its deleteProc is currently - * executing). Other attempts to delete the - * command should be ignored. - * CMD_TRACE_ACTIVE - If 1 the trace processing is currently - * underway for a rename/delete change. See the - * two flags below for which is currently being - * processed. - * CMD_HAS_EXEC_TRACES - If 1 means that this command has at least one - * execution trace (as opposed to simple - * delete/rename traces) in its tracePtr list. - * CMD_COMPILES_EXPANDED - If 1 this command has a compiler that - * can handle expansion (provided it is not the - * first word). - * TCL_TRACE_RENAME - A rename trace is in progress. Further - * recursive renames will not be traced. - * TCL_TRACE_DELETE - A delete trace is in progress. Further - * recursive deletes will not be traced. - * (these last two flags are defined in tcl.h) */ - -#define CMD_DYING 0x01 -#define CMD_TRACE_ACTIVE 0x02 -#define CMD_HAS_EXEC_TRACES 0x04 -#define CMD_COMPILES_EXPANDED 0x08 -#define CMD_REDEF_IN_PROGRESS 0x10 -#define CMD_VIA_RESOLVER 0x20 -#define CMD_DEAD 0x40 - +enum CommandFlags { + CMD_DYING = 0x01, /* The command is in the process of being + * deleted (its deleteProc is currently + * executing). Other attempts to delete the + * command should be ignored. */ + CMD_TRACE_ACTIVE = 0x02, /* Trace processing is currently underway for + * a rename/delete change. See other flags + * (TCL_TRACE_RENAME and TCL_TRACE_DELETE) + * for which is currently being processed. */ + CMD_HAS_EXEC_TRACES = 0x04, /* This command has at least one execution + * trace (as opposed to simple delete/rename + * traces) in its tracePtr list.*/ + CMD_COMPILES_EXPANDED = 0x08, + /* This command has a compiler that can handle + * expansion (provided it is not the + * first word).*/ + CMD_REDEF_IN_PROGRESS = 0x10, + CMD_VIA_RESOLVER = 0x20, + CMD_DEAD = 0x40 +}; /* *---------------------------------------------------------------- * Data structures related to name resolution procedures. *---------------------------------------------------------------- @@ -1962,22 +1973,19 @@ * 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. - */ - + * interps. */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ - Namespace *globalNsPtr; /* The interpreter's global namespace. */ Tcl_HashTable *hiddenCmdTablePtr; /* Hash table used by tclBasic.c to keep track * of hidden commands on a per-interp * basis. */ - void *interpInfo; /* Information used by tclInterp.c to keep + void *interpInfo; /* Information used by tclInterp.c to keep * track of parent/child interps on a * per-interp basis. */ #if TCL_MAJOR_VERSION > 8 void (*optimizer)(void *envPtr); #else @@ -2052,11 +2060,11 @@ 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. */ - Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for + Tcl_Size 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 * redefined. */ Proc *compiledProcPtr; /* If a procedure is being compiled, a pointer @@ -2099,11 +2107,12 @@ * interp, or NULL if no active traces. */ ActiveInterpTrace *activeInterpTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ - Tcl_Size tracesForbiddingInline; /* Count of traces (in the list headed by + Tcl_Size tracesForbiddingInline; + /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode * compilation. */ /* * Fields used to manage extensible return options (TIP 90). @@ -2128,19 +2137,17 @@ int granularityTicker; /* Counter used to determine how often to * check the limits. */ int exceeded; /* Which limits have been exceeded, described * as flag values the same as the 'active' * field. */ - - Tcl_Size cmdCount; /* Limit for how many commands to execute in + Tcl_Size cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is * reached. */ int cmdGranularity; /* Mod factor used to determine how often to * evaluate the limit check. */ - Tcl_Time time; /* Time limit for execution within the * interpreter. */ LimitHandler *timeHandlers; /* Handlers to execute when the limit is * reached. */ @@ -2165,13 +2172,14 @@ Tcl_Obj *const *sourceObjs; /* What arguments were actually input into the * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ - Tcl_Size numRemovedObjs; /* How many arguments have been stripped off + Tcl_Size numRemovedObjs;/* How many arguments have been stripped off * because of ensemble processing. */ - Tcl_Size numInsertedObjs; /* How many of the current arguments were + Tcl_Size numInsertedObjs; + /* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; /* * TIP #219: Global info for the I/O system. @@ -2227,12 +2235,11 @@ * if any. This pointer is set by the function * TclEvalObjEx() in file "tclBasic.c", and * used by function ...() in the same file. * It does for the eval/direct path of script * execution what CompileEnv.clLoc does for - * the bytecode compiler. - */ + * the bytecode compiler. */ /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. */ @@ -2292,19 +2299,20 @@ * errors. This information, if present * (asyncCancelMsg not NULL), takes precedence * over the default error messages returned by * a script cancellation operation. */ - /* - * TIP #348 IMPLEMENTATION - Substituted error stack - */ + /* + * TIP #348 IMPLEMENTATION - Substituted error stack + */ + Tcl_Obj *errorStack; /* [info errorstack] value (as a Tcl_Obj). */ Tcl_Obj *upLiteral; /* "UP" literal for [info errorstack] */ Tcl_Obj *callLiteral; /* "CALL" literal for [info errorstack] */ Tcl_Obj *innerLiteral; /* "INNER" literal for [info errorstack] */ Tcl_Obj *innerContext; /* cached list for fast reallocation */ - int resetErrorStack; /* controls cleaning up of ::errorStack */ + int resetErrorStack; /* controls cleaning up of ::errorStack */ #ifdef TCL_COMPILE_STATS /* * Statistical information about the bytecode compiler and interpreter's * operation. This should be the last field of Interp. @@ -2327,14 +2335,14 @@ */ #define TclCanceled(iPtr) \ (((iPtr)->flags & CANCELED) || ((iPtr)->flags & TCL_CANCEL_UNWIND)) -#define TclSetCancelFlags(iPtr, cancelFlags) \ - (iPtr)->flags |= CANCELED; \ - if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ - (iPtr)->flags |= TCL_CANCEL_UNWIND; \ +#define TclSetCancelFlags(iPtr, cancelFlags) \ + (iPtr)->flags |= CANCELED; \ + if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ + (iPtr)->flags |= TCL_CANCEL_UNWIND; \ } #define TclUnsetCancelFlags(iPtr) \ (iPtr)->flags &= (~(CANCELED | TCL_CANCEL_UNWIND)) @@ -2346,40 +2354,40 @@ * b = list head. * * TclSpliceIn adds to the head of the list. */ -#define TclSpliceIn(a,b) \ - (a)->nextPtr = (b); \ - if ((b) != NULL) { \ - (b)->prevPtr = (a); \ - } \ +#define TclSpliceIn(a, b) \ + (a)->nextPtr = (b); \ + if ((b) != NULL) { \ + (b)->prevPtr = (a); \ + } \ (a)->prevPtr = NULL, (b) = (a); -#define TclSpliceOut(a,b) \ - if ((a)->prevPtr != NULL) { \ - (a)->prevPtr->nextPtr = (a)->nextPtr; \ - } else { \ - (b) = (a)->nextPtr; \ - } \ - if ((a)->nextPtr != NULL) { \ - (a)->nextPtr->prevPtr = (a)->prevPtr; \ +#define TclSpliceOut(a, b) \ + if ((a)->prevPtr != NULL) { \ + (a)->prevPtr->nextPtr = (a)->nextPtr; \ + } else { \ + (b) = (a)->nextPtr; \ + } \ + if ((a)->nextPtr != NULL) { \ + (a)->nextPtr->prevPtr = (a)->prevPtr; \ } /* * EvalFlag bits for Interp structures: - * - * TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with a - * code other than TCL_OK or TCL_ERROR; 0 means codes - * other than these should be turned into errors. */ - -#define TCL_ALLOW_EXCEPTIONS 0x04 -#define TCL_EVAL_FILE 0x02 -#define TCL_EVAL_SOURCE_IN_FRAME 0x10 -#define TCL_EVAL_NORESOLVE 0x20 -#define TCL_EVAL_DISCARD_RESULT 0x40 +enum EvalFlags { + TCL_EVAL_FILE = 0x2, + TCL_ALLOW_EXCEPTIONS = 0x4, /* It's OK for the script to terminate with a + * code other than TCL_OK or TCL_ERROR; if + * unset, it means codes other than these + * should be turned into errors. */ + TCL_EVAL_SOURCE_IN_FRAME = 0x10, + TCL_EVAL_NORESOLVE = 0x20, + TCL_EVAL_DISCARD_RESULT = 0x40 +}; /* * Flag bits for Interp structures: * * DELETED: Non-zero means the interpreter has been deleted: @@ -2423,21 +2431,22 @@ * * WARNING: For the sake of some extensions that have made use of former * internal values, do not re-use the flag values 2 (formerly ERR_IN_PROGRESS) * or 8 (formerly ERROR_CODE_SET). */ - -#define DELETED 1 -#define ERR_ALREADY_LOGGED 4 -#define INTERP_DEBUG_FRAME 0x10 -#define DONT_COMPILE_CMDS_INLINE 0x20 -#define RAND_SEED_INITIALIZED 0x40 -#define SAFE_INTERP 0x80 -#define INTERP_TRACE_IN_PROGRESS 0x200 -#define INTERP_ALTERNATE_WRONG_ARGS 0x400 -#define ERR_LEGACY_COPY 0x800 -#define CANCELED 0x1000 +enum InterpFlags { + DELETED = 1, + ERR_ALREADY_LOGGED = 4, + INTERP_DEBUG_FRAME = 0x10, + DONT_COMPILE_CMDS_INLINE = 0x20, + RAND_SEED_INITIALIZED = 0x40, + SAFE_INTERP = 0x80, + INTERP_TRACE_IN_PROGRESS = 0x200, + INTERP_ALTERNATE_WRONG_ARGS = 0x400, + ERR_LEGACY_COPY = 0x800, + CANCELED = 0x1000 +}; /* * Maximum number of levels of nesting permitted in Tcl commands (used to * catch infinite recursion). */ @@ -2535,14 +2544,15 @@ * TCL_INVOKE_NO_TRACEBACK Does not record traceback information if the * invoked command returns an error. Used if the * caller plans on recording its own traceback * information. */ - -#define TCL_INVOKE_HIDDEN (1<<0) -#define TCL_INVOKE_NO_UNKNOWN (1<<1) -#define TCL_INVOKE_NO_TRACEBACK (1<<2) +enum TclInvokeFlags { + TCL_INVOKE_HIDDEN = (1<<0), + TCL_INVOKE_NO_UNKNOWN = (1<<1), + TCL_INVOKE_NO_TRACEBACK = (1<<2) +}; /* * ListStore -- * * A Tcl list's internal representation is defined through three structures. @@ -2566,51 +2576,57 @@ * optional in which case the list includes all the "in-use" slots of the * ListStore. * */ typedef struct ListStore { - Tcl_Size firstUsed; /* Index of first slot in use within slots[] */ - Tcl_Size numUsed; /* Number of slots in use (starting firstUsed) */ - Tcl_Size numAllocated; /* Total number of slots[] array slots. */ - size_t refCount; /* Number of references to this instance */ - int flags; /* LISTSTORE_* flags */ - Tcl_Obj *slots[TCLFLEXARRAY]; /* Variable size array. Grown as needed */ + Tcl_Size firstUsed; /* Index of first slot in use within slots[] */ + Tcl_Size numUsed; /* Number of slots in use (starting firstUsed) */ + Tcl_Size numAllocated; /* Total number of slots[] array slots. */ + size_t refCount; /* Number of references to this instance */ + int flags; /* LISTSTORE_* flags */ + Tcl_Obj *slots[TCLFLEXARRAY]; /* Variable size array. Grown as needed */ } ListStore; -#define LISTSTORE_CANONICAL 0x1 /* All Tcl_Obj's referencing this - store have their string representation - derived from the list representation */ +enum ListStoreFlags { + LISTSTORE_CANONICAL = 0x1 /* All Tcl_Obj's referencing this store have + * their string representation derived from + * the list representation. */ +}; /* Max number of elements that can be contained in a list */ -#define LIST_MAX \ +#define LIST_MAX \ ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ / sizeof(Tcl_Obj *))) + /* Memory size needed for a ListStore to hold numSlots_ elements */ #define LIST_SIZE(numSlots_) \ ((Tcl_Size)(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *)))) /* * ListSpan -- * See comments above for ListStore */ typedef struct ListSpan { - Tcl_Size spanStart; /* Starting index of the span */ - Tcl_Size spanLength; /* Number of elements in the span */ - size_t refCount; /* Count of references to this span record */ + Tcl_Size spanStart; /* Starting index of the span */ + Tcl_Size spanLength; /* Number of elements in the span */ + size_t refCount; /* Count of references to this span record */ } ListSpan; -#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ + +#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ #define LIST_SPAN_THRESHOLD 101 #endif /* * ListRep -- * See comments above for ListStore */ typedef struct ListRep { - ListStore *storePtr;/* element array shared amongst different lists */ - ListSpan *spanPtr; /* If not NULL, the span holds the range of slots - within *storePtr that contain this list elements. */ + ListStore *storePtr; /* Element array shared amongst different + * lists. */ + ListSpan *spanPtr; /* If not NULL, the span holds the range of + * slots within *storePtr that contain this + * list elements. */ } ListRep; /* * Macros used to get access list internal representations. * @@ -2622,30 +2638,49 @@ * be tclListType. These will convert as needed and return error if * conversion not possible. */ /* Returns the starting slot for this listRep in the contained ListStore */ -#define ListRepStart(listRepPtr_) \ - ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanStart \ - : (listRepPtr_)->storePtr->firstUsed) +static inline Tcl_Size +ListRepStart( + const ListRep *listRepPtr) +{ + return (listRepPtr->spanPtr + ? listRepPtr->spanPtr->spanStart + : listRepPtr->storePtr->firstUsed); +} /* Returns the number of elements in this listRep */ -#define ListRepLength(listRepPtr_) \ - ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanLength \ - : (listRepPtr_)->storePtr->numUsed) +static inline Tcl_Size +ListRepLength( + const ListRep *listRepPtr) +{ + return (listRepPtr->spanPtr + ? listRepPtr->spanPtr->spanLength + : listRepPtr->storePtr->numUsed); +} /* Returns a pointer to the first slot containing this ListRep elements */ -#define ListRepElementsBase(listRepPtr_) \ - (&(listRepPtr_)->storePtr->slots[ListRepStart(listRepPtr_)]) +static inline Tcl_Obj ** +ListRepElementsBase( + ListRep *listRepPtr) +{ + return &listRepPtr->storePtr->slots[ListRepStart(listRepPtr)]; +} /* Stores the number of elements and base address of the element array */ #define ListRepElements(listRepPtr_, objc_, objv_) \ (((objv_) = ListRepElementsBase(listRepPtr_)), \ ((objc_) = ListRepLength(listRepPtr_))) /* Returns 1/0 whether the ListRep's ListStore is shared. */ -#define ListRepIsShared(listRepPtr_) ((listRepPtr_)->storePtr->refCount > 1) +static inline int +ListRepIsShared( + const ListRep *listRepPtr) +{ + return listRepPtr->storePtr->refCount > 1; +} /* Returns a pointer to the ListStore component */ #define ListObjStorePtr(listObj_) \ ((ListStore *)((listObj_)->internalRep.twoPtrValue.ptr1)) @@ -2652,38 +2687,51 @@ /* Returns a pointer to the ListSpan component */ #define ListObjSpanPtr(listObj_) \ ((ListSpan *)((listObj_)->internalRep.twoPtrValue.ptr2)) /* Returns the ListRep internal representaton in a Tcl_Obj */ -#define ListObjGetRep(listObj_, listRepPtr_) \ - do { \ - (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ - (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ - } while (0) +static inline void +ListObjGetRep( + Tcl_Obj *listObj, + ListRep *listRepPtr) +{ + listRepPtr->storePtr = ListObjStorePtr(listObj); + listRepPtr->spanPtr = ListObjSpanPtr(listObj); +} /* Returns the length of the list */ -#define ListObjLength(listObj_, len_) \ - ((len_) = ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanLength \ - : ListObjStorePtr(listObj_)->numUsed) +#define ListObjLength(listObj_, len_) \ + ((len_) = ListObjSpanPtr(listObj_) \ + ? ListObjSpanPtr(listObj_)->spanLength \ + : ListObjStorePtr(listObj_)->numUsed) /* Returns the starting slot index of this list's elements in the ListStore */ -#define ListObjStart(listObj_) \ - (ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanStart \ - : ListObjStorePtr(listObj_)->firstUsed) +static inline Tcl_Size +ListObjStart( + Tcl_Obj *listObj) +{ + return (ListObjSpanPtr(listObj) + ? ListObjSpanPtr(listObj)->spanStart + : ListObjStorePtr(listObj)->firstUsed); +} /* Stores the element count and base address of this list's elements */ #define ListObjGetElements(listObj_, objc_, objv_) \ (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \ (ListObjLength(listObj_, (objc_)))) - /* * Returns 1/0 whether the internal representation (not the Tcl_Obj itself) * is shared. Note by intent this only checks for sharing of ListStore, * not spans. */ -#define ListObjRepIsShared(listObj_) (ListObjStorePtr(listObj_)->refCount > 1) +static inline int +ListObjRepIsShared( + Tcl_Obj *listObj) +{ + return ListObjStorePtr(listObj)->refCount > 1; +} /* * Certain commands like concat are optimized if an existing string * representation of a list object is known to be in canonical format (i.e. * generated from the list representation). There are three conditions when @@ -2696,48 +2744,58 @@ * (3) The list representation does not have a span component. This is * because list Tcl_Obj's with spans are always created from existing lists * and never from strings (see SetListFromAny) and thus their string * representation will always be canonical. */ -#define ListObjIsCanonical(listObj_) \ - (((listObj_)->bytes == NULL) \ - || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ - || ListObjSpanPtr(listObj_) != NULL) +static inline int +ListObjIsCanonical( + Tcl_Obj *listObj) +{ + return ((listObj->bytes == NULL) + || (ListObjStorePtr(listObj)->flags & LISTSTORE_CANONICAL) + || ListObjSpanPtr(listObj) != NULL); +} /* * Converts the Tcl_Obj to a list if it isn't one and stores the element * count and base address of this list's elements in objcPtr_ and objvPtr_. * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ -#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ - TCL_OK) \ - : Tcl_ListObjGetElements( \ +#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ + TCL_OK) \ + : Tcl_ListObjGetElements( \ (interp_), (listObj_), (objcPtr_), (objvPtr_))) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element * count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the * Tcl_Obj cannot be converted to a list. */ -#define TclListObjLength(interp_, listObj_, lenPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ +#define TclListObjLength(interp_, listObj_, lenPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) -#define TclListObjIsCanonical(listObj_) \ - ((TclHasInternalRep((listObj_), &tclListType)) ? ListObjIsCanonical((listObj_)) : 0) +static inline int +TclListObjIsCanonical( + Tcl_Obj *listObj) +{ + return TclHasInternalRep(listObj, &tclListType) + && ListObjIsCanonical(listObj); +} /* * Modes for collecting (or not) in the implementations of TclNRForeachCmd, * TclNRLmapCmd and their compilations. */ - -#define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */ -#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */ +enum TclForeachModes { + TCL_EACH_KEEP_NONE = 0, /* Discard iteration result like [foreach] */ + TCL_EACH_COLLECT = 1 /* Collect iteration result like [lmap] */ +}; /* * Macros providing a faster path to booleans and integers: * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj * and Tcl_GetIntForIndex. @@ -2745,27 +2803,27 @@ * WARNING: these macros eval their args more than once. */ #if TCL_MAJOR_VERSION > 8 #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ - || TclHasInternalRep((objPtr), &tclBooleanType)) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ + || TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #else #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ + ((TclHasInternalRep((objPtr), &tclIntType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ - : (TclHasInternalRep((objPtr), &tclBooleanType)) \ + : (TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #endif #ifdef TCL_WIDE_INT_IS_LONG #define TclGetLongFromObj(interp, objPtr, longPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ - ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ + ((TclHasInternalRep((objPtr), &tclIntType)) \ + ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #else #define TclGetLongFromObj(interp, objPtr, longPtr) \ ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \ @@ -2773,19 +2831,19 @@ ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #endif #define TclGetIntFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ (((TclHasInternalRep((objPtr), &tclIntType)) && ((objPtr)->internalRep.wideValue >= 0) \ - && ((objPtr)->internalRep.wideValue <= endValue)) \ - ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ + && ((objPtr)->internalRep.wideValue <= endValue)) \ + ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* * Macro used to save a function call for common uses of * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: @@ -2793,11 +2851,11 @@ * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, * Tcl_WideInt *wideIntPtr); */ #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ + ((TclHasInternalRep((objPtr), &tclIntType)) \ ? (*(wideIntPtr) = \ ((objPtr)->internalRep.wideValue), TCL_OK) : \ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) /* @@ -2816,15 +2874,16 @@ * DICT_PATH_NON_EXISTENT if the path is not traceable. * * DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to be set) * indicates that we are to create non-existent dictionaries on the path. */ - -#define DICT_PATH_READ 0 -#define DICT_PATH_UPDATE 1 -#define DICT_PATH_EXISTS 2 -#define DICT_PATH_CREATE 5 +enum TclDictPathFlags { + DICT_PATH_READ = 0, + DICT_PATH_UPDATE = 1, + DICT_PATH_EXISTS = 2, + DICT_PATH_CREATE = 5 +}; #define DICT_PATH_NON_EXISTENT ((Tcl_Obj *) (void *) 1) /* *---------------------------------------------------------------- @@ -2898,11 +2957,11 @@ Tcl_Encoding *encodingPtr); #ifdef _WIN32 # define TCLFSENCODING tclUtf8Encoding /* On Windows, all Unicode (except surrogates) are valid */ #else -# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */ +# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */ #endif /* * A ProcessGlobalValue struct exists for each internal value in Tcl that is * to be shared among several threads. Each thread sees a (Tcl_Obj) copy of @@ -2910,11 +2969,11 @@ * mutex control. Each ProcessGlobalValue struct should be a static variable in * some file. */ typedef struct ProcessGlobalValue { - Tcl_Size epoch; /* Epoch counter to detect changes in the + Tcl_Size epoch; /* Epoch counter to detect changes in the * global value. */ TCL_HASH_TYPE numBytes; /* Length of the global string. */ char *value; /* The global string value. */ Tcl_Encoding encoding; /* system encoding when global string was * initialized. */ @@ -2931,44 +2990,43 @@ /* *---------------------------------------------------------------------- * Flags for TclParseNumber *---------------------------------------------------------------------- */ - -#define TCL_PARSE_DECIMAL_ONLY 1 - /* Leading zero doesn't denote octal or +enum TclParseNumberFlags { + TCL_PARSE_DECIMAL_ONLY = 1, /* Leading zero doesn't denote octal or * hex. */ -#define TCL_PARSE_OCTAL_ONLY 2 - /* Parse octal even without prefix. */ -#define TCL_PARSE_HEXADECIMAL_ONLY 4 + TCL_PARSE_OCTAL_ONLY = 2, /* Parse octal even without prefix. */ + TCL_PARSE_HEXADECIMAL_ONLY = 4, /* Parse hexadecimal even without prefix. */ -#define TCL_PARSE_INTEGER_ONLY 8 - /* Disable floating point parsing. */ -#define TCL_PARSE_SCAN_PREFIXES 16 + TCL_PARSE_INTEGER_ONLY = 8, /* Disable floating point parsing. */ + TCL_PARSE_SCAN_PREFIXES = 16, /* Use [scan] rules dealing with 0? * prefixes. */ -#define TCL_PARSE_NO_WHITESPACE 32 + TCL_PARSE_NO_WHITESPACE = 32, /* Reject leading/trailing whitespace. */ -#define TCL_PARSE_BINARY_ONLY 64 - /* Parse binary even without prefix. */ -#define TCL_PARSE_NO_UNDERSCORE 128 + TCL_PARSE_BINARY_ONLY = 64, /* Parse binary even without prefix. */ + TCL_PARSE_NO_UNDERSCORE = 128 /* Reject underscore digit separator */ - +}; /* *---------------------------------------------------------------------- * Internal convenience macros for manipulating encoding flags. See * TCL_ENCODING_PROFILE_* in tcl.h *---------------------------------------------------------------------- */ #define ENCODING_PROFILE_MASK 0xFF000000 -#define ENCODING_PROFILE_GET(flags_) ((flags_) & ENCODING_PROFILE_MASK) -#define ENCODING_PROFILE_SET(flags_, profile_) \ - do { \ - (flags_) &= ~ENCODING_PROFILE_MASK; \ - (flags_) |= ((profile_) & ENCODING_PROFILE_MASK);\ + +#define ENCODING_PROFILE_GET(flags_) \ + ((flags_) & ENCODING_PROFILE_MASK) + +#define ENCODING_PROFILE_SET(flags_, profile_) \ + do { \ + (flags_) &= ~ENCODING_PROFILE_MASK; \ + (flags_) |= ((profile_) & ENCODING_PROFILE_MASK); \ } while (0) /* *---------------------------------------------------------------------- * Common functions for calculating overallocation. Trivial but allows for @@ -2978,65 +3036,98 @@ * TclResizeAlloc is needed in special cases such as when total size of * memory block is limited to less than TCL_SIZE_MAX. * *---------------------------------------------------------------------- */ + static inline Tcl_Size -TclUpsizeAlloc(TCL_UNUSED(Tcl_Size) /* oldSize. For future experiments with - * some growth algorithms that use this - * information. */, - Tcl_Size needed, - Tcl_Size limit) +TclUpsizeAlloc( + TCL_UNUSED(Tcl_Size), /* oldSize. For future experiments with + * some growth algorithms that use this + * information. */ + Tcl_Size needed, + Tcl_Size limit) { /* assert (oldCapacity < needed <= limit) */ if (needed < (limit - needed/2)) { return needed + needed / 2; - } - else { + } else { return limit; } } -static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) { - /* assert (needed < lastAttempt) */ + +static inline Tcl_Size +TclUpsizeRetry( + Tcl_Size needed, + Tcl_Size lastAttempt) +{ + /* assert (needed < lastAttempt) */ if (needed < lastAttempt - 1) { /* (needed+lastAttempt)/2 but that formula may overflow Tcl_Size */ return needed + (lastAttempt - needed) / 2; } else { return needed; } } -MODULE_SCOPE void *TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr); -MODULE_SCOPE void *TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount, - Tcl_Size elemSize, Tcl_Size leadSize, - Tcl_Size *capacityPtr); -MODULE_SCOPE void *TclAttemptReallocElemsEx(void *oldPtr, - Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr); + +MODULE_SCOPE void * TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount, + Tcl_Size elemSize, Tcl_Size leadSize, + Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclAttemptReallocElemsEx(void *oldPtr, + Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr); + /* Alloc elemCount elements of size elemSize with leadSize header * returning actual capacity (in elements) in *capacityPtr. */ -static inline void *TclAttemptAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr) { +static inline void * +TclAttemptAllocElemsEx( + Tcl_Size elemCount, + Tcl_Size elemSize, + Tcl_Size leadSize, + Tcl_Size *capacityPtr) +{ return TclAttemptReallocElemsEx( - NULL, elemCount, elemSize, leadSize, capacityPtr); + NULL, elemCount, elemSize, leadSize, capacityPtr); } + /* Alloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclAllocEx( + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclAllocElemsEx(numBytes, 1, 0, capacityPtr); } + /* Alloc numByte bytes, returning actual capacity in *capacityPtr. */ static inline void * -TclAttemptAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) +TclAttemptAllocEx( + Tcl_Size numBytes, + Tcl_Size *capacityPtr) { return TclAttemptAllocElemsEx(numBytes, 1, 0, capacityPtr); } + /* Realloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclReallocEx( + void *oldPtr, + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr); } + /* Realloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclAttemptReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclAttemptReallocEx( + void *oldPtr, + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclAttemptReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr); } /* *---------------------------------------------------------------- @@ -3053,17 +3144,16 @@ * Declarations related to internal encoding functions. */ MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; MODULE_SCOPE Tcl_Encoding tclUtf8Encoding; -MODULE_SCOPE int -TclEncodingProfileNameToId(Tcl_Interp *interp, - const char *profileName, - int *profilePtr); +MODULE_SCOPE int TclEncodingProfileNameToId(Tcl_Interp *interp, + const char *profileName, + int *profilePtr); MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp, - int profileId); -MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); + int profileId); +MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); /* * TIP #233 (Virtualized Time) * Data for the time hooks, if any. */ @@ -3157,16 +3247,16 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke; MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues; -MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); -MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); +MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); +MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); /* These two can be considered for the public api */ -MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); -MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); /* * This structure holds the data for the various iteration callbacks used to * NRE the 'for' and 'while' commands. We need a separate structure because we * have more than the 4 client data entries we can provide directly thorugh @@ -3179,21 +3269,21 @@ typedef struct ForIterData { Tcl_Obj *cond; /* Loop condition expression. */ Tcl_Obj *body; /* Loop body. */ Tcl_Obj *next; /* Loop step script, NULL for 'while'. */ const char *msg; /* Error message part. */ - Tcl_Size word; /* Index of the body script in the command */ + Tcl_Size word; /* Index of the body script in the command */ } ForIterData; /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile * and Tcl_FindSymbol. This structure corresponds to an opaque * typedef in tcl.h */ typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, const char* symbol); struct Tcl_LoadHandle_ { - void *clientData; /* Client data is the load handle in the + void *clientData; /* Client data is the load handle in the * native filesystem if a module was loaded * there, or an opaque pointer to a structure * for further bookkeeping on load-from-VFS * and load-from-memory */ TclFindSymbolProc* findSymbolProcPtr; @@ -3202,24 +3292,21 @@ Tcl_FSUnloadFileProc* unloadFileProcPtr; /* Procedure that unloads a loaded module */ }; /* Flags for conversion of doubles to digit strings */ - -#define TCL_DD_E_FORMAT 0x2 - /* Use a fixed-length string of digits, +enum TclDoubleFormatFlags { + TCL_DD_E_FORMAT = 0x2, /* Use a fixed-length string of digits, * suitable for E format*/ -#define TCL_DD_F_FORMAT 0x3 - /* Use a fixed number of digits after the + TCL_DD_F_FORMAT = 0x3, /* Use a fixed number of digits after the * decimal point, suitable for F format */ -#define TCL_DD_SHORTEST 0x4 - /* Use the shortest possible string */ -#define TCL_DD_NO_QUICK 0x8 - /* Debug flag: forbid quick FP conversion */ + TCL_DD_SHORTEST = 0x4, /* Use the shortest possible string */ + TCL_DD_NO_QUICK = 0x8, /* Debug flag: forbid quick FP conversion */ -#define TCL_DD_CONVERSION_TYPE_MASK 0x3 + TCL_DD_CONVERSION_TYPE_MASK = 0x3 /* Mask to isolate the conversion type */ +}; /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- @@ -3454,12 +3541,12 @@ 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 int TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr, - int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, - Tcl_Obj *stepObj, Tcl_Obj *lenObj); + int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, + Tcl_Obj *stepObj, Tcl_Obj *lenObj); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, Tcl_Size len); MODULE_SCOPE void TclpAlertNotifier(void *clientData); MODULE_SCOPE void *TclpNotifierData(void); MODULE_SCOPE void TclpServiceModeHook(int mode); @@ -3942,13 +4029,14 @@ Tcl_Size first, Tcl_Size count, Tcl_Obj *insertPtr, int flags); MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags); /* Flag values for the [string] ensemble functions. */ - -#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */ -#define TCL_STRING_IN_PLACE (1<<1) +enum StringEnsembleFlags { + TCL_STRING_MATCH_NOCASE = TCL_MATCH_NOCASE, /* (1<<0) in tcl.h */ + TCL_STRING_IN_PLACE = (1<<1) +}; /* * Functions defined in generic/tclVar.c and currently exported only for use * by the bytecode compiler and engine. Some of these could later be placed in * the public interface. @@ -4013,11 +4101,10 @@ MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); - /* * Just for the purposes of command-type registration. */ MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd; @@ -4076,12 +4163,12 @@ MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count); #endif /* TCL_MAJOR_VERSION > 8 */ /* Constants used in index value encoding routines. */ -#define TCL_INDEX_END ((Tcl_Size)-2) -#define TCL_INDEX_START ((Tcl_Size)0) +#define TCL_INDEX_END ((Tcl_Size)-2) +#define TCL_INDEX_START ((Tcl_Size)0) /* *---------------------------------------------------------------------- * * TclScaleTime -- @@ -4156,24 +4243,24 @@ #else # define TclIncrObjsAllocated() # define TclIncrObjsFreed() #endif /* TCL_COMPILE_STATS */ -# define TclAllocObjStorage(objPtr) \ +# define TclAllocObjStorage(objPtr) \ TclAllocObjStorageEx(NULL, (objPtr)) -# define TclFreeObjStorage(objPtr) \ +# define TclFreeObjStorage(objPtr) \ TclFreeObjStorageEx(NULL, (objPtr)) #ifndef TCL_MEM_DEBUG # define TclNewObj(objPtr) \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = &tclEmptyString; \ - (objPtr)->length = 0; \ - (objPtr)->typePtr = NULL; \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = &tclEmptyString; \ + (objPtr)->length = 0; \ + (objPtr)->typePtr = NULL; \ TCL_DTRACE_OBJ_CREATE(objPtr) /* * 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 @@ -4180,23 +4267,23 @@ * 'length == TCL_INDEX_NONE'. * Use empty 'if ; else' to handle use in unbraced outer if/else conditions. */ # define TclDecrRefCount(objPtr) \ - if ((objPtr)->refCount-- > 1) ; else { \ - if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ - TCL_DTRACE_OBJ_FREE(objPtr); \ - if ((objPtr)->bytes \ - && ((objPtr)->bytes != &tclEmptyString)) { \ - Tcl_Free((objPtr)->bytes); \ - } \ - (objPtr)->length = TCL_INDEX_NONE; \ - TclFreeObjStorage(objPtr); \ - TclIncrObjsFreed(); \ - } else { \ - TclFreeObj(objPtr); \ - } \ + if ((objPtr)->refCount-- > 1) ; else { \ + if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ + TCL_DTRACE_OBJ_FREE(objPtr); \ + if ((objPtr)->bytes \ + && ((objPtr)->bytes != &tclEmptyString)) { \ + Tcl_Free((objPtr)->bytes); \ + } \ + (objPtr)->length = TCL_INDEX_NONE; \ + TclFreeObjStorage(objPtr); \ + TclIncrObjsFreed(); \ + } else { \ + TclFreeObj(objPtr); \ + } \ } #if TCL_THREADS && !defined(USE_THREAD_ALLOC) # define USE_THREAD_ALLOC 1 #endif @@ -4299,24 +4386,24 @@ tclFreeObjList->internalRep.twoPtrValue.ptr1; \ Tcl_MutexUnlock(&tclObjMutex); \ } while (0) # define TclFreeObjStorageEx(interp, objPtr) \ - do { \ - Tcl_MutexLock(&tclObjMutex); \ + do { \ + Tcl_MutexLock(&tclObjMutex); \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \ - tclFreeObjList = (objPtr); \ - Tcl_MutexUnlock(&tclObjMutex); \ + tclFreeObjList = (objPtr); \ + Tcl_MutexUnlock(&tclObjMutex); \ } while (0) #endif #else /* TCL_MEM_DEBUG */ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, int line); # define TclDbNewObj(objPtr, file, line) \ - do { \ + do { \ TclIncrObjsAllocated(); \ (objPtr) = (Tcl_Obj *) \ Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \ TclDbInitNewObj((objPtr), (file), (line)); \ TCL_DTRACE_OBJ_CREATE(objPtr); \ @@ -4356,29 +4443,28 @@ */ #define TclInitEmptyStringRep(objPtr) \ ((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0)) - #define TclInitStringRep(objPtr, bytePtr, len) \ - if ((len) == 0) { \ - TclInitEmptyStringRep(objPtr); \ - } else { \ - (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ + if ((len) == 0) { \ + TclInitEmptyStringRep(objPtr); \ + } else { \ + (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \ - (objPtr)->bytes[len] = '\0'; \ - (objPtr)->length = (len); \ + (objPtr)->bytes[len] = '\0'; \ + (objPtr)->length = (len); \ } #define TclAttemptInitStringRep(objPtr, bytePtr, len) \ - ((((len) == 0) ? ( \ - TclInitEmptyStringRep(objPtr) \ - ) : ( \ - (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ - (objPtr)->length = ((objPtr)->bytes) ? \ + ((((len) == 0) ? ( \ + TclInitEmptyStringRep(objPtr) \ + ) : ( \ + (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ + (objPtr)->length = ((objPtr)->bytes) ? \ (memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)), \ - (objPtr)->bytes[len] = '\0', (len)) : (-1) \ + (objPtr)->bytes[len] = '\0', (len)) : (-1) \ )), (objPtr)->bytes) /* *---------------------------------------------------------------- * Macro used by the Tcl core to get the string representation's byte array @@ -4390,15 +4476,15 @@ * MODULE_SCOPE char * TclGetString(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclGetString(objPtr) \ - ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) + ((objPtr)->bytes ? (objPtr)->bytes : Tcl_GetString(objPtr)) #define TclGetStringFromObj(objPtr, lenPtr) \ - ((objPtr)->bytes \ - ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ + ((objPtr)->bytes \ + ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ : (Tcl_GetStringFromObj)((objPtr), (lenPtr))) /* *---------------------------------------------------------------- * Macro used by the Tcl core to clean out an object's internal @@ -4408,15 +4494,15 @@ * MODULE_SCOPE void TclFreeInternalRep(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclFreeInternalRep(objPtr) \ - if ((objPtr)->typePtr != NULL) { \ - if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ - (objPtr)->typePtr->freeIntRepProc(objPtr); \ - } \ - (objPtr)->typePtr = NULL; \ + if ((objPtr)->typePtr != NULL) { \ + if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ + (objPtr)->typePtr->freeIntRepProc(objPtr); \ + } \ + (objPtr)->typePtr = NULL; \ } /* *---------------------------------------------------------------- * Macro used by the Tcl core to clean out an object's string representation. @@ -4475,12 +4561,12 @@ *---------------------------------------------------------------- */ #define TclUnpackBignum(objPtr, bignum) \ do { \ - Tcl_Obj *bignumObj = (objPtr); \ - int bignumPayload = \ + Tcl_Obj *bignumObj = (objPtr); \ + int bignumPayload = \ PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ if (bignumPayload == -1) { \ (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \ } else { \ (bignum).dp = (mp_digit *)bignumObj->internalRep.twoPtrValue.ptr1; \ @@ -4529,26 +4615,26 @@ Tcl_Token *newPtr; \ if (oldPtr == (staticPtr)) { \ oldPtr = NULL; \ } \ newPtr = (Tcl_Token *)Tcl_AttemptRealloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + allocated * sizeof(Tcl_Token)); \ if (newPtr == NULL) { \ allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH; \ newPtr = (Tcl_Token *)Tcl_Realloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + allocated * sizeof(Tcl_Token)); \ } \ (available) = allocated; \ if (oldPtr == NULL) { \ memcpy(newPtr, staticPtr, \ - (used) * sizeof(Tcl_Token)); \ + (used) * sizeof(Tcl_Token)); \ } \ (tokenPtr) = newPtr; \ } \ } while (0) -#define TclGrowParseTokenArray(parsePtr, append) \ +#define TclGrowParseTokenArray(parsePtr, append) \ TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens, \ (parsePtr)->tokensAvailable, (append), \ (parsePtr)->staticTokens) /* @@ -4562,12 +4648,12 @@ * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ #define TclUtfToUniChar(str, chPtr) \ - (((UCHAR(*(str))) < 0x80) ? \ - ((*(chPtr) = UCHAR(*(str))), 1) \ + (((UCHAR(*(str))) < 0x80) ? \ + ((*(chPtr) = UCHAR(*(str))), 1) \ : Tcl_UtfToUniChar(str, chPtr)) /* *---------------------------------------------------------------- * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed- @@ -4580,19 +4666,19 @@ * numBytes must be >= 0 *---------------------------------------------------------------- */ #define TclNumUtfCharsM(numChars, bytes, numBytes) \ - do { \ - Tcl_Size _count, _i = (numBytes); \ - unsigned char *_str = (unsigned char *) (bytes); \ - while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ - _count = (numBytes) - _i; \ - if (_i) { \ - _count += Tcl_NumUtfChars((bytes) + _count, _i); \ - } \ - (numChars) = _count; \ + do { \ + Tcl_Size _count, _i = (numBytes); \ + unsigned char *_str = (unsigned char *) (bytes); \ + while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ + _count = (numBytes) - _i; \ + if (_i) { \ + _count += Tcl_NumUtfChars((bytes) + _count, _i); \ + } \ + (numChars) = _count; \ } while (0); /* *---------------------------------------------------------------- * Macro that encapsulates the logic that determines when it is safe to @@ -4613,11 +4699,10 @@ (((objPtr)->bytes==NULL) && TclHasInternalRep((objPtr), &tclDictType)) #define TclHasInternalRep(objPtr, type) \ ((objPtr)->typePtr == (type)) #define TclFetchInternalRep(objPtr, type) \ (TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL) - /* *---------------------------------------------------------------- * Macro used by the Tcl core to increment a namespace's export epoch * counter. The ANSI C "prototype" for this macro is: @@ -4659,11 +4744,10 @@ MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init; MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init; MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; - /* *---------------------------------------------------------------- * Macro used by the Tcl core to check whether a pattern has any characters * special to [string match]. The ANSI C "prototype" for this macro is: * @@ -4685,23 +4769,23 @@ * MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d); *---------------------------------------------------------------- */ #define TclSetIntObj(objPtr, i) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.wideValue = (Tcl_WideInt) i; \ - TclInvalidateStringRep(objPtr); \ - Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.wideValue = (Tcl_WideInt) i; \ + TclInvalidateStringRep(objPtr); \ + Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \ } while (0) #define TclSetDoubleObj(objPtr, d) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.doubleValue = (double) d; \ - TclInvalidateStringRep(objPtr); \ - Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir); \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.doubleValue = (double) d; \ + TclInvalidateStringRep(objPtr); \ + Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir); \ } while (0) /* *---------------------------------------------------------------- * Macros used by the Tcl core to create and initialise objects of standard @@ -4716,81 +4800,81 @@ *---------------------------------------------------------------- */ #ifndef TCL_MEM_DEBUG #define TclNewIntObj(objPtr, w) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ - (objPtr)->typePtr = &tclIntType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ + (objPtr)->typePtr = &tclIntType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewUIntObj(objPtr, uw) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + Tcl_WideUInt uw_ = (uw); \ + if (uw_ > WIDE_MAX) { \ + mp_int bignumValue_; \ + if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ Tcl_Panic("%s: memory overflow", "TclNewUIntObj"); \ - } \ - TclSetBignumInternalRep((objPtr), &bignumValue_); \ - } else { \ + } \ + TclSetBignumInternalRep((objPtr), &bignumValue_); \ + } else { \ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \ - (objPtr)->typePtr = &tclIntType; \ - } \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + (objPtr)->typePtr = &tclIntType; \ + } \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewIndexObj(objPtr, w) \ TclNewIntObj(objPtr, w) #define TclNewDoubleObj(objPtr, d) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.doubleValue = (double)(d); \ - (objPtr)->typePtr = &tclDoubleType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.doubleValue = (double)(d); \ + (objPtr)->typePtr = &tclDoubleType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewStringObj(objPtr, s, len) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - TclInitStringRep((objPtr), (s), (len)); \ - (objPtr)->typePtr = NULL; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + TclInitStringRep((objPtr), (s), (len)); \ + (objPtr)->typePtr = NULL; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #else /* TCL_MEM_DEBUG */ #define TclNewIntObj(objPtr, w) \ (objPtr) = Tcl_NewWideIntObj(w) #define TclNewUIntObj(objPtr, uw) \ - do { \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \ - (objPtr) = Tcl_NewBignumObj(&bignumValue_); \ - } else { \ - (objPtr) = NULL; \ - } \ - } else { \ - (objPtr) = Tcl_NewWideIntObj(uw_); \ - } \ + do { \ + Tcl_WideUInt uw_ = (uw); \ + if (uw_ > WIDE_MAX) { \ + mp_int bignumValue_; \ + if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \ + (objPtr) = Tcl_NewBignumObj(&bignumValue_); \ + } else { \ + (objPtr) = NULL; \ + } \ + } else { \ + (objPtr) = Tcl_NewWideIntObj(uw_); \ + } \ } while (0) #define TclNewIndexObj(objPtr, w) \ TclNewIntObj(objPtr, w) @@ -4838,31 +4922,29 @@ *---------------------------------------------------------------- * Inline version of TclCleanupCommand; still need the function as it is in * the internal stubs, but the core can use the macro instead. */ -#define TclCleanupCommandMacro(cmdPtr) \ - do { \ - if ((cmdPtr)->refCount-- <= 1) { \ - Tcl_Free(cmdPtr); \ - } \ +#define TclCleanupCommandMacro(cmdPtr) \ + do { \ + if ((cmdPtr)->refCount-- <= 1) { \ + Tcl_Free(cmdPtr); \ + } \ } while (0) - /* * inside this routine crement refCount first incase cmdPtr is replacing itself */ -#define TclRoutineAssign(location, cmdPtr) \ - do { \ - (cmdPtr)->refCount++; \ - if ((location) != NULL \ - && (location--) <= 1) { \ - Tcl_Free(((location))); \ - } \ - (location) = (cmdPtr); \ +#define TclRoutineAssign(location, cmdPtr) \ + do { \ + (cmdPtr)->refCount++; \ + if ((location) != NULL \ + && (location--) <= 1) { \ + Tcl_Free(((location))); \ + } \ + (location) = (cmdPtr); \ } while (0) - #define TclRoutineHasName(cmdPtr) \ ((cmdPtr)->hPtr != NULL) /* @@ -4874,11 +4956,11 @@ * to the non-inline version. */ #define TclLimitExceeded(limit) ((limit).exceeded != 0) -#define TclLimitReady(limit) \ +#define TclLimitReady(limit) \ (((limit).active == 0) ? 0 : \ (++(limit).granularityTicker, \ ((((limit).active & TCL_LIMIT_COMMANDS) && \ (((limit).cmdGranularity == 1) || \ ((limit).granularityTicker % (limit).cmdGranularity == 0))) \ @@ -5031,13 +5113,13 @@ #include "tclIntDecls.h" #include "tclIntPlatDecls.h" #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) -#define Tcl_AttemptAlloc TclpAlloc -#define Tcl_AttemptRealloc TclpRealloc -#define Tcl_Free TclpFree +#define Tcl_AttemptAlloc TclpAlloc +#define Tcl_AttemptRealloc TclpRealloc +#define Tcl_Free TclpFree #endif /* * Special hack for macOS, where the static linker (technically the 'ar' * command) hates empty object files, and accepts no flags to make it shut up. Index: generic/tclInterp.c ================================================================== --- generic/tclInterp.c +++ generic/tclInterp.c @@ -184,32 +184,31 @@ struct LimitHandler { int flags; /* The state of this particular handler. */ Tcl_LimitHandlerProc *handlerProc; /* The handler callback. */ - void *clientData; /* Opaque argument to the handler callback. */ + void *clientData; /* Opaque argument to the handler callback. */ Tcl_LimitHandlerDeleteProc *deleteProc; /* How to delete the clientData. */ LimitHandler *prevPtr; /* Previous item in linked list of * handlers. */ LimitHandler *nextPtr; /* Next item in linked list of handlers. */ }; /* * Values for the LimitHandler flags field. - * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being - * processed; handlers are never to be reentered. - * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This - * should not normally be observed because when a handler is - * deleted it is also spliced out of the list of handlers, but - * even so we will be careful. */ - -#define LIMIT_HANDLER_ACTIVE 0x01 -#define LIMIT_HANDLER_DELETED 0x02 - - +enum LimitHandlerFlags { + LIMIT_HANDLER_ACTIVE = 1, /* Whether the handler is currently being + * processed; handlers are never to be + * reentered.*/ + LIMIT_HANDLER_DELETED = 2 /* Whether the handler has been deleted. This + * should not normally be observed because + * when a handler is deleted it is also + * spliced out of the list of handlers, but + * even so we will be careful.*/ +}; /* * Prototypes for local static functions: */ @@ -601,23 +600,23 @@ */ int Tcl_InterpObjCmd( void *clientData, - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv); } static int NRInterpCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *childInterp; static const char *const options[] = { "alias", "aliases", "bgerror", "cancel", "children", "create", "debug", "delete", @@ -1196,11 +1195,11 @@ Tcl_CreateAlias( Tcl_Interp *childInterp, /* Interpreter for source command. */ const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - Tcl_Size argc, /* How many additional arguments? */ + Tcl_Size argc, /* How many additional arguments? */ const char *const *argv) /* These are the additional args. */ { Tcl_Obj *childObjPtr, *targetObjPtr; Tcl_Obj **objv; Tcl_Size i; @@ -1251,11 +1250,11 @@ Tcl_CreateAliasObj( Tcl_Interp *childInterp, /* Interpreter for source command. */ const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - Tcl_Size objc, /* How many additional arguments? */ + Tcl_Size objc, /* How many additional arguments? */ Tcl_Obj *const objv[]) /* Argument vector. */ { Tcl_Obj *childObjPtr, *targetObjPtr; int result; @@ -1820,11 +1819,11 @@ *---------------------------------------------------------------------- */ static int AliasNRCmd( - void *clientData, /* Alias record. */ + void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { Alias *aliasPtr = (Alias *)clientData; @@ -1873,11 +1872,11 @@ return Tcl_NREvalObj(interp, listPtr, flags); } int TclAliasObjCmd( - void *clientData, /* Alias record. */ + void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { #define ALIAS_CMDV_PREALLOC 10 @@ -1964,11 +1963,11 @@ #undef ALIAS_CMDV_PREALLOC } int TclLocalAliasObjCmd( - void *clientData, /* Alias record. */ + void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { #define ALIAS_CMDV_PREALLOC 10 @@ -2049,11 +2048,11 @@ *---------------------------------------------------------------------- */ static void AliasObjCmdDeleteProc( - void *clientData) /* The alias record for this alias. */ + void *clientData) /* The alias record for this alias. */ { Alias *aliasPtr = (Alias *)clientData; Target *targetPtr; int i; Tcl_Obj **objv; @@ -2275,11 +2274,11 @@ *---------------------------------------------------------------------- */ int Tcl_GetInterpPath( - Tcl_Interp *interp, /* Interpreter to start search from. */ + Tcl_Interp *interp, /* Interpreter to start search from. */ Tcl_Interp *targetInterp) /* Interpreter to find. */ { InterpInfo *iiPtr; if (targetInterp == interp) { @@ -2550,21 +2549,21 @@ *---------------------------------------------------------------------- */ int TclChildObjCmd( - void *clientData, /* Child interpreter. */ + void *clientData, /* Child interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRChildCmd, clientData, objc, objv); } static int NRChildCmd( - void *clientData, /* Child interpreter. */ + void *clientData, /* Child interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *childInterp = (Tcl_Interp *)clientData; @@ -2764,11 +2763,11 @@ *---------------------------------------------------------------------- */ static void ChildObjCmdDeleteProc( - void *clientData) /* The ChildRecord for the command. */ + void *clientData) /* The ChildRecord for the command. */ { Child *childPtr; /* Interim storage for Child record. */ Tcl_Interp *childInterp = (Tcl_Interp *)clientData; /* And for a child interp. */ @@ -3096,14 +3095,14 @@ static int ChildHidden( Tcl_Interp *interp, /* Interp for data return. */ Tcl_Interp *childInterp) /* Interp whose hidden commands to query. */ { - Tcl_Obj *listObjPtr; /* Local object pointer. */ - Tcl_HashTable *hTblPtr; /* For local searches. */ - Tcl_HashEntry *hPtr; /* For local searches. */ - Tcl_HashSearch hSearch; /* For local searches. */ + Tcl_Obj *listObjPtr; /* Local object pointer. */ + Tcl_HashTable *hTblPtr; /* For local searches. */ + Tcl_HashEntry *hPtr; /* For local searches. */ + Tcl_HashSearch hSearch; /* For local searches. */ TclNewObj(listObjPtr); hTblPtr = ((Interp *) childInterp)->hiddenCmdTablePtr; if (hTblPtr != NULL) { for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); @@ -4666,15 +4665,15 @@ *---------------------------------------------------------------------- */ static int ChildTimeLimitCmd( - Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Interp *childInterp, /* Interpreter being adjusted. */ - int consumedObjc, /* Number of args already parsed. */ - int objc, /* Total number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *childInterp, /* Interpreter being adjusted. */ + int consumedObjc, /* Number of args already parsed. */ + int objc, /* Total number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { "-command", "-granularity", "-milliseconds", "-seconds", NULL }; enum Options { Index: generic/tclLink.c ================================================================== --- generic/tclLink.c +++ generic/tclLink.c @@ -34,11 +34,11 @@ * via upvar. */ void *addr; /* Location of C variable. */ Tcl_Size bytes; /* Size of C variable array. This is 0 when * single variables, and >0 used for array * variables. */ - Tcl_Size numElems; /* Number of elements in C variable array. + Tcl_Size numElems; /* Number of elements in C variable array. * Zero for single variables. */ int type; /* Type of link (TCL_LINK_INT, etc.). */ union { char c; unsigned char uc; @@ -73,25 +73,22 @@ * definitions. */ } Link; /* * Definitions for flag bits: - * LINK_READ_ONLY - 1 means errors should be generated if Tcl - * script attempts to write variable. - * LINK_BEING_UPDATED - 1 means that a call to Tcl_UpdateLinkedVar is - * in progress for this variable, so trace - * callbacks on the variable should be ignored. - * LINK_ALLOC_ADDR - 1 means linkPtr->addr was allocated on the - * heap. - * LINK_ALLOC_LAST - 1 means linkPtr->valueLast.p was allocated on - * the heap. */ - -#define LINK_READ_ONLY 1 -#define LINK_BEING_UPDATED 2 -#define LINK_ALLOC_ADDR 4 -#define LINK_ALLOC_LAST 8 +enum LinkFlags { + LINK_READ_ONLY = 1, /* Errors should be generated if Tcl script + * attempts to write variable.*/ + LINK_BEING_UPDATED = 2, /* A call to Tcl_UpdateLinkedVar is in + * progress for this variable, so trace + * callbacks on the variable should be + * ignored. */ + LINK_ALLOC_ADDR = 4, /* linkPtr->addr was allocated on the heap. */ + LINK_ALLOC_LAST = 8 /* linkPtr->valueLast.p was allocated on the + * heap. */ +}; /* * Forward references to functions defined later in this file: */ @@ -108,15 +105,15 @@ /* * A marker type used to flag weirdnesses so we can pass them around right. */ static Tcl_ObjType invalidRealType = { - "invalidReal", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - NULL, /* updateStringProc */ - NULL, /* setFromAnyProc */ + "invalidReal", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; /* * Convenience macro for accessing the value of the C variable pointed to by a @@ -298,11 +295,11 @@ size = 1; /* This is a variable length string, no need * to check last value. */ /* * If no address is given create one and use as address the - * not needed linkPtr->lastValue + * not needed linkPtr->lastValue */ if (addr == NULL) { linkPtr->lastValue.aryPtr = Tcl_Alloc(linkPtr->bytes); linkPtr->flags |= LINK_ALLOC_LAST; @@ -678,11 +675,11 @@ *---------------------------------------------------------------------- */ static char * LinkTraceProc( - void *clientData, /* Contains information about the link. */ + void *clientData, /* Contains information about the link. */ Tcl_Interp *interp, /* Interpreter containing Tcl variable. */ TCL_UNUSED(const char *) /*name1*/, TCL_UNUSED(const char *) /*name2*/, /* Links can only be made to global variables, * so we can find them with need to resolve @@ -866,11 +863,11 @@ /* * A helper macro. Writing this as a function is messy because of type * variance. */ -#define InRange(lowerLimit, value, upperLimit) \ +#define InRange(lowerLimit, value, upperLimit) \ ((value) >= (lowerLimit) && (value) <= (upperLimit)) /* * If we're working with an array of numbers, extract the Tcl list. */ @@ -889,11 +886,11 @@ int *varPtr = &linkPtr->lastValue.iPtr[i]; if (GetInt(objv[i], varPtr)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have integer values"; + return (char *) "variable array must have integer values"; } } } else { int *varPtr = &linkPtr->lastValue.i; @@ -957,11 +954,11 @@ int *varPtr = &linkPtr->lastValue.iPtr[i]; if (Tcl_GetBooleanFromObj(NULL, objv[i], varPtr) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have boolean value"; + return (char *) "variable array must have boolean value"; } } } else { int *varPtr = &linkPtr->lastValue.i; @@ -976,14 +973,14 @@ case TCL_LINK_CHAR: if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetInt(objv[i], &valueInt) - || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) { + || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have char value"; + return (char *) "variable array must have char value"; } linkPtr->lastValue.cPtr[i] = (char) valueInt; } } else { if (GetInt(valueObj, &valueInt) @@ -998,11 +995,11 @@ case TCL_LINK_UCHAR: if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetInt(objv[i], &valueInt) - || !InRange(0, valueInt, (int)UCHAR_MAX)) { + || !InRange(0, valueInt, (int)UCHAR_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable array must have unsigned char value"; } @@ -1025,11 +1022,11 @@ for (i=0; i < objc; i++) { if (GetInt(objv[i], &valueInt) || !InRange(SHRT_MIN, valueInt, SHRT_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have short value"; + return (char *) "variable array must have short value"; } linkPtr->lastValue.sPtr[i] = (short) valueInt; } } else { if (GetInt(valueObj, &valueInt) @@ -1044,14 +1041,14 @@ case TCL_LINK_USHORT: if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetInt(objv[i], &valueInt) - || !InRange(0, valueInt, (int)USHRT_MAX)) { + || !InRange(0, valueInt, (int)USHRT_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) + return (char *) "variable array must have unsigned short value"; } linkPtr->lastValue.usPtr[i] = (unsigned short) valueInt; } } else { @@ -1071,11 +1068,11 @@ for (i=0; i < objc; i++) { if (GetWide(objv[i], &valueWide) || !InRange(0, valueWide, (Tcl_WideInt)UINT_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) + return (char *) "variable array must have unsigned int value"; } linkPtr->lastValue.uiPtr[i] = (unsigned int) valueWide; } } else { @@ -1093,11 +1090,11 @@ if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetUWide(objv[i], &valueUWide)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) + return (char *) "variable array must have unsigned wide int value"; } linkPtr->lastValue.uwPtr[i] = valueUWide; } } else { @@ -1113,14 +1110,14 @@ case TCL_LINK_FLOAT: if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetDouble(objv[i], &valueDouble) && !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX) - && !IsSpecial(valueDouble)) { + && !IsSpecial(valueDouble)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have float value"; + return (char *) "variable array must have float value"; } linkPtr->lastValue.fPtr[i] = (float) valueDouble; } } else { if (GetDouble(valueObj, &valueDouble) Index: generic/tclListObj.c ================================================================== --- generic/tclListObj.c +++ generic/tclListObj.c @@ -44,20 +44,20 @@ * LIST_INDEX_ASSERT is to catch errors with negative indices and counts * being passed AFTER validation. On Tcl9 length types are unsigned hence * the checks against LIST_MAX. On Tcl8 length types are signed hence the * also checks against 0. */ -#define LIST_INDEX_ASSERT(idxarg_) \ - do { \ - Tcl_Size idx_ = (idxarg_); /* To guard against ++ etc. */ \ - LIST_ASSERT(idx_ >= 0 && idx_ < LIST_MAX); \ +#define LIST_INDEX_ASSERT(idxarg_) \ + do { \ + Tcl_Size idx_ = (idxarg_); /* To guard against ++ etc. */ \ + LIST_ASSERT(idx_ >= 0 && idx_ < LIST_MAX); \ } while (0) /* Ditto for counts except upper limit is different */ -#define LIST_COUNT_ASSERT(countarg_) \ - do { \ - Tcl_Size count_ = (countarg_); /* To guard against ++ etc. */ \ - LIST_ASSERT(count_ >= 0 && count_ <= LIST_MAX); \ +#define LIST_COUNT_ASSERT(countarg_) \ + do { \ + Tcl_Size count_ = (countarg_); /* To guard against ++ etc. */ \ + LIST_ASSERT(count_ >= 0 && count_ <= LIST_MAX); \ } while (0) #else #define LIST_ASSERT(cond_) ((void) 0) @@ -76,11 +76,12 @@ * inconsistencies. This has a non-trivial cost so has to be separately * enabled and not part of assertions checking. However, the test suite does * invoke ListRepValidate directly even without ENABLE_LIST_INVARIANTS. */ #ifdef ENABLE_LIST_INVARIANTS -#define LISTREP_CHECK(listRepPtr_) ListRepValidate(listRepPtr_, __FILE__, __LINE__) +#define LISTREP_CHECK(listRepPtr_) \ + ListRepValidate(listRepPtr_, __FILE__, __LINE__) #else #define LISTREP_CHECK(listRepPtr_) (void) 0 #endif /* @@ -103,47 +104,49 @@ * - If both flags are present (LISTREP_SPACE_FAVOR_NONE), the extra space * is equally apportioned. * - Finally if LISTREP_SPACE_ONLY_BACK is present, ALL extra space is at * the back. */ -#define LISTREP_PANIC_ON_FAIL 0x00000001 -#define LISTREP_SPACE_FAVOR_FRONT 0x00000002 -#define LISTREP_SPACE_FAVOR_BACK 0x00000004 -#define LISTREP_SPACE_ONLY_BACK 0x00000008 -#define LISTREP_SPACE_FAVOR_NONE \ - (LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK) -#define LISTREP_SPACE_FLAGS \ - (LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK \ - | LISTREP_SPACE_ONLY_BACK) +enum ListRepFlags { + LISTREP_PANIC_ON_FAIL = 1, + LISTREP_SPACE_FAVOR_FRONT = 2, + LISTREP_SPACE_FAVOR_BACK = 4, + LISTREP_SPACE_ONLY_BACK = 8, + LISTREP_SPACE_FAVOR_NONE = ( + LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK), + LISTREP_SPACE_FLAGS = ( + LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK + | LISTREP_SPACE_ONLY_BACK) +}; /* * Prototypes for non-inline static functions defined later in this file: */ -static int MemoryAllocationError(Tcl_Interp *, size_t size); -static int ListLimitExceededError(Tcl_Interp *); -static ListStore *ListStoreNew(Tcl_Size objc, Tcl_Obj *const objv[], int flags); -static int ListRepInit(Tcl_Size objc, Tcl_Obj *const objv[], int flags, ListRep *); -static int ListRepInitAttempt(Tcl_Interp *, - Tcl_Size objc, - Tcl_Obj *const objv[], - ListRep *); -static void ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, int flags); -static void ListRepUnsharedFreeUnreferenced(const ListRep *repPtr); -static int TclListObjGetRep(Tcl_Interp *, Tcl_Obj *listPtr, ListRep *repPtr); -static void ListRepRange(ListRep *srcRepPtr, - Tcl_Size rangeStart, - Tcl_Size rangeEnd, - int preserveSrcRep, - ListRep *rangeRepPtr); -static ListStore *ListStoreReallocate(ListStore *storePtr, Tcl_Size numSlots); -static void ListRepValidate(const ListRep *repPtr, const char *file, - int lineNum); -static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void FreeListInternalRep(Tcl_Obj *listPtr); -static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static void UpdateStringOfList(Tcl_Obj *listPtr); -static Tcl_Size ListLength(Tcl_Obj *listPtr); +static int MemoryAllocationError(Tcl_Interp *, size_t size); +static int ListLimitExceededError(Tcl_Interp *); +static ListStore * ListStoreNew(Tcl_Size objc, Tcl_Obj *const objv[], + int flags); +static int ListRepInit(Tcl_Size objc, Tcl_Obj *const objv[], + int flags, ListRep *); +static int ListRepInitAttempt(Tcl_Interp *, Tcl_Size objc, + Tcl_Obj *const objv[], ListRep *); +static void ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, + int flags); +static void ListRepUnsharedFreeUnreferenced(const ListRep *repPtr); +static int TclListObjGetRep(Tcl_Interp *, Tcl_Obj *listPtr, + ListRep *repPtr); +static void ListRepRange(ListRep *srcRepPtr, + Tcl_Size rangeStart, Tcl_Size rangeEnd, + int preserveSrcRep, ListRep *rangeRepPtr); +static ListStore * ListStoreReallocate(ListStore *storePtr, Tcl_Size numSlots); +static void ListRepValidate(const ListRep *repPtr, const char *file, + int lineNum); +static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void FreeListInternalRep(Tcl_Obj *listPtr); +static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void UpdateStringOfList(Tcl_Obj *listPtr); +static Tcl_Size ListLength(Tcl_Obj *listPtr); /* * The structure below defines the list Tcl object type by means of functions * that can be invoked by generic object code. * @@ -168,15 +171,16 @@ } \ } while (0) /* Returns number of free unused slots at the back of the ListRep's ListStore */ #define ListRepNumFreeTail(repPtr_) \ - ((repPtr_)->storePtr->numAllocated \ + ((repPtr_)->storePtr->numAllocated \ - ((repPtr_)->storePtr->firstUsed + (repPtr_)->storePtr->numUsed)) /* Returns number of free unused slots at the front of the ListRep's ListStore */ -#define ListRepNumFreeHead(repPtr_) ((repPtr_)->storePtr->firstUsed) +#define ListRepNumFreeHead(repPtr_) \ + ((repPtr_)->storePtr->firstUsed) /* Returns a pointer to the slot corresponding to list index listIdx_ */ #define ListRepSlotPtr(repPtr_, listIdx_) \ (&(repPtr_)->storePtr->slots[ListRepStart(repPtr_) + (listIdx_)]) @@ -197,30 +201,30 @@ * ListObjReplaceRepAndInvalidate - Like ListObjOverwriteRep but additionally * assumes the Tcl_Obj internal rep is valid (and possibly even same as * passed ListRep) and frees it first. Additionally invalidates the string * representation. Generally used when modifying a Tcl_Obj value. */ -#define ListObjStompRep(objPtr_, repPtr_) \ - do { \ - (objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \ - (objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr; \ - (objPtr_)->typePtr = &tclListType; \ +#define ListObjStompRep(objPtr_, repPtr_) \ + do { \ + (objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \ + (objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr; \ + (objPtr_)->typePtr = &tclListType; \ } while (0) #define ListObjOverwriteRep(objPtr_, repPtr_) \ - do { \ - ListRepIncrRefs(repPtr_); \ - ListObjStompRep(objPtr_, repPtr_); \ + do { \ + ListRepIncrRefs(repPtr_); \ + ListObjStompRep(objPtr_, repPtr_); \ } while (0) -#define ListObjReplaceRepAndInvalidate(objPtr_, repPtr_) \ - do { \ - /* Note order important, don't use ListObjOverwriteRep! */ \ - ListRepIncrRefs(repPtr_); \ - TclFreeInternalRep(objPtr_); \ - TclInvalidateStringRep(objPtr_); \ - ListObjStompRep(objPtr_, repPtr_); \ +#define ListObjReplaceRepAndInvalidate(objPtr_, repPtr_) \ + do { \ + /* Note order important, don't use ListObjOverwriteRep! */ \ + ListRepIncrRefs(repPtr_); \ + TclFreeInternalRep(objPtr_); \ + TclInvalidateStringRep(objPtr_); \ + ListObjStompRep(objPtr_, repPtr_); \ } while (0) /* *------------------------------------------------------------------------ * @@ -237,12 +241,12 @@ * *------------------------------------------------------------------------ */ static inline ListSpan * ListSpanNew( - Tcl_Size firstSlot, /* Starting slot index of the span */ - Tcl_Size numSlots) /* Number of slots covered by the span */ + Tcl_Size firstSlot, /* Starting slot index of the span */ + Tcl_Size numSlots) /* Number of slots covered by the span */ { ListSpan *spanPtr = (ListSpan *) Tcl_Alloc(sizeof(*spanPtr)); spanPtr->refCount = 0; spanPtr->spanStart = firstSlot; spanPtr->spanLength = numSlots; @@ -264,11 +268,12 @@ * The memory may be freed. * *------------------------------------------------------------------------ */ static inline void -ListSpanDecrRefs(ListSpan *spanPtr) +ListSpanDecrRefs( + ListSpan *spanPtr) { if (spanPtr->refCount <= 1) { Tcl_Free(spanPtr); } else { spanPtr->refCount -= 1; @@ -295,13 +300,14 @@ * *------------------------------------------------------------------------ */ static inline int ListSpanMerited( - Tcl_Size length, /* Length of the proposed span */ - Tcl_Size usedStorageLength, /* Number of slots currently in used */ - Tcl_Size allocatedStorageLength) /* Length of the currently allocation */ + Tcl_Size length, /* Length of the proposed span */ + Tcl_Size usedStorageLength, /* Number of slots currently in used */ + Tcl_Size allocatedStorageLength) + /* Length of the currently allocation */ { /* * Possible optimizations for future consideration * - heuristic LIST_SPAN_THRESHOLD * - currently, information about the sharing (ref count) of existing @@ -341,11 +347,12 @@ * See comments for ListRepUnsharedFreeUnreferenced. * *------------------------------------------------------------------------ */ static inline void -ListRepFreeUnreferenced(const ListRep *repPtr) +ListRepFreeUnreferenced( + const ListRep *repPtr) { if (! ListRepIsShared(repPtr) && repPtr->spanPtr) { /* T:listrep-1.5.1 */ ListRepUnsharedFreeUnreferenced(repPtr); } @@ -366,13 +373,13 @@ * *------------------------------------------------------------------------ */ static inline void ObjArrayIncrRefs( - Tcl_Obj * const *objv, /* Pointer to the array */ - Tcl_Size startIdx, /* Starting index of subarray within objv */ - Tcl_Size count) /* Number of elements in the subarray */ + Tcl_Obj *const *objv, /* Pointer to the array */ + Tcl_Size startIdx, /* Starting index of subarray within objv */ + Tcl_Size count) /* Number of elements in the subarray */ { Tcl_Obj *const *end; LIST_INDEX_ASSERT(startIdx); LIST_COUNT_ASSERT(count); objv += startIdx; @@ -398,13 +405,13 @@ * *------------------------------------------------------------------------ */ static inline void ObjArrayDecrRefs( - Tcl_Obj * const *objv, /* Pointer to the array */ - Tcl_Size startIdx, /* Starting index of subarray within objv */ - Tcl_Size count) /* Number of elements in the subarray */ + Tcl_Obj *const *objv, /* Pointer to the array */ + Tcl_Size startIdx, /* Starting index of subarray within objv */ + Tcl_Size count) /* Number of elements in the subarray */ { Tcl_Obj * const *end; LIST_INDEX_ASSERT(startIdx); LIST_COUNT_ASSERT(count); objv += startIdx; @@ -430,13 +437,13 @@ * *------------------------------------------------------------------------ */ static inline void ObjArrayCopy( - Tcl_Obj **to, /* Destination */ - Tcl_Size count, /* Number of pointers to copy */ - Tcl_Obj *const from[]) /* Source array of Tcl_Obj* */ + Tcl_Obj **to, /* Destination */ + Tcl_Size count, /* Number of pointers to copy */ + Tcl_Obj *const from[]) /* Source array of Tcl_Obj* */ { Tcl_Obj **end; LIST_COUNT_ASSERT(count); end = to + count; /* TODO - would memmove followed by separate IncrRef loop be faster? */ @@ -461,12 +468,12 @@ * *------------------------------------------------------------------------ */ static int MemoryAllocationError( - Tcl_Interp *interp, /* Interpreter for error message. May be NULL */ - size_t size) /* Size of attempted allocation that failed */ + Tcl_Interp *interp, /* Interpreter for error message. May be NULL */ + size_t size) /* Size of attempted allocation that failed */ { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "list construction failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", @@ -490,16 +497,16 @@ * Error message and code are stored in the interpreter if not NULL. * *------------------------------------------------------------------------ */ static int -ListLimitExceededError(Tcl_Interp *interp) +ListLimitExceededError( + Tcl_Interp *interp) { if (interp != NULL) { - Tcl_SetObjResult( - interp, - Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); } return TCL_ERROR; } @@ -521,11 +528,13 @@ * storage area. The ListRep's ListSpan is updated accordingly. * *------------------------------------------------------------------------ */ static inline void -ListRepUnsharedShiftDown(ListRep *repPtr, Tcl_Size shiftCount) +ListRepUnsharedShiftDown( + ListRep *repPtr, + Tcl_Size shiftCount) { ListStore *storePtr; LISTREP_CHECK(repPtr); LIST_ASSERT(!ListRepIsShared(repPtr)); @@ -553,11 +562,11 @@ LIST_ASSERT(shiftCount == 0); } LISTREP_CHECK(repPtr); } - + /* *------------------------------------------------------------------------ * * ListRepUnsharedShiftUp -- * @@ -576,11 +585,13 @@ * *------------------------------------------------------------------------ */ #if 0 static inline void -ListRepUnsharedShiftUp(ListRep *repPtr, Tcl_Size shiftCount) +ListRepUnsharedShiftUp( + ListRep *repPtr, + Tcl_Size shiftCount) { ListStore *storePtr; LISTREP_CHECK(repPtr); LIST_ASSERT(!ListRepIsShared(repPtr)); @@ -622,23 +633,26 @@ * Panics if any invariant is not met. * *------------------------------------------------------------------------ */ static void -ListRepValidate(const ListRep *repPtr, const char *file, int lineNum) +ListRepValidate( + const ListRep *repPtr, + const char *file, + int lineNum) { ListStore *storePtr = repPtr->storePtr; const char *condition; (void)storePtr; /* To stop gcc from whining about unused vars */ -#define INVARIANT(cond_) \ - do { \ - if (!(cond_)) { \ - condition = #cond_; \ - goto failure; \ - } \ +#define INVARIANT(cond_) \ + do { \ + if (!(cond_)) { \ + condition = #cond_; \ + goto failure; \ + } \ } while (0) /* Separate each condition so line number gives exact reason for failure */ INVARIANT(storePtr != NULL); INVARIANT(storePtr->numAllocated >= 0); @@ -660,18 +674,15 @@ INVARIANT(ListRepStart(repPtr) >= storePtr->firstUsed); INVARIANT(ListRepLength(repPtr) <= storePtr->numUsed); INVARIANT(ListRepStart(repPtr) <= (storePtr->firstUsed + storePtr->numUsed - ListRepLength(repPtr))); #undef INVARIANT - return; failure: Tcl_Panic("List internal failure in %s line %d. Condition: %s", - file, - lineNum, - condition); + file, lineNum, condition); } /* *------------------------------------------------------------------------ * @@ -687,11 +698,13 @@ * cannot be converted to a list object. * *------------------------------------------------------------------------ */ void -TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj) +TclListObjValidate( + Tcl_Interp *interp, + Tcl_Obj *listObj) { ListRep listRep; if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { Tcl_Panic("Object passed to TclListObjValidate cannot be converted to " "a list object."); @@ -745,12 +758,12 @@ } storePtr = NULL; if (flags & LISTREP_SPACE_FLAGS) { /* Caller requests extra space front, back or both */ - storePtr = (ListStore *)TclAttemptAllocElemsEx( - objc, sizeof(Tcl_Obj *), offsetof(ListStore, slots), &capacity); + storePtr = (ListStore *) TclAttemptAllocElemsEx( + objc, sizeof(Tcl_Obj *), offsetof(ListStore, slots), &capacity); } else { /* Exact allocation */ capacity = objc; storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity)); } @@ -769,10 +782,11 @@ if (capacity == objc) { storePtr->firstUsed = 0; } else { Tcl_Size extra = capacity - objc; int spaceFlags = flags & LISTREP_SPACE_FLAGS; + if (spaceFlags == LISTREP_SPACE_ONLY_BACK) { storePtr->firstUsed = 0; } else if (spaceFlags == LISTREP_SPACE_FAVOR_FRONT) { /* Leave more space in the front */ storePtr->firstUsed = @@ -871,13 +885,12 @@ Tcl_Size objc, Tcl_Obj *const objv[], int flags, ListRep *repPtr) { - ListStore *storePtr; + ListStore *storePtr = ListStoreNew(objc, objv, flags); - storePtr = ListStoreNew(objc, objv, flags); if (storePtr) { repPtr->storePtr = storePtr; if (storePtr->firstUsed == 0) { repPtr->spanPtr = NULL; } else { @@ -1026,12 +1039,12 @@ count = (storePtr->firstUsed + storePtr->numUsed) - (spanPtr->spanStart + spanPtr->spanLength); LIST_COUNT_ASSERT(count); if (count > 0) { /* T:listrep-6.{1:8} */ - ObjArrayDecrRefs( - storePtr->slots, spanPtr->spanStart + spanPtr->spanLength, count); + ObjArrayDecrRefs(storePtr->slots, + spanPtr->spanStart + spanPtr->spanLength, count); LIST_ASSERT(storePtr->numUsed >= count); storePtr->numUsed -= count; } LIST_ASSERT(ListRepStart(repPtr) == storePtr->firstUsed); @@ -1245,14 +1258,14 @@ *---------------------------------------------------------------------- */ static int TclListObjGetRep( - Tcl_Interp *interp, /* Used to report errors if not NULL. */ - Tcl_Obj *listObj, /* List object for which an element array is - * to be returned. */ - ListRep *repPtr) /* Location to store descriptor */ + Tcl_Interp *interp, /* Used to report errors if not NULL. */ + Tcl_Obj *listObj, /* List object for which an element array is + * to be returned. */ + ListRep *repPtr) /* Location to store descriptor */ { if (!TclHasInternalRep(listObj, &tclListType)) { int result; result = SetListFromAny(interp, listObj); if (result != TCL_OK) { @@ -1555,11 +1568,11 @@ *---------------------------------------------------------------------- * * TclListObjRange -- * * Makes a slice of a list value. - * *listObj must be known to be a valid list. + * *listObj must be known to be a valid list. * * Results: * Returns a pointer to the sliced list. * This may be a new object or the same object if not shared. * Returns NULL if passed listObj was not a list and could not be @@ -1614,12 +1627,11 @@ Tcl_Obj * TclListObjGetElement( Tcl_Obj *objPtr, /* List object for which an element array is * to be returned. */ - Tcl_Size index -) + Tcl_Size index) { return ListObjStorePtr(objPtr)->slots[ListObjStart(objPtr) + index]; } /* @@ -1822,13 +1834,12 @@ if (shiftCount) { /* T:listrep-3.5 */ ListRepUnsharedShiftDown(&listRep, shiftCount); } } /* else T:listrep-3.{4,6} */ - ObjArrayCopy( - &listRep.storePtr->slots[ - ListRepStart(&listRep) + ListRepLength(&listRep)], + ObjArrayCopy(&listRep.storePtr->slots[ + ListRepStart(&listRep) + ListRepLength(&listRep)], elemCount, elemObjv); listRep.storePtr->numUsed = finalLen; if (listRep.spanPtr) { /* T:listrep-3.{4,5,6} */ LIST_ASSERT(listRep.spanPtr->spanStart @@ -1999,13 +2010,13 @@ */ #undef Tcl_ListObjLength int Tcl_ListObjLength( - Tcl_Interp *interp, /* Used to report errors if not NULL. */ - Tcl_Obj *listObj, /* List object whose #elements to return. */ - Tcl_Size *lenPtr) /* The resulting length is stored here. */ + Tcl_Interp *interp, /* Used to report errors if not NULL. */ + Tcl_Obj *listObj, /* List object whose #elements to return. */ + Tcl_Size *lenPtr) /* The resulting length is stored here. */ { ListRep listRep; /* Empty string => empty list. Avoid unnecessary shimmering */ if (listObj->bytes == &tclEmptyString) { @@ -2015,11 +2026,10 @@ if (TclObjTypeHasProc(listObj, lengthProc)) { *lenPtr = TclObjTypeLength(listObj); return TCL_OK; } - if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { return TCL_ERROR; } *lenPtr = ListRepLength(&listRep); @@ -2254,18 +2264,19 @@ * free space. */ if (numFreeSlots < lenChange && !ListRepIsShared(&listRep)) { /* T:listrep-1.{1,3,14,18,21},3.{3,10,11,14,27,32,41} */ ListStore *newStorePtr = - ListStoreReallocate(listRep.storePtr, origListLen + lenChange); + ListStoreReallocate(listRep.storePtr, origListLen + lenChange); if (newStorePtr == NULL) { return MemoryAllocationError(interp, LIST_SIZE(origListLen + lenChange)); } listRep.storePtr = newStorePtr; numFreeSlots = - listRep.storePtr->numAllocated - listRep.storePtr->numUsed; + listRep.storePtr->numAllocated - listRep.storePtr->numUsed; + /* * WARNING: at this point the Tcl_Obj internal rep potentially * points to freed storage if the reallocation returned a * different location. Overwrite it to bring it back in sync. */ @@ -2767,14 +2778,14 @@ Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listObj, /* Pointer to the list being modified. */ Tcl_Obj *indexArgObj, /* Index or index-list arg to 'lset'. */ Tcl_Obj *valueObj) /* Value arg to 'lset' or NULL to 'lpop'. */ { - Tcl_Size indexCount = 0; /* Number of indices in the index list. */ + Tcl_Size indexCount = 0; /* Number of indices in the index list. */ Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */ Tcl_Obj *retValueObj; /* Pointer to the list to be returned. */ - Tcl_Size index; /* Current index in the list - discarded. */ + Tcl_Size index; /* Current index in the list - discarded. */ Tcl_Obj *indexListCopy; /* * Determine whether the index arg designates a list or a single index. * We have to be careful about the order of the checks to avoid repeated @@ -2794,13 +2805,11 @@ } else { /* indexArgPtr designates a single index. */ /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */ retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj); } - } else { - indexListCopy = TclListObjCopy(NULL,indexArgObj); if (!indexListCopy) { /* * indexArgPtr designates something that is neither an index nor a * well formed list. Report the error via TclLsetFlat. @@ -2814,11 +2823,10 @@ * indexArgPtr designates something that is neither an index nor a * well formed list. Report the error via TclLsetFlat. */ retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj); } else { - /* * Let TclLsetFlat perform the actual lset operation. */ retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj); @@ -2871,12 +2879,11 @@ Tcl_Obj * TclLsetFlat( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listObj, /* Pointer to the list being modified. */ Tcl_Size indexCount, /* Number of index args. */ - Tcl_Obj *const indexArray[], - /* Index args. */ + Tcl_Obj *const indexArray[],/* Index args. */ Tcl_Obj *valueObj) /* Value arg to 'lset' or NULL to 'lpop'. */ { Tcl_Size index, len; int result; Tcl_Obj *subListObj, *retValueObj; @@ -2919,12 +2926,12 @@ result = TCL_OK; /* Allocate if static array for pending invalidations is too small */ if (indexCount > (int) (sizeof(pendingInvalidates) / sizeof(pendingInvalidates[0]))) { - pendingInvalidatesPtr = - (Tcl_Obj **) Tcl_Alloc(indexCount * sizeof(*pendingInvalidatesPtr)); + pendingInvalidatesPtr = (Tcl_Obj **) + Tcl_Alloc(indexCount * sizeof(*pendingInvalidatesPtr)); } /* * Loop through all the index arguments, and for each one dive into the * appropriate sublist. @@ -2957,25 +2964,25 @@ indexArray++; /* Why bother with this increment? TBD */ break; } indexArray++; - /* - * Special case 0-length lists. The Tcl indexing function treat - * will return any value beyond length as TCL_SIZE_MAX for this - * case. - */ + /* + * Special case 0-length lists. The Tcl indexing function treat + * will return any value beyond length as TCL_SIZE_MAX for this + * case. + */ if ((index == TCL_SIZE_MAX) && (elemCount == 0)) { index = 0; } if (index < 0 || index > elemCount || (valueObj == NULL && index >= elemCount)) { /* ...the index points outside the sublist. */ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "index \"%s\" out of range", - Tcl_GetString(indexArray[-1]))); + Tcl_GetString(indexArray[-1]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", (void *)NULL); } result = TCL_ERROR; break; @@ -3143,11 +3150,11 @@ Tcl_Size index, /* Index of element to store. */ Tcl_Obj *valueObj) /* Tcl object to store in the designated list * element. */ { ListRep listRep; - Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */ + Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */ Tcl_Size elemCount; /* Number of elements in the list. */ /* Ensure that the listObj parameter designates an unshared list. */ if (Tcl_IsShared(listObj)) { @@ -3226,13 +3233,12 @@ { ListRep listRep; ListObjGetRep(listObj, &listRep); if (listRep.storePtr->refCount-- <= 1) { - ObjArrayDecrRefs( - listRep.storePtr->slots, - listRep.storePtr->firstUsed, listRep.storePtr->numUsed); + ObjArrayDecrRefs(listRep.storePtr->slots, + listRep.storePtr->firstUsed, listRep.storePtr->numUsed); Tcl_Free(listRep.storePtr); } if (listRep.spanPtr) { ListSpanDecrRefs(listRep.spanPtr); } @@ -3360,11 +3366,10 @@ } LIST_ASSERT((Tcl_Size)(elemPtrs - listRep.storePtr->slots) == elemCount); listRep.storePtr->numUsed = elemCount; - } else { Tcl_Size estCount, length; const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length); /* @@ -3420,12 +3425,11 @@ } Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */ } - listRep.storePtr->numUsed = - elemPtrs - listRep.storePtr->slots; + listRep.storePtr->numUsed = elemPtrs - listRep.storePtr->slots; } LISTREP_CHECK(&listRep); /* @@ -3605,13 +3609,13 @@ listRep.spanPtr = ListSpanNew(leadingSpace, length); } ListObjReplaceRepAndInvalidate(listObj, &listRep); return listObj; } - + /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclLiteral.c ================================================================== --- generic/tclLiteral.c +++ generic/tclLiteral.c @@ -56,12 +56,11 @@ *---------------------------------------------------------------------- */ void TclInitLiteralTable( - LiteralTable *tablePtr) - /* Pointer to table structure, which is + LiteralTable *tablePtr) /* Pointer to table structure, which is * supplied by the caller. */ { #if (TCL_SMALL_HASH_TABLE != 4) Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable", TCL_SMALL_HASH_TABLE); @@ -174,15 +173,15 @@ */ Tcl_Obj * TclCreateLiteral( Interp *iPtr, - const char *bytes, /* The start of the string. Note that this is + const char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ - Tcl_Size length, /* Number of bytes in the string. */ - size_t hash, /* The string's hash. If the value is - * TCL_INDEX_NONE, it will be computed here. */ + Tcl_Size length, /* Number of bytes in the string. */ + size_t hash, /* The string's hash. If the value is + * TCL_INDEX_NONE, it will be computed here. */ int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr) { @@ -276,11 +275,11 @@ Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be", "TclRegisterLiteral", (length>60? 60 : (int)length), bytes); } #endif - globalPtr = (LiteralEntry *)Tcl_Alloc(sizeof(LiteralEntry)); + globalPtr = (LiteralEntry *) Tcl_Alloc(sizeof(LiteralEntry)); globalPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); globalPtr->refCount = 1; globalPtr->nsPtr = nsPtr; globalPtr->nextPtr = globalTablePtr->buckets[globalHash]; @@ -387,16 +386,16 @@ *---------------------------------------------------------------------- */ int /* Do NOT change this type. Should not be wider than TclEmitPush operand*/ TclRegisterLiteral( - void *ePtr, /* Points to the CompileEnv in whose object + void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ - const char *bytes, /* Points to string for which to find or + const char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ - Tcl_Size length, /* Number of bytes in the string. If -1, the + Tcl_Size 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 * malloc'd bytes and ownership is passed to * this function. If LITERAL_CMD_NAME then @@ -478,11 +477,11 @@ } TclVerifyLocalLiteralTable(envPtr); #endif /*TCL_COMPILE_DEBUG*/ if (objIndex > INT_MAX) { Tcl_Panic( - "Literal table index too large. Cannot be handled by TclEmitPush"); + "Literal table index too large. Cannot be handled by TclEmitPush"); } return objIndex; } #ifdef TCL_COMPILE_DEBUG @@ -505,11 +504,11 @@ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal + Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal * that was previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; @@ -551,11 +550,11 @@ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - CompileEnv *envPtr,/* Points to CompileEnv whose literal array + CompileEnv *envPtr, /* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; @@ -615,11 +614,11 @@ *---------------------------------------------------------------------- */ int TclAddLiteralObj( - CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + CompileEnv *envPtr, /* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The object to insert into the array. */ LiteralEntry **litPtrPtr) /* The location where the pointer to the new * literal entry should be stored. May be * NULL. */ @@ -632,11 +631,11 @@ } objIndex = envPtr->literalArrayNext; envPtr->literalArrayNext++; if (objIndex > INT_MAX) { Tcl_Panic( - "Literal table index too large. Cannot be handled by TclEmitPush"); + "Literal table index too large. Cannot be handled by TclEmitPush"); } lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); @@ -668,11 +667,11 @@ *---------------------------------------------------------------------- */ static size_t AddLocalLiteralEntry( - CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + CompileEnv *envPtr, /* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ int localHash) /* Hash value for the literal's string. */ { LiteralTable *localTablePtr = &envPtr->localLitTable; @@ -746,11 +745,11 @@ *---------------------------------------------------------------------- */ static void ExpandLocalLiteralArray( - CompileEnv *envPtr)/* Points to the CompileEnv whose object array + CompileEnv *envPtr) /* Points to the CompileEnv whose object array * must be enlarged. */ { /* * The current allocated local literal entries are stored between elements * 0 and (envPtr->literalArrayNext - 1) [inclusive]. @@ -828,11 +827,11 @@ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - Tcl_Obj *objPtr) /* Points to a literal object that was + Tcl_Obj *objPtr) /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr; @@ -908,12 +907,12 @@ *---------------------------------------------------------------------- */ static size_t HashString( - const char *string, /* String for which to compute hash value. */ - size_t length) /* Number of bytes in the string. */ + const char *string, /* String for which to compute hash value. */ + size_t length) /* Number of bytes in the string. */ { size_t result = 0; /* * I tried a zillion different hash functions and asked many other people @@ -972,12 +971,11 @@ *---------------------------------------------------------------------- */ static void RebuildLiteralTable( - LiteralTable *tablePtr) - /* Local or global table to enlarge. */ + LiteralTable *tablePtr) /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; LiteralEntry **oldChainPtr, **newChainPtr; LiteralEntry *entryPtr; LiteralEntry **bucketPtr; Index: generic/tclLoad.c ================================================================== --- generic/tclLoad.c +++ generic/tclLoad.c @@ -10,11 +10,10 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" - /* * The following structure describes a library that has been loaded either * dynamically (with the "load" command) or statically (as indicated by a call * to Tcl_StaticLibrary). All such libraries are linked together into a * single list for the process. @@ -372,11 +371,10 @@ * lower-case. */ Tcl_DStringSetLength(&pfx, Tcl_UtfToTitle(Tcl_DStringValue(&pfx))); - } /* * Compute the names of the two initialization functions, based on the * prefix. @@ -771,17 +769,16 @@ * *---------------------------------------------------------------------- */ static int UnloadLibrary( - Tcl_Interp *interp, - Tcl_Interp *target, - LoadedLibrary *libraryPtr, - int keepLibrary, - const char *fullFileName, - int interpExiting -) + Tcl_Interp *interp, + Tcl_Interp *target, + LoadedLibrary *libraryPtr, + int keepLibrary, + const char *fullFileName, + int interpExiting) { int code; InterpLibrary *ipFirstPtr, *ipPtr; LoadedLibrary *iterLibraryPtr; int trustedRefCount = -1, safeRefCount = -1; @@ -819,12 +816,10 @@ } } unloadProc = libraryPtr->unloadProc; } - - /* * We are ready to unload the library. First, evaluate the unload * function. If this fails, we cannot proceed with unload. Also, we must * specify the proper flag to pass to the unload callback. * TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback should @@ -854,16 +849,14 @@ } } code = unloadProc(target, code); } - if (code != TCL_OK) { Tcl_TransferResult(target, code, interp); goto done; } - /* * Remove this library from the interpreter's library cache. */ @@ -882,11 +875,10 @@ } } } Tcl_Free(ipPtr); Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); - if (IsStatic(libraryPtr)) { goto done; } @@ -1041,21 +1033,20 @@ libraryPtr->fileName[0] = 0; libraryPtr->prefix = (char *)Tcl_Alloc(strlen(prefix) + 1); strcpy(libraryPtr->prefix, prefix); libraryPtr->loadHandle = NULL; libraryPtr->initProc = initProc; - libraryPtr->safeInitProc = safeInitProc; - libraryPtr->unloadProc = NULL; + libraryPtr->safeInitProc= safeInitProc; + libraryPtr->unloadProc = NULL; libraryPtr->safeUnloadProc = NULL; Tcl_MutexLock(&libraryMutex); - libraryPtr->nextPtr = firstLibraryPtr; + libraryPtr->nextPtr = firstLibraryPtr; firstLibraryPtr = libraryPtr; Tcl_MutexUnlock(&libraryMutex); } if (interp != NULL) { - /* * If we're loading the library into an interpreter, determine whether * it's already loaded. */ @@ -1105,13 +1096,12 @@ * or error message. */ const char *targetName, /* Name of target interpreter or NULL. If * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ - const char *prefix) /* Prefix or NULL. If NULL, return info - * for all prefixes. - */ + const char *prefix) /* Prefix or NULL. If NULL, return info + * for all prefixes. */ { Tcl_Interp *target; LoadedLibrary *libraryPtr; InterpLibrary *ipPtr; Tcl_Obj *resultObj, *pkgDesc[2]; @@ -1192,11 +1182,11 @@ *---------------------------------------------------------------------- */ static void LoadCleanupProc( - TCL_UNUSED(void *), /* Pointer to first InterpLibrary structure + TCL_UNUSED(void *), /* Pointer to first InterpLibrary structure * for interp. */ Tcl_Interp *interp) { InterpLibrary *ipPtr; LoadedLibrary *libraryPtr; Index: generic/tclMain.c ================================================================== --- generic/tclMain.c +++ generic/tclMain.c @@ -274,11 +274,11 @@ *---------------------------------------------------------------------- */ TCL_NORETURN void Tcl_MainEx( - Tcl_Size argc, /* Number of arguments. */ + Tcl_Size argc, /* Number of arguments. */ TCHAR **argv, /* Array of argument strings. */ Tcl_AppInitProc *appInitProc, /* Application-specific initialization * function to call after most initialization * but before starting to execute commands. */ @@ -737,11 +737,11 @@ *---------------------------------------------------------------------- */ static void StdinProc( - void *clientData, /* The state of interactive cmd line */ + void *clientData, /* The state of interactive cmd line */ TCL_UNUSED(int) /*mask*/) { int code; Tcl_Size length; InteractiveState *isPtr = (InteractiveState *)clientData; Index: generic/tclNamesp.c ================================================================== --- generic/tclNamesp.c +++ generic/tclNamesp.c @@ -132,24 +132,24 @@ NULL, /* updateStringProc */ SetNsNameFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; -#define NsNameSetInternalRep(objPtr, nnPtr) \ - do { \ - Tcl_ObjInternalRep ir; \ - (nnPtr)->refCount++; \ - ir.twoPtrValue.ptr1 = (nnPtr); \ - ir.twoPtrValue.ptr2 = NULL; \ +#define NsNameSetInternalRep(objPtr, nnPtr) \ + do { \ + Tcl_ObjInternalRep ir; \ + (nnPtr)->refCount++; \ + ir.twoPtrValue.ptr1 = (nnPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreInternalRep((objPtr), &nsNameType, &ir); \ } while (0) -#define NsNameGetInternalRep(objPtr, nnPtr) \ - do { \ +#define NsNameGetInternalRep(objPtr, nnPtr) \ + do { \ const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &nsNameType); \ - (nnPtr) = irPtr ? (ResolvedNsName *)irPtr->twoPtrValue.ptr1 : NULL; \ + (nnPtr) = irPtr ? (ResolvedNsName *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * Array of values describing how to implement each standard subcommand of the * "namespace" command. @@ -219,11 +219,11 @@ *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetCurrentNamespace( - Tcl_Interp *interp)/* Interpreter whose current namespace is + Tcl_Interp *interp) /* Interpreter whose current namespace is * being queried. */ { return TclGetCurrentNamespace(interp); } @@ -243,11 +243,11 @@ *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetGlobalNamespace( - Tcl_Interp *interp)/* Interpreter whose global namespace should + Tcl_Interp *interp) /* Interpreter whose global namespace should * be returned. */ { return TclGetGlobalNamespace(interp); } @@ -651,11 +651,11 @@ * being created. Also used for error * reporting. */ const char *name, /* Name for the new namespace. May be a * qualified name with names of ancestor * namespaces separated by "::"s. */ - void *clientData, /* One-word value to store with namespace. */ + void *clientData, /* One-word value to store with namespace. */ Tcl_NamespaceDeleteProc *deleteProc) /* Function called to delete client data when * the namespace is deleted. NULL if no * function should be called. */ { @@ -745,16 +745,16 @@ * already exist in the parent namespace. */ if ( #ifndef BREAK_NAMESPACE_COMPAT - Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL + Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL #else - parentPtr->childTablePtr != NULL && - Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL + parentPtr->childTablePtr != NULL && + Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL #endif - ) { + ) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create namespace \"%s\": already exists", name)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", "CREATEEXISTING", (char *)NULL); Tcl_DStringFree(&tmpBuffer); @@ -1077,12 +1077,11 @@ return (nsPtr->flags & NS_DYING) ? 1 : 0; } void TclDeleteNamespaceChildren( - Namespace *nsPtr /* Namespace whose children to delete */ -) + Namespace *nsPtr) /* Namespace whose children to delete */ { Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; size_t i; int unchecked; @@ -1177,11 +1176,11 @@ *---------------------------------------------------------------------- */ void TclTeardownNamespace( - Namespace *nsPtr) /* Points to the namespace to be dismantled + Namespace *nsPtr) /* Points to the namespace to be dismantled * and unlinked from its parent. */ { Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; @@ -1315,11 +1314,11 @@ *---------------------------------------------------------------------- */ static void NamespaceFree( - Namespace *nsPtr) /* Points to the namespace to free. */ + Namespace *nsPtr) /* Points to the namespace to free. */ { /* * Most of the namespace's contents are freed when the namespace is * deleted by Tcl_DeleteNamespace. All that remains is to free its names * (for error messages), and the structure itself. @@ -2034,11 +2033,11 @@ *---------------------------------------------------------------------- */ static int InvokeImportedNRCmd( - void *clientData, /* Points to the imported command's + void *clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { @@ -2049,11 +2048,11 @@ return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr); } int TclInvokeImportedCmd( - void *clientData, /* Points to the imported command's + void *clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { @@ -2082,11 +2081,11 @@ *---------------------------------------------------------------------- */ static void DeleteImportedCmd( - void *clientData) /* Points to the imported command's + void *clientData) /* Points to the imported command's * ImportedCmdData structure. */ { ImportedCmdData *dataPtr = (ImportedCmdData *)clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; @@ -2521,11 +2520,11 @@ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag is set or * if the name starts with "::". Otherwise, * points to namespace in which to resolve * name; if NULL, look up name in the current * namespace. */ - int flags) /* Flags controlling namespace lookup: an OR'd + int flags) /* Flags controlling namespace lookup: an OR'd * combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG flags. */ { Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; const char *dummy; @@ -2635,11 +2634,10 @@ } if (result == TCL_OK) { ((Command *)cmd)->flags |= CMD_VIA_RESOLVER; return cmd; - } else if (result != TCL_CONTINUE) { return NULL; } } @@ -3082,16 +3080,16 @@ if (strncmp(pattern, nsPtr->fullName, length) != 0) { goto searchDone; } if ( #ifndef BREAK_NAMESPACE_COMPAT - Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL + Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL #else - nsPtr->childTablePtr != NULL && - Tcl_FindHashEntry(nsPtr->childTablePtr, pattern+length) != NULL + nsPtr->childTablePtr != NULL && + Tcl_FindHashEntry(nsPtr->childTablePtr, pattern+length) != NULL #endif - ) { + ) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(pattern, -1)); } goto searchDone; } @@ -3368,11 +3366,11 @@ *---------------------------------------------------------------------- */ static int NamespaceEvalCmd( - void *clientData, /* Arbitrary value passed to cmd. */ + void *clientData, /* Arbitrary value passed to cmd. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRNamespaceEvalCmd, clientData, objc, @@ -3817,11 +3815,11 @@ *---------------------------------------------------------------------- */ static int NamespaceInscopeCmd( - void *clientData, /* Arbitrary value passed to cmd. */ + void *clientData, /* Arbitrary value passed to cmd. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRNamespaceInscopeCmd, clientData, objc, @@ -4733,11 +4731,11 @@ *---------------------------------------------------------------------- */ static void FreeNsNameInternalRep( - Tcl_Obj *objPtr) /* nsName object with internal representation + Tcl_Obj *objPtr) /* nsName object with internal representation * to free. */ { ResolvedNsName *resNamePtr; NsNameGetInternalRep(objPtr, resNamePtr); @@ -4780,11 +4778,11 @@ */ static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedNsName *resNamePtr; NsNameGetInternalRep(srcPtr, resNamePtr); assert(resNamePtr != NULL); @@ -4816,11 +4814,11 @@ static int SetNsNameFromAny( Tcl_Interp *interp, /* Points to the namespace in which to resolve * name. Also used for error reporting if not * NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; ResolvedNsName *resNamePtr; const char *name; @@ -5154,15 +5152,14 @@ Tcl_Size length) /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ { TclLogCommandInfo(interp, script, command, length, NULL, NULL); } - /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ Index: generic/tclNotify.c ================================================================== --- generic/tclNotify.c +++ generic/tclNotify.c @@ -69,11 +69,11 @@ * during an event source traversal. */ EventSource *firstEventSourcePtr; /* Pointer to first event source in list of * event sources for this thread. */ Tcl_ThreadId threadId; /* Thread that owns this notifier instance. */ - void *clientData; /* Opaque handle for platform specific + void *clientData; /* Opaque handle for platform specific * notifier. */ int initialized; /* 1 if notifier has been initialized. */ struct ThreadSpecificData *nextPtr; /* Next notifier in global list of notifiers. * Access is controlled by the listLock global @@ -303,11 +303,11 @@ /* Function to invoke to figure out what to * wait for. */ Tcl_EventCheckProc *checkProc, /* Function to call after waiting to see what * happened. */ - void *clientData) /* One-word argument to pass to setupProc and + void *clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); EventSource *sourcePtr = (EventSource *)Tcl_Alloc(sizeof(EventSource)); @@ -342,11 +342,11 @@ /* Function to invoke to figure out what to * wait for. */ Tcl_EventCheckProc *checkProc, /* Function to call after waiting to see what * happened. */ - void *clientData) /* One-word argument to pass to setupProc and + void *clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); EventSource *sourcePtr, *prevPtr; @@ -389,11 +389,11 @@ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with * malloc (Tcl_Alloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ - int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, + int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, * possibly combined with TCL_QUEUE_ALERT_IF_EMPTY. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); QueueEvent(tsdPtr, evPtr, position); @@ -421,11 +421,11 @@ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with * malloc (Tcl_Alloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ - int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, + int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, * possibly combined with TCL_QUEUE_ALERT_IF_EMPTY. */ { ThreadSpecificData *tsdPtr; /* @@ -481,11 +481,11 @@ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with * malloc (Tcl_Alloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ - int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, + int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, * possibly combined with TCL_QUEUE_ALERT_IF_EMPTY */ { Tcl_MutexLock(&(tsdPtr->queueMutex)); if (tsdPtr->firstEventPtr != NULL) { position &= ~TCL_QUEUE_ALERT_IF_EMPTY; @@ -554,11 +554,11 @@ */ void Tcl_DeleteEvents( Tcl_EventDeleteProc *proc, /* The function to call. */ - void *clientData) /* The type-specific data. */ + void *clientData) /* The type-specific data. */ { Tcl_Event *evPtr; /* Pointer to the event being examined */ Tcl_Event *prevPtr; /* Pointer to evPtr's predecessor, or NULL if * evPtr designates the first event in the * queue for the thread. */ @@ -1251,11 +1251,11 @@ *---------------------------------------------------------------------- */ void Tcl_AlertNotifier( - void *clientData) /* Pointer to thread data. */ + void *clientData) /* Pointer to thread data. */ { if (tclNotifierHooks.alertNotifierProc) { tclNotifierHooks.alertNotifierProc(clientData); } else { TclpAlertNotifier(clientData); @@ -1378,11 +1378,11 @@ * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { if (tclNotifierHooks.createFileHandlerProc) { tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); } else { TclpCreateFileHandler(fd, mask, proc, clientData); Index: generic/tclOO.c ================================================================== --- generic/tclOO.c +++ generic/tclOO.c @@ -300,12 +300,12 @@ static int InitFoundation( Tcl_Interp *interp) { static Tcl_ThreadDataKey tsdKey; - ThreadLocalData *tsdPtr = - (ThreadLocalData *)Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); + ThreadLocalData *tsdPtr = (ThreadLocalData *) + Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); Foundation *fPtr = (Foundation *)Tcl_Alloc(sizeof(Foundation)); Tcl_Obj *namePtr; Tcl_DString buffer; Command *cmdPtr; size_t i; @@ -351,18 +351,18 @@ */ Tcl_DStringInit(&buffer); for (i = 0 ; defineCmds[i].name ; i++) { TclDStringAppendLiteral(&buffer, "::oo::define::"); - Tcl_DStringAppend(&buffer, defineCmds[i].name, -1); + Tcl_DStringAppend(&buffer, defineCmds[i].name, TCL_AUTO_LENGTH); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } for (i = 0 ; objdefCmds[i].name ; i++) { TclDStringAppendLiteral(&buffer, "::oo::objdefine::"); - Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1); + Tcl_DStringAppend(&buffer, objdefCmds[i].name, TCL_AUTO_LENGTH); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } @@ -430,11 +430,11 @@ * Evaluate the remaining definitions, which are a compiled-in Tcl script. */ return Tcl_EvalEx(interp, tclOOSetupScript, TCL_INDEX_NONE, 0); } - + /* * ---------------------------------------------------------------------- * * InitClassSystemRoots -- * @@ -574,12 +574,12 @@ */ static void KillFoundation( TCL_UNUSED(void *), - Tcl_Interp *interp) /* The interpreter containing the OO system - * foundation. */ + Tcl_Interp *interp) /* The interpreter containing the OO system + * foundation. */ { Foundation *fPtr = GetFoundation(interp); TclDecrRefCount(fPtr->unknownMethodNameObj); TclDecrRefCount(fPtr->constructorName); @@ -654,11 +654,12 @@ } while (1) { char objName[10 + TCL_INTEGER_SPACE]; - snprintf(objName, sizeof(objName), "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount); + snprintf(objName, sizeof(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; break; } @@ -789,15 +790,14 @@ * ---------------------------------------------------------------------- */ static void MyDeleted( - void *clientData) /* Reference to the object whose [my] has been + void *clientData) /* Reference to the object whose [my] has been * squelched. */ { Object *oPtr = (Object *)clientData; - oPtr->myCommand = NULL; } static void MyClassDeleted( @@ -820,11 +820,11 @@ * ---------------------------------------------------------------------- */ static void ObjectRenamedTrace( - void *clientData, /* The object being deleted. */ + void *clientData, /* The object being deleted. */ TCL_UNUSED(Tcl_Interp *), TCL_UNUSED(const char *) /*oldName*/, TCL_UNUSED(const char *) /*newName*/, int flags) /* Why was the object deleted? */ { @@ -1133,11 +1133,11 @@ * ---------------------------------------------------------------------- */ static void ObjectNamespaceDeleted( - void *clientData) /* Pointer to the class whose namespace is + void *clientData) /* Pointer to the class whose namespace is * being deleted. */ { Object *oPtr = (Object *)clientData; Foundation *fPtr = oPtr->fPtr; FOREACH_HASH_DECLS; @@ -1367,11 +1367,10 @@ int TclOODecrRefCount( Object *oPtr) { if (oPtr->refCount-- <= 1) { - if (oPtr->classPtr != NULL) { Tcl_Free(oPtr->classPtr); } Tcl_Free(oPtr); return 1; @@ -1716,14 +1715,14 @@ const char *nameStr, /* Name of object to create, or NULL to ask * the code to pick its own unique name. */ const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - Tcl_Size objc, /* Number of arguments. Negative value means + Tcl_Size objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - Tcl_Size skip) /* Number of arguments to _not_ pass to the + Tcl_Size skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; Object *oPtr; void *clientData[4]; @@ -1784,14 +1783,14 @@ const char *nameStr, /* Name of object to create, or NULL to ask * the code to pick its own unique name. */ const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - Tcl_Size objc, /* Number of arguments. Negative value means + Tcl_Size objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - Tcl_Size skip, /* Number of arguments to _not_ pass to the + Tcl_Size skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ { Class *classPtr = (Class *) cls; @@ -1919,11 +1918,11 @@ * want to lose errors by accident. [Bug 2903011] */ if (result != TCL_ERROR && Destructing(oPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "object deleted in constructor", -1)); + "object deleted in constructor", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", (char *)NULL); result = TCL_ERROR; } if (result != TCL_OK) { Tcl_DiscardInterpState(state); @@ -1990,11 +1989,11 @@ * Sanity check. */ if (IsRootClass(oPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not clone the class of classes", -1)); + "may not clone the class of classes", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", (char *)NULL); return NULL; } /* @@ -2605,11 +2604,11 @@ int publicPrivate, /* Whether this is an invoke from a public * context (PUBLIC_METHOD), a private context * (PRIVATE_METHOD), or a *really* private * context (any other value; conventionally * 0). */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Array of argument objects. It is assumed * that the name of the method to invoke will * be at index 1. */ { switch (publicPrivate) { @@ -2676,11 +2675,11 @@ int TclOOObjectCmdCore( Object *oPtr, /* The object being invoked. */ Tcl_Interp *interp, /* The interpreter containing the object. */ - Tcl_Size objc, /* How many arguments are being passed in. */ + Tcl_Size objc, /* How many arguments are being passed in. */ Tcl_Obj *const *objv, /* The array of arguments. */ int flags, /* Whether this is an invocation through the * public or the private command interface. */ Class *startCls) /* Where to start in the call chain, or NULL * if we are to start at the front with @@ -2798,11 +2797,11 @@ break; } } if (contextPtr->index >= contextPtr->callPtr->numChain) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no valid method implementation", -1)); + "no valid method implementation", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(methodNamePtr), (char *)NULL); TclOODeleteContext(contextPtr); return TCL_ERROR; } Index: generic/tclOO.h ================================================================== --- generic/tclOO.h +++ generic/tclOO.h @@ -122,23 +122,25 @@ /* * 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 compatibility. */ - -#define TCL_OO_METHOD_VERSION_1 1 -#define TCL_OO_METHOD_VERSION_2 2 -#define TCL_OO_METHOD_VERSION_CURRENT 1 +enum Tcl_OOMethodVersions { + TCL_OO_METHOD_VERSION_1 = 1, + TCL_OO_METHOD_VERSION_2 = 2, + TCL_OO_METHOD_VERSION_CURRENT = TCL_OO_METHOD_VERSION_1 +}; /* * Visibility constants for the flags parameter to Tcl_NewMethod and * Tcl_NewInstanceMethod. */ - -#define TCL_OO_METHOD_PUBLIC 1 -#define TCL_OO_METHOD_UNEXPORTED 0 -#define TCL_OO_METHOD_PRIVATE 0x20 +enum Tcl_OOMethodVisibilityFlags { + TCL_OO_METHOD_PUBLIC = 1, + TCL_OO_METHOD_UNEXPORTED = 0, + TCL_OO_METHOD_PRIVATE = 0x20 +}; /* * The type of some object (or class) metadata. This describes how to delete * the metadata (when the object or class is deleted) and how to create a * clone of it (when the object or class is copied). @@ -160,12 +162,13 @@ /* * 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 compatibility. */ - -#define TCL_OO_METADATA_VERSION_CURRENT 1 +enum Tcl_OOMetadataVersions { + TCL_OO_METADATA_VERSION_CURRENT = 1 +}; /* * Include all the public API, generated from tclOO.decls. */ Index: generic/tclOOBasic.c ================================================================== --- generic/tclOOBasic.c +++ generic/tclOOBasic.c @@ -98,12 +98,12 @@ /* * Make the class definition delegate. This is special; it doesn't reenter * here (and the class definition delegate doesn't run any constructors). */ - nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1); - Tcl_AppendToObj(nameObj, ":: oo ::delegate", -1); + nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, TCL_AUTO_LENGTH); + Tcl_AppendToObj(nameObj, ":: oo ::delegate", TCL_AUTO_LENGTH); Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls, TclGetString(nameObj), NULL, -1, NULL, -1); Tcl_DecrRefCount(nameObj); /* @@ -111,11 +111,11 @@ */ invoke = (Tcl_Obj **)Tcl_Alloc(3 * sizeof(Tcl_Obj *)); invoke[0] = oPtr->fPtr->defineName; invoke[1] = TclOOObjectName(interp, oPtr); - invoke[2] = objv[objc-1]; + invoke[2] = objv[objc - 1]; /* * Must add references or errors in configuration script will cause * trouble. */ @@ -146,11 +146,11 @@ int code; TclDecrRefCount(invoke[0]); TclDecrRefCount(invoke[1]); TclDecrRefCount(invoke[2]); - invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", -1); + invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", TCL_AUTO_LENGTH); invoke[1] = TclOOObjectName(interp, oPtr); Tcl_IncrRefCount(invoke[0]); Tcl_IncrRefCount(invoke[1]); saved = Tcl_SaveInterpState(interp, result); code = Tcl_EvalObjv(interp, 2, invoke, 0); @@ -212,11 +212,11 @@ } objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "object name must not be empty", -1)); + "object name must not be empty", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL); return TCL_ERROR; } /* @@ -277,19 +277,19 @@ } objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "object name must not be empty", -1)); + "object name must not be empty", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL); return TCL_ERROR; } nsName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)+1], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "namespace name must not be empty", -1)); + "namespace name must not be empty", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL); return TCL_ERROR; } /* @@ -598,18 +598,18 @@ errorMsg = Tcl_ObjPrintf("unknown method \"%s\": must be ", TclGetString(objv[skip])); for (i=0 ; ivarname method. * * ---------------------------------------------------------------------- */ + +/* + * Private method handling. [TIP 500] + * + * If we're in a context that can see some private methods of an + * object, we may need to precede a variable name with its prefix. + * This is a little tricky as we need to check through the inheritance + * hierarchy when the method was declared by a class to see if the + * current object is an instance of that class. + */ +static inline Tcl_Obj * +MapPrivateVarName( + Tcl_Object object, + CallFrame *framePtr, + Tcl_Obj *argPtr) +{ + Object *oPtr = (Object *) object; + // NB: NOT the context we got the object from! + CallContext *callerCtxt = (CallContext *) framePtr->clientData; + Method *mPtr = callerCtxt->callPtr->chain[callerCtxt->index].mPtr; + PrivateVariableMapping *pvPtr; + Tcl_Size i; + + if (mPtr->declaringObjectPtr == oPtr) { + FOREACH_STRUCT(pvPtr, oPtr->privateVariables) { + if (!strcmp(TclGetString(pvPtr->variableObj), + TclGetString(argPtr))) { + return pvPtr->fullNameObj; + } + } + } else if (mPtr->declaringClassPtr && + mPtr->declaringClassPtr->privateVariables.num) { + Class *clsPtr = mPtr->declaringClassPtr; + int isInstance = TclOOIsReachable(clsPtr, oPtr->selfCls); + Class *mixinCls; + + if (!isInstance) { + FOREACH(mixinCls, oPtr->mixins) { + if (TclOOIsReachable(clsPtr, mixinCls)) { + isInstance = 1; + break; + } + } + } + + if (isInstance) { + FOREACH_STRUCT(pvPtr, clsPtr->privateVariables) { + if (!strcmp(TclGetString(pvPtr->variableObj), + TclGetString(argPtr))) { + return pvPtr->fullNameObj; + } + } + } + } + return argPtr; +} int TclOO_Object_VarName( TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter in which to create the object; @@ -744,11 +800,11 @@ if ((int)Tcl_ObjectContextSkippedArgs(context)+1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "varName"); return TCL_ERROR; } - argPtr = objv[objc-1]; + argPtr = objv[objc - 1]; arg = TclGetString(argPtr); /* * Convert the variable name to fully-qualified form if it wasn't already. * This has to be done prior to lookup because we can run into problems @@ -762,63 +818,16 @@ varNamePtr = argPtr; } else { Tcl_Namespace *namespacePtr = Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)); - /* - * Private method handling. [TIP 500] - * - * If we're in a context that can see some private methods of an - * object, we may need to precede a variable name with its prefix. - * This is a little tricky as we need to check through the inheritance - * hierarchy when the method was declared by a class to see if the - * current object is an instance of that class. - */ - if (framePtr->isProcCallFrame & FRAME_IS_METHOD) { - Object *oPtr = (Object *) Tcl_ObjectContextObject(context); - CallContext *callerContext = (CallContext *)framePtr->clientData; - Method *mPtr = callerContext->callPtr->chain[ - callerContext->index].mPtr; - PrivateVariableMapping *pvPtr; - Tcl_Size i; - - if (mPtr->declaringObjectPtr == oPtr) { - FOREACH_STRUCT(pvPtr, oPtr->privateVariables) { - if (!strcmp(TclGetString(pvPtr->variableObj), - TclGetString(argPtr))) { - argPtr = pvPtr->fullNameObj; - break; - } - } - } else if (mPtr->declaringClassPtr && - mPtr->declaringClassPtr->privateVariables.num) { - Class *clsPtr = mPtr->declaringClassPtr; - int isInstance = TclOOIsReachable(clsPtr, oPtr->selfCls); - Class *mixinCls; - - if (!isInstance) { - FOREACH(mixinCls, oPtr->mixins) { - if (TclOOIsReachable(clsPtr, mixinCls)) { - isInstance = 1; - break; - } - } - } - if (isInstance) { - FOREACH_STRUCT(pvPtr, clsPtr->privateVariables) { - if (!strcmp(TclGetString(pvPtr->variableObj), - TclGetString(argPtr))) { - argPtr = pvPtr->fullNameObj; - break; - } - } - } - } - } - - varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1); + argPtr = MapPrivateVarName(Tcl_ObjectContextObject(context), + framePtr, argPtr); + } + + varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, TCL_AUTO_LENGTH); Tcl_AppendToObj(varNamePtr, "::", 2); Tcl_AppendObjToObj(varNamePtr, argPtr); } Tcl_IncrRefCount(varNamePtr); varPtr = TclObjLookupVar(interp, varNamePtr, NULL, @@ -840,14 +849,14 @@ /* * WARNING! This code pokes inside the implementation of hash tables! */ - Tcl_AppendToObj(varNamePtr, "(", -1); + Tcl_AppendToObj(varNamePtr, "(", TCL_AUTO_LENGTH); Tcl_AppendObjToObj(varNamePtr, ((VarInHash *) varPtr)->entry.key.objPtr); - Tcl_AppendToObj(varNamePtr, ")", -1); + Tcl_AppendToObj(varNamePtr, ")", TCL_AUTO_LENGTH); } else { Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr); } Tcl_SetObjResult(interp, varNamePtr); return TCL_OK; @@ -966,11 +975,11 @@ * context. Note that this is like [uplevel 1] and not [eval]. */ TclNRAddCallback(interp, NextRestoreFrame, framePtr, contextPtr, INT2PTR(contextPtr->index), NULL); - contextPtr->index = i-1; + contextPtr->index = i - 1; iPtr->varFramePtr = framePtr->callerVarPtr; return TclNRObjectContextInvokeNext(interp, (Tcl_ObjectContext) contextPtr, objc, objv, 2); } } @@ -1020,10 +1029,50 @@ if (contextPtr != NULL) { contextPtr->index = PTR2UINT(data[2]); } return result; } + +/* + * ---------------------------------------------------------------------- + * + * GetDeclarer, GetMethodName -- + * + * Helpers for the [self] command implementation. + * + * ---------------------------------------------------------------------- + */ + +/* Get (class?) object that declared a method. */ +static inline Object * +GetDeclarer( + Method *mPtr) /* Method impl to get declarer of. */ +{ + if (mPtr->declaringClassPtr != NULL) { + return mPtr->declaringClassPtr->thisPtr; + } else if (mPtr->declaringObjectPtr != NULL) { + return mPtr->declaringObjectPtr; + } + + Tcl_Panic("method without declarer!"); + return NULL; +} + +/* Get the official name of a method. */ +static inline Tcl_Obj * +GetMethodName( + CallContext *contextPtr, /* Context in which we're asking. */ + Method *mPtr) /* What method implementation to name. */ +{ + if (contextPtr->callPtr->flags & CONSTRUCTOR) { + return contextPtr->oPtr->fPtr->constructorName; + } else if (contextPtr->callPtr->flags & DESTRUCTOR) { + return contextPtr->oPtr->fPtr->destructorName; + } else { + return mPtr->namePtr; + } +} /* * ---------------------------------------------------------------------- * * TclOOSelfObjCmd -- @@ -1090,39 +1139,33 @@ case SELF_OBJECT: Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr)); return TCL_OK; case SELF_NS: Tcl_SetObjResult(interp, Tcl_NewStringObj( - contextPtr->oPtr->namespacePtr->fullName, -1)); + contextPtr->oPtr->namespacePtr->fullName, TCL_AUTO_LENGTH)); return TCL_OK; case SELF_CLASS: { Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr; if (clsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method not defined by a class", -1)); + "method not defined by a class", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr)); return TCL_OK; } case SELF_METHOD: - if (contextPtr->callPtr->flags & CONSTRUCTOR) { - Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->constructorName); - } else if (contextPtr->callPtr->flags & DESTRUCTOR) { - Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->destructorName); - } else { - Tcl_SetObjResult(interp, - CurrentlyInvoked(contextPtr).mPtr->namePtr); - } + Tcl_SetObjResult(interp, GetMethodName(contextPtr, + CurrentlyInvoked(contextPtr).mPtr)); return TCL_OK; case SELF_FILTER: if (!CurrentlyInvoked(contextPtr).isFilter) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "not inside a filtering context", -1)); + "not inside a filtering context", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL); return TCL_ERROR; } else { struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr); Object *oPtr; @@ -1135,119 +1178,67 @@ oPtr = contextPtr->oPtr; type = "object"; } result[0] = TclOOObjectName(interp, oPtr); - result[1] = Tcl_NewStringObj(type, -1); + result[1] = Tcl_NewStringObj(type, TCL_AUTO_LENGTH); result[2] = miPtr->mPtr->namePtr; Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); return TCL_OK; } case SELF_CALLER: if ((framePtr->callerVarPtr == NULL) || !(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){ Tcl_SetObjResult(interp, Tcl_NewStringObj( - "caller is not an object", -1)); + "caller is not an object", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL); return TCL_ERROR; } else { CallContext *callerPtr = (CallContext *)framePtr->callerVarPtr->clientData; Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr; - Object *declarerPtr; - - if (mPtr->declaringClassPtr != NULL) { - declarerPtr = mPtr->declaringClassPtr->thisPtr; - } else if (mPtr->declaringObjectPtr != NULL) { - declarerPtr = mPtr->declaringObjectPtr; - } else { - /* - * This should be unreachable code. - */ - - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method without declarer!", -1)); - return TCL_ERROR; - } + Object *declarerPtr = GetDeclarer(mPtr); result[0] = TclOOObjectName(interp, declarerPtr); result[1] = TclOOObjectName(interp, callerPtr->oPtr); - if (callerPtr->callPtr->flags & CONSTRUCTOR) { - result[2] = declarerPtr->fPtr->constructorName; - } else if (callerPtr->callPtr->flags & DESTRUCTOR) { - result[2] = declarerPtr->fPtr->destructorName; - } else { - result[2] = mPtr->namePtr; - } + result[2] = GetMethodName(callerPtr, mPtr); Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); return TCL_OK; } case SELF_NEXT: - if (contextPtr->index < contextPtr->callPtr->numChain-1) { + if (contextPtr->index < contextPtr->callPtr->numChain - 1) { Method *mPtr = contextPtr->callPtr->chain[contextPtr->index+1].mPtr; - Object *declarerPtr; - - if (mPtr->declaringClassPtr != NULL) { - declarerPtr = mPtr->declaringClassPtr->thisPtr; - } else if (mPtr->declaringObjectPtr != NULL) { - declarerPtr = mPtr->declaringObjectPtr; - } else { - /* - * This should be unreachable code. - */ - - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method without declarer!", -1)); - return TCL_ERROR; - } + Object *declarerPtr = GetDeclarer(mPtr); result[0] = TclOOObjectName(interp, declarerPtr); - if (contextPtr->callPtr->flags & CONSTRUCTOR) { - result[1] = declarerPtr->fPtr->constructorName; - } else if (contextPtr->callPtr->flags & DESTRUCTOR) { - result[1] = declarerPtr->fPtr->destructorName; - } else { - result[1] = mPtr->namePtr; - } + result[1] = GetMethodName(contextPtr, mPtr); Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); } return TCL_OK; case SELF_TARGET: if (!CurrentlyInvoked(contextPtr).isFilter) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "not inside a filtering context", -1)); + "not inside a filtering context", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL); return TCL_ERROR; } else { Method *mPtr; Object *declarerPtr; Tcl_Size i; - for (i=contextPtr->index ; icallPtr->numChain ; i++){ + for (i=contextPtr->index ; icallPtr->numChain ; i++) { if (!contextPtr->callPtr->chain[i].isFilter) { break; } } if (i == contextPtr->callPtr->numChain) { Tcl_Panic("filtering call chain without terminal non-filter"); } mPtr = contextPtr->callPtr->chain[i].mPtr; - if (mPtr->declaringClassPtr != NULL) { - declarerPtr = mPtr->declaringClassPtr->thisPtr; - } else if (mPtr->declaringObjectPtr != NULL) { - declarerPtr = mPtr->declaringObjectPtr; - } else { - /* - * This should be unreachable code. - */ - - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method without declarer!", -1)); - return TCL_ERROR; - } + declarerPtr = GetDeclarer(mPtr); result[0] = TclOOObjectName(interp, declarerPtr); - result[1] = mPtr->namePtr; + result[1] = GetMethodName(contextPtr, mPtr); Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); return TCL_OK; } case SELF_CALL: result[0] = TclOORenderCallChain(interp, contextPtr->callPtr); Index: generic/tclOOCall.c ================================================================== --- generic/tclOOCall.c +++ generic/tclOOCall.c @@ -23,11 +23,11 @@ * the construction of the CallContext. */ struct ChainBuilder { CallChain *callChainPtr; /* The call chain being built. */ - size_t filterLength; /* Number of entries in the call chain that + size_t filterLength; /* Number of entries in the call chain that * are due to processing filters and not the * main call chain. */ Object *oPtr; /* The object that we are building the chain * for. */ }; @@ -50,18 +50,21 @@ /* * Extra flags used for call chain management. */ -#define DEFINITE_PROTECTED 0x100000 -#define DEFINITE_PUBLIC 0x200000 -#define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC) -#define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN) -#define BUILDING_MIXINS 0x400000 -#define TRAVERSED_MIXIN 0x800000 -#define OBJECT_MIXIN 0x1000000 -#define DEFINE_FOR_CLASS 0x2000000 +enum CallChainExtraFlags { + DEFINITE_PROTECTED = 0x100000, + DEFINITE_PUBLIC = 0x200000, + DEFINITE_NOT_PUBLIC = (PRIVATE_METHOD | TRUE_PRIVATE_METHOD), + KNOWN_STATE = (DEFINITE_PROTECTED | DEFINITE_PUBLIC), + SPECIAL = (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN), + BUILDING_MIXINS = 0x400000, + TRAVERSED_MIXIN = 0x800000, + OBJECT_MIXIN = 0x1000000, + DEFINE_FOR_CLASS = 0x2000000 +}; #define MIXIN_CONSISTENT(flags) \ (((flags) & OBJECT_MIXIN) || \ !((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN)) /* @@ -78,11 +81,11 @@ #define IS_PRIVATE(mPtr) \ (((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0) #define WANT_PUBLIC(flags) \ (((flags) & PUBLIC_METHOD) != 0) #define WANT_UNEXPORTED(flags) \ - (((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0) + (((flags) & DEFINITE_NOT_PUBLIC) == 0) #define WANT_ITCLPRIVATE(flags) \ (((flags) & PRIVATE_METHOD) != 0) #define WANT_PRIVATE(flags) \ (((flags) & TRUE_PRIVATE_METHOD) != 0) @@ -153,10 +156,18 @@ DupMethodNameRep, NULL, NULL, TCL_OBJTYPE_V0 }; + +/* + * Name the bits used in the names table values. + */ +enum NamesTableFlags { + IN_LIST = 1, + NO_IMPLEMENTATION = 2 +}; /* * ---------------------------------------------------------------------- * @@ -307,11 +318,11 @@ * ---------------------------------------------------------------------- */ int TclOOInvokeContext( - void *clientData, /* The method call context. */ + void *clientData, /* The method call context. */ Tcl_Interp *interp, /* Interpreter for error reporting, and many * other sorts of context handling (e.g., * commands, variables) depending on method * implementation. */ int objc, /* The number of arguments. */ @@ -373,13 +384,16 @@ */ if (mPtr->typePtr->version < TCL_OO_METHOD_VERSION_2) { return (mPtr->typePtr->callProc)(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, objc, objv); + } else { + Tcl_MethodCallProc2 *callProc = (Tcl_MethodCallProc2 *) (void *) + mPtr->typePtr->callProc; + return callProc(mPtr->clientData, interp, + (Tcl_ObjectContext) contextPtr, objc, objv); } - return ((Tcl_MethodCallProc2 *)(void *)(mPtr->typePtr->callProc))(mPtr->clientData, interp, - (Tcl_ObjectContext) contextPtr, objc, objv); } static int SetFilterFlags( void *data[], @@ -458,16 +472,10 @@ Method *mPtr; Tcl_InitObjHashTable(&names); Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS); - /* - * Name the bits used in the names table values. - */ -#define IN_LIST 1 -#define NO_IMPLEMENTATION 2 - /* * Process method names due to the object. */ if (oPtr->methodsPtr) { @@ -676,11 +684,11 @@ */ static void AddClassMethodNames( Class *clsPtr, /* Class to get method names from. */ - int flags, /* Whether we are interested in just the + int flags, /* Whether we are interested in just the * public method names. */ Tcl_HashTable *const namesPtr, /* Reference to the hash table to put the * information in. The hash table maps the * Tcl_Obj * method name to an integral value @@ -807,13 +815,10 @@ isWanted &= ~NO_IMPLEMENTATION; Tcl_SetHashValue(hPtr, INT2PTR(isWanted)); } } } - -#undef IN_LIST -#undef NO_IMPLEMENTATION /* * ---------------------------------------------------------------------- * * AddInstancePrivateToCallContext -- @@ -1042,12 +1047,12 @@ * fact that we are using some "static" space initially, and only start * realloc-ing if the chain gets long. */ if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) { - callPtr->chain = - (struct MInvoke *)Tcl_Alloc(sizeof(struct MInvoke) * (callPtr->numChain + 1)); + callPtr->chain = (struct MInvoke *) + 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 = (struct MInvoke *)Tcl_Realloc(callPtr->chain, sizeof(struct MInvoke) * (callPtr->numChain + 1)); @@ -1342,20 +1347,21 @@ } else if (doFilters && !donePrivate) { if (hPtr == NULL) { int isNew; if (oPtr->flags & USE_CLASS_CACHE) { if (oPtr->selfCls->classChainCache == NULL) { - oPtr->selfCls->classChainCache = - (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + oPtr->selfCls->classChainCache = (Tcl_HashTable *) + Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->selfCls->classChainCache); } hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache, methodNameObj, &isNew); } else { if (oPtr->chainCache == NULL) { - oPtr->chainCache = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + oPtr->chainCache = (Tcl_HashTable *) + Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->chainCache); } hPtr = Tcl_CreateHashEntry(oPtr->chainCache, methodNameObj, &isNew); @@ -1377,11 +1383,12 @@ oPtr->selfCls->destructorChainPtr = callPtr; callPtr->refCount++; } returnContext: - contextPtr = (CallContext *)TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); + contextPtr = (CallContext *) + TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); contextPtr->oPtr = oPtr; /* * Corresponding TclOODecrRefCount() in TclOODeleteContext */ @@ -2037,12 +2044,13 @@ * ---------------------------------------------------------------------- */ static inline void AddDefinitionNamespaceToChain( - Class *const definerCls, /* What class defines this entry. */ - Tcl_Obj *const namespaceName, /* The name for this entry (or NULL, a + Class *const definerCls, /* What class defines this entry. */ + Tcl_Obj *const namespaceName, + /* The name for this entry (or NULL, a * no-op). */ DefineChain *const definePtr, /* The define chain to add the method * implementation to. */ int flags) /* Used to check if we're mixin-consistent Index: generic/tclOODefineCmds.c ================================================================== --- generic/tclOODefineCmds.c +++ generic/tclOODefineCmds.c @@ -685,11 +685,11 @@ newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, toPtr, &isNew); if (hPtr == newHPtr) { renameToSelf: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot rename method to itself", -1)); + "cannot rename method to itself", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", (char *)NULL); return TCL_ERROR; } else if (!isNew) { renameToExisting: Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -761,11 +761,11 @@ Tcl_Size soughtLen; const char *soughtStr, *matchedStr = NULL; if (objc < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad call of unknown handler", -1)); + "bad call of unknown handler", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", (char *)NULL); return TCL_ERROR; } if (TclOOGetDefineCmdContext(interp) == NULL) { return TCL_ERROR; @@ -795,11 +795,11 @@ Tcl_Obj **newObjv = (Tcl_Obj **) TclStackAlloc(interp, sizeof(Tcl_Obj*) * (objc - 1)); int result; - newObjv[0] = Tcl_NewStringObj(matchedStr, -1); + newObjv[0] = Tcl_NewStringObj(matchedStr, TCL_AUTO_LENGTH); Tcl_IncrRefCount(newObjv[0]); if (objc > 2) { memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2)); } result = Tcl_EvalObjv(interp, objc - 1, newObjv, 0); @@ -898,11 +898,11 @@ { CallFrame *framePtr, **framePtrPtr = &framePtr; if (namespacePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no definition namespace available", -1)); + "no definition namespace available", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } /* @@ -939,24 +939,49 @@ if ((iPtr->varFramePtr == NULL) || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE && iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "this command may only be called from within the context of" - " an ::oo::define or ::oo::objdefine command", -1)); + " an ::oo::define or ::oo::objdefine command", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return NULL; } object = (Tcl_Object)iPtr->varFramePtr->clientData; if (Tcl_ObjectDeleted(object)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "this command cannot be called when the object has been" - " deleted", -1)); + " deleted", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return NULL; } return object; } + +static inline void +ReportMisuse( + Tcl_Interp *interp) +{ + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", TCL_AUTO_LENGTH)); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); +} + +static inline Class * +GetDefineClass( + Tcl_Interp *interp) +{ + Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + + if (!oPtr) { + return NULL; + } + if (!oPtr->classPtr) { + ReportMisuse(interp); + return NULL; + } + return oPtr->classPtr; +} /* * ---------------------------------------------------------------------- * * GetClassInOuterContext, GetNamespaceInOuterContext -- @@ -990,11 +1015,11 @@ iPtr->varFramePtr = savedFramePtr; if (oPtr == NULL) { return NULL; } if (oPtr->classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(className), (char *)NULL); return NULL; } return oPtr->classPtr; @@ -1489,17 +1514,19 @@ if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->flags & ROOT_OBJECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not modify the class of the root object class", -1)); + "may not modify the class of the root object class", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } if (oPtr->flags & ROOT_CLASS) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not modify the class of the class of classes", -1)); + "may not modify the class of the class of classes", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } /* @@ -1515,11 +1542,12 @@ if (clsPtr == NULL) { return TCL_ERROR; } if (oPtr == clsPtr->thisPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not change classes into an instance of themselves", -1)); + "may not change classes into an instance of themselves", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } /* @@ -1658,28 +1686,21 @@ "-class", "-instance", NULL }; int kind = 0; - Object *oPtr; Tcl_Namespace *nsPtr; Tcl_Obj *nsNamePtr, **storagePtr; + Class *classPtr = GetDefineClass(interp); - oPtr = (Object *) TclOOGetDefineCmdContext(interp); - if (oPtr == NULL) { + if (classPtr == NULL) { return TCL_ERROR; } - if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); - return TCL_ERROR; - } - if (oPtr->flags & (ROOT_OBJECT | ROOT_CLASS)) { + if (classPtr->thisPtr->flags & (ROOT_OBJECT | ROOT_CLASS)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not modify the definition namespace of the root classes", - -1)); + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } /* @@ -1699,22 +1720,22 @@ } else { nsPtr = GetNamespaceInOuterContext(interp, objv[objc - 1]); if (nsPtr == NULL) { return TCL_ERROR; } - nsNamePtr = Tcl_NewStringObj(nsPtr->fullName, -1); + nsNamePtr = Tcl_NewStringObj(nsPtr->fullName, TCL_AUTO_LENGTH); Tcl_IncrRefCount(nsNamePtr); } /* * Update the correct field of the class definition. */ if (kind) { - storagePtr = &oPtr->classPtr->objDefinitionNs; + storagePtr = &classPtr->objDefinitionNs; } else { - storagePtr = &oPtr->classPtr->clsDefinitionNs; + storagePtr = &classPtr->clsDefinitionNs; } if (*storagePtr != NULL) { Tcl_DecrRefCount(*storagePtr); } *storagePtr = nsNamePtr; @@ -1751,13 +1772,11 @@ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceDeleteMethod && !oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + ReportMisuse(interp); return TCL_ERROR; } for (i = 1; i < objc; i++) { /* @@ -1877,13 +1896,11 @@ if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; if (!isInstanceExport && !clsPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + ReportMisuse(interp); return TCL_ERROR; } for (i = 1; i < objc; i++) { /* @@ -1971,13 +1988,11 @@ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceForward && !oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + ReportMisuse(interp); return TCL_ERROR; } isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN) ? PUBLIC_METHOD : 0; if (IsPrivateDefine(interp)) { @@ -2049,13 +2064,11 @@ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceMethod && !oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + ReportMisuse(interp); return TCL_ERROR; } if (objc == 5) { if (Tcl_GetIndexFromObj(interp, objv[2], exportModes, "export flag", 0, &exportMode) != TCL_OK) { @@ -2128,13 +2141,11 @@ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceRenameMethod && !oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + ReportMisuse(interp); return TCL_ERROR; } /* * Delete the method entry from the appropriate hash table, and transfer @@ -2190,13 +2201,11 @@ if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; if (!isInstanceUnexport && !clsPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + ReportMisuse(interp); return TCL_ERROR; } for (i = 1; i < objc; i++) { /* @@ -2320,13 +2329,13 @@ int TclOODefineSlots( Foundation *fPtr) { const struct DeclaredSlot *slotInfoPtr; - Tcl_Obj *getName = Tcl_NewStringObj("Get", -1); - Tcl_Obj *setName = Tcl_NewStringObj("Set", -1); - Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -1); + Tcl_Obj *getName = Tcl_NewStringObj("Get", TCL_AUTO_LENGTH); + Tcl_Obj *setName = Tcl_NewStringObj("Set", TCL_AUTO_LENGTH); + Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", TCL_AUTO_LENGTH); Class *slotCls; slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class) fPtr->classCls, "::oo::Slot", NULL, TCL_INDEX_NONE, NULL, 0))->classPtr; if (slotCls == NULL) { @@ -2374,30 +2383,25 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Obj *resultObj, *filterObj; Tcl_Size i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); - FOREACH(filterObj, oPtr->classPtr->filters) { + FOREACH(filterObj, classPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -2408,11 +2412,11 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Size filterc; Tcl_Obj **filterv; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, @@ -2419,23 +2423,18 @@ "filterList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { return TCL_ERROR; } - TclOOClassSetFilters(interp, oPtr->classPtr, filterc, filterv); + TclOOClassSetFilters(interp, classPtr, filterc, filterv); return TCL_OK; } /* * ---------------------------------------------------------------------- @@ -2454,37 +2453,31 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Obj *resultObj; Class *mixinPtr; Tcl_Size i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); - FOREACH(mixinPtr, oPtr->classPtr->mixins) { + FOREACH(mixinPtr, classPtr->mixins) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; - } static int ClassMixinSet( TCL_UNUSED(void *), @@ -2491,11 +2484,11 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Size mixinc, i; Tcl_Obj **mixinv; Class **mixins; /* The references to the classes to actually * install. */ Tcl_HashTable uniqueCheck; /* Note that this hash table is just used as a @@ -2508,16 +2501,11 @@ "mixinList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } @@ -2533,23 +2521,24 @@ goto freeAndError; } (void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "class should only be a direct mixin once", -1)); + "class should only be a direct mixin once", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", (char *)NULL); goto freeAndError; } - if (TclOOIsReachable(oPtr->classPtr, mixins[i])) { + if (TclOOIsReachable(classPtr, mixins[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not mix a class into itself", -1)); + "may not mix a class into itself", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", (char *)NULL); goto freeAndError; } } - TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins); + TclOOClassSetMixins(interp, classPtr, mixinc, mixins); Tcl_DeleteHashTable(&uniqueCheck); TclStackFree(interp, mixins); return TCL_OK; freeAndError: @@ -2575,31 +2564,26 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Obj *resultObj; Class *superPtr; Tcl_Size i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); - FOREACH(superPtr, oPtr->classPtr->superclasses) { + FOREACH(superPtr, classPtr->superclasses) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, superPtr->thisPtr)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; @@ -2611,33 +2595,30 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Size superc, j; Tcl_Size i; Tcl_Obj **superv; Class **superclasses, *superPtr; + Foundation *fPtr = (Foundation *) ((Interp *) interp)->objectFoundation; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "superclassList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); - return TCL_ERROR; - } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not modify the superclass of the root object", -1)); + if (classPtr == NULL) { + return TCL_ERROR; + } else if (classPtr->thisPtr->flags & ROOT_OBJECT) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "may not modify the superclass of the root object", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &superc, &superv) != TCL_OK) { return TCL_ERROR; @@ -2656,14 +2637,14 @@ * class of objects. [Bug 9d61624b3d] */ if (superc == 0) { superclasses = (Class **)Tcl_Realloc(superclasses, sizeof(Class *)); - if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) { - superclasses[0] = oPtr->fPtr->classCls; + if (TclOOIsReachable(fPtr->classCls, classPtr)) { + superclasses[0] = fPtr->classCls; } else { - superclasses[0] = oPtr->fPtr->objectCls; + superclasses[0] = fPtr->objectCls; } superc = 1; AddRef(superclasses[0]->thisPtr); } else { for (i = 0; i < superc; i++) { @@ -2674,18 +2655,19 @@ } for (j = 0; j < i; j++) { if (superclasses[j] == superclasses[i]) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "class should only be a direct superclass once", - -1)); + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",(char *)NULL); goto failedAfterAlloc; } } - if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) { + if (TclOOIsReachable(classPtr, superclasses[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to form circular dependency graph", -1)); + "attempt to form circular dependency graph", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", (char *)NULL); failedAfterAlloc: for (; i-- > 0 ;) { TclOODecrRefCount(superclasses[i]->thisPtr); } @@ -2707,23 +2689,23 @@ * involves splicing the class out of the superclasses' subclass list that * it used to be a member of and splicing it into the new superclasses' * subclass list. */ - if (oPtr->classPtr->superclasses.num != 0) { - FOREACH(superPtr, oPtr->classPtr->superclasses) { - TclOORemoveFromSubclasses(oPtr->classPtr, superPtr); + if (classPtr->superclasses.num != 0) { + FOREACH(superPtr, classPtr->superclasses) { + TclOORemoveFromSubclasses(classPtr, superPtr); TclOODecrRefCount(superPtr->thisPtr); } - Tcl_Free(oPtr->classPtr->superclasses.list); - } - oPtr->classPtr->superclasses.list = superclasses; - oPtr->classPtr->superclasses.num = superc; - FOREACH(superPtr, oPtr->classPtr->superclasses) { - TclOOAddToSubclasses(oPtr->classPtr, superPtr); - } - BumpGlobalEpoch(interp, oPtr->classPtr); + Tcl_Free(classPtr->superclasses.list); + } + classPtr->superclasses.list = superclasses; + classPtr->superclasses.num = superc; + FOREACH(superPtr, classPtr->superclasses) { + TclOOAddToSubclasses(classPtr, superPtr); + } + BumpGlobalEpoch(interp, classPtr); return TCL_OK; } /* @@ -2743,39 +2725,34 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Obj *resultObj; Tcl_Size i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); if (IsPrivateDefine(interp)) { PrivateVariableMapping *privatePtr; - FOREACH_STRUCT(privatePtr, oPtr->classPtr->privateVariables) { + FOREACH_STRUCT(privatePtr, classPtr->privateVariables) { Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj); } } else { Tcl_Obj *variableObj; - FOREACH(variableObj, oPtr->classPtr->variables) { + FOREACH(variableObj, classPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; @@ -2787,11 +2764,11 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Size i; Tcl_Size varc; Tcl_Obj **varv; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { @@ -2799,16 +2776,11 @@ "filterList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } @@ -2831,14 +2803,14 @@ return TCL_ERROR; } } if (IsPrivateDefine(interp)) { - InstallPrivateVariableMapping(&oPtr->classPtr->privateVariables, - varc, varv, oPtr->classPtr->thisPtr->creationEpoch); + InstallPrivateVariableMapping(&classPtr->privateVariables, + varc, varv, classPtr->thisPtr->creationEpoch); } else { - InstallStandardVariableMapping(&oPtr->classPtr->variables, varc, varv); + InstallStandardVariableMapping(&classPtr->variables, varc, varv); } return TCL_OK; } /* @@ -2993,11 +2965,12 @@ goto freeAndError; } (void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "class should only be a direct mixin once", -1)); + "class should only be a direct mixin once", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", (char *)NULL); goto freeAndError; } } @@ -3241,30 +3214,25 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Obj *resultObj, *propNameObj; int i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); - FOREACH(propNameObj, oPtr->classPtr->properties.readable) { + FOREACH(propNameObj, classPtr->properties.readable) { Tcl_ListObjAppendElement(NULL, resultObj, propNameObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -3275,11 +3243,11 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Size varc; Tcl_Obj **varv; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, @@ -3286,24 +3254,19 @@ "filterList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } - InstallReadableProps(&oPtr->classPtr->properties, varc, varv); - BumpGlobalEpoch(interp, oPtr->classPtr); + InstallReadableProps(&classPtr->properties, varc, varv); + BumpGlobalEpoch(interp, classPtr); return TCL_OK; } static int ObjRPropsGet( @@ -3438,30 +3401,25 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Obj *resultObj, *propNameObj; int i; if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } TclNewObj(resultObj); - FOREACH(propNameObj, oPtr->classPtr->properties.writable) { + FOREACH(propNameObj, classPtr->properties.writable) { Tcl_ListObjAppendElement(NULL, resultObj, propNameObj); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -3472,11 +3430,11 @@ Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); + Class *classPtr = GetDefineClass(interp); Tcl_Size varc; Tcl_Obj **varv; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, @@ -3483,24 +3441,19 @@ "propertyList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (oPtr == NULL) { - return TCL_ERROR; - } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); + if (classPtr == NULL) { return TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } - InstallWritableProps(&oPtr->classPtr->properties, varc, varv); - BumpGlobalEpoch(interp, oPtr->classPtr); + InstallWritableProps(&classPtr->properties, varc, varv); + BumpGlobalEpoch(interp, classPtr); return TCL_OK; } static int ObjWPropsGet( Index: generic/tclOOInfo.c ================================================================== --- generic/tclOOInfo.c +++ generic/tclOOInfo.c @@ -123,14 +123,16 @@ */ infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); if (infoCmd) { Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); - Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), - Tcl_NewStringObj("::oo::InfoObject", -1)); - Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), - Tcl_NewStringObj("::oo::InfoClass", -1)); + Tcl_DictObjPut(NULL, mapDict, + Tcl_NewStringObj("object", TCL_AUTO_LENGTH), + Tcl_NewStringObj("::oo::InfoObject", TCL_AUTO_LENGTH)); + Tcl_DictObjPut(NULL, mapDict, + Tcl_NewStringObj("class", TCL_AUTO_LENGTH), + Tcl_NewStringObj("::oo::InfoClass", TCL_AUTO_LENGTH)); Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); } } /* @@ -267,11 +269,12 @@ return TCL_ERROR; } procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", -1)); + "definition not available for this kind of method", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } @@ -281,11 +284,11 @@ if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, - Tcl_NewStringObj(localPtr->name, -1)); + Tcl_NewStringObj(localPtr->name, TCL_AUTO_LENGTH)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } @@ -379,11 +382,11 @@ } prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (prefixObj == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "prefix argument list not available for this kind of method", - -1)); + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } @@ -613,11 +616,11 @@ int i, numNames = TclOOGetSortedMethodList(oPtr, NULL, NULL, flag, &names); for (i=0 ; i 0) { Tcl_Free((void *)names); } } else if (oPtr->methodsPtr) { @@ -682,11 +685,12 @@ */ goto unknownMethod; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + mPtr->typePtr->name, TCL_AUTO_LENGTH)); return TCL_OK; } /* * ---------------------------------------------------------------------- @@ -789,12 +793,12 @@ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, - Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + oPtr->namespacePtr->fullName, TCL_AUTO_LENGTH)); return TCL_OK; } /* * ---------------------------------------------------------------------- @@ -946,11 +950,12 @@ return TCL_OK; } procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", -1)); + "definition not available for this kind of method", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", (char *)NULL); return TCL_ERROR; } TclNewObj(resultObjs[0]); @@ -959,11 +964,11 @@ if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, - Tcl_NewStringObj(localPtr->name, -1)); + Tcl_NewStringObj(localPtr->name, TCL_AUTO_LENGTH)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } @@ -1013,11 +1018,12 @@ return TCL_ERROR; } procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", -1)); + "definition not available for this kind of method", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } @@ -1027,11 +1033,11 @@ if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, - Tcl_NewStringObj(localPtr->name, -1)); + Tcl_NewStringObj(localPtr->name, TCL_AUTO_LENGTH)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } @@ -1124,11 +1130,12 @@ return TCL_OK; } procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", -1)); + "definition not available for this kind of method", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr)); @@ -1212,11 +1219,11 @@ } prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (prefixObj == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "prefix argument list not available for this kind of method", - -1)); + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } @@ -1368,11 +1375,11 @@ const char **names; Tcl_Size i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names); for (i=0 ; i 0) { Tcl_Free((void *)names); } } else { @@ -1434,11 +1441,12 @@ * exist. */ goto unknownMethod; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + mPtr->typePtr->name, TCL_AUTO_LENGTH)); return TCL_OK; } /* * ---------------------------------------------------------------------- @@ -1666,11 +1674,11 @@ contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL, NULL); if (contextPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot construct any call chain", -1)); + "cannot construct any call chain", TCL_AUTO_LENGTH)); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOORenderCallChain(interp, contextPtr->callPtr)); TclOODeleteContext(contextPtr); @@ -1711,11 +1719,11 @@ */ callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD); if (callPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot construct any call chain", -1)); + "cannot construct any call chain", TCL_AUTO_LENGTH)); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr)); TclOODeleteChain(callPtr); return TCL_OK; @@ -1869,12 +1877,12 @@ /* * ---------------------------------------------------------------------- * * SortPropList -- * Sort a list of names of properties. Simple support function. Assumes - * that the list Tcl_Obj is unshared and doesn't have a string - * representation. + * that the list Tcl_Obj is unshared, sensible to modify at all (i.e., a + * simple list) and doesn't have a string representation. * * ---------------------------------------------------------------------- */ static int @@ -1893,11 +1901,11 @@ Tcl_Obj *list) { Tcl_Size ec; Tcl_Obj **ev; - Tcl_ListObjGetElements(NULL, list, &ec, &ev); + TclListObjGetElements(NULL, list, &ec, &ev); qsort(ev, ec, sizeof(Tcl_Obj *), PropNameCompare); } /* * Local Variables: Index: generic/tclOOInt.h ================================================================== --- generic/tclOOInt.h +++ generic/tclOOInt.h @@ -45,11 +45,11 @@ const Tcl_MethodType *typePtr; /* The type of method. If NULL, this is a * special flag record which is just used for * the setting of the flags field. */ Tcl_Size refCount; - void *clientData; /* Type-specific data. */ + void *clientData; /* Type-specific data. */ Tcl_Obj *namePtr; /* Name of the method. */ struct Object *declaringObjectPtr; /* The object that declares this method, or * NULL if it was declared by a class. */ struct Class *declaringClassPtr; @@ -97,11 +97,13 @@ GetFrameInfoValueProc *gfivProc; /* Callback to allow for fine tuning of how * the method reports itself. */ } ProcedureMethod; -#define TCLOO_PROCEDURE_METHOD_VERSION 0 +enum ProcedureMethodVersions { + TCLOO_PROCEDURE_METHOD_VERSION = 0 +}; /* * Flags for use in a ProcedureMethod. * * When the USE_DECLARER_NS flag is set, the method will use the namespace of @@ -109,12 +111,13 @@ * such that the implementation of the method came to the particular use) * instead of the namespace of the object on which the method was invoked. * This flag must be distinct from all others that are associated with * methods. */ - -#define USE_DECLARER_NS 0x80 +enum ProcedureMethodFlags { + USE_DECLARER_NS = 0x80 +}; /* * Forwarded methods have the following extra information. */ @@ -207,13 +210,13 @@ Tcl_Size 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; - Tcl_Size creationEpoch; /* Unique value to make comparisons of objects + Tcl_Size creationEpoch; /* Unique value to make comparisons of objects * easier. */ - Tcl_Size epoch; /* Per-object epoch, incremented when the way + Tcl_Size 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 void *values that are the values * of each piece of attached metadata. This @@ -234,40 +237,42 @@ PropertyStorage properties; /* Information relating to the lists of * properties that this object *claims* to * support. */ } Object; -#define OBJECT_DESTRUCTING 1 /* Indicates that an object is being or has - * been destroyed */ -#define DESTRUCTOR_CALLED 2 /* Indicates that evaluation of destructor +enum ObjectFlags { + OBJECT_DESTRUCTING = 1, /* Indicates that an object is being or has + * been destroyed. */ + DESTRUCTOR_CALLED = 2, /* Indicates that evaluation of destructor * script for the object has began */ -#define OO_UNUSED_4 4 /* No longer used. */ -#define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of + // OO_UNUSED_4 = 4, /* No longer used. */ + ROOT_OBJECT = 0x1000, /* Flag to say that this object is the root of * the class hierarchy and should be treated * specially during teardown. */ -#define FILTER_HANDLING 0x2000 /* Flag set when the object is processing a + FILTER_HANDLING = 0x2000, /* Flag set when the object is processing a * filter; when set, filters are *not* * processed on the object, preventing nasty * recursive filtering problems. */ -#define USE_CLASS_CACHE 0x4000 /* Flag set to say that the object is a pure + USE_CLASS_CACHE = 0x4000, /* Flag set to say that the object is a pure * instance of the class, and has had nothing * added that changes the dispatch chain (i.e. * no methods, mixins, or filters. */ -#define ROOT_CLASS 0x8000 /* Flag to say that this object is the root + ROOT_CLASS = 0x8000, /* Flag to say that this object is the root * class of classes, and should be treated * specially during teardown (and in a few * other spots). */ -#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the + FORCE_UNKNOWN = 0x10000, /* States that we are *really* looking up the * unknown method handler at that point. */ -#define DONT_DELETE 0x20000 /* Inhibit deletion of this object. Used + DONT_DELETE = 0x20000, /* Inhibit deletion of this object. Used * during fundamental object type mutation to * make sure that the object actually survives * to the end of the operation. */ -#define HAS_PRIVATE_METHODS 0x40000 + HAS_PRIVATE_METHODS = 0x40000 /* Object/class has (or had) private methods, * and so shouldn't be cached so * aggressively. */ +}; /* * And the definition of a class. Note that every class also has an associated * object, through which it is manipulated. */ @@ -441,22 +446,22 @@ } CallContext; /* * Bits for the 'flags' field of the call chain. */ - -#define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */ -#define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances +enum CallChainFlags { + PUBLIC_METHOD = 0x01, /* This is a public (exported) method. */ + PRIVATE_METHOD = 0x02, /* This is a private (class's direct instances * only) method. Supports itcl. */ -#define OO_UNKNOWN_METHOD 0x04 /* This is an unknown method. */ -#define CONSTRUCTOR 0x08 /* This is a constructor. */ -#define DESTRUCTOR 0x10 /* This is a destructor. */ -#define TRUE_PRIVATE_METHOD 0x20 - /* This is a private method only accessible + OO_UNKNOWN_METHOD = 0x04, /* This is an unknown method. */ + CONSTRUCTOR = 0x08, /* This is a constructor. */ + DESTRUCTOR = 0x10, /* This is a destructor. */ + TRUE_PRIVATE_METHOD = 0x20, /* This is a private method only accessible * from other methods defined on this class * or instance. [TIP #500] */ -#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD) + SCOPE_FLAGS = (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD) +}; /* * Structure containing definition information about basic class methods. */ @@ -516,21 +521,21 @@ MODULE_SCOPE void TclOOAddToInstances(Object *oPtr, Class *clsPtr); MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr); MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr); MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp, Object *useThisObj); -MODULE_SCOPE int TclMethodIsType(Tcl_Method method, - const Tcl_MethodType *typePtr, - void **clientDataPtr); +MODULE_SCOPE int TclMethodIsType(Tcl_Method method, + const Tcl_MethodType *typePtr, + void **clientDataPtr); MODULE_SCOPE Tcl_Method TclNewInstanceMethod(Tcl_Interp *interp, - Tcl_Object object, Tcl_Obj *nameObj, - int flags, const Tcl_MethodType *typePtr, - void *clientData); + Tcl_Object object, Tcl_Obj *nameObj, + int flags, const Tcl_MethodType *typePtr, + void *clientData); MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls, - Tcl_Obj *nameObj, int flags, - const Tcl_MethodType *typePtr, - void *clientData); + Tcl_Obj *nameObj, int flags, + const Tcl_MethodType *typePtr, + void *clientData); MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip, Tcl_Object *objectPtr); Index: generic/tclOOMethod.c ================================================================== --- generic/tclOOMethod.c +++ generic/tclOOMethod.c @@ -202,11 +202,12 @@ * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { if (typePtr->version > TCL_OO_METHOD_VERSION_1) { - Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewInstanceMethod"); + Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", + "Tcl_NewInstanceMethod"); } return TclNewInstanceMethod(NULL, object, nameObj, flags, (const Tcl_MethodType *)typePtr, clientData); } Tcl_Method @@ -224,11 +225,12 @@ * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { if (typePtr->version < TCL_OO_METHOD_VERSION_2) { - Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_NewInstanceMethod2"); + Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", + "Tcl_NewInstanceMethod2"); } return TclNewInstanceMethod(NULL, object, nameObj, flags, (const Tcl_MethodType *)typePtr, clientData); } @@ -314,11 +316,12 @@ * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { if (typePtr->version > TCL_OO_METHOD_VERSION_1) { - Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewMethod"); + Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", + "Tcl_NewMethod"); } return TclNewMethod(NULL, cls, nameObj, flags, typePtr, clientData); } Tcl_Method @@ -335,11 +338,12 @@ * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { if (typePtr->version < TCL_OO_METHOD_VERSION_2) { - Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_NewMethod2"); + Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", + "Tcl_NewMethod2"); } return TclNewMethod(NULL, cls, nameObj, flags, (const Tcl_MethodType *)typePtr, clientData); } /* @@ -534,11 +538,11 @@ * which _must not_ be NULL. */ Tcl_Obj *bodyObj, /* The body of the method, which _must not_ be * NULL. */ const Tcl_MethodType *typePtr, /* The type of the method to create. */ - void *clientData, /* The per-method type-specific data. */ + void *clientData, /* The per-method type-specific data. */ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the * pointer in clientData. */ { @@ -647,11 +651,11 @@ * which _must not_ be NULL. */ Tcl_Obj *bodyObj, /* The body of the method, which _must not_ be * NULL. */ const Tcl_MethodType *typePtr, /* The type of the method to create. */ - void *clientData, /* The per-method type-specific data. */ + void *clientData, /* The per-method type-specific data. */ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the * pointer in clientData. */ { @@ -742,11 +746,11 @@ * ---------------------------------------------------------------------- */ static int InvokeProcedureMethod( - void *clientData, /* Pointer to some per-method context. */ + void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Arguments as actually seen. */ { @@ -1542,11 +1546,11 @@ * ---------------------------------------------------------------------- */ static int InvokeForwardMethod( - void *clientData, /* Pointer to some per-method context. */ + void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Arguments as actually seen. */ { Index: generic/tclObj.c ================================================================== --- generic/tclObj.c +++ generic/tclObj.c @@ -76,30 +76,30 @@ * The structure defined below is used in this file only. */ typedef struct { Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj - * generated by a call to the function - * TclSubstTokens() from a literal text - * where bs+nl sequences occurred in it, if - * any. I.e. this table keeps track of - * invisible and stripped continuation lines. - * Its keys are Tcl_Obj pointers, the values - * are ContLineLoc pointers. See the file - * tclCompile.h for the definition of this - * structure, and for references to all - * related places in the core. */ + * generated by a call to the function + * TclSubstTokens() from a literal text + * where bs+nl sequences occurred in it, if + * any. I.e. this table keeps track of + * invisible and stripped continuation lines. + * Its keys are Tcl_Obj pointers, the values + * are ContLineLoc pointers. See the file + * tclCompile.h for the definition of this + * structure, and for references to all + * related places in the core. */ #if TCL_THREADS && defined(TCL_MEM_DEBUG) Tcl_HashTable *objThreadMap;/* Thread local table that is used to check - * that a Tcl_Obj was not allocated by some - * other thread. */ + * that a Tcl_Obj was not allocated by some + * other thread. */ #endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -static void TclThreadFinalizeContLines(void *clientData); +static void TclThreadFinalizeContLines(void *clientData); static ThreadSpecificData *TclGetContLineTable(void); /* * Nested Tcl_Obj deletion management support * @@ -143,17 +143,17 @@ */ #define ObjDeletionLock(contextPtr) ((contextPtr)->deletionCount++) #define ObjDeletionUnlock(contextPtr) ((contextPtr)->deletionCount--) #define ObjDeletePending(contextPtr) ((contextPtr)->deletionCount > 0) #define ObjOnStack(contextPtr) ((contextPtr)->deletionStack != NULL) -#define PushObjToDelete(contextPtr,objPtr) \ +#define PushObjToDelete(contextPtr,objPtr) \ /* The string rep is already invalidated so we can use the bytes value \ - * for our pointer chain: push onto the head of the stack. */ \ - (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \ + * for our pointer chain: push onto the head of the stack. */ \ + (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \ (contextPtr)->deletionStack = (objPtr) -#define PopObjToDelete(contextPtr,objPtrVar) \ - (objPtrVar) = (contextPtr)->deletionStack; \ +#define PopObjToDelete(contextPtr,objPtrVar) \ + (objPtrVar) = (contextPtr)->deletionStack; \ (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes /* * Macro to set up the local reference to the deletion context. */ @@ -175,19 +175,19 @@ /* * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep */ #define PACK_BIGNUM(bignum, objPtr) \ - if ((bignum).used > 0x7FFF) { \ - mp_int *temp = (mp_int *)Tcl_Alloc(sizeof(mp_int)); \ - *temp = bignum; \ - (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ - (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ + if ((bignum).used > 0x7FFF) { \ + mp_int *temp = (mp_int *)Tcl_Alloc(sizeof(mp_int)); \ + *temp = bignum; \ + (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ + (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ } else if (((bignum).alloc <= 0x7FFF) || (mp_shrink(&(bignum))) == MP_OKAY) { \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (bignum).dp; \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (bignum).dp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \ - | ((bignum).alloc << 15) | ((bignum).used)); \ + | ((bignum).alloc << 15) | ((bignum).used)); \ } /* * Prototypes for functions defined later in this file: */ @@ -576,11 +576,11 @@ Tcl_Free(Tcl_GetHashValue(hPtr)); } clLocPtr->num = num; memcpy(&clLocPtr->loc, loc, num*sizeof(Tcl_Size)); - clLocPtr->loc[num] = CLL_END; /* Sentinel */ + clLocPtr->loc[num] = CLL_END; /* Sentinel */ Tcl_SetHashValue(hPtr, clLocPtr); return clLocPtr; } @@ -636,11 +636,11 @@ * First compute the range of the word within the script. (Is there a * better way which doesn't shimmer?) */ (void)TclGetStringFromObj(objPtr, &length); - end = start + length; /* First char after the word */ + end = start + length; /* First char after the word */ /* * Then compute the table slice covering the range of the word. */ @@ -702,11 +702,11 @@ Tcl_Obj *objPtr, Tcl_Obj *originObjPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr); + Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr); if (hPtr) { ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_GetHashValue(hPtr); TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc); @@ -736,14 +736,14 @@ TclContinuationsGet( Tcl_Obj *objPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); + Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (!hPtr) { - return NULL; + return NULL; } return (ContLineLoc *)Tcl_GetHashValue(hPtr); } /* @@ -1033,13 +1033,13 @@ #ifdef TCL_MEM_DEBUG void TclDbInitNewObj( Tcl_Obj *objPtr, - const char *file, /* The name of the source file calling this + 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 + int line) /* Line number in the source file; used for * debugging. */ { objPtr->refCount = 0; objPtr->typePtr = NULL; TclInitEmptyStringRep(objPtr); @@ -1161,13 +1161,13 @@ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewObj( - const char *file, /* The name of the source file calling this + 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 + int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; /* @@ -1268,11 +1268,11 @@ */ #ifdef TCL_MEM_DEBUG void TclFreeObj( - Tcl_Obj *objPtr) /* The object to be freed. */ + Tcl_Obj *objPtr) /* The object to be freed. */ { const Tcl_ObjType *typePtr = objPtr->typePtr; /* * This macro declares a variable, so must come here... @@ -1378,14 +1378,14 @@ * which we crash (if we where to access the uninitialized hashtable). */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { - hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); + hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } @@ -1393,11 +1393,11 @@ } #else /* TCL_MEM_DEBUG */ void TclFreeObj( - Tcl_Obj *objPtr) /* The object to be freed. */ + Tcl_Obj *objPtr) /* The object to be freed. */ { /* * 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'. @@ -1469,14 +1469,14 @@ * which we crash (if we where to access the uninitialized hashtable). */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { - hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); + hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } @@ -1603,11 +1603,11 @@ */ #undef Tcl_GetString char * Tcl_GetString( - Tcl_Obj *objPtr) /* Object whose string rep byte pointer should + Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be returned. */ { if (objPtr->bytes == NULL) { /* * Note we do not check for objPtr->typePtr == NULL. An invariant @@ -1661,13 +1661,13 @@ #if !defined(TCL_NO_DEPRECATED) #undef TclGetStringFromObj char * TclGetStringFromObj( - Tcl_Obj *objPtr, /* Object whose string rep byte pointer should + Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ - void *lengthPtr) /* If non-NULL, the location where the string + void *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { if (objPtr->bytes == NULL) { /* @@ -1706,11 +1706,11 @@ #endif /* !defined(TCL_NO_DEPRECATED) */ #undef Tcl_GetStringFromObj char * Tcl_GetStringFromObj( - Tcl_Obj *objPtr, /* Object whose string rep byte pointer should + Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ Tcl_Size *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { @@ -1789,11 +1789,11 @@ *---------------------------------------------------------------------- */ char * Tcl_InitStringRep( - Tcl_Obj *objPtr, /* Object whose string rep is to be set */ + Tcl_Obj *objPtr, /* Object whose string rep is to be set */ const char *bytes, size_t numBytes) { assert(objPtr->bytes == NULL || bytes == NULL); @@ -1860,11 +1860,11 @@ *---------------------------------------------------------------------- */ void Tcl_InvalidateStringRep( - Tcl_Obj *objPtr) /* Object whose string rep byte pointer should + Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be freed. */ { TclInvalidateStringRep(objPtr); } @@ -1880,11 +1880,11 @@ *---------------------------------------------------------------------- */ int Tcl_HasStringRep( - Tcl_Obj *objPtr) /* Object to test */ + Tcl_Obj *objPtr) /* Object to test */ { return TclHasStringRep(objPtr); } /* @@ -1972,11 +1972,11 @@ *---------------------------------------------------------------------- */ void Tcl_FreeInternalRep( - Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */ + Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */ { TclFreeInternalRep(objPtr); } /* @@ -1999,14 +1999,14 @@ */ #undef Tcl_GetBoolFromObj int Tcl_GetBoolFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get boolean. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get boolean. */ int flags, - char *charPtr) /* Place to store resulting boolean. */ + char *charPtr) /* Place to store resulting boolean. */ { int result; if ((flags & TCL_NULL_OK) && (objPtr == NULL || Tcl_GetString(objPtr)[0] == '\0')) { result = -1; @@ -2019,11 +2019,12 @@ Tcl_DecrRefCount(objPtr); } return TCL_ERROR; } do { - if (TclHasInternalRep(objPtr, &tclIntType) || TclHasInternalRep(objPtr, &tclBooleanType)) { + if (TclHasInternalRep(objPtr, &tclIntType) + || TclHasInternalRep(objPtr, &tclBooleanType)) { result = (objPtr->internalRep.wideValue != 0); goto boolEnd; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { /* @@ -2069,15 +2070,16 @@ } #undef Tcl_GetBooleanFromObj int Tcl_GetBooleanFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get boolean. */ - int *intPtr) /* Place to store resulting boolean. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get boolean. */ + int *intPtr) /* Place to store resulting boolean. */ { - return Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof(int), (char *)(void *)intPtr); + return Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof(int), + (char *)(void *)intPtr); } /* *---------------------------------------------------------------------- * @@ -2099,11 +2101,11 @@ */ int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { /* * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine * whether a boolean conversion is possible without generating the string * rep. @@ -2145,11 +2147,11 @@ return TCL_ERROR; } static int ParseBoolean( - Tcl_Obj *objPtr) /* The object to parse/convert. */ + Tcl_Obj *objPtr) /* The object to parse/convert. */ { int newBool; char lowerCase[6]; Tcl_Size i, length; const char *str = Tcl_GetStringFromObj(objPtr, &length); @@ -2287,20 +2289,20 @@ #ifdef TCL_MEM_DEBUG #undef Tcl_NewDoubleObj Tcl_Obj * Tcl_NewDoubleObj( - double dblValue) /* Double used to initialize the object. */ + double dblValue) /* Double used to initialize the object. */ { return Tcl_DbNewDoubleObj(dblValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewDoubleObj( - double dblValue) /* Double used to initialize the object. */ + double dblValue) /* Double used to initialize the object. */ { Tcl_Obj *objPtr; TclNewDoubleObj(objPtr, dblValue); return objPtr; @@ -2335,11 +2337,11 @@ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewDoubleObj( - double dblValue, /* Double used to initialize the object. */ + double dblValue, /* Double used to initialize the 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. */ { @@ -2356,11 +2358,11 @@ #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewDoubleObj( - double dblValue, /* Double used to initialize the object. */ + double dblValue, /* Double used to initialize the object. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { return Tcl_NewDoubleObj(dblValue); } @@ -2384,12 +2386,12 @@ *---------------------------------------------------------------------- */ void Tcl_SetDoubleObj( - Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - double dblValue) /* Double used to set the object's value. */ + Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + double dblValue) /* Double used to set the object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj"); } @@ -2416,22 +2418,22 @@ *---------------------------------------------------------------------- */ int Tcl_GetDoubleFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get a double. */ - double *dblPtr) /* Place to store resulting double. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get a double. */ + double *dblPtr) /* Place to store resulting double. */ { do { if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (isnan(objPtr->internalRep.doubleValue)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "floating point value is Not a Number", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", - (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", + (void *)NULL); } return TCL_ERROR; } *dblPtr = (double) objPtr->internalRep.doubleValue; return TCL_OK; @@ -2472,11 +2474,11 @@ */ static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1, NULL, 0); } @@ -2500,11 +2502,11 @@ *---------------------------------------------------------------------- */ static void UpdateStringOfDouble( - Tcl_Obj *objPtr) /* Double obj with string rep to update. */ + Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); TclOOM(dst, TCL_DOUBLE_SPACE + 1); @@ -2541,13 +2543,13 @@ *---------------------------------------------------------------------- */ int Tcl_GetIntFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get a int. */ - int *intPtr) /* Place to store resulting int. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get a int. */ + int *intPtr) /* Place to store resulting int. */ { #if (LONG_MAX == INT_MAX) return TclGetLongFromObj(interp, objPtr, (long *) intPtr); #else long l; @@ -2614,11 +2616,11 @@ *---------------------------------------------------------------------- */ static void UpdateStringOfInt( - Tcl_Obj *objPtr) /* Int object whose string rep to update. */ + 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, @@ -2646,13 +2648,13 @@ *---------------------------------------------------------------------- */ int Tcl_GetLongFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get a long. */ - long *longPtr) /* Place to store resulting long. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get a long. */ + long *longPtr) /* Place to store resulting long. */ { do { #ifdef TCL_WIDE_INT_IS_LONG if (TclHasInternalRep(objPtr, &tclIntType)) { *longPtr = objPtr->internalRep.wideValue; @@ -2678,13 +2680,13 @@ goto tooLarge; } #endif if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclBignumType)) { @@ -2764,23 +2766,21 @@ #ifdef TCL_MEM_DEBUG #undef Tcl_NewWideIntObj Tcl_Obj * Tcl_NewWideIntObj( - Tcl_WideInt wideValue) - /* Wide integer used to initialize the new + Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { return Tcl_DbNewWideIntObj(wideValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewWideIntObj( - Tcl_WideInt wideValue) - /* Wide integer used to initialize the new + Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); @@ -2823,12 +2823,11 @@ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewWideIntObj( - Tcl_WideInt wideValue, - /* Wide integer used to initialize the new + Tcl_WideInt wideValue, /* Wide integer used to initialize the 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. */ @@ -2842,12 +2841,11 @@ #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewWideIntObj( - Tcl_WideInt wideValue, - /* Long integer used to initialize the new + Tcl_WideInt wideValue, /* Long integer used to initialize the new * object. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { return Tcl_NewWideIntObj(wideValue); @@ -2872,13 +2870,12 @@ *---------------------------------------------------------------------- */ void Tcl_SetWideIntObj( - Tcl_Obj *objPtr, /* Object w. internal rep to init. */ - Tcl_WideInt wideValue) - /* Wide integer used to initialize the + Tcl_Obj *objPtr, /* Object w. internal rep to init. */ + Tcl_WideInt wideValue) /* Wide integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj"); } @@ -2907,25 +2904,24 @@ *---------------------------------------------------------------------- */ int Tcl_GetWideIntFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* Object from which to get a wide int. */ - Tcl_WideInt *wideIntPtr) - /* Place to store resulting long. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* Object from which to get a wide int. */ + Tcl_WideInt *wideIntPtr) /* Place to store resulting long. */ { do { if (TclHasInternalRep(objPtr, &tclIntType)) { *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclBignumType)) { @@ -2992,14 +2988,13 @@ *---------------------------------------------------------------------- */ int Tcl_GetWideUIntFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* Object from which to get a wide int. */ - Tcl_WideUInt *wideUIntPtr) - /* Place to store resulting long. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* Object from which to get a wide int. */ + Tcl_WideUInt *wideUIntPtr) /* Place to store resulting long. */ { do { if (TclHasInternalRep(objPtr, &tclIntType)) { if (objPtr->internalRep.wideValue < 0) { wideUIntOutOfRange: @@ -3077,24 +3072,24 @@ *---------------------------------------------------------------------- */ int TclGetWideBitsFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* Object from which to get a wide int. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* Object from which to get a wide int. */ Tcl_WideInt *wideIntPtr) /* Place to store resulting wide integer. */ { do { if (TclHasInternalRep(objPtr, &tclIntType)) { *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclBignumType)) { @@ -3141,13 +3136,13 @@ * *---------------------------------------------------------------------- */ int Tcl_GetSizeIntFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get a int. */ - Tcl_Size *sizePtr) /* Place to store resulting int. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get a int. */ + Tcl_Size *sizePtr) /* Place to store resulting int. */ { if (sizeof(Tcl_Size) == sizeof(int)) { return TclGetIntFromObj(interp, objPtr, (int *)sizePtr); } else { Tcl_WideInt wide; @@ -3412,13 +3407,13 @@ } return TCL_OK; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, @@ -3453,11 +3448,11 @@ int Tcl_GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ - void *bignumValue) /* Returned bignum value. */ + void *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 1, (mp_int *)bignumValue); } /* @@ -3488,11 +3483,11 @@ int Tcl_TakeBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ - void *bignumValue) /* Returned bignum value. */ + void *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 0, (mp_int *)bignumValue); } /* @@ -3513,11 +3508,11 @@ */ void Tcl_SetBignumObj( Tcl_Obj *objPtr, /* Object to set */ - void *big) /* Value to store */ + void *big) /* Value to store */ { Tcl_WideUInt value = 0; size_t numBytes; Tcl_WideUInt scratch; unsigned char *bytes = (unsigned char *) &scratch; @@ -3694,11 +3689,11 @@ */ #undef Tcl_IncrRefCount void Tcl_IncrRefCount( - Tcl_Obj *objPtr) /* The object we are registering a reference to. */ + Tcl_Obj *objPtr) /* The object we are registering a reference to. */ { ++(objPtr)->refCount; } /* @@ -3715,11 +3710,11 @@ */ #undef Tcl_DecrRefCount void Tcl_DecrRefCount( - Tcl_Obj *objPtr) /* The object we are releasing a reference to. */ + Tcl_Obj *objPtr) /* The object we are releasing a reference to. */ { if (objPtr->refCount-- <= 1) { TclFreeObj(objPtr); } } @@ -3737,11 +3732,11 @@ * *---------------------------------------------------------------------- */ void TclUndoRefCount( - Tcl_Obj *objPtr) /* The object we are releasing a reference to. */ + Tcl_Obj *objPtr) /* The object we are releasing a reference to. */ { if (objPtr->refCount > 0) { --objPtr->refCount; } } @@ -3760,11 +3755,11 @@ */ #undef Tcl_IsShared int Tcl_IsShared( - Tcl_Obj *objPtr) /* The object to test for being shared. */ + Tcl_Obj *objPtr) /* The object to test for being shared. */ { return ((objPtr)->refCount > 1); } /* @@ -3789,11 +3784,11 @@ */ #ifdef TCL_MEM_DEBUG void Tcl_DbIncrRefCount( - Tcl_Obj *objPtr, /* The object we are registering a reference + Tcl_Obj *objPtr, /* The object we are registering a reference * to. */ 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. */ @@ -3820,20 +3815,20 @@ Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", - "incr ref count"); + "incr ref count"); } } # endif /* TCL_THREADS */ ++(objPtr)->refCount; } #else /* !TCL_MEM_DEBUG */ void Tcl_DbIncrRefCount( - Tcl_Obj *objPtr, /* The object we are registering a reference + Tcl_Obj *objPtr, /* The object we are registering a reference * to. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { ++(objPtr)->refCount; @@ -3862,11 +3857,11 @@ */ #ifdef TCL_MEM_DEBUG void Tcl_DbDecrRefCount( - Tcl_Obj *objPtr, /* The object we are releasing a reference + Tcl_Obj *objPtr, /* The object we are releasing a reference * to. */ 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. */ @@ -3893,11 +3888,11 @@ Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", - "decr ref count"); + "decr ref count"); } } # endif /* TCL_THREADS */ if (objPtr->refCount-- <= 1) { @@ -3905,11 +3900,11 @@ } } #else /* !TCL_MEM_DEBUG */ void Tcl_DbDecrRefCount( - Tcl_Obj *objPtr, /* The object we are releasing a reference + Tcl_Obj *objPtr, /* The object we are releasing a reference * to. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { if (objPtr->refCount-- <= 1) { @@ -3939,11 +3934,11 @@ *---------------------------------------------------------------------- */ int Tcl_DbIsShared( - Tcl_Obj *objPtr, /* The object to test for being shared. */ + Tcl_Obj *objPtr, /* The object to test for being shared. */ #ifdef TCL_MEM_DEBUG 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. */ @@ -3975,11 +3970,11 @@ Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", - "check shared status"); + "check shared status"); } } # endif /* TCL_THREADS */ #endif /* TCL_MEM_DEBUG */ @@ -4016,12 +4011,11 @@ *---------------------------------------------------------------------- */ void Tcl_InitObjHashTable( - Tcl_HashTable *tablePtr) - /* Pointer to table record, which is supplied + Tcl_HashTable *tablePtr) /* Pointer to table record, which is supplied * by the caller. */ { Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS, &tclObjHashKeyType); } @@ -4086,13 +4080,13 @@ /* * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller - if (objPtr1 == objPtr2) { - return 1; - } + if (objPtr1 == objPtr2) { + return 1; + } */ /* * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being * in a register. @@ -4239,11 +4233,11 @@ Tcl_Command Tcl_GetCommandFromObj( Tcl_Interp *interp, /* The interpreter in which to resolve the * command and to report errors. */ - Tcl_Obj *objPtr) /* The object containing the command's name. + Tcl_Obj *objPtr) /* The object containing the command's name. * If the name starts with "::", will be * looked up in global namespace. Else, looked * up first in the current namespace, then in * global namespace. */ { @@ -4268,35 +4262,35 @@ * to discard the old rep and create a new one. */ resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (TclHasInternalRep(objPtr, &tclCmdNameType)) { - Command *cmdPtr = resPtr->cmdPtr; - - if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) - && (interp == cmdPtr->nsPtr->interp) - && !(cmdPtr->nsPtr->flags & NS_DYING)) { - Namespace *refNsPtr = (Namespace *) - TclGetCurrentNamespace(interp); - - if ((resPtr->refNsPtr == NULL) + Command *cmdPtr = resPtr->cmdPtr; + + if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) + && (interp == cmdPtr->nsPtr->interp) + && !(cmdPtr->nsPtr->flags & NS_DYING)) { + Namespace *refNsPtr = (Namespace *) + TclGetCurrentNamespace(interp); + + if ((resPtr->refNsPtr == NULL) || ((refNsPtr == resPtr->refNsPtr) - && (resPtr->refNsId == refNsPtr->nsId) - && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { - return (Tcl_Command) cmdPtr; - } - } + && (resPtr->refNsId == refNsPtr->nsId) + && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { + return (Tcl_Command) cmdPtr; + } + } } /* * OK, must create a new internal representation (or fail) as any cache we * had is invalid one way or another. */ /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */ if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) { - return NULL; + return NULL; } resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL); } @@ -4375,11 +4369,11 @@ void TclSetCmdNameObj( Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ - Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a + Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a * CmdName object. */ Command *cmdPtr) /* Points to Command structure that the * CmdName object should refer to. */ { ResolvedCmdName *resPtr; @@ -4415,11 +4409,11 @@ *---------------------------------------------------------------------- */ static void FreeCmdNameInternalRep( - Tcl_Obj *objPtr) /* CmdName object with internal + Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; /* @@ -4463,11 +4457,11 @@ */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; @@ -4497,11 +4491,11 @@ */ static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *name; Command *cmdPtr; ResolvedCmdName *resPtr; @@ -4601,13 +4595,13 @@ (void *) objv[1]->internalRep.twoPtrValue.ptr2); } } if (objv[1]->bytes) { - Tcl_AppendToObj(descObj, ", string representation \"", -1); + Tcl_AppendToObj(descObj, ", string representation \"", -1); Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length, - 16, "..."); + 16, "..."); Tcl_AppendToObj(descObj, "\"", -1); } else { Tcl_AppendToObj(descObj, ", no string representation", -1); } Index: generic/tclPanic.c ================================================================== --- generic/tclPanic.c +++ generic/tclPanic.c @@ -78,11 +78,10 @@ { 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 *); Index: generic/tclParse.c ================================================================== --- generic/tclParse.c +++ generic/tclParse.c @@ -38,11 +38,10 @@ * TYPE_CLOSE_BRACK - Character is a right square bracket. * TYPE_BRACE - Character is a curly brace (either left or right). */ const unsigned char tclCharTypeTable[] = { - /* * Positive character values, from 0-127: */ TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, @@ -203,12 +202,11 @@ * 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. */ - Tcl_Parse *parsePtr) - /* Structure to fill in with information about + Tcl_Parse *parsePtr) /* Structure to fill in with information about * the parsed command; any previous * information in the structure is ignored. */ { const char *src; /* Points to current character in the * command. */ @@ -1037,11 +1035,11 @@ *---------------------------------------------------------------------- */ static int ParseTokens( - const char *src, /* First character to parse. */ + const char *src, /* First character to parse. */ Tcl_Size 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 * mask. */ @@ -1394,11 +1392,11 @@ switch (ch) { case '{': braceCount++; break; case '}': braceCount--; break; case '\\': /* if 2 or more left, consume 2, else consume - just the \ and let it run into the end */ + * just the \ and let it run into the end */ if (numBytes > 1) { src++; numBytes--; } } numBytes--; @@ -1529,11 +1527,11 @@ */ const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ - const char *start, /* Start of variable substitution. First + const char *start, /* Start of variable substitution. First * character must be "$". */ const char **termPtr) /* If non-NULL, points to word to fill in with * character just after last one in the * variable specifier. */ { @@ -1617,12 +1615,11 @@ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ Tcl_Size 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 + Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ @@ -1818,12 +1815,11 @@ const char *start, /* Start of the quoted string. The first * character must be '"'. */ Tcl_Size 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 + Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ Index: generic/tclParse.h ================================================================== --- generic/tclParse.h +++ generic/tclParse.h @@ -1,19 +1,21 @@ /* * Minimal set of shared macro definitions and declarations so that multiple * source files can make use of the parsing table in tclParse.c */ - -#define TYPE_NORMAL 0 -#define TYPE_SPACE 0x1 -#define TYPE_COMMAND_END 0x2 -#define TYPE_SUBS 0x4 -#define TYPE_QUOTE 0x8 -#define TYPE_CLOSE_PAREN 0x10 -#define TYPE_CLOSE_BRACK 0x20 -#define TYPE_BRACE 0x40 -#define TYPE_OPEN_PAREN 0x80 -#define TYPE_BAD_ARRAY_INDEX (TYPE_OPEN_PAREN|TYPE_CLOSE_PAREN|TYPE_QUOTE|TYPE_BRACE) +enum TclParseTypes { + TYPE_NORMAL = 0, + TYPE_SPACE = 0x1, + TYPE_COMMAND_END = 0x2, + TYPE_SUBS = 0x4, + TYPE_QUOTE = 0x8, + TYPE_CLOSE_PAREN = 0x10, + TYPE_CLOSE_BRACK = 0x20, + TYPE_BRACE = 0x40, + TYPE_OPEN_PAREN = 0x80, + TYPE_BAD_ARRAY_INDEX = ( + TYPE_OPEN_PAREN | TYPE_CLOSE_PAREN | TYPE_QUOTE | TYPE_BRACE) +}; #define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)] MODULE_SCOPE const unsigned char tclCharTypeTable[]; Index: generic/tclPathObj.c ================================================================== --- generic/tclPathObj.c +++ generic/tclPathObj.c @@ -38,15 +38,15 @@ * Define the 'path' object type, which Tcl uses to represent file paths * internally. */ static const Tcl_ObjType fsPathType = { - "path", /* name */ - FreeFsPathInternalRep, /* freeIntRepProc */ - DupFsPathInternalRep, /* dupIntRepProc */ - UpdateStringOfFsPath, /* updateStringProc */ - SetFsPathFromAny, /* setFromAnyProc */ + "path", /* name */ + FreeFsPathInternalRep, /* freeIntRepProc */ + DupFsPathInternalRep, /* dupIntRepProc */ + UpdateStringOfFsPath, /* updateStringProc */ + SetFsPathFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; /* * struct FsPath -- @@ -53,21 +53,21 @@ * * Internal representation of a Tcl_Obj of fsPathType */ typedef struct { - Tcl_Obj *translatedPathPtr; /* If the path has been normalized (flags == - * 0), this is NULL. Otherwise it is a path - * in which any ~user sequences have been - * translated away. */ - Tcl_Obj *normPathPtr; /* If the path has been normalized (flags == - * 0), this is an absolute path without ., .. - * or ~user components. Otherwise it is a - * path, possibly absolute, to normalize - * relative to cwdPtr. */ - Tcl_Obj *cwdPtr; /* If NULL, either translatedPtr exists or - * normPathPtr exists and is absolute. */ + Tcl_Obj *translatedPathPtr; /* If the path has been normalized (flags == + * 0), this is NULL. Otherwise it is a path + * in which any ~user sequences have been + * translated away. */ + Tcl_Obj *normPathPtr; /* If the path has been normalized (flags == + * 0), this is an absolute path without ., .. + * or ~user components. Otherwise it is a + * path, possibly absolute, to normalize + * relative to cwdPtr. */ + Tcl_Obj *cwdPtr; /* If NULL, either translatedPtr exists or + * normPathPtr exists and is absolute. */ int flags; /* Flags to describe interpretation - see * below. */ void *nativePathPtr; /* Native representation of this path, which * is filesystem dependent. */ size_t filesystemEpoch; /* Used to ensure the path representation was @@ -87,18 +87,19 @@ /* * Define some macros to give us convenient access to path-object specific * fields. */ -#define PATHOBJ(pathPtr) ((FsPath *) (TclFetchInternalRep((pathPtr), &fsPathType)->twoPtrValue.ptr1)) -#define SETPATHOBJ(pathPtr,fsPathPtr) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \ - ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((pathPtr), &fsPathType, &ir); \ - } while (0) +#define PATHOBJ(pathPtr) \ + ((FsPath *) (TclFetchInternalRep((pathPtr), &fsPathType)->twoPtrValue.ptr1)) +#define SETPATHOBJ(pathPtr, fsPathPtr) \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreInternalRep((pathPtr), &fsPathType, &ir); \ + } while (0) #define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags) /* *--------------------------------------------------------------------------- * @@ -153,27 +154,27 @@ * NOTE: file normalization for zipfs is very specific to * format of zipfs volume being of the form //xxx:/ */ dirSep += zipVolumeLen-1; /* Start parse after : */ } else if (tclPlatform == TCL_PLATFORM_WINDOWS) { - if ( (dirSep[0] == '/' || dirSep[0] == '\\') - && (dirSep[1] == '/' || dirSep[1] == '\\') - && (dirSep[2] == '?') - && (dirSep[3] == '/' || dirSep[3] == '\\')) { + if ((dirSep[0] == '/' || dirSep[0] == '\\') + && (dirSep[1] == '/' || dirSep[1] == '\\') + && (dirSep[2] == '?') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { /* NT extended path */ dirSep += 4; - if ( (dirSep[0] == 'U' || dirSep[0] == 'u') - && (dirSep[1] == 'N' || dirSep[1] == 'n') - && (dirSep[2] == 'C' || dirSep[2] == 'c') - && (dirSep[3] == '/' || dirSep[3] == '\\')) { + if ((dirSep[0] == 'U' || dirSep[0] == 'u') + && (dirSep[1] == 'N' || dirSep[1] == 'n') + && (dirSep[2] == 'C' || dirSep[2] == 'c') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { /* NT extended UNC path */ dirSep += 4; } } - if (dirSep[0] != 0 && dirSep[1] == ':' && - (dirSep[2] == '/' || dirSep[2] == '\\')) { + if (dirSep[0] != 0 && dirSep[1] == ':' + && (dirSep[2] == '/' || dirSep[2] == '\\')) { /* Do nothing */ } else if ((dirSep[0] == '/' || dirSep[0] == '\\') && (dirSep[1] == '/' || dirSep[1] == '\\')) { /* * UNC style path, where we must skip over the first separator, @@ -402,10 +403,11 @@ */ if (zipVolumeLen || (tclPlatform == TCL_PLATFORM_WINDOWS)) { int needTrailingSlash = 0; Tcl_Size len; const char *path = TclGetStringFromObj(retVal, &len); + if (zipVolumeLen) { if (len == (zipVolumeLen - 1)) { needTrailingSlash = 1; } } else { @@ -724,11 +726,11 @@ */ splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); Tcl_IncrRefCount(splitPtr); - if (portion == TCL_PATH_TAIL) { + if (portion == TCL_PATH_TAIL) { /* * Return the last component, unless it is the only component, and * it is the root of an absolute path. */ @@ -878,14 +880,13 @@ /* if forceRelative - second path is relative */ type = forceRelative ? TCL_PATH_RELATIVE : TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { - const char *str; Tcl_Size len; + const char *str = TclGetStringFromObj(tailObj, &len); - str = TclGetStringFromObj(tailObj, &len); if (len == 0) { /* * This happens if we try to handle the root volume '/'. * There's no need to return a special path object, when * the base itself is just fine! @@ -911,11 +912,10 @@ * cannot have backslashes either. */ if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (strchr(TclGetString(elt), '\\') == NULL)) { - if (PATHFLAGS(elt)) { return TclNewFSPathObj(elt, str, len); } if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) { return TclNewFSPathObj(elt, str, len); @@ -1052,12 +1052,12 @@ if (res == NULL) { TclNewObj(res); } ptr = TclGetStringFromObj(res, &length); - /* - * A NULL value for fsPtr at this stage basically means we're trying + /* + * A NULL value for fsPtr at this stage basically means we're trying * to join a relative path onto something which is also relative (or * empty). There's nothing particularly wrong with that. */ if (*strElt == '\0') { @@ -1517,11 +1517,10 @@ void *clientData) { Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; - if (fromFilesystem->internalToNormalizedProc != NULL) { pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); } if (pathPtr == NULL) { return NULL; @@ -1808,13 +1807,11 @@ return NULL; } fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { Tcl_Size cwdLen; - Tcl_Obj *copy; - - copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); + Tcl_Obj *copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); cwdLen += (TclGetString(copy)[cwdLen] == '/'); /* @@ -2005,14 +2002,13 @@ } return NULL; } if (srcFsPathPtr->nativePathPtr == NULL) { - Tcl_FSCreateInternalRepProc *proc; char *nativePathPtr; - - proc = srcFsPathPtr->fsPtr->createInternalRepProc; + Tcl_FSCreateInternalRepProc *proc = + srcFsPathPtr->fsPtr->createInternalRepProc; if (proc == NULL) { return NULL; } nativePathPtr = (char *)proc(pathPtr); @@ -2346,11 +2342,11 @@ *--------------------------------------------------------------------------- */ static void UpdateStringOfFsPath( - Tcl_Obj *pathPtr) /* path obj with string rep to update. */ + Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); Tcl_Size cwdLen; Tcl_Obj *copy; @@ -2468,47 +2464,47 @@ * *---------------------------------------------------------------------- */ int MakeTildeRelativePath( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ - const char *user, /* User name. NULL -> current user */ - const char *subPath, /* Rest of path. May be NULL */ - Tcl_DString *dsPtr) /* Output. Is initialized by the function. Must be - * freed on success */ + Tcl_Interp *interp, /* May be NULL. Only used for error messages */ + const char *user, /* User name. NULL -> current user */ + const char *subPath, /* Rest of path. May be NULL */ + Tcl_DString *dsPtr) /* Output. Is initialized by the function. Must be + * freed on success */ { const char *dir; Tcl_DString dirString; Tcl_DStringInit(dsPtr); Tcl_DStringInit(&dirString); if (user == NULL || user[0] == 0) { - /* No user name specified -> current user */ + /* No user name specified -> current user */ dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment variable to expand path", + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find HOME environment variable to expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", - "HOMELESS", (void *)NULL); - } - return TCL_ERROR; - } + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", + "HOMELESS", (void *)NULL); + } + return TCL_ERROR; + } } else { - /* User name specified - ~user */ + /* User name specified - ~user */ dir = TclpGetUserHome(user, &dirString); if (dir == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", user)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", - (void *)NULL); - } - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "user \"%s\" doesn't exist", user)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", + (void *)NULL); + } + return TCL_ERROR; } } if (subPath) { const char *parts[2]; parts[0] = dir; @@ -2536,12 +2532,12 @@ * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetHomeDirObj( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ - const char *user) /* User name. NULL -> current user */ + Tcl_Interp *interp, /* May be NULL. Only used for error messages */ + const char *user) /* User name. NULL -> current user */ { Tcl_DString dirString; if (MakeTildeRelativePath(interp, user, NULL, &dirString) != TCL_OK) { return NULL; @@ -2568,11 +2564,11 @@ * *---------------------------------------------------------------------- */ Tcl_Obj * TclResolveTildePath( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ + Tcl_Interp *interp, /* May be NULL. Only used for error messages */ Tcl_Obj *pathObj) { const char *path; Tcl_Size len; Tcl_Size split; @@ -2590,23 +2586,23 @@ * in addition to what is passed. */ split = FindSplitPos(path, '/'); if (split == 1) { - /* No user name specified -> current user */ + /* No user name specified -> current user */ if (MakeTildeRelativePath(interp, NULL, path[1] ? 2 + path : NULL, &resolvedPath) != TCL_OK) { return NULL; } } else { - /* User name specified - ~user */ - const char *expandedUser; - Tcl_DString userName; + /* User name specified - ~user */ + const char *expandedUser; + Tcl_DString userName; - Tcl_DStringInit(&userName); - Tcl_DStringAppend(&userName, path+1, split-1); - expandedUser = Tcl_DStringValue(&userName); + Tcl_DStringInit(&userName); + Tcl_DStringAppend(&userName, path+1, split-1); + expandedUser = Tcl_DStringValue(&userName); /* path[split] is / or \0 */ if (MakeTildeRelativePath(interp, expandedUser, path[split] ? &path[split+1] : NULL, &resolvedPath) != TCL_OK) { @@ -2652,33 +2648,35 @@ Tcl_Size i; Tcl_Obj *resolvedPaths; const char *path; if (pathsObj == NULL) { - return NULL; + return NULL; } if (Tcl_ListObjGetElements(NULL, pathsObj, &objc, &objv) != TCL_OK) { - return NULL; /* Not a list */ + return NULL; /* Not a list */ } /* * Figure out if any paths need resolving to avoid unnecessary allocations. */ + for (i = 0; i < objc; ++i) { - path = Tcl_GetString(objv[i]); - if (path[0] == '~') { - break; /* At least one path needs resolution */ - } + path = Tcl_GetString(objv[i]); + if (path[0] == '~') { + break; /* At least one path needs resolution */ + } } if (i == objc) { - return pathsObj; /* No paths needed to be resolved */ + return pathsObj; /* No paths needed to be resolved */ } resolvedPaths = Tcl_NewListObj(objc, NULL); for (i = 0; i < objc; ++i) { Tcl_Obj *resolvedPath; - path = Tcl_GetString(objv[i]); + + path = Tcl_GetString(objv[i]); if (path[0] == 0) { continue; /* Skip empty strings */ } resolvedPath = TclResolveTildePath(NULL, objv[i]); if (resolvedPath) { @@ -2687,14 +2685,13 @@ } } return resolvedPaths; } - /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclPipe.c ================================================================== --- generic/tclPipe.c +++ generic/tclPipe.c @@ -192,11 +192,10 @@ detPtr->pid = pidPtr[i]; detPtr->nextPtr = detList; detList = detPtr; } Tcl_MutexUnlock(&pipeMutex); - } /* *---------------------------------------------------------------------- * @@ -1019,11 +1018,11 @@ Tcl_Channel Tcl_OpenCommandChannel( Tcl_Interp *interp, /* Interpreter for error reporting. Can NOT be * NULL. */ - Tcl_Size argc, /* How many arguments. */ + Tcl_Size argc, /* How many arguments. */ const char **argv, /* Array of arguments for command pipe. */ int flags) /* Or'ed combination of TCL_STDIN, TCL_STDOUT, * TCL_STDERR, and TCL_ENFORCE_MODE. */ { TclFile *inPipePtr, *outPipePtr, *errFilePtr; Index: generic/tclPkgConfig.c ================================================================== --- generic/tclPkgConfig.c +++ generic/tclPkgConfig.c @@ -20,11 +20,11 @@ * - TCL_MEM_DEBUG OSCMa memory debugging. * - TCL_COMPILE_DEBUG OSCMa debugging of bytecode compiler. * - TCL_COMPILE_STATS OSCMa bytecode compiler statistics. * * - TCL_CFG_DO64BIT NSCMdt tcl is compiled for a 64bit system. - * - NDEBUG NSCMdt tcl is compiled with symbol info off. + * - NDEBUG NSCMdt tcl is compiled with symbol info off. * - TCL_CFG_OPTIMIZED NSCMdt tcl is compiled with cc optimizations on * - TCL_CFG_PROFILED NSCMdt tcl is compiled with profiling info. * * - CFG_RUNTIME_* Paths to various stuff at runtime. * - CFG_INSTALL_* Paths to various stuff at installation time. Index: generic/tclPreserve.c ================================================================== --- generic/tclPreserve.c +++ generic/tclPreserve.c @@ -19,11 +19,11 @@ * calls that are still in effect. It grows as needed to accommodate any * number of calls in effect. */ typedef struct { - void *clientData; /* Address of preserved block. */ + void *clientData; /* Address of preserved block. */ size_t refCount; /* Number of Tcl_Preserve calls in effect for * block. */ int mustFree; /* Non-zero means Tcl_EventuallyFree was * called while a Tcl_Preserve call was in * effect, so the structure must be freed when @@ -34,14 +34,15 @@ /* * Global data structures used to hold the list of preserved data references. * These variables are protected by "preserveMutex". */ -static Reference *refArray = NULL; /* First in array of references. */ +static Reference *refArray = NULL; + /* First in array of references. */ static size_t spaceAvl = 0; /* Total number of structures available at * *firstRefPtr. */ -static size_t 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 */ #define INITIAL_SIZE 2 /* Initial number of reference slots to make */ @@ -115,11 +116,11 @@ *---------------------------------------------------------------------- */ void Tcl_Preserve( - void *clientData) /* Pointer to malloc'ed block of memory. */ + void *clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; size_t i; /* @@ -178,11 +179,11 @@ *---------------------------------------------------------------------- */ void Tcl_Release( - void *clientData) /* Pointer to malloc'ed block of memory. */ + void *clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; size_t i; Tcl_MutexLock(&preserveMutex); @@ -257,11 +258,11 @@ *---------------------------------------------------------------------- */ void Tcl_EventuallyFree( - void *clientData, /* Pointer to malloc'ed block of memory. */ + void *clientData, /* Pointer to malloc'ed block of memory. */ Tcl_FreeProc *freeProc) /* Function to actually do free. */ { Reference *refPtr; size_t i; Index: generic/tclProc.c ================================================================== --- generic/tclProc.c +++ generic/tclProc.c @@ -67,24 +67,24 @@ NULL, /* SetFromAny function; Tcl_ConvertToType * should panic instead. */ TCL_OBJTYPE_V0 }; -#define ProcSetInternalRep(objPtr, procPtr) \ +#define ProcSetInternalRep(objPtr, procPtr) \ do { \ Tcl_ObjInternalRep ir; \ (procPtr)->refCount++; \ ir.twoPtrValue.ptr1 = (procPtr); \ ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreInternalRep((objPtr), &tclProcBodyType, &ir); \ } while (0) -#define ProcGetInternalRep(objPtr, procPtr) \ +#define ProcGetInternalRep(objPtr, procPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \ - (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * The [upvar]/[uplevel] level reference type. Uses the wideValue field * to remember the integer value of a parsed # format. @@ -114,25 +114,25 @@ NULL, /* updateStringProc */ SetLambdaFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; -#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ +#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (procPtr); \ ir.twoPtrValue.ptr2 = (nsObjPtr); \ Tcl_IncrRefCount((nsObjPtr)); \ - Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \ + Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \ } while (0) -#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \ +#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &lambdaType); \ - (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ - (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &lambdaType); \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) /* *---------------------------------------------------------------------- @@ -154,11 +154,11 @@ #undef TclObjInterpProc int Tcl_ProcObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; Proc *procPtr; const char *procName; @@ -901,11 +901,10 @@ TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; int result; CallFrame *savedVarFramePtr, *framePtr; @@ -969,11 +968,10 @@ * TIP #280. Make actual argument location available to eval'd script */ TclArgumentGet(interp, objv[0], &invoker, &word); objPtr = objv[0]; - } else { /* * More than one argument: concatenate them together with spaces * between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. @@ -1075,25 +1073,25 @@ * Build up desired argument list for Tcl_WrongNumArgs */ numArgs = framePtr->procPtr->numArgs; desiredObjs = (Tcl_Obj **)TclStackAlloc(interp, - sizeof(Tcl_Obj *) * (numArgs+1)); + sizeof(Tcl_Obj *) * (numArgs + 1)); if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { - desiredObjs[0] = framePtr->objv[skip-1]; + desiredObjs[0] = framePtr->objv[skip - 1]; } Tcl_IncrRefCount(desiredObjs[0]); if (localCt > 0) { Var *defPtr = (Var *)(&framePtr->localCachePtr->varName0 + localCt); for (i=1 ; i<=numArgs ; i++, defPtr++) { Tcl_Obj *argObj; - Tcl_Obj *namePtr = localName(framePtr, i-1); + Tcl_Obj *namePtr = localName(framePtr, i - 1); if (defPtr->value.objPtr != NULL) { TclNewObj(argObj); Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", (void *)NULL); } else if (defPtr->flags & VAR_IS_ARGS) { @@ -1337,11 +1335,11 @@ *---------------------------------------------------------------------- */ static int InitArgsAndLocals( - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ int skip) /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; @@ -1501,13 +1499,13 @@ *---------------------------------------------------------------------- */ int TclPushProcCallFrame( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ Tcl_Size objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[], /* Argument value objects. */ int isLambda) /* 1 if this is a call by ApplyObjCmd: it @@ -1595,13 +1593,13 @@ *---------------------------------------------------------------------- */ int TclObjInterpProc( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1612,15 +1610,15 @@ return Tcl_NRCallObjProc(interp, NRInterpProc, clientData, objc, objv); } int TclNRInterpProc( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - Tcl_Size objc, /* Count of number of arguments to this + Tcl_Size objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { int result = TclPushProcCallFrame(clientData, interp, objc, objv, /*isLambda*/ 0); @@ -1635,11 +1633,11 @@ NRInterpProc( void *clientData, /* Record describing procedure to be * interpreted. */ Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - int objc, /* Count of number of arguments to this + int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { int result = TclPushProcCallFrame(clientData, interp, objc, objv, /*isLambda*/ 0); @@ -1686,14 +1684,14 @@ *---------------------------------------------------------------------- */ int TclNRInterpProcCore( - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ - Tcl_Size skip, /* Number of initial arguments to be skipped, + Tcl_Size skip, /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ ProcErrorProc *errorProc) /* How to convert results from the script into * results of the overall procedure. */ { Interp *iPtr = (Interp *) interp; @@ -2107,11 +2105,11 @@ *---------------------------------------------------------------------- */ void TclProcDeleteProc( - void *clientData) /* Procedure to be deleted. */ + void *clientData) /* Procedure to be deleted. */ { Proc *procPtr = (Proc *)clientData; if (procPtr->refCount-- <= 1) { TclProcCleanupProc(procPtr); @@ -2135,11 +2133,11 @@ *---------------------------------------------------------------------- */ void TclProcCleanupProc( - Proc *procPtr) /* Procedure to be deleted. */ + Proc *procPtr) /* Procedure to be deleted. */ { CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; @@ -2400,11 +2398,11 @@ */ static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; LambdaGetInternalRep(srcPtr, procPtr, nsObjPtr); @@ -2415,11 +2413,11 @@ LambdaSetInternalRep(copyPtr, procPtr, nsObjPtr); } static void FreeLambdaInternalRep( - Tcl_Obj *objPtr) /* CmdName object with internal representation + Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; @@ -2433,11 +2431,11 @@ } static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv; int isNew, result; @@ -2532,11 +2530,10 @@ * We created a new reference to the source file path name when we * created 'context' above. Account for the reference. */ Tcl_IncrRefCount(contextPtr->data.eval.path); - } if (contextPtr->type == TCL_LOCATION_SOURCE) { /* * We can record source location within a lambda only if the body Index: generic/tclProcess.c ================================================================== --- generic/tclProcess.c +++ generic/tclProcess.c @@ -348,11 +348,10 @@ } return TCL_PROCESS_UNKNOWN_STATUS; } } - /* *---------------------------------------------------------------------- * * BuildProcessStatusObj -- * @@ -513,12 +512,12 @@ return TCL_ERROR; } if (objc == 1) { /* - * Return a dict with all child process statuses. - */ + * Return a dict with all child process statuses. + */ dict = Tcl_NewDictObj(); Tcl_MutexLock(&infoTablesMutex); for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { @@ -718,11 +717,10 @@ TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - if (objc != 1 && objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "?flag?"); return TCL_ERROR; } @@ -889,12 +887,11 @@ int *codePtr, /* If non-NULL, will receive either: * - 0 for normal exit. * - errno in case of error. * - non-zero exit code for abormal exit. * - signal number if killed or suspended. - * - Tcl_WaitPid status in all other cases. - */ + * - Tcl_WaitPid status in all other cases. */ Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */ Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */ { Tcl_HashEntry *entry; ProcessInfo *info; Index: generic/tclRegexp.c ================================================================== --- generic/tclRegexp.c +++ generic/tclRegexp.c @@ -62,11 +62,13 @@ /* * Thread local storage used to maintain a per-thread cache of compiled * regular expressions. */ -#define NUM_REGEXPS 30 +#ifndef NUM_REGEXPS +#define NUM_REGEXPS 30 /* Size of per-thread RE cache. */ +#endif typedef struct { int initialized; /* Set to 1 when the module is initialized. */ char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular * expression patterns. NULL means that this @@ -101,32 +103,32 @@ * The regular expression Tcl object type. This serves as a cache of the * compiled form of the regular expression. */ const Tcl_ObjType tclRegexpType = { - "regexp", /* name */ - FreeRegexpInternalRep, /* freeIntRepProc */ - DupRegexpInternalRep, /* dupIntRepProc */ - NULL, /* updateStringProc */ - SetRegexpFromAny, /* setFromAnyProc */ + "regexp", /* name */ + FreeRegexpInternalRep, /* freeIntRepProc */ + DupRegexpInternalRep, /* dupIntRepProc */ + NULL, /* updateStringProc */ + SetRegexpFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; -#define RegexpSetInternalRep(objPtr, rePtr) \ +#define RegexpSetInternalRep(objPtr, rePtr) \ do { \ Tcl_ObjInternalRep ir; \ (rePtr)->refCount++; \ ir.twoPtrValue.ptr1 = (rePtr); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \ + Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \ } while (0) -#define RegexpGetInternalRep(objPtr, rePtr) \ +#define RegexpGetInternalRep(objPtr, rePtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &tclRegexpType); \ - (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ + (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* *---------------------------------------------------------------------- @@ -304,11 +306,11 @@ Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tcl_RegExp re, /* Compiled regular expression; returned by a * previous call to Tcl_GetRegExpFromObj */ const Tcl_UniChar *wString, /* String against which to match re. */ size_t numChars, /* Length of Tcl_UniChar string. */ - size_t nm, /* How many subexpression matches (counting + 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. */ { int status; @@ -365,13 +367,13 @@ * passed to Tcl_RegExpExec. */ Tcl_Size 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. */ - Tcl_Size *startPtr, /* Store address of first character in + Tcl_Size *startPtr, /* Store address of first character in * (sub-)range here. */ - Tcl_Size *endPtr) /* Store address of character just after last + Tcl_Size *endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; if ((regexpPtr->flags®_EXPECT) && (index == -1)) { @@ -443,11 +445,11 @@ * returned by previous call to * Tcl_GetRegExpFromObj. */ Tcl_Obj *textObj, /* Text against which to match re. */ Tcl_Size offset, /* Character index that marks where matching * should begin. */ - Tcl_Size nmatches, /* How many subexpression matches (counting + Tcl_Size 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; @@ -857,11 +859,11 @@ static TclRegexp * CompileRegexp( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ const char *string, /* The regexp to compile (UTF-8). */ - size_t length, /* The length of the string in bytes. */ + size_t length, /* The length of the string in bytes. */ int flags) /* Compilation flags. */ { TclRegexp *regexpPtr; const Tcl_UniChar *uniString; int numChars, status, i, exact; Index: generic/tclResult.c ================================================================== --- generic/tclResult.c +++ generic/tclResult.c @@ -386,11 +386,11 @@ *---------------------------------------------------------------------- */ void Tcl_ResetResult( - Tcl_Interp *interp)/* Interpreter for which to clear result. */ + Tcl_Interp *interp) /* Interpreter for which to clear result. */ { Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); if (iPtr->errorCode) { @@ -439,11 +439,11 @@ *---------------------------------------------------------------------- */ static void ResetObjResult( - Interp *iPtr) /* Points to the interpreter whose result + Interp *iPtr) /* Points to the interpreter whose result * object should be reset. */ { Tcl_Obj *objResultPtr = iPtr->objResultPtr; if (Tcl_IsShared(objResultPtr)) { @@ -714,11 +714,11 @@ if (iPtr->errorInfo) { Tcl_DecrRefCount(iPtr->errorInfo); iPtr->errorInfo = NULL; } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { Tcl_Size length; (void)TclGetStringFromObj(valuePtr, &length); if (length) { @@ -726,53 +726,53 @@ Tcl_IncrRefCount(iPtr->errorInfo); iPtr->flags |= ERR_ALREADY_LOGGED; } } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { - Tcl_Size len, valueObjc; - Tcl_Obj **valueObjv; - - if (Tcl_IsShared(iPtr->errorStack)) { - Tcl_Obj *newObj; - - newObj = Tcl_DuplicateObj(iPtr->errorStack); - Tcl_DecrRefCount(iPtr->errorStack); - Tcl_IncrRefCount(newObj); - iPtr->errorStack = newObj; - } - - /* - * List extraction done after duplication to avoid moving the rug - * if someone does [return -errorstack [info errorstack]] - */ - - if (TclListObjGetElements(interp, valuePtr, &valueObjc, - &valueObjv) == TCL_ERROR) { - return TCL_ERROR; - } - iPtr->resetErrorStack = 0; - TclListObjLength(interp, iPtr->errorStack, &len); - - /* - * Reset while keeping the list internalrep as much as possible. - */ - - Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc, - valueObjv); + Tcl_Size len, valueObjc; + Tcl_Obj **valueObjv; + + if (Tcl_IsShared(iPtr->errorStack)) { + Tcl_Obj *newObj; + + newObj = Tcl_DuplicateObj(iPtr->errorStack); + Tcl_DecrRefCount(iPtr->errorStack); + Tcl_IncrRefCount(newObj); + iPtr->errorStack = newObj; + } + + /* + * List extraction done after duplication to avoid moving the rug + * if someone does [return -errorstack [info errorstack]] + */ + + if (TclListObjGetElements(interp, valuePtr, &valueObjc, + &valueObjv) == TCL_ERROR) { + return TCL_ERROR; + } + iPtr->resetErrorStack = 0; + TclListObjLength(interp, iPtr->errorStack, &len); + + /* + * Reset while keeping the list internalrep as much as possible. + */ + + Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc, + valueObjv); } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { Tcl_SetObjErrorCode(interp, valuePtr); } else { Tcl_SetErrorCode(interp, "NONE", (void *)NULL); } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine); } } if (level != 0) { @@ -841,12 +841,12 @@ /* * Value is not a legal dictionary. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad %s value: expected dictionary but got \"%s\"", - compare, TclGetString(objv[1]))); + "bad %s value: expected dictionary but got \"%s\"", + compare, TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (void *)NULL); goto error; } @@ -859,11 +859,10 @@ if (valuePtr != NULL) { dict = valuePtr; Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_OPTIONS]); goto nestedOptions; } - } else { Tcl_DictObjPut(NULL, returnOpts, objv[0], objv[1]); } } @@ -872,11 +871,11 @@ */ Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr); if (valuePtr != NULL) { if (TclGetCompletionCodeFromObj(interp, valuePtr, - &code) == TCL_ERROR) { + &code) == TCL_ERROR) { goto error; } Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]); } @@ -891,12 +890,12 @@ /* * Value is not a legal level. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -level value: expected non-negative integer but got" - " \"%s\"", TclGetString(valuePtr))); + "bad -level value: expected non-negative integer but got" + " \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", (void *)NULL); goto error; } Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]); } @@ -913,12 +912,12 @@ /* * Value is not a list, which is illegal for -errorcode. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -errorcode value: expected a list but got \"%s\"", - TclGetString(valuePtr))); + "bad -errorcode value: expected a list but got \"%s\"", + TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE", (void *)NULL); goto error; } } @@ -935,28 +934,28 @@ /* * Value is not a list, which is illegal for -errorstack. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -errorstack value: expected a list but got \"%s\"", - TclGetString(valuePtr))); + "bad -errorstack value: expected a list but got \"%s\"", + TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK", - (void *)NULL); + (void *)NULL); goto error; } - if (length % 2) { - /* - * Errorstack must always be an even-sized list - */ + if (length % 2) { + /* + * Errorstack must always be an even-sized list + */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "forbidden odd-sized list for -errorstack: \"%s\"", + "forbidden odd-sized list for -errorstack: \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", - "ODDSIZEDLIST_ERRORSTACK", (void *)NULL); + "ODDSIZEDLIST_ERRORSTACK", (void *)NULL); goto error; - } + } } /* * Convert [return -code return -level X] to [return -code ok -level X+1] */ @@ -1032,11 +1031,11 @@ Tcl_NewWideIntObj(0)); } if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, ""); - Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack); + Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack); } if (iPtr->errorCode) { Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode); } if (iPtr->errorInfo) { @@ -1103,11 +1102,11 @@ Tcl_IncrRefCount(options); if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv) || (objc % 2)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected dict but got \"%s\"", TclGetString(options))); + "expected dict but got \"%s\"", TclGetString(options))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (void *)NULL); code = TCL_ERROR; } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv, &mergedOpts, &code, &level)) { code = TCL_ERROR; Index: generic/tclScan.c ================================================================== --- generic/tclScan.c +++ generic/tclScan.c @@ -15,17 +15,18 @@ /* * Flag values used by Tcl_ScanObjCmd. */ -#define SCAN_NOSKIP 0x1 /* Don't skip blanks. */ -#define SCAN_SUPPRESS 0x2 /* Suppress assignment. */ -#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */ -#define SCAN_WIDTH 0x8 /* A width value was supplied. */ - -#define SCAN_LONGER 0x400 /* Asked for a wide value. */ -#define SCAN_BIG 0x800 /* Asked for a bignum value. */ +enum TclScanFlags { + SCAN_NOSKIP = 0x1, /* Don't skip blanks. */ + SCAN_SUPPRESS = 0x2, /* Suppress assignment. */ + SCAN_UNSIGNED = 0x4, /* Read an unsigned value. */ + SCAN_WIDTH = 0x8, /* A width value was supplied. */ + SCAN_LONGER = 0x400, /* Asked for a wide value. */ + SCAN_BIG = 0x800 /* Asked for a bignum value. */ +}; /* * The following structure contains the information associated with a * character set. */ @@ -353,23 +354,21 @@ * Parse any width specifier. */ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ /* Note ull >= 0 because of isdigit check above */ - unsigned long long ull; - ull = strtoull( - format - 1, (char **)&format, 10); /* INTL: "C" locale. */ + unsigned long long ull = strtoull( + format - 1, (char **)&format, 10); /* INTL: "C" locale. */ + /* Note >=, not >, to leave room for a nul */ if (ull >= TCL_SIZE_MAX) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("specified field width %" TCL_LL_MODIFIER - "u exceeds limit %" TCL_SIZE_MODIFIER "d.", - ull, - (Tcl_Size)TCL_SIZE_MAX-1)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "specified field width %" TCL_LL_MODIFIER + "u exceeds limit %" TCL_SIZE_MODIFIER "d.", + ull, (Tcl_Size)TCL_SIZE_MAX-1)); Tcl_SetErrorCode( - interp, "TCL", "FORMAT", "WIDTHLIMIT", (void *)NULL); + interp, "TCL", "FORMAT", "WIDTHLIMIT", (void *)NULL); goto error; } flags |= SCAN_WIDTH; format += TclUtfToUniChar(format, &ch); } Index: generic/tclStrToD.c ================================================================== --- generic/tclStrToD.c +++ generic/tclStrToD.c @@ -24,11 +24,10 @@ #ifndef PRIx64 # define PRIx64 TCL_LL_MODIFIER "x" #endif - /* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be * uniquely determined by radix and by the widths of significand and exponent. */ @@ -275,23 +274,23 @@ (Tcl_WideUInt) 3125U*3125U, /* 5**10 */ (Tcl_WideUInt) 3125U*3125U*5U, (Tcl_WideUInt) 3125U*3125U*25U, (Tcl_WideUInt) 3125U*3125U*125U, (Tcl_WideUInt) 3125U*3125U*625U, - (Tcl_WideUInt) 3125U*3125U*3125U, /* 5**15 */ + (Tcl_WideUInt) 3125U*3125U*3125U, /* 5**15 */ (Tcl_WideUInt) 3125U*3125U*3125U*5U, (Tcl_WideUInt) 3125U*3125U*3125U*25U, (Tcl_WideUInt) 3125U*3125U*3125U*125U, (Tcl_WideUInt) 3125U*3125U*3125U*625U, (Tcl_WideUInt) 3125U*3125U*3125U*3125U, /* 5**20 */ (Tcl_WideUInt) 3125U*3125U*3125U*3125U*5U, (Tcl_WideUInt) 3125U*3125U*3125U*3125U*25U, (Tcl_WideUInt) 3125U*3125U*3125U*3125U*125U, (Tcl_WideUInt) 3125U*3125U*3125U*3125U*625U, - (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U, /* 5**25 */ + (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U, /* 5**25 */ (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U*5U, - (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U*25U /* 5**27 */ + (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U*25U /* 5**27 */ }; /* * Static functions defined in this file. */ @@ -651,11 +650,10 @@ goto next; } continue_num: switch (state) { - case INITIAL: /* * Initial state. Acceptable characters are +, -, digits, period, * I, N, and whitespace. */ @@ -1442,11 +1440,10 @@ } break; case FRACTION: case EXPONENT: - /* * Here, we're parsing a floating-point number. 'significandWide' * or 'significandBig' contains the exact significand, according * to whether 'significandOverflow' is set. The desired floating * point value is significand * 10**k, where @@ -1695,11 +1692,11 @@ * twice: once to the precision of double-extended and then again to the * precision of double. Double-rounding introduces gratuitous errors of 1 * ulp, so we need to change rounding mode to 53-bits. We also make * 'retval' volatile, so that it doesn't get promoted to a register. */ - volatile double retval; /* Value of the number. */ + volatile double retval; /* Value of the number. */ /* * Test for zero significand, which requires explicit construction * of -0.0. (Unary minus returns a positive zero.) */ @@ -2651,11 +2648,11 @@ *---------------------------------------------------------------------- */ static inline void SetPrecisionLimits( - int flags, /* Type of conversion: TCL_DD_SHORTEST, + int flags, /* Type of conversion: TCL_DD_SHORTEST, * TCL_DD_E_FMT, TCL_DD_F_FMT. */ int k, /* Floor(log10(number to convert)) */ int *ndigitsPtr, /* IN/OUT: Number of digits requested (will be * adjusted if needed). */ int *iPtr, /* OUT: Maximum number of digits to return. */ @@ -4228,11 +4225,10 @@ * longest format that doesn't introduce empty precision. * * Extract the next group of digits. */ - if ((err != MP_OKAY) || (mp_div(&b, &S, &dig, &b) != MP_OKAY) || (dig.used > 1)) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; for (j = g-1; j >= 0; --j) { @@ -4846,11 +4842,10 @@ int bits, shift, i, lsb; double r; mp_err err; const mp_int *a = (const mp_int *)big; - /* * We need a 'mantBits'-bit significand. Determine what shift will * give us that. */ @@ -4882,12 +4877,11 @@ err = mp_copy(a, &b); } else if (shift > 0) { err = mp_mul_2d(a, shift, &b); } else if (shift < 0) { lsb = mp_cnt_lsb(a); - if (lsb == -1-shift) { - + if (lsb == -1 - shift) { /* * Round to even */ err = mp_div_2d(a, -shift, &b, NULL); @@ -4897,11 +4891,10 @@ } else { err = mp_add_d(&b, 1, &b); } } } else { - /* * Ordinary rounding */ err = mp_div_2d(a, -1-shift, &b, NULL); @@ -4960,11 +4953,11 @@ *---------------------------------------------------------------------- */ double TclCeil( - const void *big) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; mp_err err; const mp_int *a = (const mp_int *)big; @@ -5026,11 +5019,11 @@ *---------------------------------------------------------------------- */ double TclFloor( - const void *big) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; mp_err err; const mp_int *a = (const mp_int *)big; Index: generic/tclStringObj.c ================================================================== --- generic/tclStringObj.c +++ generic/tclStringObj.c @@ -457,11 +457,10 @@ } return numChars; } - /* *---------------------------------------------------------------------- * * TclCheckEmptyString -- * @@ -717,12 +716,12 @@ */ Tcl_Obj * Tcl_GetRange( Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ - Tcl_Size first, /* First index of the range. */ - Tcl_Size last) /* Last index of the range. */ + Tcl_Size first, /* First index of the range. */ + Tcl_Size last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; Tcl_Size length = 0; @@ -2469,11 +2468,10 @@ } Tcl_AppendObjToObj(segment, pure); Tcl_DecrRefCount(pure); break; } - } break; } case 'a': @@ -3518,16 +3516,15 @@ * be changed. * *--------------------------------------------------------------------------- */ - static int UniCharNcasememcmp( - const void *ucsPtr, /* Unicode string to compare to uct. */ - const void *uctPtr, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of Unichars to compare. */ + const void *ucsPtr, /* Unicode string to compare to uct. */ + const void *uctPtr, /* Unicode string ucs is compared to. */ + size_t numChars) /* Number of Unichars to compare. */ { const Tcl_UniChar *ucs = (const Tcl_UniChar *)ucsPtr; const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { @@ -3544,11 +3541,11 @@ static int UtfNmemcmp( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; const char *cs = (const char *)csPtr; const char *ct = (const char *)ctPtr; @@ -3576,11 +3573,11 @@ static int UtfNcasememcmp( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; const char *cs = (const char *)csPtr; const char *ct = (const char *)ctPtr; @@ -3603,13 +3600,13 @@ return 0; } static int UniCharNmemcmp( - const void *ucsPtr, /* Unicode string to compare to uct. */ - const void *uctPtr, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of unichars to compare. */ + const void *ucsPtr, /* Unicode string to compare to uct. */ + const void *uctPtr, /* Unicode string ucs is compared to. */ + size_t numChars) /* Number of unichars to compare. */ { const Tcl_UniChar *ucs = (const Tcl_UniChar *)ucsPtr; const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; #if defined(WORDS_BIGENDIAN) /* @@ -3637,11 +3634,11 @@ Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ Tcl_Size reqlength) /* requested length in characters; - * TCL_INDEX_NONE to compare whole strings */ + * TCL_INDEX_NONE to compare whole strings */ { const char *s1, *s2; int empty, match; Tcl_Size length, s1len = 0, s2len = 0; memCmpFn_t memCmpFn; Index: generic/tclStringRep.h ================================================================== --- generic/tclStringRep.h +++ generic/tclStringRep.h @@ -40,11 +40,12 @@ * (allocated+1). */ Tcl_Size 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 Tcl_UniChar representation. */ - Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Tcl_UniChar units. + Tcl_UniChar unicode[TCLFLEXARRAY]; + /* The array of Tcl_UniChar units. * The actual size of this field depends on * the maxChars field above. */ } String; /* Limit on string lengths. The -1 because limit does not include the nul */ @@ -65,13 +66,13 @@ ((String *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_STRING(objPtr, stringPtr) \ ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL), \ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr)) -#endif /* _TCLSTRINGREP */ +#endif /* _TCLSTRINGREP */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclStubLibTbl.c ================================================================== --- generic/tclStubLibTbl.c +++ generic/tclStubLibTbl.c @@ -31,18 +31,18 @@ * *---------------------------------------------------------------------- */ MODULE_SCOPE const char * TclInitStubTable( - const char *version) /* points to the version field of a - structure variable. */ + const char *version) /* points to the version field of a + * structure variable. */ { if (version) { if (tclStubsHandle == NULL) { - /* This can only happen with -DBUILD_STATIC, so simulate - * that the loading of Tcl succeeded, although we didn't - * actually load it dynamically */ + /* This can only happen with -DBUILD_STATIC, so simulate + * that the loading of Tcl succeeded, although we didn't + * actually load it dynamically */ tclStubsHandle = (void *)1; } tclStubsPtr = ((const TclStubs **) version)[-1]; if (tclStubsPtr->hooks) { Index: generic/tclThread.c ================================================================== --- generic/tclThread.c +++ generic/tclThread.c @@ -21,13 +21,13 @@ * These statics are guarded by the mutex in the caller of * TclRememberThreadData, e.g., TclpThreadDataKeyInit */ typedef struct { - int num; /* Number of objects remembered */ - int max; /* Max size of the array */ - void **list; /* List of pointers */ + int num; /* Number of objects remembered */ + int max; /* Max size of the array */ + void **list; /* List of pointers */ } SyncObjRecord; static SyncObjRecord keyRecord = {0, 0, NULL}; static SyncObjRecord mutexRecord = {0, 0, NULL}; static SyncObjRecord condRecord = {0, 0, NULL}; @@ -142,11 +142,10 @@ void *objPtr, /* Pointer to sync object */ SyncObjRecord *recPtr) /* Record of sync objects */ { void **newList; int i, j; - /* * Reuse any free slot in the list. */ @@ -486,11 +485,11 @@ */ #undef Tcl_ConditionWait void Tcl_ConditionWait( - TCL_UNUSED(Tcl_Condition *), /* Really (pthread_cond_t **) */ + TCL_UNUSED(Tcl_Condition *),/* Really (pthread_cond_t **) */ TCL_UNUSED(Tcl_Mutex *), /* Really (pthread_mutex_t **) */ TCL_UNUSED(const Tcl_Time *)) /* Timeout on waiting period */ { } Index: generic/tclThreadAlloc.c ================================================================== --- generic/tclThreadAlloc.c +++ generic/tclThreadAlloc.c @@ -90,11 +90,11 @@ /* All fields below for accounting only */ size_t numRemoves; /* Number of removes from bucket */ size_t numInserts; /* Number of inserts into bucket */ size_t numLocks; /* Number of locks acquired */ - size_t totalAssigned; /* Total space assigned to bucket */ + size_t totalAssigned; /* Total space assigned to bucket */ } Bucket; /* * The following structure defines a cache of buckets and objs, of which there * will be (at most) one per thread. Any changes need to be reflected in the @@ -118,11 +118,11 @@ */ static struct { size_t blockSize; /* Bucket blocksize. */ size_t maxBlocks; /* Max blocks before move to share. */ - size_t numMove; /* Num blocks to move to share. */ + size_t numMove; /* Num blocks to move to share. */ Tcl_Mutex *lockPtr; /* Share bucket lock. */ } bucketInfo[NBUCKETS]; /* * Static functions defined in this file. @@ -944,11 +944,10 @@ */ if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].numFree > 0) { LockBucket(cachePtr, bucket); if (sharedPtr->buckets[bucket].numFree > 0) { - /* * Either move the entire list or walk the list to find the last * block to move. */ Index: generic/tclThreadStorage.c ================================================================== --- generic/tclThreadStorage.c +++ generic/tclThreadStorage.c @@ -46,11 +46,11 @@ /* * The type of the data held per thread in a system TSD. */ typedef struct { - void **tablePtr; /* The table of Tcl TSDs. */ + void **tablePtr; /* The table of Tcl TSDs. */ sig_atomic_t allocated; /* The size of the table in the current * thread. */ } TSDTable; /* Index: generic/tclThreadTest.c ================================================================== --- generic/tclThreadTest.c +++ generic/tclThreadTest.c @@ -52,12 +52,13 @@ /* * The following bit-values are legal for the "flags" field of the * ThreadSpecificData structure. */ - -#define TP_Dying 0x001 /* This thread is being canceled */ +enum ThreadCtrlFlags { + TP_Dying = 0x001 /* This thread is being canceled */ +}; /* * An instance of the following structure contains all information that is * passed into a new thread when the thread is created using either the * "thread create" Tcl command or the ThreadCreate() C function. Index: generic/tclTimer.c ================================================================== --- generic/tclTimer.c +++ generic/tclTimer.c @@ -19,11 +19,11 @@ */ typedef struct TimerHandler { Tcl_Time time; /* When timer is to fire. */ Tcl_TimerProc *proc; /* Function to call. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ Tcl_TimerToken token; /* Identifies handler so it can be deleted. */ struct TimerHandler *nextPtr; /* Next event in queue, or NULL for end of * queue. */ } TimerHandler; @@ -71,11 +71,11 @@ * linked together into a list. */ typedef struct IdleHandler { Tcl_IdleProc *proc; /* Function to call. */ - void *clientData; /* Value to pass to proc. */ + void *clientData; /* Value to pass to proc. */ int generation; /* Used to distinguish older handlers from * recently-created ones. */ struct IdleHandler *nextPtr;/* Next in list of active handlers. */ } IdleHandler; @@ -180,11 +180,12 @@ */ static ThreadSpecificData * InitTimer(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL); Tcl_CreateThreadExitHandler(TimerExitProc, NULL); @@ -211,11 +212,12 @@ static void TimerExitProc( TCL_UNUSED(void *)) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { TimerHandler *timerHandlerPtr; @@ -249,11 +251,11 @@ Tcl_TimerToken Tcl_CreateTimerHandler( int milliseconds, /* How many milliseconds to wait before * invoking proc. */ Tcl_TimerProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { Tcl_Time time; /* * Compute when the event should fire. @@ -295,11 +297,11 @@ void *clientData) { TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); - timerHandlerPtr = (TimerHandler *)Tcl_Alloc(sizeof(TimerHandler)); + timerHandlerPtr = (TimerHandler *) Tcl_Alloc(sizeof(TimerHandler)); /* * Fill in fields for the event. */ @@ -617,11 +619,11 @@ */ void Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr; Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); @@ -661,11 +663,11 @@ */ void Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr, *prevPtr; IdleHandler *nextPtr; ThreadSpecificData *tsdPtr = InitTimer(); @@ -821,14 +823,14 @@ if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) != TCL_OK) { const char *arg = TclGetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad argument \"%s\": must be" - " cancel, idle, info, or an integer", arg)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", - arg, (void *)NULL); + "bad argument \"%s\": must be" + " cancel, idle, info, or an integer", arg)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", + arg, (void *)NULL); return TCL_ERROR; } } /* @@ -950,34 +952,34 @@ if (assocPtr->interp == interp) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( "after#%d", afterPtr->id)); } } - Tcl_SetObjResult(interp, resultObj); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "?id?"); return TCL_ERROR; } afterPtr = GetAfterEvent(assocPtr, objv[2]); if (afterPtr == NULL) { - const char *eventStr = TclGetString(objv[2]); + const char *eventStr = TclGetString(objv[2]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "event \"%s\" doesn't exist", eventStr)); - Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, (void *)NULL); + "event \"%s\" doesn't exist", eventStr)); + Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, (void *)NULL); return TCL_ERROR; } else { Tcl_Obj *resultListPtr; TclNewObj(resultListPtr); Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr); Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( (afterPtr->token == NULL) ? "idle" : "timer", -1)); - Tcl_SetObjResult(interp, resultListPtr); + Tcl_SetObjResult(interp, resultListPtr); } break; default: Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds"); } @@ -1041,21 +1043,21 @@ || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { diff = TCL_TIME_DIFF_MS_CEILING(endTime, now); if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } - if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { - diff = 1; - } + if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { + diff = 1; + } if (diff > 0) { Tcl_Sleep((int) diff); - if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { - break; - } + if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { + break; + } } else { - break; - } + break; + } } else { diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } @@ -1147,11 +1149,11 @@ *---------------------------------------------------------------------- */ static void AfterProc( - void *clientData) /* Describes command to execute. */ + void *clientData) /* Describes command to execute. */ { AfterInfo *afterPtr = (AfterInfo *)clientData; AfterAssocData *assocPtr = afterPtr->assocPtr; AfterInfo *prevPtr; int result; @@ -1212,11 +1214,11 @@ *---------------------------------------------------------------------- */ static void FreeAfterPtr( - AfterInfo *afterPtr) /* Command to be deleted. */ + AfterInfo *afterPtr) /* Command to be deleted. */ { AfterInfo *prevPtr; AfterAssocData *assocPtr = afterPtr->assocPtr; if (assocPtr->firstAfterPtr == afterPtr) { @@ -1249,11 +1251,11 @@ *---------------------------------------------------------------------- */ static void AfterCleanupProc( - void *clientData, /* Points to AfterAssocData for the + void *clientData, /* Points to AfterAssocData for the * interpreter. */ TCL_UNUSED(Tcl_Interp *)) { AfterAssocData *assocPtr = (AfterAssocData *)clientData; AfterInfo *afterPtr; Index: generic/tclTomMath.h ================================================================== --- generic/tclTomMath.h +++ generic/tclTomMath.h @@ -3,23 +3,23 @@ #include #if defined(TCL_NO_TOMMATH_H) typedef size_t mp_digit; typedef int mp_sign; -# define MP_ZPOS 0 /* positive integer */ -# define MP_NEG 1 /* negative */ +# define MP_ZPOS 0 /* positive integer */ +# define MP_NEG 1 /* negative */ typedef int mp_ord; -# define MP_LT -1 /* less than */ -# define MP_EQ 0 /* equal to */ -# define MP_GT 1 /* greater than */ +# define MP_LT -1 /* less than */ +# define MP_EQ 0 /* equal to */ +# define MP_GT 1 /* greater than */ typedef int mp_err; -# define MP_OKAY 0 /* no error */ -# define MP_ERR -1 /* unknown error */ -# define MP_MEM -2 /* out of mem */ -# define MP_VAL -3 /* invalid input */ -# define MP_ITER -4 /* maximum iterations reached */ -# define MP_BUF -5 /* buffer overflow, supplied buffer too small */ +# define MP_OKAY 0 /* no error */ +# define MP_ERR -1 /* unknown error */ +# define MP_MEM -2 /* out of mem */ +# define MP_VAL -3 /* invalid input */ +# define MP_ITER -4 /* maximum iterations reached */ +# define MP_BUF -5 /* buffer overflow, supplied buffer too small */ typedef int mp_order; # define MP_LSB_FIRST -1 # define MP_MSB_FIRST 1 typedef int mp_endian; # define MP_LITTLE_ENDIAN -1 Index: generic/tclTomMathStubLib.c ================================================================== --- generic/tclTomMathStubLib.c +++ generic/tclTomMathStubLib.c @@ -15,11 +15,10 @@ #include "tclTomMath.h" MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr; const TclTomMathStubs *tclTomMathStubsPtr = NULL; - /* *---------------------------------------------------------------------- * * TclTomMathInitStubs -- Index: generic/tclTrace.c ================================================================== --- generic/tclTrace.c +++ generic/tclTrace.c @@ -20,11 +20,11 @@ typedef struct { int flags; /* Operations for which Tcl command is to be * invoked. */ Tcl_Size length; /* Number of non-NUL chars. in command. */ - char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual + char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual * size will be as large as necessary to hold * command. This field must be the last in the * structure, so that it can be larger than 1 * byte. */ } TraceVarInfo; @@ -42,11 +42,11 @@ int flags; /* Operations for which Tcl command is to be * invoked. */ Tcl_Size length; /* Number of non-NUL chars. in command. */ Tcl_Trace stepTrace; /* Used for execution traces, when tracing * inside the given command */ - Tcl_Size startLevel; /* Used for bookkeeping with step execution + Tcl_Size startLevel; /* Used for bookkeeping with step execution * traces, store the level at which the step * trace was invoked */ char *startCmd; /* Used for bookkeeping with step execution * traces, store the command name which * invoked step trace */ @@ -54,11 +54,11 @@ int curCode; /* Return code for the current command */ 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. */ - char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual + char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual * size will be as large as necessary to hold * command. This field must be the last in the * structure, so that it can be larger than 1 * byte. */ } TraceCommandInfo; @@ -80,15 +80,17 @@ * by the command being traced, not because of * an internal trace. * The flag 'TCL_TRACE_DESTROYED' may also be used in command execution traces. */ -#define TCL_TRACE_ENTER_DURING_EXEC 4 -#define TCL_TRACE_LEAVE_DURING_EXEC 8 -#define TCL_TRACE_ANY_EXEC 15 -#define TCL_TRACE_EXEC_IN_PROGRESS 0x10 -#define TCL_TRACE_EXEC_DIRECT 0x20 +enum TraceCommandFlags { + TCL_TRACE_ENTER_DURING_EXEC = 4, + TCL_TRACE_LEAVE_DURING_EXEC = 8, + TCL_TRACE_ANY_EXEC = 15, + TCL_TRACE_EXEC_IN_PROGRESS = 0x10, + TCL_TRACE_EXEC_DIRECT = 0x20 +}; /* * Forward declarations for functions defined in this file: */ @@ -144,27 +146,27 @@ * The following structure holds the client data for string-based * trace procs */ typedef struct { - void *clientData; /* Client data from Tcl_CreateTrace */ + void *clientData; /* Client data from Tcl_CreateTrace */ Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */ } StringTraceData; /* * Convenience macros for iterating over the list of traces. Note that each of * these *must* be treated as a command, and *must* have a block following it. */ #define FOREACH_VAR_TRACE(interp, name, clientData) \ - (clientData) = NULL; \ - while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \ + (clientData) = NULL; \ + while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \ 0, TraceVarProc, (clientData))) != NULL) #define FOREACH_COMMAND_TRACE(interp, name, clientData) \ - (clientData) = NULL; \ - while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \ + (clientData) = NULL; \ + while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \ TraceCommandProc, (clientData))) != NULL) /* *---------------------------------------------------------------------- * @@ -195,10 +197,11 @@ static const char *const traceOptions[] = { "add", "info", "remove", NULL }; enum traceOptionsEnum optionIndex; + int typeIndex; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } @@ -207,37 +210,33 @@ &optionIndex) != TCL_OK) { return TCL_ERROR; } switch (optionIndex) { case TRACE_ADD: - case TRACE_REMOVE: { + case TRACE_REMOVE: /* * All sub commands of trace add/remove must take at least one more * argument. Beyond that we let the subcommand itself control the * argument structure. */ - int typeIndex; - if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "type ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option", 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } return traceSubCmds[typeIndex](interp, optionIndex, objc, objv); - } - case TRACE_INFO: { + case TRACE_INFO: /* * All sub commands of trace info must take exactly two more arguments * which name the type of thing being traced and the name of the thing * being traced. */ - int typeIndex; if (objc < 3) { /* * Delegate other complaints to the type-specific code which can * give a better error message. */ @@ -248,13 +247,10 @@ if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option", 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } return traceSubCmds[typeIndex](interp, optionIndex, objc, objv); - break; - } - } return TCL_OK; } /* @@ -277,12 +273,13 @@ */ static int TraceExecutionObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + enum traceOptionsEnum optionIndex, + /* Add, info or remove */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *command; Tcl_Size length; static const char *const opStrings[] = { @@ -524,12 +521,13 @@ */ static int TraceCommandObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + enum traceOptionsEnum optionIndex, + /* Add, info or remove */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *command; Tcl_Size length; static const char *const opStrings[] = { "delete", "rename", NULL }; @@ -718,12 +716,13 @@ */ static int TraceVariableObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + enum traceOptionsEnum optionIndex, + /* Add, info or remove */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *command; Tcl_Size length; void *clientData; @@ -979,11 +978,11 @@ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are * invoked upon cmdName. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, @@ -1014,11 +1013,10 @@ iPtr->compileEpoch++; } cmdPtr->flags |= CMD_HAS_EXEC_TRACES; } - return TCL_OK; } /* *---------------------------------------------------------------------- @@ -1043,11 +1041,11 @@ const char *cmdName, /* Name of command. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { CommandTrace *tracePtr; CommandTrace *prevPtr; Command *cmdPtr; Interp *iPtr = (Interp *)interp; @@ -1118,11 +1116,11 @@ * We therefore remove this flag: */ cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES; - /* + /* * Bug 3484621: up the interp's epoch if this is a BC'ed command */ if (cmdPtr->compileProc != NULL) { iPtr->compileEpoch++; @@ -1148,11 +1146,11 @@ *---------------------------------------------------------------------- */ static void TraceCommandProc( - void *clientData, /* Information about the command trace. */ + void *clientData, /* Information about the command trace. */ Tcl_Interp *interp, /* Interpreter containing command. */ const char *oldName, /* Name of command being changed. */ const char *newName, /* New name of command. Empty string or NULL * means command is being deleted (renamed to * ""). */ @@ -1293,11 +1291,11 @@ * string. */ TCL_UNUSED(Tcl_Size) /*numChars*/, Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ - Tcl_Size objc, /* Number of arguments for the command. */ + Tcl_Size objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; CommandTrace *tracePtr, *lastTracePtr; ActiveCommandTrace active; @@ -1399,11 +1397,11 @@ Tcl_Size 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. */ int traceFlags, /* Current tracing situation. */ - Tcl_Size objc, /* Number of arguments for the command. */ + Tcl_Size objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; Trace *tracePtr, *lastTracePtr; ActiveInterpTrace active; @@ -1537,11 +1535,11 @@ */ static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ - Trace *tracePtr, /* Describes the trace function to call. */ + Trace *tracePtr, /* Describes the trace function to call. */ Command *cmdPtr, /* Points to command's Command struct. */ const char *command, /* Points to the first character of the * command's source before substitutions. */ Tcl_Size numChars, /* The number of characters in the command's * source. */ @@ -1832,11 +1830,11 @@ *---------------------------------------------------------------------- */ static char * TraceVarProc( - void *clientData, /* Information about the variable trace. */ + void *clientData, /* Information about the variable trace. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable or array. */ const char *name2, /* Name of element within array; NULL means * scalar variable is being referenced. */ int flags) /* OR-ed bits giving operation and other @@ -2015,14 +2013,14 @@ } Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Size level, /* Maximum nesting level */ + Tcl_Size level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc *proc, /* Trace callback */ - void *clientData, /* Client data for the callback */ + void *clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { TraceWrapperInfo *info = (TraceWrapperInfo *)Tcl_Alloc(sizeof(TraceWrapperInfo)); info->proc = proc; @@ -2034,14 +2032,14 @@ } Tcl_Trace Tcl_CreateObjTrace2( Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Size level, /* Maximum nesting level */ + Tcl_Size level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc2 *proc, /* Trace callback */ - void *clientData, /* Client data for the callback */ + void *clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { Trace *tracePtr; Interp *iPtr = (Interp *) interp; @@ -2123,15 +2121,15 @@ */ Tcl_Trace Tcl_CreateTrace( Tcl_Interp *interp, /* Interpreter in which to create trace. */ - Tcl_Size level, /* Only call proc for commands at nesting + Tcl_Size level, /* Only call proc for commands at nesting * level<=argument level (1=>top level). */ Tcl_CmdTraceProc *proc, /* Function to call before executing each * command. */ - void *clientData) /* Arbitrary value word to pass to proc. */ + void *clientData) /* Arbitrary value word to pass to proc. */ { StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData)); data->clientData = clientData; data->proc = proc; @@ -2433,11 +2431,11 @@ */ int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - Var *arrayPtr, /* Pointer to array variable that contains the + Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, /* Variable's two-part name. */ @@ -2467,11 +2465,11 @@ } int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - Var *arrayPtr, /* Pointer to array variable that contains the + Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ const char *part1, const char *part2, /* Variable's two-part name. */ @@ -2546,19 +2544,19 @@ } /* Keep the original pointer for possible use in an error message */ element = part2; if (part2 == NULL) { - if (TclIsVarArrayElement(varPtr)) { - Tcl_Obj *keyObj = VarHashGetKey(varPtr); - part2 = Tcl_GetString(keyObj); - } + if (TclIsVarArrayElement(varPtr)) { + Tcl_Obj *keyObj = VarHashGetKey(varPtr); + part2 = Tcl_GetString(keyObj); + } } else if ((flags & VAR_TRACED_UNSET) && !(flags & VAR_ARRAY_ELEMENT)) { - /* On unset traces, part2 has already been set by the caller, and - * the VAR_ARRAY_ELEMENT flag indicates whether the accessed - * variable actually has a second part, or is a scalar */ - element = NULL; + /* On unset traces, part2 has already been set by the caller, and + * the VAR_ARRAY_ELEMENT flag indicates whether the accessed + * variable actually has a second part, or is a scalar */ + element = NULL; } /* * Invoke traces on the array containing the variable, if relevant. */ @@ -2775,11 +2773,11 @@ 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 associated with trace. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; VarTrace *prevPtr, *nextPtr; Var *varPtr, *arrayPtr; Interp *iPtr = (Interp *) interp; @@ -2978,11 +2976,11 @@ * 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. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; int result; tracePtr = (VarTrace *)Tcl_Alloc(sizeof(VarTrace)); @@ -3025,11 +3023,11 @@ * traced. */ const char *part1, /* Name of scalar variable or array. */ const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ - VarTrace *tracePtr)/* Structure containing flags, traceProc and + VarTrace *tracePtr) /* Structure containing flags, traceProc and * clientData fields. Others should be left * 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. */ Index: generic/tclUtf.c ================================================================== --- generic/tclUtf.c +++ generic/tclUtf.c @@ -16,38 +16,40 @@ */ #include "tclUniData.c" /* - * The following macros are used for fast character category tests. The x_BITS + * The following values are used for fast character category tests. The x_BITS * values are shifted right by the category value to determine whether the * given category is included in the set. */ - -#define ALPHA_BITS ((1 << UPPERCASE_LETTER) | (1 << LOWERCASE_LETTER) \ - | (1 << TITLECASE_LETTER) | (1 << MODIFIER_LETTER) | (1<= TCL_COMBINE) { ch &= (TCL_COMBINE - 1); @@ -307,11 +308,11 @@ *--------------------------------------------------------------------------- */ char * Tcl_UniCharToUtfDString( - const int *uniStr, /* Unicode string to convert to UTF-8. */ + const int *uniStr, /* Unicode string to convert to UTF-8. */ Tcl_Size uniLength, /* Length of Unicode string. Negative for nul * terminated string */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { @@ -368,11 +369,10 @@ if (uniStr == NULL) { return NULL; } if (uniLength < 0) { - uniLength = 0; w = uniStr; while (*w != '\0') { uniLength++; w++; @@ -438,13 +438,13 @@ 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178 }; Tcl_Size Tcl_UtfToUniChar( - const char *src, /* The UTF-8 string. */ - int *chPtr)/* Filled with the Unicode character represented by - * the UTF-8 string. */ + const char *src, /* The UTF-8 string. */ + int *chPtr) /* Filled with the Unicode character + * represented by the UTF-8 string. */ { int byte; /* * Unroll 1 to 4 byte UTF-8 sequences. @@ -498,11 +498,12 @@ /* * A three-byte-character lead-byte not followed by two trail-bytes * represents itself. */ } else if (byte < 0xF5) { - if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { + if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) + && ((src[3] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by three trail bytes. */ *chPtr = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12) | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)); @@ -521,13 +522,14 @@ return 1; } Tcl_Size Tcl_UtfToChar16( - const char *src, /* The UTF-8 string. */ - unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by - * the UTF-8 string. This could be a surrogate too. */ + const char *src, /* The UTF-8 string. */ + unsigned short *chPtr) /* Filled with the Tcl_UniChar represented by + * the UTF-8 string. This could be a surrogate + * too. */ { unsigned short byte; /* * Unroll 1 to 4 byte UTF-8 sequences. @@ -799,13 +801,13 @@ *--------------------------------------------------------------------------- */ Tcl_Size Tcl_NumUtfChars( - const char *src, /* The UTF-8 string to measure. */ - Tcl_Size length) /* The length of the string in bytes, or - * negative value for strlen(src). */ + const char *src, /* The UTF-8 string to measure. */ + Tcl_Size length) /* The length of the string in bytes, or + * negative value for strlen(src). */ { Tcl_UniChar ch = 0; Tcl_Size i = 0; if (length < 0) { @@ -851,13 +853,13 @@ return i; } Tcl_Size TclNumUtfChars( - const char *src, /* The UTF-8 string to measure. */ - Tcl_Size length) /* The length of the string in bytes, or - * negative for strlen(src). */ + const char *src, /* The UTF-8 string to measure. */ + Tcl_Size length) /* The length of the string in bytes, or + * negative for strlen(src). */ { unsigned short ch = 0; Tcl_Size i = 0; if (length < 0) { @@ -1074,12 +1076,11 @@ int trailBytesSeen = 0; /* How many trail bytes have been verified? */ const char *fallback = src - 1; /* If we cannot find a lead byte that might * start a prefix of a valid UTF byte sequence, * we will fallback to a one-byte back step */ - const char *look = fallback; - /* Start search at the fallback position */ + const char *look = fallback;/* Start search at the fallback position */ /* Quick boundary case exit. */ if (fallback <= start) { return start; } @@ -1175,12 +1176,12 @@ *--------------------------------------------------------------------------- */ int Tcl_UniCharAtIndex( - const char *src, /* The UTF-8 string to dereference. */ - Tcl_Size index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string to dereference. */ + Tcl_Size index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int i = 0; if (index < 0) { @@ -1211,12 +1212,12 @@ *--------------------------------------------------------------------------- */ const char * Tcl_UtfAtIndex( - const char *src, /* The UTF-8 string. */ - Tcl_Size index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string. */ + Tcl_Size index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; while (index-- > 0) { src += TclUtfToUniChar(src, &ch); @@ -1224,12 +1225,12 @@ return src; } const char * TclUtfAtIndex( - const char *src, /* The UTF-8 string. */ - Tcl_Size index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string. */ + Tcl_Size index) /* The position of the desired character. */ { unsigned short ch = 0; Tcl_Size len = 0; if (index > 0) { @@ -1488,11 +1489,11 @@ int TclpUtfNcmp2( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ - size_t numBytes) /* Number of *bytes* to compare. */ + size_t numBytes) /* Number of *bytes* to compare. */ { const char *cs = (const char *)csPtr; const char *ct = (const char *)ctPtr; /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to @@ -1521,12 +1522,12 @@ /* *---------------------------------------------------------------------- * * Tcl_UtfNcmp -- * - * Compare at most numChars chars (not bytes) of string cs to string ct. Both cs - * and ct are assumed to be at least numChars chars long. + * Compare at most numChars chars (not bytes) of string cs to string ct. + * Both cs and ct are assumed to be at least numChars chars long. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. * * Side effects: @@ -1537,11 +1538,11 @@ int TclUtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF-16 chars to compare. */ + size_t numChars) /* Number of UTF-16 chars to compare. */ { unsigned short ch1 = 0, ch2 = 0; /* * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the @@ -1550,12 +1551,12 @@ */ while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. This should be called - * only when both strings are of at least n UTF-16 chars long (no need for \0 - * check) + * only when both strings are of at least n UTF-16 chars long (no need + * for \0 check) */ cs += Tcl_UtfToChar16(cs, &ch1); ct += Tcl_UtfToChar16(ct, &ch2); if (ch1 != ch2) { @@ -1575,11 +1576,11 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; /* * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the @@ -1623,11 +1624,11 @@ int TclUtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF-16 chars to compare. */ + size_t numChars) /* Number of UTF-16 chars to compare. */ { unsigned short ch1 = 0, ch2 = 0; while (numChars-- > 0) { /* @@ -1658,11 +1659,11 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; while (numChars-- > 0) { /* @@ -1879,11 +1880,12 @@ *---------------------------------------------------------------------- */ Tcl_Size Tcl_Char16Len( - const unsigned short *uniStr) /* Unicode string to find length of. */ + const unsigned short *uniStr) + /* Unicode string to find length of. */ { Tcl_Size len = 0; while (*uniStr != '\0') { len++; @@ -1909,11 +1911,11 @@ *---------------------------------------------------------------------- */ Tcl_Size Tcl_UniCharLen( - const int *uniStr) /* Unicode string to find length of. */ + const int *uniStr) /* Unicode string to find length of. */ { Tcl_Size len = 0; while (*uniStr != '\0') { len++; @@ -1941,11 +1943,11 @@ int TclUniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { #if defined(WORDS_BIGENDIAN) /* * We are definitely on a big-endian machine; memcmp() is safe */ @@ -1986,11 +1988,11 @@ int TclUniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); Tcl_UniChar lct = Tcl_UniCharToLower(*uct); Index: generic/tclUtil.c ================================================================== --- generic/tclUtil.c +++ generic/tclUtil.c @@ -86,16 +86,18 @@ * * For more details, see the comments on the Tcl*Scan*Element and * Tcl*Convert*Element routines. */ -#define COMPAT 1 -#define CONVERT_NONE 0 -#define CONVERT_BRACE 2 -#define CONVERT_ESCAPE 4 -#define CONVERT_MASK (CONVERT_BRACE | CONVERT_ESCAPE) -#define CONVERT_ANY 16 +enum ScanConvertFlags { + COMPAT = 1, + CONVERT_NONE = 0, + CONVERT_BRACE = 2, + CONVERT_ESCAPE = 4, + CONVERT_MASK = (CONVERT_BRACE | CONVERT_ESCAPE), + CONVERT_ANY = 16 +}; /* * Prototypes for functions defined later in this file. */ @@ -122,15 +124,15 @@ * updateStringProc will never be called and need not exist. The type * is unregistered, so has no need of a setFromAnyProc either. */ static const Tcl_ObjType endOffsetType = { - "end-offset", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - NULL, /* updateStringProc */ - NULL, /* setFromAnyProc */ + "end-offset", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL, /* setFromAnyProc */ TCL_OBJTYPE_V1(TclLengthOne) }; Tcl_Size TclLengthOne( @@ -726,11 +728,10 @@ size = (p - elemStart); goto done; } } break; - } p++; } /* @@ -944,13 +945,13 @@ *---------------------------------------------------------------------- */ Tcl_Size Tcl_ScanElement( - const char *src, /* String to convert to list element. */ - 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, TCL_INDEX_NONE, flagPtr); } /* @@ -1034,11 +1035,11 @@ int requireEscape = 0; /* Force use of CONVERT_ESCAPE mode. For some * reason bare or brace-quoted form fails. */ Tcl_Size extra = 0; /* Count of number of extra bytes needed for * formatted element, assuming we use escape * sequences in formatting. */ - Tcl_Size bytesNeeded; /* Buffer length computed to complete the + Tcl_Size bytesNeeded; /* Buffer length computed to complete the * element formatting in the selected mode. */ #if COMPAT int preferEscape = 0; /* Use preferences to track whether to use */ int preferBrace = 0; /* CONVERT_MASK mode. */ int braceCount = 0; /* Count of all braces '{' '}' seen. */ @@ -1081,100 +1082,100 @@ preferBrace = 1; #endif /* COMPAT */ } while (length) { - if (CHAR_TYPE(*p) != TYPE_NORMAL) { - switch (*p) { - case '{': /* TYPE_BRACE */ -#if COMPAT - braceCount++; -#endif /* COMPAT */ - extra++; /* Escape '{' => '\{' */ - nestingLevel++; - break; - case '}': /* TYPE_BRACE */ -#if COMPAT - braceCount++; -#endif /* COMPAT */ - extra++; /* Escape '}' => '\}' */ - if (nestingLevel-- < 1) { - /* - * Unbalanced braces! Cannot format with brace quoting. - */ - - requireEscape = 1; - } - break; - case ']': /* TYPE_CLOSE_BRACK */ - case '"': /* TYPE_SPACE */ -#if COMPAT - forbidNone = 1; - extra++; /* Escapes all just prepend a backslash */ - preferEscape = 1; - break; -#else - /* FLOW THROUGH */ -#endif /* COMPAT */ - case '[': /* TYPE_SUBS */ - case '$': /* TYPE_SUBS */ - case ';': /* TYPE_COMMAND_END */ - forbidNone = 1; - extra++; /* Escape sequences all one byte longer. */ -#if COMPAT - preferBrace = 1; -#endif /* COMPAT */ - break; - case '\\': /* TYPE_SUBS */ - extra++; /* Escape '\' => '\\' */ - if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) { - /* - * Final backslash. Cannot format with brace quoting. - */ - - requireEscape = 1; - break; - } - if (p[1] == '\n') { - extra++; /* Escape newline => '\n', one byte longer */ - - /* - * Backslash newline sequence. Brace quoting not permitted. - */ - - requireEscape = 1; - length -= (length > 0); - p++; - break; - } - if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) { - extra++; /* Escape sequences all one byte longer. */ - length -= (length > 0); - p++; - } - forbidNone = 1; -#if COMPAT - preferBrace = 1; -#endif /* COMPAT */ - break; - case '\0': /* TYPE_SUBS */ - if (length == TCL_INDEX_NONE) { - goto endOfString; - } - /* TODO: Panic on improper encoding? */ - break; - default: - if (TclIsSpaceProcM(*p)) { - forbidNone = 1; - extra++; /* Escape sequences all one byte longer. */ -#if COMPAT - preferBrace = 1; -#endif - } - break; - } - } + if (CHAR_TYPE(*p) != TYPE_NORMAL) { + switch (*p) { + case '{': /* TYPE_BRACE */ +#if COMPAT + braceCount++; +#endif /* COMPAT */ + extra++; /* Escape '{' => '\{' */ + nestingLevel++; + break; + case '}': /* TYPE_BRACE */ +#if COMPAT + braceCount++; +#endif /* COMPAT */ + extra++; /* Escape '}' => '\}' */ + if (nestingLevel-- < 1) { + /* + * Unbalanced braces! Cannot format with brace quoting. + */ + + requireEscape = 1; + } + break; + case ']': /* TYPE_CLOSE_BRACK */ + case '"': /* TYPE_SPACE */ +#if COMPAT + forbidNone = 1; + extra++; /* Escapes all just prepend a backslash */ + preferEscape = 1; + break; +#else + /* FLOW THROUGH */ +#endif /* COMPAT */ + case '[': /* TYPE_SUBS */ + case '$': /* TYPE_SUBS */ + case ';': /* TYPE_COMMAND_END */ + forbidNone = 1; + extra++; /* Escape sequences all one byte longer. */ +#if COMPAT + preferBrace = 1; +#endif /* COMPAT */ + break; + case '\\': /* TYPE_SUBS */ + extra++; /* Escape '\' => '\\' */ + if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) { + /* + * Final backslash. Cannot format with brace quoting. + */ + + requireEscape = 1; + break; + } + if (p[1] == '\n') { + extra++; /* Escape newline => '\n', one byte longer */ + + /* + * Backslash newline sequence. Brace quoting not permitted. + */ + + requireEscape = 1; + length -= (length > 0); + p++; + break; + } + if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) { + extra++; /* Escape sequences all one byte longer. */ + length -= (length > 0); + p++; + } + forbidNone = 1; +#if COMPAT + preferBrace = 1; +#endif /* COMPAT */ + break; + case '\0': /* TYPE_SUBS */ + if (length == TCL_INDEX_NONE) { + goto endOfString; + } + /* TODO: Panic on improper encoding? */ + break; + default: + if (TclIsSpaceProcM(*p)) { + forbidNone = 1; + extra++; /* Escape sequences all one byte longer. */ +#if COMPAT + preferBrace = 1; +#endif + } + break; + } + } length -= (length > 0); p++; } endOfString: @@ -1321,13 +1322,13 @@ *---------------------------------------------------------------------- */ Tcl_Size Tcl_ConvertElement( - const char *src, /* Source information for list element. */ - char *dst, /* Place to put list-ified element. */ - 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, TCL_INDEX_NONE, dst, flags); } /* @@ -1351,11 +1352,11 @@ *---------------------------------------------------------------------- */ Tcl_Size Tcl_ConvertCountedElement( - const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { Tcl_Size numBytes = TclConvertElement(src, length, dst, flags); @@ -1384,11 +1385,11 @@ *---------------------------------------------------------------------- */ Tcl_Size TclConvertElement( - const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { int conversion = flags & CONVERT_MASK; @@ -1565,11 +1566,11 @@ *---------------------------------------------------------------------- */ char * Tcl_Merge( - Tcl_Size argc, /* How many strings to merge. */ + Tcl_Size argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; Tcl_Size i; @@ -1642,18 +1643,18 @@ *---------------------------------------------------------------------- */ Tcl_Size TclTrimRight( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim) /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim) /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (trim[numTrim] == '\0'). */ { const char *pp, *p = bytes + numBytes; int ch1, ch2; /* Empty strings -> nothing to do */ @@ -1721,18 +1722,18 @@ *---------------------------------------------------------------------- */ Tcl_Size TclTrimLeft( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim) /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim) /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (trim[numTrim] == '\0'). */ { const char *p = bytes; int ch1, ch2; /* Empty strings -> nothing to do */ @@ -1795,25 +1796,24 @@ *---------------------------------------------------------------------- */ Tcl_Size TclTrim( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim, /* ...and its length in bytes */ - /* Calls in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim, /* ...and its length in bytes */ + /* Calls in this routine + * rely on (trim[numTrim] == '\0'). */ Tcl_Size *trimRightPtr) /* Offset from the end of the string. */ { Tcl_Size trimLeft = 0, trimRight = 0; /* Empty strings -> nothing to do */ if ((numBytes > 0) && (numTrim > 0)) { - /* When bytes is NUL-terminated, returns 0 <= trimLeft <= numBytes */ trimLeft = TclTrimLeft(bytes, numBytes, trim, numTrim); numBytes -= trimLeft; /* If we did not trim the whole string, it starts with a character @@ -1857,11 +1857,11 @@ /* The whitespace characters trimmed during [concat] operations */ #define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1) char * Tcl_Concat( - Tcl_Size argc, /* Number of strings to concatenate. */ + Tcl_Size argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { Tcl_Size i, needSpace = 0, bytesNeeded = 0; char *result, *p; @@ -2335,15 +2335,15 @@ */ int TclByteArrayMatch( const unsigned char *string,/* String. */ - Tcl_Size strLen, /* Length of String */ + Tcl_Size strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ - Tcl_Size ptnLen, /* Length of Pattern */ + Tcl_Size ptnLen, /* Length of Pattern */ TCL_UNUSED(int) /*flags*/) { const unsigned char *stringEnd, *patternEnd; unsigned char p; @@ -2615,11 +2615,10 @@ TCL_SIZE_MAX); return NULL; /* NOTREACHED */ } newSize = length + dsPtr->length + 1; - if (newSize > dsPtr->spaceAvl) { if (dsPtr->string == dsPtr->staticSpace) { char *newString; newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); @@ -2807,11 +2806,11 @@ */ void Tcl_DStringSetLength( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - Tcl_Size length) /* New length for dynamic string. */ + Tcl_Size length) /* New length for dynamic string. */ { Tcl_Size newsize; if (length < 0) { length = 0; @@ -3230,23 +3229,23 @@ * element separators, for example.) * end = Tcl_UtfPrev(end, start); while (*end == '{') { - if (end == start) { - return 0; - } - end = Tcl_UtfPrev(end, start); + if (end == start) { + return 0; + } + end = Tcl_UtfPrev(end, start); } * */ while ((--end >= start) && (*end == '{')) { } if (end < start) { - return 0; + return 0; } /* * (c) the trailing character of the string is already a list-element * separator, Use the same testing routine as TclFindElement to @@ -3296,11 +3295,11 @@ Tcl_Size TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ - Tcl_WideInt n) /* The integer to format. */ + Tcl_WideInt n) /* The integer to format. */ { Tcl_WideUInt intVal; int i = 0, numFormatted, j; static const char digits[] = "0123456789"; @@ -3358,29 +3357,29 @@ *---------------------------------------------------------------------- */ static int GetWideForIndex( - Tcl_Interp *interp, /* Interpreter to use for error reporting. If + Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ - Tcl_Obj *objPtr, /* Points to the value to be parsed */ - Tcl_WideInt endValue, /* The value to be stored at *widePtr if + Tcl_Obj *objPtr, /* Points to the value to be parsed */ + Tcl_WideInt endValue, /* The value to be stored at *widePtr if * objPtr holds "end". - * NOTE: this value may be TCL_INDEX_NONE. */ - Tcl_WideInt *widePtr) /* Location filled in with a wide integer - * representing an index. */ + * NOTE: this value may be TCL_INDEX_NONE. */ + Tcl_WideInt *widePtr) /* Location filled in with a wide integer + * representing an index. */ { int numType; void *cd; int code = Tcl_GetNumberFromObj(NULL, objPtr, &cd, &numType); if (code == TCL_OK) { if (numType == TCL_NUMBER_INT) { /* objPtr holds an integer in the signed wide range */ *widePtr = *(Tcl_WideInt *)cd; - if ((*widePtr < 0)) { + if ((*widePtr < 0)) { *widePtr = (endValue == -1) ? WIDE_MIN : -1; } return TCL_OK; } if (numType == TCL_NUMBER_BIG) { @@ -3451,14 +3450,14 @@ if (wide >= 0 && wide <= TCL_SIZE_MAX) { *indexPtr = (Tcl_Size)wide; /* A valid index */ } else if (wide > TCL_SIZE_MAX) { *indexPtr = TCL_SIZE_MAX; /* Beyond max possible index */ } else if (wide < -1-TCL_SIZE_MAX) { - *indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */ - } else if ((wide < 0) && (endValue >= 0)) { - *indexPtr = TCL_INDEX_NONE; /* No clue why this special case */ - } else { + *indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */ + } else if ((wide < 0) && (endValue >= 0)) { + *indexPtr = TCL_INDEX_NONE; /* No clue why this special case */ + } else { *indexPtr = (Tcl_Size) wide; } } return TCL_OK; } @@ -3493,15 +3492,15 @@ */ static int GetEndOffsetFromObj( Tcl_Interp *interp, - Tcl_Obj *objPtr, /* Pointer to the object to parse */ - Tcl_WideInt endValue, /* The value to be stored at "widePtr" if - * "objPtr" holds "end". */ - Tcl_WideInt *widePtr) /* Location filled in with an integer - * representing an index. */ + Tcl_Obj *objPtr, /* Pointer to the object to parse */ + Tcl_WideInt endValue, /* The value to be stored at "widePtr" if + * "objPtr" holds "end". */ + Tcl_WideInt *widePtr) /* Location filled in with an integer + * representing an index. */ { Tcl_ObjInternalRep *irPtr; Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */ void *cd; @@ -3530,18 +3529,18 @@ * Quick scan to see if multi-value list is even possible. * This relies on TclGetString() returning a NUL-terminated string. */ if ((TclMaxListLength(bytes, TCL_INDEX_NONE, NULL) > 1) /* If it's possible, do the full list parse. */ - && (TCL_OK == TclListObjLength(NULL, objPtr, &length)) - && (length > 1)) { - goto parseError; + && (TCL_OK == TclListObjLength(NULL, objPtr, &length)) + && (length > 1)) { + goto parseError; } /* Passed the list screen, so parse for index arithmetic expression */ if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE, &opPtr, - TCL_PARSE_INTEGER_ONLY)) { + TCL_PARSE_INTEGER_ONLY)) { Tcl_WideInt w1=0, w2=0; /* value starts with valid integer... */ if ((*opPtr == '-') || (*opPtr == '+')) { @@ -3696,16 +3695,16 @@ offset = irPtr->wideValue; if (offset == WIDE_MAX) { /* * Encodes end+1. This is distinguished from end+n as noted - * in function header. + * in function header. * NOTE: this may wrap around if the caller passes (as lset does) * listLen-1 as endValue and and listLen is 0. The -1 will be * interpreted as FF...FF and adding 1 will result in 0 which * is what we want. Callers like lset which pass in listLen-1 == -1 - * as endValue will have to adjust accordingly. + * as endValue will have to adjust accordingly. */ *widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1; } else if (offset == WIDE_MIN) { /* -1 - position before first */ *widePtr = -1; @@ -3722,18 +3721,18 @@ return TCL_OK; /* Report a parse error. */ parseError: if (interp != NULL) { - char * bytes = TclGetString(objPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad index \"%s\": must be integer?[+-]integer? or" - " end?[+-]integer?", bytes)); - if (!strncmp(bytes, "end-", 4)) { - bytes += 4; - } - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL); + char * bytes = TclGetString(objPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\": must be integer?[+-]integer? or" + " end?[+-]integer?", bytes)); + if (!strncmp(bytes, "end-", 4)) { + bytes += 4; + } + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL); } return TCL_ERROR; } @@ -3796,15 +3795,15 @@ *---------------------------------------------------------------------- */ 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 */ - int *indexPtr) /* Where to write the encoded answer, not NULL */ + 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 */ + int *indexPtr) /* Where to write the encoded answer, not NULL */ { Tcl_WideInt wide; int idx; const Tcl_WideInt ENDVALUE = 2 * (Tcl_WideInt) INT_MAX; @@ -3919,13 +3918,12 @@ *indexPtr = idx; return TCL_OK; rangeerror: if (interp) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" out of range", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (void *)NULL); } return TCL_ERROR; } @@ -3944,12 +3942,12 @@ *---------------------------------------------------------------------- */ Tcl_Size TclIndexDecode( - int encoded, /* Value to decode */ - Tcl_Size endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ + int encoded, /* Value to decode */ + Tcl_Size endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ { if (encoded > TCL_INDEX_END) { return encoded; } endValue += encoded - TCL_INDEX_END; @@ -3974,12 +3972,12 @@ * *------------------------------------------------------------------------ */ int TclCommandWordLimitError( - Tcl_Interp *interp, /* May be NULL */ - Tcl_Size count) /* If <= 0, "unknown" */ + Tcl_Interp *interp, /* May be NULL */ + Tcl_Size count) /* If <= 0, "unknown" */ { if (interp) { if (count > 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Number of words (%" TCL_SIZE_MODIFIER @@ -4041,12 +4039,12 @@ static Tcl_HashTable * GetThreadHash( Tcl_ThreadDataKey *keyPtr) { - Tcl_HashTable **tablePtrPtr = - (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); + Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **) + Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); if (NULL == *tablePtrPtr) { *tablePtrPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr); Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS); Index: generic/tclVar.c ================================================================== --- generic/tclVar.c +++ generic/tclVar.c @@ -250,53 +250,53 @@ "localVarName", FreeLocalVarName, DupLocalVarName, NULL, NULL, TCL_OBJTYPE_V0 }; -#define LocalSetInternalRep(objPtr, index, namePtr) \ +#define LocalSetInternalRep(objPtr, index, namePtr) \ do { \ Tcl_ObjInternalRep ir; \ Tcl_Obj *ptr = (namePtr); \ if (ptr) {Tcl_IncrRefCount(ptr);} \ ir.twoPtrValue.ptr1 = ptr; \ ir.twoPtrValue.ptr2 = INT2PTR(index); \ Tcl_StoreInternalRep((objPtr), &localVarNameType, &ir); \ } while (0) -#define LocalGetInternalRep(objPtr, index, name) \ +#define LocalGetInternalRep(objPtr, index, name) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \ - (name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \ + (name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \ } while (0) static const Tcl_ObjType parsedVarNameType = { "parsedVarName", FreeParsedVarName, DupParsedVarName, NULL, NULL, TCL_OBJTYPE_V0 }; -#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \ +#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \ do { \ Tcl_ObjInternalRep ir; \ Tcl_Obj *ptr1 = (arrayPtr); \ Tcl_Obj *ptr2 = (elem); \ if (ptr1) {Tcl_IncrRefCount(ptr1);} \ if (ptr2) {Tcl_IncrRefCount(ptr2);} \ ir.twoPtrValue.ptr1 = ptr1; \ ir.twoPtrValue.ptr2 = ptr2; \ - Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir); \ + Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir); \ } while (0) -#define ParsedGetInternalRep(objPtr, parsed, array, elem) \ +#define ParsedGetInternalRep(objPtr, parsed, array, elem) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &parsedVarNameType); \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &parsedVarNameType); \ (parsed) = (irPtr != NULL); \ - (array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ - (elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ + (array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ + (elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) Var * TclVarHashCreateVar( TclVarHashTable *tablePtr, @@ -529,24 +529,24 @@ */ Var * TclObjLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ - Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an + Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an * array. Otherwise, this is a full variable * name that could include a parenthesized * array element. */ const char *part2, /* Name of element within array, or NULL. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * and TCL_LEAVE_ERR_MSG bits matter. */ const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ - int createPart1, /* If 1, create hash table entry for part 1 of + int createPart1, /* If 1, create hash table entry for part 1 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ - int createPart2, /* If 1, create hash table entry for part 2 of + int createPart2, /* If 1, create hash table entry for part 2 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var **arrayPtrPtr) /* If the name refers to an element of an * array, *arrayPtrPtr gets filled in with * address of array variable. Otherwise this @@ -589,24 +589,24 @@ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * and TCL_LEAVE_ERR_MSG bits matter. */ const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ - int createPart1, /* If 1, create hash table entry for part 1 of + int createPart1, /* If 1, create hash table entry for part 1 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ - int createPart2, /* If 1, create hash table entry for part 2 of + int createPart2, /* If 1, create hash table entry for part 2 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var **arrayPtrPtr) /* If the name refers to an element of an * array, *arrayPtrPtr gets filled in with * address of array variable. Otherwise this * is set to NULL. */ { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; - Var *varPtr; /* Points to the variable's in-frame Var + Var *varPtr; /* Points to the variable's in-frame Var * structure. */ const char *errMsg = NULL; int index, parsed = 0; Tcl_Size localIndex; @@ -825,11 +825,11 @@ Tcl_Obj *varNamePtr, /* This is a simple variable name that could * represent a scalar or an array. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG * bits matter. */ - int create, /* If 1, create hash table entry for varname, + int create, /* If 1, create hash table entry for varname, * if it doesn't already exist. If 0, return * error if it doesn't exist. */ const char **errMsgPtr, int *indexPtr) { @@ -1058,19 +1058,19 @@ TclLookupArrayElement( Tcl_Interp *interp, /* Interpreter to use for lookup. */ Tcl_Obj *arrayNamePtr, /* This is the name of the array, or NULL if * index>= 0. */ Tcl_Obj *elNamePtr, /* Name of element within array. */ - int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */ + int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */ const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ - int createArray, /* If 1, transform arrayName to be an array if + int createArray, /* If 1, transform arrayName to be an array if * it isn't one yet and the transformation is * possible. If 0, return error if it isn't * already an array. */ - int createElem, /* If 1, create hash table entry for the + int createElem, /* If 1, create hash table entry for the * element, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var *arrayPtr, /* Pointer to the array's Var structure. */ int index) /* If >=0, the index of the local array. */ { @@ -1275,14 +1275,14 @@ Tcl_Obj * Tcl_ObjGetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - Tcl_Obj *part1Ptr, /* Points to an object holding the name of an + Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ - Tcl_Obj *part2Ptr, /* If non-null, points to an object holding + Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG bits. */ { @@ -1334,11 +1334,11 @@ * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ - int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { if (varPtr == NULL) { Tcl_Panic("varPtr must not be NULL"); } @@ -1373,18 +1373,18 @@ Tcl_Obj * TclPtrGetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - Var *varPtr, /* The variable to be read.*/ + Var *varPtr, /* The variable to be read.*/ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ - int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { @@ -1481,11 +1481,11 @@ */ int Tcl_SetObjCmd( TCL_UNUSED(void *), - Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *varValueObj; @@ -1658,14 +1658,14 @@ Tcl_Obj * Tcl_ObjSetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ - Tcl_Obj *part1Ptr, /* Points to an object holding the name of an + Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ - Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding + Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *newValuePtr, /* New value for variable. */ int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, @@ -1729,11 +1729,11 @@ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ - int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { if (varPtr == NULL) { Tcl_Panic("varPtr must not be NULL"); } @@ -1898,21 +1898,21 @@ Tcl_Obj * TclPtrSetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - Var *varPtr, /* Reference to the variable to set. */ + Var *varPtr, /* Reference to the variable to set. */ Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. NULL if the 'index' * parameter is >= 0 */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ - int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ int index) /* Index of local var where part1 is to be * found. */ { Interp *iPtr = (Interp *) interp; @@ -2167,11 +2167,11 @@ Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *incrPtr, /* Increment value. */ /* TODO: Which of these flag values really make sense? */ - int flags) /* Various flags that tell how to incr value: + int flags) /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ { if (varPtr == NULL) { @@ -2223,11 +2223,11 @@ Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *incrPtr, /* Increment value. */ /* TODO: Which of these flag values really make sense? */ - int flags, /* Various flags that tell how to incr value: + int flags, /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is @@ -2412,11 +2412,11 @@ * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ - int flags) /* OR-ed combination of any of + int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { if (varPtr == NULL) { Tcl_Panic("varPtr must not be NULL"); @@ -2503,11 +2503,11 @@ */ if (result != TCL_OK) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", - ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index); + ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index); Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", (char *)NULL); } } /* @@ -2611,27 +2611,27 @@ } } if ((dummyVar.flags & VAR_TRACED_UNSET) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) { - - /* - * Pass the array element name to TclObjCallVarTraces(), because - * it cannot be determined from dummyVar. Alternatively, indicate - * via flags whether the variable involved in the code that caused - * the trace to be triggered was an array element, for the correct - * formatting of error messages. - */ - if (part2Ptr) { - flags |= VAR_ARRAY_ELEMENT; - } else if (TclIsVarArrayElement(varPtr)) { - part2Ptr = VarHashGetKey(varPtr); - } + /* + * Pass the array element name to TclObjCallVarTraces(), because + * it cannot be determined from dummyVar. Alternatively, indicate + * via flags whether the variable involved in the code that caused + * the trace to be triggered was an array element, for the correct + * formatting of error messages. + */ + + if (part2Ptr) { + flags |= VAR_ARRAY_ELEMENT; + } else if (TclIsVarArrayElement(varPtr)) { + part2Ptr = VarHashGetKey(varPtr); + } dummyVar.flags &= ~VAR_TRACE_ACTIVE; TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr, - (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT)) + (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT)) | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0, index); /* * The traces that we just called may have triggered a change in @@ -2801,12 +2801,11 @@ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Var *varPtr, *arrayPtr; - Tcl_Obj *varValuePtr = NULL; - /* Initialized to avoid compiler warning. */ + Tcl_Obj *varValuePtr = NULL;/* Initialized to avoid compiler warning. */ int i; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?"); return TCL_ERROR; @@ -4299,11 +4298,11 @@ { Var *varPtr, *varPtr2, *protectedVarPtr; Tcl_Obj *varNameObj, *patternObj, *nameObj; Tcl_HashSearch search; const char *pattern; - int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */ + int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */ int isArray; switch (objc) { case 2: varNameObj = objv[1]; @@ -4478,11 +4477,11 @@ * error messages, too. */ CallFrame *framePtr, /* Call frame containing "other" variable. * NULL means use global :: context. */ Tcl_Obj *otherP1Ptr, const char *otherP2, /* Two-part name of variable in framePtr. */ - int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: + int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of "other" variable. */ Tcl_Obj *myNamePtr, /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of myName. */ @@ -5335,11 +5334,11 @@ */ static void DeleteSearches( Interp *iPtr, - Var *arrayVarPtr) /* Variable whose searches are to be + Var *arrayVarPtr) /* Variable whose searches are to be * deleted. */ { ArraySearch *searchPtr, *nextPtr; Tcl_HashEntry *sPtr; @@ -6804,11 +6803,11 @@ Tcl_DecrRefCount(objPtr); } 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 = (Tcl_Obj *)keyPtr; Tcl_Obj *objPtr2 = hPtr->key.objPtr; const char *p1, *p2; @@ -7000,11 +6999,12 @@ void TclInitArrayVar( Var *arrayPtr) { - ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)Tcl_Alloc(sizeof(ArrayVarHashTable)); + ArrayVarHashTable *tablePtr = (ArrayVarHashTable *) + Tcl_Alloc(sizeof(ArrayVarHashTable)); /* * Mark the variable as an array. */ @@ -7084,17 +7084,17 @@ * lappend v(a) 2; # returns a new object {1 2} * set v(b); # returns the original default object "1" */ if (tablePtr->defaultObj) { - Tcl_DecrRefCount(tablePtr->defaultObj); - Tcl_DecrRefCount(tablePtr->defaultObj); + Tcl_DecrRefCount(tablePtr->defaultObj); + Tcl_DecrRefCount(tablePtr->defaultObj); } tablePtr->defaultObj = defaultObj; if (tablePtr->defaultObj) { - Tcl_IncrRefCount(tablePtr->defaultObj); - Tcl_IncrRefCount(tablePtr->defaultObj); + Tcl_IncrRefCount(tablePtr->defaultObj); + Tcl_IncrRefCount(tablePtr->defaultObj); } } /* * Local Variables: Index: generic/tclZipfs.c ================================================================== --- generic/tclZipfs.c +++ generic/tclZipfs.c @@ -99,68 +99,132 @@ #define ZIP_SIG_LEN 4 /* * Local header of ZIP archive member (at very beginning of each member). + * + * The structure is one of these, but packed and guaranteed to be little endian: + +struct ZipLocalMemberHeader { + uint32_t signature; // = ZIP_LOCAL_HEADER_SIG + uint16_t version; // version needed to extract + uint16_t flags; // general purpose bit flag + uint16_t compressionMethod; // compression method + uint16_t modifiedTime; // last mod file time + uint16_t modifiedDate; // last mod file date + uint32_t crc32; // crc-32 + uint32_t compressedLength; // compressed size + uint32_t uncompressedLength;// uncompressed size + uint16_t pathLength; // file name length + uint16_t extraLength; // extra field length +}; */ - +enum ZipLocalMemberHeaderOffsets { #define ZIP_LOCAL_HEADER_SIG 0x04034b50 -#define ZIP_LOCAL_HEADER_LEN 30 -#define ZIP_LOCAL_SIG_OFFS 0 -#define ZIP_LOCAL_VERSION_OFFS 4 -#define ZIP_LOCAL_FLAGS_OFFS 6 -#define ZIP_LOCAL_COMPMETH_OFFS 8 -#define ZIP_LOCAL_MTIME_OFFS 10 -#define ZIP_LOCAL_MDATE_OFFS 12 -#define ZIP_LOCAL_CRC32_OFFS 14 -#define ZIP_LOCAL_COMPLEN_OFFS 18 -#define ZIP_LOCAL_UNCOMPLEN_OFFS 22 -#define ZIP_LOCAL_PATHLEN_OFFS 26 -#define ZIP_LOCAL_EXTRALEN_OFFS 28 + ZIP_LOCAL_SIG_OFFS = 0, + ZIP_LOCAL_VERSION_OFFS = 4, + ZIP_LOCAL_FLAGS_OFFS = 6, + ZIP_LOCAL_COMPMETH_OFFS = 8, + ZIP_LOCAL_MTIME_OFFS = 10, + ZIP_LOCAL_MDATE_OFFS = 12, + ZIP_LOCAL_CRC32_OFFS = 14, + ZIP_LOCAL_COMPLEN_OFFS = 18, + ZIP_LOCAL_UNCOMPLEN_OFFS = 22, + ZIP_LOCAL_PATHLEN_OFFS = 26, + ZIP_LOCAL_EXTRALEN_OFFS = 28, + ZIP_LOCAL_HEADER_LEN = 30 /* Length of header */ +}; /* * Central header of ZIP archive member at end of ZIP file. + * + * The structure is one of these, but packed and guaranteed to be little endian: + +struct ZipCentralMemberHeader { + uint32_t signature; // = ZIP_CENTRAL_HEADER_SIG + uint16_t versionMade; // version made by + uint16_t version; // version needed to extract + uint16_t flags; // general purpose bit flag + uint16_t compressionMethod; // compression method + uint16_t modifiedTime; // last mod file time + uint16_t modifiedDate; // last mod file date + uint32_t crc32; // crc-32 + uint32_t compressedLength; // compressed size + uint32_t uncompressedLength;// uncompressed size + uint16_t pathLength; // file name length + uint16_t extraLength; // extra field length + uint16_t commentLength; // file comment length + uint16_t diskFile; // disk number start + uint16_t iattr; // internal file attributes + uint32_t eattr; // external file attributes + uint32_t localHeader; // relative offset of local header +}; */ - +enum ZipCentralMemberHeaderOffsets { #define ZIP_CENTRAL_HEADER_SIG 0x02014b50 -#define ZIP_CENTRAL_HEADER_LEN 46 -#define ZIP_CENTRAL_SIG_OFFS 0 -#define ZIP_CENTRAL_VERSIONMADE_OFFS 4 -#define ZIP_CENTRAL_VERSION_OFFS 6 -#define ZIP_CENTRAL_FLAGS_OFFS 8 -#define ZIP_CENTRAL_COMPMETH_OFFS 10 -#define ZIP_CENTRAL_MTIME_OFFS 12 -#define ZIP_CENTRAL_MDATE_OFFS 14 -#define ZIP_CENTRAL_CRC32_OFFS 16 -#define ZIP_CENTRAL_COMPLEN_OFFS 20 -#define ZIP_CENTRAL_UNCOMPLEN_OFFS 24 -#define ZIP_CENTRAL_PATHLEN_OFFS 28 -#define ZIP_CENTRAL_EXTRALEN_OFFS 30 -#define ZIP_CENTRAL_FCOMMENTLEN_OFFS 32 -#define ZIP_CENTRAL_DISKFILE_OFFS 34 -#define ZIP_CENTRAL_IATTR_OFFS 36 -#define ZIP_CENTRAL_EATTR_OFFS 38 -#define ZIP_CENTRAL_LOCALHDR_OFFS 42 + ZIP_CENTRAL_SIG_OFFS = 0, + ZIP_CENTRAL_VERSIONMADE_OFFS = 4, + ZIP_CENTRAL_VERSION_OFFS = 6, + ZIP_CENTRAL_FLAGS_OFFS = 8, + ZIP_CENTRAL_COMPMETH_OFFS = 10, + ZIP_CENTRAL_MTIME_OFFS = 12, + ZIP_CENTRAL_MDATE_OFFS = 14, + ZIP_CENTRAL_CRC32_OFFS = 16, + ZIP_CENTRAL_COMPLEN_OFFS = 20, + ZIP_CENTRAL_UNCOMPLEN_OFFS = 24, + ZIP_CENTRAL_PATHLEN_OFFS = 28, + ZIP_CENTRAL_EXTRALEN_OFFS = 30, + ZIP_CENTRAL_FCOMMENTLEN_OFFS = 32, + ZIP_CENTRAL_DISKFILE_OFFS = 34, + ZIP_CENTRAL_IATTR_OFFS = 36, + ZIP_CENTRAL_EATTR_OFFS = 38, + ZIP_CENTRAL_LOCALHDR_OFFS = 42, + ZIP_CENTRAL_HEADER_LEN = 46 /* Length of directory entry header */ +}; /* * Central end signature at very end of ZIP file. + * + * The structure is one of these, but packed and guaranteed to be little endian: + +struct ZipMainHeader { + uint32_t signature; // = ZIP_CENTRAL_END_SIG + uint16_t diskNumber; // number of this disk + uint16_t diskDir; // number of the disk with the + // start of the central directory + uint16_t entities; // total number of entries in the + // central directory on this disk + uint16_t totalEntities; // total number of entries in + // the central directory + uint32_t dirSize; // size of the central directory + uint32_t dirStart; // offset of start of central + // directory with respect to + // the starting disk number + uint16_t commentLen; // .ZIP file comment length + char comment[]; // .ZIP file comment +}; */ - +enum ZipMainHeaderOffsets { #define ZIP_CENTRAL_END_SIG 0x06054b50 -#define ZIP_CENTRAL_END_LEN 22 -#define ZIP_CENTRAL_END_SIG_OFFS 0 -#define ZIP_CENTRAL_DISKNO_OFFS 4 -#define ZIP_CENTRAL_DISKDIR_OFFS 6 -#define ZIP_CENTRAL_ENTS_OFFS 8 -#define ZIP_CENTRAL_TOTALENTS_OFFS 10 -#define ZIP_CENTRAL_DIRSIZE_OFFS 12 -#define ZIP_CENTRAL_DIRSTART_OFFS 16 -#define ZIP_CENTRAL_COMMENTLEN_OFFS 20 + ZIP_CENTRAL_END_SIG_OFFS = 0, + ZIP_CENTRAL_DISKNO_OFFS = 4, + ZIP_CENTRAL_DISKDIR_OFFS= 6, + ZIP_CENTRAL_ENTS_OFFS = 8, + ZIP_CENTRAL_TOTALENTS_OFFS = 10, + ZIP_CENTRAL_DIRSIZE_OFFS = 12, + ZIP_CENTRAL_DIRSTART_OFFS = 16, + ZIP_CENTRAL_COMMENTLEN_OFFS = 20, + ZIP_CENTRAL_END_LEN = 22 /* Length of archive "header" */ +}; #define ZIP_MIN_VERSION 20 -#define ZIP_COMPMETH_STORED 0 -#define ZIP_COMPMETH_DEFLATED 8 + +/* Supported compression methods. */ +enum ZipCompressionMethods { + ZIP_COMPMETH_STORED = 0, /* The file is stored (no compression) */ + ZIP_COMPMETH_DEFLATED = 8 /* The file is Deflated */ +}; #define ZIP_PASSWORD_END_SIG 0x5a5a4b50 #define ZIP_CRYPT_HDR_LEN 12 #define ZIP_MAX_FILE_SIZE INT_MAX @@ -194,11 +258,11 @@ void *ptrToFree; /* Non-NULL if malloc'ed file */ size_t numFiles; /* Number of files in archive */ size_t baseOffset; /* Archive start */ size_t passOffset; /* Password start */ size_t directoryOffset; /* Archive directory start */ - size_t directorySize; /* Size of archive directory */ + size_t directorySize; /* Size of archive directory */ unsigned char passBuf[264]; /* Password buffer */ size_t numOpen; /* Number of open files on archive */ struct ZipEntry *entries; /* List of files in archive */ struct ZipEntry *topEnts; /* List of top-level dirs in archive */ char *mountPoint; /* Mount point name */ @@ -215,27 +279,30 @@ typedef struct ZipEntry { char *name; /* The full pathname of the virtual file */ ZipFile *zipFilePtr; /* The ZIP file holding this virtual file */ size_t offset; /* Data offset into memory mapped ZIP file */ int numBytes; /* Uncompressed size of the virtual file. - -1 for zip64 */ + * -1 for zip64 */ int numCompressedBytes; /* Compressed size of the virtual file. - -1 for zip64 */ + * -1 for zip64 */ int compressMethod; /* Compress method */ int isDirectory; /* 0 if file, 1 if directory, -1 if root */ int depth; /* Number of slashes in path. */ int crc32; /* CRC-32 as stored in ZIP */ int timestamp; /* Modification time */ int isEncrypted; /* True if data is encrypted */ int flags; -#define ZE_F_CRC_COMPARED 0x0001 /* If 1, the CRC has been compared. */ -#define ZE_F_CRC_CORRECT 0x0002 /* Only meaningful if ZE_F_CRC_COMPARED is 1 */ -#define ZE_F_VOLUME 0x0004 /* Entry corresponds to //zipfs:/ */ unsigned char *data; /* File data if written */ struct ZipEntry *next; /* Next file in the same archive */ struct ZipEntry *tnext; /* Next top-level dir in archive */ } ZipEntry; + +enum ZipEntryFlags { + ZE_F_CRC_COMPARED = 1, /* The CRC has been compared. */ + ZE_F_CRC_CORRECT = 2, /* Only meaningful if ZE_F_CRC_COMPARED is set */ + ZE_F_VOLUME = 4 /* Entry corresponds to //zipfs:/ */ +}; /* * File channel for file contained in mounted ZIP archive. * * Regarding data buffers: @@ -255,15 +322,15 @@ ZipEntry *zipEntryPtr; /* Pointer back to virtual file */ Tcl_Size maxWrite; /* Maximum size for write */ Tcl_Size numBytes; /* Number of bytes of uncompressed data */ Tcl_Size cursor; /* Seek position for next read or write*/ unsigned char *ubuf; /* Pointer to the uncompressed data */ - unsigned char *ubufToFree; /* NULL if ubuf points to memory that does not - need freeing. Else memory to free (ubuf - may point *inside* the block) */ + unsigned char *ubufToFree; /* NULL if ubuf points to memory that does not + * need freeing. Else memory to free (ubuf + * may point *inside* the block) */ Tcl_Size ubufSize; /* Size of allocated ubufToFree */ - int iscompr; /* True if data is compressed */ + int iscompr; /* True if data is compressed */ int isDirectory; /* Set to 1 if directory, or -1 if root */ int isEncrypted; /* True if data is encrypted */ int mode; /* O_WRITE, O_APPEND, O_TRUNC etc.*/ unsigned long keys[3]; /* Key for decryption */ } ZipChannel; @@ -808,15 +875,17 @@ * left in interp if not NULL. * *------------------------------------------------------------------------ */ static int -DecodeCryptHeader(Tcl_Interp *interp, - ZipEntry *z, - unsigned long keys[3],/* Updated on success. Must have been - initialized by caller. */ - unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) /* From zip file content */ +DecodeCryptHeader( + Tcl_Interp *interp, + ZipEntry *z, + unsigned long keys[3], /* Updated on success. Must have been + * initialized by caller. */ + unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) + /* From zip file content */ { int i; int ch; int len = z->zipFilePtr->passBuf[0] & 0xFF; char passBuf[260]; @@ -871,11 +940,11 @@ static char * DecodeZipEntryText( const unsigned char *inputBytes, unsigned int inputLength, - Tcl_DString *dstPtr) /* Must have been initialized by caller! */ + Tcl_DString *dstPtr) /* Must have been initialized by caller! */ { Tcl_Encoding encoding; const char *src; char *dst; int dstLen, srcLen = inputLength, flags; @@ -976,13 +1045,14 @@ * TCL_ERROR on fail with error message in interp if not NULL * *------------------------------------------------------------------------ */ static int -NormalizeMountPoint(Tcl_Interp *interp, - const char *mountPath, - Tcl_DString *dsPtr) /* Must be initialized by caller! */ +NormalizeMountPoint( + Tcl_Interp *interp, + const char *mountPath, + Tcl_DString *dsPtr) /* Must be initialized by caller! */ { const char *joiner[2]; char *joinedPath; Tcl_Obj *unnormalizedObj; Tcl_Obj *normalizedObj; @@ -1063,15 +1133,15 @@ * Stores mapped path in dsPtr. * *------------------------------------------------------------------------ */ static char * -MapPathToZipfs(Tcl_Interp *interp, - const char *mountPath, /* Must be fully normalized */ - const char *path, /* Archive content path to map */ - Tcl_DString *dsPtr) /* Must be initialized and cleared - by caller */ +MapPathToZipfs( + Tcl_Interp *interp, + const char *mountPath, /* Must be fully normalized */ + const char *path, /* Archive content path to map */ + Tcl_DString *dsPtr) /* Must be initialized and cleared by caller */ { const char *joiner[2]; char *joinedPath; Tcl_Obj *unnormalizedObj; Tcl_Obj *normalizedObj; @@ -1436,14 +1506,13 @@ return TCL_OK; } ZIPFS_ERROR(interp, "archive directory end signature not found"); ZIPFS_ERROR_CODE(interp, "END_SIG"); - error: + error: ZipFSCloseArchive(interp, zf); return TCL_ERROR; - } /* * eocdPtr -> End of Central Directory (EOCD) record at this point. * Note this is not same as "end of Central Directory" :-) as EOCD @@ -1655,11 +1724,11 @@ zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); if (zf->length == (size_t) TCL_INDEX_NONE) { ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } - /* What's the magic about 64 * 1024 * 1024 ? */ + /* What's the magic about 64 * 1024 * 1024 ? */ if ((zf->length <= ZIP_CENTRAL_END_LEN) || (zf->length - ZIP_CENTRAL_END_LEN) > (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) { ZIPFS_ERROR(interp, "illegal file size"); ZIPFS_ERROR_CODE(interp, "FILE_SIZE"); @@ -2225,14 +2294,16 @@ * Side effects: * Memory associated with the mounted archive is deallocated. *------------------------------------------------------------------------ */ static void -CleanupMount(ZipFile *zf) /* Mount point */ +CleanupMount( + ZipFile *zf) /* Mount point */ { ZipEntry *z, *znext; Tcl_HashEntry *hPtr; + for (z = zf->entries; z; z = znext) { znext = z->next; hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); if (hPtr) { Tcl_DeleteHashEntry(hPtr); @@ -2370,11 +2441,11 @@ ret = ZipFSOpenArchive(interp, normPath, 1, zf); if (ret != TCL_OK) { Tcl_Free(zf); } else { ret = ZipFSCatalogFilesystem( - interp, zf, mountPoint, passwd, normPath); + interp, zf, mountPoint, passwd, normPath); /* Note zf is already freed on error! */ } } } Tcl_DecrRefCount(normZipPathObj); @@ -2477,11 +2548,11 @@ if (ret != TCL_OK) { Tcl_Free(zf); } else { /* Note ZipFSCatalogFilesystem will free zf on error */ ret = ZipFSCatalogFilesystem( - interp, zf, mountPoint, NULL, "Memory Buffer"); + interp, zf, mountPoint, NULL, "Memory Buffer"); } if (ret == TCL_OK && interp) { Tcl_DStringResult(interp, &ds); } @@ -3274,11 +3345,11 @@ Tcl_Obj *pathObj, /* The path to the origin file */ Tcl_Obj *directNameObj, /* User-specified name for use in the ZIP * archive */ const char *strip, /* A prefix to strip; may be NULL if no * stripping need be done. */ - Tcl_Size slen) /* The length of the prefix; must be 0 if no + Tcl_Size slen) /* The length of the prefix; must be 0 if no * stripping need be done. */ { const char *name; Tcl_Size len; @@ -3350,12 +3421,12 @@ Tcl_Channel out; int count, ret = TCL_ERROR; Tcl_Size pwlen = 0, slen = 0, len, i = 0; Tcl_Size lobjc; long long directoryStartOffset; - /* The overall file offset of the start of the - * central directory. */ + /* The overall file offset of the start of the + * central directory. */ long long suffixStartOffset;/* The overall file offset of the start of the * suffix of the central directory (i.e., * where this data will be written). */ Tcl_Obj **lobjv, *list = mappingList; ZipEntry *z; @@ -4393,13 +4464,13 @@ * Copy channel data back into original file in archive. */ ZipEntry *z = info->zipEntryPtr; assert(info->ubufToFree && info->ubuf); unsigned char *newdata; - newdata = (unsigned char *)Tcl_AttemptRealloc( - info->ubufToFree, - info->numBytes ? info->numBytes : 1); /* Bug [23dd83ce7c] */ + newdata = (unsigned char *) Tcl_AttemptRealloc( + info->ubufToFree, + info->numBytes ? info->numBytes : 1); /* Bug [23dd83ce7c] */ if (newdata == NULL) { /* Could not reallocate, keep existing buffer */ newdata = info->ubufToFree; } info->ubufToFree = NULL; /* Now newdata! */ @@ -4570,12 +4641,12 @@ if (needed < (info->maxWrite - needed/2)) { needed += needed / 2; } else { needed = info->maxWrite; } - unsigned char *newBuf = - (unsigned char *)Tcl_AttemptRealloc(info->ubufToFree, needed); + unsigned char *newBuf = (unsigned char *) + Tcl_AttemptRealloc(info->ubufToFree, needed); if (newBuf == NULL) { *errloc = ENOMEM; return -1; } info->ubufToFree = newBuf; @@ -5541,22 +5612,21 @@ if (types) { wanted = types->type; if ((wanted & TCL_GLOB_TYPE_MOUNT) && (wanted != TCL_GLOB_TYPE_MOUNT)) { if (interp) { ZIPFS_ERROR(interp, - "Internal error: TCL_GLOB_TYPE_MOUNT should not " - "be set in conjunction with other glob types."); + "Internal error: TCL_GLOB_TYPE_MOUNT should not " + "be set in conjunction with other glob types."); } return TCL_ERROR; } if ((wanted & (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | TCL_GLOB_TYPE_MOUNT)) == 0) { /* Not looking for files,dirs,mounts. zipfs cannot have others */ return TCL_OK; } - wanted &= - (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | TCL_GLOB_TYPE_MOUNT); + wanted &= TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | TCL_GLOB_TYPE_MOUNT; } else { wanted = TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE; } /* @@ -6513,11 +6583,11 @@ int TclZipfs_Mount( Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(const char *), /* Path to ZIP file to mount. */ TCL_UNUSED(const char *), /* Mount point path. */ - TCL_UNUSED(const char *)) /* Password for opening the ZIP, or NULL if + TCL_UNUSED(const char *)) /* Password for opening the ZIP, or NULL if * the ZIP is unprotected. */ { ZIPFS_ERROR(interp, "no zlib available"); ZIPFS_ERROR_CODE(interp, "NO_ZLIB"); return TCL_ERROR; @@ -6550,11 +6620,11 @@ TclZipfs_AppHook( TCL_UNUSED(int *), /*argcPtr*/ #ifdef _WIN32 TCL_UNUSED(WCHAR ***)) /* argvPtr */ #else /* !_WIN32 */ - TCL_UNUSED(char ***)) /* Pointer to argv */ + TCL_UNUSED(char ***)) /* Pointer to argv */ #endif /* _WIN32 */ { return NULL; } Index: generic/tclZlib.c ================================================================== --- generic/tclZlib.c +++ generic/tclZlib.c @@ -80,13 +80,15 @@ int flags; /* Miscellaneous flag bits. */ GzipHeader *gzHeaderPtr; /* If we've allocated a gzip header * structure. */ } ZlibStreamHandle; -#define DICT_TO_SET 0x1 /* If we need to set a compression dictionary +enum ZlibStreamHandleFlags { + DICT_TO_SET = 0x1 /* If we need to set a compression dictionary * in the low-level engine at the next * opportunity. */ +}; /* * Macros to make it clearer in some of the twiddlier accesses what is * happening. */ @@ -128,25 +130,21 @@ * dictionary (not dictObj!) to use if * necessary. */ } ZlibChannelData; /* - * Value bits for the flags field. Definitions are: - * ASYNC - Whether this is an asynchronous channel. - * IN_HEADER - Whether the inHeader field has been registered with - * the input compressor. - * OUT_HEADER - Whether the outputHeader field has been registered - * with the output decompressor. - * STREAM_DECOMPRESS - Signal decompress pending data. - * STREAM_DONE - Flag to signal stream end up to transform input. + * Value bits for the flags field. */ - -#define ASYNC 0x01 -#define IN_HEADER 0x02 -#define OUT_HEADER 0x04 -#define STREAM_DECOMPRESS 0x08 -#define STREAM_DONE 0x10 +enum ZlibChannelDataFlags { + ASYNC = 0x01, /* This is an asynchronous channel. */ + IN_HEADER = 0x02, /* Whether the inHeader field has been + * registered with the input compressor. */ + OUT_HEADER = 0x04, /* Whether the outputHeader field has been + * registered with the output decompressor. */ + STREAM_DECOMPRESS = 0x08, /* Signal decompress pending data. */ + STREAM_DONE = 0x10 /* Signal stream end up to transform input. */ +}; /* * Size of buffers allocated by default, and the range it can be set to. The * same sorts of values apply to streams, except with different limits (they * permit byte-level activity). Channels always use bytes unless told to use @@ -212,11 +210,11 @@ NULL, /* seekProc */ ZlibTransformSetOption, ZlibTransformGetOption, ZlibTransformWatch, ZlibTransformGetHandle, - ZlibTransformClose, /* close2Proc */ + ZlibTransformClose, /* close2Proc */ ZlibTransformBlockMode, NULL, /* flushProc */ ZlibTransformEventHandler, NULL, /* wideSeekProc */ NULL, @@ -442,10 +440,11 @@ if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { Tcl_EncodingState state; + valueStr = TclGetStringFromObj(value, &length); result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, &state, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, NULL); @@ -1358,11 +1357,11 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ Tcl_Obj *data, /* A place to append the data. */ - Tcl_Size count) /* Number of bytes to grab as a maximum, you + Tcl_Size count) /* Number of bytes to grab as a maximum, you * may get less! */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; int e; Tcl_Size listLen, i, itemLen = 0, dataPos = 0; @@ -1840,11 +1839,11 @@ } TclNewObj(obj); outData = Tcl_SetByteArrayLength(obj, bufferSize); memset(&stream, 0, sizeof(z_stream)); - stream.avail_in = 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; stream.next_out = outData; @@ -2232,11 +2231,11 @@ * -> handleCmd */ return ZlibStreamSubcmd(interp, objc, objv); case CMD_PUSH: /* push mode channel options... * -> channel */ return ZlibPushSubcmd(interp, objc, objv); - }; + } return TCL_ERROR; badLevel: Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1)); @@ -2749,33 +2748,33 @@ &index) != TCL_OK) { return TCL_ERROR; } switch (index) { - case ao_flush: /* -flush */ + case ao_flush: /* -flush */ if (flush >= 0) { flush = -2; } else { flush = Z_SYNC_FLUSH; } break; - case ao_fullflush: /* -fullflush */ + case ao_fullflush: /* -fullflush */ if (flush >= 0) { flush = -2; } else { flush = Z_FULL_FLUSH; } break; - case ao_finalize: /* -finalize */ + case ao_finalize: /* -finalize */ if (flush >= 0) { flush = -2; } else { flush = Z_FINISH; } break; - case ao_buffer: /* -buffer */ - if (i == objc-2) { + case ao_buffer: /* -buffer */ + if (i == objc - 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-buffer\" option must be followed by integer " "decompression buffersize", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; @@ -2789,12 +2788,12 @@ MAX_BUFFER_SIZE)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", (char *)NULL); return TCL_ERROR; } break; - case ao_dictionary: - if (i == objc-2) { + case ao_dictionary: /* -dictionary */ + if (i == objc - 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-dictionary\" option must be followed by" " compression dictionary bytes", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; @@ -2876,33 +2875,33 @@ &index) != TCL_OK) { return TCL_ERROR; } switch (index) { - case po_flush: /* -flush */ + case po_flush: /* -flush */ if (flush >= 0) { flush = -2; } else { flush = Z_SYNC_FLUSH; } break; - case po_fullflush: /* -fullflush */ + case po_fullflush: /* -fullflush */ if (flush >= 0) { flush = -2; } else { flush = Z_FULL_FLUSH; } break; - case po_finalize: /* -finalize */ + case po_finalize: /* -finalize */ if (flush >= 0) { flush = -2; } else { flush = Z_FINISH; } break; - case po_dictionary: - if (i == objc-2) { + case po_dictionary: /* -dictionary */ + if (i == objc - 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-dictionary\" option must be followed by" " compression dictionary bytes", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; @@ -3153,11 +3152,10 @@ * 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 == -1) { - /* See ReflectInput() in tclIORTrans.c */ if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) { break; } @@ -3166,11 +3164,11 @@ } /* more bytes (or Eof if readBytes == 0) */ cd->inStream.avail_in += readBytes; -copyDecompressed: + copyDecompressed: /* * Transform the read chunk, if not empty. Anything we get * back is a transformation result to be put into our buffers, and * the next iteration will put it into the result. @@ -3346,11 +3344,11 @@ * *---------------------------------------------------------------------- */ static int -ZlibTransformSetOption( /* not used */ +ZlibTransformSetOption( /* not used */ void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value) { @@ -3871,16 +3869,14 @@ int *errorCodePtr) { int e, written, resBytes = 0; Tcl_Obj *errObj; - cd->flags &= ~STREAM_DECOMPRESS; cd->inStream.next_out = (Bytef *) buf; cd->inStream.avail_out = toRead; while (cd->inStream.avail_out > 0) { - e = inflate(&cd->inStream, flush); if (e == Z_NEED_DICT && cd->compDictObj) { e = SetInflateDictionary(&cd->inStream, cd->compDictObj); if (e == Z_OK) { /* Index: macosx/tclMacOSXFCmd.c ================================================================== --- macosx/tclMacOSXFCmd.c +++ macosx/tclMacOSXFCmd.c @@ -82,15 +82,15 @@ static Tcl_Obj * NewOSTypeObj(const OSType newOSType); static int SetOSTypeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfOSType(Tcl_Obj *objPtr); static const Tcl_ObjType tclOSTypeType = { - "osType", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - UpdateStringOfOSType, /* updateStringProc */ - SetOSTypeFromAny, /* setFromAnyProc */ + "osType", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + UpdateStringOfOSType, /* updateStringProc */ + SetOSTypeFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; enum { kIsInvisible = 0x4000, @@ -130,14 +130,14 @@ *---------------------------------------------------------------------- */ int TclMacOSXGetFileAttribute( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file (UTF-8). */ - Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { #ifdef HAVE_GETATTRLIST int result; Tcl_StatBuf statBuf; struct attrlist alist; @@ -689,11 +689,11 @@ *---------------------------------------------------------------------- */ static void UpdateStringOfOSType( - Tcl_Obj *objPtr) /* OSType object whose string rep to + Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { const size_t size = TCL_UTF_MAX * 4; char *dst = Tcl_InitStringRep(objPtr, NULL, size); OSType osType = (OSType) objPtr->internalRep.wideValue; Index: macosx/tclMacOSXNotify.c ================================================================== --- macosx/tclMacOSXNotify.c +++ macosx/tclMacOSXNotify.c @@ -309,11 +309,11 @@ int readyMask; /* Mask of events that have been seen since * the last time file handlers were invoked * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; /* * The following structure is what is added to the Tcl event queue when file @@ -1112,11 +1112,11 @@ * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); if (filePtr == NULL) { @@ -1906,11 +1906,11 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(void *), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { #if TCL_THREADS /* Index: unix/tclAppInit.c ================================================================== --- unix/tclAppInit.c +++ unix/tclAppInit.c @@ -27,11 +27,11 @@ extern Tcl_LibraryInitProc Tcltest_Init; extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #ifdef TCL_XT_TEST -extern void XtToolkitInitialize(void); +extern void XtToolkitInitialize(void); extern Tcl_LibraryInitProc Tclxttest_Init; #endif /* TCL_XT_TEST */ /* * The following #if block allows you to change the AppInit function by using Index: unix/tclEpollNotfy.c ================================================================== --- unix/tclEpollNotfy.c +++ unix/tclEpollNotfy.c @@ -40,11 +40,11 @@ int readyMask; /* Mask of events that have been seen since * the last time file handlers were invoked * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- * ciated with regular files (S_IFREG) that are * ready for I/O. */ @@ -224,28 +224,26 @@ if (TclOSfstat(filePtr->fd, &fdStat) == -1) { Tcl_Panic("fstat: %s", strerror(errno)); } - if (epoll_ctl(tsdPtr->eventsFd, op, filePtr->fd, &newEvent) == -1) { - switch (errno) { - case EPERM: - switch (op) { - case EPOLL_CTL_ADD: - if (isNew) { - LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr, - readyNode); - } - break; - case EPOLL_CTL_DEL: - LIST_REMOVE(filePtr, readyNode); - break; - - } - break; - default: - Tcl_Panic("epoll_ctl: %s", strerror(errno)); + if (epoll_ctl(tsdPtr->eventsFd, op, filePtr->fd, &newEvent) == -1) { + if (errno != EPERM) { + /* Unexpected! */ + Tcl_Panic("epoll_ctl: %s", strerror(errno)); + } + + switch (op) { + case EPOLL_CTL_ADD: + if (isNew) { + LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr, + readyNode); + } + break; + case EPOLL_CTL_DEL: + LIST_REMOVE(filePtr, readyNode); + break; } } return; } @@ -511,11 +509,11 @@ * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); int isNew = (filePtr == NULL); @@ -789,11 +787,11 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - void *clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { #if TCL_THREADS /* Index: unix/tclKqueueNotfy.c ================================================================== --- unix/tclKqueueNotfy.c +++ unix/tclKqueueNotfy.c @@ -38,11 +38,11 @@ int readyMask; /* Mask of events that have been seen since * the last time file handlers were invoked * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- * ciated with regular files (S_IFREG) that are * ready for I/O. */ @@ -183,12 +183,11 @@ if (TclOSfstat(filePtr->fd, &fdStat) == -1) { Tcl_Panic("fstat: %s", strerror(errno)); } else if ((fdStat.st_mode & S_IFMT) == S_IFREG || (fdStat.st_mode & S_IFMT) == S_IFDIR - || (fdStat.st_mode & S_IFMT) == S_IFLNK - ) { + || (fdStat.st_mode & S_IFMT) == S_IFLNK) { switch (op) { case EV_ADD: if (isNew) { LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr, readyNode); @@ -516,11 +515,11 @@ * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); int isNew = (filePtr == NULL); @@ -785,11 +784,11 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - void *clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { #if TCL_THREADS /* Index: unix/tclLoadAix.c ================================================================== --- unix/tclLoadAix.c +++ unix/tclLoadAix.c @@ -246,11 +246,11 @@ char *p = s; while (*p >= '0' && *p <= '9') { p++; } - switch (atoi(s)) { /* INTL: "C", UTF safe. */ + switch (atoi(s)) { /* INTL: "C", UTF safe. */ case L_ERROR_TOOMANY: strcat(errbuf, "to many errors"); break; case L_ERROR_NOLIB: strcat(errbuf, "can't load library"); Index: unix/tclLoadDl.c ================================================================== --- unix/tclLoadDl.c +++ unix/tclLoadDl.c @@ -186,16 +186,16 @@ if (Tcl_UtfToExternalDStringEx(interp, NULL, symbol, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&ds); return NULL; } native = Tcl_DStringValue(&ds); - proc = dlsym(handle, native); /* INTL: Native. */ + proc = dlsym(handle, native); /* INTL: Native. */ if (proc == NULL) { Tcl_DStringInit(&newName); TclDStringAppendLiteral(&newName, "_"); native = Tcl_DStringAppend(&newName, native, TCL_INDEX_NONE); - proc = dlsym(handle, native); /* INTL: Native. */ + proc = dlsym(handle, native); /* INTL: Native. */ Tcl_DStringFree(&newName); } #ifdef __cplusplus if (proc == NULL) { char buf[32]; Index: unix/tclLoadDyld.c ================================================================== --- unix/tclLoadDyld.c +++ unix/tclLoadDyld.c @@ -102,11 +102,11 @@ */ #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) static const char * DyldOFIErrorMsg( - int err) + int err) /* Error code to be converted */ { switch (err) { case NSObjectFileImageSuccess: return NULL; case NSObjectFileImageFailure: @@ -146,11 +146,11 @@ MODULE_SCOPE int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ - Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded + Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this @@ -546,11 +546,11 @@ * (allocated with TclpLoadMemoryGetBuffer). */ int size, /* Allocation size of buffer. */ int codeSize, /* Size of code data read into buffer or -1 if * an error occurred and the buffer should * just be freed. */ - Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded + Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this @@ -581,11 +581,11 @@ #else const struct mach_header_64 *mh = NULL; # define mh_size sizeof(struct mach_header_64) # define mh_magic MH_MAGIC_64 # define arch_abi CPU_ARCH_ABI64 -#endif /* __LP64__ */ +#endif /* __LP64__ */ if ((size_t) codeSize >= sizeof(struct fat_header) && fh->magic == OSSwapHostToBigInt32(FAT_MAGIC)) { uint32_t fh_nfat_arch = OSSwapBigToHostInt32(fh->nfat_arch); Index: unix/tclLoadNext.c ================================================================== --- unix/tclLoadNext.c +++ unix/tclLoadNext.c @@ -134,13 +134,13 @@ *---------------------------------------------------------------------- */ static void * FindSymbol( - Tcl_Interp *interp, - Tcl_LoadHandle loadHandle, - const char *symbol) + Tcl_Interp *interp, /* Where to report errors. */ + Tcl_LoadHandle loadHandle, /* Handle for the opened library. */ + const char *symbol) /* The symbol to look up. */ { Tcl_LibraryInitProc *proc = NULL; if (symbol) { char sym[strlen(symbol) + 2]; Index: unix/tclLoadOSF.c ================================================================== --- unix/tclLoadOSF.c +++ unix/tclLoadOSF.c @@ -127,11 +127,11 @@ * I build loadable modules with a makefile rule like * ld ... -export $@: -o $@ $(OBJS) */ if ((pkg = strrchr(fileName, '/')) == NULL) { - pkg = fileName; + pkg = fileName; } else { pkg++; } newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = pkg; @@ -159,13 +159,13 @@ *---------------------------------------------------------------------- */ static void * FindSymbol( - Tcl_Interp *interp, - Tcl_LoadHandle loadHandle, - const char *symbol) + Tcl_Interp *interp, /* Where to report errors. */ + Tcl_LoadHandle loadHandle, /* Handle for the opened library. */ + const char *symbol) /* The symbol to look up. */ { void *proc = ldr_lookup_package((char *) loadHandle, symbol); if (proc == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( Index: unix/tclLoadShl.c ================================================================== --- unix/tclLoadShl.c +++ unix/tclLoadShl.c @@ -123,15 +123,15 @@ * interp's result. * *---------------------------------------------------------------------- */ -static void* +static void * FindSymbol( - Tcl_Interp *interp, - Tcl_LoadHandle loadHandle, - const char *symbol) + Tcl_Interp *interp, /* Where to report errors. */ + Tcl_LoadHandle loadHandle, /* Handle for the opened library. */ + const char *symbol) /* The symbol to look up. */ { Tcl_DString newName; Tcl_LibraryInitProc *proc = NULL; shl_t handle = (shl_t) loadHandle->clientData; Index: unix/tclSelectNotfy.c ================================================================== --- unix/tclSelectNotfy.c +++ unix/tclSelectNotfy.c @@ -30,11 +30,11 @@ int readyMask; /* Mask of events that have been seen since * the last time file handlers were invoked * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; /* * The following structure contains a set of select() masks to track readable, @@ -178,21 +178,20 @@ static pthread_cond_t notifierCV = PTHREAD_COND_INITIALIZER; /* * The pollState bits: - * - * POLL_WANT is set by each thread before it waits on its condition variable. - * It is checked by the notifier before it does select. - * - * POLL_DONE is set by the notifier if it goes into select after seeing - * POLL_WANT. The idea is to ensure it tries a select with the same bits - * the initial thread had set. */ - -#define POLL_WANT 0x1 -#define POLL_DONE 0x2 +enum PollStateBits { + POLL_WANT = 0x1, /* Set by each thread before it waits on its + * condition variable. Checked by the notifier + * before it does select. */ + POLL_DONE = 0x2 /* Set by the notifier if it goes into select + * after seeing POLL_WANT. The idea is to + * ensure it tries a select with the same bits + * the initial thread had set. */ +}; /* * This is the thread ID of the notifier thread that does select. */ @@ -478,11 +477,11 @@ * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); if (filePtr == NULL) { @@ -641,11 +640,11 @@ *---------------------------------------------------------------------- */ int TclpWaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { FileHandler *filePtr; int mask; Tcl_Time vTime; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -919,11 +918,11 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(void *), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { #if TCL_THREADS /* Index: unix/tclUnixChan.c ================================================================== --- unix/tclUnixChan.c +++ unix/tclUnixChan.c @@ -160,19 +160,19 @@ */ static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ - NULL, + NULL, NULL, /* Set option proc. */ FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ - FileCloseProc, /* close2proc. */ + FileCloseProc, /* New close proc. */ FileBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ FileWideSeekProc, /* wide seek proc. */ NULL, @@ -186,19 +186,19 @@ */ static const Tcl_ChannelType ttyChannelType = { "tty", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ NULL, /* Seek proc. */ TtySetOptionProc, /* Set option proc. */ TtyGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ - TtyCloseProc, /* close2proc. */ + TtyCloseProc, /* New close proc. */ FileBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ NULL, /* thread action proc. */ @@ -223,11 +223,11 @@ *---------------------------------------------------------------------- */ static int FileBlockModeProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ int mode) /* The mode to set. Can be TCL_MODE_BLOCKING * or TCL_MODE_NONBLOCKING. */ { FileState *fsPtr = (FileState *)instanceData; @@ -256,11 +256,11 @@ *---------------------------------------------------------------------- */ static int FileInputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { @@ -306,11 +306,11 @@ *---------------------------------------------------------------------- */ static int FileOutputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { FileState *fsPtr = (FileState *)instanceData; @@ -353,11 +353,11 @@ *---------------------------------------------------------------------- */ static int FileCloseProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ TCL_UNUSED(Tcl_Interp *), int flags) { FileState *fsPtr = (FileState *)instanceData; int errorCode = 0; @@ -446,11 +446,11 @@ *---------------------------------------------------------------------- */ static long long FileWideSeekProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? Can be * one of SEEK_START, SEEK_CUR or SEEK_END. */ int *errorCodePtr) /* To store error code. */ { @@ -494,11 +494,11 @@ Tcl_NotifyChannel(channel, mask); } static void FileWatchProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { FileState *fsPtr = (FileState *)instanceData; @@ -534,13 +534,13 @@ *---------------------------------------------------------------------- */ static int FileGetHandleProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { FileState *fsPtr = (FileState *)instanceData; if (direction & fsPtr->validMask) { *handlePtr = INT2PTR(fsPtr->fd); @@ -771,11 +771,11 @@ *---------------------------------------------------------------------- */ static int TtySetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ { TtyState *fsPtr = (TtyState *)instanceData; @@ -1111,11 +1111,11 @@ *---------------------------------------------------------------------- */ static int TtyGetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { TtyState *fsPtr = (TtyState *)instanceData; @@ -1628,14 +1628,11 @@ int i, end; char parity; const char *bad = "bad value for -mode"; i = sscanf(mode, "%d,%c,%d,%d%n", - &ttyPtr->baud, - &parity, - &ttyPtr->data, - &ttyPtr->stop, &end); + &ttyPtr->baud, &parity, &ttyPtr->data, &ttyPtr->stop, &end); if ((i != 4) || (mode[end] != '\0')) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s: should be baud,parity,data,stop", bad)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); @@ -1652,15 +1649,15 @@ * not allow preprocessor directives in their arguments. */ if ( #if defined(PAREXT) - strchr("noems", parity) + strchr("noems", parity) #else - strchr("noe", parity) + strchr("noe", parity) #endif /* PAREXT */ - == NULL) { + == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s parity: should be %s", bad, #if defined(PAREXT) "n, o, e, m, or s" @@ -2067,11 +2064,11 @@ * writing, 0 means for reading. */ TCL_UNUSED(int), /* Obsolete argument. * Ignored, we always check that * the channel is open for the requested * mode. */ - void **filePtr) /* Store pointer to FILE structure here. */ + void **filePtr) /* Store pointer to FILE structure here. */ { Tcl_Channel chan; int chanMode, fd; const Tcl_ChannelType *chanTypePtr; void *data; Index: unix/tclUnixCompat.c ================================================================== --- unix/tclUnixCompat.c +++ unix/tclUnixCompat.c @@ -32,11 +32,11 @@ * 'size' the result is unaligned and PadBuffer corrects both the pointer, * _and_ the 'length'. The latter means that future increments of 'buffer' by * 'length' stay aligned. */ -#define PadBuffer(buffer, length, size) \ +#define PadBuffer(buffer, length, size) \ if (((length) % (size))) { \ (buffer) += ((size) - ((length) % (size))); \ (length) += ((size) - ((length) % (size))); \ } @@ -957,18 +957,10 @@ return len; } #endif /* NEED_COPYSTRING */ -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ - /* *------------------------------------------------------------------------ * * TclWinCPUID -- * @@ -984,39 +976,41 @@ *---------------------------------------------------------------------- */ int TclWinCPUID( - int index, /* Which CPUID value to retrieve. */ - int *regsPtr) /* Registers after the CPUID. */ + int index, /* Which CPUID value to retrieve. */ + int *regsPtr) /* Registers after the CPUID. */ { int status = TCL_ERROR; /* See: */ #if defined(__x86_64__) || defined(_M_AMD64) || defined (_M_X64) - __asm__ __volatile__("movq %%rbx, %%rsi \n\t" /* save %rbx */ - "cpuid \n\t" - "xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */ - : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) - : "a"(index)); + __asm__ __volatile__( + "movq %%rbx, %%rsi \n\t" /* save %rbx */ + "cpuid \n\t" + "xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */ + : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) + : "a"(index)); status = TCL_OK; #elif defined(__i386__) || defined(_M_IX86) - __asm__ __volatile__("mov %%ebx, %%esi \n\t" /* save %ebx */ - "cpuid \n\t" - "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ - : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) - : "a"(index)); + __asm__ __volatile__( + "mov %%ebx, %%esi \n\t" /* save %ebx */ + "cpuid \n\t" + "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ + : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) + : "a"(index)); status = TCL_OK; #else (void)index; (void)regsPtr; #endif return status; } - + /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: unix/tclUnixFCmd.c ================================================================== --- unix/tclUnixFCmd.c +++ unix/tclUnixFCmd.c @@ -53,13 +53,15 @@ /* * The following constants specify the type of callback when * TraverseUnixTree() calls the traverseProc() */ -#define DOTREE_PRED 1 /* pre-order directory */ -#define DOTREE_POSTD 2 /* post-order directory */ -#define DOTREE_F 3 /* regular file */ +enum TraverseUnixTreeType { + DOTREE_PRED = 1, /* pre-order directory */ + DOTREE_POSTD = 2, /* post-order directory */ + DOTREE_F = 3 /* regular file */ +}; /* * Fallback temporary file location the temporary file generation code. Can be * overridden at compile time for when it is known that temp files can't be * written to /tmp (hello, iOS!). @@ -767,12 +769,12 @@ if (ret != TCL_OK) { *errorPtr = srcPathPtr; } else { transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); ret = Tcl_UtfToExternalDStringEx(NULL, NULL, - (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL); + (transPtr != NULL ? TclGetString(transPtr) : NULL), + -1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } if (ret != TCL_OK) { *errorPtr = destPathPtr; @@ -1247,11 +1249,10 @@ int type, /* Reason for call - see TraverseUnixTree(). */ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { - switch (type) { case DOTREE_F: if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) { return TCL_OK; } @@ -1290,11 +1291,11 @@ */ static int CopyFileAtts( #ifdef MAC_OSX_TCL - const char *src, /* Path name of source file (native). */ + const char *src, /* Path name of source file (native). */ #else TCL_UNUSED(const char *) /*src*/, #endif const char *dst, /* Path name of target file (native). */ const Tcl_StatBuf *statBufPtr) @@ -1764,11 +1765,11 @@ */ static int GetModeFromPermString( TCL_UNUSED(Tcl_Interp *), - const char *modeStringPtr, /* Permissions string */ + const char *modeStringPtr, /* Permissions string */ mode_t *modePtr) /* pointer to the mode value */ { mode_t newMode; mode_t oldMode; /* Storage for the value of the old mode (that * is passed in), to allow for the chmod style @@ -2486,14 +2487,14 @@ *--------------------------------------------------------------------------- */ static int SetUnixFileAttributes( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr) /* The attribute to set. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr) /* The attribute to set. */ { int yesNo, fileAttributes, old; WCHAR *winPath; if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) { Index: unix/tclUnixFile.c ================================================================== --- unix/tclUnixFile.c +++ unix/tclUnixFile.c @@ -322,11 +322,11 @@ Tcl_DStringFree(&ds); Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } - d = TclOSopendir(native); /* INTL: Native. */ + d = TclOSopendir(native); /* INTL: Native. */ if (d == NULL) { Tcl_DStringFree(&ds); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read directory \"%s\": %s", @@ -436,14 +436,14 @@ *---------------------------------------------------------------------- */ static int NativeMatchType( - Tcl_Interp *interp, /* Interpreter to receive errors. */ - const char *nativeEntry, /* Native path to check. */ - const char *nativeName, /* Native filename to check. */ - Tcl_GlobTypeData *types) /* Type description to match against. */ + Tcl_Interp *interp, /* Interpreter to receive errors. */ + const char *nativeEntry, /* Native path to check. */ + const char *nativeName, /* Native filename to check. */ + Tcl_GlobTypeData *types) /* Type description to match against. */ { Tcl_StatBuf buf; if (types == NULL) { /* Index: unix/tclUnixInit.c ================================================================== --- unix/tclUnixInit.c +++ unix/tclUnixInit.c @@ -52,25 +52,25 @@ "x86_64", "ia32_on_win64", "neutral", "arm64", "arm32_on_win64", "ia32_on_arm64" }; typedef struct { union { - unsigned int dwOemId; - struct { - int wProcessorArchitecture; - int wReserved; - }; + unsigned int dwOemId; + struct { + int wProcessorArchitecture; + int wReserved; + }; }; - unsigned int dwPageSize; + unsigned int dwPageSize; void *lpMinimumApplicationAddress; void *lpMaximumApplicationAddress; void *dwActiveProcessorMask; - unsigned int dwNumberOfProcessors; - unsigned int dwProcessorType; - unsigned int dwAllocationGranularity; - int wProcessorLevel; - int wProcessorRevision; + unsigned int dwNumberOfProcessors; + unsigned int dwProcessorType; + unsigned int dwAllocationGranularity; + int wProcessorLevel; + int wProcessorRevision; } SYSTEM_INFO; typedef struct { unsigned int dwOSVersionInfoSize; unsigned int dwMajorVersion; @@ -323,12 +323,11 @@ #endif /* HAVE_COREFOUNDATION */ #if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \ defined(MAC_OS_X_VERSION_MIN_REQUIRED) && ( \ (TCL_THREADS && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \ (defined(__LP64__) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050) || \ - (defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050)\ - ))) + (defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050)))) /* * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c: * initialize release global at startup from uname(). */ #define GET_DARWIN_RELEASE 1 @@ -859,19 +858,19 @@ if (*p) { Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, -1)); } Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_pkgPath", -1), NULL, pkgListObj, TCL_GLOBAL_ONLY); { - /* Some platforms build configure scripts expect ~ expansion so do that */ - Tcl_Obj *origPaths; - Tcl_Obj *resolvedPaths; - - origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); - resolvedPaths = TclResolveTildePathList(origPaths); - if (resolvedPaths != origPaths && resolvedPaths != NULL) { - Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, resolvedPaths, TCL_GLOBAL_ONLY); - } + /* Some platforms build configure scripts expect ~ expansion so do that */ + Tcl_Obj *origPaths; + Tcl_Obj *resolvedPaths; + + origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); + resolvedPaths = TclResolveTildePathList(origPaths); + if (resolvedPaths != origPaths && resolvedPaths != NULL) { + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, resolvedPaths, TCL_GLOBAL_ONLY); + } } #ifdef DJGPP Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); #else Index: unix/tclUnixNotfy.c ================================================================== --- unix/tclUnixNotfy.c +++ unix/tclUnixNotfy.c @@ -211,11 +211,11 @@ *---------------------------------------------------------------------- */ void TclpSetTimer( - TCL_UNUSED(const Tcl_Time *)) /* Timeout value, may be NULL. */ + TCL_UNUSED(const Tcl_Time *)) /* Timeout value, may be NULL. */ { /* * The interval timer doesn't do anything in this implementation, because * the only event loop is via Tcl_DoOneEvent, which passes timeout values * to Tcl_WaitForEvent. @@ -416,11 +416,10 @@ * notifierCount != 0: unbalanced InitNotifier() / FinalizeNotifier calls * waitingListPtr != 0: there are threads currently waiting for events. */ if (atForkInit == 1) { - notifierCount = 0; if (notifierThreadRunning == 1) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); notifierThreadRunning = 0; Index: unix/tclUnixPipe.c ================================================================== --- unix/tclUnixPipe.c +++ unix/tclUnixPipe.c @@ -78,19 +78,19 @@ */ static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ PipeWatchProc, /* Initialize notifier. */ PipeGetHandleProc, /* Get OS handles out of channel. */ - PipeClose2Proc, /* close2proc. */ + PipeClose2Proc, /* New close proc. */ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ NULL, /* thread action proc */ @@ -354,11 +354,11 @@ *---------------------------------------------------------------------- */ int TclpCloseFile( - TclFile file) /* The file to close. */ + TclFile file) /* The file to close. */ { int fd = GetFd(file); /* * Refuse to close the fds for stdin, stdout and stderr. @@ -399,11 +399,11 @@ TclpCreateProcess( Tcl_Interp *interp, /* Interpreter in which to leave errors that * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - size_t argc, /* Number of arguments in following array. */ + size_t argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings in UTF-8. * argv[0] contains the name of the executable * translated using Tcl_TranslateFileName * call). Additional arguments have not been * converted. */ @@ -1001,11 +1001,11 @@ *---------------------------------------------------------------------- */ static int PipeBlockModeProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { PipeState *psPtr = (PipeState *)instanceData; @@ -1041,11 +1041,11 @@ *---------------------------------------------------------------------- */ static int PipeClose2Proc( - void *instanceData, /* The pipe to close. */ + void *instanceData, /* The pipe to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { PipeState *pipePtr = (PipeState *)instanceData; Tcl_Channel errChan; @@ -1138,11 +1138,11 @@ *---------------------------------------------------------------------- */ static int PipeInputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { @@ -1189,11 +1189,11 @@ *---------------------------------------------------------------------- */ static int PipeOutputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { PipeState *psPtr = (PipeState *)instanceData; @@ -1248,11 +1248,11 @@ Tcl_NotifyChannel(channel, mask); } static void PipeWatchProc( - void *instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { PipeState *psPtr = (PipeState *)instanceData; @@ -1296,13 +1296,13 @@ *---------------------------------------------------------------------- */ static int PipeGetHandleProc( - void *instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { PipeState *psPtr = (PipeState *)instanceData; if (direction == TCL_READABLE && psPtr->inFile) { *handlePtr = INT2PTR(GetFd(psPtr->inFile)); Index: unix/tclUnixPort.h ================================================================== --- unix/tclUnixPort.h +++ unix/tclUnixPort.h @@ -685,11 +685,11 @@ MODULE_SCOPE struct passwd * TclpGetPwUid(uid_t uid); MODULE_SCOPE struct group * TclpGetGrGid(gid_t gid); MODULE_SCOPE struct hostent * TclpGetHostByName(const char *name); MODULE_SCOPE struct hostent * TclpGetHostByAddr(const char *addr, int length, int type); -MODULE_SCOPE void *TclpMakeTcpClientChannelMode( +MODULE_SCOPE void * TclpMakeTcpClientChannelMode( void *tcpSocket, int mode); #endif /* _TCLUNIXPORT */ /* Index: unix/tclUnixSock.c ================================================================== --- unix/tclUnixSock.c +++ unix/tclUnixSock.c @@ -21,12 +21,12 @@ #define SET_BITS(var, bits) ((var) |= (bits)) #define CLEAR_BITS(var, bits) ((var) &= ~(bits)) #define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ -#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) -#define SOCK_TEMPLATE "sock%" TCL_Z_MODIFIER "x" +#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) +#define SOCK_TEMPLATE "sock%" TCL_Z_MODIFIER "x" #undef SOCKET /* Possible conflict with win32 SOCKET */ /* * This is needed to comply with the strict aliasing rules of GCC, but it also @@ -62,43 +62,43 @@ /* * Only needed for server sockets */ Tcl_TcpAcceptProc *acceptProc; - /* Proc to call on accept. */ - void *acceptProcData; /* The data for the accept proc. */ + /* Proc to call on accept. */ + void *acceptProcData; /* The data for the accept proc. */ /* * Only needed for client sockets */ struct addrinfo *addrlist; /* Addresses to connect to. */ struct addrinfo *addr; /* Iterator over addrlist. */ struct addrinfo *myaddrlist;/* Local address. */ struct addrinfo *myaddr; /* Iterator over myaddrlist. */ - int filehandlers; /* Caches FileHandlers that get set up while - * an async socket is not yet connected. */ - int connectError; /* Cache SO_ERROR of async socket. */ - int cachedBlocking; /* Cache blocking mode of async socket. */ + int filehandlers; /* Caches FileHandlers that get set up while + * an async socket is not yet connected. */ + int connectError; /* Cache SO_ERROR of async socket. */ + int cachedBlocking; /* Cache blocking mode of async socket. */ }; /* * These bits may be OR'ed together into the "flags" field of a TcpState * structure. */ -#define TCP_NONBLOCKING (1<<0) /* Socket with non-blocking I/O */ -#define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */ -#define TCP_ASYNC_PENDING (1<<4) /* TcpConnect was called to - * process an async connect. This - * flag indicates that reentry is - * still pending */ -#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */ - -#define TCP_ASYNC_TEST_MODE (1<<8) /* Async testing activated. Do not - * automatically continue connection - * process. */ +enum TcpStateFlags { + TCP_NONBLOCKING = 1<<0, /* Socket with non-blocking I/O. */ + TCP_ASYNC_CONNECT = 1<<1, /* Async connect in progress. */ + TCP_ASYNC_PENDING = 1<<4, /* TcpConnect was called to process an async + * connect. This flag indicates that reentry + * is still pending. */ + TCP_ASYNC_FAILED = 1<<5, /* An async connect finally failed. */ + TCP_ASYNC_TEST_MODE = 1<<8 /* Async testing activated. Do not + * automatically continue connection + * process. */ +}; /* * The following defines the maximum length of the listen queue. This is the * number of outstanding yet-to-be-serviced requests for a connection on a * server socket, more than this number of outstanding requests and the @@ -154,19 +154,19 @@ */ static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ TcpSetOptionProc, /* Set option proc. */ TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Initialize notifier. */ TcpGetHandleProc, /* Get OS handles out of channel. */ - TcpClose2Proc, /* Close2 proc. */ + TcpClose2Proc, /* New close proc. */ TcpBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ TcpThreadActionProc, /* thread action proc. */ @@ -225,11 +225,11 @@ struct utsname u; struct hostent *hp; memset(&u, (int) 0, sizeof(struct utsname)); if (uname(&u) >= 0) { /* INTL: Native. */ - hp = TclpGetHostByName(u.nodename); /* INTL: Native. */ + hp = TclpGetHostByName(u.nodename); /* INTL: Native. */ if (hp == NULL) { /* * Sometimes the nodename is fully qualified, but gets truncated * as it exceeds SYS_NMLN. See if we can just get the immediate * nodename and get a proper answer that way. @@ -244,15 +244,15 @@ node[dot - u.nodename] = '\0'; hp = TclpGetHostByName(node); Tcl_Free(node); } } - if (hp != NULL) { + if (hp != NULL) { native = hp->h_name; - } else { + } else { native = u.nodename; - } + } } #else /* !NO_UNAME */ /* * Uname doesn't exist; try gethostname instead. * @@ -355,11 +355,11 @@ * ---------------------------------------------------------------------- */ static int TcpBlockModeProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { TcpState *statePtr = (TcpState *)instanceData; @@ -368,12 +368,12 @@ CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING); } else { SET_BITS(statePtr->flags, TCP_NONBLOCKING); } if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { - statePtr->cachedBlocking = mode; - return 0; + statePtr->cachedBlocking = mode; + return 0; } if (TclUnixSetBlockingMode(statePtr->fds.fd, mode) < 0) { return errno; } return 0; @@ -441,41 +441,41 @@ * - Call by recv/send and blocking socket * (errorCodePtr != NULL && !GOT_BITS(flags, TCP_NONBLOCKING)) */ if (GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE) - && !(errorCodePtr != NULL - && !GOT_BITS(statePtr->flags, TCP_NONBLOCKING))) { + && !(errorCodePtr != NULL + && !GOT_BITS(statePtr->flags, TCP_NONBLOCKING))) { *errorCodePtr = EWOULDBLOCK; return -1; } if (errorCodePtr == NULL || GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { - timeout = 0; + timeout = 0; } else { - timeout = -1; + timeout = -1; } do { - if (TclUnixWaitForFile(statePtr->fds.fd, - TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) { - TcpConnect(NULL, statePtr); - } - - /* - * Do this only once in the nonblocking case and repeat it until the - * socket is final when blocking. - */ + if (TclUnixWaitForFile(statePtr->fds.fd, + TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) { + TcpConnect(NULL, statePtr); + } + + /* + * Do this only once in the nonblocking case and repeat it until the + * socket is final when blocking. + */ } while (timeout == -1 && GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)); if (errorCodePtr != NULL) { - if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { - *errorCodePtr = EAGAIN; - return -1; - } else if (statePtr->connectError != 0) { - *errorCodePtr = ENOTCONN; - return -1; - } + if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { + *errorCodePtr = EAGAIN; + return -1; + } else if (statePtr->connectError != 0) { + *errorCodePtr = ENOTCONN; + return -1; + } } return 0; } /* @@ -500,11 +500,11 @@ *---------------------------------------------------------------------- */ static int TcpInputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { @@ -551,11 +551,11 @@ *---------------------------------------------------------------------- */ static int TcpOutputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { TcpState *statePtr = (TcpState *)instanceData; @@ -592,11 +592,11 @@ *---------------------------------------------------------------------- */ static int TcpCloseProc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ TCL_UNUSED(Tcl_Interp *)) { TcpState *statePtr = (TcpState *)instanceData; int errorCode = 0; TcpFdList *fds; @@ -615,24 +615,23 @@ } Tcl_DeleteFileHandler(fds->fd); if (close(fds->fd) < 0) { errorCode = errno; } - } fds = statePtr->fds.next; while (fds != NULL) { TcpFdList *next = fds->next; Tcl_Free(fds); fds = next; } if (statePtr->addrlist != NULL) { - freeaddrinfo(statePtr->addrlist); + freeaddrinfo(statePtr->addrlist); } if (statePtr->myaddrlist != NULL) { - freeaddrinfo(statePtr->myaddrlist); + freeaddrinfo(statePtr->myaddrlist); } Tcl_Free(statePtr); return errorCode; } @@ -653,11 +652,11 @@ *---------------------------------------------------------------------- */ static int TcpClose2Proc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ TCL_UNUSED(Tcl_Interp *), int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = (TcpState *)instanceData; int readError = 0; @@ -704,24 +703,24 @@ static inline int IPv6AddressNeedsNumericRendering( struct in6_addr addr) { if (IN6_ARE_ADDR_EQUAL(&addr, &in6addr_any)) { - return 1; + return 1; } /* * The IN6_IS_ADDR_V4MAPPED macro has a problem with aliasing warnings on * at least some versions of OSX. */ if (!IN6_IS_ADDR_V4MAPPED(&addr)) { - return 0; + return 0; } return (addr.s6_addr[12] == 0 && addr.s6_addr[13] == 0 - && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0); + && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0); } #if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) #pragma GCC diagnostic pop #endif #endif /* NEED_FAKE_RFC2553 */ @@ -736,51 +735,51 @@ #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" char host[NI_MAXHOST], nhost[NI_MAXHOST], nport[NI_MAXSERV]; int flags = 0; getnameinfo(&addr.sa, salen, nhost, sizeof(nhost), nport, sizeof(nport), - NI_NUMERICHOST | NI_NUMERICSERV); + NI_NUMERICHOST | NI_NUMERICSERV); Tcl_DStringAppendElement(dsPtr, nhost); /* * We don't want to resolve INADDR_ANY and sin6addr_any; they can * sometimes cause problems (and never have a name). */ if (addr.sa.sa_family == AF_INET) { - if (addr.sa4.sin_addr.s_addr == INADDR_ANY) { - flags |= NI_NUMERICHOST; - } + if (addr.sa4.sin_addr.s_addr == INADDR_ANY) { + flags |= NI_NUMERICHOST; + } #ifndef NEED_FAKE_RFC2553 } else if (addr.sa.sa_family == AF_INET6) { - if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) { - flags |= NI_NUMERICHOST; - } + if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) { + flags |= NI_NUMERICHOST; + } #endif /* NEED_FAKE_RFC2553 */ } /* * Check if reverse DNS has been switched off globally. */ if (interp != NULL && - Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { - flags |= NI_NUMERICHOST; + Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { + flags |= NI_NUMERICHOST; } if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, - flags) == 0) { - /* - * Reverse mapping worked. - */ + flags) == 0) { + /* + * Reverse mapping worked. + */ - Tcl_DStringAppendElement(dsPtr, host); + Tcl_DStringAppendElement(dsPtr, host); } else { - /* - * Reverse mapping failed - use the numeric rep once more. - */ + /* + * Reverse mapping failed - use the numeric rep once more. + */ - Tcl_DStringAppendElement(dsPtr, nhost); + Tcl_DStringAppendElement(dsPtr, nhost); } Tcl_DStringAppendElement(dsPtr, nport); } /* @@ -905,44 +904,44 @@ if ((len > 1) && (optionName[1] == 'e') && (strncmp(optionName, "-error", len) == 0)) { socklen_t optlen = sizeof(int); WaitForConnect(statePtr, NULL); - if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { - /* - * Suppress errors as long as we are not done. - */ - - errno = 0; - } else if (statePtr->connectError != 0) { - errno = statePtr->connectError; - statePtr->connectError = 0; - } else { - int err; - - getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err, - &optlen); - errno = err; - } - if (errno != 0) { + if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { + /* + * Suppress errors as long as we are not done. + */ + + errno = 0; + } else if (statePtr->connectError != 0) { + errno = statePtr->connectError; + statePtr->connectError = 0; + } else { + int err; + + getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err, + &optlen); + errno = err; + } + if (errno != 0) { Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errno), TCL_INDEX_NONE); - } + } return TCL_OK; } if ((len > 1) && (optionName[1] == 'c') && (strncmp(optionName, "-connecting", len) == 0)) { WaitForConnect(statePtr, NULL); Tcl_DStringAppend(dsPtr, GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT) ? "1" : "0", TCL_INDEX_NONE); - return TCL_OK; + return TCL_OK; } if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && (strncmp(optionName, "-peername", len) == 0))) { - address peername; - socklen_t size = sizeof(peername); + address peername; + socklen_t size = sizeof(peername); WaitForConnect(statePtr, NULL); if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { /* * In async connect output an empty string @@ -961,15 +960,15 @@ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringStartSublist(dsPtr); } - TcpHostPortList(interp, dsPtr, peername, size); + TcpHostPortList(interp, dsPtr, peername, size); if (len) { - return TCL_OK; - } - Tcl_DStringEndSublist(dsPtr); + return TCL_OK; + } + Tcl_DStringEndSublist(dsPtr); } else { /* * getpeername failed - but if we were asked for all the options * (len==0), don't flag an error at that point because it could be * an fconfigure request on a server socket (which have no peer). @@ -977,11 +976,11 @@ */ if (len) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get peername: %s", + "can't get peername: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } } @@ -1002,30 +1001,30 @@ if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { /* * In async connect output an empty string */ - found = 1; + found = 1; } else { for (fds = &statePtr->fds; fds != NULL; fds = fds->next) { size = sizeof(sockname); if (getsockname(fds->fd, &(sockname.sa), &size) >= 0) { found = 1; TcpHostPortList(interp, dsPtr, sockname, size); } } } - if (found) { - if (len) { - return TCL_OK; - } - Tcl_DStringEndSublist(dsPtr); - } else { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get sockname: %s", Tcl_PosixError(interp))); - } + if (found) { + if (len) { + return TCL_OK; + } + Tcl_DStringEndSublist(dsPtr); + } else { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get sockname: %s", Tcl_PosixError(interp))); + } return TCL_ERROR; } } if ((len == 0) || ((len > 1) && (optionName[1] == 'k') && @@ -1068,11 +1067,11 @@ } } if (len > 0) { return Tcl_BadChannelOption(interp, optionName, - "connecting keepalive nodelay peername sockname"); + "connecting keepalive nodelay peername sockname"); } return TCL_OK; } @@ -1167,36 +1166,35 @@ Tcl_NotifyChannel(statePtr->channel, newmask); } static void TcpWatchProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { TcpState *statePtr = (TcpState *)instanceData; if (statePtr->acceptProc != NULL) { - /* - * Make sure we don't mess with server sockets since they will never - * be readable or writable at the Tcl level. This keeps Tcl scripts - * from interfering with the -accept behavior (bug #3394732). - */ + /* + * Make sure we don't mess with server sockets since they will never + * be readable or writable at the Tcl level. This keeps Tcl scripts + * from interfering with the -accept behavior (bug #3394732). + */ return; } if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { - /* - * Async sockets use a FileHandler internally while connecting, so we - * need to cache this request until the connection has succeeded. - */ - - statePtr->filehandlers = mask; - } else if (mask) { - + /* + * Async sockets use a FileHandler internally while connecting, so we + * need to cache this request until the connection has succeeded. + */ + + statePtr->filehandlers = mask; + } else if (mask) { /* * Whether it is a bug or feature or otherwise, it is a fact of life * that on at least some Linux kernels select() fails to report that a * socket file descriptor is writable when the other end of the socket * is closed. This is in contrast to the guarantees Tcl makes that @@ -1240,13 +1238,13 @@ * ---------------------------------------------------------------------- */ static int TcpGetHandleProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { TcpState *statePtr = (TcpState *)instanceData; *handlePtr = INT2PTR(statePtr->fds.fd); return TCL_OK; @@ -1264,11 +1262,11 @@ * ---------------------------------------------------------------------- */ static void TcpAsyncCallback( - void *clientData, /* The socket state. */ + void *clientData, /* The socket state. */ TCL_UNUSED(int) /*mask*/) { TcpConnect(NULL, (TcpState *)clientData); } @@ -1312,40 +1310,40 @@ int ret = -1, error = EHOSTUNREACH; int async = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT); static const int reuseaddr = 1; if (async_callback) { - goto reenter; + goto reenter; } for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; - statePtr->addr = statePtr->addr->ai_next) { - for (statePtr->myaddr = statePtr->myaddrlist; - statePtr->myaddr != NULL; - statePtr->myaddr = statePtr->myaddr->ai_next) { + statePtr->addr = statePtr->addr->ai_next) { + for (statePtr->myaddr = statePtr->myaddrlist; + statePtr->myaddr != NULL; + statePtr->myaddr = statePtr->myaddr->ai_next) { /* * No need to try combinations of local and remote addresses of * different families. */ if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) { continue; } - /* - * Close the socket if it is still open from the last unsuccessful - * iteration. - */ + /* + * Close the socket if it is still open from the last unsuccessful + * iteration. + */ - if (statePtr->fds.fd >= 0) { + if (statePtr->fds.fd >= 0) { close(statePtr->fds.fd); statePtr->fds.fd = -1; - errno = 0; + errno = 0; } statePtr->fds.fd = socket(statePtr->addr->ai_family, SOCK_STREAM, - 0); + 0); if (statePtr->fds.fd < 0) { continue; } /* @@ -1360,70 +1358,70 @@ */ TclSockMinimumBuffers(INT2PTR(statePtr->fds.fd), SOCKET_BUFSIZE); if (async) { - ret = TclUnixSetBlockingMode(statePtr->fds.fd, - TCL_MODE_NONBLOCKING); - if (ret < 0) { - continue; - } - } - - /* - * Must reset the error variable here, before we use it for the - * first time in this iteration. - */ - - error = 0; - - (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR, - (char *) &reuseaddr, sizeof(reuseaddr)); - ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr, - statePtr->myaddr->ai_addrlen); - if (ret < 0) { - error = errno; - continue; - } + ret = TclUnixSetBlockingMode(statePtr->fds.fd, + TCL_MODE_NONBLOCKING); + if (ret < 0) { + continue; + } + } + + /* + * Must reset the error variable here, before we use it for the + * first time in this iteration. + */ + + error = 0; + + (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR, + (char *) &reuseaddr, sizeof(reuseaddr)); + ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr, + statePtr->myaddr->ai_addrlen); + if (ret < 0) { + error = errno; + continue; + } /* * Attempt to connect. The connect may fail at present with an * EINPROGRESS but at a later time it will complete. The caller * will set up a file handler on the socket if she is interested * in being informed when the connect completes. */ ret = connect(statePtr->fds.fd, statePtr->addr->ai_addr, - statePtr->addr->ai_addrlen); - if (ret < 0) { - error = errno; - } + statePtr->addr->ai_addrlen); + if (ret < 0) { + error = errno; + } if (ret < 0 && errno == EINPROGRESS) { - Tcl_CreateFileHandler(statePtr->fds.fd, - TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback, - statePtr); - errno = EWOULDBLOCK; - SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); - return TCL_OK; - - reenter: - CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); - Tcl_DeleteFileHandler(statePtr->fds.fd); - - /* - * Read the error state from the socket to see if the async - * connection has succeeded or failed. As this clears the - * error condition, we cache the status in the socket state - * struct for later retrieval by [fconfigure -error]. - */ - - optlen = sizeof(int); - - getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, - (char *) &error, &optlen); - errno = error; - } + Tcl_CreateFileHandler(statePtr->fds.fd, + TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback, + statePtr); + errno = EWOULDBLOCK; + SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); + return TCL_OK; + + reenter: + CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); + Tcl_DeleteFileHandler(statePtr->fds.fd); + + /* + * Read the error state from the socket to see if the async + * connection has succeeded or failed. As this clears the + * error condition, we cache the status in the socket state + * struct for later retrieval by [fconfigure -error]. + */ + + optlen = sizeof(int); + + getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, + (char *) &error, &optlen); + errno = error; + } if (error == 0) { goto out; } } } @@ -1430,47 +1428,47 @@ out: statePtr->connectError = error; CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); if (async_callback) { - /* - * An asynchonous connection has finally succeeded or failed. - */ - - TcpWatchProc(statePtr, statePtr->filehandlers); - TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking); - - if (error != 0) { - SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); - } - - /* - * We need to forward the writable event that brought us here, because - * upon reading of getsockopt(SO_ERROR), at least some OSes clear the - * writable state from the socket, and so a subsequent select() on - * behalf of a script level [fileevent] would not fire. It doesn't - * hurt that this is also called in the successful case and will save - * the event mechanism one roundtrip through select(). - */ + /* + * An asynchonous connection has finally succeeded or failed. + */ + + TcpWatchProc(statePtr, statePtr->filehandlers); + TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking); + + if (error != 0) { + SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); + } + + /* + * We need to forward the writable event that brought us here, because + * upon reading of getsockopt(SO_ERROR), at least some OSes clear the + * writable state from the socket, and so a subsequent select() on + * behalf of a script level [fileevent] would not fire. It doesn't + * hurt that this is also called in the successful case and will save + * the event mechanism one roundtrip through select(). + */ if (statePtr->cachedBlocking == TCL_MODE_NONBLOCKING) { Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE); } } if (error != 0) { - /* - * Failure for either a synchronous connection, or an async one that - * failed before it could enter background mode, e.g. because an - * invalid -myaddr was given. - */ - - if (interp != NULL) { - errno = error; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", Tcl_PosixError(interp))); - } - return TCL_ERROR; + /* + * Failure for either a synchronous connection, or an async one that + * failed before it could enter background mode, e.g. because an + * invalid -myaddr was given. + */ + + if (interp != NULL) { + errno = error; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", Tcl_PosixError(interp))); + } + return TCL_ERROR; } return TCL_OK; } /* @@ -1509,20 +1507,20 @@ /* * Do the name lookups for the local and remote addresses. */ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg) - || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, - &errorMsg)) { - if (addrlist != NULL) { - freeaddrinfo(addrlist); - } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", errorMsg)); - } - return NULL; + || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, + &errorMsg)) { + if (addrlist != NULL) { + freeaddrinfo(addrlist); + } + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", errorMsg)); + } + return NULL; } /* * Allocate a new TcpState for this socket. */ @@ -1538,18 +1536,18 @@ /* * Create a new client socket and wrap it in a channel. */ if (TcpConnect(interp, statePtr) != TCL_OK) { - TcpCloseProc(statePtr, NULL); - return NULL; + TcpCloseProc(statePtr, NULL); + return NULL; } snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(statePtr)); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - statePtr, TCL_READABLE | TCL_WRITABLE); + statePtr, TCL_READABLE | TCL_WRITABLE); if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation", "auto crlf") == TCL_ERROR) { Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } @@ -1572,14 +1570,14 @@ *---------------------------------------------------------------------- */ Tcl_Channel Tcl_MakeTcpClientChannel( - void *sock) /* The socket to wrap up into a channel. */ + void *sock) /* The socket to wrap up into a channel. */ { return (Tcl_Channel) TclpMakeTcpClientChannelMode(sock, - TCL_READABLE | TCL_WRITABLE); + TCL_READABLE | TCL_WRITABLE); } /* *---------------------------------------------------------------------- * @@ -1597,11 +1595,11 @@ *---------------------------------------------------------------------- */ void * TclpMakeTcpClientChannelMode( - void *sock, /* The socket to wrap up into a channel. */ + void *sock, /* The socket to wrap up into a channel. */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { TcpState *statePtr; char channelName[SOCK_CHAN_LENGTH]; @@ -1644,11 +1642,11 @@ Tcl_OpenTcpServerEx( Tcl_Interp *interp, /* For error reporting - may be NULL. */ const char *service, /* Port number to open. */ const char *myHost, /* Name of local host. */ unsigned int flags, /* Flags. */ - int backlog, /* Length of OS listen backlog queue. */ + int backlog, /* Length of OS listen backlog queue. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ void *acceptProcData) /* Data for the callback. */ { @@ -1682,21 +1680,21 @@ int retry = 0; #define MAXRETRY 10 repeat: if (retry > 0) { - if (statePtr != NULL) { - TcpCloseProc(statePtr, NULL); - statePtr = NULL; - } - if (addrlist != NULL) { - freeaddrinfo(addrlist); - addrlist = NULL; - } - if (retry >= MAXRETRY) { - goto error; - } + if (statePtr != NULL) { + TcpCloseProc(statePtr, NULL); + statePtr = NULL; + } + if (addrlist != NULL) { + freeaddrinfo(addrlist); + addrlist = NULL; + } + if (retry >= MAXRETRY) { + goto error; + } } retry++; chosenport = 0; if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) { @@ -1703,18 +1701,18 @@ errorMsg = "invalid port number"; goto error; } if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, - &errorMsg)) { + &errorMsg)) { my_errno = errno; goto error; } for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) { sock = socket(addrPtr->ai_family, addrPtr->ai_socktype, - addrPtr->ai_protocol); + addrPtr->ai_protocol); if (sock == -1) { if (howfar < SOCKET) { howfar = SOCKET; my_errno = errno; } @@ -1758,104 +1756,104 @@ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEPORT, (char *) &optvalue, sizeof(optvalue)); #endif } - /* - * Make sure we use the same port number when opening two server - * sockets for IPv4 and IPv6 on a random port. - * - * As sockaddr_in6 uses the same offset and size for the port member - * as sockaddr_in, we can handle both through the IPv4 API. - */ + /* + * Make sure we use the same port number when opening two server + * sockets for IPv4 and IPv6 on a random port. + * + * As sockaddr_in6 uses the same offset and size for the port member + * as sockaddr_in, we can handle both through the IPv4 API. + */ if (port == 0 && chosenport != 0) { ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port = - htons(chosenport); + htons(chosenport); } #ifdef IPV6_V6ONLY /* - * Missing on: Solaris 2.8 - */ - - if (addrPtr->ai_family == AF_INET6) { - int v6only = 1; - - (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY, - &v6only, sizeof(v6only)); - } + * Missing on: Solaris 2.8 + */ + + if (addrPtr->ai_family == AF_INET6) { + int v6only = 1; + + (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY, + &v6only, sizeof(v6only)); + } #endif /* IPV6_V6ONLY */ status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen); - if (status == -1) { + if (status == -1) { if (howfar < BIND) { howfar = BIND; my_errno = errno; } - close(sock); - sock = -1; - if (port == 0 && errno == EADDRINUSE) { - goto repeat; - } - continue; - } - if (port == 0 && chosenport == 0) { - address sockname; - socklen_t namelen = sizeof(sockname); - - /* - * Synchronize port numbers when binding to port 0 of multiple - * addresses. - */ - - if (getsockname(sock, &sockname.sa, &namelen) >= 0) { - chosenport = ntohs(sockname.sa4.sin_port); - } - } - if (backlog < 0) { - backlog = SOMAXCONN; - } - status = listen(sock, backlog); - if (status < 0) { + close(sock); + sock = -1; + if (port == 0 && errno == EADDRINUSE) { + goto repeat; + } + continue; + } + if (port == 0 && chosenport == 0) { + address sockname; + socklen_t namelen = sizeof(sockname); + + /* + * Synchronize port numbers when binding to port 0 of multiple + * addresses. + */ + + if (getsockname(sock, &sockname.sa, &namelen) >= 0) { + chosenport = ntohs(sockname.sa4.sin_port); + } + } + if (backlog < 0) { + backlog = SOMAXCONN; + } + status = listen(sock, backlog); + if (status < 0) { if (howfar < LISTEN) { howfar = LISTEN; my_errno = errno; } - close(sock); - sock = -1; - if (port == 0 && errno == EADDRINUSE) { - goto repeat; - } - continue; - } - if (statePtr == NULL) { - /* - * Allocate a new TcpState for this socket. - */ - - statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); - memset(statePtr, 0, sizeof(TcpState)); - statePtr->acceptProc = acceptProc; - statePtr->acceptProcData = acceptProcData; - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(statePtr)); - newfds = &statePtr->fds; - } else { - newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); - memset(newfds, (int) 0, sizeof(TcpFdList)); - fds->next = newfds; - } - 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); + close(sock); + sock = -1; + if (port == 0 && errno == EADDRINUSE) { + goto repeat; + } + continue; + } + if (statePtr == NULL) { + /* + * Allocate a new TcpState for this socket. + */ + + statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); + memset(statePtr, 0, sizeof(TcpState)); + statePtr->acceptProc = acceptProc; + statePtr->acceptProcData = acceptProcData; + snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(statePtr)); + newfds = &statePtr->fds; + } else { + newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); + memset(newfds, (int) 0, sizeof(TcpFdList)); + fds->next = newfds; + } + 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); } error: if (addrlist != NULL) { freeaddrinfo(addrlist); @@ -1864,19 +1862,19 @@ statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, 0); return statePtr->channel; } if (interp != NULL) { - Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", TCL_INDEX_NONE); + Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", TCL_INDEX_NONE); if (errorMsg == NULL) { - errno = my_errno; - Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), TCL_INDEX_NONE); - } else { + errno = my_errno; + Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), TCL_INDEX_NONE); + } else { Tcl_AppendToObj(errorObj, errorMsg, TCL_INDEX_NONE); } - Tcl_SetObjResult(interp, errorObj); + Tcl_SetObjResult(interp, errorObj); } if (sock != -1) { close(sock); } return NULL; @@ -1898,14 +1896,15 @@ *---------------------------------------------------------------------- */ static void TcpAccept( - void *data, /* Callback token. */ + void *data, /* Callback token. */ TCL_UNUSED(int) /*mask*/) { - TcpFdList *fds = (TcpFdList *)data; /* Client data of server socket. */ + TcpFdList *fds = (TcpFdList *)data; + /* Client data of server socket. */ int newsock; /* The new client socket */ TcpState *newSockState; /* State for new socket. */ address addr; /* The remote address */ socklen_t len; /* For accept interface */ char channelName[SOCK_CHAN_LENGTH]; @@ -1936,13 +1935,13 @@ Tcl_SetChannelOption(NULL, newSockState->channel, "-translation", "auto crlf"); if (fds->statePtr->acceptProc != NULL) { getnameinfo(&addr.sa, len, host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); + NI_NUMERICHOST|NI_NUMERICSERV); fds->statePtr->acceptProc(fds->statePtr->acceptProcData, - newSockState->channel, host, atoi(port)); + newSockState->channel, host, atoi(port)); } } /* * Local Variables: Index: unix/tclUnixTest.c ================================================================== --- unix/tclUnixTest.c +++ unix/tclUnixTest.c @@ -310,11 +310,11 @@ return TCL_OK; } static void TestFileHandlerProc( - void *clientData, /* Points to a Pipe structure. */ + void *clientData, /* Points to a Pipe structure. */ int mask) /* Indicates which events happened: * TCL_READABLE or TCL_WRITABLE. */ { Pipe *pipePtr = (Pipe *)clientData; @@ -609,13 +609,13 @@ */ static int TestchmodCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ + Tcl_Obj *const *objv) /* Argument strings. */ { int i, mode; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?"); Index: unix/tclUnixThrd.c ================================================================== --- unix/tclUnixThrd.c +++ unix/tclUnixThrd.c @@ -211,12 +211,12 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ - void *clientData, /* The one argument to Main() */ - size_t stackSize, /* Size of stack for the new thread */ + void *clientData, /* The one argument to Main() */ + size_t stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { #if TCL_THREADS pthread_attr_t attr; @@ -670,11 +670,11 @@ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (pthread_cond_t **) */ Tcl_Mutex *mutexPtr, /* Really (PMutex **) */ - const Tcl_Time *timePtr) /* Timeout on waiting period */ + const Tcl_Time *timePtr) /* Timeout on waiting period */ { pthread_cond_t *pcondPtr; PMutex *pmutexPtr; struct timespec ptime; @@ -706,11 +706,11 @@ * current time, including possible overflow situations. [Bug #411603] */ Tcl_GetTime(&now); ptime.tv_sec = timePtr->sec + now.sec + - (timePtr->usec + now.usec) / 1000000; + (timePtr->usec + now.usec) / 1000000; ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000); PCondTimedWait(pcondPtr, pmutexPtr, &ptime); } } @@ -837,11 +837,10 @@ * finalization initiated from Tcl_FinalizeThread() */ TclFreeAllocCache(ptr); pthread_setspecific(key, NULL); - } else { /* * Called by TclFinalizeThreadAlloc() during the process * finalization initiated from Tcl_Finalize() */ Index: unix/tclXtNotify.c ================================================================== --- unix/tclXtNotify.c +++ unix/tclXtNotify.c @@ -31,11 +31,11 @@ XtInputId read; /* Xt read callback handle. */ XtInputId write; /* Xt write callback handle. */ XtInputId except; /* Xt exception callback handle. */ Tcl_FileProc *proc; /* Procedure to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; /* * The following structure is what is added to the Tcl event queue when file @@ -261,11 +261,11 @@ *---------------------------------------------------------------------- */ static void SetTimer( - const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ + const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { unsigned long timeout; if (!initialized) { InitNotifier(); @@ -337,11 +337,11 @@ * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. */ Tcl_FileProc *proc, /* Procedure to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { FileHandler *filePtr; if (!initialized) { InitNotifier(); @@ -625,11 +625,11 @@ *---------------------------------------------------------------------- */ static int WaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { int timeout; if (!initialized) { InitNotifier(); Index: win/tclWin32Dll.c ================================================================== --- win/tclWin32Dll.c +++ win/tclWin32Dll.c @@ -430,12 +430,12 @@ *---------------------------------------------------------------------- */ int TclWinCPUID( - int index, /* Which CPUID value to retrieve. */ - int *regsPtr) /* Registers after the CPUID. */ + int index, /* Which CPUID value to retrieve. */ + int *regsPtr) /* Registers after the CPUID. */ { int status = TCL_ERROR; #if defined(HAVE_INTRIN_H) && defined(_WIN64) && defined(HAVE_CPUID) Index: win/tclWinChan.c ================================================================== --- win/tclWinChan.c +++ win/tclWinChan.c @@ -15,16 +15,20 @@ /* * State flags used in the info structures below. */ -#define FILE_PENDING (1<<0) /* Message is pending in the queue. */ -#define FILE_ASYNC (1<<1) /* Channel is non-blocking. */ -#define FILE_APPEND (1<<2) /* File is in append mode. */ +enum FileInfoFlags { + FILE_PENDING = (1 << 0), /* Message is pending in the queue. */ + FILE_ASYNC = (1 << 1), /* Channel is non-blocking. */ + FILE_APPEND = (1 << 2) /* File is in append mode. */ +}; -#define FILE_TYPE_SERIAL (FILE_TYPE_PIPE+1) -#define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2) +enum TclWinFileType { + FILE_TYPE_SERIAL = (FILE_TYPE_PIPE + 1), + FILE_TYPE_CONSOLE = (FILE_TYPE_PIPE + 2) +}; /* * The following structure contains per-instance data for a file based * channel. */ @@ -106,19 +110,19 @@ */ static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ - NULL, + NULL, NULL, /* Set option proc. */ FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ FileGetHandleProc, /* Get an OS handle from channel. */ - FileCloseProc, /* close2proc. */ + FileCloseProc, /* New close proc. */ FileBlockProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ FileWideSeekProc, /* Wide seek proc. */ FileThreadActionProc, /* Thread action proc. */ @@ -383,11 +387,11 @@ *---------------------------------------------------------------------- */ static int FileBlockProc( - void *instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -422,11 +426,11 @@ *---------------------------------------------------------------------- */ static int FileCloseProc( - void *instanceData, /* Pointer to FileInfo structure. */ + void *instanceData, /* Pointer to FileInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { FileInfo *fileInfoPtr = (FileInfo *)instanceData; FileInfo *infoPtr; @@ -472,11 +476,11 @@ * been removed by an earlier Threadaction call, but do that now * since just deallocating fileInfoPtr would leave an deallocated * pointer on the thread local list. */ - FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE); + FileThreadActionProc(fileInfoPtr, TCL_CHANNEL_THREAD_REMOVE); break; } } Tcl_Free(fileInfoPtr); return errorCode; @@ -500,11 +504,11 @@ *---------------------------------------------------------------------- */ static long long FileWideSeekProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -552,11 +556,11 @@ *---------------------------------------------------------------------- */ static int FileTruncateProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ long long length) /* Length to truncate at. */ { FileInfo *infoPtr = (FileInfo *)instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; @@ -628,11 +632,11 @@ *---------------------------------------------------------------------- */ static int FileInputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -683,11 +687,11 @@ *---------------------------------------------------------------------- */ static int FileOutputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -730,11 +734,11 @@ *---------------------------------------------------------------------- */ static void FileWatchProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ int mask) /* What events to watch for; OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -769,13 +773,13 @@ *---------------------------------------------------------------------- */ static int FileGetHandleProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { FileInfo *infoPtr = (FileInfo *)instanceData; if (!TEST_FLAG(direction, infoPtr->validMask)) { return TCL_ERROR; @@ -919,11 +923,11 @@ return dictObj; } static int FileGetOptionProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ Tcl_Interp *interp, /* For error reporting. */ const char *optionName, /* What option to read, or NULL for all. */ Tcl_DString *dsPtr) /* Where to write the value read. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -1217,11 +1221,11 @@ *---------------------------------------------------------------------- */ Tcl_Channel Tcl_MakeFileChannel( - void *rawHandle, /* OS level handle */ + void *rawHandle, /* OS level handle */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__) TCLEXCEPTION_REGISTRATION registration; Index: win/tclWinConsole.c ================================================================== --- win/tclWinConsole.c +++ win/tclWinConsole.c @@ -92,14 +92,14 @@ /* * Ring buffer for storing data. Actual data is from bufPtr[start]:bufPtr[size-1] * and bufPtr[0]:bufPtr[length - (size-start)]. */ typedef struct RingBuffer { - char *bufPtr; /* Pointer to buffer storage */ - Tcl_Size capacity; /* Size of the buffer in RingBufferChar */ - Tcl_Size start; /* Start of the data within the buffer. */ - Tcl_Size length; /* Number of RingBufferChar*/ + char *bufPtr; /* Pointer to buffer storage */ + Tcl_Size capacity; /* Size of the buffer in RingBufferChar */ + Tcl_Size start; /* Start of the data within the buffer. */ + Tcl_Size length; /* Number of RingBufferChar */ } RingBuffer; #define RingBufferLength(ringPtr_) ((ringPtr_)->length) #define RingBufferHasFreeSpace(ringPtr_) ((ringPtr_)->length < (ringPtr_)->capacity) #define RINGBUFFER_ASSERT(ringPtr_) assert(RingBufferCheck(ringPtr_)) @@ -123,32 +123,36 @@ * references to it - one each from every channel that is attached to it * plus one from the console thread itself which also serves as the reference * from gConsoleHandleInfoList. */ typedef struct ConsoleHandleInfo { - struct ConsoleHandleInfo *nextPtr; /* Process-global list of consoles */ - HANDLE console; /* Console handle */ - HANDLE consoleThread; /* Handle to thread doing actual i/o on the console */ - SRWLOCK lock; /* Controls access to this structure. - * Cheaper than CRITICAL_SECTION but note does not - * support recursive locks or Try* style attempts.*/ + struct ConsoleHandleInfo *nextPtr; + /* Process-global list of consoles */ + HANDLE console; /* Console handle */ + HANDLE consoleThread; /* Handle to thread doing actual i/o on the console */ + SRWLOCK lock; /* Controls access to this structure. + * Cheaper than CRITICAL_SECTION but note does not + * support recursive locks or Try* style attempts.*/ CONDITION_VARIABLE consoleThreadCV;/* For awakening console thread */ CONDITION_VARIABLE interpThreadCV; /* For awakening interpthread(s) */ - RingBuffer buffer; /* Buffer for data transferred between console - * threads and Tcl threads. For input consoles, - * written by the console thread and read by Tcl - * threads. The converse for output threads */ - DWORD initMode; /* Initial console mode. */ - DWORD lastError; /* An error caused by the last background - * operation. Set to 0 if no error has been - * detected. */ - int numRefs; /* See comments above */ - int permissions; /* TCL_READABLE for input consoles, TCL_WRITABLE - * for output. Only one or the other can be set. */ + RingBuffer buffer; /* Buffer for data transferred between console + * threads and Tcl threads. For input consoles, + * written by the console thread and read by Tcl + * threads. The converse for output threads */ + DWORD initMode; /* Initial console mode. */ + DWORD lastError; /* An error caused by the last background + * operation. Set to 0 if no error has been + * detected. */ + int numRefs; /* See comments above */ + int permissions; /* TCL_READABLE for input consoles, TCL_WRITABLE + * for output. Only one or the other can be set. */ int flags; -#define CONSOLE_DATA_AWAITED 0x0001 /* An interpreter is awaiting data */ } ConsoleHandleInfo; + +enum ConsoleHandleInfoFlags { + CONSOLE_DATA_AWAITED = 1 /* An interpreter is awaiting data */ +}; /* * This structure describes per-instance data for a console based channel. * * Note on locking - this structure has no locks because it is accessed @@ -181,21 +185,24 @@ struct ConsoleChannelInfo *nextWatchingChannelPtr; /* Pointer to next channel watching events. */ Tcl_Channel channel; /* Pointer to channel structure. */ DWORD initMode; /* Initial console mode. */ int numRefs; /* See comments above */ - int permissions; /* OR'ed combination of TCL_READABLE, + int permissions; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ int watchMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which events should be reported. */ int flags; /* State flags */ -#define CONSOLE_EVENT_QUEUED 0x0001 /* Notification event already queued */ -#define CONSOLE_ASYNC 0x0002 /* Channel is non-blocking. */ -#define CONSOLE_READ_OPS 0x0004 /* Channel supports read-related ops. */ } ConsoleChannelInfo; + +enum ConsoleChannelInfoFlags { + CONSOLE_EVENT_QUEUED = 1, /* Notification event already queued */ + CONSOLE_ASYNC = 2, /* Channel is non-blocking. */ + CONSOLE_READ_OPS = 4 /* Channel supports read-related ops. */ +}; /* * The following structure is what is added to the Tcl event queue when * console events are generated. */ @@ -278,11 +285,10 @@ * locks being held. Note console channels also differ from other Tcl * channel types in that the channel<->OS descriptor mapping is not one-to-one. */ SRWLOCK gConsoleLock; - /* Process-wide list of console handles. Access control through gConsoleLock */ static ConsoleHandleInfo *gConsoleHandleInfoList; /* * Process-wide list of channels that are listening for events. Again access @@ -297,27 +303,27 @@ * This structure describes the channel type structure for command console * based IO. */ static const Tcl_ChannelType consoleChannelType = { - "console", /* Type name. */ - TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ - ConsoleInputProc, /* Input proc. */ - ConsoleOutputProc, /* Output proc. */ - NULL, /* Seek proc. */ - ConsoleSetOptionProc, /* Set option proc. */ - ConsoleGetOptionProc, /* Get option proc. */ - ConsoleWatchProc, /* Set up notifier to watch the channel. */ - ConsoleGetHandleProc, /* Get an OS handle from channel. */ - ConsoleCloseProc, /* close2proc. */ - ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ - NULL, /* Flush proc. */ - NULL, /* Handler proc. */ - NULL, /* Wide seek proc. */ - ConsoleThreadActionProc, /* Thread action proc. */ - NULL /* Truncation proc. */ + "console", /* Type name. */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ + NULL, /* Old close proc. */ + ConsoleInputProc, /* Input proc. */ + ConsoleOutputProc, /* Output proc. */ + NULL, /* Seek proc. */ + ConsoleSetOptionProc, /* Set option proc. */ + ConsoleGetOptionProc, /* Get option proc. */ + ConsoleWatchProc, /* Set up notifier to watch the channel. */ + ConsoleGetHandleProc, /* Get an OS handle from channel. */ + ConsoleCloseProc, /* New close proc. */ + ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ + NULL, /* Flush proc. */ + NULL, /* Handler proc. */ + NULL, /* Wide seek proc. */ + ConsoleThreadActionProc, /* Thread action proc. */ + NULL /* Truncation proc. */ }; /* *------------------------------------------------------------------------ * @@ -411,11 +417,12 @@ } if (ringPtr->capacity - ringPtr->start > ringPtr->length) { /* There is room at the back */ Tcl_Size endSpaceStart = ringPtr->start + ringPtr->length; - Tcl_Size endSpace = ringPtr->capacity - endSpaceStart; + Tcl_Size endSpace = ringPtr->capacity - endSpaceStart; + if (endSpace >= srcLen) { /* Everything fits at the back */ memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, srcLen); } else { /* srcLen > endSpace */ @@ -423,11 +430,12 @@ memmove(ringPtr->bufPtr, endSpace + srcPtr, srcLen - endSpace); } } else { /* No room at the back. Existing data wrap to front. */ Tcl_Size wrapLen = - ringPtr->start + ringPtr->length - ringPtr->capacity; + ringPtr->start + ringPtr->length - ringPtr->capacity; + memmove(wrapLen + ringPtr->bufPtr, srcPtr, srcLen); } ringPtr->length += srcLen; @@ -730,10 +738,11 @@ static void NudgeWatchers( HANDLE consoleHandle) { ConsoleChannelInfo *chanInfoPtr; + AcquireSRWLockShared(&gConsoleLock); /* Shared-read lock */ for (chanInfoPtr = gWatchingChannelList; chanInfoPtr; chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { /* * Notify channels interested in our handle AND that have @@ -971,11 +980,11 @@ *---------------------------------------------------------------------- */ static int ConsoleCloseProc( - void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ + void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; ConsoleHandleInfo *handleInfoPtr; @@ -1304,11 +1313,11 @@ * (4) when the pointer is not aligned on WCHAR * The ring buffer deals with cases (3) and (4). It would be harder * to duplicate that here. */ if ((chanInfoPtr->flags & CONSOLE_ASYNC) /* Case (1) */ - || RingBufferLength(&handleInfoPtr->buffer) != 0 /* Case (2) */ + || RingBufferLength(&handleInfoPtr->buffer) != 0/* Case (2) */ || (toWrite & 1) != 0 /* Case (3) */ || (PTR2INT(buf) & 1) != 0) { /* Case (4) */ numWritten += RingBufferIn(&handleInfoPtr->buffer, numWritten + buf, toWrite - numWritten, 1); if (numWritten == toWrite || chanInfoPtr->flags & CONSOLE_ASYNC) { @@ -1656,11 +1665,10 @@ /* This thread is holding a reference so pointer is safe */ AcquireSRWLockExclusive(&handleInfoPtr->lock); while (1) { - if (handleInfoPtr->numRefs == 1) { /* * Sole reference. That's this thread. Exit since no clients * and no way for a thread to attach to a console after process * start. @@ -1673,10 +1681,11 @@ * copy that. Else check if there has been an error. In both cases * notify the interp threads. */ if (inputLen > 0 || handleInfoPtr->lastError != 0) { HANDLE consoleHandle; + if (inputLen > 0) { /* Private buffer has data. Copy it over. */ Tcl_Size nStored; assert((inputLen - inputOffset) > 0); @@ -1742,10 +1751,11 @@ */ if (lastReadSize == sizeof(inputChars) || ((handleInfoPtr->flags & CONSOLE_DATA_AWAITED) && ConsoleDataAvailable(handleInfoPtr->console))) { DWORD error; + /* Do not hold the lock while blocked in console */ ReleaseSRWLockExclusive(&handleInfoPtr->lock); error = ReadConsoleChars(handleInfoPtr->console, (WCHAR *)inputChars, sizeof(inputChars) / sizeof(WCHAR), &inputLen); @@ -1847,11 +1857,11 @@ /* * This buffer size has no relation really with the size of the shared * buffer. Could be bigger or smaller. Make larger as multiple threads * could potentially be writing to it. */ - char buffer[2*CONSOLE_BUFFER_SIZE]; + char buffer[2 * CONSOLE_BUFFER_SIZE]; /* * Keep looping until one of the following happens. * * - there are not more channels listening on the console @@ -1886,14 +1896,16 @@ * Sole reference. That's this thread. Exit since no clients * and no buffered output. */ break; } + /* Wake up any threads waiting synchronously. */ WakeConditionVariable(&handleInfoPtr->interpThreadCV); success = SleepConditionVariableSRW(&handleInfoPtr->consoleThreadCV, &handleInfoPtr->lock, INFINITE, 0); + /* Note: lock has been acquired again! */ if (!success && GetLastError() != ERROR_TIMEOUT) { /* TODO - what can be done? Should not happen */ /* For now keep going */ } @@ -1922,11 +1934,13 @@ handleInfoPtr->lastError = status; } if (status == ERROR_INVALID_HANDLE) { handleInfoPtr->console = INVALID_HANDLE_VALUE; } - /* Assume this write is done but keep looping in case + + /* + * Assume this write is done but keep looping in case * it is a transient error. Not sure just closing handle * and exiting thread is a good idea until all references * from interp threads are gone. */ break; @@ -1935,17 +1949,18 @@ offset += numWChars * sizeof(WCHAR); } /* Wake up any threads waiting synchronously. */ WakeConditionVariable(&handleInfoPtr->interpThreadCV); + /* * Wake up all channels registered for file events. Note in * order to follow the locking hierarchy, we cannot hold any locks * when calling NudgeWatchers. */ - NudgeWatchers(consoleHandle); + NudgeWatchers(consoleHandle); AcquireSRWLockExclusive(&handleInfoPtr->lock); } /* * Exiting: @@ -1955,10 +1970,11 @@ * As per the GetStdHandle documentation, it need not be closed. * Other components may be directly using it. Note however that * an explicit chan close script command does close the handle * for all threads. */ + ReleaseSRWLockExclusive(&handleInfoPtr->lock); AcquireSRWLockExclusive(&gConsoleLock); /* Modifying - exclusive lock */ for (iterator = &gConsoleHandleInfoList; *iterator; iterator = &(*iterator)->nextPtr) { if (*iterator == handleInfoPtr) { @@ -1999,11 +2015,11 @@ *------------------------------------------------------------------------ */ static ConsoleHandleInfo * AllocateConsoleHandleInfo( HANDLE consoleHandle, - int permissions) /* TCL_READABLE or TCL_WRITABLE */ + int permissions) /* TCL_READABLE or TCL_WRITABLE */ { ConsoleHandleInfo *handleInfoPtr; DWORD consoleMode; handleInfoPtr = (ConsoleHandleInfo *) Tcl_Alloc(sizeof(*handleInfoPtr)); @@ -2022,18 +2038,19 @@ consoleMode &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); consoleMode |= ENABLE_LINE_INPUT; SetConsoleMode(consoleHandle, consoleMode); } handleInfoPtr->consoleThread = CreateThread( - NULL, /* default security descriptor */ - 2*CONSOLE_BUFFER_SIZE, /* Stack size - gets rounded up to granularity */ - permissions == TCL_READABLE ? ConsoleReaderThread : ConsoleWriterThread, - handleInfoPtr, /* Pass to thread */ - 0, /* Flags - no special cases */ - NULL); /* Don't care about thread id */ + NULL, /* default security descriptor */ + 2*CONSOLE_BUFFER_SIZE, /* Stack size - gets rounded up to granularity */ + permissions == TCL_READABLE ? ConsoleReaderThread : ConsoleWriterThread, + handleInfoPtr, /* Pass to thread */ + 0, /* Flags - no special cases */ + NULL); /* Don't care about thread id */ if (handleInfoPtr->consoleThread == NULL) { /* Note - SRWLock and condition variables do not need finalization */ + RingBufferClear(&handleInfoPtr->buffer); Tcl_Free(handleInfoPtr); return NULL; } @@ -2066,14 +2083,16 @@ * None. * *------------------------------------------------------------------------ */ static ConsoleHandleInfo * -FindConsoleInfo(const ConsoleChannelInfo *chanInfoPtr) +FindConsoleInfo( + const ConsoleChannelInfo *chanInfoPtr) { ConsoleHandleInfo *handleInfoPtr; - for (handleInfoPtr = gConsoleHandleInfoList; handleInfoPtr; handleInfoPtr = handleInfoPtr->nextPtr) { + for (handleInfoPtr = gConsoleHandleInfoList; handleInfoPtr; + handleInfoPtr = handleInfoPtr->nextPtr) { if (handleInfoPtr->console == chanInfoPtr->handle) { return handleInfoPtr; } } return NULL; @@ -2256,11 +2275,11 @@ * *---------------------------------------------------------------------- */ static int ConsoleSetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ { ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; @@ -2345,11 +2364,11 @@ *---------------------------------------------------------------------- */ static int ConsoleGetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; Index: win/tclWinDde.c ================================================================== --- win/tclWinDde.c +++ win/tclWinDde.c @@ -82,13 +82,15 @@ #define TCL_DDE_VERSION "1.4.5" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME L"TclEval" #define TCL_DDE_EXECUTE_RESULT L"$TCLEVAL$EXECUTE$RESULT" -#define DDE_FLAG_ASYNC 1 -#define DDE_FLAG_BINARY 2 -#define DDE_FLAG_FORCE 4 +enum TclDdeFlags { + DDE_FLAG_ASYNC = 1, + DDE_FLAG_BINARY = 2, + DDE_FLAG_FORCE = 4 +}; TCL_DECLARE_MUTEX(ddeMutex) #if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 @@ -308,14 +310,14 @@ */ static const WCHAR * DdeSetServerName( Tcl_Interp *interp, - const WCHAR *name, /* The name that will be used to refer to the + const WCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ - int flags, /* DDE_FLAG_FORCE or 0 */ + int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { int suffix; RegisteredInterp *riPtr, *prevPtr; @@ -513,11 +515,11 @@ *---------------------------------------------------------------------- */ static void DeleteProc( - void *clientData) /* The interp we are deleting. */ + void *clientData) /* The interp we are deleting. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; RegisteredInterp *searchPtr, *prevPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -566,12 +568,12 @@ *---------------------------------------------------------------------- */ static Tcl_Obj * ExecuteRemoteObject( - RegisteredInterp *riPtr, /* Info about this server. */ - Tcl_Obj *ddeObjectPtr) /* The object to execute. */ + RegisteredInterp *riPtr, /* Info about this server. */ + Tcl_Obj *ddeObjectPtr) /* The object to execute. */ { Tcl_Obj *returnPackagePtr; int result = TCL_OK; if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) { @@ -1254,11 +1256,11 @@ *---------------------------------------------------------------------- */ static void SetDdeError( - Tcl_Interp *interp) /* The interp to put the message in. */ + Tcl_Interp *interp) /* The interp to put the message in. */ { const char *errorMessage, *errorCode; switch (DdeGetLastError(ddeInstance)) { case DMLERR_DATAACKTIMEOUT: @@ -1301,13 +1303,13 @@ *---------------------------------------------------------------------- */ static int DdeObjCmd( - void *dummy, /* Not used. */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* The interp we are sending from */ - Tcl_Size objc, /* Number of arguments */ + Tcl_Size objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { static const char *const ddeCommands[] = { "servername", "execute", "poke", "request", "services", "eval", NULL}; enum DdeSubcommands { @@ -1653,13 +1655,13 @@ && !dataString[tmp / sizeof(WCHAR) - 1]) { tmp -= (DWORD)sizeof(WCHAR); } Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(dataString, tmp>>1, &dsBuf); - returnObjPtr = - Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), - Tcl_DStringLength(&dsBuf)); + returnObjPtr = Tcl_NewStringObj( + Tcl_DStringValue(&dsBuf), + Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); Tcl_SetObjResult(interp, returnObjPtr); Index: win/tclWinFCmd.c ================================================================== --- win/tclWinFCmd.c +++ win/tclWinFCmd.c @@ -15,14 +15,16 @@ /* * The following constants specify the type of callback when * TraverseWinTree() calls the traverseProc() */ -#define DOTREE_PRED 1 /* pre-order directory */ -#define DOTREE_POSTD 2 /* post-order directory */ -#define DOTREE_F 3 /* regular file */ -#define DOTREE_LINK 4 /* symbolic link */ +enum TraversalNodeType { + DOTREE_PRED = 1, /* pre-order directory */ + DOTREE_POSTD = 2, /* post-order directory */ + DOTREE_F = 3, /* regular file */ + DOTREE_LINK = 4 /* symbolic link */ +}; /* * Callbacks for file attributes code. */ @@ -48,13 +50,13 @@ WIN_READONLY_ATTRIBUTE, WIN_SHORTNAME_ATTRIBUTE, WIN_SYSTEM_ATTRIBUTE }; -static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, +static const int attributeArray[] = { + FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; - const char *const tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", "-shortname", "-system", NULL }; @@ -387,11 +389,10 @@ * Other types of access failure is that dst is a read-only * filesystem, that an open file referred to src or dest, or that src * or dest specified the current working directory on the current * filesystem. EACCES is returned for those cases. */ - } else if (Tcl_GetErrno() == EEXIST) { /* * Reports EEXIST any time the target already exists. If it makes * sense, remove the old file and try renaming again. */ @@ -432,11 +433,11 @@ } } } else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ Tcl_SetErrno(ENOTDIR); } - } else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ + } else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { Tcl_SetErrno(EISDIR); } else { /* * Overwrite existing file by: @@ -1120,11 +1121,10 @@ *p = '/'; } } } return TCL_ERROR; - } static int DoRemoveDirectory( Tcl_DString *pathPtr, /* Pathname of directory to be removed @@ -2028,11 +2028,11 @@ baseLen = Tcl_DStringLength(&base); do { char tempbuf[SUFFIX_LENGTH + 1]; int i; static const char randChars[] = - "QWERTYUIOPASDFGHJKLZXCVBNM1234567890"; + "QWERTYUIOPASDFGHJKLZXCVBNM1234567890"; static const int numRandChars = sizeof(randChars) - 1; /* * Put a random suffix on the end. */ Index: win/tclWinFile.c ================================================================== --- win/tclWinFile.c +++ win/tclWinFile.c @@ -14,13 +14,13 @@ #include "tclWinInt.h" #include "tclFileSystem.h" #include #include -#include /* For TclpGetUserHome(). */ +#include /* For TclpGetUserHome(). */ #include /* For TclpGetUserHome(). */ -#include /* For GetNamedSecurityInfo */ +#include /* For GetNamedSecurityInfo */ #ifdef _MSC_VER # pragma comment(lib, "userenv.lib") #endif /* @@ -283,11 +283,10 @@ * reasonable. */ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { return WinSymLinkDirectory(linkSourcePath, linkTargetPath); - } else if (linkAction & TCL_CREATE_HARD_LINK) { /* * Can't hard link directories. */ @@ -341,11 +340,10 @@ * The source doesn't exist. */ Tcl_WinConvertError(GetLastError()); return NULL; - } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * It is a file - this is not yet supported. */ @@ -1248,11 +1246,10 @@ * Have match for 'con' */ return 3; } - } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { if (path[3] >= '1' && path[3] <= '9') { /* @@ -1263,11 +1260,10 @@ return 4; } else if (path[4] == ':' && path[5] == '\0') { return 4; } } - } else if (!strcasecmp(path, "prn") || !strcasecmp(path, "nul") || !strcasecmp(path, "aux")) { /* * Have match for 'prn', 'nul' or 'aux'. */ @@ -1357,11 +1353,10 @@ /* * Quicker test for directory, which is a common case. */ return 1; - } else if (types->type != 0) { unsigned short st_mode; int isExec = NativeIsExec(nativeName); st_mode = NativeStatMode(attr, 0, isExec); @@ -1436,36 +1431,39 @@ wDomain = NULL; domain = Tcl_UtfFindFirst(name, '@'); if (domain == NULL) { const char *ptr; - /* - * Treat the current user as a special case because the general case - * below does not properly retrieve the path. The NetUserGetInfo - * call returns an empty path and the code defaults to the user's - * name in the profiles directory. On modern Windows systems, this - * is generally wrong as when the account is a Microsoft account, - * for example abcdefghi@outlook.com, the directory name is - * abcde and not abcdefghi. - * - * Note we could have just used env(USERPROFILE) here but - * the intent is to retrieve (as on Unix) the system's view - * of the home irrespective of environment settings of HOME - * and USERPROFILE. - * - * Fixing this for the general user needs more investigating but - * at least for the current user we can use a direct call. - */ + /* + * Treat the current user as a special case because the general case + * below does not properly retrieve the path. The NetUserGetInfo + * call returns an empty path and the code defaults to the user's + * name in the profiles directory. On modern Windows systems, this + * is generally wrong as when the account is a Microsoft account, + * for example abcdefghi@outlook.com, the directory name is + * abcde and not abcdefghi. + * + * Note we could have just used env(USERPROFILE) here but + * the intent is to retrieve (as on Unix) the system's view + * of the home irrespective of environment settings of HOME + * and USERPROFILE. + * + * Fixing this for the general user needs more investigating but + * at least for the current user we can use a direct call. + */ + ptr = TclpGetUserName(&ds); if (ptr != NULL && strcasecmp(name, ptr) == 0) { HANDLE hProcess; WCHAR buf[MAX_PATH]; DWORD nChars = sizeof(buf) / sizeof(buf[0]); + /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */ hProcess = GetCurrentProcess(); /* Need not be closed */ if (hProcess) { HANDLE hToken; + if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) { if (GetUserProfileDirectoryW(hToken, buf, &nChars)) { result = Tcl_WCharToUtfDString(buf, nChars-1, (bufferPtr)); rc = 1; } @@ -1830,11 +1828,10 @@ CloseHandle(hToken); if (!accessYesNo) { Tcl_SetErrno(EACCES); return -1; } - } return 0; } /* @@ -1891,11 +1888,11 @@ *---------------------------------------------------------------------- */ int TclpObjChdir( - Tcl_Obj *pathPtr) /* Path to new working directory. */ + Tcl_Obj *pathPtr) /* Path to new working directory. */ { int result; const WCHAR *nativePath; nativePath = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); @@ -2057,26 +2054,26 @@ fileType = GetFileType(fileHandle); CloseHandle(fileHandle); if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) { Tcl_SetErrno(ENOENT); return -1; - } + } - /* + /* * Mock up the expected structure */ memset(&data, 0, sizeof(data)); statPtr->st_atime = 0; statPtr->st_mtime = 0; statPtr->st_ctime = 0; - } else { + } else { CloseHandle(fileHandle); statPtr->st_atime = ToCTime(data.ftLastAccessTime); statPtr->st_mtime = ToCTime(data.ftLastWriteTime); statPtr->st_ctime = ToCTime(data.ftCreationTime); - } + } attr = data.dwFileAttributes; statPtr->st_size = ((long long) data.nFileSizeLow) | (((long long) data.nFileSizeHigh) << 32); /* @@ -2518,13 +2515,13 @@ */ int TclpObjNormalizePath( TCL_UNUSED(Tcl_Interp *), - Tcl_Obj *pathPtr, /* An unshared object containing the path to + Tcl_Obj *pathPtr, /* An unshared object containing the path to * normalize */ - int nextCheckpoint) /* offset to start at in pathPtr */ + int nextCheckpoint) /* offset to start at in pathPtr */ { char *lastValidPathEnd = NULL; Tcl_DString dsNorm; /* This will hold the normalized string. */ char *path, *currentPathEndPosition; Tcl_Obj *temp = NULL; @@ -3278,11 +3275,11 @@ native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (GetNamedSecurityInfoW((LPWSTR) native, SE_FILE_OBJECT, OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL, &secd) != ERROR_SUCCESS) { - /* + /* * Either not a file, or we do not have access to it in which case we * are in all likelihood not the owner. */ return 0; @@ -3294,41 +3291,41 @@ * could not possibly own anything. Normally a process can *always* look * up its own token. */ if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) { - /* + /* * Find out how big the buffer needs to be. */ bufsz = 0; GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); if (bufsz) { buf = (LPBYTE)Tcl_Alloc(bufsz); if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); - } - } + } + } CloseHandle(token); } /* * Free allocations and be done. */ if (secd) { - LocalFree(secd); /* Also frees ownerSid */ + LocalFree(secd); /* Also frees ownerSid */ } if (buf) { Tcl_Free(buf); } - return (owned != 0); /* Convert non-0 to 1 */ + return (owned != 0); /* Convert non-0 to 1 */ } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: win/tclWinInit.c ================================================================== --- win/tclWinInit.c +++ win/tclWinInit.c @@ -514,18 +514,18 @@ } if (Tcl_DStringLength(&ds) > 0) { Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); } else { - /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ - ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); - if (ptr != NULL && ptr[0]) { - Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); - } else { - /* Last resort */ - Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); - } + /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ + ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); + if (ptr != NULL && ptr[0]) { + Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); + } else { + /* Last resort */ + Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); + } } } /* * Initialize the user name from the environment first, since this is much @@ -568,11 +568,11 @@ Tcl_Size TclpFindVariable( const char *name, /* Name of desired environment variable * (UTF-8). */ - Tcl_Size *lengthPtr) /* Used to return length of name (for + Tcl_Size *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { Tcl_Size i, length, result = TCL_INDEX_NONE; Index: win/tclWinInt.h ================================================================== --- win/tclWinInt.h +++ win/tclWinInt.h @@ -73,14 +73,13 @@ HANDLE evControl; /* Auto-reset event used by the main thread to * signal when the pipe thread should attempt * to do read/write operation. Additionally * used as signal to stop (state set to -1) */ volatile LONG state; /* Indicates current state of the thread */ - void *clientData; /* Referenced data of the main thread */ + void *clientData; /* Referenced data of the main thread */ HANDLE evWakeUp; /* Optional wake-up event worker set by shutdown */ } TclPipeThreadInfo; - /* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without * more overhead for finalize thread (should be executed anyway) * * #define _PTI_USE_CKALLOC 1 @@ -90,17 +89,17 @@ * State of the pipe-worker. * * State PTI_STATE_STOP possible from idle state only, worker owns TI structure. * Otherwise PTI_STATE_END used (main thread hold ownership of the TI). */ - -#define PTI_STATE_IDLE 0 /* idle or not yet initialzed */ -#define PTI_STATE_WORK 1 /* in work */ -#define PTI_STATE_STOP 2 /* thread should stop work (owns TI structure) */ -#define PTI_STATE_END 4 /* thread should stop work (worker is busy) */ -#define PTI_STATE_DOWN 8 /* worker is down */ - +enum PipeThreadInfoStates { + PTI_STATE_IDLE = 0, /* idle or not yet initialzed */ + PTI_STATE_WORK = 1, /* in work */ + PTI_STATE_STOP = 2, /* thread should stop work (owns TI structure) */ + PTI_STATE_END = 4, /* thread should stop work (worker is busy) */ + PTI_STATE_DOWN = 8 /* worker is down */ +}; MODULE_SCOPE TclPipeThreadInfo * TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr, void *clientData, HANDLE wakeEvent); MODULE_SCOPE int TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr); Index: win/tclWinLoad.c ================================================================== --- win/tclWinLoad.c +++ win/tclWinLoad.c @@ -88,15 +88,15 @@ * binary path. */ Tcl_DString ds; - /* - * Remember the first error on load attempt to be used if the - * second load attempt below also fails. - */ - firstError = (nativeName == NULL) ? + /* + * Remember the first error on load attempt to be used if the + * second load attempt below also fails. + */ + firstError = (nativeName == NULL) ? ERROR_MOD_NOT_FOUND : GetLastError(); Tcl_DStringInit(&ds); nativeName = Tcl_UtfToWCharDString(TclGetString(pathPtr), TCL_INDEX_NONE, &ds); hInstance = LoadLibraryExW(nativeName, NULL, @@ -104,23 +104,23 @@ Tcl_DStringFree(&ds); } if (hInstance == NULL) { DWORD lastError; - Tcl_Obj *errMsg; - - /* - * We choose to only use the error from the second call if the first - * call failed due to the file not being found. Else stick to the - * first error for reporting purposes. - */ - if (firstError == ERROR_MOD_NOT_FOUND || + Tcl_Obj *errMsg; + + /* + * We choose to only use the error from the second call if the first + * call failed due to the file not being found. Else stick to the + * first error for reporting purposes. + */ + if (firstError == ERROR_MOD_NOT_FOUND || firstError == ERROR_DLL_NOT_FOUND) { - lastError = GetLastError(); - } else { - lastError = firstError; - } + lastError = GetLastError(); + } else { + lastError = firstError; + } errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", TclGetString(pathPtr)); /* @@ -155,15 +155,16 @@ case ERROR_DLL_INIT_FAILED: Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", (char *)NULL); Tcl_AppendToObj(errMsg, "the library initialization" " routine failed", TCL_INDEX_NONE); break; - case ERROR_BAD_EXE_FORMAT: + case ERROR_BAD_EXE_FORMAT: Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", (char *)NULL); - Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", TCL_INDEX_NONE); - break; - default: + Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", + TCL_INDEX_NONE); + break; + default: Tcl_WinConvertError(lastError); Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), TCL_INDEX_NONE); } Tcl_SetObjResult(interp, errMsg); } @@ -199,13 +200,13 @@ *---------------------------------------------------------------------- */ static void * FindSymbol( - Tcl_Interp *interp, - Tcl_LoadHandle loadHandle, - const char *symbol) + Tcl_Interp *interp, /* Where to report errors. */ + Tcl_LoadHandle loadHandle, /* Handle for the opened library. */ + const char *symbol) /* The symbol to look up. */ { HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; void *proc = NULL; /* Index: win/tclWinNotify.c ================================================================== --- win/tclWinNotify.c +++ win/tclWinNotify.c @@ -17,12 +17,14 @@ * The following static indicates whether this module has been initialized. */ #define INTERVAL_TIMER 1 /* Handle of interval timer. */ -#define WM_WAKEUP WM_USER /* Message that is send by - * Tcl_AlertNotifier. */ +enum NotifierMessageIds { + WM_WAKEUP = WM_USER /* Message that is send by Tcl_AlertNotifier. */ +}; + /* * The following static structure contains the state information for the * Windows implementation of the Tcl notifier. One of these structures is * created for each thread that is using the notifier. */ @@ -146,11 +148,11 @@ *---------------------------------------------------------------------- */ void TclpFinalizeNotifier( - void *clientData) /* Pointer to notifier data. */ + void *clientData) /* Pointer to notifier data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; /* * Only finalize the notifier if a notifier was installed in the current @@ -216,11 +218,11 @@ *---------------------------------------------------------------------- */ void TclpAlertNotifier( - void *clientData) /* Pointer to thread data. */ + void *clientData) /* Pointer to thread data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; /* * Note that we do not need to lock around access to the hwnd because the @@ -262,11 +264,11 @@ *---------------------------------------------------------------------- */ void TclpSetTimer( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); UINT timeout; /* @@ -368,13 +370,13 @@ int TclAsyncNotifier( TCL_UNUSED(int), /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(void *), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ TCL_UNUSED(int *), /* Flag to mark. */ - TCL_UNUSED(int)) /* Value of mark. */ + TCL_UNUSED(int)) /* Value of mark. */ { return 0; } /* @@ -462,11 +464,11 @@ *---------------------------------------------------------------------- */ int TclpWaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); MSG msg; DWORD timeout, result; int status; Index: win/tclWinPipe.c ================================================================== --- win/tclWinPipe.c +++ win/tclWinPipe.c @@ -29,23 +29,26 @@ /* * The following defines identify the various types of applications that run * under windows. There is special case code for the various types. */ - -#define APPL_NONE 0 -#define APPL_DOS 1 -#define APPL_WIN3X 2 -#define APPL_WIN32 3 +enum TclApplicationTypeIds { + APPL_NONE = 0, + APPL_DOS = 1, + APPL_WIN3X = 2, + APPL_WIN32 = 3 +}; /* * The following constants and structures are used to encapsulate the state of * various types of files used in a pipeline. This used to have a 1 && 2 that * supported Win32s. */ -#define WIN_FILE 3 /* Basic Win32 file. */ +enum WinFileTypes { + WIN_FILE = 3 /* Basic Win32 file. */ +}; /* * This structure encapsulates the common state associated with all file types * used in a pipeline. */ @@ -66,22 +69,19 @@ } ProcInfo; static ProcInfo *procList; /* - * Bit masks used in the flags field of the PipeInfo structure below. - */ - -#define PIPE_PENDING (1<<0) /* Message is pending in the queue. */ -#define PIPE_ASYNC (1<<1) /* Channel is non-blocking. */ - -/* - * Bit masks used in the sharedFlags field of the PipeInfo structure below. - */ - -#define PIPE_EOF (1<<2) /* Pipe has reached EOF. */ -#define PIPE_EXTRABYTE (1<<3) /* The reader thread has consumed one byte. */ + * Bit masks used in the flags and readFlags fields of the PipeInfo structure + * below. + */ +enum PipeInfoFlags { + PIPE_PENDING = (1<<0), /* Message is pending in the queue. */ + PIPE_ASYNC = (1<<1), /* Channel is non-blocking. */ + PIPE_EOF = (1<<2), /* Pipe has reached EOF. */ + PIPE_EXTRABYTE = (1<<3) /* The reader thread has consumed one byte. */ +}; /* * TODO: It appears the whole EXTRABYTE machinery is in place to support * outdated Win 95 systems. If this can be confirmed, much code can be * deleted. @@ -111,11 +111,10 @@ * threads. */ TclPipeThreadInfo *writeTI; /* Thread info of writer and reader, this */ TclPipeThreadInfo *readTI; /* structure owned by corresponding thread. */ HANDLE writeThread; /* Handle to writer thread. */ HANDLE readThread; /* Handle to reader thread. */ - HANDLE writable; /* Manual-reset event to signal when the * writer thread has finished waiting for the * current buffer to be written. */ HANDLE readable; /* Manual-reset event to signal when the * reader thread has finished waiting for @@ -201,19 +200,19 @@ */ static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ PipeWatchProc, /* Set up notifier to watch the channel. */ PipeGetHandleProc, /* Get an OS handle from channel. */ - PipeClose2Proc, /* close2proc */ + PipeClose2Proc, /* New close proc */ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ PipeThreadActionProc, /* thread action proc */ @@ -914,11 +913,11 @@ TclpCreateProcess( Tcl_Interp *interp, /* Interpreter in which to leave errors that * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - size_t argc, /* Number of arguments in following array. */ + size_t argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings. argv[0] contains * the name of the executable converted to * native format (using the * Tcl_TranslateFileName call). Additional * arguments have not been converted. */ @@ -1539,11 +1538,11 @@ static void BuildCommandLine( const char *executable, /* Full path of executable (including * extension). Replacement for argv[0]. */ - size_t argc, /* Number of arguments. */ + size_t argc, /* Number of arguments. */ const char **argv, /* Argument strings in UTF. */ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the * command line (WCHAR). */ { const char *arg, *start, *special, *bspos; @@ -1602,12 +1601,12 @@ start++) { if (*start & 0x80) { continue; } if (TclIsSpaceProc(*start)) { - quote |= CL_QUOTE; /* quote only */ - if (bspos) { /* if backslash found, escape & quote */ + quote |= CL_QUOTE; /* quote only */ + if (bspos) { /* if backslash found, escape & quote */ quote |= CL_ESCAPE; break; } continue; } @@ -1804,12 +1803,12 @@ * Start the background reader thread. */ infoPtr->readable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread, - TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable), - 0, NULL); + TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable), + 0, NULL); SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); infoPtr->validMask |= TCL_READABLE; } else { infoPtr->readTI = NULL; infoPtr->readThread = 0; @@ -1819,12 +1818,12 @@ * Start the background writer thread. */ infoPtr->writable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread, - TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable), - 0, NULL); + TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable), + 0, NULL); SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST); infoPtr->validMask |= TCL_WRITABLE; } else { infoPtr->writeTI = NULL; infoPtr->writeThread = 0; @@ -1956,11 +1955,11 @@ *---------------------------------------------------------------------- */ static int PipeBlockModeProc( - void *instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; @@ -1995,11 +1994,11 @@ *---------------------------------------------------------------------- */ static int PipeClose2Proc( - void *instanceData, /* Pointer to PipeInfo structure. */ + void *instanceData, /* Pointer to PipeInfo structure. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { PipeInfo *pipePtr = (PipeInfo *) instanceData; Tcl_Channel errChan; @@ -2017,11 +2016,10 @@ * done before we can close the file, since the thread may be blocking * trying to read from the pipe. */ if (pipePtr->readThread) { - TclPipeThreadStop(&pipePtr->readTI, pipePtr->readThread); CloseHandle(pipePtr->readThread); CloseHandle(pipePtr->readable); pipePtr->readThread = NULL; } @@ -2031,30 +2029,26 @@ pipePtr->validMask &= ~TCL_READABLE; pipePtr->readFile = NULL; } if ((!flags || flags & TCL_CLOSE_WRITE) && (pipePtr->writeFile != NULL)) { if (pipePtr->writeThread) { - /* * Wait for the writer thread to finish the current buffer, then * terminate the thread and close the handles. If the channel is * nonblocking or may block during exit, bail out since the worker * thread is not interruptible and we want TIP#398-fast-exit. */ + if ((pipePtr->flags & PIPE_ASYNC) && inExit) { - /* give it a chance to leave honorably */ TclPipeThreadStopSignal(&pipePtr->writeTI, pipePtr->writable); if (WaitForSingleObject(pipePtr->writable, 20) == WAIT_TIMEOUT) { return EWOULDBLOCK; } - } else { - WaitForSingleObject(pipePtr->writable, inExit ? 5000 : INFINITE); - } TclPipeThreadStop(&pipePtr->writeTI, pipePtr->writeThread); CloseHandle(pipePtr->writable); @@ -2166,11 +2160,11 @@ *---------------------------------------------------------------------- */ static int PipeInputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCode) /* Where to store error code. */ { @@ -2260,11 +2254,11 @@ *---------------------------------------------------------------------- */ static int PipeOutputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; @@ -2334,11 +2328,10 @@ return bytesWritten; error: *errorCode = errno; return -1; - } /* *---------------------------------------------------------------------- * @@ -2442,11 +2435,11 @@ *---------------------------------------------------------------------- */ static void PipeWatchProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { PipeInfo **nextPtrPtr, *ptr; @@ -2504,13 +2497,13 @@ *---------------------------------------------------------------------- */ static int PipeGetHandleProc( - void *instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr; if (direction == TCL_READABLE && infoPtr->readFile) { @@ -3234,12 +3227,12 @@ memcpy(namePtr, baseStr, length); namePtr += length; } counter = TclpGetClicks() % 65533; - counter2 = 1024; /* Only try this many times! Prevents - * an infinite loop. */ + counter2 = 1024; /* Only try this many times! Prevents + * an infinite loop. */ do { char number[TCL_INTEGER_SPACE + 4]; snprintf(number, sizeof(number), "%d.TMP", counter); Index: win/tclWinPort.h ================================================================== --- win/tclWinPort.h +++ win/tclWinPort.h @@ -202,11 +202,11 @@ #endif #ifndef ENOTCONN # define ENOTCONN 126 /* Socket is not connected */ #endif #ifndef ENOTRECOVERABLE -# define ENOTRECOVERABLE 127 /* Not recoverable */ +# define ENOTRECOVERABLE 127 /* Not recoverable */ #endif #ifndef ENOTSOCK # define ENOTSOCK 128 /* Socket operation on non-socket */ #endif #ifndef ENOTSUP @@ -243,11 +243,10 @@ # define ETXTBSY 139 /* Text file or pseudo-device busy */ #endif #ifndef EWOULDBLOCK # define EWOULDBLOCK 140 /* Operation would block */ #endif - /* Visual Studio doesn't have these, so just choose some high numbers */ #ifndef ESOCKTNOSUPPORT # define ESOCKTNOSUPPORT 240 /* Socket type not supported */ #endif @@ -413,11 +412,10 @@ # else # define S_ISLNK(m) 0 # endif #endif /* !S_ISLNK */ - /* * Define MAXPATHLEN in terms of MAXPATH if available */ #ifndef MAXPATH @@ -521,11 +519,10 @@ #define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \ 0, (LPVOID)ptr, size)) /* This type is not defined in the Windows headers */ #define socklen_t int - /* * The following macros have trivial definitions, allowing generic code to * address platform-specific issues. */ Index: win/tclWinReg.c ================================================================== --- win/tclWinReg.c +++ win/tclWinReg.c @@ -51,11 +51,13 @@ /* * The following flag is used in OpenKeys to indicate that the specified key * should be created if it doesn't currently exist. */ -#define REG_CREATE 1 +enum TclRegFlags { + REG_CREATE = 1 +}; /* * The following tables contain the mapping from registry root names to the * system predefined keys. */ @@ -291,13 +293,13 @@ *---------------------------------------------------------------------- */ static int RegistryObjCmd( - void *dummy, /* Not used. */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Size n = 1, argc; int index; REGSAM mode = 0; @@ -384,11 +386,11 @@ /* * Create the key and then close it immediately. */ mode |= KEY_ALL_ACCESS; - if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) { + if (OpenKey(interp, objv[n], mode, REG_CREATE, &key) != TCL_OK) { return TCL_ERROR; } RegCloseKey(key); return TCL_OK; } else if (argc == 3) { @@ -1205,11 +1207,12 @@ DWORD result, size; Tcl_DString subkey; HKEY hKey; REGSAM saveMode = mode; static int checkExProc = 0; - static LONG (* regDeleteKeyExProc) (HKEY, LPCWSTR, REGSAM, DWORD) = (LONG (*) (HKEY, LPCWSTR, REGSAM, DWORD)) NULL; + static LONG (* regDeleteKeyExProc) (HKEY, LPCWSTR, REGSAM, DWORD) = + (LONG (*) (HKEY, LPCWSTR, REGSAM, DWORD)) NULL; /* * Do not allow NULL or empty key name. */ @@ -1427,11 +1430,11 @@ */ static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { LRESULT result; DWORD_PTR sendResult; int timeout = 3000; Index: win/tclWinSerial.c ================================================================== --- win/tclWinSerial.c +++ win/tclWinSerial.c @@ -31,28 +31,26 @@ /* * Bit masks used in the flags field of the SerialInfo structure below. */ -#define SERIAL_PENDING (1<<0) /* Message is pending in the queue. */ -#define SERIAL_ASYNC (1<<1) /* Channel is non-blocking. */ - -/* - * Bit masks used in the sharedFlags field of the SerialInfo structure below. - */ - -#define SERIAL_EOF (1<<2) /* Serial has reached EOF. */ -#define SERIAL_ERROR (1<<4) - -/* - * Bit masks used for noting whether to drain or discard output on close. They - * are disjoint from each other; at most one may be set at a time. - */ - -#define SERIAL_CLOSE_DRAIN (1<<6) /* Drain all output on close. */ -#define SERIAL_CLOSE_DISCARD (1<<7) /* Discard all output on close. */ -#define SERIAL_CLOSE_MASK (3<<6) /* Both two bits above. */ +enum SerialInfoFlags { + SERIAL_PENDING = (1<<0), /* Message is pending in the queue. */ + SERIAL_ASYNC = (1<<1), /* Channel is non-blocking. */ + SERIAL_EOF = (1<<2), /* Serial has reached EOF. */ + SERIAL_ERROR = (1<<4), + + /* + * Bit masks used for noting whether to drain or discard output on close. + * They are disjoint from each other; at most one may be set at a time. + */ + + SERIAL_CLOSE_DRAIN = (1<<6),/* Drain all output on close. */ + SERIAL_CLOSE_DISCARD = (1<<7), /* Discard all output on close. */ + SERIAL_CLOSE_MASK = (SERIAL_CLOSE_DRAIN | SERIAL_CLOSE_DISCARD) + /* Both two bits above. */ +}; /* * Default time to block between checking status on the serial port. */ @@ -83,11 +81,12 @@ * which events should be reported. */ int flags; /* State flags, see above for a list. */ int readable; /* Flag that the channel is readable. */ int writable; /* Flag that the channel is writable. */ int blockTime; /* Maximum blocktime in msec. */ - unsigned long long lastEventTime; /* Time in milliseconds since last readable + unsigned long long lastEventTime; + /* Time in milliseconds since last readable * event. */ /* Next readable event only after blockTime */ DWORD error; /* pending error code returned by * ClearCommError() */ DWORD lastError; /* last error code, can be fetched with @@ -202,25 +201,25 @@ */ static const Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. */ SerialInputProc, /* Input proc. */ SerialOutputProc, /* Output proc. */ NULL, /* Seek proc. */ SerialSetOptionProc, /* Set option proc. */ SerialGetOptionProc, /* Get option proc. */ SerialWatchProc, /* Set up notifier to watch the channel. */ SerialGetHandleProc, /* Get an OS handle from channel. */ - SerialCloseProc, /* close2proc. */ + SerialCloseProc, /* New close proc. */ SerialBlockProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ SerialThreadActionProc, /* thread action proc */ - NULL /* truncate */ + NULL /* truncate */ }; /* *---------------------------------------------------------------------- * @@ -559,11 +558,11 @@ *---------------------------------------------------------------------- */ static int SerialBlockProc( - void *instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { int errorCode = 0; SerialInfo *infoPtr = (SerialInfo *) instanceData; @@ -598,11 +597,11 @@ *---------------------------------------------------------------------- */ static int SerialCloseProc( - void *instanceData, /* Pointer to SerialInfo structure. */ + void *instanceData, /* Pointer to SerialInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { SerialInfo *serialPtr = (SerialInfo *) instanceData; int errorCode = 0, result = 0; @@ -610,11 +609,10 @@ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { return EINVAL; } - if (serialPtr->validMask & TCL_READABLE) { PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR); CloseHandle(serialPtr->osRead.hEvent); } @@ -853,11 +851,11 @@ *---------------------------------------------------------------------- */ static int SerialInputProc( - void *instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCode) /* Where to store error code. */ { @@ -960,11 +958,11 @@ *---------------------------------------------------------------------- */ static int SerialOutputProc( - void *instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; @@ -1043,11 +1041,10 @@ memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; ResetEvent(infoPtr->evWritable); TclPipeThreadSignal(&infoPtr->writeTI); bytesWritten = (DWORD) toWrite; - } else { /* * In the blocking case, just try to write the buffer directly. This * avoids an unnecessary copy. */ @@ -1190,11 +1187,11 @@ *---------------------------------------------------------------------- */ static void SerialWatchProc( - void *instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { SerialInfo **nextPtrPtr, *ptr; @@ -1247,13 +1244,13 @@ *---------------------------------------------------------------------- */ static int SerialGetHandleProc( - void *instanceData, /* The serial state. */ + void *instanceData, /* The serial state. */ TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; *handlePtr = (void *)infoPtr->handle; return TCL_OK; @@ -1478,11 +1475,10 @@ TclWinGenerateChannelName(channelName, "file", infoPtr); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, infoPtr, permissions); - SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR); /* @@ -1610,11 +1606,11 @@ *---------------------------------------------------------------------- */ static int SerialSetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ { SerialInfo *infoPtr; @@ -2034,11 +2030,11 @@ *---------------------------------------------------------------------- */ static int SerialGetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { SerialInfo *infoPtr; Index: win/tclWinSock.c ================================================================== --- win/tclWinSock.c +++ win/tclWinSock.c @@ -60,14 +60,14 @@ * once, and so can be used without regard to side effects. */ #define SET_BITS(var, bits) ((var) |= (bits)) #define CLEAR_BITS(var, bits) ((var) &= ~(bits)) -#define GOT_BITS(var, bits) (((var) & (bits)) != 0) +#define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ -#define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) +#define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) /* * The following variable is used to tell whether this module has been * initialized. If 1, initialization of sockets was successful, if -1 then * socket initialization failed (WSAStartup failed). @@ -79,15 +79,20 @@ /* * The following defines declare the messages used on socket windows. */ -#define SOCKET_MESSAGE WM_USER+1 -#define SOCKET_SELECT WM_USER+2 -#define SOCKET_TERMINATE WM_USER+3 -#define SELECT TRUE -#define UNSELECT FALSE +enum TclSocketMessageID { + SOCKET_MESSAGE = WM_USER+1, /* There is something waiting. */ + SOCKET_SELECT = WM_USER+2, /* Change what we are waiting for. */ + SOCKET_TERMINATE = WM_USER+3/* Terminate the worker thread. */ +}; + +enum SocketSelectOp { + SELECT = TRUE, + UNSELECT = FALSE, +}; /* * This is needed to comply with the strict aliasing rules of GCC, but it also * simplifies casting between the different sockaddr types. */ @@ -148,11 +153,11 @@ struct addrinfo *addrlist; /* Addresses to connect to. */ struct addrinfo *addr; /* Iterator over addrlist. */ struct addrinfo *myaddrlist;/* Local address. */ struct addrinfo *myaddr; /* Iterator over myaddrlist. */ int connectError; /* Cache status of async socket. */ - int cachedBlocking; /* Cache blocking mode of async socket. */ + int cachedBlocking; /* Cache blocking mode of async socket. */ volatile int notifierConnectError; /* Async connect error set by notifier thread. * This error is still a windows error code. * Access must be protected by semaphore */ struct TcpState *nextPtr; /* The next socket on the per-thread socket @@ -162,25 +167,23 @@ /* * These bits may be OR'ed together into the "flags" field of a TcpState * structure. */ -#define TCP_NONBLOCKING (1<<0) /* Socket with non-blocking I/O */ -#define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */ -#define SOCKET_EOF (1<<2) /* A zero read happened on the - * socket. */ -#define SOCKET_PENDING (1<<3) /* A message has been sent for this - * socket */ -#define TCP_ASYNC_PENDING (1<<4) /* TcpConnect was called to - * process an async connect. This - * flag indicates that reentry is - * still pending */ -#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */ - -#define TCP_ASYNC_TEST_MODE (1<<8) /* Async testing activated. Do not - * automatically continue connection - * process */ +enum TcpStateFlags { + TCP_NONBLOCKING = (1<<0), /* Socket with non-blocking I/O. */ + TCP_ASYNC_CONNECT = (1<<1), /* Async connect in progress. */ + SOCKET_EOF = (1<<2), /* A zero read happened on the socket. */ + SOCKET_PENDING = (1<<3), /* A message has been sent for this socket */ + TCP_ASYNC_PENDING = (1<<4), /* TcpConnect was called to process an async + * connect. This flag indicates that reentry + * is still pending. */ + TCP_ASYNC_FAILED = (1<<5), /* An async connect finally failed. */ + TCP_ASYNC_TEST_MODE = (1<<8)/* Async testing activated. Do not + * automatically continue connection + * process */ +}; /* * The following structure is what is added to the Tcl event queue when a * socket event occurs. */ @@ -199,22 +202,20 @@ * This defines the minimum buffersize maintained by the kernel. */ #define TCP_BUFFER_SIZE 4096 - typedef struct { HWND hwnd; /* Handle to window for socket messages. */ HANDLE socketThread; /* Thread handling the window */ Tcl_ThreadId threadId; /* Parent thread. */ HANDLE readyEvent; /* Event indicating that a socket event is * ready. Also used to indicate that the * socketThread has been initialized and has * started. */ HANDLE socketListLock; /* Win32 Event to lock the socketList */ - TcpState *pendingTcpState; - /* This socket is opened but not jet in the + TcpState *pendingTcpState; /* This socket is opened but not jet in the * list. This value is also checked by * the event structure. */ TcpState *socketList; /* Every open socket in this thread has an * entry on this list. */ } ThreadSpecificData; @@ -262,19 +263,19 @@ */ static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ TcpSetOptionProc, /* Set option proc. */ TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Initialize notifier. */ TcpGetHandleProc, /* Get OS handles out of channel. */ - TcpClose2Proc, /* Close2 proc. */ + TcpClose2Proc, /* New close2 proc. */ TcpBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ TcpThreadActionProc, /* thread action proc. */ @@ -291,14 +292,19 @@ /* * Simple wrapper round the SendMessage syscall. */ -#define SendSelectMessage(tsdPtr, message, payload) \ - SendMessageW((tsdPtr)->hwnd, SOCKET_SELECT, \ - (WPARAM) (message), (LPARAM) (payload)) - +static inline void +SendSelectMessage( + ThreadSpecificData *tsdPtr, + enum SocketSelectOp message, + TcpState *payload) +{ + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) message, (LPARAM) payload); +} /* * Address print debug functions */ #if 0 @@ -356,11 +362,10 @@ /* * Convert string from native to UTF then change to lowercase. */ Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, TCL_INDEX_NONE, &ds)); - } else { TclInitSockets(); /* * The buffer size of 256 is recommended by the MSDN page that * documents gethostname() as being always adequate. @@ -447,14 +452,14 @@ * assigned to _this_ thread. */ tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->pendingTcpState = NULL; - tsdPtr->socketList = NULL; - tsdPtr->hwnd = NULL; - tsdPtr->threadId = Tcl_GetCurrentThread(); - tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); + tsdPtr->socketList = NULL; + tsdPtr->hwnd = NULL; + tsdPtr->threadId = Tcl_GetCurrentThread(); + tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); if (tsdPtr->readyEvent == NULL) { goto initFailure; } tsdPtr->socketListLock = CreateEventW(NULL, FALSE, TRUE, NULL); if (tsdPtr->socketListLock == NULL) { @@ -505,11 +510,12 @@ */ void TclpFinalizeSockets(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Careful! This is a finalizer! */ @@ -560,11 +566,11 @@ *---------------------------------------------------------------------- */ static int TcpBlockModeProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { TcpState *statePtr = (TcpState *)instanceData; @@ -644,11 +650,11 @@ * - Call by the event queue (errorCodePtr == NULL) */ if (GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE) && errorCodePtr != NULL - && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { + && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { *errorCodePtr = EWOULDBLOCK; return -1; } /* @@ -737,13 +743,13 @@ *errorCodePtr = ENOTCONN; } return -1; } - /* - * Free list lock. - */ + /* + * Free list lock. + */ SetEvent(tsdPtr->socketListLock); /* * Background operation returns with no action as there was no connect @@ -791,11 +797,11 @@ *---------------------------------------------------------------------- */ static int TcpInputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { @@ -882,11 +888,11 @@ /* * Check for error condition or underflow in non-blocking case. */ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING) - || (error != WSAEWOULDBLOCK)) { + || (error != WSAEWOULDBLOCK)) { Tcl_WinConvertError(error); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; break; } @@ -924,11 +930,11 @@ *---------------------------------------------------------------------- */ static int TcpOutputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { TcpState *statePtr = (TcpState *)instanceData; @@ -1028,11 +1034,11 @@ *---------------------------------------------------------------------- */ static int TcpCloseProc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ TCL_UNUSED(Tcl_Interp *)) { TcpState *statePtr = (TcpState *)instanceData; /* TIP #218 */ int errorCode = 0; @@ -1114,11 +1120,11 @@ *---------------------------------------------------------------------- */ static int TcpClose2Proc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { TcpState *statePtr = (TcpState *)instanceData; int readError = 0; @@ -1164,11 +1170,11 @@ *---------------------------------------------------------------------- */ static int TcpSetOptionProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to set. */ const char *value) /* New value for option. */ { TcpState *statePtr = (TcpState *)instanceData; @@ -1247,11 +1253,11 @@ *---------------------------------------------------------------------- */ static int TcpGetOptionProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to retrieve the value * for, or NULL to get all options and their * values. */ Tcl_DString *dsPtr) /* Where to store the computed value; @@ -1543,11 +1549,11 @@ *---------------------------------------------------------------------- */ static void TcpWatchProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { TcpState *statePtr = (TcpState *)instanceData; @@ -1597,13 +1603,13 @@ *---------------------------------------------------------------------- */ static int TcpGetHandleProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { TcpState *statePtr = (TcpState *)instanceData; *handlePtr = INT2PTR(statePtr->sockets->fd); return TCL_OK; @@ -1650,16 +1656,16 @@ Tcl_Interp *interp, /* For error reporting; can be NULL. */ TcpState *statePtr) { DWORD error; int async_connect = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT); - /* We are started with async connect and the - * connect notification was not yet - * received. */ + /* We are started with async connect and the + * connect notification was not yet + * received. */ int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING); - /* We were called by the event procedure and - * continue our loop. */ + /* We were called by the event procedure and + * continue our loop. */ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (async_callback) { goto reenter; } @@ -1676,14 +1682,14 @@ if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) { continue; } - /* - * Close the socket if it is still open from the last unsuccessful - * iteration. - */ + /* + * Close the socket if it is still open from the last unsuccessful + * iteration. + */ if (statePtr->sockets->fd != INVALID_SOCKET) { closesocket(statePtr->sockets->fd); } @@ -1992,20 +1998,20 @@ /* * Do the name lookups for the local and remote addresses. */ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg) - || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, - &errorMsg)) { - if (addrlist != NULL) { - freeaddrinfo(addrlist); - } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", errorMsg)); - } - return NULL; + || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, + &errorMsg)) { + if (addrlist != NULL) { + freeaddrinfo(addrlist); + } + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", errorMsg)); + } + return NULL; } statePtr = NewSocketInfo(INVALID_SOCKET); statePtr->addrlist = addrlist; statePtr->myaddrlist = myaddrlist; @@ -2107,12 +2113,12 @@ Tcl_OpenTcpServerEx( Tcl_Interp *interp, /* For error reporting - may be NULL. */ const char *service, /* Port number to open. */ const char *myHost, /* Name of local host. */ unsigned int flags, /* Flags. */ - int backlog, /* Length of OS listen backlog queue, or -1 - * for default. */ + int backlog, /* Length of OS listen backlog queue, or -1 + * for default. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ void *acceptProcData) /* Data for the callback. */ { @@ -2221,11 +2227,11 @@ * different, and there may be differences between TCP/IP stacks). */ if (backlog < 0) { backlog = SOMAXCONN; - } + } if (listen(sock, backlog) == SOCKET_ERROR) { Tcl_WinConvertError((DWORD) WSAGetLastError()); closesocket(sock); continue; } @@ -2539,11 +2545,11 @@ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (statePtr = tsdPtr->socketList; statePtr != NULL; statePtr = statePtr->nextPtr) { if (GOT_BITS(statePtr->readyEvents, statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) - && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { + && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { SET_BITS(statePtr->flags, SOCKET_PENDING); evPtr = (SocketEvent *)Tcl_Alloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; evPtr->socket = statePtr->sockets->fd; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -2839,12 +2845,11 @@ fds->fd = socket; fds->statePtr = statePtr; fds->next = NULL; } - - + /* *---------------------------------------------------------------------- * * NewSocketInfo -- * @@ -2895,14 +2900,13 @@ *---------------------------------------------------------------------- */ static int WaitForSocketEvent( - TcpState *statePtr, /* Information about this socket. */ + TcpState *statePtr, /* Information about this socket. */ int events, /* Events to look for. May be one of - * FD_READ or FD_WRITE. - */ + * FD_READ or FD_WRITE. */ int *errorCodePtr) /* Where to store errors? */ { int result = 1; int oldMode; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); @@ -3243,11 +3247,11 @@ void *instanceData, int action) { ThreadSpecificData *tsdPtr; TcpState *statePtr = (TcpState *)instanceData; - int notifyCmd; + enum SocketSelectOp notifyCmd; if (action == TCL_CHANNEL_THREAD_INSERT) { /* * Ensure that socket subsystem is initialized in this thread, or else * sockets will not work. Index: win/tclWinTest.c ================================================================== --- win/tclWinTest.c +++ win/tclWinTest.c @@ -334,13 +334,13 @@ */ static int TestExceptionCmd( TCL_UNUSED(void *), - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Argument count */ - Tcl_Obj *const objv[]) /* Argument vector */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Argument count */ + Tcl_Obj *const objv[]) /* Argument vector */ { static const char *const cmds[] = { "access_violation", "datatype_misalignment", "array_bounds", "float_denormal", "float_divbyzero", "float_inexact", "float_invalidop", "float_overflow", "float_stack", "float_underflow", Index: win/tclWinThrd.c ================================================================== --- win/tclWinThrd.c +++ win/tclWinThrd.c @@ -76,42 +76,41 @@ * The per-thread event and queue pointers. */ #if TCL_THREADS -typedef struct ThreadSpecificData { - HANDLE condEvent; /* Per-thread condition event */ - struct ThreadSpecificData *nextPtr; /* Queue pointers */ - struct ThreadSpecificData *prevPtr; - int flags; /* See flags below */ -} ThreadSpecificData; +typedef struct ThreadSpecificData ThreadSpecificData; +struct ThreadSpecificData { + HANDLE condEvent; /* Per-thread condition event */ + ThreadSpecificData *nextPtr;/* Queue pointers */ + ThreadSpecificData *prevPtr; + int flags; /* See flags below */ +}; static Tcl_ThreadDataKey dataKey; #endif /* TCL_THREADS */ /* * State bits for the thread. - * WIN_THREAD_UNINIT Uninitialized. Must be zero because of the way - * ThreadSpecificData is created. - * WIN_THREAD_RUNNING Running, not waiting. - * WIN_THREAD_BLOCKED Waiting, or trying to wait. */ - -#define WIN_THREAD_UNINIT 0x0 -#define WIN_THREAD_RUNNING 0x1 -#define WIN_THREAD_BLOCKED 0x2 +enum ThreadStateFlags { + WIN_THREAD_UNINIT = 0x0, /* Uninitialized. Must be zero because of the + * way ThreadSpecificData is created. */ + WIN_THREAD_RUNNING = 0x1, /* Running, not waiting. */ + WIN_THREAD_BLOCKED = 0x2 /* Waiting, or trying to wait. */ +}; /* * The per condition queue pointers and the Mutex used to serialize access to * the queue. */ typedef struct { CRITICAL_SECTION condLock; /* Lock to serialize queuing on the * condition. */ - struct ThreadSpecificData *firstPtr; /* Queue pointers */ - struct ThreadSpecificData *lastPtr; + ThreadSpecificData *firstPtr; /* Queue pointers */ + ThreadSpecificData *lastPtr; } WinCondition; /* * Additions by AOL for specialized thread memory allocator. */ @@ -118,11 +117,11 @@ #ifdef USE_THREAD_ALLOC static DWORD tlsKey; typedef struct { - Tcl_Mutex tlock; + Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; #endif /* USE_THREAD_ALLOC */ /* @@ -129,13 +128,14 @@ * The per thread data passed from TclpThreadCreate * to TclWinThreadStart. */ typedef struct { - LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */ - LPVOID lpParameter; /* Original startup data */ - unsigned int fpControl; /* Floating point control word from the + LPTHREAD_START_ROUTINE lpStartAddress; + /* Original startup routine */ + LPVOID lpParameter; /* Original startup data */ + unsigned int fpControl; /* Floating point control word from the * main thread */ } WinThread; /* @@ -216,12 +216,12 @@ winThreadPtr->lpParameter = clientData; winThreadPtr->fpControl = _controlfp(0, 0); EnterCriticalSection(&joinLock); - *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and - * on WIN64 sizeof void* != sizeof unsigned */ + *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and + * on WIN64 sizeof void* != sizeof unsigned */ #if defined(_MSC_VER) || defined(__MSVCRT__) tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize, (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr, 0, (unsigned *)idPtr); @@ -657,11 +657,11 @@ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (WinCondition **) */ Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */ - const Tcl_Time *timePtr) /* Timeout on waiting period */ + const Tcl_Time *timePtr) /* Timeout on waiting period */ { WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ DWORD wtime; /* Windows time value */ int timeout; /* True if we got a timeout */ @@ -924,13 +924,10 @@ Tcl_Free(winCondPtr); *condPtr = NULL; } } - - - /* * Additions by AOL for specialized thread memory allocator. */ #ifdef USE_THREAD_ALLOC @@ -1027,11 +1024,10 @@ Tcl_Panic("TlsFree failed from TclpFreeAllocCache"); } } } #endif /* USE_THREAD_ALLOC */ - void * TclpThreadCreateKey(void) { DWORD *key; Index: win/tclWinTime.c ================================================================== --- win/tclWinTime.c +++ win/tclWinTime.c @@ -101,11 +101,10 @@ int perfCounter; /* 1 if performance counter usable for wide * clicks */ double microsecsScale; /* Denominator scale between clock / microsecs */ } wideClick = {0, 0, 0.0}; - /* * Declarations for functions defined later in this file. */ static void StopCalibration(void *clientData); @@ -212,13 +211,13 @@ if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { return (Tcl_WideUInt) usecSincePosixEpoch; } else { /* - * Use the Tcl_GetTime abstraction to get the time in microseconds, as - * nearly as we can, and return it. - */ + * Use the Tcl_GetTime abstraction to get the time in microseconds, as + * nearly as we can, and return it. + */ Tcl_Time now; /* Current Tcl time */ GetTime(&now); return ((unsigned long long)(now.sec)*1000000ULL) +