Tcl Source Code

Check-in [553e3556d7]
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 trunk. Also a lot of ckfree() -> Tcl_Free() changes, hopefully that will fix the Travis build.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-refactor
Files: files | file ages | folders
SHA3-256: 553e3556d7f7fe488277c0afdd39d0f965bfa12ee73b5f52e3d7a746deb5159e
User & Date: jan.nijtmans 2019-08-29 13:58:35
Context
2019-09-08
14:02
Fix travis build for --enable-symbols=all check-in: e9d72aef77 user: jan.nijtmans tags: dgp-refactor
2019-08-29
13:58
Merge trunk. Also a lot of ckfree() -> Tcl_Free() changes, hopefully that will fix the Travis build. check-in: 553e3556d7 user: jan.nijtmans tags: dgp-refactor
10:39
Merge from core-8-branch. nmake bug fix [889065786b] for extension stubs. check-in: 8fedd4f1f7 user: apnadkarni tags: trunk
2019-08-28
13:17
merge trunk check-in: 030c2f7cbd user: dgp tags: dgp-refactor
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclBrodnik.h.

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
...
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
TclBrodnikArrayDeclare(T,static);					\
TclBrodnikArrayDefine(T,static)

#define TclBrodnikArrayDefine(T,scope)					\
scope BA_ ## T *							\
BA_ ## T ## _Create()							\
{									\
    BA_ ## T *newPtr = ckalloc(sizeof(BA_ ## T));			\
									\
    newPtr->hi = 0;							\
    newPtr->lo = 0;							\
    newPtr->dbsize = 1;							\
    newPtr->count = 0;							\
    newPtr->dbused = 1;							\
    newPtr->dbavail = 1;						\
    newPtr->store = ckalloc(sizeof(T *));				\
    newPtr->store[0] = ckalloc(sizeof(T));				\
    return newPtr;							\
}									\
									\
scope void								\
BA_ ## T ## _Destroy(							\
    BA_ ## T *a)							\
{									\
    unsigned int i = a->dbused;						\
									\
    while (i--) {							\
	ckfree(a->store[i]);						\
    }									\
    ckfree(a->store);							\
    ckfree(a);								\
}									\
									\
