Tcl Source Code

Check-in [c5ff3f41bd]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Merge 8.7
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: c5ff3f41bd31abb07ee62157f9670c64bd0bdf46418319092185277ce7149f1b
User & Date: jan.nijtmans 2019-06-12 15:42:54
Context
2019-06-15
21:29
Merge 8.7 check-in: af0bfa72a8 user: jan.nijtmans tags: trunk
2019-06-13
12:13
merge trunk check-in: 08d36921f0 user: dgp tags: dgp-refactor
2019-06-12
19:04
merge trunk check-in: d03f410e2a user: dgp tags: dgp-properbytearray
18:41
merge trunk check-in: 9b0d0c83a1 user: dgp tags: novem
15:42
Merge 8.7 check-in: c5ff3f41bd user: jan.nijtmans tags: trunk
15:26
Eliminate (internal) TclOffset() usage, just use offsetof() in stead. check-in: f0c76dd6a8 user: jan.nijtmans tags: core-8-branch
2019-06-11
15:32
Merge 8.7 check-in: 699e9fd1dd user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclBasic.c.

577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
    }

#if defined(_WIN32) && !defined(_WIN64)
    if (sizeof(time_t) != 4) {
	/*NOTREACHED*/
	Tcl_Panic("<time.h> is not compatible with MSVC");
    }
    if ((TclOffset(Tcl_StatBuf,st_atime) != 32)
	    || (TclOffset(Tcl_StatBuf,st_ctime) != 40)) {
	/*NOTREACHED*/
	Tcl_Panic("<sys/stat.h> is not compatible with MSVC");
    }
#endif

    if (cancelTableInitialized == 0) {
	Tcl_MutexLock(&cancelLock);






|
|







577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
    }

#if defined(_WIN32) && !defined(_WIN64)
    if (sizeof(time_t) != 4) {
	/*NOTREACHED*/
	Tcl_Panic("<time.h> is not compatible with MSVC");
    }
    if ((offsetof(Tcl_StatBuf,st_atime) != 32)
	    || (offsetof(Tcl_StatBuf,st_ctime) != 40)) {
	/*NOTREACHED*/
	Tcl_Panic("<sys/stat.h> is not compatible with MSVC");
    }
#endif

    if (cancelTableInitialized == 0) {
	Tcl_MutexLock(&cancelLock);

Changes to generic/tclBinary.c.

273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
				 * minus 1 byte. */
    unsigned char bytes[1];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_SIZE(len) \
		((TclOffset(ByteArray, bytes) + (len)))
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (baPtr)
 
int
TclIsPureByteArray(
    Tcl_Obj * objPtr)






|







273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
				 * minus 1 byte. */
    unsigned char bytes[1];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_SIZE(len) \
		(offsetof(ByteArray, bytes) + (len))
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (baPtr)
 
int
TclIsPureByteArray(
    Tcl_Obj * objPtr)

Changes to generic/tclCkalloc.c.

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
    size_t refCount;		/* Number of mem_headers referencing this
				 * tag. */
    char string[1];		/* Actual size of string will be as large as
				 * needed for actual tag. This must be the
				 * last field in the structure. */
} MemTag;

#define TAG_SIZE(bytesInString) ((TclOffset(MemTag, string) + 1) + bytesInString)

static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
				 * by "memory tag" command). */

/*
 * One of the following structures is allocated just before each dynamically
 * allocated chunk of memory, both to record information about the chunk and






|







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
    size_t refCount;		/* Number of mem_headers referencing this
				 * tag. */
    char string[1];		/* Actual size of string will be as large as
				 * needed for actual tag. This must be the
				 * last field in the structure. */
} MemTag;

#define TAG_SIZE(bytesInString) ((offsetof(MemTag, string) + 1) + bytesInString)

static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
				 * by "memory tag" command). */