scope size_t								\
BA_ ## T ## _Size(							\
    BA_ ## T *a)							\
{									\
    if (a == NULL) {							\
................................................................................
									\
scope void								\
BA_ ## T ## _Grow(							\
    BA_ ## T *a)							\
{									\
    if (a->dbused == a->dbavail) {					\
	a->dbavail *= 2;						\
	a->store = ckrealloc(a->store, a->dbavail*sizeof(T *));		\
    }									\
    a->store[a->dbused] = ckalloc(a->dbsize * sizeof(T));		\
    a->dbused++;							\
}									\
									\
scope void								\
BA_ ## T ## _Shrink(							\
    BA_ ## T *a)							\
{									\
    a->dbused--;							\
    ckfree(a->store[a->dbused]);					\
    if (a->dbavail / a->dbused >= 4) {					\
	a->dbavail /= 2;						\
	a->store = ckrealloc(a->store, a->dbavail*sizeof(T *));		\
    }									\
}									\
									\
scope void								\
BA_ ## T ## _Copy(							\
    T *p,								\
    BA_ ## T *a)							\






|







|
|










|

|
|







 







|

|








|


|







90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
...
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
TclBrodnikArrayDeclare(T,static);					\
TclBrodnikArrayDefine(T,static)

#define TclBrodnikArrayDefine(T,scope)					\
scope BA_ ## T *							\
BA_ ## T ## _Create()							\
{									\
    BA_ ## T *newPtr = Tcl_Alloc(sizeof(BA_ ## T));			\
									\
    newPtr->hi = 0;							\
    newPtr->lo = 0;							\
    newPtr->dbsize = 1;							\
    newPtr->count = 0;							\
    newPtr->dbused = 1;							\
    newPtr->dbavail = 1;						\
    newPtr->store = Tcl_Alloc(sizeof(T *));				\
    newPtr->store[0] = Tcl_Alloc(sizeof(T));				\
    return newPtr;							\
}									\
									\
scope void								\
BA_ ## T ## _Destroy(							\
    BA_ ## T *a)							\
{									\
    unsigned int i = a->dbused;						\
									\
    while (i--) {							\
	Tcl_Free(a->store[i]);						\
    }									\
    Tcl_Free(a->store);							\
    Tcl_Free(a);								\
}									\
									\
scope size_t								\
BA_ ## T ## _Size(							\
    BA_ ## T *a)							\
{									\
    if (a == NULL) {							\
................................................................................
									\
scope void								\
BA_ ## T ## _Grow(							\
    BA_ ## T *a)							\
{									\
    if (a->dbused == a->dbavail) {					\
	a->dbavail *= 2;						\
	a->store = Tcl_Realloc(a->store, a->dbavail*sizeof(T *));		\
    }									\
    a->store[a->dbused] = Tcl_Alloc(a->dbsize * sizeof(T));		\
    a->dbused++;							\
}									\
									\
scope void								\
BA_ ## T ## _Shrink(							\
    BA_ ## T *a)							\
{									\
    a->dbused--;							\
    Tcl_Free(a->store[a->dbused]);					\
    if (a->dbavail / a->dbused >= 4) {					\
	a->dbavail /= 2;						\
	a->store = Tcl_Realloc(a->store, a->dbavail*sizeof(T *));		\
    }									\
}									\
									\
scope void								\
BA_ ## T ## _Copy(							\
    T *p,								\
    BA_ ## T *a)							\

Changes to generic/tclEnv.c.

672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
	BP_pchar ptr;
	pchar *p = BA_pchar_First(env.cachePtr, &ptr);

	while (p) {
	    if (*p == oldStr) {
		pchar *lastPtr;

		ckfree(*p);

		if (newStr) {
		    *p = newStr;
		    return;
		}

		lastPtr = BA_pchar_Detach(env.cachePtr);






|







672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
	BP_pchar ptr;
	pchar *p = BA_pchar_First(env.cachePtr, &ptr);

	while (p) {
	    if (*p == oldStr) {
		pchar *lastPtr;

		Tcl_Free(*p);

		if (newStr) {
		    *p = newStr;
		    return;
		}

		lastPtr = BA_pchar_Detach(env.cachePtr);

Changes to generic/tclHAMT.c.

109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
...
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
...
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
...
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
...
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
....
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
....
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
....
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
....
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
....
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
....
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
	kt->dropRefProc(l->key);
    }
    l->key = NULL;
    if (vt && vt->dropRefProc) {
	vt->dropRefProc(l->value);
    }
    l->value = NULL;
    ckfree(l);
}
 
static 
int KVLEqualKeys(
    HAMT *hamt,
    ClientData key1,
    ClientData key2)
................................................................................
KVList KVLNew(
    HAMT *hamt,
    ClientData key,
    ClientData value)
{
    const TclHAMTKeyType *kt = hamt->kt;
    const TclHAMTValueType *vt = hamt->vt;
    KVList new = ckalloc(sizeof(KVNode));
    new->claim = 0;
    if (kt && kt->makeRefProc) {
	kt->makeRefProc(key);
    }
    new->key = key;
    if (vt && vt->makeRefProc) {
	vt->makeRefProc(value);
................................................................................
    }
    KVLDisclaim(hamt, c->l);
    c->l = NULL;
    if (c->next) {
	CNDisclaim(hamt, c->next);
    }
    c->next = NULL;
    ckfree(c);
}

static
Collision CNNew(
    KVList l,
    Collision next)
{
    Collision new = ckalloc(sizeof(CNode));
    new->claim = 0;
    if (next) {
	CNClaim(next);
    }
    new->next = next;
    KVLClaim(l);
    new->l = l;
................................................................................
	am->slot[i] = NULL;
    }
    for (i = 2*numList; i < 2*numList + numSubnode; i++) {
	AMDisclaim(hamt, am->slot[i]);
	am->slot[i] = NULL;
    }

    ckfree(am);
}

/*
 *----------------------------------------------------------------------
 *
 * AMNew --
 *
................................................................................
ArrayMap AMNew(
    TclHAMT hamt,
    int numList,
    int numSubnode,
    size_t mask,
    size_t id)
{
    ArrayMap new = ckalloc(AMN_SIZE(numList, numSubnode));

    new->canWrite = (hamt) ? hamt->id : 0;
    new->claim = 0;
    new->size = 0;
    new->mask = mask;
    new->id = id;
    return new;
................................................................................
 */

TclHAMT
TclHAMTCreate(
    const TclHAMTKeyType *kt,	/* Custom key handling functions */
    const TclHAMTValueType *vt)	/* Custom value handling functions */
{
    HAMT *hamt = ckalloc(sizeof(HAMT));

    hamt->id = 0;
    hamt->claim = 0;
    hamt->kt = kt;
    hamt->vt = vt;
    hamt->kvl = NULL;
    hamt->x.am = NULL;
................................................................................
	hamt->x.am = NULL;
    }
    if (hamt->overflow) {
	CNDisclaim(hamt, hamt->overflow);
    }
    hamt->kt = NULL;
    hamt->vt = NULL;
    ckfree(hamt);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclHAMTFetch --
 *
................................................................................
    assert ( hamt );

    if (hamt->kvl == NULL && hamt->x.am == NULL) {
	/* Empty */
	return NULL;
    }

    i = ckalloc(sizeof(Idx) + depth*sizeof(ArrayMap));

    /*
     * We claim an interest in hamt.  After that we need not claim any
     * interest in any of its sub-parts since it already takes care of
     * that for us.
     */

................................................................................
TclHAMTDone(
    TclHAMTIdx idx)
{
    Idx *i = idx;

    TclHAMTDisclaim(i->hamt);
    i->hamt = NULL;
    ckfree(i);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclHAMTInfo --
 *
................................................................................

Tcl_Obj *
TclHAMTInfo(
    TclHAMT hamt)
{
    const int branchShift = TclMSB(branchFactor);
    const int depth = CHAR_BIT * sizeof(size_t) / branchShift;
    size_t *accum = ckalloc(depth*sizeof(size_t));
    size_t size = TclHAMTSize(hamt);
    double avg = 0.0;
    int i, collisions = 0;
    size_t nodes = 0;
    size_t numBytes = 0;
    size_t slots = 0;
    size_t hist[129];
................................................................................
	Tcl_DecrRefCount(count);

	fraction = (1.0 * accum[i]) / size;
	avg += i * fraction;
    }
    Tcl_AppendPrintfToObj(result, "\naverage hops: %g ", avg);
    }
    ckfree(accum);

    return result;
}


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






|







 







|







 







|







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|












109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
...
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
...
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
...
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
...
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
....
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
....
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
....
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
....
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
....
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
....
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
	kt->dropRefProc(l->key);
    }
    l->key = NULL;
    if (vt && vt->dropRefProc) {
	vt->dropRefProc(l->value);
    }
    l->value = NULL;
    Tcl_Free(l);
}
 
static 
int KVLEqualKeys(
    HAMT *hamt,
    ClientData key1,
    ClientData key2)
................................................................................
KVList KVLNew(
    HAMT *hamt,
    ClientData key,
    ClientData value)
{
    const TclHAMTKeyType *kt = hamt->kt;
    const TclHAMTValueType *vt = hamt->vt;
    KVList new = Tcl_Alloc(sizeof(KVNode));
    new->claim = 0;
    if (kt && kt->makeRefProc) {
	kt->makeRefProc(key);
    }
    new->key = key;
    if (vt && vt->makeRefProc) {
	vt->makeRefProc(value);
................................................................................
    }
    KVLDisclaim(hamt, c->l);
    c->l = NULL;
    if (c->next) {
	CNDisclaim(hamt, c->next);
    }
    c->next = NULL;
    Tcl_Free(c);
}

static
Collision CNNew(
    KVList l,
    Collision next)
{
    Collision new = Tcl_Alloc(sizeof(CNode));
    new->claim = 0;
    if (next) {
	CNClaim(next);
    }
    new->next = next;
    KVLClaim(l);
    new->l = l;
................................................................................
	am->slot[i] = NULL;
    }
    for (i = 2*numList; i < 2*numList + numSubnode; i++) {
	AMDisclaim(hamt, am->slot[i]);
	am->slot[i] = NULL;
    }

    Tcl_Free(am);
}

/*
 *----------------------------------------------------------------------
 *
 * AMNew --
 *
................................................................................
ArrayMap AMNew(
    TclHAMT hamt,
    int numList,
    int numSubnode,
    size_t mask,
    size_t id)
{
    ArrayMap new = Tcl_Alloc(AMN_SIZE(numList, numSubnode));

    new->canWrite = (hamt) ? hamt->id : 0;
    new->claim = 0;
    new->size = 0;
    new->mask = mask;
    new->id = id;
    return new;
................................................................................
 */

TclHAMT
TclHAMTCreate(
    const TclHAMTKeyType *kt,	/* Custom key handling functions */
    const TclHAMTValueType *vt)	/* Custom value handling functions */
{
    HAMT *hamt = Tcl_Alloc(sizeof(HAMT));

    hamt->id = 0;
    hamt->claim = 0;
    hamt->kt = kt;
    hamt->vt = vt;
    hamt->kvl = NULL;
    hamt->x.am = NULL;
................................................................................
	hamt->x.am = NULL;
    }
    if (hamt->overflow) {
	CNDisclaim(hamt, hamt->overflow);
    }
    hamt->kt = NULL;
    hamt->vt = NULL;
    Tcl_Free(hamt);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclHAMTFetch --
 *
................................................................................
    assert ( hamt );

    if (hamt->kvl == NULL && hamt->x.am == NULL) {
	/* Empty */
	return NULL;
    }

    i = Tcl_Alloc(sizeof(Idx) + depth*sizeof(ArrayMap));

    /*
     * We claim an interest in hamt.  After that we need not claim any
     * interest in any of its sub-parts since it already takes care of
     * that for us.
     */

................................................................................
TclHAMTDone(
    TclHAMTIdx idx)
{
    Idx *i = idx;

    TclHAMTDisclaim(i->hamt);
    i->hamt = NULL;
    Tcl_Free(i);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclHAMTInfo --
 *
................................................................................

Tcl_Obj *
TclHAMTInfo(
    TclHAMT hamt)
{
    const int branchShift = TclMSB(branchFactor);
    const int depth = CHAR_BIT * sizeof(size_t) / branchShift;
    size_t *accum = Tcl_Alloc(depth*sizeof(size_t));
    size_t size = TclHAMTSize(hamt);
    double avg = 0.0;
    int i, collisions = 0;
    size_t nodes = 0;
    size_t numBytes = 0;
    size_t slots = 0;
    size_t hist[129];
................................................................................
	Tcl_DecrRefCount(count);

	fraction = (1.0 * accum[i]) / size;
	avg += i * fraction;
    }
    Tcl_AppendPrintfToObj(result, "\naverage hops: %g ", avg);
    }
    Tcl_Free(accum);

    return result;
}


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclHAMTObj.c.

921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
....
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
....
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
....
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
AllocChainEntry(
    Tcl_HashTable *tablePtr,
    void *keyPtr)
{
    Tcl_Obj *objPtr = keyPtr;
    ChainEntry *cPtr;

    cPtr = ckalloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    Tcl_SetHashValue(&cPtr->entry, NULL);
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}
................................................................................
 */

static void
DeleteDict(
    Dict *dict)
{
    DeleteChainTable(dict);
    ckfree(dict);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclTraceDictPath --
 *
................................................................................
#else /* !TCL_MEM_DEBUG */

    Tcl_Obj *dictPtr;
    Dict *dict;

    TclNewObj(dictPtr);
    TclInvalidateStringRep(dictPtr);
    dict = ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DICT(dictPtr) = dict;
    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
    dictPtr->typePtr = &tclDictType;
................................................................................
{
#ifdef TCL_MEM_DEBUG
    Tcl_Obj *dictPtr;
    Dict *dict;

    TclDbNewObj(dictPtr, file, line);
    TclInvalidateStringRep(dictPtr);
    dict = ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DICT(dictPtr) = dict;
    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
    dictPtr->typePtr = &tclDictType;






|







 







|







 







|







 







|







921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
....
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
....
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
....
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
AllocChainEntry(
    Tcl_HashTable *tablePtr,
    void *keyPtr)
{
    Tcl_Obj *objPtr = keyPtr;
    ChainEntry *cPtr;

    cPtr = Tcl_Alloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    Tcl_SetHashValue(&cPtr->entry, NULL);
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}
................................................................................
 */

static void
DeleteDict(
    Dict *dict)
{
    DeleteChainTable(dict);
    Tcl_Free(dict);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclTraceDictPath --
 *
................................................................................
#else /* !TCL_MEM_DEBUG */

    Tcl_Obj *dictPtr;
    Dict *dict;

    TclNewObj(dictPtr);
    TclInvalidateStringRep(dictPtr);
    dict = Tcl_Alloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DICT(dictPtr) = dict;
    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
    dictPtr->typePtr = &tclDictType;
................................................................................
{
#ifdef TCL_MEM_DEBUG
    Tcl_Obj *dictPtr;
    Dict *dict;

    TclDbNewObj(dictPtr, file, line);
    TclInvalidateStringRep(dictPtr);
    dict = Tcl_Alloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DICT(dictPtr) = dict;
    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
    dictPtr->typePtr = &tclDictType;

Changes to generic/tclParse.c.

223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
...
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
...
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
	    tirPtr->scriptObjPtr = NULL;
	    Tcl_DecrRefCount(releaseMe);
	    if (originalShimmered == 0) {
		return;
	    }
	}
    }
    ckfree(tirPtr->tokenPtr);
    ckfree(tirPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * DupTokensInternalRep --
 *
................................................................................
SetTokensFromAny (interp, objPtr)
    Tcl_Interp *interp;	/* Not used. */
    Tcl_Obj *objPtr;	/* Value for which to generate Tcl_Token array by
			 * parsing the string value */
{
    int numBytes;
    const char *script = Tcl_GetStringFromObj(objPtr, &numBytes);
    TokenIntRep *tirPtr = ckalloc(sizeof(TokenIntRep));

    /*
     * Free the old internal rep, parse the string as a Tcl script, and
     * stash the Tcl_Token array into a new internal rep
     *
     * NOTE: the Tcl_Token array contains pointers pointing into the
     * parsed string rep, which in this situation is objPtr->bytes.
................................................................................
	*termPtr = parsePtr->term;
    }
    /*
     * Note no call to Tcl_FreeParse().
     * We'll transfer the tokens to the caller.
     */
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	result = ckrealloc(parsePtr->tokenPtr,
		parsePtr->numTokens * sizeof(Tcl_Token));
    } else {
	result = ckalloc(parsePtr->numTokens * sizeof(Tcl_Token));
	memcpy(result, parsePtr->tokenPtr, 
		(size_t) (parsePtr->numTokens * sizeof(Tcl_Token)));
    }

    if (lastTokenPtrPtr != NULL) {
	*lastTokenPtrPtr = &(result[parsePtr->numTokens - 1]);
    }






|
|







 







|







 







|


|







223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
...
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
...
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
	    tirPtr->scriptObjPtr = NULL;
	    Tcl_DecrRefCount(releaseMe);
	    if (originalShimmered == 0) {
		return;
	    }
	}
    }
    Tcl_Free(tirPtr->tokenPtr);
    Tcl_Free(tirPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * DupTokensInternalRep --
 *
................................................................................
SetTokensFromAny (interp, objPtr)
    Tcl_Interp *interp;	/* Not used. */
    Tcl_Obj *objPtr;	/* Value for which to generate Tcl_Token array by
			 * parsing the string value */
{
    int numBytes;
    const char *script = Tcl_GetStringFromObj(objPtr, &numBytes);
    TokenIntRep *tirPtr = Tcl_Alloc(sizeof(TokenIntRep));

    /*
     * Free the old internal rep, parse the string as a Tcl script, and
     * stash the Tcl_Token array into a new internal rep
     *
     * NOTE: the Tcl_Token array contains pointers pointing into the
     * parsed string rep, which in this situation is objPtr->bytes.
................................................................................
	*termPtr = parsePtr->term;
    }
    /*
     * Note no call to Tcl_FreeParse().
     * We'll transfer the tokens to the caller.
     */
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	result = Tcl_Realloc(parsePtr->tokenPtr,
		parsePtr->numTokens * sizeof(Tcl_Token));
    } else {
	result = Tcl_Alloc(parsePtr->numTokens * sizeof(Tcl_Token));
	memcpy(result, parsePtr->tokenPtr, 
		(size_t) (parsePtr->numTokens * sizeof(Tcl_Token)));
    }

    if (lastTokenPtrPtr != NULL) {
	*lastTokenPtrPtr = &(result[parsePtr->numTokens - 1]);
    }

Changes to win/rules.vc.

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
....
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
....
1413
1414
1415
1416
1417
1418
1419
1420
1421

1422
1423
1424
1425
1426
1427
1428
....
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
!ifndef _RULES_VC
_RULES_VC = 1

# The following macros define the version of the rules.vc nmake build system
# For modifications that are not backward-compatible, you *must* change
# the major version.
RULES_VERSION_MAJOR = 1
RULES_VERSION_MINOR = 3

# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
!error *** Error: Macro PROJECT not defined! Please define it before including rules.vc
!endif

!if "$(PRJ_PACKAGE_TCLNAME)" == ""
................................................................................

!if $(TCL_MEM_DEBUG)
OPTDEFINES	= $(OPTDEFINES) -DTCL_MEM_DEBUG
!endif
!if $(TCL_COMPILE_DEBUG)
OPTDEFINES	= $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
!endif
!if $(TCL_THREADS) && $(TCL_VERSION) < 86
OPTDEFINES	= $(OPTDEFINES) -DTCL_THREADS=1
!if $(USE_THREAD_ALLOC)
OPTDEFINES	= $(OPTDEFINES) -DUSE_THREAD_ALLOC=1
!endif
!endif
!if $(STATIC_BUILD)
OPTDEFINES	= $(OPTDEFINES) -DSTATIC_BUILD
................................................................................

# appcflags contains $(cflags) and flags for building the application
# object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus
# flags used for building shared object files The two differ in the
# BUILD_$(PROJECT) macro which should be defined only for the shared
# library *implementation* and not for its caller interface

appcflags = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) $(USE_STUBS_DEFS)
appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES)