/*
 * One of the following structures is allocated just before each dynamically
 * allocated chunk of memory, both to record information about the chunk and

Changes to generic/tclCompile.c.

3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
    /*
     * Create a new variable if appropriate.
     */

    if (create || (name == NULL)) {
	localVar = procPtr->numCompiledLocals;
	localPtr = Tcl_Alloc(TclOffset(CompiledLocal, name) + nameBytes + 1);
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;






|







3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
    /*
     * Create a new variable if appropriate.
     */

    if (create || (name == NULL)) {
	localVar = procPtr->numCompiledLocals;
	localPtr = Tcl_Alloc(offsetof(CompiledLocal, name) + nameBytes + 1);
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;

Changes to generic/tclExecute.c.

149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
    } while (0)
 
/*
 * These variable-access macros have to coincide with those in tclVar.c
 */

#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))

static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,
    int *newPtr)
{






|







149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
    } while (0)
 
/*
 * These variable-access macros have to coincide with those in tclVar.c
 */

#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))

static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,
    int *newPtr)
{

Changes to generic/tclHash.c.

778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
    Tcl_HashEntry *hPtr;
    size_t size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = Tcl_Alloc(TclOffset(Tcl_HashEntry, key) + allocsize);
    memcpy(hPtr->key.string, string, size);
    Tcl_SetHashValue(hPtr, NULL);
    return hPtr;
}
 
/*
 *----------------------------------------------------------------------






|







778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
    Tcl_HashEntry *hPtr;
    size_t size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = Tcl_Alloc(offsetof(Tcl_HashEntry, key) + allocsize);
    memcpy(hPtr->key.string, string, size);
    Tcl_SetHashValue(hPtr, NULL);
    return hPtr;
}
 
/*
 *----------------------------------------------------------------------

Changes to generic/tclIO.h.

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
    				/* Next buffer in chain. */
    char buf[1];		/* Placeholder for real buffer. The real
				 * buffer occuppies this space + bufSize-1
				 * bytes. This must be the last field in the
				 * structure. */
} ChannelBuffer;

#define CHANNELBUFFER_HEADER_SIZE	TclOffset(ChannelBuffer, buf)

/*
 * How much extra space to allocate in buffer to hold bytes from previous
 * buffer (when converting to UTF-8) or to hold bytes that will go to next
 * buffer (when converting from UTF-8).
 */







|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
    				/* Next buffer in chain. */
    char buf[1];		/* Placeholder for real buffer. The real
				 * buffer occuppies this space + bufSize-1
				 * bytes. This must be the last field in the
				 * structure. */
} ChannelBuffer;

#define CHANNELBUFFER_HEADER_SIZE	offsetof(ChannelBuffer, buf)

/*
 * How much extra space to allocate in buffer to hold bytes from previous
 * buffer (when converting to UTF-8) or to hold bytes that will go to next
 * buffer (when converting from UTF-8).
 */

Changes to generic/tclInt.h.

4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
#    ifdef NO_ISNAN
#	 define TclIsNaN(d)	((d) != (d))
#    else
#	 define TclIsNaN(d)	(isnan(d))
#    endif
#endif

/*
 * ----------------------------------------------------------------------
 * Macro to use to find the offset of a field in a structure. Computes number
 * of bytes from beginning of structure to a given field.
 */

#ifdef offsetof
#define TclOffset(type, field) (offsetof(type, field))
#else
#define TclOffset(type, field) (((char *) &((type *) 0)->field))
#endif

/*
 *----------------------------------------------------------------
 * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
 */







|
<
<
<
<
<
|
<
<
|







4815
4816
4817
4818
4819
4820
4821
4822





4823


4824
4825
4826
4827
4828
4829
4830
4831
#    ifdef NO_ISNAN
#	 define TclIsNaN(d)	((d) != (d))
#    else
#	 define TclIsNaN(d)	(isnan(d))
#    endif
#endif

/* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */





#ifndef offsetof


#   define offsetof(type, field) ((size_t) ((char *) &((type *) 0)->field))
#endif

/*
 *----------------------------------------------------------------
 * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
 */

Changes to generic/tclOOMethod.c.

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
/*
 * Helper macros (derived from things private to tclVar.c)
 */

#define TclVarTable(contextNs) \
    ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable))
#define TclVarHashGetValue(hPtr) \
    ((Tcl_Var) ((char *)hPtr - TclOffset(VarInHash, entry)))
 
/*
 * ----------------------------------------------------------------------
 *
 * Tcl_NewInstanceMethod --
 *
 *	Attach a method to an object instance.






|







117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
/*
 * Helper macros (derived from things private to tclVar.c)
 */

#define TclVarTable(contextNs) \
    ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable))
#define TclVarHashGetValue(hPtr) \
    ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry)))
 
/*
 * ----------------------------------------------------------------------
 *
 * Tcl_NewInstanceMethod --
 *
 *	Attach a method to an object instance.

Changes to generic/tclProc.c.

630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
	    localPtr = localPtr->nextPtr;
	} else {
	    /*
	     * Allocate an entry in the runtime procedure frame's array of
	     * local variables for the argument.
	     */

	    localPtr = Tcl_Alloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1);
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
	    localPtr->nextPtr = NULL;






|







630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
	    localPtr = localPtr->nextPtr;
	} else {
	    /*
	     * Allocate an entry in the runtime procedure frame's array of
	     * local variables for the argument.
	     */

	    localPtr = Tcl_Alloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1);
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
	    localPtr->nextPtr = NULL;

Changes to generic/tclTest.c.

7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
7715
7716
7717
7718
7719
    if (resVarInfo->var) {
        HashVarFree(resVarInfo->var);
    }
    Tcl_Free(vInfoPtr);
}

#define TclVarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))

static Tcl_Var
MyCompiledVarFetch(
    Tcl_Interp *interp,
    Tcl_ResolvedVarInfo *vinfoPtr)
{
    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr;






|







7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
7715
7716
7717
7718
7719
    if (resVarInfo->var) {
        HashVarFree(resVarInfo->var);
    }
    Tcl_Free(vInfoPtr);
}

#define TclVarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))

static Tcl_Var
MyCompiledVarFetch(
    Tcl_Interp *interp,
    Tcl_ResolvedVarInfo *vinfoPtr)
{
    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr;

Changes to generic/tclTrace.c.

467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
...
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
...
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = Tcl_Alloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
................................................................................
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = Tcl_Alloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
................................................................................
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = Tcl_Alloc(
		    TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
	    }






|







 







|







 







|







467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
...
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
...
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
................................................................................
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
................................................................................
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = Tcl_Alloc(
		    offsetof(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
	    }

Changes to generic/tclVar.c.

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
			    Tcl_Obj *key, int *newPtr);
static inline Var *	VarHashFirstVar(TclVarHashTable *tablePtr,
			    Tcl_HashSearch *searchPtr);
static inline Var *	VarHashNextVar(Tcl_HashSearch *searchPtr);
static inline void	CleanupVar(Var *varPtr, Var *arrayPtr);

#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))

/*
 * NOTE: VarHashCreateVar increments the recount of its key argument.
 * All callers that will call Tcl_DecrRefCount on that argument must
 * call Tcl_IncrRefCount on it before passing it in.  This requirement
 * can bubble up to callers of callers .... etc.
 */






|







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
			    Tcl_Obj *key, int *newPtr);
static inline Var *	VarHashFirstVar(TclVarHashTable *tablePtr,
			    Tcl_HashSearch *searchPtr);
static inline Var *	VarHashNextVar(Tcl_HashSearch *searchPtr);
static inline void	CleanupVar(Var *varPtr, Var *arrayPtr);

#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))

/*
 * NOTE: VarHashCreateVar increments the recount of its key argument.
 * All callers that will call Tcl_DecrRefCount on that argument must
 * call Tcl_IncrRefCount on it before passing it in.  This requirement
 * can bubble up to callers of callers .... etc.
 */