pkgcflags = $(appcflags) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT)
pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT)

# stubscflags contains $(cflags) plus flags used for building a stubs
# library for the package.  Note: -DSTATIC_BUILD is defined in
# $(OPTDEFINES) only if the OPTS configuration indicates a static
# library. However the stubs library is ALWAYS static hence included
................................................................................
# here irrespective of the OPTS setting.
#
# TBD - tclvfs has a comment that stubs libs should not be compiled with -GL
# without stating why. Tcl itself compiled stubs libs with this flag.
# so we do not remove it from cflags. -GL may prevent extensions
# compiled with one VC version to fail to link against stubs library
# compiled with another VC version. Check for this and fix accordingly.
stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES)

# Link flags

!if $(DEBUG)
ldebug	= -debug -debugtype:cv
!else
ldebug	= -release -opt:ref -opt:icf,3






|







 







|







 







<

>







 







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
....
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
....
1413
1414
1415
1416
1417
1418
1419

1420
1421
1422
1423
1424
1425
1426
1427
1428
....
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
!ifndef _RULES_VC
_RULES_VC = 1

# The following macros define the version of the rules.vc nmake build system
# For modifications that are not backward-compatible, you *must* change
# the major version.
RULES_VERSION_MAJOR = 1
RULES_VERSION_MINOR = 4

# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
!error *** Error: Macro PROJECT not defined! Please define it before including rules.vc
!endif

!if "$(PRJ_PACKAGE_TCLNAME)" == ""
................................................................................

!if $(TCL_MEM_DEBUG)
OPTDEFINES	= $(OPTDEFINES) -DTCL_MEM_DEBUG
!endif
!if $(TCL_COMPILE_DEBUG)
OPTDEFINES	= $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
!endif
!if $(TCL_THREADS) && $(TCL_VERSION) <= 86
OPTDEFINES	= $(OPTDEFINES) -DTCL_THREADS=1
!if $(USE_THREAD_ALLOC)
OPTDEFINES	= $(OPTDEFINES) -DUSE_THREAD_ALLOC=1
!endif
!endif
!if $(STATIC_BUILD)
OPTDEFINES	= $(OPTDEFINES) -DSTATIC_BUILD
................................................................................

# appcflags contains $(cflags) and flags for building the application
# object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus
# flags used for building shared object files The two differ in the
# BUILD_$(PROJECT) macro which should be defined only for the shared
# library *implementation* and not for its caller interface


appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES)
appcflags = $(appcflags_nostubs) $(USE_STUBS_DEFS)
pkgcflags = $(appcflags) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT)
pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT)

# stubscflags contains $(cflags) plus flags used for building a stubs
# library for the package.  Note: -DSTATIC_BUILD is defined in
# $(OPTDEFINES) only if the OPTS configuration indicates a static
# library. However the stubs library is ALWAYS static hence included
................................................................................
# here irrespective of the OPTS setting.
#
# TBD - tclvfs has a comment that stubs libs should not be compiled with -GL
# without stating why. Tcl itself compiled stubs libs with this flag.
# so we do not remove it from cflags. -GL may prevent extensions
# compiled with one VC version to fail to link against stubs library
# compiled with another VC version. Check for this and fix accordingly.
stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS)

# Link flags

!if $(DEBUG)
ldebug	= -debug -debugtype:cv
!else
ldebug	= -release -opt:ref -opt:icf,3