Tcl Source Code

Changes On Branch dkf-http-cookies
Login

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

Changes In Branch dkf-http-cookies Excluding Merge-Ins

This is equivalent to a diff from 49e104fa48 to 9484e75bad

2018-11-06
09:50
Implement TIP 406 check-in: 5f51fd5a97 user: dkf tags: core-8-branch
09:49
merge core-8-branch Closed-Leaf check-in: 9484e75bad user: dkf tags: dkf-http-cookies
2018-11-01
20:10
Fixed memory leak in TclOO.c:ObjectNamespaceDeleted, object mixins and object/class mutation. check-in: 1e3b9149a7 user: pooryorick tags: core-8-branch
2018-10-19
10:07
merge core-8-branch check-in: 4e23367512 user: dkf tags: dkf-http-cookies
2017-11-13
08:59
merge tcl-9-cleanup (and also a minor bug-fix from core-8-branch). check-in: b03c4194f0 user: jan.nijtmans tags: trunk
2017-11-09
15:47
Rebase branch to trunk. check-in: f714eca8f2 user: dgp tags: dgp-refactor
14:44
merge trunk check-in: d27981d722 user: dgp tags: no-wideint
14:40
merge trunk Closed-Leaf check-in: 844ae11ba0 user: dgp tags: tcl-9-cleanup
13:46
merge trunk check-in: a10fc87c05 user: dgp tags: dgp-properbytearray
12:52
merge trunk check-in: 54f289e311 user: jan.nijtmans tags: novem
12:51
merge core-8-branch check-in: 49e104fa48 user: jan.nijtmans tags: trunk
12:50
merge core-8-6-branch check-in: ef4cc04bc1 user: jan.nijtmans tags: core-8-branch
2017-11-08
09:38
merge core-8-branch check-in: 3885b08997 user: jan.nijtmans tags: trunk

Changes to .fossil-settings/crlf-glob.

8
9
10
11
12
13
14


15
16
17
8
9
10
11
12
13
14
15
16
17
18
19







+
+



libtommath/*.vcproj
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/rules-ext.vc
win/targets.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in

Deleted .fossil-settings/crnl-glob.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
compat/zlib/contrib/vstudio/readme.txt
compat/zlib/contrib/vstudio/*/zlib.rc
compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
libtommath/*.dsp
libtommath/*.sln
libtommath/*.vcproj
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in

Changes to .fossil-settings/ignore-glob.

40
41
42
43
44
45
46

47
48
40
41
42
43
44
45
46
47
48
49







+


unix/dltest.marker
unix/tcl.pc
unix/tclIndex
unix/pkgs/*
win/Debug*
win/Release*
win/pkgs/*
win/coffbase.txt
win/tcl.hpj
win/nmhlp-out.txt

Added .github/ISSUE_TEMPLATE.md.




1
2
3
+
+
+
Important Note
==========
Please do not file issues with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.

Added .github/PULL_REQUEST_TEMPLATE.md.




1
2
3
+
+
+
Important Note
==========
Please do not file pull requests with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues (including patches) are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.

Changes to .project.

1
2
3

4
5
6
7
8
9
10
1
2

3
4
5
6
7
8
9
10


-
+







<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
	<name>tcl9</name>
	<name>tcl8</name>
	<comment></comment>
	<projects>
	</projects>
	<buildSpec>
	</buildSpec>
	<natures>
	</natures>

Changes to ChangeLog.2007.

1422
1423
1424
1425
1426
1427
1428
1429

1430
1431
1432
1433
1434
1435
1436
1422
1423
1424
1425
1426
1427
1428

1429
1430
1431
1432
1433
1434
1435
1436







-
+







	an expr syntax error (masked by a [catch]).

	* generic/tclCompCmds.c (TclCompileReturnCmd):	Added crash protection
	to handle callers other than TclCompileScript() failing to meet the
	initialization assumptions of the TIP 280 code in CompileWord().

	* generic/tclCompExpr.c:	Suppress the attempt to convert to
	numeric when pre-compiling a constant expresion indicates an error.
	numeric when pre-compiling a constant expression indicates an error.

2007-08-22  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TEBC): disable the new shortcut to frequent
	INSTs for debug builds. REVERTED (collision with alternative fix)

2007-08-21  Don Porter	<[email protected]>

Changes to README.

1
2

3
4
5
6
7
8
9
1

2
3
4
5
6
7
8
9

-
+







README:  Tcl
    This is the Tcl 9.0a0 source distribution.
    This is the Tcl 8.7a2 source distribution.
	http://sourceforge.net/projects/tcl/files/Tcl/
    You can get any source release of Tcl from the URL above.

Contents
--------
    1. Introduction
    2. Documentation

Changes to changes.

8230
8231
8232
8233
8234
8235
8236
8237

8238
8239
8240
8241
8242
8243
8244
8230
8231
8232
8233
8234
8235
8236

8237
8238
8239
8240
8241
8242
8243
8244







-
+








2013-05-06 (platform support) Cygwin64 (nijtmans)

2013-05-15 (enhancement) Improved [list {*}...] compile (fellows)

2013-05-16 (platform support) mingw-4.0 (nijtmans)

2013-05-19 (platform support) FreeBSD updates (gahr)
2013-05-19 (platform support) FreeBSD updates (cerutti)

2013-05-20 (bug fix)[3613567] access error temp file creation (keene)

2013-05-20 (bug fix)[3613569] temp file open fail can crash [load] (keene)

2013-05-22 (bug fix)[3613609] [lsort -nocase] failed on non-ASCII (fellows)

8653
8654
8655
8656
8657
8658
8659
8660

8661
8662
8663
8664
8665
8666
8667
8653
8654
8655
8656
8657
8658
8659

8660
8661
8662
8663
8664
8665
8666
8667







-
+







2016-05-13 (bug)[3154ea] Mem corruption in assembler exceptions (tkob,kenny)

2016-05-13 (bug) registry package support any Unicode env (nijtmans)
=> registry 1.3.2

2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows)

2016-06-02 (TIP 447) execution time verbosity option (gahr)
2016-06-02 (TIP 447) execution time verbosity option (cerutti)
=> tcltest 2.4.0

2016-06-16 (bug)[16828b] crash due to [vwait] trace undo fail (dah,porter)

2016-06-16 (enhancement)[4b61af] good [info frame] from more cases (beric)

2016-06-21 (bug)[c383eb] crash in [glob -path a] (oehlmann,porter)
8792
8793
8794
8795
8796
8797
8798







































8799
8800
8801
8802
8803
8804
8805
8792
8793
8794
8795
8796
8797
8798
8799
8800
8801
8802
8803
8804
8805
8806
8807
8808
8809
8810
8811
8812
8813
8814
8815
8816
8817
8818
8819
8820
8821
8822
8823
8824
8825
8826
8827
8828
8829
8830
8831
8832
8833
8834
8835
8836
8837
8838
8839
8840
8841
8842
8843
8844







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








2017-07-06 (bug)[adb198] Plug memleak in TclJoinPath (sebres,porter)

2017-07-17 (bug)[fb2208] Repeatable tclIndex generation (wiedemann,nijtmans)

--- Released 8.6.7, August 9, 2017 --- http://core.tcl.tk/tcl/ for details

2017-08-10 [array names -regexp] supports backrefs (goth)

2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows)

2017-08-29 (bug)[b50fb2] exec redir append stdout and stderr to file (coulter)

2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
=> http 2.8.12

2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)

2017-10-19 (bug)[1a5655] [info * methods] includes mixins (fellows)

2017-10-23 tzdata updated to Olson's tzdata2017c (jima)

2017-10-24 (bug)[fc1409] segfault in method cloning, oo-15.15 (coulter,fellows)

2017-11-03 (bug)[6f2f83] More robust [load] for ReactOS (werner)

2017-11-08 (bug)[3298012] Stop crash when hash tables overflow 32 bits (porter)

2017-11-14 (bug)[5d6de6] Close failing case of [package prefer stable] (kupries)

2017-11-17 (bug)[fab924] Fix misleading [load] message on Windows (oehlmann)

2017-12-05 (bug)[4f6a1e] Crash when ensemble map and list are same (sebres)

2017-12-06 (bug)[ce3a21] file normalize failure when tail is empty (porter)

2017-12-08 (new)[TIP 477] nmake build system reform (nadkarni)

2017-12-19 (bug)[586e71] EvalObjv exception handling at level #0 (sebres,porter)

--- Released 8.6.8, December 22, 2017 --- http://core.tcl.tk/tcl/ for details

Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:

2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter)

2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans)

8832
8833
8834
8835
8836
8837
8838
8839
8840
8841
8842
8843





8871
8872
8873
8874
8875
8876
8877

8878
8879
8880
8881
8882
8883
8884
8885
8886







-




+
+
+
+
+

2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows)
=> TclOO 1.2.0

2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin)

2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
=> http 2.8.12

2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)

--- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details

2018-03-12 (TIP 490) add oo support for msgcat => msgcat 1.7.0 (oehlmann)

2018-03-12 (TIP 499) custom locale preference list (oehlmann)
=> msgcat 1.7.0

Deleted compat/fixstrtod.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36




































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * fixstrtod.c --
 *
 *	Source code for the "fixstrtod" procedure.  This procedure is
 *	used in place of strtod under Solaris 2.4, in order to fix
 *	a bug where the "end" pointer gets set incorrectly.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <stdio.h>

#undef strtod

/*
 * Declare strtod explicitly rather than including stdlib.h, since in
 * somes systems (e.g. SunOS 4.1.4) stdlib.h doesn't declare strtod.
 */

extern double strtod(char *, char **);

double
fixstrtod(
    char *string,
    char **endPtr)
{
    double d;
    d = strtod(string, endPtr);
    if ((endPtr != NULL) && (*endPtr != string) && ((*endPtr)[-1] == 0)) {
	*endPtr -= 1;
    }
    return d;
}

Deleted compat/float.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14














-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * float.h --
 *
 *	This is a dummy header file to #include in Tcl when there
 *	is no float.h in /usr/include.  Right now this file is empty:
 *	Tcl contains #ifdefs to deal with the lack of definitions;
 *	all it needs is for the #include statement to work.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

Changes to compat/stdlib.h.

25
26
27
28
29
30
31
32
33
34
35
36
25
26
27
28
29
30
31

32
33
34
35







-




extern void		exit(int status);
extern int		free(char *blockPtr);
extern char *		getenv(const char *name);
extern char *		malloc(unsigned int numBytes);
extern void		qsort(void *base, int n, int size, int (*compar)(
			    const void *element1, const void *element2));
extern char *		realloc(char *ptr, unsigned int numBytes);
extern double		strtod(const char *string, char **endPtr);
extern long		strtol(const char *string, char **endPtr, int base);
extern unsigned long	strtoul(const char *string, char **endPtr, int base);

#endif /* _STDLIB */

Deleted compat/strtod.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252




























































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * strtod.c --
 *
 *	Source code for the "strtod" library procedure.
 *
 * Copyright (c) 1988-1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
#ifndef NULL
#define NULL 0
#endif

static const int maxExponent = 511;	/* Largest possible base 10 exponent.  Any
				 * exponent larger than this will already
				 * produce underflow or overflow, so there's
				 * no need to worry about additional digits.
				 */
static const double powersOf10[] = {	/* Table giving binary powers of 10.  Entry */
    10.,			/* is 10^2^i.  Used to convert decimal */
    100.,			/* exponents into floating-point numbers. */
    1.0e4,
    1.0e8,
    1.0e16,
    1.0e32,
    1.0e64,
    1.0e128,
    1.0e256
};

/*
 *----------------------------------------------------------------------
 *
 * strtod --
 *
 *	This procedure converts a floating-point number from an ASCII
 *	decimal representation to internal double-precision format.
 *
 * Results:
 *	The return value is the double-precision floating-point
 *	representation of the characters in string.  If endPtr isn't
 *	NULL, then *endPtr is filled in with the address of the
 *	next character after the last one that was part of the
 *	floating-point number.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

double
strtod(
    const char *string,		/* A decimal ASCII floating-point number,
				 * optionally preceded by white space. Must
				 * have form "-I.FE-X", where I is the integer
				 * part of the mantissa, F is the fractional
				 * part of the mantissa, and X is the
				 * exponent. Either of the signs may be "+",
				 * "-", or omitted. Either I or F may be
				 * omitted, or both. The decimal point isn't
				 * necessary unless F is present. The "E" may
				 * actually be an "e". E and X may both be
				 * omitted (but not just one). */
    char **endPtr)		/* If non-NULL, store terminating character's
				 * address here. */
{
    int sign, expSign = FALSE;
    double fraction, dblExp;
    const double *d;
    register const char *p;
    register int c;
    int exp = 0;		/* Exponent read from "EX" field. */
    int fracExp = 0;		/* Exponent that derives from the fractional
				 * part. Under normal circumstatnces, it is
				 * the negative of the number of digits in F.
				 * However, if I is very long, the last digits
				 * of I get dropped (otherwise a long I with a
				 * large negative exponent could cause an
				 * unnecessary overflow on I alone). In this
				 * case, fracExp is incremented one for each
				 * dropped digit. */
    int mantSize;		/* Number of digits in mantissa. */
    int decPt;			/* Number of mantissa digits BEFORE decimal
				 * point. */
    const char *pExp;		/* Temporarily holds location of exponent in
				 * string. */

    /*
     * Strip off leading blanks and check for a sign.
     */

    p = string;
    while (isspace(UCHAR(*p))) {
	p += 1;
    }
    if (*p == '-') {
	sign = TRUE;
	p += 1;
    } else {
	if (*p == '+') {
	    p += 1;
	}
	sign = FALSE;
    }

    /*
     * Count the number of digits in the mantissa (including the decimal
     * point), and also locate the decimal point.
     */

    decPt = -1;
    for (mantSize = 0; ; mantSize += 1)
    {
	c = *p;
	if (!isdigit(c)) {
	    if ((c != '.') || (decPt >= 0)) {
		break;
	    }
	    decPt = mantSize;
	}
	p += 1;
    }

    /*
     * Now suck up the digits in the mantissa. Use two integers to collect 9
     * digits each (this is faster than using floating-point). If the mantissa
     * has more than 18 digits, ignore the extras, since they can't affect the
     * value anyway.
     */

    pExp  = p;
    p -= mantSize;
    if (decPt < 0) {
	decPt = mantSize;
    } else {
	mantSize -= 1;		/* One of the digits was the point. */
    }
    if (mantSize > 18) {
	fracExp = decPt - 18;
	mantSize = 18;
    } else {
	fracExp = decPt - mantSize;
    }
    if (mantSize == 0) {
	fraction = 0.0;
	p = string;
	goto done;
    } else {
	int frac1, frac2;

	frac1 = 0;
	for ( ; mantSize > 9; mantSize -= 1) {
	    c = *p;
	    p += 1;
	    if (c == '.') {
		c = *p;
		p += 1;
	    }
	    frac1 = 10*frac1 + (c - '0');
	}
	frac2 = 0;
	for (; mantSize > 0; mantSize -= 1) {
	    c = *p;
	    p += 1;
	    if (c == '.') {
		c = *p;
		p += 1;
	    }
	    frac2 = 10*frac2 + (c - '0');
	}
	fraction = (1.0e9 * frac1) + frac2;
    }

    /*
     * Skim off the exponent.
     */

    p = pExp;
    if ((*p == 'E') || (*p == 'e')) {
	p += 1;
	if (*p == '-') {
	    expSign = TRUE;
	    p += 1;
	} else {
	    if (*p == '+') {
		p += 1;
	    }
	    expSign = FALSE;
	}
	if (!isdigit(UCHAR(*p))) {
	    p = pExp;
	    goto done;
	}
	while (isdigit(UCHAR(*p))) {
	    exp = exp * 10 + (*p - '0');
	    p += 1;
	}
    }
    if (expSign) {
	exp = fracExp - exp;
    } else {
	exp = fracExp + exp;
    }

    /*
     * Generate a floating-point number that represents the exponent. Do this
     * by processing the exponent one bit at a time to combine many powers of
     * 2 of 10. Then combine the exponent with the fraction.
     */

    if (exp < 0) {
	expSign = TRUE;
	exp = -exp;
    } else {
	expSign = FALSE;
    }
    if (exp > maxExponent) {
	exp = maxExponent;
	errno = ERANGE;
    }
    dblExp = 1.0;
    for (d = powersOf10; exp != 0; exp >>= 1, ++d) {
	if (exp & 01) {
	    dblExp *= *d;
	}
    }
    if (expSign) {
	fraction /= dblExp;
    } else {
	fraction *= dblExp;
    }

  done:
    if (endPtr != NULL) {
	*endPtr = (char *) p;
    }

    if (sign) {
	return -fraction;
    }
    return fraction;
}

Changes to compat/zlib/contrib/minizip/minizip.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40

41

42
43
44
45
46
47
48







-















-
+










-
+
-







         Modifications of Unzip for Zip64
         Copyright (C) 2007-2008 Even Rouault

         Modifications for Zip64 support on both zip and unzip
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
*/


#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
        #ifndef __USE_FILE_OFFSET64
                #define __USE_FILE_OFFSET64
        #endif
        #ifndef __USE_LARGEFILE64
                #define __USE_LARGEFILE64
        #endif
        #ifndef _LARGEFILE64_SOURCE
                #define _LARGEFILE64_SOURCE
        #endif
        #ifndef _FILE_OFFSET_BIT
                #define _FILE_OFFSET_BIT 64
        #endif
#endif

#ifdef __APPLE__
#if defined(__APPLE__) || defined(IOAPI_NO_64)
// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
#define FTELLO_FUNC(stream) ftello(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin)
#else
#define FOPEN_FUNC(filename, mode) fopen64(filename, mode)
#define FTELLO_FUNC(stream) ftello64(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
#endif


#include "tinydir.h"

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <errno.h>
#include <fcntl.h>

168
169
170
171
172
173
174

175
176
177
178
179
180
181
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180







+







    printf("MiniZip 1.1, demo of zLib + MiniZip64 package, written by Gilles Vollant\n");
    printf("more info on MiniZip at http://www.winimage.com/zLibDll/minizip.html\n\n");
}

void do_help()
{
    printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \
           "  -r  Scan directories recursively\n" \
           "  -o  Overwrite existing file.zip\n" \
           "  -a  Append to existing file.zip\n" \
           "  -0  Store only\n" \
           "  -1  Compress faster\n" \
           "  -9  Compress better\n\n" \
           "  -j  exclude path. store only the file name.\n\n");
}
238
239
240
241
242
243
244
245












































































































































246
247
248
249
250

251

252
253
254
255
256
257
258
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390

391
392
393
394
395
396
397
398








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





+
-
+







     largeFile = 1;

                fclose(pFile);
  }

 return largeFile;
}

void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
    FILE * fin;
    int size_read;
    const char *savefilenameinzip;
    zip_fileinfo zi;
    unsigned long crcFile=0;
    int zip64 = 0;
    int err=0;
    int size_buf=WRITEBUFFERSIZE;
    unsigned char buf[WRITEBUFFERSIZE];
    zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
    zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
    zi.dosDate = 0;
    zi.internal_fa = 0;
    zi.external_fa = 0;
    filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);

/*
    err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
                     NULL,0,NULL,0,NULL / * comment * /,
                     (opt_compress_level != 0) ? Z_DEFLATED : 0,
                     opt_compress_level);
*/
    if ((password != NULL) && (err==ZIP_OK))
        err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);

    zip64 = isLargeFile(filenameinzip);

   /* The path name saved, should not include a leading slash. */
   /*if it did, windows/xp and dynazip couldn't read the zip file. */
     savefilenameinzip = filenameinzip;
     while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
     {
         savefilenameinzip++;
     }

     /*should the zip file contain any path at all?*/
     if( opt_exclude_path )
     {
         const char *tmpptr;
         const char *lastslash = 0;
         for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
         {
             if( *tmpptr == '\\' || *tmpptr == '/')
             {
                 lastslash = tmpptr;
             }
         }
         if( lastslash != NULL )
         {
             savefilenameinzip = lastslash+1; // base filename follows last slash.
         }
     }

     /**/
    err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
                     NULL,0,NULL,0,NULL /* comment*/,
                     (opt_compress_level != 0) ? Z_DEFLATED : 0,
                     opt_compress_level,0,
                     /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
                     -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
                     password,crcFile, zip64);

    if (err != ZIP_OK)
        printf("error in opening %s in zipfile\n",filenameinzip);
    else
    {
        fin = FOPEN_FUNC(filenameinzip,"rb");
        if (fin==NULL)
        {
            err=ZIP_ERRNO;
            printf("error in opening %s for reading\n",filenameinzip);
        }
    }

    if (err == ZIP_OK)
        do
        {
            err = ZIP_OK;
            size_read = (int)fread(buf,1,size_buf,fin);
            if (size_read < size_buf)
                if (feof(fin)==0)
            {
                printf("error in reading %s\n",filenameinzip);
                err = ZIP_ERRNO;
            }

            if (size_read>0)
            {
                err = zipWriteInFileInZip (zf,buf,size_read);
                if (err<0)
                {
                    printf("error in writing %s in the zipfile\n",
                                     filenameinzip);
                }

            }
        } while ((err == ZIP_OK) && (size_read>0));

    if (fin)
        fclose(fin);

    if (err<0)
        err=ZIP_ERRNO;
    else
    {
        err = zipCloseFileInZip(zf);
        if (err!=ZIP_OK)
            printf("error in closing %s in the zipfile\n",
                        filenameinzip);
    }
}


void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
    tinydir_dir dir;
    int i;
    char newname[512];

    tinydir_open_sorted(&dir, filenameinzip);

    for (i = 0; i < dir.n_files; i++)
    {
        tinydir_file file;
        tinydir_readfile_n(&dir, &file, i);
        if(strcmp(file.name,".")==0) continue;
        if(strcmp(file.name,"..")==0) continue;
        sprintf(newname,"%s/%s",dir.path,file.name);
        if (file.is_dir)
        {
            addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
        } else {
            addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
        }
    }

    tinydir_close(&dir);
}


int main(argc,argv)
    int argc;
    char *argv[];
{
    int i;
    int opt_recursive=0;
    int opt_overwrite=0;
    int opt_overwrite=1;
    int opt_compress_level=Z_DEFAULT_COMPRESSION;
    int opt_exclude_path=0;
    int zipfilenamearg = 0;
    char filename_try[MAXFILENAME+16];
    int zipok;
    int err=0;
    int size_buf=0;
281
282
283
284
285
286
287
288


289
290
291
292
293
294
295
421
422
423
424
425
426
427

428
429
430
431
432
433
434
435
436







-
+
+







                        opt_overwrite = 1;
                    if ((c=='a') || (c=='A'))
                        opt_overwrite = 2;
                    if ((c>='0') && (c<='9'))
                        opt_compress_level = c-'0';
                    if ((c=='j') || (c=='J'))
                        opt_exclude_path = 1;

                    if ((c=='r') || (c=='R'))
                        opt_recursive = 1;
                    if (((c=='p') || (c=='P')) && (i+1<argc))
                    {
                        password=argv[i+1];
                        i++;
                    }
                }
            }
388
389
390
391
392
393
394

395
396
397
398
399
400
401
402
403
404
405

406
407
408
409
410
411
412
413
414
415
416
417

418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461

462
463
464
465
466
467
468
469
470

471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
529
530
531
532
533
534
535
536
537
538
539








540












541












































542









543



































544
545
546
547
548
549
550







+



-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








        for (i=zipfilenamearg+1;(i<argc) && (err==ZIP_OK);i++)
        {
            if (!((((*(argv[i]))=='-') || ((*(argv[i]))=='/')) &&
                  ((argv[i][1]=='o') || (argv[i][1]=='O') ||
                   (argv[i][1]=='a') || (argv[i][1]=='A') ||
                   (argv[i][1]=='p') || (argv[i][1]=='P') ||
                   (argv[i][1]=='r') || (argv[i][1]=='R') ||
                   ((argv[i][1]>='0') || (argv[i][1]<='9'))) &&
                  (strlen(argv[i]) == 2)))
            {
                FILE * fin;
                int size_read;
                const char* filenameinzip = argv[i];
                const char *savefilenameinzip;
                zip_fileinfo zi;
                unsigned long crcFile=0;
                int zip64 = 0;

                if(opt_recursive) {
                zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
                zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
                zi.dosDate = 0;
                zi.internal_fa = 0;
                zi.external_fa = 0;
                filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);

/*
                err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
                                 NULL,0,NULL,0,NULL / * comment * /,
                                 (opt_compress_level != 0) ? Z_DEFLATED : 0,
                                 opt_compress_level);
                    addPathToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);
*/
                if ((password != NULL) && (err==ZIP_OK))
                    err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);

                zip64 = isLargeFile(filenameinzip);

                                                         /* The path name saved, should not include a leading slash. */
               /*if it did, windows/xp and dynazip couldn't read the zip file. */
                 savefilenameinzip = filenameinzip;
                 while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
                 {
                     savefilenameinzip++;
                 }

                 /*should the zip file contain any path at all?*/
                 if( opt_exclude_path )
                 {
                     const char *tmpptr;
                     const char *lastslash = 0;
                     for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
                     {
                         if( *tmpptr == '\\' || *tmpptr == '/')
                         {
                             lastslash = tmpptr;
                         }
                     }
                     if( lastslash != NULL )
                     {
                         savefilenameinzip = lastslash+1; // base filename follows last slash.
                     }
                 }

                 /**/
                err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
                                 NULL,0,NULL,0,NULL /* comment*/,
                                 (opt_compress_level != 0) ? Z_DEFLATED : 0,
                                 opt_compress_level,0,
                                 /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
                                 -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
                                 password,crcFile, zip64);

                if (err != ZIP_OK)
                    printf("error in opening %s in zipfile\n",filenameinzip);
                else
                } else {
                {
                    fin = FOPEN_FUNC(filenameinzip,"rb");
                    if (fin==NULL)
                    {
                        err=ZIP_ERRNO;
                        printf("error in opening %s for reading\n",filenameinzip);
                    }
                }

                    addFileToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);
                if (err == ZIP_OK)
                    do
                    {
                        err = ZIP_OK;
                        size_read = (int)fread(buf,1,size_buf,fin);
                        if (size_read < size_buf)
                            if (feof(fin)==0)
                        {
                            printf("error in reading %s\n",filenameinzip);
                            err = ZIP_ERRNO;
                        }

                        if (size_read>0)
                        {
                            err = zipWriteInFileInZip (zf,buf,size_read);
                            if (err<0)
                            {
                                printf("error in writing %s in the zipfile\n",
                                                 filenameinzip);
                            }

                        }
                    } while ((err == ZIP_OK) && (size_read>0));

                if (fin)
                    fclose(fin);

                if (err<0)
                    err=ZIP_ERRNO;
                else
                {
                    err = zipCloseFileInZip(zf);
                    if (err!=ZIP_OK)
                        printf("error in closing %s in the zipfile\n",
                                    filenameinzip);
                }
            }
        }
        errclose = zipClose(zf,NULL);
        if (errclose != ZIP_OK)
            printf("error in closing %s\n",filename_try);
    }

Added compat/zlib/contrib/minizip/tinydir.h.

















































































































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
Copyright (c) 2013-2017, tinydir authors:
- Cong Xu
- Lautis Sun
- Baudouin Feildel
- Andargor <[email protected]>
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

1. Redistributions of source code must retain the above copyright notice, this
   list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation
   and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#ifndef TINYDIR_H
#define TINYDIR_H

#ifdef __cplusplus
extern "C" {
#endif

#if ((defined _UNICODE) && !(defined UNICODE))
#define UNICODE
#endif

#if ((defined UNICODE) && !(defined _UNICODE))
#define _UNICODE
#endif

#include <errno.h>
#include <stdlib.h>
#include <string.h>
#ifdef _MSC_VER
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
# include <tchar.h>
# pragma warning(push)
# pragma warning (disable : 4996)
#else
# include <dirent.h>
# include <libgen.h>
# include <sys/stat.h>
# include <stddef.h>
#endif
#ifdef __MINGW32__
# include <tchar.h>
#endif


/* types */

/* Windows UNICODE wide character support */
#if defined _MSC_VER || defined __MINGW32__
# define _tinydir_char_t TCHAR
# define TINYDIR_STRING(s) _TEXT(s)
# define _tinydir_strlen _tcslen
# define _tinydir_strcpy _tcscpy
# define _tinydir_strcat _tcscat
# define _tinydir_strcmp _tcscmp
# define _tinydir_strrchr _tcsrchr
# define _tinydir_strncmp _tcsncmp
#else
# define _tinydir_char_t char
# define TINYDIR_STRING(s) s
# define _tinydir_strlen strlen
# define _tinydir_strcpy strcpy
# define _tinydir_strcat strcat
# define _tinydir_strcmp strcmp
# define _tinydir_strrchr strrchr
# define _tinydir_strncmp strncmp
#endif

#if (defined _MSC_VER || defined __MINGW32__)
# include <windows.h>
# define _TINYDIR_PATH_MAX MAX_PATH
#elif defined  __linux__
# include <limits.h>
# define _TINYDIR_PATH_MAX PATH_MAX
#elif defined(__unix__) || (defined(__APPLE__) && defined(__MACH__))
# include <sys/param.h>
# if defined(BSD)
#  include <limits.h>
#  define _TINYDIR_PATH_MAX PATH_MAX
# endif
#endif

#ifndef _TINYDIR_PATH_MAX
#define _TINYDIR_PATH_MAX 4096
#endif

#ifdef _MSC_VER
/* extra chars for the "\\*" mask */
# define _TINYDIR_PATH_EXTRA 2
#else
# define _TINYDIR_PATH_EXTRA 0
#endif

#define _TINYDIR_FILENAME_MAX 256

#if (defined _MSC_VER || defined __MINGW32__)
#define _TINYDIR_DRIVE_MAX 3
#endif

#ifdef _MSC_VER
# define _TINYDIR_FUNC static __inline
#elif !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L
# define _TINYDIR_FUNC static __inline__
#else
# define _TINYDIR_FUNC static inline
#endif

/* readdir_r usage; define TINYDIR_USE_READDIR_R to use it (if supported) */
#ifdef TINYDIR_USE_READDIR_R

/* readdir_r is a POSIX-only function, and may not be available under various
 * environments/settings, e.g. MinGW. Use readdir fallback */
#if _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE ||\
	_POSIX_SOURCE
# define _TINYDIR_HAS_READDIR_R
#endif
#if _POSIX_C_SOURCE >= 200112L
# define _TINYDIR_HAS_FPATHCONF
# include <unistd.h>
#endif
#if _BSD_SOURCE || _SVID_SOURCE || \
	(_POSIX_C_SOURCE >= 200809L || _XOPEN_SOURCE >= 700)
# define _TINYDIR_HAS_DIRFD
# include <sys/types.h>
#endif
#if defined _TINYDIR_HAS_FPATHCONF && defined _TINYDIR_HAS_DIRFD &&\
	defined _PC_NAME_MAX
# define _TINYDIR_USE_FPATHCONF
#endif
#if defined __MINGW32__ || !defined _TINYDIR_HAS_READDIR_R ||\
	!(defined _TINYDIR_USE_FPATHCONF || defined NAME_MAX)
# define _TINYDIR_USE_READDIR
#endif

/* Use readdir by default */
#else
# define _TINYDIR_USE_READDIR
#endif

/* MINGW32 has two versions of dirent, ASCII and UNICODE*/
#ifndef _MSC_VER
#if (defined __MINGW32__) && (defined _UNICODE)
#define _TINYDIR_DIR _WDIR
#define _tinydir_dirent _wdirent
#define _tinydir_opendir _wopendir
#define _tinydir_readdir _wreaddir
#define _tinydir_closedir _wclosedir
#else
#define _TINYDIR_DIR DIR
#define _tinydir_dirent dirent
#define _tinydir_opendir opendir
#define _tinydir_readdir readdir
#define _tinydir_closedir closedir
#endif
#endif

/* Allow user to use a custom allocator by defining _TINYDIR_MALLOC and _TINYDIR_FREE. */
#if    defined(_TINYDIR_MALLOC) &&  defined(_TINYDIR_FREE)
#elif !defined(_TINYDIR_MALLOC) && !defined(_TINYDIR_FREE)
#else
#error "Either define both alloc and free or none of them!"
#endif

#if !defined(_TINYDIR_MALLOC)
	#define _TINYDIR_MALLOC(_size) malloc(_size)
	#define _TINYDIR_FREE(_ptr)    free(_ptr)
#endif /* !defined(_TINYDIR_MALLOC) */

typedef struct tinydir_file
{
	_tinydir_char_t path[_TINYDIR_PATH_MAX];
	_tinydir_char_t name[_TINYDIR_FILENAME_MAX];
	_tinydir_char_t *extension;
	int is_dir;
	int is_reg;

#ifndef _MSC_VER
#ifdef __MINGW32__
	struct _stat _s;
#else
	struct stat _s;
#endif
#endif
} tinydir_file;

typedef struct tinydir_dir
{
	_tinydir_char_t path[_TINYDIR_PATH_MAX];
	int has_next;
	size_t n_files;

	tinydir_file *_files;
#ifdef _MSC_VER
	HANDLE _h;
	WIN32_FIND_DATA _f;
#else
	_TINYDIR_DIR *_d;
	struct _tinydir_dirent *_e;
#ifndef _TINYDIR_USE_READDIR
	struct _tinydir_dirent *_ep;
#endif
#endif
} tinydir_dir;


/* declarations */

_TINYDIR_FUNC
int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path);
_TINYDIR_FUNC
int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path);
_TINYDIR_FUNC
void tinydir_close(tinydir_dir *dir);

_TINYDIR_FUNC
int tinydir_next(tinydir_dir *dir);
_TINYDIR_FUNC
int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file);
_TINYDIR_FUNC
int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i);
_TINYDIR_FUNC
int tinydir_open_subdir_n(tinydir_dir *dir, size_t i);

_TINYDIR_FUNC
int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path);
_TINYDIR_FUNC
void _tinydir_get_ext(tinydir_file *file);
_TINYDIR_FUNC
int _tinydir_file_cmp(const void *a, const void *b);
#ifndef _MSC_VER
#ifndef _TINYDIR_USE_READDIR
_TINYDIR_FUNC
size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp);
#endif
#endif


/* definitions*/

_TINYDIR_FUNC
int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path)
{
#ifndef _MSC_VER
#ifndef _TINYDIR_USE_READDIR
	int error;
	int size;	/* using int size */
#endif
#else
	_tinydir_char_t path_buf[_TINYDIR_PATH_MAX];
#endif
	_tinydir_char_t *pathp;

	if (dir == NULL || path == NULL || _tinydir_strlen(path) == 0)
	{
		errno = EINVAL;
		return -1;
	}
	if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
	{
		errno = ENAMETOOLONG;
		return -1;
	}

	/* initialise dir */
	dir->_files = NULL;
#ifdef _MSC_VER
	dir->_h = INVALID_HANDLE_VALUE;
#else
	dir->_d = NULL;
#ifndef _TINYDIR_USE_READDIR
	dir->_ep = NULL;
#endif
#endif
	tinydir_close(dir);

	_tinydir_strcpy(dir->path, path);
	/* Remove trailing slashes */
	pathp = &dir->path[_tinydir_strlen(dir->path) - 1];
	while (pathp != dir->path && (*pathp == TINYDIR_STRING('\\') || *pathp == TINYDIR_STRING('/')))
	{
		*pathp = TINYDIR_STRING('\0');
		pathp++;
	}
#ifdef _MSC_VER
	_tinydir_strcpy(path_buf, dir->path);
	_tinydir_strcat(path_buf, TINYDIR_STRING("\\*"));
#if (defined WINAPI_FAMILY) && (WINAPI_FAMILY != WINAPI_FAMILY_DESKTOP_APP)
	dir->_h = FindFirstFileEx(path_buf, FindExInfoStandard, &dir->_f, FindExSearchNameMatch, NULL, 0);
#else
	dir->_h = FindFirstFile(path_buf, &dir->_f);
#endif
	if (dir->_h == INVALID_HANDLE_VALUE)
	{
		errno = ENOENT;
#else
	dir->_d = _tinydir_opendir(path);
	if (dir->_d == NULL)
	{
#endif
		goto bail;
	}

	/* read first file */
	dir->has_next = 1;
#ifndef _MSC_VER
#ifdef _TINYDIR_USE_READDIR
	dir->_e = _tinydir_readdir(dir->_d);
#else
	/* allocate dirent buffer for readdir_r */
	size = _tinydir_dirent_buf_size(dir->_d); /* conversion to int */
	if (size == -1) return -1;
	dir->_ep = (struct _tinydir_dirent*)_TINYDIR_MALLOC(size);
	if (dir->_ep == NULL) return -1;

	error = readdir_r(dir->_d, dir->_ep, &dir->_e);
	if (error != 0) return -1;
#endif
	if (dir->_e == NULL)
	{
		dir->has_next = 0;
	}
#endif

	return 0;

bail:
	tinydir_close(dir);
	return -1;
}

_TINYDIR_FUNC
int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path)
{
	/* Count the number of files first, to pre-allocate the files array */
	size_t n_files = 0;
	if (tinydir_open(dir, path) == -1)
	{
		return -1;
	}
	while (dir->has_next)
	{
		n_files++;
		if (tinydir_next(dir) == -1)
		{
			goto bail;
		}
	}
	tinydir_close(dir);

	if (tinydir_open(dir, path) == -1)
	{
		return -1;
	}

	dir->n_files = 0;
	dir->_files = (tinydir_file *)_TINYDIR_MALLOC(sizeof *dir->_files * n_files);
	if (dir->_files == NULL)
	{
		goto bail;
	}
	while (dir->has_next)
	{
		tinydir_file *p_file;
		dir->n_files++;

		p_file = &dir->_files[dir->n_files - 1];
		if (tinydir_readfile(dir, p_file) == -1)
		{
			goto bail;
		}

		if (tinydir_next(dir) == -1)
		{
			goto bail;
		}

		/* Just in case the number of files has changed between the first and
		second reads, terminate without writing into unallocated memory */
		if (dir->n_files == n_files)
		{
			break;
		}
	}

	qsort(dir->_files, dir->n_files, sizeof(tinydir_file), _tinydir_file_cmp);

	return 0;

bail:
	tinydir_close(dir);
	return -1;
}

_TINYDIR_FUNC
void tinydir_close(tinydir_dir *dir)
{
	if (dir == NULL)
	{
		return;
	}

	memset(dir->path, 0, sizeof(dir->path));
	dir->has_next = 0;
	dir->n_files = 0;
	_TINYDIR_FREE(dir->_files);
	dir->_files = NULL;
#ifdef _MSC_VER
	if (dir->_h != INVALID_HANDLE_VALUE)
	{
		FindClose(dir->_h);
	}
	dir->_h = INVALID_HANDLE_VALUE;
#else
	if (dir->_d)
	{
		_tinydir_closedir(dir->_d);
	}
	dir->_d = NULL;
	dir->_e = NULL;
#ifndef _TINYDIR_USE_READDIR
	_TINYDIR_FREE(dir->_ep);
	dir->_ep = NULL;
#endif
#endif
}

_TINYDIR_FUNC
int tinydir_next(tinydir_dir *dir)
{
	if (dir == NULL)
	{
		errno = EINVAL;
		return -1;
	}
	if (!dir->has_next)
	{
		errno = ENOENT;
		return -1;
	}

#ifdef _MSC_VER
	if (FindNextFile(dir->_h, &dir->_f) == 0)
#else
#ifdef _TINYDIR_USE_READDIR
	dir->_e = _tinydir_readdir(dir->_d);
#else
	if (dir->_ep == NULL)
	{
		return -1;
	}
	if (readdir_r(dir->_d, dir->_ep, &dir->_e) != 0)
	{
		return -1;
	}
#endif
	if (dir->_e == NULL)
#endif
	{
		dir->has_next = 0;
#ifdef _MSC_VER
		if (GetLastError() != ERROR_SUCCESS &&
			GetLastError() != ERROR_NO_MORE_FILES)
		{
			tinydir_close(dir);
			errno = EIO;
			return -1;
		}
#endif
	}

	return 0;
}

_TINYDIR_FUNC
int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file)
{
	if (dir == NULL || file == NULL)
	{
		errno = EINVAL;
		return -1;
	}
#ifdef _MSC_VER
	if (dir->_h == INVALID_HANDLE_VALUE)
#else
	if (dir->_e == NULL)
#endif
	{
		errno = ENOENT;
		return -1;
	}
	if (_tinydir_strlen(dir->path) +
		_tinydir_strlen(
#ifdef _MSC_VER
			dir->_f.cFileName
#else
			dir->_e->d_name
#endif
		) + 1 + _TINYDIR_PATH_EXTRA >=
		_TINYDIR_PATH_MAX)
	{
		/* the path for the file will be too long */
		errno = ENAMETOOLONG;
		return -1;
	}
	if (_tinydir_strlen(
#ifdef _MSC_VER
			dir->_f.cFileName
#else
			dir->_e->d_name
#endif
		) >= _TINYDIR_FILENAME_MAX)
	{
		errno = ENAMETOOLONG;
		return -1;
	}

	_tinydir_strcpy(file->path, dir->path);
	_tinydir_strcat(file->path, TINYDIR_STRING("/"));
	_tinydir_strcpy(file->name,
#ifdef _MSC_VER
		dir->_f.cFileName
#else
		dir->_e->d_name
#endif
	);
	_tinydir_strcat(file->path, file->name);
#ifndef _MSC_VER
#ifdef __MINGW32__
	if (_tstat(
#else
	if (stat(
#endif
		file->path, &file->_s) == -1)
	{
		return -1;
	}
#endif
	_tinydir_get_ext(file);

	file->is_dir =
#ifdef _MSC_VER
		!!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
#else
		S_ISDIR(file->_s.st_mode);
#endif
	file->is_reg =
#ifdef _MSC_VER
		!!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NORMAL) ||
		(
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DEVICE) &&
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) &&
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_ENCRYPTED) &&
#ifdef FILE_ATTRIBUTE_INTEGRITY_STREAM
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_INTEGRITY_STREAM) &&
#endif
#ifdef FILE_ATTRIBUTE_NO_SCRUB_DATA
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NO_SCRUB_DATA) &&
#endif
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_OFFLINE) &&
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_TEMPORARY));
#else
		S_ISREG(file->_s.st_mode);
#endif

	return 0;
}

_TINYDIR_FUNC
int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i)
{
	if (dir == NULL || file == NULL)
	{
		errno = EINVAL;
		return -1;
	}
	if (i >= dir->n_files)
	{
		errno = ENOENT;
		return -1;
	}

	memcpy(file, &dir->_files[i], sizeof(tinydir_file));
	_tinydir_get_ext(file);

	return 0;
}

_TINYDIR_FUNC
int tinydir_open_subdir_n(tinydir_dir *dir, size_t i)
{
	_tinydir_char_t path[_TINYDIR_PATH_MAX];
	if (dir == NULL)
	{
		errno = EINVAL;
		return -1;
	}
	if (i >= dir->n_files || !dir->_files[i].is_dir)
	{
		errno = ENOENT;
		return -1;
	}

	_tinydir_strcpy(path, dir->_files[i].path);
	tinydir_close(dir);
	if (tinydir_open_sorted(dir, path) == -1)
	{
		return -1;
	}

	return 0;
}

/* Open a single file given its path */
_TINYDIR_FUNC
int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path)
{
	tinydir_dir dir;
	int result = 0;
	int found = 0;
	_tinydir_char_t dir_name_buf[_TINYDIR_PATH_MAX];
	_tinydir_char_t file_name_buf[_TINYDIR_FILENAME_MAX];
	_tinydir_char_t *dir_name;
	_tinydir_char_t *base_name;
#if (defined _MSC_VER || defined __MINGW32__)
	_tinydir_char_t drive_buf[_TINYDIR_PATH_MAX];
	_tinydir_char_t ext_buf[_TINYDIR_FILENAME_MAX];
#endif

	if (file == NULL || path == NULL || _tinydir_strlen(path) == 0)
	{
		errno = EINVAL;
		return -1;
	}
	if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
	{
		errno = ENAMETOOLONG;
		return -1;
	}

	/* Get the parent path */
#if (defined _MSC_VER || defined __MINGW32__)
#if ((defined _MSC_VER) && (_MSC_VER >= 1400))
		_tsplitpath_s(
			path,
			drive_buf, _TINYDIR_DRIVE_MAX,
			dir_name_buf, _TINYDIR_FILENAME_MAX,
			file_name_buf, _TINYDIR_FILENAME_MAX,
			ext_buf, _TINYDIR_FILENAME_MAX);
#else
		_tsplitpath(
			path,
			drive_buf,
			dir_name_buf,
			file_name_buf,
			ext_buf);
#endif

/* _splitpath_s not work fine with only filename and widechar support */
#ifdef _UNICODE
		if (drive_buf[0] == L'\xFEFE')
			drive_buf[0] = '\0';
		if (dir_name_buf[0] == L'\xFEFE')
			dir_name_buf[0] = '\0';
#endif

	if (errno)
	{
		errno = EINVAL;
		return -1;
	}
	/* Emulate the behavior of dirname by returning "." for dir name if it's
	empty */
	if (drive_buf[0] == '\0' && dir_name_buf[0] == '\0')
	{
		_tinydir_strcpy(dir_name_buf, TINYDIR_STRING("."));
	}
	/* Concatenate the drive letter and dir name to form full dir name */
	_tinydir_strcat(drive_buf, dir_name_buf);
	dir_name = drive_buf;
	/* Concatenate the file name and extension to form base name */
	_tinydir_strcat(file_name_buf, ext_buf);
	base_name = file_name_buf;
#else
	_tinydir_strcpy(dir_name_buf, path);
	dir_name = dirname(dir_name_buf);
	_tinydir_strcpy(file_name_buf, path);
	base_name =basename(file_name_buf);
#endif

	/* Open the parent directory */
	if (tinydir_open(&dir, dir_name) == -1)
	{
		return -1;
	}

	/* Read through the parent directory and look for the file */
	while (dir.has_next)
	{
		if (tinydir_readfile(&dir, file) == -1)
		{
			result = -1;
			goto bail;
		}
		if (_tinydir_strcmp(file->name, base_name) == 0)
		{
			/* File found */
			found = 1;
			break;
		}
		tinydir_next(&dir);
	}
	if (!found)
	{
		result = -1;
		errno = ENOENT;
	}

bail:
	tinydir_close(&dir);
	return result;
}

_TINYDIR_FUNC
void _tinydir_get_ext(tinydir_file *file)
{
	_tinydir_char_t *period = _tinydir_strrchr(file->name, TINYDIR_STRING('.'));
	if (period == NULL)
	{
		file->extension = &(file->name[_tinydir_strlen(file->name)]);
	}
	else
	{
		file->extension = period + 1;
	}
}

_TINYDIR_FUNC
int _tinydir_file_cmp(const void *a, const void *b)
{
	const tinydir_file *fa = (const tinydir_file *)a;
	const tinydir_file *fb = (const tinydir_file *)b;
	if (fa->is_dir != fb->is_dir)
	{
		return -(fa->is_dir - fb->is_dir);
	}
	return _tinydir_strncmp(fa->name, fb->name, _TINYDIR_FILENAME_MAX);
}

#ifndef _MSC_VER
#ifndef _TINYDIR_USE_READDIR
/*
The following authored by Ben Hutchings <[email protected]>
from https://womble.decadent.org.uk/readdir_r-advisory.html
*/
/* Calculate the required buffer size (in bytes) for directory      *
* entries read from the given directory handle.  Return -1 if this  *
* this cannot be done.                                              *
*                                                                   *
* This code does not trust values of NAME_MAX that are less than    *
* 255, since some systems (including at least HP-UX) incorrectly    *
* define it to be a smaller value.                                  */
_TINYDIR_FUNC
size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp)
{
	long name_max;
	size_t name_end;
	/* parameter may be unused */
	(void)dirp;

#if defined _TINYDIR_USE_FPATHCONF
	name_max = fpathconf(dirfd(dirp), _PC_NAME_MAX);
	if (name_max == -1)
#if defined(NAME_MAX)
		name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
#else
		return (size_t)(-1);
#endif
#elif defined(NAME_MAX)
 	name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
#else
#error "buffer size for readdir_r cannot be determined"
#endif
	name_end = (size_t)offsetof(struct _tinydir_dirent, d_name) + name_max + 1;
	return (name_end > sizeof(struct _tinydir_dirent) ?
		name_end : sizeof(struct _tinydir_dirent));
}
#endif
#endif

#ifdef __cplusplus
}
#endif

# if defined (_MSC_VER)
# pragma warning(pop)
# endif

#endif

Changes to doc/CrtObjCmd.3.

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18










-
+







'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj, Tcl_RegisterCommandTypeName, Tcl_GetCommandTypeName \- implement new commands in C
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_CreateObjCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
.sp
38
39
40
41
42
43
44








45
46
47
48
49
50
51
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59







+
+
+
+
+
+
+
+







\fBTcl_GetCommandName\fR(\fIinterp, token\fR)
.sp
void
\fBTcl_GetCommandFullName\fR(\fIinterp, token, objPtr\fR)
.sp
Tcl_Command
\fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR)
.sp
.VS "info cmdtype feature"
void
\fBTcl_RegisterCommandTypeName\fR(\fIproc, typeName\fR)
.sp
const char *
\fBTcl_GetCommandTypeName\fR(\fItoken\fR)
.VE "info cmdtype feature"
.SH ARGUMENTS
.AS Tcl_CmdDeleteProc *deleteProc in/out
.AP Tcl_Interp *interp in
Interpreter in which to create a new command or that contains a command.
.AP char *cmdName in
Name of command.
.AP Tcl_ObjCmdProc *proc in
61
62
63
64
65
66
67



68
69
70
71
72
73
74
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85







+
+
+







Token for command, returned by previous call to \fBTcl_CreateObjCommand\fR.
The command must not have been deleted.
.AP Tcl_CmdInfo *infoPtr in/out
Pointer to structure containing various information about a
Tcl command.
.AP Tcl_Obj *objPtr in
Value containing the name of a Tcl command.
.AP "const char" *typeName in
Indicates the name of the type of command implementation associated
with a particular \fIproc\fR, or NULL to break the association.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CreateObjCommand\fR defines a new command in \fIinterp\fR
and associates it with procedure \fIproc\fR
such that whenever \fIname\fR is
invoked as a Tcl command (e.g., via a call to \fBTcl_EvalObjEx\fR)
292
293
294
295
296
297
298
















299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




The name, including all namespace prefixes,
is appended to the value specified by \fIobjPtr\fR.
.PP
\fBTcl_GetCommandFromObj\fR returns a token for the command
specified by the name in a \fBTcl_Obj\fR.
The command name is resolved relative to the current namespace.
Returns NULL if the command is not found.
.PP
.VS "info cmdtype feature"
\fBTcl_RegisterCommandTypeName\fR is used to associate a name (the
\fItypeName\fR argument) with a particular implementation function so that it
can then be looked up with \fBTcl_GetCommandTypeName\fR, which in turn is
called with a command token that information is wanted for and which returns
the name of the type that was registered for the implementation function used
for that command. (The lookup functionality is surfaced virtually directly in Tcl via
\fBinfo cmdtype\fR.) If there is no function registered for a particular
function, the result will be the string literal
.QW \fBnative\fR .
The registration of a name can be undone by registering a mapping to NULL
instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that
string which was registered, and not a copy; use of a compile-time constant
string is \fIstrongly recommended\fR.
.VE "info cmdtype feature"
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3)
.SH KEYWORDS
bind, command, create, delete, namespace, value

Changes to doc/Encoding.3.

256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
256
257
258
259
260
261
262




263
264
265
266
267
268
269







-
-
-
-







\fBTcl_ExternalToUtf\fR.
.PP
\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR are
Windows-only convenience
functions for converting between UTF-8 and Windows strings
based on the TCHAR type which is by convention
a Unicode character on Windows NT.
These functions are essentially wrappers around
\fBTcl_UtfToExternalDString\fR and
\fBTcl_ExternalToUtfDString\fR that convert to and from the
Unicode encoding.
.PP
\fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR.
Given an \fIencoding\fR, the return value is the \fIname\fR argument that
was used to create the encoding.  The string returned by
\fBTcl_GetEncodingName\fR is only guaranteed to persist until the
\fIencoding\fR is deleted.  The caller must not modify this string.
.PP

Changes to doc/Eval.3.

172
173
174
175
176
177
178
179

180
181
182



183
184
185
186
187
188
189
172
173
174
175
176
177
178

179



180
181
182
183
184
185
186
187
188
189







-
+
-
-
-
+
+
+







\fBTCL_EVAL_DIRECT\fR flag is useful in situations where the
contents of a value are going to change immediately, so the
bytecodes will not be reused in a future execution.  In this case,
it is faster to execute the script directly.
.TP 23
\fBTCL_EVAL_GLOBAL\fR
.
If this flag is set, the script is processed at global level.  This
If this flag is set, the script is evaluated in the global namespace instead of
means that it is evaluated in the global namespace and its variable
context consists of global variables only (it ignores any Tcl
procedures that are active).
the current namespace and its variable context consists of global variables
only (it ignores any Tcl procedures that are active).
.\" TODO: document TCL_EVAL_INVOKE and TCL_EVAL_NOERR.

.SH "MISCELLANEOUS DETAILS"
.PP
During the processing of a Tcl command it is legal to make nested
calls to evaluate other commands (this is how procedures and
some control structures are implemented).
If a code other than \fBTCL_OK\fR is returned

Changes to doc/GetInt.3.

60
61
62
63
64
65
66



67
68
69


70
71
72
73
74
75
76
60
61
62
63
64
65
66
67
68
69
70


71
72
73
74
75
76
77
78
79







+
+
+

-
-
+
+







.QW \fB0d\fR
then \fIsrc\fR is expected to be in decimal form; otherwise,
if the first such characters are
.QW \fB0o\fR
then \fIsrc\fR is expected to be in octal form;  otherwise,
if the first such characters are
.QW \fB0b\fR
then \fIsrc\fR is expected to be in binary form;  otherwise,
if the first such character is
.QW \fB0\fR
then \fIsrc\fR
is expected to be in binary form;  otherwise, \fIsrc\fR is
expected to be in decimal form.
is expected to be in octal form;  otherwise, \fIsrc\fR
is expected to be in decimal form.
.PP
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
number, which is:  white space;  a sign; a sequence of digits;  a
decimal point
.QW \fB.\fR ;
a sequence of digits;  the letter
.QW \fBe\fR ;

Changes to doc/IntObj.3.

93
94
95
96
97
98
99
100

101
102
103
104
105
106
107
93
94
95
96
97
98
99

100
101
102
103
104
105
106
107







-
+







with which values might be exchanged.  The C integral types for which Tcl
provides value exchange routines are \fBint\fR, \fBlong int\fR,
\fBTcl_WideInt\fR, and \fBmp_int\fR.  The \fBint\fR and \fBlong int\fR types
are provided by the C language standard.  The \fBTcl_WideInt\fR type is a
typedef defined to be whatever signed integral type covers at least the
64-bit integer range (-9223372036854775808 to 9223372036854775807).  Depending
on the platform and the C compiler, the actual type might be
\fBlong int\fR, \fBlong long int\fR, \fB__int64\fR, or something else.
\fBlong long int\fR, \fB__int64\fR, or something else.
The \fBmp_int\fR type is a multiple-precision integer type defined
by the LibTomMath multiple-precision integer library.
.PP
The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR,
and \fBTcl_NewBignumObj\fR routines each create and return a new
Tcl value initialized to the integral value of the argument.  The
returned Tcl value is unshared.

Changes to doc/Interp.3.

29
30
31
32
33
34
35













36
37
38
39
40
41
42
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55







+
+
+
+
+
+
+
+
+
+
+
+
+







structure.  Callers of \fBTcl_CreateInterp\fR should use this pointer
as an opaque token, suitable for nothing other than passing back to
other routines in the Tcl interface.  Accessing fields directly through
the pointer as described below is no longer supported.  The supported
public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR,
\fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead.
.PP
For legacy programs and extensions no longer being maintained, compiles
against the Tcl 8.6 header files are only possible with the compiler
directives
.CS
#define USE_INTERP_RESULT
.CE
and/or
.CS
#define USE_INTERP_ERRORLINE
.CE
depending on which fields of the \fBTcl_Interp\fR struct are accessed.
These directives may be embedded in code or supplied via compiler options.
.PP
The \fIresult\fR and \fIfreeProc\fR fields are used to return
results or error messages from commands.
This information is returned by command procedures back to \fBTcl_Eval\fR,
and by \fBTcl_Eval\fR back to its callers.
The \fIresult\fR field points to the string that represents the
result or error message, and the \fIfreeProc\fR field tells how
to dispose of the storage for the string when it is not needed anymore.
84
85
86
87
88
89
90
91

92
93
94
95
96
97
98
97
98
99
100
101
102
103

104
105
106
107
108
109
110
111







-
+







As part of processing each command, \fBTcl_Eval\fR initializes
\fIinterp->result\fR
and \fIinterp->freeProc\fR just before calling the command procedure for
the command.  The \fIfreeProc\fR field will be initialized to zero,
and \fIinterp->result\fR will point to an empty string.  Commands that
do not return any value can simply leave the fields alone.
Furthermore, the empty string pointed to by \fIresult\fR is actually
part of an array of \fBTCL_RESULT_SIZE\fR characters (approximately 200).
part of an array of approximately 200 characters.
If a command wishes to return a short string, it can simply copy
it to the area pointed to by \fIinterp->result\fR.  Or, it can use
the sprintf procedure to generate a short result string at the location
pointed to by \fIinterp->result\fR.
.PP
It is a general convention in Tcl-based applications that the result
of an interpreter is normally in the initialized state described

Changes to doc/Method.3.

1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19


20
21
22
23


24
25
26
27
28
29
30
31
32
33
34
35
36
37

38
39




40
41
42
43
44
45
46
1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17


18
19
20
21


22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51











-
+





-
-
+
+


-
-
+
+














+


+
+
+
+







'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Method 3 0.1 TclOO "TclOO Library Functions"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsPrivate, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
.SH SYNOPSIS
.nf
\fB#include <tclOO.h>\fR
.sp
Tcl_Method
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, isPublic,
              methodTypePtr, clientData\fR)
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, flags, methodTypePtr,
              clientData\fR)
.sp
Tcl_Method
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, isPublic,
                      methodTypePtr, clientData\fR)
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, flags, methodTypePtr,
                      clientData\fR)
.sp
\fBTcl_ClassSetConstructor\fR(\fIinterp, class, method\fR)
.sp
\fBTcl_ClassSetDestructor\fR(\fIinterp, class, method\fR)
.sp
Tcl_Class
\fBTcl_MethodDeclarerClass\fR(\fImethod\fR)
.sp
Tcl_Object
\fBTcl_MethodDeclarerObject\fR(\fImethod\fR)
.sp
Tcl_Obj *
\fBTcl_MethodName\fR(\fImethod\fR)
.sp
.VS TIP500
int
\fBTcl_MethodIsPublic\fR(\fImethod\fR)
.VE TIP500
.sp
int
\fBTcl_MethodIsPrivate\fR(\fImethod\fR)
.sp
int
\fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR)
.sp
int
\fBTcl_ObjectContextInvokeNext\fR(\fIinterp, context, objc, objv, skip\fR)
.sp
62
63
64
65
66
67
68
69
70
71
72









73
74
75
76
77
78
79
67
68
69
70
71
72
73




74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89







-
-
-
-
+
+
+
+
+
+
+
+
+







.AP Tcl_Object object in
The object to create the method in.
.AP Tcl_Class class in
The class to create the method in.
.AP Tcl_Obj *nameObj in
The name of the method to create. Should not be NULL unless creating
constructors or destructors.
.AP int isPublic in
A flag saying what the visibility of the method is. The only supported public
values of this flag are 0 for a non-exported method, and 1 for an exported
method.
.AP int flags in
A flag saying (currently) what the visibility of the method is. The supported
public values of this flag are \fBTCL_OO_METHOD_PUBLIC\fR (which is fixed at 1
for backward compatibility) for an exported method,
\fBTCL_OO_METHOD_UNEXPORTED\fR (which is fixed at 0 for backward
compatibility) for a non-exported method,
.VS TIP500
and \fBTCL_OO_METHOD_PRIVATE\fR for a private method.
.VE TIP500
.AP Tcl_MethodType *methodTypePtr in
A description of the type of the method to create, or the type of method to
compare against.
.AP ClientData clientData in
A piece of data that is passed to the implementation of the method without
interpretation.
.AP ClientData *clientDataPtr out
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
128
111
112
113
114
115
116
117


118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133


134
135
136
137
138
139
140
141
142
143
144
145
146







-
-
+
+
+
+
+
+










-
-
+
+
+
+
+
+







that class.
.PP
Given a method, the entity that declared it can be found using
\fBTcl_MethodDeclarerClass\fR which returns the class that the method is
attached to (or NULL if the method is not attached to any class) and
\fBTcl_MethodDeclarerObject\fR which returns the object that the method is
attached to (or NULL if the method is not attached to an object). The name of
the method can be retrieved with \fBTcl_MethodName\fR and whether the method
is exported is retrieved with \fBTcl_MethodIsPublic\fR. The type of the method
the method can be retrieved with \fBTcl_MethodName\fR, whether the method
is exported is retrieved with \fBTcl_MethodIsPublic\fR,
.VS TIP500
and whether the method is private is retrieved with \fBTcl_MethodIsPrivate\fR.
.VE TIP500
The type of the method
can also be introspected upon to a limited degree; the function
\fBTcl_MethodIsType\fR returns whether a method is of a particular type,
assigning the per-method \fIclientData\fR to the variable pointed to by
\fIclientDataPtr\fR if (that is non-NULL) if the type is matched.
.SS "METHOD CREATION"
.PP
Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR,
which
create a method attached to a class or an object respectively. In both cases,
the \fInameObj\fR argument gives the name of the method to create, the
\fIisPublic\fR argument states whether the method should be exported
initially, the \fImethodTypePtr\fR argument describes the implementation of
\fIflags\fR argument states whether the method should be exported
initially
.VS TIP500
or be marked as a private method,
.VE TIP500
the \fImethodTypePtr\fR argument describes the implementation of
the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR
argument gives some implementation-specific data that is passed on to the
implementation of the method when it is called.
.PP
When the \fInameObj\fR argument to \fBTcl_NewMethod\fR is NULL, an
unnamed method is created, which is used for constructors and destructors.
Constructors should be installed into their class using the

Changes to doc/NRE.3.

1
2

3
4
5
6
7
8
9
1
2
3
4
5
6
7
8
9
10


+







.\"
.\" Copyright (c) 2008 by Kevin B. Kenny.
.\" Copyright (c) 2018 by Nathan Coulter.
.\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH NRE 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
34
35
36
37
38
39
40
41

42
43

44
45
46




47
48
49

50
51
52


53
54
55


56
57
58

59
60
61

62
63

64

65

66
67
68
69
70
71


72
73
74


75
76

77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163


164
165
166
167
168
169


170
171
172


173
174

175
176
177
178

179
180
181
182
183
184
185
186
187
188
189
190
191

192
193
194
195

196
197
198
199

200
201
202
203
204
205

206

207
208
209
210
211
212
213
35
36
37
38
39
40
41

42
43

44
45


46
47
48
49
50


51
52


53
54
55


56
57

58

59
60


61
62

63
64
65

66



67


68
69
70


71
72
73

74

75
76
77
78
79
80
81
82
83




84
85
86
87
88
89
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




128
129
130
131
132
133
134
135
136
137




138




139




140



141
142

143

144
145
146
147
148
149
150
151







-
+

-
+

-
-
+
+
+
+

-
-
+

-
-
+
+

-
-
+
+
-

-
+

-
-
+

-
+

+
-
+
-
-
-

-
-
+
+

-
-
+
+

-
+
-









-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
+
+

-
-
-
-
-
-
-
-
+
-
-
-
-
-

-
+
-
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-

-
-
-
-
-
-
+
+

-
+
-
-
-
+
-
-
-
+
+
-
-

-
+
-
-
-
-
+
+
-
-
-

-
-
+
+
-
-
-
+
+

-
+
-
-
-
-
+









-
-
-
-
+
-
-
-
-
+
-
-
-
-
+
-
-
-


-
+
-
+







.sp
void
\fBTcl_NRAddCallback\fR(\fIinterp, postProcPtr, data0, data1, data2, data3\fR)
.fi
.SH ARGUMENTS
.AS Tcl_CmdDeleteProc *interp in
.AP Tcl_Interp *interp in
Interpreter in which to create or evaluate a command.
The relevant Interpreter.
.AP char *cmdName in
Name of a new command to create.
Name of the command to create.
.AP Tcl_ObjCmdProc *proc in
Implementation of a command that will be called whenever \fIcmdName\fR
is invoked as a command in the unoptimized way.
Called in order to evaluate a command.  Is often just a small wrapper that uses
\fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline.  Behaves
in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3)
(\fIq.v.\fR).
.AP Tcl_ObjCmdProc *nreProc in
Implementation of a command that will be called whenever \fIcmdName\fR
is invoked and requested to conserve the C stack.
Called instead of \fIproc\fR when a trampoline is already in use.
.AP ClientData clientData in
Arbitrary one-word value that will be passed to \fIproc\fR, \fInreProc\fR,
\fIdeleteProc\fR and \fIobjProc\fR.
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
and \fIobjProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in/out
Procedure to call before \fIcmdName\fR is deleted from the interpreter.
This procedure allows for command-specific cleanup. If \fIdeleteProc\fR
Called before \fIcmdName\fR is deleted from the interpreter, allowing for
command-specific cleanup. May be NULL.
is \fBNULL\fR, then no procedure is called before the command is deleted.
.AP int objc in
Count of parameters provided to the implementation of a command.
Number of items in \fIobjv\fR.
.AP Tcl_Obj **objv in
Pointer to an array of Tcl values. Each value holds the value of a
single word in the command to execute.
Words in the command.
.AP Tcl_Obj *objPtr in
Pointer to a Tcl_Obj whose value is a script or expression to execute.
A script or expression to evaluate.
.AP int flags in
As described for \fITcl_EvalObjv\fR.
ORed combination of flag bits that specify additional options.
.PP
\fBTCL_EVAL_GLOBAL\fR is the only flag that is currently supported.
.\" TODO: This is a lie. But kbk didn't grasp TCL_EVAL_INVOKE and
.\"       TCL_EVAL_NOERR well enough to document them.
.AP Tcl_Command cmd in
Token for a command that is to be used instead of the currently
executing command.
Token to use instead of one derived from the first word of \fIobjv\fR in order
to evaluate a command.
.AP Tcl_Obj *resultPtr out
Pointer to an unshared Tcl_Obj where the result of expression
evaluation is written.
Pointer to an unshared Tcl_Obj where the result of the evaluation is stored if
the return code is TCL_OK.
.AP Tcl_NRPostProc *postProcPtr in
Pointer to a function that will be invoked when the command currently
A function to push.
executing in the interpreter designated by \fIinterp\fR completes.
.AP ClientData data0 in
.AP ClientData data1 in
.AP ClientData data2 in
.AP ClientData data3 in
\fIdata0\fR through \fIdata3\fR are four one-word values that will be passed
to the function designated by \fIpostProcPtr\fR when it is invoked.
.BE
.SH DESCRIPTION
.PP
This series of C functions provides an interface whereby commands that
are implemented in C can be evaluated, and invoke Tcl commands scripts
and scripts, without consuming space on the C stack. The non-recursive
evaluation is done by installing a \fItrampoline\fR, a small piece of
These functions provide an interface to the function stack that an interpreter
iterates through to evaluate commands.  The routine behind a command is
implemented by an initial function and any additional functions that the
routine pushes onto the stack as it progresses.  The interpreter itself pushes
functions onto the stack to react to the end of a routine and to exercise other
forms of control such as switching between in-progress stacks and the
evaluation of other scripts at additional levels without adding frames to the C
stack.  To execute a routine, the initial function for the routine is called
and then a small bit of code called a \fItrampoline\fR iteratively takes
code that invokes a command or script, and then executes a series of
callbacks when the command or script returns.
functions off the stack and calls them, using the value of the last call as the
value of the routine.
.PP
The \fBTcl_NRCreateCommand\fR function creates a Tcl command in the
interpreter designated by \fIinterp\fR that is prepared to handle
nonrecursive evaluation with a trampoline. The \fIcmdName\fR argument
gives the name of the new command. If \fIcmdName\fR contains any
namespace qualifiers, then the new command is added to the specified
namespace; otherwise, it is added to the global namespace. \fIproc\fR
gives the procedure that will be called when the interpreter wishes to
evaluate the command in an unoptimized manner, and \fInreProc\fR is
\fBTcl_NRCallObjProc\fR calls \fInreProc\fR using a new trampoline.
the procedure that will be called when the interpreter wishes to
evaluate the command using a trampoline. \fIdeleteProc\fR is a
function that will be called before the command is deleted from the
interpreter. When any of the three functions is invoked, it is passed
the \fIclientData\fR parameter.
.PP
\fBTcl_NRCreateCommand\fR deletes any existing command
\fBTcl_NRCreateCommand\fR, an alternative to \fBTcl_CreateObjCommand\fR,
\fIname\fR already associated with the interpreter
(however see below for an exception where the existing command
is not deleted).
It returns a token that may be used to refer
to the command in subsequent calls to \fBTcl_GetCommandName\fR.
resolves \fIcmdName\fR, which may contain namespace qualifiers, relative to the
current namespace, creates a command by that name, and returns a token for the
command which may be used in subsequent calls to \fBTcl_GetCommandName\fR.
If \fBTcl_NRCreateCommand\fR is called for an interpreter that is in
the process of being deleted, then it does not create a new command,
does not delete any existing command of the same name, and returns NULL.
Except for a few cases noted below any existing command by the same name is
.PP
The \fIproc\fR and \fInreProc\fR function are expected to conform to
all the rules set forth for the \fIproc\fR argument to
\fBTcl_CreateObjCommand\fR(3) (\fIq.v.\fR).
.PP
When a command that is written to cope with evaluation via trampoline
is invoked without a trampoline on the stack, it will usually respond
to the invocation by creating a trampoline and calling the
trampoline-enabled implementation of the same command. This call is done by
means of \fBTcl_NRCallObjProc\fR. In the call to
\fBTcl_NRCallObjProc\fR, the \fIinterp\fR, \fIclientData\fR,
\fIobjc\fR and \fIobjv\fR parameters should be the same ones that were
passed to \fIproc\fR. The \fInreProc\fR parameter should designate the
trampoline-enabled implementation of the command.
.PP
\fBTcl_NREvalObj\fR arranges for the script contained in \fIobjPtr\fR
to be evaluated in the interpreter designated by \fIinterp\fR after
the current command (which must be trampoline-enabled) returns. It is
the method by which a command may invoke a script without consuming
space on the C stack. Similarly, \fBTcl_NREvalObjv\fR arranges to
first deleted.  If \fIinterp\fR is in the process of being deleted
\fBTcl_NRCreateCommand\fR does not create any command, does not delete any
command, and returns NULL.
.PP
\fBTcl_NREvalObj\fR pushes a function that is like \fBTcl_EvalObjEx\fR but
consumes no space on the C stack.
invoke a single Tcl command whose words have already been separated
and substituted. The \fIobjc\fR and \fIobjv\fR parameters give the
words of the command to be evaluated when execution reaches the
trampoline.
.PP
\fBTcl_NRCmdSwap\fR allows for trampoline evaluation of a command whose
resolution is already known.  The \fIcmd\fR parameter gives a
\fBTcl_Command\fR token (returned from \fBTcl_CreateObjCommand\fR or
\fBTcl_GetCommandFromObj\fR) identifying the command to be invoked in
the trampoline; this command must match the word in \fIobjv[0]\fR.
The remaining arguments are as for \fBTcl_NREvalObjv\fR.
\fBTcl_NREvalObjv\fR pushes a function that is like \fBTcl_EvalObjv\fR but
consumes no space on the C stack.
.PP
\fBTcl_NREvalObj\fR, \fBTcl_NREvalObjv\fR and \fBTcl_NRCmdSwap\fR
\fBTcl_NRCmdSwap\fR is like \fBTcl_NREvalObjv\fR, but uses \fIcmd\fR, a token
all accept a \fIflags\fR parameter, which is an OR-ed-together set of
bits to control evaluation. At the present time, the only supported flag
available to callers is \fBTCL_EVAL_GLOBAL\fR.
previously returned by \fBTcl_CreateObjCommand\fR or
.\" TODO: Again, this is a lie. Do we want to explain TCL_EVAL_INVOKE
.\"       and TCL_EVAL_NOERR?
If the \fBTCL_EVAL_GLOBAL\fR flag is set, the script or command is
\fBTcl_GetCommandFromObj\fR, instead of resolving the first word of \fIobjv\fR.
.  The name of this command must be the same as \fIobjv[0]\fR.
evaluated in the global namespace. If it is not set, it is evaluated
in the current namespace.
.PP
\fBTcl_NRExprObj\fR arranges for the expression contained in \fIobjPtr\fR
\fBTcl_NRExprObj\fR pushes a function that evaluates \fIobjPtr\fR as an
to be evaluated in the interpreter designated by \fIinterp\fR after
the current command (which must be trampoline-enabled) returns. It is
the method by which a command may evaluate a Tcl expression without consuming
space on the C stack.  The argument \fIresultPtr\fR is a pointer to an
expression in the same manner as \fBTcl_ExprObj\fR but without consuming space
on the C stack.
unshared Tcl_Obj where the result of expression evaluation is to be written.
If expression evaluation returns any code other than TCL_OK, the
\fIresultPtr\fR value is left untouched.
.PP
All of the routines return \fBTCL_OK\fR if command or expression invocation
has been scheduled successfully. If for any reason the scheduling cannot
All of the functions return \fBTCL_OK\fR if the evaluation of the script,
command, or expression has been scheduled successfully.  Otherwise (for example
be completed (for example, if the interpreter is unable to find
the requested command), they return \fBTCL_ERROR\fR with an
appropriate message left in the interpreter's result.
if the command name cannot be resolved), they return \fBTCL_ERROR\fR and store
a message as the interpreter's result.
.PP
\fBTcl_NRAddCallback\fR arranges to have a C function called when the
\fBTcl_NRAddCallback\fR pushes \fIpostProcPtr\fR.  The signature for
current trampoline-enabled command in the Tcl interpreter designated
by \fIinterp\fR returns.  The \fIpostProcPtr\fR argument is a pointer
to the callback function, which must have arguments and return value
consistent with the \fBTcl_NRPostProc\fR data type:
\fBTcl_NRPostProc\fR is:
.PP
.CS
typedef int
\fBTcl_NRPostProc\fR(
        \fBClientData\fR \fIdata\fR[],
        \fBTcl_Interp\fR *\fIinterp\fR,
        int \fIresult\fR);
.CE
.PP
When the trampoline invokes the callback function, the \fIdata\fR
parameter will point to an array containing the four one-word
quantities that were passed to \fBTcl_NRAddCallback\fR in the
\fIdata0\fR through \fIdata3\fR parameters. The Tcl interpreter will
\fIdata\fR is a pointer to an array containing \fIdata0\fR through \fIdata3\fR.
be designated by the \fIinterp\fR parameter, and the \fIresult\fR
parameter will contain the result (\fBTCL_OK\fR, \fBTCL_ERROR\fR,
\fBTCL_RETURN\fR, \fBTCL_BREAK\fR or \fBTCL_CONTINUE\fR) that was
returned by the command evaluation. The callback function is expected,
\fIresult\fR is the value returned by the previous function implementing part
in turn, either to return a \fIresult\fR to control further evaluation.
.PP
Multiple \fBTcl_NRAddCallback\fR invocations may request multiple
callbacks, which may be to the same or different callback
the routine.
functions. If multiple callbacks are requested, they are executed in
last-in, first-out order, that is, the most recently requested
callback is executed first.
.SH EXAMPLE
.PP
The usual pattern for Tcl commands that invoke other Tcl commands
The following command uses \fBTcl_EvalObjEx\fR, which consumes space on the C
is something like:
stack, to evalute a script:
.PP
.CS
int
\fITheCmdOldObjProc\fR(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
224
225
226
227
228
229
230
231
232


233
234
235
236



237
238


239
240
241
242
243
244
245
246
247
248
249
250
251
252

253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
162
163
164
165
166
167
168


169
170




171
172
173


174
175







176



177
178

179
180
181
182
183
184
185
186
187
188
189



190
191
192
193
194
195
196







-
-
+
+
-
-
-
-
+
+
+
-
-
+
+
-
-
-
-
-
-
-

-
-
-


-
+










-
-
-








    return result;
}
\fBTcl_CreateObjCommand\fR(interp, "theCommand",
        \fITheCmdOldObjProc\fR, clientData, TheCmdDeleteProc);
.CE
.PP
To enable a command like this one for trampoline-based evaluation,
it must be split into three pieces:
To avoid consuming space on the C stack, \fITheCmdOldObjProc\fR is renamed to
\fITheCmdNRObjProc\fR and the postprocessing step is split into a separate
.IP \(bu
A non-trampoline implementation, \fITheCmdNewObjProc\fR,
which will simply create a trampoline
and invoke the trampoline-based implementation.
function, \fITheCmdPostProc\fR, which is pushed onto the function stack.
\fITcl_EvalObjEx\fR is replaced with \fITcl_NREvalObj\fR, which uses a
trampoline instead of consuming space on the C stack.  A new version of
.IP \(bu
A trampoline-enabled implementation, \fITheCmdNRObjProc\fR.  This
\fITheCmdOldObjProc\fR is just a a wrapper that uses \fBTcl_NRCallObjProc\fR to
call \fITheCmdNRObjProc\fR:
function will perform the initialization, request that the trampoline
call the postprocessing routine after command evaluation, and finally,
request that the trampoline call the inner command.
.IP \(bu
A postprocessing routine, \fITheCmdPostProc\fR. This function will
perform the postprocessing formerly done after the return from the
inner command in \fITheCmdObjProc\fR.
.PP
The non-trampoline implementation is simple and stylized, containing
a single statement:
.PP
.CS
int
\fITheCmdNewObjProc\fR(
\fITheCmdOldObjProc\fR(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return \fBTcl_NRCallObjProc\fR(interp, \fITheCmdNRObjProc\fR,
            clientData, objc, objv);
}
.CE
.PP
The trampoline-enabled implementation requests postprocessing,
and returns to the trampoline requesting command evaluation.
.PP
.CS
int
\fITheCmdNRObjProc\fR
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306

307
308
309
310

311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328


204
205
206
207
208
209
210



211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226

227




228
229











230
231
232
233
234

235
236







-
-
-
















-
+
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
-





-
+
+
    /* \fIdata0 .. data3\fR are up to four one-word items to
     * pass to the postprocessing procedure */

    return \fBTcl_NREvalObj\fR(interp, objPtr, 0);
}
.CE
.PP
The postprocessing procedure does whatever the original command did
upon return from the inner evaluation.
.PP
.CS
int
\fITheCmdNRPostProc\fR(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    /* \fIdata[0] .. data[3]\fR are the four words of data
     * passed to \fBTcl_NRAddCallback\fR */

    \fI... postprocessing ...\fR

    return result;
}
.CE
.PP
If \fItheCommand\fR is a command that results in multiple commands or
Any function comprising a routine can push other functions, making it possible
scripts being evaluated, its postprocessing routine may schedule
additional postprocessing and then request another command evaluation
by means of \fBTcl_NREvalObj\fR or one of the other evaluation
routines. Looping and sequencing constructs may be implemented in this way.
implement looping and sequencing constructs using the function stack.
.PP
Finally, to install a trampoline-enabled command in the interpreter,
\fBTcl_NRCreateCommand\fR is used in place of
\fBTcl_CreateObjCommand\fR.  It accepts two command procedures instead
of one. The first is for use when no trampoline is yet on the stack,
and the second is for use when there is already a trampoline in place.
.PP
.CS
\fBTcl_NRCreateCommand\fR(interp, "theCommand",
        \fITheCmdNewObjProc\fR, \fITheCmdNRObjProc\fR, clientData,
        TheCmdDeleteProc);
.CE
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright (c) 2008 by Kevin B. Kenny
Copyright (c) 2008 by Kevin B. Kenny.
Copyright (c) 2018 by Nathan Coulter.

Changes to doc/Object.3.

253
254
255
256
257
258
259
260

261
262
263
264
265
266
267
253
254
255
256
257
258
259

260
261
262
263
264
265
266
267







-
+







\fBincr x\fR
.CE
.PP
The \fBincr\fR command first gets an integer from \fIx\fR's value
by calling \fBTcl_GetIntFromObj\fR.
This procedure checks whether the value is already an integer value.
Since it is not, it converts the value
by setting the value's \fIinternalRep.longValue\fR member
by setting the value's internal representation
to the integer \fB123\fR
and setting the value's \fItypePtr\fR
to point to the integer Tcl_ObjType structure.
Both representations are now valid.
\fBincr\fR increments the value's integer internal representation
then invalidates its string representation
(by calling \fBTcl_InvalidateStringRep\fR)

Changes to doc/Panic.3.

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22
23



24
25
26
27
28
29
30
1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33









-
+













+
+
+







'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\"  Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort
Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
void
\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR)
.sp
void
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp
void
\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
.SH ARGUMENTS
.AS Tcl_PanicProc *panicProc
.AP "const char*" format in
A printf-style format string.
.AP "" arg in
Arguments matching the format string.
.AP va_list argList in
49
50
51
52
53
54
55








56
57
58
59
60
61
62
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73







+
+
+
+
+
+
+
+







In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted
error message to the standard error file of the process, and then
calls \fBabort\fR to terminate the process.  \fBTcl_Panic\fR does not
return. On Windows, when a debugger is running, the formatted error
message is sent to the debugger in stead. If the windows executable
does not have a stderr channel (e.g. \fBwish.exe\fR), then a
system dialog box is used to display the panic message.
.PP
If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR
and you want to implicitly use the stderr channel of your
application's C runtime (in stead of the stderr channel of the
C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR
with \fBTcl_ConsolePanic\fR as its argument. On platforms which
only have one C runtime (almost all platforms except Windows)
\fBTcl_ConsolePanic\fR is equivalent to NULL.
.PP
\fBTcl_SetPanicProc\fR may be used to modify the behavior of
\fBTcl_Panic\fR.  The \fIpanicProc\fR argument should match the
type \fBTcl_PanicProc\fR:
.PP
.CS
typedef void \fBTcl_PanicProc\fR(

Changes to doc/SaveResult.3.

1
2
3

4
5
6
7
8
9
10
11
12



13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

34
35

36
37

38
39

40
41
42
43
44
45


46
47
48
49

50
51
52




53
54
55

56
57

58
59

60
61
62
63
64
65

66
67
68
69
70


71
72

73
74
75
76
77
78
79


80

81
82
83
84
85
86
87
88
89
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
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

36
37

38
39

40
41

42
43
44
45



46
47

48


49



50
51
52
53

54

55


56


57



58


59





60
61
62

63







64
65

66
67



















68
69


70
71
72


73
74


75
76
77

78


79
80
81



82

83
84
85



+








-
+
+
+




















-
+

-
+

-
+

-
+



-
-
-
+
+
-

-
-
+
-
-
-
+
+
+
+
-

-
+
-
-
+
-
-
+
-
-
-

-
-
+
-
-
-
-
-
+
+

-
+
-
-
-
-
-
-
-
+
+
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
+
+

-
-
+
+
-
-
+


-
+
-
-
+


-
-
-
+
-
+


'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
'\" Copyright (c) 2018 Nathan Coulter.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- save and restore an interpreter's state
Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState,
Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- Save and restore the
state of an an interpreter.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_InterpState
\fBTcl_SaveInterpState\fR(\fIinterp, status\fR)
.sp
int
\fBTcl_RestoreInterpState\fR(\fIinterp, state\fR)
.sp
\fBTcl_DiscardInterpState\fR(\fIstate\fR)
.sp
\fBTcl_SaveResult\fR(\fIinterp, savedPtr\fR)
.sp
\fBTcl_RestoreResult\fR(\fIinterp, savedPtr\fR)
.sp
\fBTcl_DiscardResult\fR(\fIsavedPtr\fR)
.SH ARGUMENTS
.AS Tcl_InterpState savedPtr
.AP Tcl_Interp *interp in
Interpreter for which state should be saved.
The interpreter for the operation.
.AP int status in
Return code value to save as part of interpreter state.
The return code for the state.
.AP Tcl_InterpState state in
Saved state token to be restored or discarded.
A token for saved state.
.AP Tcl_SavedResult *savedPtr in
Pointer to location where interpreter result should be saved or restored.
A pointer to storage for saved state.
.BE
.SH DESCRIPTION
.PP
These routines allows a C procedure to take a snapshot of the current
state of an interpreter so that it can be restored after a call
to \fBTcl_Eval\fR or some other routine that modifies the interpreter
These routines save the state of an interpreter before a call to a routine such
as \fBTcl_Eval\fR, and restore the state afterwards.
state.  There are two triplets of routines meant to work together.
.PP
The first triplet stores the snapshot of interpreter state in
an opaque token returned by \fBTcl_SaveInterpState\fR.  That token
\fBTcl_SaveInterpState\fR saves the parts of \fIinterp\fR that comprise the
value may then be passed back to one of \fBTcl_RestoreInterpState\fR
or \fBTcl_DiscardInterpState\fR, depending on whether the interp
state is to be restored.  So long as one of the latter two routines
result of a script, including the resulting value, the return code passed as
\fIstatus\fR, and any options such as \fB\-errorinfo\fR and \fB\-errorcode\fR.
It returns a token for the saved state.  The interpreter result is not reset
and no interpreter state is changed.
is called, Tcl will take care of memory management.
.PP
The second triplet stores the snapshot of only the interpreter
\fBTcl_RestoreInterpState\fR restores the state indicated by \fIstate\fR and
result (not its complete state) in memory allocated by the caller.
These routines are passed a pointer to \fBTcl_SavedResult\fR
returns the \fIstatus\fR originally passed in the corresponding call to
that is used to store enough information to restore the interpreter result.
\fBTcl_SavedResult\fR can be allocated on the stack of the calling
\fBTcl_SaveInterpState\fR.
procedure.  These routines do not save the state of any error
information in the interpreter (e.g. the \fB\-errorcode\fR or
\fB\-errorinfo\fR return options, when an error is in progress).
.PP
Because the routines \fBTcl_SaveInterpState\fR,
\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR perform
If a saved state is not restored, \fBTcl_DiscardInterpState\fR must be called
a superset of the functions provided by the other routines,
any new code should only make use of the more powerful routines.
The older, weaker routines \fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR,
and \fBTcl_DiscardResult\fR continue to exist only for the sake
of existing programs that may already be using them.
to release it.  A token used to discard or restore state must not be used
again.
.PP
\fBTcl_SaveInterpState\fR takes a snapshot of those portions of
\fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR, and \fBTcl_DiscardResult\fR are
interpreter state that make up the full result of script evaluation.
This include the interpreter result, the return code (passed in
as the \fIstatus\fR argument, and any return options, including
\fB\-errorinfo\fR and \fB\-errorcode\fR when an error is in progress.
This snapshot is returned as an opaque token of type \fBTcl_InterpState\fR.
The call to \fBTcl_SaveInterpState\fR does not itself change the
state of the interpreter.  Unlike \fBTcl_SaveResult\fR, it does
deprecated.  Instead use \fBTcl_SaveInterpState\fR,
\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR, which are more
not reset the interpreter.
capable.
.PP
\fBTcl_RestoreInterpState\fR accepts a \fBTcl_InterpState\fR token
previously returned by \fBTcl_SaveInterpState\fR and restores the
state of the interp to the state held in that snapshot.  The return
value of \fBTcl_RestoreInterpState\fR is the status value originally
passed to \fBTcl_SaveInterpState\fR when the snapshot token was
created.
.PP
\fBTcl_DiscardInterpState\fR is called to release a \fBTcl_InterpState\fR
token previously returned by \fBTcl_SaveInterpState\fR when that
snapshot is not to be restored to an interp.
.PP
The \fBTcl_InterpState\fR token returned by \fBTcl_SaveInterpState\fR
must eventually be passed to either \fBTcl_RestoreInterpState\fR
or \fBTcl_DiscardInterpState\fR to avoid a memory leak.  Once
the \fBTcl_InterpState\fR token is passed to one of them, the
token is no longer valid and should not be used anymore.
.PP
\fBTcl_SaveResult\fR moves the string and value results
of \fIinterp\fR into the location specified by \fIstatePtr\fR.
\fBTcl_SaveResult\fR moves the result of \fIinterp\fR to the location
\fIstatePtr\fR points to and returns the interpreter result to its initial
\fBTcl_SaveResult\fR clears the result for \fIinterp\fR and
leaves the result in its normal empty initialized state.
state.  It does not save options such as \fB\-errorcode\fR or
\fB\-errorinfo\fR.
.PP
\fBTcl_RestoreResult\fR moves the string and value results from
\fIstatePtr\fR back into \fIinterp\fR.  Any result or error that was
\fBTcl_RestoreResult\fR clears any existing result or error in \fIinterp\fR and
moves the result from \fIstatePtr\fR back to \fIinterp\fR.  \fIstatePtr\fR is
already in the interpreter will be cleared.  The \fIstatePtr\fR is left
in an uninitialized state and cannot be used until another call to
then in an undefined state and must not be used until passed again to
\fBTcl_SaveResult\fR.
.PP
\fBTcl_DiscardResult\fR releases the saved interpreter state
\fBTcl_DiscardResult\fR releases the state stored at \fBstatePtr\fR, which is
stored at \fBstatePtr\fR.  The state structure is left in an
uninitialized state and cannot be used until another call to
then in an undefined state and must not be used until passed again to
\fBTcl_SaveResult\fR.
.PP
Once \fBTcl_SaveResult\fR is called to save the interpreter
result, either \fBTcl_RestoreResult\fR or
\fBTcl_DiscardResult\fR must be called to properly clean up the
If a saved result is not restored, \fBTcl_DiscardResult\fR must be called to
memory associated with the saved state.
release it.
.SH KEYWORDS
result, state, interp

Changes to doc/SetResult.3.

193
194
195
196
197
198
199













200
201
202
203
204
205
206
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219







+
+
+
+
+
+
+
+
+
+
+
+
+







\fBTcl_FreeResult\fR performs part of the work
of \fBTcl_ResetResult\fR.
It frees up the memory associated with \fIinterp\fR's result.
It also sets \fIinterp->freeProc\fR to zero, but does not
change \fIinterp->result\fR or clear error state.
\fBTcl_FreeResult\fR is most commonly used when a procedure
is about to replace one result value with another.
.SS "DIRECT ACCESS TO INTERP->RESULT"
.PP
It used to be legal for programs to
directly read and write \fIinterp->result\fR
to manipulate the interpreter result.  The Tcl headers no longer
permit this access by default, and C code still doing this must
be updated to use supported routines \fBTcl_GetObjResult\fR,
\fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR.
As a migration aid, access can be restored with the compiler directive
.CS
#define USE_INTERP_RESULT
.CE
but this is meant only to offer life support to otherwise dead code.
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
the Tcl system is to manage the storage for the \fIresult\fR argument.
If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called
at a time when \fIinterp\fR holds a string result,
they do whatever is necessary to dispose of the old string result

Changes to doc/StringObj.3.

33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47







-
+







.sp
Tcl_UniChar *
\fBTcl_GetUnicodeFromObj\fR(\fIobjPtr, lengthPtr\fR)
.sp
Tcl_UniChar *
\fBTcl_GetUnicode\fR(\fIobjPtr\fR)
.sp
Tcl_UniChar
int
\fBTcl_GetUniChar\fR(\fIobjPtr, index\fR)
.sp
int
\fBTcl_GetCharLength\fR(\fIobjPtr\fR)
.sp
Tcl_Obj *
\fBTcl_GetRange\fR(\fIobjPtr, first, last\fR)
200
201
202
203
204
205
206
207


208
209
210
211
212
213
214
200
201
202
203
204
205
206

207
208
209
210
211
212
213
214
215







-
+
+







\fIlengthPtr\fR if it is non-NULL.  The storage referenced by the returned
byte pointer is owned by the value manager and should not be modified by
the caller.  The procedure \fBTcl_GetUnicode\fR is used in the common case
where the caller does not need the length of the unicode string
representation.
.PP
\fBTcl_GetUniChar\fR returns the \fIindex\fR'th character in the
value's Unicode representation.
value's Unicode representation. If the index is out of range or
it references a low surrogate preceded by a high surrogate, it returns -1;
.PP
\fBTcl_GetRange\fR returns a newly created value comprised of the
characters between \fIfirst\fR and \fIlast\fR (inclusive) in the
value's Unicode representation.  If the value's Unicode
representation is invalid, the Unicode representation is regenerated
from the value's string representation.
.PP

Changes to doc/Thread.3.

41
42
43
44
45
46
47

48


49
50
51
52
53
54
55
41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
56
57







+
-
+
+







int
\fBTcl_JoinThread\fR(\fIid, result\fR)
.SH ARGUMENTS
.AS Tcl_CreateThreadProc proc out
.AP Tcl_Condition *condPtr in
A condition variable, which must be associated with a mutex lock.
.AP Tcl_Mutex *mutexPtr in
.VS TIP509
A mutex lock.
A recursive mutex lock.
.VE TIP509
.AP "const Tcl_Time" *timePtr in
A time limit on the condition wait.  NULL to wait forever.
Note that a polling value of 0 seconds does not make much sense.
.AP Tcl_ThreadDataKey *keyPtr in
This identifies a block of thread local storage.  The key should be
static and process-wide, yet each thread will end up associating
a different block of storage with this key.
136
137
138
139
140
141
142

143

144




145
146
147
148
149
150
151
138
139
140
141
142
143
144
145

146

147
148
149
150
151
152
153
154
155
156
157







+
-
+
-
+
+
+
+







the \fBNotifier\fR manual page for more information on these procedures.
.PP
A mutex is a lock that is used to serialize all threads through a piece
of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR.
If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will
block until \fBTcl_MutexUnlock\fR is called.
A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR.
.VS TIP509
The result of locking a mutex twice from the same thread is undefined.
Mutexes are reentrant: they can be locked several times from the same
On some platforms it will result in a deadlock.
thread. However there must be exactly one call to
\fBTcl_MutexUnlock\fR for each call to \fBTcl_MutexLock\fR in order
for a thread to release a mutex completely.
.VE TIP509
The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR
procedures are defined as empty macros if not compiling with threads enabled.
For declaration of mutexes the \fBTCL_DECLARE_MUTEX\fR macro should be used.
This macro assures correct mutex handling even when the core is compiled
without threads enabled.
.PP
A condition variable is used as a signaling mechanism:

Changes to doc/ToUpper.3.

9
10
11
12
13
14
15
16

17
18
19

20
21
22

23
24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
9
10
11
12
13
14
15

16
17
18

19
20
21

22
23
24
25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43







-
+


-
+


-
+













-
+







.BS
.SH NAME
Tcl_UniCharToUpper, Tcl_UniCharToLower, Tcl_UniCharToTitle, Tcl_UtfToUpper, Tcl_UtfToLower, Tcl_UtfToTitle \- routines for manipulating the case of Unicode characters and UTF-8 strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_UniChar
int
\fBTcl_UniCharToUpper\fR(\fIch\fR)
.sp
Tcl_UniChar
int
\fBTcl_UniCharToLower\fR(\fIch\fR)
.sp
Tcl_UniChar
int
\fBTcl_UniCharToTitle\fR(\fIch\fR)
.sp
int
\fBTcl_UtfToUpper\fR(\fIstr\fR)
.sp
int
\fBTcl_UtfToLower\fR(\fIstr\fR)
.sp
int
\fBTcl_UtfToTitle\fR(\fIstr\fR)
.SH ARGUMENTS
.AS char *str in/out
.AP int ch in
The Tcl_UniChar to be converted.
The Unicode character to be converted.
.AP char *str in/out
Pointer to UTF-8 string to be converted in place.
.BE

.SH DESCRIPTION
.PP
The first three routines convert the case of individual Unicode characters:

Changes to doc/UniCharIsAlpha.3.

44
45
46
47
48
49
50
51

52
53
54
55
56

57
58
59
60
61
62
63
64
65
66
67
68
69
70
44
45
46
47
48
49
50

51
52
53
54
55

56
57
58
59
60



61
62
63
64
65
66
67







-
+




-
+




-
-
-







\fBTcl_UniCharIsUpper\fR(\fIch\fR)
.sp
int
\fBTcl_UniCharIsWordChar\fR(\fIch\fR)
.SH ARGUMENTS
.AS int ch
.AP int ch in
The Tcl_UniChar to be examined.
The Unicode character to be examined.
.BE

.SH DESCRIPTION
.PP
All of the routines described examine Tcl_UniChars and return a
All of the routines described examine Unicode characters and return a
boolean value. A non-zero return value means that the character does
belong to the character class associated with the called routine. The
rest of this document just describes the character classes associated
with the various routines.
.PP
Note: A Tcl_UniChar is a Unicode character represented as an unsigned,
fixed-size quantity.

.SH "CHARACTER CLASSES"
.PP
\fBTcl_UniCharIsAlnum\fR tests if the character is an alphanumeric Unicode character.
.PP
\fBTcl_UniCharIsAlpha\fR tests if the character is an alphabetic Unicode character.
.PP

Changes to doc/Utf.3.

59
60
61
62
63
64
65
66

67
68
69
70
71
72
73
74
75
76
77
78
79
80

81
82
83
84
85
86
87
59
60
61
62
63
64
65

66
67
68
69
70
71
72
73
74
75
76
77
78
79

80
81
82
83
84
85
86
87







-
+













-
+







.sp
const char *
\fBTcl_UtfNext\fR(\fIsrc\fR)
.sp
const char *
\fBTcl_UtfPrev\fR(\fIsrc, start\fR)
.sp
Tcl_UniChar
int
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
.sp
const char *
\fBTcl_UtfAtIndex\fR(\fIsrc, index\fR)
.sp
int
\fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *uniPattern in/out
.AP char *buf out
Buffer in which the UTF-8 representation of the Tcl_UniChar is stored.  At most
\fBTCL_UTF_MAX\fR bytes are stored in the buffer.
.AP int ch in
The Tcl_UniChar to be converted or examined.
The Unicode character to be converted or examined.
.AP Tcl_UniChar *chPtr out
Filled with the Tcl_UniChar represented by the head of the UTF-8 string.
.AP "const char" *src in
Pointer to a UTF-8 string.
.AP "const char" *cs in
Pointer to a UTF-8 string.
.AP "const char" *ct in
117
118
119
120
121
122
123
124
125


126
127
128
129
130
131
132
133

134
135




136
137
138
139
140
141
142



143
144
145
146
147
148
149
117
118
119
120
121
122
123


124
125
126
127
128
129
130
131
132

133
134

135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155







-
-
+
+







-
+

-
+
+
+
+







+
+
+







.AP int nocase in
Specifies whether the match should be done case-sensitive (0) or
case-insensitive (1).
.BE

.SH DESCRIPTION
.PP
These routines convert between UTF-8 strings and Tcl_UniChars.  A
Tcl_UniChar is a Unicode character represented as an unsigned, fixed-size
These routines convert between UTF-8 strings and Unicode characters.  An
Unicode character represented as an unsigned, fixed-size
quantity.  A UTF-8 character is a Unicode character represented as
a varying-length sequence of up to \fBTCL_UTF_MAX\fR bytes.  A multibyte UTF-8
sequence consists of a lead byte followed by some number of trail bytes.
.PP
\fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to
represent one Unicode character in the UTF-8 representation.
.PP
\fBTcl_UniCharToUtf\fR stores the Tcl_UniChar \fIch\fR as a UTF-8 string
\fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string
in starting at \fIbuf\fR.  The return value is the number of bytes stored
in \fIbuf\fR.
in \fIbuf\fR. If ch is an upper surrogate (range U+D800 - U+DBFF), then
the return value will be 0 and nothing will be stored. If you still
want to produce UTF-8 output for it (even though knowing it's an illegal
code-point on its own), just call \fBTcl_UniCharToUtf\fR again using ch = -1.
.PP
\fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR
and stores it as a Tcl_UniChar in \fI*chPtr\fR.  The return value is the
number of bytes read from \fIsrc\fR.  The caller must ensure that the
source buffer is long enough such that this routine does not run off the
end and dereference non-existent or random memory; if the source buffer
is known to be null-terminated, this will not happen.  If the input is
a byte in the range 0x80 - 0x9F, \fBTcl_UtfToUniChar\fR assumes the
cp1252 encoding, stores the corresponding Tcl_UniChar in \fI*chPtr\fR
and returns 1. If the input is otherwise
not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first
byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x0000 and
0x00ff and return 1.
.PP
\fBTcl_UniCharToUtfDString\fR converts the given Unicode string
to UTF-8, storing the result in a previously initialized \fBTcl_DString\fR.
You must specify \fIuniLength\fR, the length of the given Unicode string.
196
197
198
199
200
201
202
203

204
205
206
207
208
209
210
211

212
213
214
215
216

217
218
219
220
221
222
223
202
203
204
205
206
207
208

209
210
211
212
213
214
215
216

217
218
219
220
221

222
223
224
225
226
227
228
229







-
+







-
+




-
+







characters.
.PP
\fBTcl_UtfCharComplete\fR returns 1 if the source UTF-8 string \fIsrc\fR
of \fIlength\fR bytes is long enough to be decoded by
\fBTcl_UtfToUniChar\fR, or 0 otherwise.  This function does not guarantee
that the UTF-8 string is properly formed.  This routine is used by
procedures that are operating on a byte at a time and need to know if a
full Tcl_UniChar has been seen.
full Unicode character has been seen.
.PP
\fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings.  It
returns the number of Tcl_UniChars that are represented by the UTF-8 string
\fIsrc\fR.  The length of the source string is \fIlength\fR bytes.  If the
length is negative, all bytes up to the first null byte are used.
.PP
\fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings.  It
returns a pointer to the first occurrence of the Tcl_UniChar \fIch\fR
returns a pointer to the first occurrence of the Unicode character \fIch\fR
in the null-terminated UTF-8 string \fIsrc\fR.  The null terminator is
considered part of the UTF-8 string.
.PP
\fBTcl_UtfFindLast\fR corresponds to \fBstrrchr\fR for UTF-8 strings.  It
returns a pointer to the last occurrence of the Tcl_UniChar \fIch\fR
returns a pointer to the last occurrence of the Unicode character \fIch\fR
in the null-terminated UTF-8 string \fIsrc\fR.  The null terminator is
considered part of the UTF-8 string.
.PP
Given \fIsrc\fR, a pointer to some location in a UTF-8 string,
\fBTcl_UtfNext\fR returns a pointer to the next UTF-8 character in the
string.  The caller must not ask for the next character after the last
character in the string if the string is not terminated by a null

Added doc/abstract.n.














































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH abstract n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::abstract \- a class that does not allow direct instances of itself
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::abstract\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR
       \(-> \fBoo::abstract\fR
.fi
.BE
.SH DESCRIPTION
Abstract classes are classes that can contain definitions, but which cannot be
directly manufactured; they are intended to only ever be inherited from and
instantiated indirectly. The characteristic methods of \fBoo::class\fR
(\fBcreate\fR and \fBnew\fR) are not exported by an instance of
\fBoo::abstract\fR.
.PP
Note that \fBoo::abstract\fR is not itself an instance of \fBoo::abstract\fR.
.SS CONSTRUCTOR
The \fBoo::abstract\fR class does not define an explicit constructor; this
means that it is effectively the same as the constructor of the
\fBoo::class\fR class.
.SS DESTRUCTOR
The \fBoo::abstract\fR class does not define an explicit destructor;
destroying an instance of it is just like destroying an ordinary class (and
will destroy all its subclasses).
.SS "EXPORTED METHODS"
The \fBoo::abstract\fR class defines no new exported methods.
.SS "NON-EXPORTED METHODS"
The \fBoo::abstract\fR class explicitly states that \fBcreate\fR,
\fBcreateWithNamespace\fR, and \fBnew\fR are unexported.
.SH EXAMPLES
.PP
This example defines a simple class hierarchy and creates a new instance of
it. It then invokes a method of the object before destroying the hierarchy and
showing that the destruction is transitive.
.PP
.CS
\fBoo::abstract\fR create fruit {
    method eat {} {
        puts "yummy!"
    }
}
oo::class create banana {
    superclass fruit
    method peel {} {
        puts "skin now off"
    }
}
set b [banana \fBnew\fR]
$b peel              \fI\(-> prints 'skin now off'\fR
$b eat               \fI\(-> prints 'yummy!'\fR
set f [fruit new]    \fI\(-> error 'unknown method "new"...'\fR
.CE
.SH "SEE ALSO"
oo::define(n), oo::object(n)
.SH KEYWORDS
abstract class, class, metaclass, object
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/append.n.

16
17
18
19
20
21
22





23
24
25
26
27
28
29
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34







+
+
+
+
+







.BE
.SH DESCRIPTION
.PP
Append all of the \fIvalue\fR arguments to the current value
of variable \fIvarName\fR.  If \fIvarName\fR does not exist,
it is given a value equal to the concatenation of all the
\fIvalue\fR arguments.
.VS TIP508
If \fIvarName\fR indicate an element that does not exist of an array that has
a default value set, the concatenation of the default value and all the
\fIvalue\fR arguments will be stored in the array element.
.VE TIP508
The result of this command is the new value stored in variable
\fIvarName\fR.
This command provides an efficient way to build up long
variables incrementally.
For example,
.QW "\fBappend a $b\fR"
is much more efficient than
40
41
42
43
44
45
46
47
48
49




45
46
47
48
49
50
51



52
53
54
55







-
-
-
+
+
+
+
puts $var
# Prints 0,1,2,3,4,5,6,7,8,9,10
.CE
.SH "SEE ALSO"
concat(n), lappend(n)
.SH KEYWORDS
append, variable
'\" Local Variables:
'\" mode: nroff
'\" End:
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/array.n.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH array n 8.3 Tcl "Tcl Built-In Commands"
.TH array n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
array \- Manipulate array variables
.SH SYNOPSIS
\fBarray \fIoption arrayName\fR ?\fIarg arg ...\fR?
31
32
33
34
35
36
37















































38
39
40
41
42
43
44
45
46
47
48
49









50
51
52
53
54
55
56
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












+
+
+
+
+
+
+
+
+







\fISearchId\fR indicates which search on \fIarrayName\fR to
check, and must have been the return value from a previous
invocation of \fBarray startsearch\fR.
This option is particularly useful if an array has an element
with an empty name, since the return value from
\fBarray nextelement\fR will not indicate whether the search
has been completed.
.TP
\fBarray default \fIsubcommand arrayName args...\fR
.VS TIP508
Manages the default value of the array. Arrays initially have no default
value, but this command allows you to set one; the default value will be
returned when reading from an element of the array \farrayName\fR if the read
would otherwise result in an error. Note that this may cause the \fBappend\fR,
\fBdict\fR, \fBincr\fR and \fBlappend\fR commands to change their behavior in
relation to non-existing array elements.
.RS
.PP
The \fIsubcommand\fR argument controls what exact operation will be performed
on the default value of \fIarrayName\fR. Supported \fIsubcommand\fRs are:
.VE TIP508
.TP
\fBarray default exists \fIarrayName\fR
.VS TIP508
This returns a boolean value indicating whether a default value has been set
for the array \fIarrayName\fR. Returns a false value if \fIarrayName\fR does
not exist. Raises an error if \fIarrayName\fR is an existing variable that is
not an array.
.VE TIP508
.TP
\fBarray default get \fIarrayName\fR
.VS TIP508
This returns the current default value for the array \fIarrayName\fR.  Raises
an error if \fIarrayName\fR is an existing variable that is not an array, or
if \fIarrayName\fR is an array without a default value.
.VE TIP508
.TP
\fBarray default set \fIarrayName value\fR
.VS TIP508
This sets the default value for the array \fIarrayName\fR to \fIvalue\fR.
Returns the empty string. Raises an error if \fIarrayName\fR is an existing
variable that is not an array, or if \fIarrayName\fR is an illegal name for an
array. If \fIarrayName\fR does not currently exist, it is created as an empty
array as well as having its default value set.
.VE TIP508
.TP
\fBarray default unset \fIarrayName\fR
.VS TIP508
This removes the default value for the array \fIarrayName\fR and returns the
empty string. Does nothing if \fIarrayName\fR does not have a default
value. Raises an error if \fIarrayName\fR is an existing variable that is not
an array.
.VE TIP508
.RE
.TP
\fBarray donesearch \fIarrayName searchId\fR
This command terminates an array search and destroys all the
state associated with that search.  \fISearchId\fR indicates
which search on \fIarrayName\fR to destroy, and must have
been the return value from a previous invocation of
\fBarray startsearch\fR.  Returns an empty string.
.TP
\fBarray exists \fIarrayName\fR
Returns 1 if \fIarrayName\fR is an array variable, 0 if there
is no variable by that name or if it is a scalar variable.
.TP
\fBarray for {\fIkeyVariable valueVariable\fB} \fIarrayName body\fP
The first argument is a two element list of variable names for the
key and value of each entry in the array.  The second argument is the
array name to iterate over.  The third argument is the body to execute
for each key and value returned.
The ordering of the returned keys is undefined.
If an array element is deleted or a new array element is inserted during
the \fIarray for\fP process, the command will terminate with an error.
.TP
\fBarray get \fIarrayName\fR ?\fIpattern\fR?
Returns a list containing pairs of elements.  The first
element in each pair is the name of an element in \fIarrayName\fR
and the second element of each pair is the value of the
array element.  The order of the pairs is undefined.
If \fIpattern\fR is not specified, then all of the elements of the
array are included in the result.
181
182
183
184
185
186
187




237
238
239
240
241
242
243
244
245
246
247







+
+
+
+
    number of buckets with 10 or more entries: 0
    average search distance for entry: 1.2
.CE
.SH "SEE ALSO"
list(n), string(n), variable(n), trace(n), foreach(n)
.SH KEYWORDS
array, element names, search
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Added doc/callback.n.

























































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH callback n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
callback, mymethod \- generate callbacks to methods
.SH SYNOPSIS
.nf
package require TclOO

\fBcallback\fR \fImethodName\fR ?\fIarg ...\fR?
\fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBcallback\fR command,
'\" Based on notes in the tcllib docs, we know the provenance of mymethod
also called \fBmymethod\fR for compatibility with the ooutil and snit packages
of Tcllib,
and which should only be used from within the context of a call to a method
(i.e. inside a method, constructor or destructor body) is used to generate a
script fragment that will invoke the method, \fImethodName\fR, on the current
object (as reported by \fBself\fR) when executed. Any additional arguments
provided will be provided as leading arguments to the callback. The resulting
script fragment shall be a proper list.
.PP
Note that it is up to the caller to ensure that the current object is able to
handle the call of \fImethodName\fR; this command does not check that.
\fImethodName\fR may refer to any exported or unexported method, but may not
refer to a private method as those can only be invoked directly from within
methods. If there is no such method present at the point when the callback is
invoked, the standard \fBunknown\fR method handler will be called.
.SH EXAMPLE
This is a simple echo server class. The \fBcallback\fR command is used in two
places, to arrange for the incoming socket connections to be handled by the
\fIAccept\fR method, and to arrange for the incoming bytes on those
connections to be handled by the \fIReceive\fR method.
.PP
.CS
oo::class create EchoServer {
    variable server clients
    constructor {port} {
        set server [socket -server [\fBcallback\fR Accept] $port]
        set clients {}
    }
    destructor {
        chan close $server
        foreach client [dict keys $clients] {
            chan close $client
        }
    }

    method Accept {channel clientAddress clientPort} {
        dict set clients $channel [dict create \e
                address $clientAddress port $clientPort]
        chan event $channel readable [\fBcallback\fR Receive $channel]
    }
    method Receive {channel} {
        if {[chan gets $channel line] >= 0} {
            my echo $channel $line
        } else {
            chan close $channel
            dict unset clients $channel
        }
    }

    method echo {channel line} {
        dict with clients $channel {
            chan puts $channel \e
                    [format {[%s:%d] %s} $address $port $line]
        }
    }
}
.CE
.SH "SEE ALSO"
chan(n), fileevent(n), my(n), self(n), socket(n), trace(n)
.SH KEYWORDS
callback, object
.\" Local Variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/cd.n.

37
38
39
40
41
42
43




37
38
39
40
41
42
43
44
45
46
47







+
+
+
+
.CS
\fBcd\fR ../lib
.CE
.SH "SEE ALSO"
filename(n), glob(n), pwd(n)
.SH KEYWORDS
working directory
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Added doc/classvariable.n.















































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 2011-2015 Andreas Kupries
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH classvariable n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
classvariable \- create link from local variable to variable in class
.SH SYNOPSIS
.nf
package require TclOO

\fBclassvariable\fR \fIvariableName\fR ?\fI...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBclassvariable\fR command is available within methods. It takes a series
of one or more variable names and makes them available in the method's scope;
those variable names must not be qualified and must not refer to array
elements. The originating scope for the variables is the namespace of the
class that the method was defined by. In other words, the referenced variables
are shared between all instances of that class.
.PP
Note: This command is equivalent to the command \fBtypevariable\fR provided by
the snit package in tcllib for approximately the same purpose. If used in a
method defined directly on a class instance (e.g., through the
\fBoo::objdefine\fR \fBmethod\fR definition) this is very much like just
using:
.PP
.CS
namespace upvar [namespace current] $var $var
.CE
.PP
for each variable listed to \fBclassvariable\fR.
.SH EXAMPLE
This class counts how many instances of it have been made.
.PP
.CS
oo::class create Counted {
    initialise {
        variable count 0
    }

    variable number
    constructor {} {
        \fBclassvariable\fR count
        set number [incr count]
    }

    method report {} {
        \fBclassvariable\fR count
        puts "This is instance $number of $count"
    }
}

set a [Counted new]
set b [Counted new]
$a report
        \fI\(-> This is instance 1 of 2\fR
set c [Counted new]
$b report
        \fI\(-> This is instance 2 of 3\fR
$c report
        \fI\(-> This is instance 3 of 3\fR
.CE
.SH "SEE ALSO"
global(n), namespace(n), oo::class(n), oo::define(n), upvar(n), variable(n)
.SH KEYWORDS
class, class variable, variable
.\" Local Variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/clock.n.

448
449
450
451
452
453
454













455
456
457
458
459
460
461
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474







+
+
+
+
+
+
+
+
+
+
+
+
+







If a format string lacks a \fB%z\fR or \fB%Z\fR format group,
it is possible for the time to be ambiguous because it appears twice
in the same day, once without and once with Daylight Saving Time.
If this situation occurs, the first occurrence of the time is chosen.
(For this reason, it is wise to have the input string contain the
time zone when converting local times.  This caveat does not apply to
UTC times.)
.PP
If the interpretation of the groups yields an impossible time because
a field is out of range, enough of that field's unit will be added to
or subtracted from the time to bring it in range. Thus, if attempting to
scan or format day 0 of the month, one day will be subtracted from day
1 of the month, yielding the last day of the previous month.
.PP
If the interpretation of the groups yields an impossible time because
a Daylight Saving Time change skips over that time, or an ambiguous
time because a Daylight Saving Time change skips back so that the clock
observes the given time twice, and no time zone specifier (\fB%z\fR
or \fB%Z\fR) is present in the format, the time is interpreted as
if the clock had not changed.
.SH "FORMAT GROUPS"
.PP
The following format groups are recognized by the \fBclock scan\fR and
\fBclock format\fR commands.
.TP
\fB%a\fR
On output, receives an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day
869
870
871
872
873
874
875

876
877
878





879
880
881

882
883
884
885
886
887
888





889
890

891
892
893
894
895
896

897
898
899
900
901
902
903

904
905
906
907
908
909

910
911
912
913
914
915
916
882
883
884
885
886
887
888
889



890
891
892
893
894
895
896
897
898
899
900





901
902
903
904
905
906

907
908
909
910
911
912
913
914
915
916
917
918
919
920

921
922
923
924
925
926
927
928
929
930
931
932
933
934
935







+
-
-
-
+
+
+
+
+



+


-
-
-
-
-
+
+
+
+
+

-
+






+






-
+






+







time.  This is useful for determining the time on a specific day or
doing other date-relative conversions.
.PP
The \fIinputString\fR argument consists of zero or more specifications of the
following form:
.TP
\fItime\fR
.
A time of day, which is of the form: \fBhh?:mm?:ss?? ?meridian? ?zone?\fR
or \fBhhmm ?meridian? ?zone?\fR
If no meridian is specified, \fBhh\fR is interpreted on
A time of day, which is of the form:
.QW "\fIhh\fR?\fB:\fImm\fR?\fB:\fIss\fR?? ?\fImeridian\fR? ?\fIzone\fR?"
or
.QW "\fBhhmm \fR?\fBmeridian\fR? ?\fBzone\fR?" .
If no \fImeridian\fR is specified, \fIhh\fR is interpreted on
a 24-hour clock.
.TP
\fIdate\fR
.
A specific month and day with optional year.  The
acceptable formats are
.QW "\fBmm/dd\fR?\fB/yy\fR?" ,
.QW "\fBmonthname dd\fR?\fB, yy\fR?" ,
.QW "\fBday, dd monthname \fR?\fByy\fR?" ,
.QW "\fBdd monthname yy\fR" ,
.QW "?\fBCC\fR?\fByymmdd\fR" ,
.QW "\fImm\fB/\fIdd\fR?\fB/\fIyy\fR?" ,
.QW "\fImonthname dd\fR?\fB, \fIyy\fR?" ,
.QW "\fIday\fB, \fIdd monthname \fR?\fIyy\fR?" ,
.QW "\fIdd monthname yy\fR" ,
.QW "?\fICC\fR?\fIyymmdd\fR" ,
and
.QW "\fBdd-monthname-\fR?\fBCC\fR?\fByy\fR" .
.QW "\fIdd\fB-\fImonthname\fB-\fR?\fICC\fR?\fIyy\fR" .
The default year is the current year.  If the year is less
than 100, we treat the years 00-68 as 2000-2068 and the years 69-99
as 1969-1999.  Not all platforms can represent the years 38-70, so
an error may result if these years are used.
.TP
\fIISO 8601 point-in-time\fR
.
An ISO 8601 point-in-time specification, such as
.QW \fICCyymmdd\fBT\fIhhmmss\fR,
where \fBT\fR is the literal
.QW T ,
.QW "\fICCyymmdd hhmmss\fR" ,
or
.QW \fICCyymmdd\fBT\fIhh:mm:ss\fR .
.QW \fICCyymmdd\fBT\fIhh\fB:\fImm\fB:\fIss\fR .
Note that only these three formats are accepted.
The command does \fInot\fR accept the full range of point-in-time
specifications specified in ISO8601.  Other formats can be recognized by
giving an explicit \fB\-format\fR option to the \fBclock scan\fR command.
.TP
\fIrelative time\fR
.
A specification relative to the current time.  The format is \fBnumber
unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
\fBmonth\fR, \fBweek\fR, \fBday\fR,
\fBhour\fR, \fBminute\fR (or \fBmin\fR), and \fBsecond\fR (or \fBsec\fR).  The
unit can be specified as a singular or plural, as in \fB3 weeks\fR.
These modifiers may also be specified:
\fBtomorrow\fR, \fByesterday\fR, \fBtoday\fR, \fBnow\fR,

Added doc/cookiejar.n.


























































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 2014-2018 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "cookiejar" n 0.1 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
cookiejar \- Implementation of the Tcl http package cookie jar protocol
.SH SYNOPSIS
.nf
\fBpackage require\fR \fBcookiejar\fR ?\fB0.1\fR?

\fB::http::cookiejar configure\fR ?\fIoptionName\fR? ?\fIoptionValue\fR?
\fB::http::cookiejar create\fR \fIname\fR ?\fIfilename\fR?
\fB::http::cookiejar new\fR ?\fIfilename\fR?

\fIcookiejar\fR \fBdestroy\fR
\fIcookiejar\fR \fBforceLoadDomainData\fR
\fIcookiejar\fR \fBgetCookies\fR \fIprotocol host path\fR
\fIcookiejar\fR \fBstoreCookie\fR \fIoptions\fR
\fIcookiejar\fR \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR?
.fi
.SH DESCRIPTION
.PP
The cookiejar package provides an implementation of the http package's cookie
jar protocol using an SQLite database. It provides one main command,
\fB::http::cookiejar\fR, which is a TclOO class that should be instantiated to
create a cookie jar that manages a particular HTTP session.
.PP
The database management policy can be controlled at the package level by the
\fBconfigure\fR method on the \fB::http::cookiejar\fR class object:
.TP
\fB::http::cookiejar configure\fR ?\fIoptionName\fR? ?\fIoptionValue\fR?
.
If neither \fIoptionName\fR nor \fIoptionValue\fR are supplied, this returns a
copy of the configuration as a Tcl dictionary. If just \fIoptionName\fR is
supplied, just the value of the named option is returned. If both
\fIoptionName\fR and \fIoptionValue\fR are given, the named option is changed
to be the given value.
.RS
.PP
Supported options are:
.TP
\fB\-domainfile \fIfilename\fR
.
A file (defaulting to within the cookiejar package) with a description of the
list of top-level domains (e.g., \fB.com\fR or \fB.co.jp\fR). Such domains
\fImust not\fR accept cookies set upon them. Note that the list of such
domains is both security-sensitive and \fInot\fR constant and should be
periodically refetched. Cookie jars maintain their own cache of the domain
list.
.TP
\fB\-domainlist \fIurl\fR
.
A URL to fetch the list of top-level domains (e.g., \fB.com\fR or
\fB.co.jp\fR) from.  Such domains \fImust not\fR accept cookies set upon
them. Note that the list of such domains is both security-sensitive and
\fInot\fR constant and should be periodically refetched. Cookie jars maintain
their own cache of the domain list.
.TP
\fB\-domainrefresh \fIintervalMilliseconds\fR
.
The number of milliseconds between checks of the \fI\-domainlist\fR for new
domains.
.TP
\fB\-loglevel \fIlevel\fR
.
The logging level of this package. The logging level must be (in order of
decreasing verbosity) one of \fBdebug\fR, \fBinfo\fR, \fBwarn\fR, or
\fBerror\fR.
.TP
\fB\-offline \fIflag\fR
.
Allows the cookie managment engine to be placed into offline mode. In offline
mode, the list of domains is read immediately from the file configured in the
\fB\-domainfile\fR option, and the \fB\-domainlist\fR option is not used; it
also makes the \fB\-domainrefresh\fR option be effectively ignored.
.TP
\fB\-purgeold \fIintervalMilliseconds\fR
.
The number of milliseconds between checks of the database for expired
cookies; expired cookies are deleted.
.TP
\fB\-retain \fIcookieCount\fR
.
The maximum number of cookies to retain in the database.
.TP
\fB\-vacuumtrigger \fIdeletionCount\fR
.
A count of the number of persistent cookie deletions to go between vacuuming
the database.
.RE
.PP
Cookie jar instances may be made with any of the standard TclOO instance
creation methods (\fBcreate\fR or \fRnew\fR).
.TP
\fB::http::cookiejar new\fR ?\fIfilename\fR?
.
If a \fIfilename\fR argument is provided, it is the name of a file containing
an SQLite database that will contain the persistent cookies maintained by the
cookie jar; the database will be created if the file does not already
exist. If \fIfilename\fR is not supplied, the database will be held entirely within
memory, which effectively forces all cookies within it to be session cookies.
.SS "INSTANCE METHODS"
.PP
The following methods are supported on the instances:
.TP
\fIcookiejar\fR \fBdestroy\fR
.
This is the standard TclOO destruction method. It does \fInot\fR delete the
SQLite database if it is written to disk. Callers are responsible for ensuring
that the cookie jar is not in use by the http package at the time of
destruction.
.TP
\fIcookiejar\fR \fBforceLoadDomainData\fR
.
This method causes the cookie jar to immediately load (and cache) the domain
list data. The domain list will be loaded from the \fB\-domainlist\fR
configured a the package level if that is enabled, and otherwise will be
obtained from the \fB\-domainfile\fR configured at the package level.
.TP
\fIcookiejar\fR \fBgetCookies\fR \fIprotocol host path\fR
.
This method obtains the cookies for a particular HTTP request. \fIThis
implements the http cookie jar protocol.\fR
.TP
\fIcookiejar\fR \fBpolicyAllow\fR \fIoperation domain path\fR
.
This method is called by the \fBstoreCookie\fR method to get a decision on
whether to allow \fIoperation\fR to be performed for the \fIdomain\fR and
\fIpath\fR. This is checked immediately before the database is updated but
after the built-in security checks are done, and should return a boolean
value; if the value is false, the operation is rejected and the database is
not modified. The supported \fIoperation\fRs are:
.RS
.TP
\fBdelete\fR
.
The \fIdomain\fR is seeking to delete a cookie.
.TP
\fBsession\fR
.
The \fIdomain\fR is seeking to create or update a session cookie.
.TP
\fBset\fR
.
The \fIdomain\fR is seeking to create or update a persistent cookie (with a
defined lifetime).
.PP
The default implementation of this method just returns true, but subclasses of
this class may impose their own rules.
.RE
.TP
\fIcookiejar\fR \fBstoreCookie\fR \fIoptions\fR
.
This method stores a single cookie from a particular HTTP response. Cookies
that fail security checks are ignored. \fIThis implements the http cookie jar
protocol.\fR
.TP
\fIcookiejar\fR \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR?
.
This method looks a cookie by exact host (or domain) matching. If neither
\fIhost\fR nor \fIkey\fR are supplied, the list of hosts for which a cookie is
stored is returned. If just \fIhost\fR (which may be a hostname or a domain
name) is supplied, the list of cookie keys stored for that host is returned.
If both \fIhost\fR and \fIkey\fR are supplied, the value for that key is
returned; it is an error if no such host or key match exactly.
.SH "EXAMPLES"
.PP
The simplest way of using a cookie jar is to just permanently configure it at
the start of the application.
.PP
.CS
package require http
\fBpackage require cookiejar\fR

set cookiedb ~/.tclcookies.db
http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb]

# No further explicit steps are required to use cookies
set tok [http::geturl http://core.tcl.tk/]
.CE
.PP
To only allow a particular domain to use cookies, perhaps because you only
want to enable a particular host to create and manipulate sessions, create a
subclass that imposes that policy.
.PP
.CS
package require http
\fBpackage require cookiejar\fR

oo::class create MyCookieJar {
    superclass \fBhttp::cookiejar\fR

    method \fBpolicyAllow\fR {operation domain path} {
        return [expr {$domain eq "my.example.com"}]
    }
}

set cookiedb ~/.tclcookies.db
http::configure -cookiejar [MyCookieJar new $cookiedb]

# No further explicit steps are required to use cookies
set tok [http::geturl http://core.tcl.tk/]
.CE
.SH "SEE ALSO"
http(n), oo::class(n), sqlite3(n)
.SH KEYWORDS
cookie, internet, security policy, www
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/define.n.

1
2

3
4
5
6
7
8
9
1

2
3
4
5
6
7
8
9

-
+







'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\" Copyright (c) 2007-2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH define n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
34
35
36
37
38
39
40





















41
42
43
44
45
46
47
48
49
50
51
52
53

54
55
56
57
58
59
60
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












-
+







\fIarg\fR arguments; when the second is present, it is exactly as if all the
arguments from \fIsubcommand\fR onwards are made into a list and that list is
used as the \fIdefScript\fR argument.
.SS "CONFIGURING CLASSES"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form:
.TP
\fBclassmethod\fI name\fR ?\fIargList bodyScrip\fR?
.VS TIP478
This creates a class method, or (if \fIargList\fR and \fIbodyScript\fR are
omitted) promotes an existing method on the class object to be a class
method. The \fIname\fR, \fIargList\fR and \fIbodyScript\fR arguments are as in
the \fBmethod\fR definition, below.
.RS
.PP
Class methods can be called on either the class itself or on the instances of
that class. When they are called, the current object (see the \fBself\R and
\fBmy\fR commands) is the class on which they are called or the class of the
instance on which they are called, depending on whether they are called on the
class or an instance of the class, respectively. If called on a subclass or
instance of the subclass, the current object is the subclass.
.PP
In a private definition context, the methods as invoked on classes are
\fInot\fR private, but the methods as invoked on instances of classes are
private.
.RE
.VE TIP478
.TP
\fBconstructor\fI argList bodyScript\fR
.
This creates or updates the constructor for a class. The formal arguments to
the constructor (defined using the same format as for the Tcl \fBproc\fR
command) will be \fIargList\fR, and the body of the constructor will be
\fIbodyScript\fR. When the body of the constructor is evaluated, the current
namespace of the constructor will be a namespace that is unique to the object
being constructed. Within the constructor, the \fBnext\fR command should be
used to call the superclasses' constructors. If \fIbodyScript\fR is the empty
string, the constructor will be deleted.
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified).
.TP
\fBdestructor\fI bodyScript\fR
78
79
80
81
82
83
84
85

86
87
88
89
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
128
129


















130

131
132
133
134
135
136
137
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
128
129
130
131
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
161
162

163
164

165
166
167

168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186

187
188
189
190
191
192
193
194







-
+

-





-

-












+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












+
+
+
+
+
+
+


-
+

-



-

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+







This arranges for each of the named methods, \fIname\fR, to be exported
(i.e. usable outside an instance through the instance object's command) by the
class being defined. Note that the methods themselves may be actually defined
by a superclass; subclass exports override superclass visibility, and may in
turn be overridden by instances.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.VS
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
be exposed or not exposed); it is not an error for a non-existent method to be
named since they may be defined by subclasses.
.VS
By default, this slot works by appending.
.VE
.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
This creates or updates a forwarded method called \fIname\fR. The method is
defined be forwarded to the command called \fIcmdName\fR, with additional
arguments, \fIarg\fR etc., added before those arguments specified by the
caller of the method. The \fIcmdName\fR will always be resolved using the
rules of the invoking objects' namespaces, i.e., when \fIcmdName\fR is not
fully-qualified, the command will be searched for in each object's namespace,
using the instances' namespace's path, or by looking in the global namespace.
The method will be exported if \fIname\fR starts with a lower-case letter, and
non-exported otherwise.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private forwarded methods.
.VE TIP500
.RE
.TP
\fBinitialise\fI script\fR
.TP
\fBinitialize\fI script\fR
.VS TIP478
This evaluates \fIscript\fR in a context which supports local variables and
where the current namespace is the instance namespace of the class object
itself. This is useful for setting up, e.g., class-scoped variables.
.VE TIP478
.TP
\fBmethod\fI name argList bodyScript\fR
.
This creates or updates a method that is implemented as a procedure-like
script. The name of the method is \fIname\fR, the formal arguments to the
method (defined using the same format as for the Tcl \fBproc\fR command) will
be \fIargList\fR, and the body of the method will be \fIbodyScript\fR. When
the body of the method is evaluated, the current namespace of the method will
be a namespace that is unique to the current object. The method will be
exported if \fIname\fR starts with a lower-case letter, and non-exported
otherwise; this behavior can be overridden via \fBexport\fR and
\fBunexport\fR.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private procedure-like methods.
.VE TIP500
.RE
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.VS
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates the list of additional classes that are to be mixed into
all the instances of the class being defined. Each \fIclassName\fR argument
names a single class that is to be mixed in.
.VS
By default, this slot works by replacement.
.TP
\fBprivate \fIcmd arg...\fR
.TP
\fBprivate \fIscript\fR
.
.VS TIP500
This evaluates the \fIscript\fR (or the list of command and arguments given by
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
current class will be private definitions.
.RS
.PP
The following class definition commands are affected by \fBprivate\fR:
\fBforward\fR, \fBmethod\fR, \fBself\fR, and \fBvariable\fR. Nesting
\fBprivate\fR inside \fBprivate\fR has no cumulative effect; the innermost
definition context is just a private definition context. All other definition
commands have no difference in behavior when used in a private definition
context.
.RE
.VE
.VE TIP500
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
155
156
157
158
159
160
161





162
163
164
165

166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

189
190
191
192
193

194

195
196
197
198











199


200
201
202
203
204
205
206
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226

227
228

229
230
231
232
233
234

235

236
237
238
239
240
241
242
243
244
245
246

247
248
249
250
251
252
253

254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269

270
271
272
273
274
275
276
277
278







+
+
+
+
+



-
+

-






-

-











-
+





+
-
+




+
+
+
+
+
+
+
+
+
+
+
-
+
+







.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .
.RS
.PP
.VS TIP470
If no arguments at all are used, this gives the name of the class currently
being configured.
.VE TIP470
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), the definitions on the class object will also be made in a private
definition context.
.VE TIP500
.RE
.TP
\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.VS
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
allows the alteration of the superclasses of the class being defined.
Each \fIclassName\fR argument names one class that is to be a superclass of
the defined class. Note that objects must not be changed from being classes to
being non-classes or vice-versa, that an empty parent class is equivalent to
\fBoo::object\fR, and that the parent classes of \fBoo::object\fR and
\fBoo::class\fR may not be modified.
.VS
By default, this slot works by replacement.
.VE
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be not exported
(i.e. not usable outside the instance through the instance object's command,
but instead just through the \fBmy\fR command visible in each object's
context) by the class being defined. Note that the methods themselves may be
actually defined by a superclass; subclass unexports override superclass
visibility, and may be overridden by instance unexports.
.TP
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
.VS
.
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
variables to be automatically made
available in the methods, constructor and destructor declared by the class
being defined. Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
actually present in the namespace of the instance object on which the method
actually present in the instance object on which the method is executed. Note
is executed. Note
that the variable lists declared by a superclass or subclass are completely
disjoint, as are variable lists declared by instances; the list of variable
names is just for methods (and constructors and destructors) declared by this
class. By default, this slot works by appending.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this slot manipulates the list of private variable bindings for this
class. In a private variable binding, the name of the variable within the
instance object is different to the name given in the definition; the name
used in the definition is the name that you use to access the variable within
the methods of this class, and the name of the variable in the instance
namespace has a unique prefix that makes accidental use from other classes
extremely unlikely.
.VE
.VE TIP500
.RE
.SS "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:
.TP
\fBclass\fI className\fR
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246







247
248
249
250
251
252
253
254
255
256







257
258
259

260
261
262
263
264
265
266
















267

268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292

293
294
295
296

297

298
299
300


























301
302
303
304
305
306

307
308
309
310








311
312
313



314
315
316
317
318




319
320
321

322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341













342


















343
344

345
346
347











348
349
350
351
352
353
354







355

356
357
358
359
360
361
362
291
292
293
294
295
296
297

298
299

300
301
302
303
304
305

306

307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341

342
343

344
345
346

347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363

364
365
366
367
368
369
370
371
372
373
374

375
376
377
378
379
380
381
382
383
384
385
386
387

388
389
390
391
392
393

394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428

429
430

431
432
433
434
435
436
437
438
439
440



441
442
443
444




445
446
447
448
449
450

451
452
453
454
455
456
457
458
459
460
461
462
463

464
465





466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498

499
500
501

502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526

527
528
529
530
531
532
533
534







-
+

-






-

-









+
+
+
+
+
+
+










+
+
+
+
+
+
+


-
+

-



-

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+










-













-
+




+
-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+

-


+
+
+
+
+
+
+
+
-
-
-
+
+
+

-
-
-
-
+
+
+
+


-
+












-


-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


-
+
+
+
+
+
+
+
+
+
+
+







+
+
+
+
+
+
+
-
+







.
This arranges for each of the named methods, \fIname\fR, to be exported
(i.e. usable outside the object through the object's command) by the object
being defined. Note that the methods themselves may be actually defined by a
class or superclass; object exports override class visibility.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.VS
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
not exposed); it is not an error for a non-existent method to be named. Note
that the actual list of filters also depends on the filters set upon any
classes that the object is an instance of.
.VS
By default, this slot works by appending.
.VE
.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
This creates or updates a forwarded object method called \fIname\fR. The
method is defined be forwarded to the command called \fIcmdName\fR, with
additional arguments, \fIarg\fR etc., added before those arguments specified
by the caller of the method. Forwarded methods should be deleted using the
\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
a lower-case letter, and non-exported otherwise.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private forwarded methods.
.VE TIP500
.RE
.TP
\fBmethod\fI name argList bodyScript\fR
.
This creates, updates or deletes an object method. The name of the method is
\fIname\fR, the formal arguments to the method (defined using the same format
as for the Tcl \fBproc\fR command) will be \fIargList\fR, and the body of the
method will be \fIbodyScript\fR. When the body of the method is evaluated, the
current namespace of the method will be a namespace that is unique to the
object. The method will be exported if \fIname\fR starts with a lower-case
letter, and non-exported otherwise.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private procedure-like methods.
.VE TIP500
.RE
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.VS
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates a per-object list of additional classes that are to be
mixed into the object. Each argument, \fIclassName\fR, names a single class
that is to be mixed in.
.VS
By default, this slot works by replacement.
.TP
\fBprivate \fIcmd arg...\fR
.TP
\fBprivate \fIscript\fR
.VS TIP500
This evaluates the \fIscript\fR (or the list of command and arguments given by
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
current object will be private definitions.
.RS
.PP
The following class definition commands are affected by \fBprivate\fR:
\fBforward\fR, \fBmethod\fR, and \fBvariable\fR. Nesting \fBprivate\fR inside
\fBprivate\fR has no cumulative effect; the innermost definition context is
just a private definition context. All other definition commands have no
difference in behavior when used in a private definition context.
.RE
.VE
.VE TIP500
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of. Does not change the export status of the
method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be not exported
(i.e. not usable outside the object through the object's command, but instead
just through the \fBmy\fR command visible in the object's context) by the
object being defined. Note that the methods themselves may be actually defined
by a class; instance unexports override class visibility.
.TP
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
.VS
.
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
variables to be automatically made available in the methods declared by the
object being defined.  Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
actually present in the namespace of the object on which the method is
actually present in the object on which the method is executed. Note that the
executed. Note that the
variable lists declared by the classes and mixins of which the object is an
instance are completely disjoint; the list of variable names is just for
methods declared by this object. By default, this slot works by appending.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this slot manipulates the list of private variable bindings for this
object.  In a private variable binding, the name of the variable within the
instance object is different to the name given in the definition; the name
used in the definition is the name that you use to access the variable within
the methods of this instance object, and the name of the variable in the
instance namespace has a unique prefix that makes accidental use from
superclass methods extremely unlikely.
.VE TIP500
.RE
.SH "PRIVATE METHODS"
.VS TIP500
When a class or instance has a private method, that private method can only be
invoked from within methods of that class or instance. Other callers of the
object's methods \fIcannot\fR invoke private methods, it is as if the private
methods do not exist. However, a private method of a class \fIcan\fR be
invoked from the class's methods when those methods are being used on another
instance object; this means that a class can use them to coordinate behaviour
between several instances of itself without interfering with how other
classes (especially either subclasses or superclasses) interact. Private
methods precede all mixed in classes in the method call order (as reported by
\fBself call\fR).
.VE TIP500
.SH "SLOTTED DEFINITIONS"
Some of the configurable definitions of a class or object are \fIslotted
definitions\fR. This means that the configuration is implemented by a slot
object, that is an instance of the class \fBoo::Slot\fR, which manages a list
of values (class names, variable names, etc.) that comprises the contents of
the slot. The class defines three operations (as methods) that may be done on
the slot. The class defines five operations (as methods) that may be done on
the slot:
.VE
.TP
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
.
This appends the given \fImember\fR elements to the slot definition.
.TP
\fIslot\fR \fB\-clear\fR
.
This sets the slot definition to the empty list.
.TP
\fIslot\fR \fB\-prepend\fR ?\fImember ...\fR?
.VS
This appends the given \fImember\fR elements to the slot definition.
.VE
.VS TIP516
This prepends the given \fImember\fR elements to the slot definition.
.VE TIP516
.TP
\fIslot\fR \fB\-clear\fR
.VS
This sets the slot definition to the empty list.
.VE
\fIslot\fR \fB\-remove\fR ?\fImember ...\fR?
.VS TIP516
This removes the given \fImember\fR elements from the slot definition.
.VE TIP516
.TP
\fIslot\fR \fB\-set\fR ?\fImember ...\fR?
.VS
.
This replaces the slot definition with the given \fImember\fR elements.
.PP
A consequence of this is that any use of a slot's default operation where the
first member argument begins with a hyphen will be an error. One of the above
operations should be used explicitly in those circumstances.
.SS "SLOT IMPLEMENTATION"
Internally, slot objects also define a method \fB\-\-default\-operation\fR
which is forwarded to the default operation of the slot (thus, for the class
.QW \fBvariable\fR
slot, this is forwarded to
.QW "\fBmy \-append\fR" ),
and these methods which provide the implementation interface:
.VE
.TP
\fIslot\fR \fBGet\fR
.VS
Returns a list that is the current contents of the slot. This method must
always be called from a stack frame created by a call to \fBoo::define\fR or
\fBoo::objdefine\fR.
.VE
.
Returns a list that is the current contents of the slot, but does not modify
the slot. This method must always be called from a stack frame created by a
call to \fBoo::define\fR or \fBoo::objdefine\fR. This method \fIshould not\fR
return an error unless it is called from outside a definition context or with
the wrong number of arguments.
.RS
.PP
.VS TIP516
The elements of the list should be fully resolved, if that is a meaningful
concept to the slot.
.VE TIP516
.RE
.TP
\fIslot\fR \fBResolve\fR \fIslotElement\fR
.VS TIP516
Returns \fIslotElement\fR with a resolution operation applied to it, but does
not modify the slot. For slots of simple strings, this is an operation that
does nothing, whereas for slots of classes, this maps a class name to its
fully-qualified class name.  This method must always be called from a stack
frame created by a call to \fBoo::define\fR or \fBoo::objdefine\fR.  This
method \fIshould not\fR return an error unless it is called from outside a
definition context or with the wrong number of arguments; unresolvable
arguments should be returned as is (as not all slot operations strictly
require that values are resolvable to work).
.RS
.PP
Implementations \fIshould not\fR enforce uniqueness and ordering constraints
in this method; that is the responsibility of the \fBSet\fR method.
.RE
.VE TIP516
.TP
\fIslot\fR \fBSet \fIelementList\fR
.VS
.
Sets the contents of the slot to the list \fIelementList\fR and returns the
empty string. This method must always be called from a stack frame created by
a call to \fBoo::define\fR or \fBoo::objdefine\fR.
a call to \fBoo::define\fR or \fBoo::objdefine\fR. This method may return an
error if it rejects the change to the slot contents (e.g., because of invalid
values) as well as if it is called from outside a definition context or with
the wrong number of arguments.
.RS
.PP
This method \fImay\fR reorder and filter the elements if this is necessary in
order to satisfy the underlying constraints of the slot. (For example, slots
of classes enforce a uniqueness constraint that places each element in the
earliest location in the slot that it can.)
.RE
.PP
The implementation of these methods is slot-dependent (and responsible for
accessing the correct part of the class or object definition). Slots also have
an unknown method handler to tie all these pieces together, and they hide
their \fBdestroy\fR method so that it is not invoked inadvertently. It is
\fIrecommended\fR that any user changes to the slot mechanism be restricted to
defining new operations whose names start with a hyphen.
.PP
.VS TIP516
Most slot operations will initially \fBResolve\fR their argument list, combine
it with the results of the \fBGet\fR method, and then \fBSet\fR the result.
Some operations omit one or both of the first two steps; omitting the third
would result in an idempotent read-only operation (but the standard mechanism
for reading from slots is via \fBinfo class\fR and \fBinfo object\fR).
.VE
.VE TIP516
.SH EXAMPLES
This example demonstrates how to use both forms of the \fBoo::define\fR and
\fBoo::objdefine\fR commands (they work in the same way), as well as
illustrating four of the subcommands of them.
.PP
.CS
oo::class create c
405
406
407
408
409
410
411














































































412
413
414
415
416
417
418
419
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








}
\fBoo::objdefine\fR inst {
    \fBmixin -append\fR B
}
inst m1              \fI\(-> prints "red brick"\fR
inst m2              \fI\(-> prints "blue brick"\fR
.CE
.PP
.VS TIP478
This example shows how to create and use class variables. It is a class that
counts how many instances of itself have been made.
.PP
.CS
oo::class create Counted
\fBoo::define\fR Counted {
    \fBinitialise\fR {
        variable count 0
    }

    \fBvariable\fR number
    \fBconstructor\fR {} {
        classvariable count
        set number [incr count]
    }

    \fBmethod\fR report {} {
        classvariable count
        puts "This is instance $number of $count"
    }
}

set a [Counted new]
set b [Counted new]
$a report
        \fI\(-> This is instance 1 of 2\fR
set c [Counted new]
$b report
        \fI\(-> This is instance 2 of 3\fR
$c report
        \fI\(-> This is instance 3 of 3\fR
.CE
.PP
This example demonstrates how to use class methods. (Note that the constructor
for \fBoo::class\fR calls \fBoo::define\fR on the class.)
.PP
.CS
oo::class create DBTable {
    \fBclassmethod\fR find {description} {
        puts "DB: locate row from [self] matching $description"
        return [my new]
    }
    \fBclassmethod\fR insert {description} {
        puts "DB: create row in [self] matching $description"
        return [my new]
    }
    \fBmethod\fR update {description} {
        puts "DB: update row [self] with $description"
    }
    \fBmethod\fR delete {} {
        puts "DB: delete row [self]"
        my destroy; # Just delete the object, not the DB row
    }
}

oo::class create Users {
    \fBsuperclass\fR DBTable
}
oo::class create Groups {
    \fBsuperclass\fR DBTable
}

set u1 [Users insert "username=abc"]
        \fI\(-> DB: create row from ::Users matching username=abc\fR
set u2 [Users insert "username=def"]
        \fI\(-> DB: create row from ::Users matching username=def\fR
$u2 update "group=NULL"
        \fI\(-> DB: update row ::oo::Obj124 with group=NULL\fR
$u1 delete
        \fI\(-> DB: delete row ::oo::Obj123\fR
set g [Group find "groupname=webadmins"]
        \fI\(-> DB: locate row ::Group with groupname=webadmins\fR
$g update "emailaddress=admins"
        \fI\(-> DB: update row ::oo::Obj125 with emailaddress=admins\fR
.CE
.VE TIP478
.SH "SEE ALSO"
next(n), oo::class(n), oo::object(n)
.SH KEYWORDS
class, definition, method, object, slot
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/dict.n.

23
24
25
26
27
28
29





30
31
32
33
34
35
36
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41







+
+
+
+
+







\fBdict append \fIdictionaryVariable key \fR?\fIstring ...\fR?
.
This appends the given string (or strings) to the value that the given
key maps to in the dictionary value contained in the given variable,
writing the resulting dictionary value back to that variable.
Non-existent keys are treated as if they map to an empty string. The
updated dictionary value is returned.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the appending operation.
.VE TIP508
.TP
\fBdict create \fR?\fIkey value ...\fR?
.
Return a new dictionary that contains each of the key/value mappings
listed as arguments (keys and values alternating, with each key being
followed by its associated value.)
.TP
120
121
122
123
124
125
126





127
128
129
130
131
132
133
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143







+
+
+
+
+







This adds the given increment value (an integer that defaults to 1 if
not specified) to the value that the given key maps to in the
dictionary value contained in the given variable, writing the
resulting dictionary value back to that variable. Non-existent keys
are treated as if they map to 0. It is an error to increment a value
for an existing key if that value is not an integer. The updated
dictionary value is returned.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the incrementing operation.
.VE TIP508
.TP
\fBdict info \fIdictionaryValue\fR
.
This returns information (intended for display to people) about the
given dictionary though the format of this data is dependent on the
implementation of the dictionary. For dictionaries that are
implemented by hash tables, it is expected that this will return the
145
146
147
148
149
150
151





152
153
154
155
156
157
158
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173







+
+
+
+
+







This appends the given items to the list value that the given key maps
to in the dictionary value contained in the given variable, writing
the resulting dictionary value back to that variable. Non-existent
keys are treated as if they map to an empty list, and it is legal for
there to be no items to append to the list. It is an error for the
value that the key maps to to not be representable as a list. The
updated dictionary value is returned.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the list-appending operation.
.VE TIP508
.TP
\fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
.
This command applies a transformation to each element of a dictionary,
returning a new dictionary. It takes three arguments: the first is a
two-element list of variable names (for the key and value respectively of each
mapping in the dictionary), the second the dictionary value to iterate across,
202
203
204
205
206
207
208





209
210
211
212
213
214
215
216
217
218
219
220
221
222
223





224
225
226
227
228
229
230
231
232
233
234
235
236
237
238





239
240
241
242
243
244
245
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275







+
+
+
+
+















+
+
+
+
+















+
+
+
+
+







\fBdict set \fIdictionaryVariable key \fR?\fIkey ...\fR? \fIvalue\fR
.
This operation takes the name of a variable containing a dictionary
value and places an updated dictionary value in that variable
containing a mapping from the given key to the given value. When
multiple keys are present, this operation creates or updates a chain
of nested dictionaries. The updated dictionary value is returned.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the value insert/update operation.
.VE TIP508
.TP
\fBdict size \fIdictionaryValue\fR
.
Return the number of key/value mappings in the given dictionary value.
.TP
\fBdict unset \fIdictionaryVariable key \fR?\fIkey ...\fR?
.
This operation (the companion to \fBdict set\fR) takes the name of a
variable containing a dictionary value and places an updated
dictionary value in that variable that does not contain a mapping for
the given key. Where multiple keys are present, this describes a path
through nested dictionaries to the mapping to remove. At least one key
must be specified, but the last key on the key-path need not exist.
All other components on the path must exist. The updated dictionary
value is returned.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the value remove operation.
.VE TIP508
.TP
\fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
.
Execute the Tcl script in \fIbody\fR with the value for each \fIkey\fR
(as found by reading the dictionary value in \fIdictionaryVariable\fR)
mapped to the variable \fIvarName\fR. There may be multiple
\fIkey\fR/\fIvarName\fR pairs. If a \fIkey\fR does not have a mapping,
that corresponds to an unset \fIvarName\fR. When \fIbody\fR
terminates, any changes made to the \fIvarName\fRs is reflected back
to the dictionary within \fIdictionaryVariable\fR (unless
\fIdictionaryVariable\fR itself becomes unreadable, when all updates
are silently discarded), even if the result of \fIbody\fR is an error
or some other kind of exceptional exit. The result of \fBdict
update\fR is (unless some kind of error occurs) the result of the
evaluation of \fIbody\fR.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the update operation.
.VE TIP508
.RS
.PP
Each \fIvarName\fR is mapped in the scope enclosing the \fBdict update\fR;
it is recommended that this command only be used in a local scope
(\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
this, the variables set by \fBdict update\fR will continue to
exist after the command finishes (unless explicitly \fBunset\fR).
266
267
268
269
270
271
272





273
274
275
276
277
278
279
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314







+
+
+
+
+







for the execution of \fIbody\fR. As with \fBdict update\fR, making
\fIdictionaryVariable\fR unreadable will make the updates to the
dictionary be discarded, and this also happens if the contents of
\fIdictionaryVariable\fR are adjusted so that the chain of
dictionaries no longer exists. The result of \fBdict with\fR is
(unless some kind of error occurs) the result of the evaluation of
\fIbody\fR.
.VS TIP508
If \fIdictionaryVarable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the updating operation.
.VE TIP508
.RS
.PP
The variables are mapped in the scope enclosing the \fBdict with\fR;
it is recommended that this command only be used in a local scope
(\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
this, the variables set by \fBdict with\fR will continue to
exist after the command finishes (unless explicitly \fBunset\fR).

Changes to doc/eof.n.

55
56
57
58
59
60
61




55
56
57
58
59
60
61
62
63
64
65







+
+
+
+
    puts "Read record: $record"
}
.CE
.SH "SEE ALSO"
file(n), open(n), close(n), fblocked(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, end of file
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/exec.n.

212
213
214
215
216
217
218













219
220
221
222
223
224
225
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238







+
+
+
+
+
+
+
+
+
+
+
+
+







.QW \fB@\0\fIfileId\fR
notation, does not work.  When reading from a socket, a 16-bit DOS
application will hang and a 32-bit application will return immediately with
end-of-file.  When either type of application writes to a socket, the
information is instead sent to the console, if one is present, or is
discarded.
.RS
.PP
Note that the current escape resp. quoting of arguments for windows works only
with executables using CommandLineToArgv, CRT-library or similar, as well as
with the windows batch files (excepting the newline, see below).
Although it is the common escape algorithm, but, in fact, the way how the
executable parses the command-line (resp. splits it into single arguments)
is decisive.
.PP
Unfortunately, there is currently no way to supply newline character within
an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command
processor (\fBcmd.exe /c\fR), because this causes truncation of command-line
(also the argument chain) on the first newline character.
But it works properly with an executable (using CommandLineToArgv, etc).
.PP
The Tk console text widget does not provide real standard IO capabilities.
Under Tk, when redirecting from standard input, all applications will see an
immediate end-of-file; information redirected to standard output or standard
error will be discarded.
.PP
Either forward or backward slashes are accepted as path separators for
405
406
407
408
409
410
411




412
413
414
415
416
417
418
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435







+
+
+
+







.CS
\fBexec\fR cmp.bat somefile.c -o somefile
.CE
.PP
With the file \fIcmp.bat\fR looking something like:
.PP
.CS
@gcc %*
.CE
or like another variant using single parameters:
.CS
@gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
.CE
.SS "WORKING WITH COMMAND BUILT-INS"
.PP
Sometimes you need to be careful, as different programs may have the
same name and be in the path. It can then happen that typing a command
at the DOS prompt finds \fIa different program\fR than the same

Changes to doc/exit.n.

45
46
47
48
49
50
51




45
46
47
48
49
50
51
52
53
54
55







+
+
+
+
    \fBexit\fR 2
}
.CE
.SH "SEE ALSO"
exec(n)
.SH KEYWORDS
abort, exit, process
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/expr.n.

46
47
48
49
50
51
52
53



54
55
56
57
58
59
60
46
47
48
49
50
51
52

53
54
55
56
57
58
59
60
61
62







-
+
+
+







An expression consists of a combination of operands, operators, parentheses and
commas, possibly with whitespace between any of these elements, which is
ignored.
An integer operand may be specified in decimal (the normal case, the optional
first two characters are \fB0d\fR), binary
(the first two characters are \fB0b\fR), octal
(the first two characters are \fB0o\fR), or hexadecimal
(the first two characters are \fB0x\fR) form.
(the first two characters are \fB0x\fR) form.  For
compatibility with older Tcl releases, an operand that begins with \fB0\fR is
interpreted as an octal integer even if the second character is not \fBo\fR.
A floating-point number may be specified in any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
the sign characters \fB+\fR and \fB\-\fR.  The
following are all valid floating-point numbers:  2.1, 3., 6e4, 7.91e+16.
The strings \fBInf\fR
and \fBNaN\fR, in any combination of case, are also recognized as floating point

Changes to doc/fblocked.n.

61
62
63
64
65
66
67




61
62
63
64
65
66
67
68
69
70
71







+
+
+
+
socket -server connect 12345
vwait forever
.CE
.SH "SEE ALSO"
gets(n), open(n), read(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, nonblocking
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/fileevent.n.

150
151
152
153
154
155
156




150
151
152
153
154
155
156
157
158
159
160







+
+
+
+
\fBfileevent\fR is based on the \fBaddinput\fR command created
by Mark Diekhans.
.SH "SEE ALSO"
fconfigure(n), gets(n), interp(n), puts(n), read(n), Tcl_StandardChannels(3)
.SH KEYWORDS
asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
script, writable.
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/filename.n.

172
173
174
175
176
177
178




172
173
174
175
176
177
178
179
180
181
182







+
+
+
+
.QW .....abc
is illegal.
.SH "SEE ALSO"
file(n), glob(n)
.SH KEYWORDS
current directory, absolute file name, relative file name,
volume-relative file name, portability
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/flush.n.

39
40
41
42
43
44
45




39
40
41
42
43
44
45
46
47
48
49







+
+
+
+
gets stdin name
puts "Hello there, $name!"
.CE
.SH "SEE ALSO"
file(n), open(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, buffer, channel, flush, nonblocking, output
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/foreach.n.

98
99
100
101
102
103
104




98
99
100
101
102
103
104
105
106
107
108







+
+
+
+
.CE

.SH "SEE ALSO"
for(n), while(n), break(n), continue(n)

.SH KEYWORDS
foreach, iteration, list, loop
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/format.n.

79
80
81
82
83
84
85
86
87
88



89
90
91
92
93



94
95
96
97
98
99
100
79
80
81
82
83
84
85



86
87
88
89
90
91


92
93
94
95
96
97
98
99
100
101







-
-
-
+
+
+



-
-
+
+
+







number if the first character is not a sign.
.TP 10
\fB0\fR
Specifies that the number should be padded on the left with
zeroes instead of spaces.
.TP 10
\fB#\fR
Requests an alternate output form. For \fBo\fR and \fBO\fR
conversions it guarantees that the first digit is always \fB0\fR.
For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively)
Requests an alternate output form. For \fBo\fR conversions,
\fB0o\fR will be added to the beginning of the result unless
it is zero. For \fBx\fR or \fBX\fR conversions, \fB0x\fR
will be added to the beginning of the result unless it is zero.
For \fBb\fR conversions, \fB0b\fR
will be added to the beginning of the result unless it is zero.
For \fBd\fR conversions, \fB0d\fR will be added to the beginning
of the result unless it is zero.
For \fBd\fR conversions, \fB0d\fR there is no effect unless
the \fB0\fR specifier is used as well: In that case, \fB0d\fR
will be added to the beginning.
For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR,
\fBg\fR, and \fBG\fR) it guarantees that the result always
has a decimal point.
For \fBg\fR and \fBG\fR conversions it specifies that
trailing zeroes should not be removed.
.SS "OPTIONAL FIELD WIDTH"
.PP
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142


143

144
145
146
147
148
149
150
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143
144
145

146
147
148
149
150
151
152
153







-
+







+
+
-
+







printed; if the string is longer than this then the trailing characters will be dropped.
If the precision is specified with \fB*\fR rather than a number
then the next argument to the \fBformat\fR command determines the precision;
it must be a numeric string.
.SS "OPTIONAL SIZE MODIFIER"
.PP
The fifth part of a conversion specifier is a size modifier,
which must be \fBll\fR, \fBh\fR, or \fBl\fR.
which must be \fBll\fR, \fBh\fR, \fBl\fR, or \fBL\fR.
If it is \fBll\fR it specifies that an integer value is taken
without truncation for conversion to a formatted substring.
If it is \fBh\fR it specifies that an integer value is
truncated to a 16-bit range before converting.  This option is rarely useful.
If it is \fBl\fR it specifies that the integer value is
truncated to the same range as that produced by the \fBwide()\fR
function of the \fBexpr\fR command (at least a 64-bit range).
If it is \fBL\fR it specifies that an integer or double value is taken
without truncation for conversion to a formatted substring.
If neither \fBh\fR nor \fBl\fR are present, the integer value is
If neither \fBh\fR nor \fBl\fR nor \fBL\fR are present, the integer value is
truncated to the same range as that produced by the \fBint()\fR
function of the \fBexpr\fR command (at least a 32-bit range, but
determined by the value of the \fBwordSize\fR element of the
\fBtcl_platform\fR array).
.SS "MANDATORY CONVERSION TYPE"
.PP
The last thing in a conversion specifier is an alphabetic character
167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
170
171
172
173
174
175
176

177
178
179
180
181
182
183
184







-
+







Convert integer to unsigned hexadecimal string, using digits
.QW 0123456789abcdef
for \fBx\fR and
.QW 0123456789ABCDEF
for \fBX\fR).
.TP 10
\fBb\fR
Convert integer to binary string, using digits 0 and 1.
Convert integer to unsigned binary string, using digits 0 and 1.
.TP 10
\fBc\fR
Convert integer to the Unicode character it represents.
.TP 10
\fBs\fR
No conversion; just insert string.
.TP 10
196
197
198
199
200
201
202







203
204




205
206
207
208
209
210
211
212
213

214
215
216
217
218
219
220
221
222
223
224
225
226
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226

227
228
229
230
231
232

233
234
235
236
237
238
239







+
+
+
+
+
+
+


+
+
+
+








-
+





-







\fBg\fR or \fBG\fR
If the exponent is less than \-4 or greater than or equal to the
precision, then convert number as for \fB%e\fR or
\fB%E\fR.
Otherwise convert as for \fB%f\fR.
Trailing zeroes and a trailing decimal point are omitted.
.TP 10
\fBa\fR or \fBA\fR
Convert double to hexadecimal notation in the form
\fI0x1.yyy\fBp\(+-\fIzz\fR, where the number of \fIy\fR's is
determined by the precision (default: 13).
If the \fBA\fR form is used then the hex characters
are printed in uppercase.
.TP 10
\fB%\fR
No conversion: just insert \fB%\fR.
.TP 10
\fBp\fR
Shorthand form for \fB0x%zx\fR, so it outputs the integer in
hexadecimal form with \fB0x\fR prefix.
.SH "DIFFERENCES FROM ANSI SPRINTF"
.PP
The behavior of the format command is the same as the
ANSI C \fBsprintf\fR procedure except for the following
differences:
.IP [1]
Tcl guarantees that it will be working with UNICODE characters.
.IP [2]
\fB%p\fR and \fB%n\fR specifiers are not supported.
\fB%n\fR specifier is not supported.
.IP [3]
For \fB%c\fR conversions the argument must be an integer value,
which will then be converted to the corresponding character value.
.IP [4]
The size modifiers are ignored when formatting floating-point values.
The \fBll\fR modifier has no \fBsprintf\fR counterpart.
The \fBb\fR specifier has no \fBsprintf\fR counterpart.
.SH EXAMPLES
.PP
Convert the numeric value of a UNICODE character to the character
itself:
.PP
.CS

Changes to doc/global.n.

52
53
54
55
56
57
58




52
53
54
55
56
57
58
59
60
61
62







+
+
+
+
    append accumulator $string \en
}
.CE
.SH "SEE ALSO"
namespace(n), upvar(n), variable(n)
.SH KEYWORDS
global, namespace, procedure, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/history.n.

96
97
98
99
100
101
102




96
97
98
99
100
101
102
103
104
105
106







+
+
+
+
is modified to eliminate the history command and replace it with
the result of the history command.
If you want to redo an event without modifying history, then use
the \fBevent\fR operation to retrieve some event,
and the \fBadd\fR operation to add it to history and execute it.
.SH KEYWORDS
event, history, record
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/http.n.

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16

17
18
19

20
21
22
23


24
25
26
27
28
29
30
1
2
3
4
5
6
7
8

9
10
11
12
13
14
15

16
17
18

19
20
21
22
23
24
25
26
27
28
29
30
31
32








-
+






-
+


-
+




+
+







'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 by Ajuba Solutions.
'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "http" n 2.7 http "Tcl Bundled Packages"
.TH "http" n 2.9 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
http \- Client-side implementation of the HTTP/1.1 protocol
.SH SYNOPSIS
\fBpackage require http ?2.7?\fR
\fBpackage require http\fI ?\fB2.8\fR?
.\" See Also -useragent option documentation in body!
.sp
\fB::http::config ?\fI\-option value\fR ...?
\fB::http::config\fR ?\fI\-option value\fR ...?
.sp
\fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...?
.sp
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
.sp
\fB::http::quoteString\fR \fIvalue\fR
.sp
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.sp
\fB::http::wait \fItoken\fR
.sp
\fB::http::status \fItoken\fR
.sp
40
41
42
43
44
45
46


47
48
49
50
51
52

53
54
55
56
57
58
59
42
43
44
45
46
47
48
49
50
51
52
53
54
55

56
57
58
59
60
61
62
63







+
+





-
+







.sp
\fB::http::error \fItoken\fR
.sp
\fB::http::cleanup \fItoken\fR
.sp
\fB::http::register \fIproto port command\fR
.sp
\fB::http::registerError \fIport\fR ?\fImessage\fR?
.sp
\fB::http::unregister \fIproto\fR
.BE
.SH DESCRIPTION
.PP
The \fBhttp\fR package provides the client side of the HTTP/1.1
protocol, as defined in RFC 2616.
protocol, as defined in RFC 7230 to RFC 7235, which supersede RFC 2616.
The package implements the GET, POST, and HEAD operations
of HTTP/1.1.  It allows configuration of a proxy host to get through
firewalls.  The package is compatible with the \fBSafesock\fR security
policy, so it can be used by untrusted applets to do URL fetching from
a restricted set of hosts. This package can be extended to support
additional HTTP transport protocols, such as HTTPS, by providing
a custom \fBsocket\fR command, via \fB::http::register\fR.
90
91
92
93
94
95
96






















97
98
99
100
101
102
103
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
128
129







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







\fB\-accept\fR \fImimetypes\fR
.
The Accept header of the request.  The default is */*, which means that
all types of documents are accepted.  Otherwise you can supply a
comma-separated list of mime type patterns that you are
willing to receive.  For example,
.QW "image/gif, image/jpeg, text/*" .
.TP
\fB\-cookiejar\fR \fIcommand\fR
.VS TIP406
The cookie store for the package to use to manage HTTP cookies.
\fIcommand\fR is a command prefix list; if the empty list (the
default value) is used, no cookies will be sent by requests or stored
from responses. The command indicated by \fIcommand\fR, if supplied,
must obey the \fBCOOKIE JAR PROTOCOL\fR described below.
.VE TIP406
.TP
\fB\-pipeline\fR \fIboolean\fR
.
Specifies whether HTTP/1.1 transactions on a persistent socket will be
pipelined.  See the \fBPERSISTENT SOCKETS\fR section for details. The default
is 1.
.TP
\fB\-postfresh\fR \fIboolean\fR
.
Specifies whether requests that use the \fBPOST\fR method will always use a
fresh socket, overriding the \fB-keepalive\fR option of
command \fBhttp::geturl\fR.  See the \fBPERSISTENT SOCKETS\fR section for details.
The default is 0.
.TP
\fB\-proxyhost\fR \fIhostname\fR
.
The name of the proxy host, if any.  If this value is the
empty string, the URL host is contacted directly.
.TP
\fB\-proxyport\fR \fInumber\fR
111
112
113
114
115
116
117












118
119
120
121

122

123
124
125
126
127


128
129
130
131
132
















133
134
135
136
137
138
139
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160

161
162
163
164


165
166
167
168
169


170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192







+
+
+
+
+
+
+
+
+
+
+
+




+
-
+



-
-
+
+



-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







to determine if a proxy is required for a given host.  One argument, a
host name, is added to \fIcommand\fR when it is invoked.  If a proxy
is required, the callback should return a two-element list containing
the proxy server and proxy port.  Otherwise the filter should return
an empty list.  The default filter returns the values of the
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
non-empty.
.TP
\fB\-repost\fR \fIboolean\fR
.
Specifies what to do if a POST request over a persistent connection fails
because the server has half-closed the connection.  If boolean \fBtrue\fR, the
request
will be automatically retried; if boolean \fBfalse\fR it will not, and the
application
that uses \fBhttp::geturl\fR is expected to seek user confirmation before
retrying the POST.  The value \fBtrue\fR should be used only under certain
conditions. See the \fBPERSISTENT SOCKETS\fR section for details. The
default is 0.
.TP
\fB\-urlencoding\fR \fIencoding\fR
.
The \fIencoding\fR used for creating the x-url-encoded URLs with
\fB::http::formatQuery\fR and \fB::http::quoteString\fR.
\fB::http::formatQuery\fR.  The default is \fButf-8\fR, as specified by RFC
The default is \fButf-8\fR, as specified by RFC
2718.  Prior to http 2.5 this was unspecified, and that behavior can be
returned by specifying the empty string (\fB{}\fR), although
\fIiso8859-1\fR is recommended to restore similar behavior but without the
\fB::http::formatQuery\fR throwing an error processing non-latin-1
characters.
\fB::http::formatQuery\fR or \fB::http::quoteString\fR
throwing an error processing non-latin-1 characters.
.TP
\fB\-useragent\fR \fIstring\fR
.
The value of the User-Agent header in the HTTP request.  The default is
.QW "\fBTcl http client package 2.7\fR" .
The value of the User-Agent header in the HTTP request.  In an unsafe
interpreter, the default value depends upon the operating system, and
the version numbers of \fBhttp\fR and \fBTcl\fR, and is (for example)
.QW "\fBMozilla/5.0 (Windows; U; Windows NT 10.0) http/2.8.12 Tcl/8.6.8\fR" .
A safe interpreter cannot determine its operating system, and so the default
in a safe interpreter is to use a Windows 10 value with the current version
numbers of \fBhttp\fR and \fBTcl\fR.
.TP
\fB\-zip\fR \fIboolean\fR
.
If the value is boolean \fBtrue\fR, then by default requests will send a header
.QW "\fBAccept-Encoding: gzip,deflate,compress\fR" .
If the value is boolean \fBfalse\fR, then by default this header will not be sent.
In either case the default can be overridden for an individual request by
supplying a custom \fBAccept-Encoding\fR header in the \fB-headers\fR option
of \fBhttp::geturl\fR. The default is 1.
.RE
.TP
\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
.
The \fB::http::geturl\fR command is the main procedure in the package.
The \fB\-query\fR option causes a POST operation and
the \fB\-validate\fR option causes a HEAD operation;
223
224
225
226
227
228
229
230

231
232
233
234
235
236
237
276
277
278
279
280
281
282

283
284
285
286
287
288
289
290







-
+







.CS
Pragma: no-cache
.CE
.RE
.TP
\fB\-keepalive\fR \fIboolean\fR
.
If true, attempt to keep the connection open for servicing
If boolean \fBtrue\fR, attempt to keep the connection open for servicing
multiple requests.  Default is 0.
.TP
\fB\-method\fR \fItype\fR
.
Force the HTTP request method to \fItype\fR. \fB::http::geturl\fR will
auto-select GET, POST or HEAD based on other options, but this option
enables choices like PUT and DELETE for webdav support.
329
330
331
332
333
334
335





336
337
338
339
340
341
342
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400







+
+
+
+
+







\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
.
This procedure does x-url-encoding of query data.  It takes an even
number of arguments that are the keys and values of the query.  It
encodes the keys and values, and generates one string that has the
proper & and = separators.  The result is suitable for the
\fB\-query\fR value passed to \fB::http::geturl\fR.
.TP
\fB::http::quoteString\fR \fIvalue\fR
.
This procedure does x-url-encoding of string.  It takes a single argument and
encodes it.
.TP
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.
This command resets the HTTP transaction identified by \fItoken\fR, if any.
This sets the \fBstate(status)\fR value to \fIwhy\fR, which defaults to
\fBreset\fR, and then calls the registered \fB\-command\fR callback.
.TP
410
411
412
413
414
415
416











417
418
419
420
421
422
423
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492







+
+
+
+
+
+
+
+
+
+
+







package require tls

::http::register https 443 ::tls::socket

set token [::http::geturl https://my.secure.site/]
.CE
.RE
.TP
\fB::http::registerError\fR \fIport\fR ?\fImessage\fR?
.
This procedure allows a registered protocol handler to deliver an error
message for use by \fBhttp\fR.  Calling this command does not raise an
error. The command is useful when a registered protocol detects an problem
(for example, an invalid TLS certificate) that will cause an error to
propagate to \fBhttp\fR.  The command allows \fBhttp\fR to provide a
precise error message rather than a general one.  The command returns the
value provided by the last call with argument \fImessage\fR, or the empty
string if no such call has been made.
.TP
\fB::http::unregister\fR \fIproto\fR
.
This procedure unregisters a protocol handler that was previously
registered via \fB::http::register\fR, returning a two-item list of
the default port and handler command that was previously installed
(via \fB::http::register\fR) if there was such a handler, and an error if
500
501
502
503
504
505
506








507
508
509
510
511
512
513
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590







+
+
+
+
+
+
+
+







Once the data associated with the URL is no longer needed, the state
array should be unset to free up storage.
The \fB::http::cleanup\fR procedure is provided for that purpose.
The following elements of
the array are supported:
.RS
.TP
\fBbinary\fR
.
This is boolean \fBtrue\fR if (after decoding any compression specified
by the
.QW "Content-Encoding"
response header) the HTTP response is binary.  It is boolean \fBfalse\fR
if the HTTP response is text.
.TP
\fBbody\fR
.
The contents of the URL.  This will be empty if the \fB\-channel\fR
option has been specified.  This value is returned by the \fB::http::data\fR command.
.TP
\fBcharset\fR
.
598
599
600
601
602
603
604










































































































































































































605
606
607
608
609
610
611
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







.
A copy of the \fBContent-Type\fR meta-data value.
.TP
\fBurl\fR
.
The requested URL.
.RE
.SH "PERSISTENT CONNECTIONS"
.PP
.SS "BASICS"
.PP
See RFC 7230 Sec 6, which supersedes RFC 2616 Sec 8.1.
.PP
A persistent connection allows multiple HTTP/1.1 transactions to be
carried over the same TCP connection.  Pipelining allows a
client to make multiple requests over a persistent connection without
waiting for each response.  The server sends responses in the same order
that the requests were received.
.PP
If a POST request fails to complete, typically user confirmation is
needed before sending the request again.  The user may wish to verify
whether the server was modified by the failed POST request, before
sending the same request again.
.PP
A HTTP request will use a persistent socket if the call to
\fBhttp::geturl\fR has the option \fB-keepalive true\fR. It will use
pipelining where permitted if the \fBhttp::config\fR option
\fB-pipeline\fR is boolean \fBtrue\fR (its default value).
.PP
The http package maintains no more than one persistent connection to each
server (i.e. each value of
.QW "domain:port" ).
If \fBhttp::geturl\fR is called to make a request over a persistent
connection while the connection is busy with another request, the new
request will be held in a queue until the connection is free.
.PP
The http package does not support HTTP/1.0 persistent connections
controlled by the \fBKeep-Alive\fR header.
.SS "SPECIAL CASES"
.PP
This subsection discusses issues related to closure of the
persistent connection by the server, automatic retry of failed requests,
the special treatment necessary for POST requests, and the options for
dealing with these cases.
.PP
In accordance with RFC 7230, \fBhttp::geturl\fR does not pipeline
requests that use the POST method.  If a POST uses a persistent
connection and is not the first request on that connection,
\fBhttp::geturl\fR waits until it has received the response for the previous
request; or (if \fBhttp::config\fR option \fB-postfresh\fR is boolean \fBtrue\fR) it
uses a new connection for each POST.
.PP
If the server is processing a number of pipelined requests, and sends a
response header
.QW "\fBConnection: close\fR"
with one of the responses (other than the last), then subsequent responses
are unfulfilled. \fBhttp::geturl\fR will send the unfulfilled requests again
over a new connection.
.PP
A difficulty arises when a HTTP client sends a request over a persistent
connection that has been idle for a while.  The HTTP server may
half-close an apparently idle connection while the client is sending a
request, but before the request arrives at the server: in this case (an
.QW "asynchronous close event" )
the request will fail.  The difficulty arises because the client cannot
be certain whether the POST modified the state of the server.  For HEAD or
GET requests, \fBhttp::geturl\fR opens another connection and retransmits
the failed request. However, if the request was a POST, RFC 7230 forbids
automatic retry by default, suggesting either user confirmation, or
confirmation by user-agent software that has semantic understanding of
the application.  The \fBhttp::config\fR option \fB-repost\fR allows for
either possibility.
.PP
Asynchronous close events can occur only in a short interval of time.  The
\fBhttp\fR package monitors each persistent connection for closure by the
server.  Upon detection, the connection is also closed at the client end,
and subsequent requests will use a fresh connection.
.PP
If the \fBhttp::geturl\fR command is called with option \fB-keepalive true\fR,
then it will both try to use an existing persistent connection
(if one is available), and it will send the server a
.QW "\fBConnection: keep-alive\fR"
request header asking to keep the connection open for future requests.
.PP
The \fBhttp::config\fR options \fB-pipeline\fR, \fB-postfresh\fR, and
\fB-repost\fR relate to persistent connections.
.PP
Option \fB-pipeline\fR, if boolean \fBtrue\fR, will pipeline GET and HEAD requests
made
over a persistent connection.  POST requests will not be pipelined - if the
POST is not the first transaction on the connection, its request will not
be sent until the previous response has finished.  GET and HEAD requests
made after a POST will not be sent until the POST response has been
delivered, and will not be sent if the POST fails.
.PP
Option \fB-postfresh\fR, if boolean \fBtrue\fR, will override the \fBhttp::geturl\fR option
\fB-keepalive\fR, and always open a fresh connection for a POST request.
.PP
Option \fB-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request
that fails because it uses a persistent connection that the server has
half-closed (an
.QW "asynchronous close event" ).
Subsequent GET and HEAD requests in a failed pipeline will also be retried.
\fIThe -repost option should be used only if the application understands
that the retry is appropriate\fR - specifically, the application must know
that if the failed POST successfully modified the state of the server, a repeat POST
would have no adverse effect.
.VS TIP406
.SH "COOKIE JAR PROTOCOL"
.PP
Cookies are short key-value pairs used to implement sessions within the
otherwise-stateless HTTP protocol. (See RFC 6265 for details; Tcl does not
implement the Cookie2 protocol as that is rarely seen in the wild.)
.PP
Cookie storage managment commands \(em
.QW "cookie jars"
\(em must support these subcommands which form the HTTP cookie storage
management protocol. Note that \fIcookieJar\fR below does not have to be a
command name; it is properly a command prefix (a Tcl list of words that will
be expanded in place) and admits many possible implementations.
.PP
Though not formally part of the protocol, it is expected that particular
values of \fIcookieJar\fR will correspond to sessions; it is up to the caller
of \fB::http::config\fR to decide what session applies and to manage the
deletion of said sessions when they are no longer desired (which should be
when they not configured as the current cookie jar).
.TP
\fIcookieJar \fBgetCookies \fIprotocol host requestPath\fR
.
This command asks the cookie jar what cookies should be supplied for a
particular request. It should take the \fIprotocol\fR (typically \fBhttp\fR or
\fBhttps\fR), \fIhost\fR name and \fIrequestPath\fR (parsed from the \fIurl\fR
argument to \fB::http::geturl\fR) and return a list of cookie keys and values
that describe the cookies to supply to the remote host. The list must have an
even number of elements.
.RS
.PP
There should only ever be at most one cookie with a particular key for any
request (typically the one with the most specific \fIhost\fR/domain match and
most specific \fIrequestPath\fR/path match), but there may be many cookies
with different names in any request.
.RE
.TP
\fIcookieJar \fBstoreCookie \fIcookieDictionary\fR
.
This command asks the cookie jar to store a particular cookie that was
returned by a request; the result of this command is ignored. The cookie
(which will have been parsed by the http package) is described by a
dictionary, \fIcookieDictionary\fR, that may have the following keys:
.RS
.TP
\fBdomain\fR
.
This is always present. Its value describes the domain hostname \fIor
prefix\fR that the cookie should be returned for.  The checking of the domain
against the origin (below) should be careful since sites that issue cookies
should only do so for domains related to themselves. Cookies that do not obey
a relevant origin matching rule should be ignored.
.TP
\fBexpires\fR
.
This is optional. If present, the cookie is intended to be a persistent cookie
and the value of the option is the Tcl timestamp (in seconds from the same
base as \fBclock seconds\fR) of when the cookie expires (which may be in the
past, which should result in the cookie being deleted immediately). If absent,
the cookie is intended to be a session cookie that should be not persisted
beyond the lifetime of the cookie jar.
.TP
\fBhostonly\fR
.
This is always present. Its value is a boolean that describes whether the
cookie is a single host cookie (true) or a domain-level cookie (false).
.TP
\fBhttponly\fR
.
This is always present. Its value is a boolean that is true when the site
wishes the cookie to only ever be used with HTTP (or HTTPS) traffic.
.TP
\fBkey\fR
.
This is always present. Its value is the \fIkey\fR of the cookie, which is
part of the information that must be return when sending this cookie back in a
future request.
.TP
\fBorigin\fR
.
This is always present. Its value describes where the http package believes it
received the cookie from, which may be useful for checking whether the
cookie's domain is valid.
.TP
\fBpath\fR
.
This is always present. Its value describes the path prefix of requests to the
cookie domain where the cookie should be returned.
.TP
\fBsecure\fR
.
This is always present. Its value is a boolean that is true when the cookie
should only used on requests sent over secure channels (typically HTTPS).
.TP
\fBvalue\fR
.
This is always present. Its value is the value of the cookie, which is part of
the information that must be return when sending this cookie back in a future
request.
.PP
Other keys may always be ignored; they have no meaning in this protocol.
.RE
.VE TIP406
.SH EXAMPLE
.PP
This example creates a procedure to copy a URL to a file while printing a
progress meter, and prints the meta-data associated with the URL.
.PP
.CS
proc httpcopy { url file {chunk 4096} } {

Added doc/idna.n.

























































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 2014-2018 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "idna" n 0.1 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::idna \- Support for normalization of Internationalized Domain Names
.SH SYNOPSIS
.nf
package require tcl::idna 1.0

\fBtcl::idna decode\fR \fIhostname\fR
\fBtcl::idna encode\fR \fIhostname\fR
\fBtcl::idna puny decode\fR \fIstring\fR ?\fIcase\fR?
\fBtcl::idna puny encode\fR \fIstring\fR ?\fIcase\fR?
\fBtcl::idna version\fR
.fi
.SH DESCRIPTION
This package provides an implementation of the punycode scheme used in
Internationalised Domain Names, and some access commands. (See RFC 3492 for a
description of punycode.)
.TP
\fBtcl::idna decode\fR \fIhostname\fR
.
This command takes the name of a host that potentially contains
punycode-encoded character sequences, \fIhostname\fR, and returns the hostname
as might be displayed to the user. Note that there are often UNICODE
characters that have extremely similar glyphs, so care should be taken with
displaying hostnames to users.
.TP
\fBtcl::idna encode\fR \fIhostname\fR
.
This command takes the name of a host as might be displayed to the user,
\fIhostname\fR, and returns the version of the hostname with characters not
permitted in basic hostnames encoded with punycode.
.TP
\fBtcl::idna puny\fR \fIsubcommand ...\fR
.
This command provides direct access to the basic punycode encoder and
decoder. It supports two \fIsubcommand\fRs:
.RS
.TP
\fBtcl::idna puny decode\fR \fIstring\fR ?\fIcase\fR?
.
This command decodes the punycode-encoded string, \fIstring\fR, and returns
the result. If \fIcase\fR is provided, it is a boolean to make the case be
folded to upper case (if \fIcase\fR is true) or lower case (if \fIcase\fR is
false) during the decoding process; if omitted, no case transformation is
applied.
.TP
\fBtcl::idna puny encode\fR \fIstring\fR ?\fIcase\fR?
.
This command encodes the string, \fIstring\fR, and returns the
punycode-encoded version of the string. If \fIcase\fR is provided, it is a
boolean to make the case be folded to upper case (if \fIcase\fR is true) or
lower case (if \fIcase\fR is false) during the encoding process; if omitted,
no case transformation is applied.
.RE
.TP
\fBtcl::idna version\fR
.
This returns the version of the \fBtcl::idna\fR package.
.SH "EXAMPLE"
.PP
This is an example of how punycoding of a string works:
.PP
.CS
package require tcl::idna

puts [\fBtcl::idna puny encode\fR "abc\(->def"]
#    prints: \fIabcdef-kn2c\fR
puts [\fBtcl::idna puny decode\fR "abcdef-kn2c"]
#    prints: \fIabc\(->def\fR
.CE
'\" TODO: show how it handles a real domain name
.SH "SEE ALSO"
http(n), cookiejar(n)
.SH KEYWORDS
internet, www
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/incr.n.

23
24
25
26
27
28
29





30
31
32
33
34
35
36
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41







+
+
+
+
+







1 is added to \fIvarName\fR.
The new value is stored as a decimal string in variable \fIvarName\fR
and also returned as result.
.PP
Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed
to \fBincr\fR may be unset, and in that case, it will be set to
the value \fIincrement\fR or to the default increment value of \fB1\fR.
.VS TIP508
If \fIvarName\fR indicate an element that does not exist of an array that has
a default value set, the sum of the default value and the \fIincrement\fR (or
1) will be stored in the array element.
.VE TIP508
.SH EXAMPLES
.PP
Add one to the contents of the variable \fIx\fR:
.PP
.CS
\fBincr\fR x
.CE
55
56
57
58
59
60
61




60
61
62
63
64
65
66
67
68
69
70







+
+
+
+
.CS
\fBincr\fR x 0
.CE
.SH "SEE ALSO"
expr(n), set(n)
.SH KEYWORDS
add, increment, variable, value
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/info.n.

31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
46




































47
48
49
50
51
52
53
31
32
33
34
35
36
37

38
39
40

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88







-
+


-





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







.TP
\fBinfo body \fIprocname\fR
.
Returns the body of procedure \fIprocname\fR.  \fIProcname\fR must be
the name of a Tcl command procedure.
.TP
\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR
.VS 8.6
.
Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
described in \fBCLASS INTROSPECTION\fR below.
.VE 8.6
.TP
\fBinfo cmdcount\fR
.
Returns a count of the total number of commands that have been invoked
in this interpreter.
.TP
\fBinfo cmdtype \fIcommandName\fR
.VS TIP426
Returns a description of the kind of command named by \fIcommandName\fR.  The
supported types are:
.RS
.IP \fBalias\fR
Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. Note that
safe interpreters can only see a subset of aliases (specifically those between
two commands within themselves).
.IP \fBcoroutine\fR
Indicates that \fIcommandName\fR was created by \fBcoroutine\fR.
.IP \fBensemble\fR
Indicates that \fIcommandName\fR was created by \fBnamespace ensemble\fR.
.IP \fBimport\fR
Indicates that \fIcommandName\fR was created by \fBnamespace import\fR.
.IP \fBnative\fR
Indicates that \fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR
interface directly without further registration of the type of command.
.IP \fBobject\fR
Indicates that \fIcommandName\fR is the public command that represents an
instance of \fBoo::object\fR or one of its subclasses.
.IP \fBprivateObject\fR
Indicates that \fIcommandName\fR is the private command (\fBmy\fR by default)
that represents an instance of \fBoo::object\fR or one of its subclasses.
.IP \fBproc\fR
Indicates that \fIcommandName\fR was created by \fBproc\fR.
.IP \fBslave\fR
Indicates that \fIcommandName\fR was created by \fBinterp create\fR.
.IP \fBzlibStream\fR
Indicates that \fIcommandName\fR was created by \fBzlib stream\fR.
.PP
There may be other registered types as well; this is a set that is extensible
at the implementation level with \fBTcl_RegisterCommandTypeName\fR.
.RE
.VE TIP426
.TP
\fBinfo commands \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified,
returns a list of names of all the Tcl commands visible
(i.e. executable without using a qualified name) to the current namespace,
including both the built-in commands written in C and
74
75
76
77
78
79
80
81

82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

97
98
99
100
101
102
103
109
110
111
112
113
114
115

116
117
118
119

120
121
122
123
124
125
126
127
128
129

130
131
132
133
134
135
136
137







-
+



-










-
+







If the command does not appear to be complete then 0 is returned.
This command is typically used in line-oriented input environments
to allow users to type in commands that span multiple lines;  if the
command is not complete, the script can delay evaluating it until additional
lines have been typed to complete the command.
.TP
\fBinfo coroutine\fR
.VS 8.6
.
Returns the name of the currently executing \fBcoroutine\fR, or the empty
string if either no coroutine is currently executing, or the current coroutine
has been deleted (but has not yet returned or yielded since deletion).
.VE 8.6
.TP
\fBinfo default \fIprocname arg varname\fR
.
\fIProcname\fR must be the name of a Tcl command procedure and \fIarg\fR
must be the name of an argument to that procedure.  If \fIarg\fR
does not have a default value then the command returns \fB0\fR.
Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
into variable \fIvarname\fR.
.TP
\fBinfo errorstack \fR?\fIinterp\fR?
.VS 8.6
.
Returns, in a form that is programmatically easy to parse, the function names
and arguments at each level from the call stack of the last error in the given
\fIinterp\fR, or in the current one if not specified.
.RS
.PP
This form is an even-sized list alternating tokens and parameters. Tokens are
currently either \fBCALL\fR, \fBUP\fR, or \fBINNER\fR, but other values may be
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
148
149
150
151
152
153
154

155
156
157
158
159
160
161







-







granularity.
.PP
This information is also present in the \fB\-errorstack\fR entry of the
options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR
is a convenient way of retrieving it for uncaught errors at top-level in an
interactive \fBtclsh\fR.
.RE
.VE 8.6
.TP
\fBinfo exists \fIvarName\fR
.
Returns \fB1\fR if the variable named \fIvarName\fR exists in the
current context (either as a global or local variable) and has been
defined by being given a value, returns \fB0\fR otherwise.
.TP
325
326
327
328
329
330
331
332

333
334
335
336
337
338
339
340
341
342
358
359
360
361
362
363
364

365
366
367

368
369
370
371
372
373
374







-
+


-







\fBinfo nameofexecutable\fR
.
Returns the full path name of the binary file from which the application
was invoked.  If Tcl was unable to identify the file, then an empty
string is returned.
.TP
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
.VS 8.6
.
Returns information about the object, \fIobject\fR. The \fIsubcommand\fRs are
described in \fBOBJECT INTROSPECTION\fR below.
.VE 8.6
.TP
\fBinfo patchlevel\fR
.
Returns the value of the global variable \fBtcl_patchLevel\fR, which holds
the exact version of the Tcl library by default.
.TP
\fBinfo procs \fR?\fIpattern\fR?
395
396
397
398
399
400
401
402
403
404
405
406
407
408

409
410
411
412
413
414
415





416
417
418
419
420
421
422
423
424
425
426





427
428
429
430
431

432
433
434
435
436
437
438
439
440
441

442
443
444
445
446
447
448
449
450

451
452
453
454
455
456

457
458
459
460
461

462
463
464
465
466
467

468
469
470
471
472
473
474

475
476
477
478
479
480
481


482
483




484
485
486
487
488


489
490
491





492




















493
494


495
496
497

498
499
500
501
502
503
504
505
506

507
508
509
510
511
512

513
514
515
516
517
518
519
520

521
522
523
524
525

526

527
528
529




530
531
532
533
534
535
536

537
538
539
540
541





542
543
544
545
546
547
548
549
550
551
552
553





554
555
556
557
558

559
560
561











562

563
564
565

566
567
568
569
570
571
572
573
574

575
576
577
578
579

580
581
582
583
584
585

586
587
588
589
590
591
592
593

594
595
596
597
598
599

600
601
602
603
604
605

606
607
608
609
610

611
612
613
614
615

616
617
618
619
620
621
622
623

624
625
626
627
628
629
630


631
632




633
634
635
636
637


638
639
640





641




















642
643


644
645
646

647
648
649
650
651
652
653
654
655

656
657
658
659
660
661

662
663
664
665
666

667

668
669
670



671

672
673
674

675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
427
428
429
430
431
432
433

434
435

436
437

438
439
440
441
442
443
444

445
446
447
448
449
450
451
452
453
454
455
456
457
458
459

460
461
462
463
464
465

466
467

468
469
470
471
472
473
474

475
476

477
478
479
480
481
482

483
484

485
486
487

488
489

490
491

492
493

494
495
496

497
498

499
500
501
502

503
504

505
506
507
508
509

510
511
512
513


514
515
516
517
518
519

520
521
522
523



524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550

551
552
553
554

555
556
557
558
559
560

561
562

563
564
565

566
567

568
569
570
571
572

573
574

575
576
577

578

579

580
581
582
583
584
585
586
587
588
589
590

591
592

593
594
595
596
597

598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613

614
615
616
617
618
619

620
621

622
623
624
625
626
627
628
629
630
631
632
633
634
635
636

637
638
639

640
641
642
643
644
645

646
647

648
649

650
651

652
653
654

655
656

657
658
659
660

661
662
663

664
665
666

667
668

669
670
671

672
673

674
675

676
677

678
679

680
681

682
683
684
685
686

687
688

689
690
691
692
693

694
695
696
697


698
699
700
701
702
703

704
705
706
707



708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734

735
736
737
738

739
740
741
742
743
744

745
746

747
748
749

750
751

752
753
754

755

756

757
758
759
760
761
762
763

764
765
766

767
768
769
770
771
772
773
774
775

776
777
778
779
780
781
782







-


-


-
+






-
+
+
+
+
+










-
+
+
+
+
+

-


-
+






-


-
+





-


-
+


-


-
+

-


-
+


-


-
+



-


-
+




-


+
+
-
-
+
+
+
+


-


+
+
-
-
-
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+


-
+





-


-
+


-


-
+




-


-
+


-

-
+
-
+



+
+
+
+



-


-
+




-
+
+
+
+
+











-
+
+
+
+
+

-


-
+



+
+
+
+
+
+
+
+
+
+
+
-
+


-
+





-


-
+

-


-
+


-


-
+



-



-
+


-


-
+


-


-
+

-


-
+

-


-
+




-


-
+




-


+
+
-
-
+
+
+
+


-


+
+
-
-
-
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+


-
+





-


-
+


-


-
+


-

-
+
-
+



+
+
+
-
+


-
+








-







has each matching namespace variable qualified with the name
of its namespace.
Note that a currently-visible variable may not yet
.QW exist
if it has not
been set (e.g. a variable declared but not set by \fBvariable\fR).
.SS "CLASS INTROSPECTION"
.VS 8.6
.PP
The following \fIsubcommand\fR values are supported by \fBinfo class\fR:
.VE 8.6
.TP
\fBinfo class call\fI class method\fR
.VS
.
Returns a description of the method implementations that are used to provide a
stereotypical instance of \fIclass\fR's implementation of \fImethod\fR
(stereotypical instances being objects instantiated by a class without having
any object-specific definitions added). This consists of a list of lists of
four elements, where each sublist consists of a word that describes the
general type of method implementation (being one of \fBmethod\fR for an
ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
ordinary method, \fBfilter\fR for an applied filter,
.VS TIP500
\fBprivate\fR for a private method,
.VE TIP500
and \fBunknown\fR for a
method that is invoked as part of unknown method handling), a word giving the
name of the particular method invoked (which is always the same as
\fImethod\fR for the \fBmethod\fR type, and
.QW \fBunknown\fR
for the \fBunknown\fR type), a word giving the fully qualified name of the
class that defined the method, and a word describing the type of method
implementation (see \fBinfo class methodtype\fR).
.RS
.PP
Note that there is no inspection of whether the method implementations
actually use \fBnext\fR to transfer control along the call chain.
actually use \fBnext\fR to transfer control along the call chain,
.VS TIP500
and the call chains that this command files do not actually contain private
methods.
.VE TIP500
.RE
.VE 8.6
.TP
\fBinfo class constructor\fI class\fR
.VS 8.6
.
This subcommand returns a description of the definition of the constructor of
class \fIclass\fR. The definition is described as a two element list; the first
element is the list of arguments to the constructor in a form suitable for
passing to another call to \fBproc\fR or a method definition, and the second
element is the body of the constructor. If no constructor is present, this
returns the empty list.
.VE 8.6
.TP
\fBinfo class definition\fI class method\fR
.VS 8.6
.
This subcommand returns a description of the definition of the method named
\fImethod\fR of class \fIclass\fR. The definition is described as a two element
list; the first element is the list of arguments to the method in a form
suitable for passing to another call to \fBproc\fR or a method definition, and
the second element is the body of the method.
.VE 8.6
.TP
\fBinfo class destructor\fI class\fR
.VS 8.6
.
This subcommand returns the body of the destructor of class \fIclass\fR. If no
destructor is present, this returns the empty string.
.VE 8.6
.TP
\fBinfo class filters\fI class\fR
.VS 8.6
.
This subcommand returns the list of filter methods set on the class.
.VE 8.6
.TP
\fBinfo class forward\fI class method\fR
.VS 8.6
.
This subcommand returns the argument list for the method forwarding called
\fImethod\fR that is set on the class called \fIclass\fR.
.VE 8.6
.TP
\fBinfo class instances\fI class\fR ?\fIpattern\fR?
.VS 8.6
.
This subcommand returns a list of instances of class \fIclass\fR. If the
optional \fIpattern\fR argument is present, it constrains the list of returned
instances to those that match it according to the rules of \fBstring match\fR.
.VE 8.6
.TP
\fBinfo class methods\fI class\fR ?\fIoptions...\fR?
.VS 8.6
.
This subcommand returns a list of all public (i.e. exported) methods of the
class called \fIclass\fR. Any of the following \fIoption\fRs may be
specified, controlling exactly which method names are returned:
.RS
.VE 8.6
.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS 8.6
If the \fB\-all\fR flag is given, the list of methods will include those
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will include those
methods defined not just by the class, but also by the class's superclasses
and mixins.
.VE 8.6
.TP
\fB\-private\fR
.
If the \fB\-private\fR flag is given,
.VS 8.6
If the \fB\-private\fR flag is given, the list of methods will also include
the private (i.e. non-exported) methods of the class (and superclasses and
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will also include
the non-exported methods of the class (and superclasses and
mixins, if \fB\-all\fR is also given).
.VS TIP500
Note that this naming is an unfortunate clash with true private methods; this
option name is retained for backward compatibility.
.VE TIP500
.TP
\fB\-scope\fI scope\fR
.VS TIP500
Returns a list of all methods on \fIclass\fR that have the given visibility
\fIscope\fR.  When this option is supplied, both the \fB\-all\fR and
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
.RS
.IP \fBpublic\fR 3
Only methods with \fIpublic\fR scope (i.e., callable from anywhere by any instance
of this class) are to be returned.
.IP \fBunexported\fR 3
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
be returned.
.IP \fBprivate\fR 3
Only methods with \fIprivate\fR scope (i.e., only callable from within this class's
methods) are to be returned.
.RE
.VE 8.6
.VE TIP500
.RE
.TP
\fBinfo class methodtype\fI class method\fR
.VS 8.6
.
This subcommand returns a description of the type of implementation used for
the method named \fImethod\fR of class \fIclass\fR. When the result is
\fBmethod\fR, further information can be discovered with \fBinfo class
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo class forward\fR.
.VE 8.6
.TP
\fBinfo class mixins\fI class\fR
.VS 8.6
.
This subcommand returns a list of all classes that have been mixed into the
class named \fIclass\fR.
.VE 8.6
.TP
\fBinfo class subclasses\fI class\fR ?\fIpattern\fR?
.VS 8.6
.
This subcommand returns a list of direct subclasses of class \fIclass\fR. If
the optional \fIpattern\fR argument is present, it constrains the list of
returned classes to those that match it according to the rules of
\fBstring match\fR.
.VE 8.6
.TP
\fBinfo class superclasses\fI class\fR
.VS 8.6
.
This subcommand returns a list of direct superclasses of class \fIclass\fR in
inheritance precedence order.
.VE 8.6
.TP
\fBinfo class variables\fI class\fR
\fBinfo class variables\fI class\fR ?\fB\-private\fR?
.VS 8.6
.
This subcommand returns a list of all variables that have been declared for
the class named \fIclass\fR (i.e. that are automatically present in the
class's methods, constructor and destructor).
.VS TIP500
If the \fB\-private\fR option is specified, this lists the private variables
declared instead.
.VE TIP500
.SS "OBJECT INTROSPECTION"
.PP
The following \fIsubcommand\fR values are supported by \fBinfo object\fR:
.VE 8.6
.TP
\fBinfo object call\fI object method\fR
.VS 8.6
.
Returns a description of the method implementations that are used to provide
\fIobject\fR's implementation of \fImethod\fR.  This consists of a list of
lists of four elements, where each sublist consists of a word that describes
the general type of method implementation (being one of \fBmethod\fR for an
ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
ordinary method, \fBfilter\fR for an applied filter,
.VS TIP500
\fBprivate\fR for a private method,
.VE TIP500
and \fBunknown\fR for a
method that is invoked as part of unknown method handling), a word giving the
name of the particular method invoked (which is always the same as
\fImethod\fR for the \fBmethod\fR type, and
.QW \fBunknown\fR
for the \fBunknown\fR type), a word giving what defined the method (the fully
qualified name of the class, or the literal string \fBobject\fR if the method
implementation is on an instance), and a word describing the type of method
implementation (see \fBinfo object methodtype\fR).
.RS
.PP
Note that there is no inspection of whether the method implementations
actually use \fBnext\fR to transfer control along the call chain.
actually use \fBnext\fR to transfer control along the call chain,
.VS TIP500
and the call chains that this command files do not actually contain private
methods.
.VE TIP500
.RE
.VE 8.6
.TP
\fBinfo object class\fI object\fR ?\fIclassName\fR?
.VS 8.6
.
If \fIclassName\fR is unspecified, this subcommand returns class of the
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
boolean value indicating whether the \fIobject\fR is of that class.
.TP
\fBinfo object creationid\fI object\fR
.VS TIP500
Returns the unique creation identifier for the \fIobject\fR object. This
creation identifier is unique to the object (within a Tcl interpreter) and
cannot be controlled at object creation time or altered afterwards.
.RS
.PP
\fIImplementation note:\fR the creation identifier is used to generate unique
identifiers associated with the object, especially for private variables.
.RE
.VE 8.6
.VE TIP500
.TP
\fBinfo object definition\fI object method\fR
.VS 8.6
.
This subcommand returns a description of the definition of the method named
\fImethod\fR of object \fIobject\fR. The definition is described as a two
element list; the first element is the list of arguments to the method in a
form suitable for passing to another call to \fBproc\fR or a method definition,
and the second element is the body of the method.
.VE 8.6
.TP
\fBinfo object filters\fI object\fR
.VS 8.6
.
This subcommand returns the list of filter methods set on the object.
.VE 8.6
.TP
\fBinfo object forward\fI object method\fR
.VS 8.6
.
This subcommand returns the argument list for the method forwarding called
\fImethod\fR that is set on the object called \fIobject\fR.
.VE 8.6
.TP
\fBinfo object isa\fI category object\fR ?\fIarg\fR?
.VS 8.6
.
This subcommand tests whether an object belongs to a particular category,
returning a boolean value that indicates whether the \fIobject\fR argument
meets the criteria for the category. The supported categories are:
.VE 8.6
.RS
.TP
\fBinfo object isa class\fI object\fR
.VS 8.6
.
This returns whether \fIobject\fR is a class (i.e. an instance of
\fBoo::class\fR or one of its subclasses).
.VE 8.6
.TP
\fBinfo object isa metaclass\fI object\fR
.VS 8.6
.
This returns whether \fIobject\fR is a class that can manufacture classes
(i.e. is \fBoo::class\fR or a subclass of it).
.VE 8.6
.TP
\fBinfo object isa mixin\fI object class\fR
.VS 8.6
.
This returns whether \fIclass\fR is directly mixed into \fIobject\fR.
.VE 8.6
.TP
\fBinfo object isa object\fI object\fR
.VS 8.6
.
This returns whether \fIobject\fR really is an object.
.VE 8.6
.TP
\fBinfo object isa typeof\fI object class\fR
.VS 8.6
.
This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether
\fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether
direct or indirect).
.RE
.VE 8.6
.TP
\fBinfo object methods\fI object\fR ?\fIoption...\fR?
.VS 8.6
.
This subcommand returns a list of all public (i.e. exported) methods of the
object called \fIobject\fR. Any of the following \fIoption\fRs may be
specified, controlling exactly which method names are returned:
.RS
.VE 8.6
.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS 8.6
If the \fB\-all\fR flag is given, the list of methods will include those
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will include those
methods defined not just by the object, but also by the object's class and
mixins, plus the superclasses of those classes.
.VE 8.6
.TP
\fB\-private\fR
.
If the \fB\-private\fR flag is given,
.VS 8.6
If the \fB\-private\fR flag is given, the list of methods will also include
the private (i.e. non-exported) methods of the object (and classes, if
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will also include
the non-exported methods of the object (and classes, if
\fB\-all\fR is also given).
.VS TIP500
Note that this naming is an unfortunate clash with true private methods; this
option name is retained for backward compatibility.
.VE TIP500
.TP
\fB\-scope\fI scope\fR
.VS TIP500
Returns a list of all methods on \fIobject\fR that have the given visibility
\fIscope\fR.  When this option is supplied, both the \fB\-all\fR and
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
.RS
.IP \fBpublic\fR 3
Only methods with \fIpublic\fR scope (i.e., callable from anywhere) are to be
returned.
.IP \fBunexported\fR 3
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
be returned.
.IP \fBprivate\fR 3
Only methods with \fIprivate\fR scope (i.e., only callable from within this object's
instance methods) are to be returned.
.RE
.VE 8.6
.VE TIP500
.RE
.TP
\fBinfo object methodtype\fI object method\fR
.VS 8.6
.
This subcommand returns a description of the type of implementation used for
the method named \fImethod\fR of object \fIobject\fR. When the result is
\fBmethod\fR, further information can be discovered with \fBinfo object
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo object forward\fR.
.VE 8.6
.TP
\fBinfo object mixins\fI object\fR
.VS 8.6
.
This subcommand returns a list of all classes that have been mixed into the
object named \fIobject\fR.
.VE 8.6
.TP
\fBinfo object namespace\fI object\fR
.VS 8.6
.
This subcommand returns the name of the internal namespace of the object named
\fIobject\fR.
.VE 8.6
.TP
\fBinfo object variables\fI object\fR
\fBinfo object variables\fI object\fRR ?\fB\-private\fR?
.VS 8.6
.
This subcommand returns a list of all variables that have been declared for
the object named \fIobject\fR (i.e. that are automatically present in the
object's methods).
.VS TIP500
If the \fB\-private\fR option is specified, this lists the private variables
declared instead.
.VE 8.6
.VE TIP500
.TP
\fBinfo object vars\fI object\fR ?\fIpattern\fR?
.VS 8.6
.
This subcommand returns a list of all variables in the private namespace of
the object named \fIobject\fR. If the optional \fIpattern\fR argument is
given, it is a filter (in the syntax of a \fBstring match\fR glob pattern)
that constrains the list of variables returned. Note that this is different
from the list returned by \fBinfo object variables\fR; that can include
variables that are currently unset, whereas this can include variables that
are not automatically included by any of \fIobject\fR's methods (or those of
its class, superclasses or mixins).
.VE 8.6
.SH EXAMPLES
.PP
This command prints out a procedure suitable for saving in a Tcl
script:
.PP
.CS
proc printProc {procName} {
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726

727
728

729
730
731
732
733
734
735
791
792
793
794
795
796
797

798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828







-




















+


+







            lappend formals [list $var]
        }
    }
    puts [lappend result $formals [\fBinfo body\fR $procName]]
}
.CE
.SS "EXAMPLES WITH OBJECTS"
.VS 8.6
.PP
Every object necessarily knows what its class is; this information is
trivially extractable through introspection:
.PP
.CS
oo::class create c
c create o
puts [\fBinfo object class\fR o]
                     \fI\(-> prints "::c"\fR
puts [\fBinfo object class\fR c]
                     \fI\(-> prints "::oo::class"\fR
.CE
.PP
The introspection capabilities can be used to discover what class implements a
method and get how it is defined. This procedure illustrates how:
.PP
.CS
proc getDef {obj method} {
    foreach inf [\fBinfo object call\fR $obj $method] {
        lassign $inf calltype name locus methodtype

        # Assume no forwards or filters, and hence no $calltype
        # or $methodtype checks...

        if {$locus eq "object"} {
            return [\fBinfo object definition\fR $obj $name]
        } else {
            return [\fBinfo class definition\fR $locus $name]
        }
    }
    error "no definition for $method"
744
745
746
747
748
749
750

751

752
753
754
755
756
757
758

759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774

775
776
777
778
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858

859

860

861
862
863




864
865
866
867
868







+

+







+




-

-

-



-
-
-
-
+




.PP
.CS
proc getDef {obj method} {
    if {$method in [\fBinfo object methods\fR $obj]} {
        # Assume no forwards
        return [\fBinfo object definition\fR $obj $method]
    }

    set cls [\fBinfo object class\fR $obj]

    while {$method ni [\fBinfo class methods\fR $cls]} {
        # Assume the simple case
        set cls [lindex [\fBinfo class superclass\fR $cls] 0]
        if {$cls eq ""} {
            error "no definition for $method"
        }
    }

    # Assume no forwards
    return [\fBinfo class definition\fR $cls $method]
}
.CE
.VE 8.6
.SH "SEE ALSO"
.VS 8.6
global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n),
.VE 8.6
tcl_library(n), tcl_patchLevel(n), tcl_version(n)
.SH KEYWORDS
command, information, interpreter, introspection, level, namespace,
.VS 8.6
object,
.VE 8.6
procedure, variable
object, procedure, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/interp.n.

232
233
234
235
236
237
238
239

240
241
242
243
244
245
246
232
233
234
235
236
237
238

239
240
241
242
243
244
245
246







-
+







execution of all commands.
.PP
Note that once it is on, this flag cannot be switched back off: such
attempts are silently ignored. This is needed to maintain the
consistency of the underlying interpreter's state.
.RE
.TP
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
\fBinterp\fR \fBdelete \fR?\fIpath ...\fR?
.
Deletes zero or more interpreters given by the optional \fIpath\fR
arguments, and for each interpreter, it also deletes its slaves. The
command also deletes the slave command for each interpreter deleted.
For each \fIpath\fR argument, if no interpreter by that name
exists, the command raises an error.
.TP

Changes to doc/join.n.

38
39
40
41
42
43
44




38
39
40
41
42
43
44
45
46
47
48







+
+
+
+
\fBjoin\fR $data
     \fB\(-> 1 2 3 4 5 {6 7} 8\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), split(n)
.SH KEYWORDS
element, join, list, separator
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/lappend.n.

18
19
20
21
22
23
24






25
26
27
28
29
30
31
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37







+
+
+
+
+
+







.SH DESCRIPTION
.PP
This command treats the variable given by \fIvarName\fR as a list
and appends each of the \fIvalue\fR arguments to that list as a separate
element, with spaces between elements.
If \fIvarName\fR does not exist, it is created as a list with elements
given by the \fIvalue\fR arguments.
.VS TIP508
If \fIvarName\fR indicate an element that does not exist of an array that has
a default value set, list that is comprised of the default value with all the
\fIvalue\fR arguments appended as elements will be stored in the array
element.
.VE TIP508
\fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
are appended as list elements rather than raw text.
This command provides a relatively efficient way to build up
large lists.  For example,
.QW "\fBlappend a $b\fR"
is much more efficient than
.QW "\fBset a [concat $a [list $b]]\fR"
43
44
45
46
47
48
49




49
50
51
52
53
54
55
56
57
58
59







+
+
+
+
1 2 3 4 5
.CE
.SH "SEE ALSO"
list(n), lindex(n), linsert(n), llength(n), lset(n),
lsort(n), lrange(n)
.SH KEYWORDS
append, element, list, variable
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/lindex.n.

9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23







-
+







.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lindex \- Retrieve an element from a list
.SH SYNOPSIS
\fBlindex \fIlist ?index ...?\fR
\fBlindex \fIlist\fR ?\fIindex ...\fR?
.BE
.SH DESCRIPTION
.PP
The \fBlindex\fR command accepts a parameter, \fIlist\fR, which
it treats as a Tcl list. It also accepts zero or more \fIindices\fR into
the list.  The indices may be presented either consecutively on the
command line, or grouped in a

Added doc/link.n.





























































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 2011-2015 Andreas Kupries
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH link n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
link \- create link from command to method of object
.SH SYNOPSIS
.nf
package require TclOO

\fBlink\fR \fImethodName\fR ?\fI...\fR?
\fBlink\fR \fB{\fIcommandName methodName\fB}\fR ?\fI...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBlink\fR command is available within methods. It takes a series of one
or more method names (\fImethodName ...\fR) and/or pairs of command- and
method-name (\fB{\fIcommandName methodName\fB}\fR) and makes the named methods
available as commands without requiring the explicit use of the name of the
object or the \fBmy\fR command. The method does not need to exist at the time
that the link is made; if the link command is invoked when the method does not
exist, the standard \fBunknown\fR method handling system is used.
.PP
The command name under which the method becomes available defaults to the
method name, except where explicitly specified through an alias/method pair.
Formally, every argument must be a list; if the list has two elements, the
first element is the name of the command to create and the second element is
the name of the method of the current object to which the command links;
otherwise, the name of the command and the name of the method are the same
string (the first element of the list).
.PP
If the name of the command is not a fully-qualified command name, it will be
resolved with respect to the current namespace (i.e., the object namespace).
.SH EXAMPLES
This demonstrates linking a single method in various ways. First it makes a
simple link, then a renamed link, then an external link. Note that the method
itself is unexported, but that it can still be called directly from outside
the class.
.PP
.CS
oo::class create ABC {
    method Foo {} {
        puts "This is Foo in [self]"
    }

    constructor {} {
        \fBlink\fR Foo
        # The method foo is now directly accessible as foo here
        \fBlink\fR {bar Foo}
        # The method foo is now directly accessible as bar
        \fBlink\fR {::ExternalCall Foo}
        # The method foo is now directly accessible in the global
        # namespace as ExternalCall
    }

    method grill {} {
        puts "Step 1:"
        Foo
        puts "Step 2:"
        bar
    }
}

ABC create abc
abc grill
        \fI\(-> Step 1:\fR
        \fI\(-> This is foo in ::abc\fR
        \fI\(-> Step 2:\fR
        \fI\(-> This is foo in ::abc\fR
# Direct access via the linked command
puts "Step 3:"; ExternalCall
        \fI\(-> Step 3:\fR
        \fI\(-> This is foo in ::abc\fR
.CE
.PP
This example shows that multiple linked commands can be made in a call to
\fBlink\fR, and that they can handle arguments.
.PP
.CS
oo::class create Ex {
    constructor {} {
        \fBlink\fR a b c
        # The methods a, b, and c (defined below) are all now
        # directly acessible within methods under their own names.
    }

    method a {} {
        puts "This is a"
    }
    method b {x} {
        puts "This is b($x)"
    }
    method c {y z} {
        puts "This is c($y,$z)"
    }

    method call {p q r} {
        a
        b $p
        c $q $r
    }
}

set o [Ex new]
$o 3 5 7
        \fI\(-> This is a\fR
        \fI\(-> This is b(3)\fR
        \fI\(-> This is c(5,7)\fR
.CE
.SH "SEE ALSO"
interp(n), my(n), oo::class(n), oo::define(n)
.SH KEYWORDS
command, method, object
.\" Local Variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/llength.n.

49
50
51
52
53
54
55




49
50
51
52
53
54
55
56
57
58
59







+
+
+
+
1,0
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n)
.SH KEYWORDS
element, list, length
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/lrange.n.

72
73
74
75
76
77
78




72
73
74
75
76
77
78
79
80
81
82







+
+
+
+
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lreplace(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, range, sublist
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/lrepeat.n.

29
30
31
32
33
34
35
36
37
38




29
30
31
32
33
34
35

36
37
38
39
40
41







-


+
+
+
+
\fBlrepeat\fR 3 a b c
      \fI\(-> a b c a b c a b c\fR
\fBlrepeat\fR 3 [\fBlrepeat\fR 2 a] b c
      \fI\(-> {a a} b c {a a} b c {a a} b c\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), linsert(n), llength(n), lset(n)

.SH KEYWORDS
element, index, list
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/lreplace.n.

13
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35









36
37
38

39
40
41

42
43
44
45

46
47
48
49
50
51
52
53
13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28
29

30




31
32
33
34
35
36
37
38
39
40
41

42
43
44

45
46
47
48

49

50
51
52
53
54
55
56







-
+









-

-
-
-
-
+
+
+
+
+
+
+
+
+


-
+


-
+



-
+
-







.SH NAME
lreplace \- Replace elements in a list with new elements
.SH SYNOPSIS
\fBlreplace \fIlist first last \fR?\fIelement element ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBlreplace\fR returns a new list formed by replacing one or more elements of
\fBlreplace\fR returns a new list formed by replacing zero or more elements of
\fIlist\fR with the \fIelement\fR arguments.
\fIfirst\fR and \fIlast\fR are index values specifying the first and
last elements of the range to replace.
The index values \fIfirst\fR and \fIlast\fR are interpreted
the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the
end of the list.
0 refers to the first element of the
list, and \fBend\fR refers to the last element of the list.
If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored.
.PP
If \fIfirst\fR is less than zero, it is considered to refer to before the
first element of the list.  For non-empty lists, the element indicated
by \fIfirst\fR must exist or \fIfirst\fR must indicate before the
start of the list.
If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered
to refer to before the first element of the list. This allows \fBlreplace\fR
to prepend elements to \fIlist\fR.
.VS TIP505
If either \fIfirst\fR or \fIlast\fR indicates a position greater than the
index of the last element of the list, it is treated as if it is an
index one greater than the last element. This allows \fBlreplace\fR to
append elements to \fIlist\fR.
.VE TIP505
.PP
If \fIlast\fR is less than \fIfirst\fR, then any specified elements
will be inserted into the list before the point specified by \fIfirst\fR
will be inserted into the list before the element specified by \fIfirst\fR
with no elements being deleted.
.PP
The \fIelement\fR arguments specify zero or more new arguments to
The \fIelement\fR arguments specify zero or more new elements to
be added to the list in place of those that were deleted.
Each \fIelement\fR argument will become a separate element of
the list.  If no \fIelement\fR arguments are specified, then the elements
between \fIfirst\fR and \fIlast\fR are simply deleted.  If \fIlist\fR
between \fIfirst\fR and \fIlast\fR are simply deleted.
is empty, any \fIelement\fR arguments are added to the end of the list.
.SH EXAMPLES
.PP
Replacing an element of a list with another:
.PP
.CS
% \fBlreplace\fR {a b c d e} 1 1 foo
a foo c d e
74
75
76
77
78
79
80













81
82
83
84
85
86




77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106







+
+
+
+
+
+
+
+
+
+
+
+
+






+
+
+
+
.CS
proc lremove {listVariable value} {
    upvar 1 $listVariable var
    set idx [lsearch -exact $var $value]
    set var [\fBlreplace\fR $var $idx $idx]
}
.CE
.PP
.VS TIP505
Appending elements to the list; note that \fBend+2\fR will initially
be treated as if it is \fB6\fR here, but both that and \fB12345\fR are greater
than the index of the final item so they behave identically:
.PP
.CS
% set var {a b c d e}
a b c d e
% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
a b c d e f g h i
.CE
.VE TIP505
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/lsearch.n.

143
144
145
146
147
148
149













150
151
152
153
154
155
156
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169







+
+
+
+
+
+
+
+
+
+
+
+
+







This option implies \fB\-sorted\fR and cannot be used with either \fB\-all\fR
or \fB\-not\fR.
.VE 8.6
.SS "NESTED LIST OPTIONS"
.PP
These options are used to search lists of lists.  They may be used
with any other options.
.TP
\fB\-stride\0\fIstrideLength\fR
.
If this option is specified, the list is treated as consisting of
groups of \fIstrideLength\fR elements and the groups are searched by
either their first element or, if the \fB\-index\fR option is used,
by the element within each group given by the first index passed to
\fB\-index\fR (which is then ignored by \fB\-index\fR). The resulting
index always points to the first element in a group.
.PP
The list length must be an integer multiple of \fIstrideLength\fR, which
in turn must be at least 1. A \fIstrideLength\fR of 1 is the default and
indicates no grouping.
.TP
\fB\-index\fR\0\fIindexList\fR
.
This option is designed for use when searching within nested lists.
The \fIindexList\fR argument gives a path of indices (much as might be
used with the \fBlindex\fR or \fBlset\fR commands) within each element
to allow the location of the term being matched against.
204
205
206
207
208
209
210







211
212
213
214
215
216
217
218
219
220
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240







+
+
+
+
+
+
+










.PP
It is also possible to search inside elements:
.PP
.CS
\fBlsearch\fR -index 1 -all -inline {{a abc} {b bcd} {c cde}} *bc*
      \fI\(-> {a abc} {b bcd}\fR
.CE
.PP
The same thing for a flattened list:
.PP
.CS
\fBlsearch\fR -stride 2 -index 1 -all -inline {a abc b bcd c cde} *bc*
      \fI\(-> {a abc b bcd}\fR
.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n),
lset(n), lsort(n), lrange(n), lreplace(n),
string(n)
.SH KEYWORDS
binary search, linear search,
list, match, pattern, regular expression, search, string
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/msgcat.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16

17
18
19
20
21
22
23
24




25
26
27

28


29
30
31
32
33
34
35
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
41













-
+

-
+








+
+
+
+



+
-
+
+







'\"
'\" Copyright (c) 1998 Mark Harrison.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.5\fR
\fBpackage require Tcl 8.7\fR
.sp
\fBpackage require msgcat 1.6\fR
\fBpackage require msgcat 1.7\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.sp
.VS "TIP 412"
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
.VE "TIP 412"
.sp
.VS "TIP 490"
\fB::msgcat::mcpackagenamespaceget\fR
.VE "TIP 490"
.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp
.VS "TIP 499"
\fB::msgcat::mcpreferences\fR
\fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ...
.VE "TIP 499"
.sp
.VS "TIP 412"
\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
.VE "TIP 412"
.sp
\fB::msgcat::mcload \fIdirname\fR
.sp
46
47
48
49
50
51
52




53
54
55
56
57
58
59
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69







+
+
+
+







.VS "TIP 412"
\fB::msgcat::mcpackagelocale subcommand\fR ?\fIlocale\fR?
.sp
\fB::msgcat::mcpackageconfig subcommand\fR \fIoption\fR ?\fIvalue\fR?
.sp
\fB::msgcat::mcforgetpackage\fR
.VE "TIP 412"
.sp
.VS "TIP 499"
\fB::msgcat::mcutil subcommand\fR ?\fIlocale\fR?
.VS "TIP 499"
.BE
.SH DESCRIPTION
.PP
The \fBmsgcat\fR package provides a set of functions
that can be used to manage multi-lingual user interfaces.
Text strings are defined in a
.QW "message catalog"
67
68
69
70
71
72
73





74
75
76
77
78
79
80
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95







+
+
+
+
+







Each package has its own message catalog and configuration settings in \fBmsgcat\fR.
.PP
A \fIlocale\fR is a specification string describing a user language like \fBde_ch\fR for Swiss German.
In \fBmsgcat\fR, there is a global locale initialized by the system locale of the current system.
Each package may decide to use the global locale or to use a package specific locale.
.PP
The global locale may be changed on demand, for example by a user initiated language change or within a multi user application like a web server.
.PP
.VS tip490
Object oriented programming is supported by the use of a package namespace.
.VE tip490
.PP
.SH COMMANDS
.TP
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.
Returns a translation of \fIsrc-string\fR according to the
current locale.  If additional arguments past \fIsrc-string\fR
are given, the \fBformat\fR command is used to substitute the
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
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143














144




145
146
147
148
149
150
151
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177



178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193

194
195
196
197
198
199
200

201
202







203
204
205
206
207
208
209
210
211
212
213
214
215
216

217
218
219
220
221
222
223
224
225
226
227







+
+
+
+
+
+
+
+
+
+
+







+

-
+

-






+
+
+
+
+

+
-
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
+
+
+
+
+
+
+
+
+
+
+
+




-







-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+







\fB::msgcat::mc\fR is the main function used to localize an
application.  Instead of using an English string directly, an
application can pass the English string through \fB::msgcat::mc\fR and
use the result.  If an application is written for a single language in
this fashion, then it is easy to add support for additional languages
later simply by defining new message catalog entries.
.RE
.VS "TIP 490"
.TP
\fB::msgcat::mcn \fInamespace\fR \fIsrc-string\fR ?\fIarg arg ...\fR?
.
Like \fB::msgcat::mc\fR, but with the message namespace specified as first argument.
.PP
.RS
\fBmcn\fR may be used for cases where the package namespace is not the namespace of the caller.
An example is shown within the description of the command \fB::msgcat::mcpackagenamespaceget\fR below.
.RE
.PP
.TP
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.
Given several source strings, \fB::msgcat::mcmax\fR returns the length
of the longest translated string.  This is useful when designing
localized GUIs, which may require that all buttons, for example, be a
fixed width (which will be the width of the widest button).
.VS "TIP 412"
.TP
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? ?\fB-namespace\fR \fInamespace\fR? \fIsrc-string\fR
.
.VS "TIP 412"
Return true, if there is a translation for the given \fIsrc-string\fR.
.PP
.RS
The search may be limited by the option \fB\-exactnamespace\fR to only check the current namespace and not any parent namespaces.
.PP
It may also be limited by the option \fB\-exactlocale\fR to only check the first prefered locale (e.g. first element returned by \fB::msgcat::mcpreferences\fR if global locale is used).
.PP
.VE "TIP 412"
.VS "TIP 490"
An explicit package namespace may be specified by the option \fB-namespace\fR.
The namespace of the caller is used if not explicitly specified.
.RE
.PP
.VE "TIP 412"
.VE "TIP 490"
.VS "TIP 490"
.TP
\fB::msgcat::mcpackagenamespaceget\fR
.
Return the package namespace of the caller.
This command handles all cases described in section \fBOBJECT ORIENTED PROGRAMMING\fR.
.PP
.RS
Example usage is a tooltip package, which saves the caller package namespace to update the translation each time the tooltip is shown:
.CS
proc ::tooltip::tooltip {widget message} {
    ...
    set messagenamespace [uplevel 1 {::msgcat::mcpackagenamespaceget}]
    ...
    bind $widget  [list ::tooltip::show $widget $messagenamespace $message]
}

proc ::tooltip::show {widget messagenamespace message} {
    ...
    set message [::msgcat::mcn $messagenamespace $message]
    ...
}
.CE
.RE
.PP
.VE "TIP 490"
.TP
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.
This function sets the locale to \fInewLocale\fR.  If \fInewLocale\fR
is omitted, the current locale is returned, otherwise the current locale
is set to \fInewLocale\fR.  msgcat stores and compares the locale in a
If \fInewLocale\fR is omitted, the current locale is returned, otherwise the current locale
is set to \fInewLocale\fR.
.PP
.RS
If the new locale is set to \fInewLocale\fR, the corresponding preferences are calculated and set.
For example, if the current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR returns \fB{en_us_funky en_us en {}}\fR.
.PP
The same result may be acheved by \fB::msgcat::mcpreferences\fR {*}[\fB::msgcat::mcutil getpreferences\fR \fInewLocale\fR].
.PP
The current locale is always the first element of the list returned by \fBmcpreferences\fR.
.PP
msgcat stores and compares the locale in a
case-insensitive manner, and returns locales in lowercase.
The initial locale is determined by the locale specified in
the user's environment.  See \fBLOCALE SPECIFICATION\fR
below for a description of the locale string format.
.RS
.PP
.VS "TIP 412"
If the locale is set, the preference list of locales is evaluated.
Locales in this list are loaded now, if not jet loaded.
.VE "TIP 412"
.RE
.TP
\fB::msgcat::mcpreferences\fR
\fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ...
.
Returns an ordered list of the locales preferred by
the user, based on the user's language specification.
The list is ordered from most specific to least
preference.  The list is derived from the current
locale set in msgcat by \fB::msgcat::mclocale\fR, and
cannot be set independently.  For example, if the
current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR
Without arguments, returns an ordered list of the locales preferred by
the user.
The list is ordered from most specific to least preference.
.PP
.VS "TIP 499"
.RS
A set of locale preferences may be given to set the list of locale preferences.
The current locale is also set, which is the first element of the locale preferences list.
.PP
Locale preferences are loaded now, if not jet loaded.
.PP
As an example, the user may prefer French or English text. This may be configured by:
.CS
::msgcat::mcpreferences fr en {}
returns \fB{en_us_funky en_us en {}}\fR.
.CE
.RE
.PP
.VS "TIP 499"
.TP
\fB::msgcat:mcloadedlocales subcommand\fR ?\fIlocale\fR?
.
This group of commands manage the list of loaded locales for packages not setting a package locale.
.PP
.RS
The subcommand \fBget\fR returns the list of currently loaded locales.
227
228
229
230
231
232
233
















234
235
236
237
238
239
240
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







Note that this routine is only called if the concerned package did not set a package locale unknown command name.
.RE
.TP
\fB::msgcat::mcforgetpackage\fR
.
The calling package clears all its state within the \fBmsgcat\fR package including all settings and translations.
.VE "TIP 412"
.PP
.VS "TIP 499"
.TP
\fB::msgcat::mcutil getpreferences\fR \fIlocale\fR
.
Return the preferences list of the given locale as described in section \fBLOCALE SPECIFICATION\fR.
An example is the composition of a preference list for the bilingual region "Biel/Bienne" as a concatenation of swiss german and swiss french:
.CS
% concat [lrange [msgcat::mcutil getpreferences fr_CH] 0 end-1] [msgcat::mcutil getpreferences de_CH]
fr_ch fr de_ch de {}
.CE
.TP
\fB::msgcat::mcutil getsystemlocale\fR
.
The system locale is returned as described by the section \fBLOCALE SPECIFICATION\fR.
.VE "TIP 499"
.PP
.SH "LOCALE SPECIFICATION"
.PP
The locale is specified to \fBmsgcat\fR by a locale string
passed to \fB::msgcat::mclocale\fR.
The locale string consists of
a language code, an optional country code, and an optional
433
434
435
436
437
438
439
440

441
442
443
444
445
446
447
525
526
527
528
529
530
531

532
533
534
535
536
537
538
539







-
+







.PP
.CS
\fBmsgcat::mc\fR {Produced %1$d at %2$s} $num $city
# ... where that key is mapped to one of the
# human-oriented versions by \fBmsgcat::mcset\fR
.CE
.VS "TIP 412"
.SH Package private locale
.SH "PACKAGE PRIVATE LOCALE"
.PP
A package using \fBmsgcat\fR may choose to use its own package private
locale and its own set of loaded locales, independent to the global
locale set by \fB::msgcat::mclocale\fR.
.PP
This allows a package to change its locale without causing any locales load or removal in other packages and not to invoke the global locale change callback (see below).
.PP
457
458
459
460
461
462
463
464

465
466

467












468
469
470
471
472
473
474
549
550
551
552
553
554
555

556
557

558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578







-
+

-
+

+
+
+
+
+
+
+
+
+
+
+
+







This command may cause the load of locales.
.RE
.TP
\fB::msgcat::mcpackagelocale get\fR
.
Return the package private locale or the global locale, if no package private locale is set.
.TP
\fB::msgcat::mcpackagelocale preferences\fR
\fB::msgcat::mcpackagelocale preferences\fR ?\fIlocale preference\fR? ...
.
Return the package private preferences or the global preferences,
With no parameters, return the package private preferences or the global preferences,
if no package private locale is set.
The package locale state (set or not) is not changed (in contrast to the command \fB::msgcat::mcpackagelocale set\fR).
.PP
.RS
.VS "TIP 499"
If a set of locale preferences is given, it is set as package locale preference list.
The package locale is set to the first element of the preference list.
A package locale is activated, if it was not set so far.
.PP
Locale preferences are loaded now for the package, if not jet loaded.
.VE "TIP 499"
.RE
.PP
.TP
\fB::msgcat::mcpackagelocale loaded\fR
.
Return the list of locales loaded for this package.
.TP
\fB::msgcat::mcpackagelocale isset\fR
.
484
485
486
487
488
489
490
491

492
493
494
495
496
497
498
588
589
590
591
592
593
594

595
596
597
598
599
600
601
602







-
+







.
Returns true, if the given locale is loaded for the package.
.TP
\fB::msgcat::mcpackagelocale clear\fR
.
Clear any loaded locales of the package not present in the package preferences.
.PP
.SH Changing package options
.SH "CHANGING PACKAGE OPTIONS"
.PP
Each package using msgcat has a set of options within \fBmsgcat\fR.
The package options are described in the next sectionPackage options.
Each package option may be set or unset individually using the following ensemble:
.TP
\fB::msgcat::mcpackageconfig get\fR \fIoption\fR
.
559
560
561
562
563
564
565
566

567
568
569
570
571
572
573
574
575
576
577
578
579
580
















































581
582
583
584
585
586
587
663
664
665
666
667
668
669

670
671
672
673
674
675
676
677
678
679
680
681
682
683

684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738







-
+













-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







The called procedure must return the formatted message which will finally be returned by msgcat::mc.
.PP
A generic unknown handler is used if set to the empty string. This consists in returning the key if no arguments are given. With given arguments, format is used to process the arguments.
.PP
See section \fBcallback invocation\fR below.
The appended arguments are identical to \fB::msgcat::mcunknown\fR.
.RE
.SS Callback invocation
.SH "Callback invocation"
A package may decide to register one or multiple callbacks, as described above.
.PP
Callbacks are invoked, if:
.PP
1. the callback command is set,
.PP
2. the command is not the empty string,
.PP
3. the registering namespace exists.
.PP
If a called routine fails with an error, the \fBbgerror\fR routine for the interpreter is invoked after command completion.
Only exception is the callback \fBunknowncmd\fR, where an error causes the invoking \fBmc\fR-command to fail with that error.
.PP
.SS Examples
.VS tip490
.SH "OBJECT ORIENTED PROGRAMMING"
\fBmsgcat\fR supports packages implemented by object oriented programming.
Objects and classes should be defined within a package namespace.
.PP
There are 3 supported cases where package namespace sensitive commands of msgcat (\fBmc\fR, \fBmcexists\fR, \fBmcpackagelocale\fR, \fBmcforgetpackage\fR, \fBmcpackagenamespaceget\fR, \fBmcpackageconfig\fR, \fBmcset\fR and \fBmcmset\fR) may be called:
.PP
.TP
\fB1) In class definition script\fR
.
\fBmsgcat\fR command is called within a class definition script.
.CS
namespace eval ::N2 {
    mcload $dir/msgs
    oo::class create C1 {puts [mc Hi!]}
}
.CE
.PP
.TP
\fB2) method defined in a class\fR
.
\fBmsgcat\fR command is called from a method in an object and the method is defined in a class.
.CS
namespace eval ::N3Class {
    mcload $dir/msgs
    oo::class create C1
    oo::define C1 method m1 {
        puts [mc Hi!]
    }
}
.CE
.PP
.TP
\fB3) method defined in a classless object\fR
.
\fBmsgcat\fR command is called from a method of a classless object.
.CS
namespace eval ::N4 {
    mcload $dir/msgs
    oo::object create O1
    oo::objdefine O1 method m1 {} {
        puts [mc Hi!]
    }
}
.CE
.PP
.VE tip490
.SH EXAMPLES
Packages which display a GUI may update their widgets when the global locale changes.
To register to a callback, use:
.CS
namespace eval gui {
    msgcat::mcpackageconfig changecmd updateGUI

    proc updateGui args {
639
640
641
642
643
644
645
646

647
648

649
650
651
790
791
792
793
794
795
796

797
798

799
800
801
802







-
+

-
+



}
.CE
.VE "TIP 412"
.SH CREDITS
.PP
The message catalog code was developed by Mark Harrison.
.SH "SEE ALSO"
format(n), scan(n), namespace(n), package(n)
format(n), scan(n), namespace(n), package(n), oo::class(n), oo::object
.SH KEYWORDS
internationalization, i18n, localization, l10n, message, text, translation
internationalization, i18n, localization, l10n, message, text, translation, class, object
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/my.n.

1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17

18
19
20
21
22
23







24
25
26
27
28

















29
30


31
32
33
34
35
36
37
38
39
40
41
42

43
44
45
46
47























































48
49
50
51
52
53
54
55
56
1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19
20
21
22


23
24
25
26
27
28
29
30




31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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

128
129
130
131











-
+





+




-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+












+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-




'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH my n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
my \- invoke any method of current object
my, myclass \- invoke any method of current object or its class
.SH SYNOPSIS
.nf
package require TclOO

\fBmy\fI methodName\fR ?\fIarg ...\fR?
\fBmyclass\fI methodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
.PP
The \fBmy\fR command is used to allow methods of objects to invoke any method
of the object (or its class). In particular, the set of valid values for
The \fBmy\fR command is used to allow methods of objects to invoke methods
of the object (or its class),
.VS TIP478
and he \fBmyclass\fR command is used to allow methods of objects to invoke
methods of the current class of the object \fIas an object\fR.
.VE TIP478
In particular, the set of valid values for
\fImethodName\fR is the set of all methods supported by an object and its
superclasses, including those that are not exported. The object upon which the
method is invoked is always the one that is the current context of the method
(i.e. the object that is returned by \fBself object\fR) from which the
\fBmy\fR command is invoked.
superclasses, including those that are not exported
.VS TIP500
and private methods of the object or class when used within another method
defined by that object or class.
.VE TIP500
.PP
The object upon which the method is invoked via \fBmy\fR is the one that owns
the namespace that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
remains if the command is renamed), which is the currently invoked object by
default.
.VS TIP478
Similarly, the object on which the method is invoked via \fBmyclass\fR is the
object that is the current class of the object that owns the namespace that
the \fBmyclass\fR command is contained in initially. As with \fBmy\fR, the
link remains even if the command is renamed into another namespace, and
defaults to being the manufacturing class of the current object.
.VE TIP478
.PP
Each object has its own \fBmy\fR command, contained in its instance namespace.
Each object has its own \fBmy\fR and \fBmyclass\fR commands, contained in its
instance namespace.
.SH EXAMPLES
.PP
This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
the \fBoo::object\fR class, which is not publicly visible by default:
.PP
.CS
oo::class create c {
    method count {} {
        \fBmy\fR variable counter
        puts [incr counter]
    }
}

c create o
o count              \fI\(-> prints "1"\fR
o count              \fI\(-> prints "2"\fR
o count              \fI\(-> prints "3"\fR
.CE
.PP
This example shows how you can use \fBmy\fR to make callbacks to private
methods from outside the object (from a \fBtrace\fR), using
\fBnamespace code\fR to enter the correct context. (See the \fBcallback\fR
command for the recommended way of doing this.)
.PP
.CS
oo::class create HasCallback {
    method makeCallback {} {
        return [namespace code {
            \fBmy\fR Callback
        }]
    }

    method Callback {args} {
        puts "callback: $args"
    }
}

set o [HasCallback new]
trace add variable xyz write [$o makeCallback]
set xyz "called"     \fI\(-> prints "callback: xyz {} write"\fR
.CE
.PP
.VS TIP478
This example shows how to access a private method of a class from an instance
of that class. (See the \fBclassmethod\fR declaration in \fBoo::define\fR for
a higher level interface for doing this.)
.PP
.CS
oo::class create CountedSteps {
    self {
        variable count
        method Count {} {
            return [incr count]
        }
    }
    method advanceTwice {} {
        puts "in [self] step A: [\fBmyclass\fR Count]"
        puts "in [self] step B: [\fBmyclass\fR Count]"
    }
}

CountedSteps create x
CountedSteps create y
x advanceTwice       \fI\(-> prints "in ::x step A: 1"\fR
                     \fI\(-> prints "in ::x step B: 2"\fR
y advanceTwice       \fI\(-> prints "in ::y step A: 3"\fR
                     \fI\(-> prints "in ::y step B: 4"\fR
x advanceTwice       \fI\(-> prints "in ::x step A: 5"\fR
                     \fI\(-> prints "in ::x step B: 6"\fR
y advanceTwice       \fI\(-> prints "in ::y step A: 7"\fR
                     \fI\(-> prints "in ::y step B: 8"\fR
.CE
.VE TIP478
.SH "SEE ALSO"
next(n), oo::object(n), self(n)
.SH KEYWORDS
method, method visibility, object, private method, public method

.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/next.n.

108
109
110
111
112
113
114

115
116
117
118
119
120
121
122
123

124
125
126
127
128
129
130
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132







+









+







.PP
.CS
oo::class create theSuperclass {
    method example {args} {
        puts "in the superclass, args = $args"
    }
}

oo::class create theSubclass {
    superclass theSuperclass
    method example {args} {
        puts "before chaining from subclass, args = $args"
        \fBnext\fR a {*}$args b
        \fBnext\fR pureSynthesis
        puts "after chaining from subclass"
    }
}

theSubclass create obj
oo::objdefine obj method example args {
    puts "per-object method, args = $args"
    \fBnext\fR x {*}$args y
    \fBnext\fR
}
obj example 1 2 3
163
164
165
166
167
168
169

170
171
172
173
174
175
176
177
178
179
180

181
182
183
184

185
186
187
188
189
190
191
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196







+











+




+







        if {[info exist ValueCache($key)]} {
            return $ValueCache($key)
        }

        \fI# Compute value, insert into cache, and return it\fR
        return [set ValueCache($key) [\fBnext\fR {*}$args]]
    }

    method flushCache {} {
        my variable ValueCache
        unset ValueCache
        \fI# Skip the caching\fR
        return -level 2 ""
    }
}

oo::object create demo
oo::objdefine demo {
    mixin cache

    method compute {a b c} {
        after 3000 \fI;# Simulate deep thought\fR
        return [expr {$a + $b * $c}]
    }

    method compute2 {a b c} {
        after 3000 \fI;# Simulate deep thought\fR
        return [expr {$a * $b + $c}]
    }
}

puts [demo compute  1 2 3]      \fI\(-> prints "7" after delay\fR

Changes to doc/packagens.n.

44
45
46
47
48
49
50




44
45
46
47
48
49
50
51
52
53
54







+
+
+
+
specified.
.PP
At least one \fB\-load\fR or \fB\-source\fR parameter must be given.
.SH "SEE ALSO"
package(n)
.SH KEYWORDS
auto-load, index, package, version
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/pid.n.

39
40
41
42
43
44
45
46
47
48




39
40
41
42
43
44
45

46
47
48
49
50
51







-


+
+
+
+
puts [string repeat - 70]
puts [read $pipeline]
close $pipeline
.CE

.SH "SEE ALSO"
exec(n), open(n)

.SH KEYWORDS
file, pipeline, process identifier
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/platform.n.

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22







-
+







.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform ?1.0.10?\fR
\fBpackage require platform\fR ?\fB1.0.10\fR?
.sp
\fBplatform::generic\fR
\fBplatform::identify\fR
\fBplatform::patterns \fIidentifier\fR
.fi
.BE
.SH DESCRIPTION

Changes to doc/platform_shell.n.

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22







-
+







.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform::shell \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform::shell ?1.1.4?\fR
\fBpackage require platform::shell\fR ?\fB1.1.4\fR?
.sp
\fBplatform::shell::generic \fIshell\fR
\fBplatform::shell::identify \fIshell\fR
\fBplatform::shell::platform \fIshell\fR
.fi
.BE
.SH DESCRIPTION
51
52
53
54
55
56
57




51
52
53
54
55
56
57
58
59
60
61







+
+
+
+
for the specified Tcl shell, in contrast to the running shell.
.TP
\fBplatform::shell::platform \fIshell\fR
This command returns the contents of \fBtcl_platform(platform)\fR for
the specified Tcl shell.
.SH KEYWORDS
operating system, cpu architecture, platform, architecture
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/prefix.n.

8
9
10
11
12
13
14
15
16
17



18
19
20
21
22
23
24
25

26
27
28
29
30

31
32
33
34
35

36
37
38
39
40
41
42
8
9
10
11
12
13
14



15
16
17
18
19
20
21
22
23
24

25
26
27
28
29

30
31
32
33
34

35
36
37
38
39
40
41
42







-
-
-
+
+
+







-
+




-
+




-
+







.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::prefix \- facilities for prefix matching
.SH SYNOPSIS
.nf
\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix match\fR \fI?option ...?\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix all\fR \fItable string\fR
\fB::tcl::prefix longest\fR \fItable string\fR
\fB::tcl::prefix match\fR ?\fIoption ...\fR? \fItable string\fR
.fi
.BE
.SH DESCRIPTION
.PP
This document describes commands looking up a prefix in a list of strings.
The following commands are supported:
.TP
\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix all\fR \fItable string\fR
.
Returns a list of all elements in \fItable\fR that begin with the prefix
\fIstring\fR.
.TP
\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix longest\fR \fItable string\fR
.
Returns the longest common prefix of all elements in \fItable\fR that
begin with the prefix \fIstring\fR.
.TP
\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable\fR \fIstring\fR
\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable string\fR
.
If \fIstring\fR equals one element in \fItable\fR or is a prefix to exactly
one element, the matched element is returned. If not, the result depends
on the \fB\-error\fR option. (It is recommended that the \fItable\fR be sorted
before use with this subcommand, so that the list of matches presented in the
error message also becomes sorted, though this is not strictly necessary for
the operation of this subcommand itself.)

Added doc/process.n.























































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 2017 Frederic Bonnet.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH process n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::process \- Subprocess management
.SH SYNOPSIS
\fB::tcl::process \fIoption \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command provides a way to manage subprocesses created by the \fBopen\fR
and \fBexec\fR commands, as identified by the process identifiers (PIDs) of
those subprocesses. The legal \fIoptions\fR (which may be abbreviated) are:
.TP
\fB::tcl::process autopurge\fR ?\fIflag\fR?
.
Automatic purge facility. If \fIflag\fR is specified as a boolean value then
it activates or deactivate autopurge. In all cases it returns the current
status as a boolean value. When autopurge is active,
\fBTcl_ReapDetachedProcs\fR is called each time the \fBexec\fR command is
executed or a pipe channel created by \fBopen\fR is closed. When autopurge is
inactive, \fB::tcl::process\fR purge must be called explicitly. By default
autopurge is active.
.TP
\fB::tcl::process list\fR
.
Returns the list of subprocess PIDs. This includes all currently executing
subprocesses and all terminated subprocesses that have not yet had their
corresponding process table entries purged.
.TP
\fB::tcl::process purge\fR ?\fIpids\fR?
.
Cleans up all data associated with terminated subprocesses. If \fIpids\fR is
specified as a list of PIDs then the command only cleanup data for the matching
subprocesses if they exist, and raises an error otherwise. If a process listed is
still active, this command does nothing to that process.
.TP
\fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
.
Returns a dictionary mapping subprocess PIDs to their respective status. If
\fIpids\fR is specified as a list of PIDs then the command only returns the
status of the matching subprocesses if they exist, and raises an error
otherwise. For active processes, the status is an empty value. For terminated
processes, the status is a list with the following format:
.QW "\fB{\fIcode\fR ?\fImsg errorCode\fR?\fB}\fR" ,
where:
.RS
.TP
\fIcode\fR\0
.
is a standard Tcl return code, i.e., \fB0\fR for TCL_OK and \fB1\fR
for TCL_ERROR,
.TP
\fImsg\fR\0
.
is the human-readable error message,
.TP
\fIerrorCode\fR\0
.
uses the same format as the \fBerrorCode\fR global variable
.PP
Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally
terminated processes (i.e. those where the \fIcode\fR is nonzero). Under the
hood this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
non-blocking behavior, unless the \fB\-wait\fR switch is set (see below).
.PP
Additionally, \fB::tcl::process status\fR accepts the following switches:
.TP
\fB\-wait\fR\0
.
By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is
called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fIpids\fR
is specified as a list of PIDs then the command waits until the status of the
matching subprocesses are available. If \fIpids\fR was not specified, this
command will wait for all known subprocesses.
.TP
\fB\-\|\-\fR
.
Marks the end of switches.  The argument following this one will
be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
.RE
.SH "EXAMPLES"
.PP
These show the use of \fB::tcl::process\fR. Some of the results from
\fB::tcl::process status\fR are split over multiple lines for readability.
.PP
.CS
\fB::tcl::process autopurge\fR
     \fI\(-> true\fR
\fB::tcl::process autopurge\fR false
     \fI\(-> false\fR

set pid1 [exec command1 a b c | command2 d e f &]
     \fI\(-> 123 456\fR
set chan [open "|command1 a b c | command2 d e f"]
     \fI\(-> file123\fR
set pid2 [pid $chan]
     \fI\(-> 789 1011\fR

\fB::tcl::process list\fR
     \fI\(-> 123 456 789 1011\fR

\fB::tcl::process status\fR
     \fI\(-> 123 0
       456 {1 "child killed: write on pipe with no readers" {
         CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
       789 {1 "child suspended: background tty read" {
         CHILDSUSP 789 SIGTTIN "background tty read"}}
       1011 {}\fR

\fB::tcl::process status\fR 123
     \fI\(-> 123 0\fR

\fB::tcl::process status\fR 1011
     \fI\(-> 1011 {}\fR

\fB::tcl::process status\fR -wait
     \fI\(-> 123 0
       456 {1 "child killed: write on pipe with no readers" {
         CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
       789 {1 "child suspended: background tty read" {
         CHILDSUSP 789 SIGTTIN "background tty read"}}
       1011 {1 "child process exited abnormally" {
         CHILDSTATUS 1011 -1}}\fR

\fB::tcl::process status\fR 1011
     \fI\(-> 1011 {1 "child process exited abnormally" {
         CHILDSTATUS 1011 -1}}\fR

\fB::tcl::process purge\fR
exec command1 1 2 3 &
     \fI\(-> 1213\fR
\fB::tcl::process list\fR
     \fI\(-> 1213\fR
.CE
.SH "SEE ALSO"
exec(n), open(n), pid(n),
Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
.SH "KEYWORDS"
background, child, detach, process, wait
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/puts.n.

92
93
94
95
96
97
98




92
93
94
95
96
97
98
99
100
101
102







+
+
+
+
\fBputs\fR $chan "$timestamp - Hello, World!"
close $chan
.CE
.SH "SEE ALSO"
file(n), fileevent(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, newline, output, write
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/pwd.n.

33
34
35
36
37
38
39




33
34
35
36
37
38
39
40
41
42
43







+
+
+
+
exec tar -xf $tarFile
cd $savedDir
.CE
.SH "SEE ALSO"
file(n), cd(n), glob(n), filename(n)
.SH KEYWORDS
working directory
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/rename.n.

39
40
41
42
43
44
45




39
40
41
42
43
44
45
46
47
48
49







+
+
+
+
    uplevel 1 ::theRealSource $args
}
.CE
.SH "SEE ALSO"
namespace(n), proc(n)
.SH KEYWORDS
command, delete, namespace, rename
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/scan.n.

220
221
222
223
224
225
226
227



228
229
230

231
232
233
234
235
236
237
220
221
222
223
224
225
226

227
228
229
230
231

232
233
234
235
236
237
238
239







-
+
+
+


-
+







hexadecimal conversions with substring sizes:
.PP
.CS
set string "#08D03F"
\fBscan\fR $string "#%2x%2x%2x" r g b
.CE
.PP
Parse a \fIHH:MM\fR time string:
Parse a \fIHH:MM\fR time string, noting that this avoids problems with
octal numbers by forcing interpretation as decimals (if we did not
care, we would use the \fB%i\fR conversion instead):
.PP
.CS
set string "08:08"
set string "08:08"   ;# *Not* octal!
if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} {
    error "not a valid time string"
}
# We have to understand numeric ranges ourselves...
if {$minutes < 0 || $minutes > 59} {
    error "invalid number of minutes"
}

Changes to doc/self.n.

28
29
30
31
32
33
34





35

36
37
38
39
40
41
42
28
29
30
31
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47







+
+
+
+
+
-
+







\fBself call\fR
.
This returns a two-element list describing the method implementations used to
implement the current call chain. The first element is the same as would be
reported by \fBinfo object\fR \fBcall\fR for the current method (except that this
also reports useful values from within constructors and destructors, whose
names are reported as \fB<constructor>\fR and \fB<destructor>\fR
respectively,
.VS TIP500
and for private methods, which are described as being \fBprivate\fR instead of
being a \fBmethod\fR),
.VE TIP500
respectively), and the second element is an index into the first element's
and the second element is an index into the first element's
list that indicates which actual implementation is currently executing (the
first implementation to execute is always at index 0).
.TP
\fBself caller\fR
.
When the method was invoked from inside another object method, this subcommand
returns a three element list describing the containing object and method. The

Changes to doc/set.n.

69
70
71
72
73
74
75




69
70
71
72
73
74
75
76
77
78
79







+
+
+
+
\fBset\fR vbl in[expr {rand() >= 0.5}]
\fBset\fR out [\fBset\fR $vbl]
.CE
.SH "SEE ALSO"
expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), variable(n)
.SH KEYWORDS
read, write, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Added doc/singleton.n.




































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH singleton n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::singleton \- a class that does only allows one instance of itself
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::singleton\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR
       \(-> \fBoo::singleton\fR
.fi
.BE
.SH DESCRIPTION
Singleton classes are classes that only permit at most one instance of
themselves to exist. They unexport the \fBcreate\fR and
\fBcreateWithNamespace\fR methods entirely, and override the \fBnew\fR method
so that it only makes a new instance if there is no existing instance.  It is
not recommended to inherit from a singleton class; singleton-ness is \fInot\fR
inherited. It is not recommended that a singleton class's constructor take any
arguments.
.PP
Instances have their\fB destroy\fR method overridden with a method that always
returns an error in order to discourage destruction of the object, but
destruction remains possible if strictly necessary (e.g., by destroying the
class or using \fBrename\fR to delete it). They also have a (non-exported)
\fB<cloned>\fR method defined on them that similarly always returns errors to
make attempts to use the singleton instance with \fBoo::copy\fR fail.
.SS CONSTRUCTOR
The \fBoo::singleton\fR class does not define an explicit constructor; this
means that it is effectively the same as the constructor of the
\fBoo::class\fR class.
.SS DESTRUCTOR
The \fBoo::singleton\fR class does not define an explicit destructor;
destroying an instance of it is just like destroying an ordinary class (and
will destroy the singleton object).
.SS "EXPORTED METHODS"
.TP
\fIcls \fBnew \fR?\fIarg ...\fR?
.
This returns the current instance of the singleton class, if one exists, and
creates a new instance only if there is no existing instance. The additional
arguments, \fIarg ...\fR, are only used if a new instance is actually
manufactured; that construction is via the \fBoo::class\fR class's \fBnew\fR
method.
.RS
.PP
This is an override of the behaviour of a superclass's method with an
identical call signature to the superclass's implementation.
.RE
.SS "NON-EXPORTED METHODS"
The \fBoo::singleton\fR class explicitly states that \fBcreate\fR and
\fBcreateWithNamespace\fR are unexported; callers should not assume that they
have control over either the name or the namespace name of the singleton instance.
.SH EXAMPLE
.PP
This example demonstrates that there is only one instance even though the
\fBnew\fR method is called three times.
.PP
.CS
\fBoo::singleton\fR create Highlander {
    method say {} {
        puts "there can be only one"
    }
}

set h1 [Highlander new]
set h2 [Highlander new]
if {$h1 eq $h2} {
    puts "equal objects"    \fI\(-> prints "equal objects"\fR
}
set h3 [Highlander new]
if {$h1 eq $h3} {
    puts "equal objects"    \fI\(-> prints "equal objects"\fR
}
.CE
.PP
Note that the name of the instance of the singleton is not guaranteed to be
anything in particular.
.SH "SEE ALSO"
oo::class(n)
.SH KEYWORDS
class, metaclass, object, single instance
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/source.n.

65
66
67
68
69
70
71




65
66
67
68
69
70
71
72
73
74
75







+
+
+
+
    \fBsource\fR $scriptFile
}
.CE
.SH "SEE ALSO"
file(n), cd(n), encoding(n), info(n)
.SH KEYWORDS
file, script
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/string.n.

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22







-
+







.TH string n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
string \- Manipulate strings
.SH SYNOPSIS
\fBstring \fIoption arg \fR?\fIarg ...?\fR
\fBstring \fIoption arg \fR?\fIarg ...\fR?
.BE
.SH DESCRIPTION
.PP
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR?
111
112
113
114
115
116
117
118

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

135
136
137
138
139
140
141
111
112
113
114
115
116
117

118


119
120
121
122
123
124
125
126
127
128
129
130
131

132
133
134
135
136
137
138
139







-
+
-
-













-
+







Any of the forms allowed to \fBTcl_GetBoolean\fR.
.IP \fBcontrol\fR 12
Any Unicode control character.
.IP \fBdigit\fR 12
Any Unicode digit character.  Note that this includes characters
outside of the [0\-9] range.
.IP \fBdouble\fR 12
Any of the valid forms for a double in Tcl, with optional surrounding
Any of the forms allowed to \fBTcl_GetDoubleFromObj\fR.
whitespace.  In case of under/overflow in the value, 0 is returned and
the \fIvarname\fR will contain \-1.
.IP \fBentier\fR 12
.VS 8.6
Any of the valid string formats for an integer value of arbitrary size
in Tcl, with optional surrounding whitespace. The formats accepted are
exactly those accepted by the C routine \fBTcl_GetBignumFromObj\fR.
.VE
.IP \fBfalse\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
false.
.IP \fBgraph\fR 12
Any Unicode printing character, except space.
.IP \fBinteger\fR 12
Any of the valid string formats for a 32-bit integer value in Tcl,
with optional surrounding whitespace.  In case of under/overflow in
with optional surrounding whitespace.  In case of overflow in
the value, 0 is returned and the \fIvarname\fR will contain \-1.
.IP \fBlist\fR 12
Any proper list structure, with optional surrounding whitespace. In
case of improper list structure, 0 is returned and the \fIvarname\fR
will contain the index of the
.QW element
where the list parsing fails, or \-1 if this cannot be determined.
152
153
154
155
156
157
158
159

160
161
162
163
164
165
166
150
151
152
153
154
155
156

157
158
159
160
161
162
163
164







-
+







.IP \fBtrue\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
true.
.IP \fBupper\fR 12
Any upper case alphabet character in the Unicode character set.
.IP \fBwideinteger\fR 12
Any of the valid forms for a wide integer in Tcl, with optional
surrounding whitespace.  In case of under/overflow in the value, 0 is
surrounding whitespace.  In case of overflow in the value, 0 is
returned and the \fIvarname\fR will contain \-1.
.IP \fBwordchar\fR 12
Any Unicode word character.  That is any alphanumeric character, and
any Unicode connector punctuation characters (e.g. underscore).
.IP \fBxdigit\fR 12
Any hexadecimal digit character ([0\-9A\-Fa\-f]).
.PP

Changes to doc/tclsh.1.

139
140
141
142
143
144
145









146
147
148
149
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158







+
+
+
+
+
+
+
+
+




The variable \fBtcl_prompt2\fR is used in a similar way when
a newline is typed but the current command is not yet complete;
if \fBtcl_prompt2\fR is not set then no prompt is output for
incomplete commands.
.SH "STANDARD CHANNELS"
.PP
See \fBTcl_StandardChannels\fR for more explanations.
.SH ZIPVFS
.PP
When a zipfile is concatenated to the end of a \fBtclsh\fR, on
startup the contents of the zip archive will be mounted as the
virtual file system /zvfs. If a top level directory tcl8.6 is
present in the zip archive, it will become the directory loaded
as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present
in the top level directory of the zip archive, it will be sourced
instead of the shell's normal command line handing.
.SH "SEE ALSO"
auto_path(n), encoding(n), env(n), fconfigure(n)
.SH KEYWORDS
application, argument, interpreter, prompt, script file, shell

Changes to doc/tcltest.n.

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18

19
20
21
22
23
24
25
26










-
+







-
+







'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\" Copyright (c) 2000 Ajuba Solutions
'\" Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages"
.TH "tcltest" n 2.5 tcltest "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcltest \- Test harness support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require tcltest\fR ?\fB2.3\fR?
\fBpackage require tcltest\fR ?\fB2.5\fR?

\fBtcltest::test \fIname description\fR ?\fI\-option value ...\fR?
\fBtcltest::test \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR

\fBtcltest::loadTestedCommands\fR
\fBtcltest::makeDirectory \fIname\fR ?\fIdirectory\fR?
\fBtcltest::removeDirectory \fIname\fR ?\fIdirectory\fR?
450
451
452
453
454
455
456

457
458
459
460
461
462
463
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464







+







        ?\fB\-setup \fIsetupScript\fR?
        ?\fB\-body \fItestScript\fR?
        ?\fB\-cleanup \fIcleanupScript\fR?
        ?\fB\-result \fIexpectedAnswer\fR?
        ?\fB\-output \fIexpectedOutput\fR?
        ?\fB\-errorOutput \fIexpectedError\fR?
        ?\fB\-returnCodes \fIcodeList\fR?
        ?\fB\-errorCode \fIexpectedErrorCode\fR?
        ?\fB\-match \fImode\fR?
.CE
.PP
The \fIname\fR may be any string.  It is conventional to choose
a \fIname\fR according to the pattern:
.PP
.CS
573
574
575
576
577
578
579









580
581
582
583
584
585
586
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596







+
+
+
+
+
+
+
+
+







a list of return codes that may be accepted from evaluation of the
\fB\-body\fR script.  If evaluation of the \fB\-body\fR script returns
a code not in the \fIexpectedCodeList\fR, the test fails.  All
return codes known to \fBreturn\fR, in both numeric and symbolic
form, including extended return codes, are acceptable elements in
the \fIexpectedCodeList\fR.  Default value is
.QW "\fBok return\fR" .
.TP
\fB\-errorCode \fIexpectedErrorCode\fR
.
The optional \fB\-errorCode\fR attribute supplies \fIexpectedErrorCode\fR,
a glob pattern that should match the error code reported from evaluation of the
\fB\-body\fR script.  If evaluation of the \fB\-body\fR script returns
a code not matching \fIexpectedErrorCode\fR, the test fails.  Default value is
.QW "\fB*\fR" .
If \fB\-returnCodes\fR does not include \fBerror\fR it is set to \fBerror\fR.
.PP
To pass, a test must successfully evaluate its \fB\-setup\fR, \fB\-body\fR,
and \fB\-cleanup\fR scripts.  The return code of the \fB\-body\fR script and
its result must match expected values, and if specified, output and error
data from the test must match expected \fB\-output\fR and \fB\-errorOutput\fR
values.  If any of these conditions are not met, then the test fails.
Note that all scripts are evaluated in the context of the caller

Changes to doc/tell.n.

42
43
44
45
46
47
48




42
43
44
45
46
47
48
49
50
51
52







+
+
+
+
    seek $chan $offset
}
.CE
.SH "SEE ALSO"
file(n), open(n), close(n), gets(n), seek(n), Tcl_StandardChannels(3)
.SH KEYWORDS
access position, channel, seeking
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/trace.n.

16
17
18
19
20
21
22
23


24
25
26
27
28
29
30
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30
31







-
+
+







\fBtrace \fIoption\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command causes Tcl commands to be executed whenever certain operations are
invoked.  The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBtrace add \fItype name ops ?args?\fR
\fBtrace add \fItype name ops\fR ?\fIargs\fR?
.
Where \fItype\fR is \fBcommand\fR, \fBexecution\fR, or \fBvariable\fR.
.RS
.TP
\fBtrace add command\fR \fIname ops commandPrefix\fR
.
Arrange for \fIcommandPrefix\fR to be executed (with additional arguments)
whenever command \fIname\fR is modified in one of the ways given by the list

Changes to doc/unknown.n.

85
86
87
88
89
90
91




85
86
87
88
89
90
91
92
93
94
95







+
+
+
+
    uplevel 1 [list _original_unknown {*}$args]
}
.CE
.SH "SEE ALSO"
info(n), proc(n), interp(n), library(n), namespace(n)
.SH KEYWORDS
error, non-existent command, unknown
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/update.n.

59
60
61
62
63
64
65




59
60
61
62
63
64
65
66
67
68
69







+
+
+
+
    \fBupdate\fR
}
.CE
.SH "SEE ALSO"
after(n), interp(n)
.SH KEYWORDS
asynchronous I/O, event, flush, handler, idle, update
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/uplevel.n.

20
21
22
23
24
25
26
27

28
29

30
31
32
33
34
35
36
20
21
22
23
24
25
26

27
28

29
30
31
32
33
34
35
36







-
+

-
+







been passed to \fBconcat\fR; the result is then evaluated in the
variable context indicated by \fIlevel\fR.  \fBUplevel\fR returns
the result of that evaluation.
.PP
If \fIlevel\fR is an integer then
it gives a distance (up the procedure calling stack) to move before
executing the command.  If \fIlevel\fR consists of \fB#\fR followed by
a number then the number gives an absolute level number.  If \fIlevel\fR
a integer then the level gives an absolute level.  If \fIlevel\fR
is omitted then it defaults to \fB1\fR.  \fILevel\fR cannot be
defaulted if the first \fIcommand\fR argument starts with a digit or \fB#\fR.
defaulted if the first \fIcommand\fR argument is an integer or starts with \fB#\fR.
.PP
For example, suppose that procedure \fBa\fR was invoked
from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR.
Suppose that \fBc\fR invokes the \fBuplevel\fR command.  If \fIlevel\fR
is \fB1\fR or \fB#2\fR  or omitted, then the command will be executed
in the variable context of \fBb\fR.  If \fIlevel\fR is \fB2\fR or \fB#1\fR
then the command will be executed in the variable context of \fBa\fR.

Changes to doc/while.n.

59
60
61
62
63
64
65




59
60
61
62
63
64
65
66
67
68
69







+
+
+
+
    puts "[incr lineCount]: $line"
}
.CE
.SH "SEE ALSO"
break(n), continue(n), for(n), foreach(n)
.SH KEYWORDS
boolean, loop, test, while
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Added doc/zipfs.3.























































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 2015 Jan Nijtmans <[email protected]>
'\" Copyright (c) 2015 Christian Werner <[email protected]>
'\" Copyright (c) 2017 Sean Woods <[email protected]>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems
.SH SYNOPSIS
.nf
int
\fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR)
.sp
int
\fBTclzipfs_Mount\fR(\fIinterp, mountpoint, zipname, password\fR)
.sp
int
\fBTclZipfs_MountBuffer\fR(\fIinterp, mountpoint, data, dataLen, copy\fR)
.sp
int
\fBTclzipfs_Unmount\fR(\fIinterp, mountpoint\fR)
.fi
.SH ARGUMENTS
.AS Tcl_Interp *mountpoint in
.AP "int" *argcPtr in
Pointer to a variable holding the number of command line arguments from
\fBmain\fR().
.AP "char" ***argvPtr in
Pointer to an array of strings containing the command line arguments to
\fBmain\fR().
.AP Tcl_Interp *interp in
Interpreter in which the ZIP file system is mounted.  The interpreter's result is
modified to hold the result or error message from the script.
.AP "const char" *zipname in
Name of a ZIP file. Must not be NULL when either mounting or unmounting a ZIP.
.AP "const char" *mountpoint in
Name of a mount point, which must be a legal Tcl file or directory name. May
be NULL to query current mount points.
.AP "const char" *password in
An (optional) password. Use NULL if no password is wanted to read the file.
.AP "unsigned char" *data in
A data buffer to mount. The data buffer must hold the contents of a ZIP
archive, and must not be NULL.
.AP size_t dataLen in
The number of bytes in the supplied data buffer argument, \fIdata\fR.
.AP int copy in
If non-zero, the ZIP archive in the data buffer will be internally copied
before mounting, allowing the data buffer to be disposed once
\fBTclZipfs_MountBuffer\fR returns. If zero, the caller guarantees that the
buffer will be valid to read from for the duration of the mount.
.BE
.SH DESCRIPTION
\fBTclZipfs_AppHook\fR is a utility function to perform standard application
initialization procedures, taking into account available ZIP archives as
follows:
.IP [1]
If the current application has a mountable ZIP archive, that archive is
mounted under \fIZIPFS_VOLUME\fB/app\fR as a read-only Tcl virtual file
system. \fIZIPFS_VOLUME\fR is usually \fB//zipfs:\fR on all platforms, but
\fBzipfs:\fR may also be used on Windows (due to differences in the
platform's filename parsing).
.IP [2]
If a file named \fBmain.tcl\fR is located in the root directory of that file
system (i.e., at \fIZIPROOT\fB/app/main.tcl\fR after the ZIP archive is
mounted as described above) it is treated as the startup script for the
process.
.IP [3]
If the file \fIZIPROOT\fB/app/tcl_library/init.tcl\fR is present, the
\fBtcl_library\fR global variable in the initial Tcl interpreter is set to
\fIZIPROOT\fB/app/tcl_library\fR.
.IP [4]
If the directory \fBtcl_library\fR was not found in the main application
mount, the system will then search for it as either a VFS attached to the
application dynamic library, or as a zip archive named
\fBlibtcl_\fImajor\fB_\fIminor\fB_\fIpatchlevel\fB.zip\fR either in the
present working directory or in the standard Tcl install location. (For
example, the Tcl 8.7.2 release would be searched for in a file
\fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only.
.PP
On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since
it uses WCHAR in stead of char. As a result, it requires your application to
be compiled with the UNICODE preprocessor symbol defined (e.g., via the
\fB-DUNICODE\fR compiler flag).
.PP
The result of \fBTclZipfs_AppHook\fR is a Tcl result code (e.g., \fBTCL_OK\fR
when the function is successful). The function \fImay\fR modify the variables
pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the
current implementation does not do so, but callers \fIshould not\fR assume
that this will be true in the future.
.PP
\fBTclzipfs_Mount\fR mounts the ZIP archive \fIzipname\fR on the mount point
given in \fImountpoint\fR using the optional ZIP password \fIpassword\fR.
Errors during that process are reported in the interpreter \fIinterp\fR.  If
\fImountpoint\fR is a NULL pointer, information on all currently mounted ZIP
file systems is written into \fIinterp\fR's result as a sequence of mount
points and ZIP file names.  The result of this call is a standard Tcl result
code.
.PP
\fBTclzipfs_MountBuffer\fR mounts the ZIP archive in the buffer pointed to by
\fIdata\fR on the mount point given in \fImountpoint\fR. The ZIP archive is
assumed to be not password protected.  Errors during that process are reported
in the interpreter \fIinterp\fR. The \fIcopy\fR argument determines whether
the buffer is internally copied before mounting or not. The result of this
call is a standard Tcl result code.
.PP
\fBTclzipfs_Unmount\fR undoes the effect of \fBTclzipfs_Mount\fR, i.e., it
unmounts the mounted ZIP file system that was mounted from \fIzipname\fR (at
\fImountpoint\fR). Errors are reported in the interpreter \fIinterp\fR.  The
result of this call is a standard Tcl result code.
.SH "SEE ALSO"
zipfs(n)
.SH KEYWORDS
compress, filesystem, zip

Added doc/zipfs.n.
































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 2015 Jan Nijtmans <[email protected]>
'\" Copyright (c) 2015 Christian Werner <[email protected]>
'\" Copyright (c) 2015 Sean Woods <[email protected]>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH zipfs n 1.0 Zipfs "zipfs Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
zipfs \- Mount and work with ZIP files within Tcl
.SH SYNOPSIS
.nf
\fBpackage require zipfs \fR?\fB1.0\fR?
.sp
\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR?
\fBzipfs exists\fR \fIfilename\fR
\fBzipfs find\fR \fIdirectoryName\fR
\fBzipfs info\fR \fIfilename\fR
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
\fBzipfs mkkey\fR \fIpassword\fR
\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
\fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
\fBzipfs root\fR
\fBzipfs unmount\fR \fImountpoint\fR
.fi
'\" The following subcommand is *UNDOCUMENTED*
'\" \fBzipfs mount_data\fR ?\fImountpoint\fR? ?\fIdata\fR?
.BE
.SH DESCRIPTION
.PP
The \fBzipfs\fR command (the sole public command provided by the built-in
package with the same name) provides Tcl with the ability to mount the
contents of a ZIP archive file as a virtual file system. ZIP archives support
simple encryption, sufficient to prevent casual inspection of their contents
but not able to prevent access by even a moderately determined attacker.
.TP
\fBzipfs canonical\fR ?\fImountpoint\fR? \fIfilename\fR ?\fIinZipfs\fR?
.
This takes the name of a file, \fIfilename\fR, and produces where it would be
mapped into a zipfs mount as its result. If specified, \fImountpoint\fR says
within which mount the mapping will be done; if omitted, the main root of the
zipfs system is used. The \fIinZipfs\fR argument is a an optional boolean
which controls whether to fully canonicalise the name; it defaults to true.
.TP
\fBzipfs exists\fR \fIfilename\fR
.
Return 1 if the given filename exists in the mounted zipfs and 0 if it does not.
.TP
\fBzipfs find\fR \fIdirectoryName\fR
.
Recursively lists files including and below the directory \fIdirectoryName\fR.
The result list consists of relative path names starting from the given
directory. This command is also used by the \fBzipfs mkzip\fR and \fBzipfs
mkimg\fR commands.
.TP
\fBzipfs info\fR \fIfile\fR
.
Return information about the given \fIfile\fR in the mounted zipfs.  The
information consists of:
.RS
.IP (1)
the name of the ZIP archive file that contains the file,
.IP (2)
the size of the file after decompressions,
.IP (3)
the compressed size of the file, and
.IP (4)
the offset of the compressed data in the ZIP archive file.
.PP
Note: querying the mount point gives the start of the zip data as the offset
in (4), which can be used to truncate the zip information from an executable.
.RE
.TP
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
.
Return a list of all files in the mounted zipfs, or just those matching
\fIpattern\fR (optionally controlled by the option parameters).  The order of
the names in the list is arbitrary.
.TP
\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
.
The \fBzipfs mount\fR command mounts a ZIP archive file as a Tcl virtual
filesystem at \fImountpoint\fR.  After this command executes, files contained
in \fIzipfile\fR will appear to Tcl to be regular files at the mount point.
.RS
.PP
With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR.  With
no \fImountpoint\fR, return all zipfile/mount pairs.  If \fImountpoint\fR is
specified as an empty string, mount on file path.
.PP
\fBNB:\fR because the current working directory is a concept maintained by the
operating system, using \fBcd\fR into a mounted archive will only work in the
current process, and then not entirely consistently (e.g., if a shared library
uses direct access to the OS rather than through Tcl's filesystem API, it will
not see the current directory as being inside the mount and will not be able
to access the files inside the mount).
.RE
.TP
\fBzipfs root\fR
.
Returns a constant string which indicates the mount point for zipfs volumes
for the current platform. On Windows, this value is
.QW \fBzipfs:/\fR .
On Unix, this value is
.QW \fB//zipfs:/\fR .
.RE
.TP
\fBzipfs unmount \fImountpoint\fR
.
Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
.SS "ZIP CREATION COMMANDS"
This package also provides several commands to aid the creation of ZIP
archives as Tcl applications.
.TP
\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
.
Creates a ZIP archive file named \fIoutfile\fR from the contents of the input
directory \fIindir\fR (contained regular files only) with optional ZIP
password \fIpassword\fR. While processing the files below \fIindir\fR the
optional file name prefix given in \fIstrip\fR is stripped off the beginning
of the respective file name.  When stripping, it is common to remove either
the whole source directory name or the name of its parent directory.
.RS
.PP
\fBCaution:\fR the choice of the \fIindir\fR parameter (less the optional
stripped prefix) determines the later root name of the archive's content.
.RE
.TP
\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
.
Creates an image (potentially a new executable file) similar to \fBzipfs
mkzip\fR; see that command for a description of most parameters to this
command, as they behave identically here.
.RS
.PP
If the \fIinfile\fR parameter is specified, this file is prepended in front of
the ZIP archive, otherwise the file returned by \fBinfo nameofexecutable\fR
(i.e., the executable file of the running process) is used. If the
\fIpassword\fR parameter is not empty, an obfuscated version of that password
(see \fBzipfs mkkey\fR) is placed between the image and ZIP chunks of the
output file and the contents of the ZIP chunk are protected with that
password.
.PP
If there is a file, \fBmain.tcl\fR, in the root directory of the resulting
archive and the image file that the archive is attached to is a \fBtclsh\fR
(or \fBwish\fR) instance (true by default, but depends on your configuration),
then the resulting image is an executable that will \fBsource\fR the script in
that \fBmain.tcl\fR after mounting the ZIP archive, and will \fBexit\fR once
that script has been executed.
.PP
\fBCaution:\fR highly experimental, not usable on Android, only partially
tested on Linux and Windows.
.RE
.TP
\fBzipfs mkkey\fR \fIpassword\fR
.
Given the clear text \fIpassword\fR argument, an obfuscated string version is
returned with the same format used in the \fBzipfs mkimg\fR command.
.TP
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
.
This command is like \fBzipfs mkimg\fR, but instead of an input directory,
\fIinlist\fR must be a Tcl list where the odd elements are the names of files
to be copied into the archive in the image, and the even elements are their
respective names within that archive.
.TP
\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
.
This command is like \fBzipfs mkzip\fR, but instead of an input directory,
\fIinlist\fR must be a Tcl list where the odd elements are the names of files
to be copied into the archive, and the even elements are their respective
names within that archive.
.SH "EXAMPLES"
.PP
Mounting an ZIP archive as an application directory and running code out of it
before unmounting it again:
.PP
.CS
set zip myApp.zip
set base [file join [\fbzipfs root\fR] myApp]

\fBzipfs mount\fR $base $zip
# $base now has the contents of myApp.zip

source [file join $base app.tcl]
# use the contents, load libraries from it, etc...

\fBzipfs unmount\fR $zip
.CE
.PP
Creating a ZIP archive, given that a directory exists containing the content
to put in the archive. Note that the source directory is given twice, in order
to strip the exterior directory name from each filename in the archive.
.PP
.CS
set sourceDirectory [file normalize myApp]
set targetZip myApp.zip

\fBzipfs mkzip\fR $targetZip $sourceDirectory $sourceDirectory
.CE
.PP
Encryption can be applied to ZIP archives by providing a password when
building the ZIP and when mounting it.
.PP
.CS
set zip myApp.zip
set sourceDir [file normalize myApp]
set password "hunter2"
set base [file join [\fbzipfs root\fR] myApp]

# Create with password
\fBzipfs mkzip\fR $targetZip $sourceDir $sourceDir $password

# Mount with password
\fBzipfs mount\fR $base $zip $password
.CE
.PP
When creating an executable image with a password, the password is placed
within the executable in a shrouded form so that the application can read
files inside the embedded ZIP archive yet casual inspection cannot read it.
.PP
.CS
set appDir [file normalize myApp]
set img "myApp.bin"
set password "hunter2"

# Create some simple content to define a basic application
file mkdir $appDir
set f [open $appDir/main.tcl]
puts $f {
    puts "Hi. This is [info script]"
}
close $f

# Create the executable
\fBzipfs mkimg\fR $img $appDir $appDir $password

# Launch the executable, printing its output to stdout
exec $img >@stdout
#    prints: \fIHi. This is //zipfs:/app/main.tcl\fR
.CE
.SH "SEE ALSO"
tclsh(1), file(n), zipfs(3), zlib(n)
.SH "KEYWORDS"
compress, filesystem, zip
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to generic/regc_locale.c.

133
134
135
136
137
138
139
140
141


142
143
144
145
146
147
148
133
134
135
136
137
138
139


140
141
142
143
144
145
146
147
148







-
-
+
+







 * Unicode: alphabetic characters.
 */

static const crange alphaRangeTable[] = {
    {0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6},
    {0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374},
    {0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5},
    {0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587},
    {0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
    {0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x560, 0x588},
    {0x5d0, 0x5ea}, {0x5ef, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
    {0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea},
    {0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86a}, {0x8a0, 0x8b4},
    {0x8b6, 0x8bd}, {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980},
    {0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9},
    {0x9df, 0x9e1}, {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30},
    {0xa59, 0xa5c}, {0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91},
    {0xa93, 0xaa8}, {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c},
161
162
163
164
165
166
167
168

169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196

























197
198
199
200
201
202
203
204
205
206







207
208
209
210
211
212
213
214
215

216
217
218
219
220
221
222
223
224
225









226
227
228
229
230
231






232
233
234
235
236
237
238
161
162
163
164
165
166
167

168
169
170
171

























172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196










197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

212
213
214








215
216
217
218
219
220
221
222
223
224





225
226
227
228
229
230
231
232
233
234
235
236
237







-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+








-
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+







    {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288},
    {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be},
    {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315},
    {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd},
    {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea},
    {0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731},
    {0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3},
    {0x1820, 0x1877}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5},
    {0x1820, 0x1878}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5},
    {0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
    {0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33},
    {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23},
    {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1ce9, 0x1cec},
    {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d},
    {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d},
    {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc},
    {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4},
    {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113}, {0x2119, 0x211d},
    {0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f}, {0x2145, 0x2149},
    {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee},
    {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, {0x2da0, 0x2da6},
    {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
    {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x3031, 0x3035},
    {0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa}, {0x30fc, 0x30ff},
    {0x3105, 0x312e}, {0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff},
    {0x3400, 0x4db5}, {0x4e00, 0x9fea}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd},
    {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d},
    {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ae},
    {0xa7b0, 0xa7b7}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a},
    {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7},
    {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2},
    {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28},
    {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf},
    {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4},
    {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26},
    {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2},
    {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e},
    {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1c90, 0x1cba},
    {0x1cbd, 0x1cbf}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf},
    {0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d},
    {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc},
    {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb},
    {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c},
    {0x210a, 0x2113}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139},
    {0x213c, 0x213f}, {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e},
    {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67},
    {0x2d80, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6},
    {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6},
    {0x2dd8, 0x2dde}, {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f},
    {0x30a1, 0x30fa}, {0x30fc, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e},
    {0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef},
    {0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f},
    {0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f},
    {0xa722, 0xa788}, {0xa78b, 0xa7b9}, {0xa7f7, 0xa801}, {0xa803, 0xa805},
    {0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3},
    {0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c},
    {0xa984, 0xa9b2}, {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe},
    {0xaa00, 0xaa28}, {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76},
    {0xaa7e, 0xaaaf}, {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea},
    {0xaaf2, 0xaaf4}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
    {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65},
    {0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
    {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e},
    {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e},
    {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e},
    {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d},
    {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28},
    {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d},
    {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74},
    {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe},
    {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
#if TCL_UTF_MAX > 4
    {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
    {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
    {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
    {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
    {0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
    {0xffda, 0xffdc}
#if CHRBITS > 16
    ,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
    {0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
    {0x10300, 0x1031f}, {0x1032d, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
    {0x10380, 0x1039d}, {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d},
    {0x104b0, 0x104d3}, {0x104d8, 0x104fb}, {0x10500, 0x10527}, {0x10530, 0x10563},
    {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
    {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e},
    {0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7},
    {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a60, 0x10a7c},
    {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a60, 0x10a7c},
    {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35},
    {0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48},
    {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x11003, 0x11037}, {0x11083, 0x110af},
    {0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2},
    {0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286},
    {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de},
    {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
    {0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af},
    {0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
    {0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
    {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10d00, 0x10d23}, {0x10f00, 0x10f1c},
    {0x10f30, 0x10f45}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8},
    {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4},
    {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
    {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de}, {0x11305, 0x1130c},
    {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361},
    {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af}, {0x11580, 0x115ae},
    {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa}, {0x11700, 0x1171a},
    {0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
    {0x11a86, 0x11a89}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e},
    {0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x12000, 0x12399},
    {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
    {0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43},
    {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
    {0x17000, 0x187ec}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
    {0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x11d60, 0x11d65},
    {0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2}, {0x12000, 0x12399}, {0x12480, 0x12543},
    {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
    {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43}, {0x16b63, 0x16b77},
    {0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
    {0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
    {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
    {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
    {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
    {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
    {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da},
    {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e},
    {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2},
260
261
262
263
264
265
266
267
268
269




270
271
272
273
274
275
276







277
278
279
280
281
282
283
284
285
286
287
288
289
290
291

292
293
294
295
296
297
298
299
300
301
302


303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328






329
330
331
332
333
334
335
259
260
261
262
263
264
265



266
267
268
269
270






271
272
273
274
275
276
277

278
279
280
281
282
283
284
285
286
287
288
289
290

291
292
293
294
295
296
297
298
299
300


301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322






323
324
325
326
327
328
329
330
331
332
333
334
335







-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
-













-
+









-
-
+
+




















-
-
-
-
-
-
+
+
+
+
+
+







    0xcf2, 0xd3d, 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84,
    0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2,
    0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e,
    0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae,
    0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f,
    0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184,
    0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b,
    0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5,
    0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
#if TCL_UTF_MAX > 4
    0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa8fe, 0xa9cf, 0xaa7a, 0xaab1,
    0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43,
    0xfb44
#if CHRBITS > 16
    ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
    0x109bf, 0x10a00, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, 0x11310, 0x11332,
    0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x11a00,
    0x11a3a, 0x11a50, 0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x16f50, 0x16fe0, 0x16fe1,
    0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22,
    0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51,
    0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62,
    0x109bf, 0x10a00, 0x10f27, 0x11144, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f,
    0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644,
    0x118ff, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d, 0x11c40, 0x11d08, 0x11d09, 0x11d46,
    0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2,
    0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39,
    0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57,
    0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
    0x1ee64, 0x1ee7e
#endif
};

#define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr))

/*
 * Unicode: control characters.
 */

static const crange controlRangeTable[] = {
    {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f},
    {0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff},
    {0xfff9, 0xfffb}
#if TCL_UTF_MAX > 4
#if CHRBITS > 16
    ,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd},
    {0x100000, 0x10fffd}
#endif
};

#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))

static const chr controlCharTable[] = {
    0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff
#if TCL_UTF_MAX > 4
    ,0x110bd, 0xe0001
#if CHRBITS > 16
    ,0x110bd, 0x110cd, 0xe0001
#endif
};

#define NUM_CONTROL_CHAR (sizeof(controlCharTable)/sizeof(chr))

/*
 * Unicode: decimal digit characters.
 */

static const crange digitRangeTable[] = {
    {0x30, 0x39}, {0x660, 0x669}, {0x6f0, 0x6f9}, {0x7c0, 0x7c9},
    {0x966, 0x96f}, {0x9e6, 0x9ef}, {0xa66, 0xa6f}, {0xae6, 0xaef},
    {0xb66, 0xb6f}, {0xbe6, 0xbef}, {0xc66, 0xc6f}, {0xce6, 0xcef},
    {0xd66, 0xd6f}, {0xde6, 0xdef}, {0xe50, 0xe59}, {0xed0, 0xed9},
    {0xf20, 0xf29}, {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9},
    {0x1810, 0x1819}, {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89},
    {0x1a90, 0x1a99}, {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49},
    {0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909},
    {0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
    {0xff10, 0xff19}
#if TCL_UTF_MAX > 4
    ,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
    {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459}, {0x114d0, 0x114d9},
    {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9},
    {0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59},
    {0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}
#if CHRBITS > 16
    ,{0x104a0, 0x104a9}, {0x10d30, 0x10d39}, {0x11066, 0x1106f}, {0x110f0, 0x110f9},
    {0x11136, 0x1113f}, {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459},
    {0x114d0, 0x114d9}, {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739},
    {0x118e0, 0x118e9}, {0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x11da0, 0x11da9},
    {0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}
#endif
};

#define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange))

/*
 * no singletons of digit characters.
344
345
346
347
348
349
350
351

352
353
354
355
356
357

358
359
360
361
362
363






364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382










383
384
385



386
387
388
389
390
391
392
344
345
346
347
348
349
350

351
352
353
354
355
356

357
358





359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374









375
376
377
378
379
380
381
382
383
384
385


386
387
388
389
390
391
392
393
394
395







-
+





-
+

-
-
-
-
-
+
+
+
+
+
+










-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
+
+
+







    {0x55a, 0x55f}, {0x66a, 0x66d}, {0x700, 0x70d}, {0x7f7, 0x7f9},
    {0x830, 0x83e}, {0xf04, 0xf12}, {0xf3a, 0xf3d}, {0xfd0, 0xfd4},
    {0x104a, 0x104f}, {0x1360, 0x1368}, {0x16eb, 0x16ed}, {0x17d4, 0x17d6},
    {0x17d8, 0x17da}, {0x1800, 0x180a}, {0x1aa0, 0x1aa6}, {0x1aa8, 0x1aad},
    {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
    {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
    {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998},
    {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e49},
    {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e4e},
    {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
    {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
    {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
    {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
    {0xff5f, 0xff65}
#if TCL_UTF_MAX > 4
#if CHRBITS > 16
    ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
    {0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143},
    {0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x1144b, 0x1144f},
    {0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c}, {0x1173c, 0x1173e},
    {0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2}, {0x11c41, 0x11c45},
    {0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x1da87, 0x1da8b}
    {0x10b99, 0x10b9c}, {0x10f55, 0x10f59}, {0x11047, 0x1104d}, {0x110be, 0x110c1},
    {0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x111dd, 0x111df}, {0x11238, 0x1123d},
    {0x1144b, 0x1144f}, {0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c},
    {0x1173c, 0x1173e}, {0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2},
    {0x11c41, 0x11c45}, {0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x16e97, 0x16e9a},
    {0x1da87, 0x1da8b}
#endif
};

#define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange))

static const chr punctCharTable[] = {
    0x3a, 0x3b, 0x3f, 0x40, 0x5f, 0x7b, 0x7d, 0xa1, 0xa7,
    0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
    0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
    0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970,
    0x9fd, 0xaf0, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14, 0xf85, 0xfd9,
    0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c, 0x1735, 0x1736,
    0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e,
    0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe,
    0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673,
    0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df,
    0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68,
    0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
#if TCL_UTF_MAX > 4
    0x9fd, 0xa76, 0xaf0, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14,
    0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c,
    0x1735, 0x1736, 0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3,
    0x207d, 0x207e, 0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc,
    0x29fd, 0x2cfe, 0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe,
    0xa4ff, 0xa673, 0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f,
    0xa9de, 0xa9df, 0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f,
    0xfe63, 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f,
    0xff5b, 0xff5d
#if CHRBITS > 16
    ,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
    0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x11c70,
    0x11c71, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f, 0x1e95e, 0x1e95f
    0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x1183b,
    0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f,
    0x1e95e, 0x1e95f
#endif
};

#define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr))

/*
 * Unicode: white space characters.
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426











427
428
429
430
431
432
433
434







435
436
437
438
439
440
441
412
413
414
415
416
417
418











419
420
421
422
423
424
425
426
427
428
429
430







431
432
433
434
435
436
437
438
439
440
441
442
443
444







-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+







 * Unicode: lowercase characters.
 */

static const crange lowerRangeTable[] = {
    {0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180},
    {0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
    {0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
    {0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x13f8, 0x13fd},
    {0x1c80, 0x1c88}, {0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a},
    {0x1e95, 0x1e9d}, {0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27},
    {0x1f30, 0x1f37}, {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67},
    {0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7},
    {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7},
    {0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b},
    {0x2d00, 0x2d25}, {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795},
    {0xab30, 0xab5a}, {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06},
    {0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if TCL_UTF_MAX > 4
    {0x3ef, 0x3f3}, {0x430, 0x45f}, {0x560, 0x588}, {0x10d0, 0x10fa},
    {0x10fd, 0x10ff}, {0x13f8, 0x13fd}, {0x1c80, 0x1c88}, {0x1d00, 0x1d2b},
    {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
    {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
    {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
    {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
    {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
    {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
    {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab65},
    {0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if CHRBITS > 16
    ,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df},
    {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b},
    {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503},
    {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3},
    {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5},
    {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b},
    {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f},
    {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
    {0x16e60, 0x16e7f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
    {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
    {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
    {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
    {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714},
    {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788},
    {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
#endif
};

#define NUM_LOWER_RANGE (sizeof(lowerRangeTable)/sizeof(crange))

static const chr lowerCharTable[] = {
    0xb5, 0x101, 0x103, 0x105, 0x107, 0x109, 0x10b, 0x10d, 0x10f,
497
498
499
500
501
502
503
504
505


506
507
508
509
510
511
512
513
514
515
516
517
518
519
520

521
522
523
524
525
526
527







528
529
530
531
532
533
534







535
536
537
538
539
540
541
500
501
502
503
504
505
506


507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524







525
526
527
528
529
530
531
532






533
534
535
536
537
538
539
540
541
542
543
544
545
546







-
-
+
+















+
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+







    0xa691, 0xa693, 0xa695, 0xa697, 0xa699, 0xa69b, 0xa723, 0xa725, 0xa727,
    0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737, 0xa739, 0xa73b, 0xa73d,
    0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, 0xa74b, 0xa74d, 0xa74f,
    0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, 0xa75d, 0xa75f, 0xa761,
    0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
    0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
    0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
    0xa7b5, 0xa7b7, 0xa7fa
#if TCL_UTF_MAX > 4
    0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7fa
#if CHRBITS > 16
    ,0x1d4bb, 0x1d7cb
#endif
};

#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr))

/*
 * Unicode: uppercase characters.
 */

static const crange upperRangeTable[] = {
    {0x41, 0x5a}, {0xc0, 0xd6}, {0xd8, 0xde}, {0x189, 0x18b},
    {0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8},
    {0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab},
    {0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
    {0x13a0, 0x13f5}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, {0x1f08, 0x1f0f},
    {0x13a0, 0x13f5}, {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f},
    {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb},
    {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb},
    {0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d},
    {0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70},
    {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if TCL_UTF_MAX > 4
    {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d},
    {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb},
    {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112},
    {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e},
    {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae},
    {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if CHRBITS > 16
    ,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf},
    {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac},
    {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
    {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
    {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621},
    {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa},
    {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}, {0x1e900, 0x1e921}
    {0x16e40, 0x16e5f}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
    {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
    {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
    {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
    {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
    {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8},
    {0x1e900, 0x1e921}
#endif
};

#define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange))

static const chr upperCharTable[] = {
    0x100, 0x102, 0x104, 0x106, 0x108, 0x10a, 0x10c, 0x10e, 0x110,
596
597
598
599
600
601
602
603
604



605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637



















638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671

































672
673
674

675
676

677
678
679
680
681
682
683
684
685
686









687
688
689
690
691
692
693
694
695
696
697







698
699
700
701
702
703
704
705
706
707
708
709


710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727


















728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755


























756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773












774
775
776
777
778
779
780
781







782
783
784
785
786
787
788
601
602
603
604
605
606
607


608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624



















625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643


































644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678

679
680

681
682









683
684
685
686
687
688
689
690
691











692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708


709
710
711
712
















713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
























735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766












767
768
769
770
771
772
773
774
775
776
777
778
779
780






781
782
783
784
785
786
787
788
789
790
791
792
793
794







-
-
+
+
+














-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+










-
-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
+
+
+
+
+
+
+







    0xa686, 0xa688, 0xa68a, 0xa68c, 0xa68e, 0xa690, 0xa692, 0xa694, 0xa696,
    0xa698, 0xa69a, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a, 0xa72c, 0xa72e,
    0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e, 0xa740, 0xa742,
    0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, 0xa752, 0xa754,
    0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
    0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
    0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
    0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6
#if TCL_UTF_MAX > 4
    0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6,
    0xa7b8
#if CHRBITS > 16
    ,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
    0x1d539, 0x1d546, 0x1d7ca
#endif
};

#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr))

/*
 * Unicode: unicode print characters excluding space.
 */

static const crange graphRangeTable[] = {
    {0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37f},
    {0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x52f}, {0x531, 0x556},
    {0x559, 0x55f}, {0x561, 0x587}, {0x58d, 0x58f}, {0x591, 0x5c7},
    {0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc},
    {0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa},
    {0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a},
    {0x8a0, 0x8b4}, {0x8b6, 0x8bd}, {0x8d4, 0x8e1}, {0x8e3, 0x983},
    {0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9},
    {0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fd},
    {0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30},
    {0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75},
    {0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8},
    {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9},
    {0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff},
    {0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
    {0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63},
    {0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95},
    {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8},
    {0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c},
    {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44},
    {0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc58, 0xc5a}, {0xc60, 0xc63},
    {0x559, 0x58a}, {0x58d, 0x58f}, {0x591, 0x5c7}, {0x5d0, 0x5ea},
    {0x5ef, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d},
    {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x7fd, 0x82d},
    {0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a}, {0x8a0, 0x8b4},
    {0x8b6, 0x8bd}, {0x8d3, 0x8e1}, {0x8e3, 0x983}, {0x985, 0x98c},
    {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
    {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fe}, {0xa01, 0xa03},
    {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
    {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa76}, {0xa81, 0xa83},
    {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
    {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd},
    {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff}, {0xb01, 0xb03},
    {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39},
    {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77},
    {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
    {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd},
    {0xbe6, 0xbfa}, {0xc00, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
    {0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d},
    {0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc8c},
    {0xc66, 0xc6f}, {0xc78, 0xc83}, {0xc85, 0xc8c}, {0xc8e, 0xc90},
    {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xcbc, 0xcc4},
    {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3}, {0xce6, 0xcef},
    {0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd44},
    {0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63}, {0xd66, 0xd7f},
    {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6},
    {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef}, {0xdf2, 0xdf4},
    {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f},
    {0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd}, {0xec0, 0xec4},
    {0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47},
    {0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc},
    {0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d},
    {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d},
    {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5},
    {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a},
    {0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd},
    {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c},
    {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c},
    {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9},
    {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1877}, {0x1880, 0x18aa},
    {0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b},
    {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9},
    {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c},
    {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe},
    {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37},
    {0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf9},
    {0x1d00, 0x1df9}, {0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
    {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
    {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
    {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
    {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bf}, {0x20d0, 0x20f0},
    {0x2100, 0x218b}, {0x2190, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
    {0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd2},
    {0x2bec, 0x2bef}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
    {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
    {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3},
    {0xce6, 0xcef}, {0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
    {0xd12, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63},
    {0xd66, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
    {0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef},
    {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97},
    {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd},
    {0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf},
    {0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc},
    {0xfbe, 0xfcc}, {0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248},
    {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288},
    {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be},
    {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315},
    {0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5},
    {0x13f8, 0x13fd}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8},
    {0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753},
    {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9},
    {0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1878},
    {0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b},
    {0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
    {0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e},
    {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad},
    {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3},
    {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1c90, 0x1cba},
    {0x1cbd, 0x1cc7}, {0x1cd0, 0x1cf9}, {0x1d00, 0x1df9}, {0x1dfb, 0x1f15},
    {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
    {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3},
    {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe},
    {0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e}, {0x2090, 0x209c},
    {0x20a0, 0x20bf}, {0x20d0, 0x20f0}, {0x2100, 0x218b}, {0x2190, 0x2426},
    {0x2440, 0x244a}, {0x2460, 0x2b73}, {0x2b76, 0x2b95}, {0x2b98, 0x2bc8},
    {0x2bca, 0x2bfe}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
    {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
    {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
    {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e49},
    {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e4e},
    {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
    {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312e},
    {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312f},
    {0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
    {0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fea}, {0xa000, 0xa48c},
    {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ae},
    {0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
    {0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
    {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe},
    {0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2},
    {0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
    {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab65}, {0xab70, 0xabed},
    {0xabf0, 0xabf9}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
    {0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c},
    {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7b9},
    {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c5},
    {0xa8ce, 0xa8d9}, {0xa8e0, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd},
    {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d},
    {0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06},
    {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
    {0xab30, 0xab65}, {0xab70, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3},
    {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
    {0xdc00, 0xdc3e}, {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe},
    {0xdd00, 0xdd3e}, {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe},
    {0xde00, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe},
    {0xdf00, 0xdf3e}, {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe},
    {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
    {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f},
    {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19},
    {0xfe20, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
    {0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
    {0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if TCL_UTF_MAX > 4
    {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c},
    {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7},
    {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe52}, {0xfe54, 0xfe66},
    {0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe},
    {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc},
    {0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if CHRBITS > 16
    ,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
    {0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
    {0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
    {0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x1032d, 0x1034a},
    {0x10350, 0x1037a}, {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5},
    {0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x104b0, 0x104d3}, {0x104d8, 0x104fb},
    {0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755},
    {0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
    {0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b},
    {0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03},
    {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a38, 0x10a3a},
    {0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
    {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a38, 0x10a3a},
    {0x10a3f, 0x10a48}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
    {0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72},
    {0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48},
    {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e},
    {0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1},
    {0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11143},
    {0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4},
    {0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
    {0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9},
    {0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330},
    {0x11335, 0x11339}, {0x1133c, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363},
    {0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7},
    {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644},
    {0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9},
    {0x11700, 0x11719}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x118a0, 0x118f2},
    {0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11a9c}, {0x11a9e, 0x11aa2},
    {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45},
    {0x11c50, 0x11c6c}, {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6},
    {0x11d00, 0x11d06}, {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59},
    {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10d27}, {0x10d30, 0x10d39},
    {0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x11000, 0x1104d},
    {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8},
    {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146}, {0x11150, 0x11176},
    {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4}, {0x11200, 0x11211},
    {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d},
    {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, {0x11300, 0x11303},
    {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
    {0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363}, {0x11366, 0x1136c},
    {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7}, {0x114d0, 0x114d9},
    {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644}, {0x11650, 0x11659},
    {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x11700, 0x1171a},
    {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x11800, 0x1183b}, {0x118a0, 0x118f2},
    {0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11aa2}, {0x11ac0, 0x11af8},
    {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45}, {0x11c50, 0x11c6c},
    {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6}, {0x11d00, 0x11d06},
    {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59}, {0x11d60, 0x11d65},
    {0x11d6a, 0x11d8e}, {0x11d93, 0x11d98}, {0x11da0, 0x11da9}, {0x11ee0, 0x11ef8},
    {0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, {0x12480, 0x12543},
    {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
    {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45},
    {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f},
    {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x17000, 0x187ec},
    {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb}, {0x1bc00, 0x1bc6a},
    {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f},
    {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172}, {0x1d17b, 0x1d1e8},
    {0x1d200, 0x1d245}, {0x1d300, 0x1d356}, {0x1d360, 0x1d371}, {0x1d400, 0x1d454},
    {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3},
    {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c},
    {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
    {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f},
    {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006}, {0x1e008, 0x1e018}, {0x1e01b, 0x1e021},
    {0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a},
    {0x1e950, 0x1e959}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
    {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
    {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
    {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
    {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf},
    {0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b},
    {0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248},
    {0x1f260, 0x1f265}, {0x1f300, 0x1f6d4}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f8},
    {0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
    {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b},
    {0x1f910, 0x1f93e}, {0x1f940, 0x1f94c}, {0x1f950, 0x1f96b}, {0x1f980, 0x1f997},
    {0x1f9d0, 0x1f9e6}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
    {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
    {0x16e40, 0x16e9a}, {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f},
    {0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
    {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
    {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
    {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d2e0, 0x1d2f3}, {0x1d300, 0x1d356},
    {0x1d360, 0x1d378}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
    {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
    {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
    {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
    {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006},
    {0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4},
    {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4},
    {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
    {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
    {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
    {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093},
    {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5},
    {0x1f100, 0x1f10c}, {0x1f110, 0x1f16b}, {0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202},
    {0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265}, {0x1f300, 0x1f6d4},
    {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f9}, {0x1f700, 0x1f773}, {0x1f780, 0x1f7d8},
    {0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, {0x1f850, 0x1f859}, {0x1f860, 0x1f887},
    {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b}, {0x1f910, 0x1f93e}, {0x1f940, 0x1f970},
    {0x1f973, 0x1f976}, {0x1f97c, 0x1f9a2}, {0x1f9b0, 0x1f9b9}, {0x1f9c0, 0x1f9c2},
    {0x1f9d0, 0x1f9ff}, {0x1fa60, 0x1fa6d}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734},
    {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d},
    {0xe0100, 0xe01ef}
#endif
};

#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))

static const chr graphCharTable[] = {
    0x38c, 0x589, 0x58a, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8,
    0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
    0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3,
    0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57,
    0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f,
    0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde,
    0xcf1, 0xcf2, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82,
    0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
    0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
    0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e,
    0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
#if TCL_UTF_MAX > 4
    0x38c, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8, 0x9d7, 0x9dc,
    0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39,
    0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3, 0xad0, 0xb0f,
    0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, 0xb5c, 0xb5d,
    0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4,
    0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2,
    0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, 0xe84, 0xe87,
    0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xec6, 0x10c7,
    0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59, 0x1f5b, 0x1f5d,
    0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41,
    0xfb43, 0xfb44, 0xfffc, 0xfffd
#if CHRBITS > 16
    ,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
    0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
    0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x118ff, 0x11d08, 0x11d09,
    0x11d3a, 0x11d3c, 0x11d3d, 0x16a6e, 0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f,
    0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f,
    0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49,
    0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f,
    0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f9c0
    0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x1145e, 0x118ff, 0x11d08,
    0x11d09, 0x11d3a, 0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e,
    0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb,
    0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27,
    0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54,
    0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e,
    0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f97a
#endif
};

#define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr))

/*
 *	End of auto-generated Unicode character ranges declarations.

Changes to generic/regcustom.h.

87
88
89
90
91
92
93
94

95
96
97
98
99
100
101
87
88
89
90
91
92
93

94
95
96
97
98
99
100
101







-
+







typedef int celt;		/* Type to hold chr, or NOCELT */
#define	NOCELT (-1)		/* Celt value which is not valid chr */
#define	CHR(c) (UCHAR(c))	/* Turn char literal into chr literal */
#define	DIGITVAL(c) ((c)-'0')	/* Turn chr digit into its value */
#if TCL_UTF_MAX > 4
#define	CHRBITS	32		/* Bits in a chr; must not use sizeof */
#define	CHR_MIN	0x00000000	/* Smallest and largest chr; the value */
#define	CHR_MAX	0xffffffff	/* CHR_MAX-CHR_MIN+1 should fit in uchr */
#define	CHR_MAX	0x10ffff	/* CHR_MAX-CHR_MIN+1 should fit in uchr */
#else
#define	CHRBITS	16		/* Bits in a chr; must not use sizeof */
#define	CHR_MIN	0x0000		/* Smallest and largest chr; the value */
#define	CHR_MAX	0xffff		/* CHR_MAX-CHR_MIN+1 should fit in uchr */
#endif

/*

Changes to generic/tcl.decls.

28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42







-
+







# to preserve backwards compatibility.

declare 0 {
    int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name,
	    const char *version, const void *clientData)
}
declare 1 {
    CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
    const char *Tcl_PkgRequireEx(Tcl_Interp *interp,
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
}
declare 2 {
    TCL_NORETURN void Tcl_Panic(const char *format, ...)
}
declare 3 {
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
128
129
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
128
129







-
+














-
+







}
declare 20 {
    void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, int line)
}
declare 21 {
    int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
declare 22 {
declare 22 {deprecated {No longer in use, changed to macro}} {
    Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
}
declare 23 {
    Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length,
	    const char *file, int line)
}
declare 24 {
    Tcl_Obj *Tcl_DbNewDoubleObj(double doubleValue, const char *file,
	    int line)
}
declare 25 {
    Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
	    const char *file, int line)
}
declare 26 {
declare 26 {deprecated {No longer in use, changed to macro}} {
    Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
}
declare 27 {
    Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
}
declare 28 {
    Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, int length,
148
149
150
151
152
153
154
155

156
157

158
159
160
161
162
163
164
148
149
150
151
152
153
154

155
156

157
158
159
160
161
162
163
164







-
+

-
+







declare 34 {
    int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
declare 35 {
    int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    double *doublePtr)
}
declare 36 {
declare 36 {deprecated {No longer in use, changed to macro}} {
    int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr)
	    const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
}
declare 37 {
    int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
}
declare 38 {
    int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr)
}
194
195
196
197
198
199
200
201

202
203
204
205
206
207
208
209
210

211
212
213
214
215
216

217
218
219
220
221
222
223
224
225

226
227
228
229
230
231
232
233
234
235
236
237
238

239
240
241
242
243
244

245
246
247
248
249
250
251
252
253

254
255
256

257
258
259
260
261
262
263
194
195
196
197
198
199
200

201
202
203
204
205
206
207
208
209

210
211
212
213
214
215

216
217
218
219
220
221
222
223
224

225
226
227
228
229
230
231
232
233
234
235
236
237

238
239
240
241
242
243

244
245
246
247
248
249
250
251
252

253
254
255

256
257
258
259
260
261
262
263







-
+








-
+





-
+








-
+












-
+





-
+








-
+


-
+







    int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    int *lengthPtr)
}
declare 48 {
    int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
	    int count, int objc, Tcl_Obj *const objv[])
}
declare 49 {
declare 49 {deprecated {No longer in use, changed to macro}} {
    Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
}
declare 50 {
    Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
}
declare 51 {
    Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
declare 52 {
declare 52 {deprecated {No longer in use, changed to macro}} {
    Tcl_Obj *Tcl_NewIntObj(int intValue)
}
declare 53 {
    Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}
declare 54 {
declare 54 {deprecated {No longer in use, changed to macro}} {
    Tcl_Obj *Tcl_NewLongObj(long longValue)
}
declare 55 {
    Tcl_Obj *Tcl_NewObj(void)
}
declare 56 {
    Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
declare 57 {
declare 57 {deprecated {No longer in use, changed to macro}} {
    void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
}
declare 58 {
    unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
}
declare 59 {
    void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes,
	    int length)
}
declare 60 {
    void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
declare 61 {
declare 61 {deprecated {No longer in use, changed to macro}} {
    void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
}
declare 62 {
    void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}
declare 63 {
declare 63 {deprecated {No longer in use, changed to macro}} {
    void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
}
declare 64 {
    void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
}
declare 65 {
    void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
declare 66 {
declare 66 {deprecated {No longer in use, changed to macro}} {
    void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
}
declare 67 {
declare 67 {deprecated {No longer in use, changed to macro}} {
    void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
	    int length)
}
declare 68 {
    void Tcl_AllowExceptions(Tcl_Interp *interp)
}
declare 69 {
281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309

310
311
312
313
314
315
316
317
318
319
320
321

322
323
324
325
326
327
328
281
282
283
284
285
286
287

288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308

309
310
311
312
313
314
315
316
317
318
319
320

321
322
323
324
325
326
327
328







-
+




















-
+











-
+







}
declare 75 {
    int Tcl_AsyncReady(void)
}
declare 76 {
    void Tcl_BackgroundError(Tcl_Interp *interp)
}
declare 77 {
declare 77 {deprecated {Use Tcl_UtfBackslash}} {
    char Tcl_Backslash(const char *src, int *readPtr)
}
declare 78 {
    int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
	    const char *optionList)
}
declare 79 {
    void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
	    ClientData clientData)
}
declare 80 {
    void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData)
}
declare 81 {
    int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 82 {
    int Tcl_CommandComplete(const char *cmd)
}
declare 83 {
    char *Tcl_Concat(int argc, CONST84 char *const *argv)
    char *Tcl_Concat(int argc, const char *const *argv)
}
declare 84 {
    int Tcl_ConvertElement(const char *src, char *dst, int flags)
}
declare 85 {
    int Tcl_ConvertCountedElement(const char *src, int length, char *dst,
	    int flags)
}
declare 86 {
    int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
	    Tcl_Interp *target, const char *targetCmd, int argc,
	    CONST84 char *const *argv)
	    const char *const *argv)
}
declare 87 {
    int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
	    Tcl_Interp *target, const char *targetCmd, int objc,
	    Tcl_Obj *const objv[])
}
declare 88 {
348
349
350
351
352
353
354
355

356
357
358
359
360
361
362
348
349
350
351
352
353
354

355
356
357
358
359
360
361
362







-
+







}
declare 93 {
    void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 94 {
    Tcl_Interp *Tcl_CreateInterp(void)
}
declare 95 {
declare 95 {deprecated {}} {
    void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
	    int numArgs, Tcl_ValueType *argTypes,
	    Tcl_MathProc *proc, ClientData clientData)
}
declare 96 {
    Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
	    const char *cmdName,
457
458
459
460
461
462
463
464

465
466
467

468
469
470
471
472
473
474
475
476

477
478
479
480
481
482
483
457
458
459
460
461
462
463

464
465
466

467
468
469
470
471

472
473
474

475
476
477
478
479
480
481
482







-
+


-
+




-



-
+







declare 125 {
    void Tcl_DStringStartSublist(Tcl_DString *dsPtr)
}
declare 126 {
    int Tcl_Eof(Tcl_Channel chan)
}
declare 127 {
    CONST84_RETURN char *Tcl_ErrnoId(void)
    const char *Tcl_ErrnoId(void)
}
declare 128 {
    CONST84_RETURN char *Tcl_ErrnoMsg(int err)
    const char *Tcl_ErrnoMsg(int err)
}
declare 129 {
    int Tcl_Eval(Tcl_Interp *interp, const char *script)
}
# This is obsolete, use Tcl_FSEvalFile
declare 130 {
    int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
declare 131 {
declare 131 {deprecated {No longer in use, changed to macro}} {
    int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 132 {
    void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
declare 133 {
    TCL_NORETURN void Tcl_Exit(int status)
525
526
527
528
529
530
531
532
533


534
535
536
537

538
539
540
541
542
543
544
524
525
526
527
528
529
530


531
532
533
534
535

536
537
538
539
540
541
542
543







-
-
+
+



-
+







    int Tcl_Flush(Tcl_Channel chan)
}
declare 147 {
    void Tcl_FreeResult(Tcl_Interp *interp)
}
declare 148 {
    int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
	    Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
	    int *argcPtr, CONST84 char ***argvPtr)
	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
	    int *argcPtr, const char ***argvPtr)
}
declare 149 {
    int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
	    Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
	    int *objcPtr, Tcl_Obj ***objv)
}
declare 150 {
    ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name,
	    Tcl_InterpDeleteProc **procPtr)
}
declare 151 {
555
556
557
558
559
560
561
562

563
564
565
566
567
568
569
570
571
572
573
574
575
576

577
578
579
580
581
582
583

584
585
586
587
588
589
590
554
555
556
557
558
559
560

561
562
563
564
565
566
567
568
569
570
571
572
573
574

575
576
577
578
579
580
581

582
583
584
585
586
587
588
589







-
+













-
+






-
+







declare 154 {
    ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan)
}
declare 155 {
    int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 {
    CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan)
    const char *Tcl_GetChannelName(Tcl_Channel chan)
}
declare 157 {
    int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
	    const char *optionName, Tcl_DString *dsPtr)
}
declare 158 {
    CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
}
declare 159 {
    int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
	    Tcl_CmdInfo *infoPtr)
}
declare 160 {
    CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp,
    const char *Tcl_GetCommandName(Tcl_Interp *interp,
	    Tcl_Command command)
}
declare 161 {
    int Tcl_GetErrno(void)
}
declare 162 {
    CONST84_RETURN char *Tcl_GetHostName(void)
    const char *Tcl_GetHostName(void)
}
declare 163 {
    int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
}
declare 164 {
    Tcl_Interp *Tcl_GetMaster(Tcl_Interp *interp)
}
619
620
621
622
623
624
625
626

627
628
629


630
631
632
633

634
635
636
637
638
639

640
641
642
643
644
645
646
618
619
620
621
622
623
624

625
626


627
628
629
630
631

632
633
634
635
636
637

638
639
640
641
642
643
644
645







-
+

-
-
+
+



-
+





-
+







declare 172 {
    Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
}
declare 173 {
    Tcl_Channel Tcl_GetStdChannel(int type)
}
declare 174 {
    CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp)
    const char *Tcl_GetStringResult(Tcl_Interp *interp)
}
declare 175 {
    CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
declare 175 {deprecated {No longer in use, changed to macro}} {
    const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
	    int flags)
}
declare 176 {
    CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
    const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags)
}
declare 177 {
    int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
}
declare 178 {
declare 178 {deprecated {No longer in use, changed to macro}} {
    int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 179 {
    int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName,
	    const char *hiddenCmdToken)
}
declare 180 {
659
660
661
662
663
664
665
666

667
668
669
670
671
672
673
658
659
660
661
662
663
664

665
666
667
668
669
670
671
672







-
+







    int Tcl_InterpDeleted(Tcl_Interp *interp)
}
declare 185 {
    int Tcl_IsSafe(Tcl_Interp *interp)
}
# Obsolete, use Tcl_FSJoinPath
declare 186 {
    char *Tcl_JoinPath(int argc, CONST84 char *const *argv,
    char *Tcl_JoinPath(int argc, const char *const *argv,
	    Tcl_DString *resultPtr)
}
declare 187 {
    int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr,
	    int type)
}

682
683
684
685
686
687
688
689

690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707

708
709
710
711
712
713
714
681
682
683
684
685
686
687

688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705

706
707
708
709
710
711
712
713







-
+

















-
+







declare 190 {
    int Tcl_MakeSafe(Tcl_Interp *interp)
}
declare 191 {
    Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
declare 192 {
    char *Tcl_Merge(int argc, CONST84 char *const *argv)
    char *Tcl_Merge(int argc, const char *const *argv)
}
declare 193 {
    Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
}
declare 194 {
    void Tcl_NotifyChannel(Tcl_Channel channel, int mask)
}
declare 195 {
    Tcl_Obj *Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
	    Tcl_Obj *part2Ptr, int flags)
}
declare 196 {
    Tcl_Obj *Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
	    Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags)
}
declare 197 {
    Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
	    CONST84 char **argv, int flags)
	    const char **argv, int flags)
}
# This is obsolete, use Tcl_FSOpenFileChannel
declare 198 {
    Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName,
	    const char *modeString, int permissions)
}
declare 199 {
726
727
728
729
730
731
732
733

734
735
736
737
738
739
740
725
726
727
728
729
730
731

732
733
734
735
736
737
738
739







-
+







declare 202 {
    void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst)
}
declare 203 {
    int Tcl_PutEnv(const char *assignment)
}
declare 204 {
    CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp)
    const char *Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 {
    void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
}
declare 206 {
    int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead)
}
762
763
764
765
766
767
768
769

770
771
772
773
774
775
776
777
778
779
780
781
782
783
784

785
786
787
788
789
790
791
761
762
763
764
765
766
767

768
769
770
771
772
773
774
775
776
777
778
779
780
781


782
783
784
785
786
787
788
789







-
+













-
-
+







}
declare 214 {
    int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
	    const char *pattern)
}
declare 215 {
    void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
	    CONST84 char **startPtr, CONST84 char **endPtr)
	    const char **startPtr, const char **endPtr)
}
declare 216 {
    void Tcl_Release(ClientData clientData)
}
declare 217 {
    void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 {
    int Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 {
    int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Obsolete
declare 220 {
declare 220 {deprecated {}} {
    int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
}
declare 221 {
    int Tcl_ServiceAll(void)
}
declare 222 {
    int Tcl_ServiceEvent(int flags)
832
833
834
835
836
837
838
839
840


841
842
843
844

845
846
847
848

849
850
851

852
853
854
855
856
857
858

859
860
861
862

863
864
865
866
867
868
869
870
871
872

873
874
875

876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896

897
898
899
900
901
902
903

904
905
906
907
908
909
910
911
912
913
914
915

916
917
918
919
920
921
922
923
924
925
926

927
928
929
930
931
932
933
830
831
832
833
834
835
836


837
838
839
840
841

842
843
844
845

846
847
848

849
850
851
852
853
854
855

856
857
858
859

860
861
862
863
864
865
866
867
868


869
870
871

872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892

893
894
895
896
897
898
899

900
901
902
903
904
905
906
907
908
909
910
911

912
913
914
915
916
917
918
919
920
921
922

923
924
925
926
927
928
929
930







-
-
+
+



-
+



-
+


-
+






-
+



-
+








-
-
+


-
+




















-
+






-
+











-
+










-
+







}
declare 235 {
    void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr)
}
declare 236 {
    void Tcl_SetStdChannel(Tcl_Channel channel, int type)
}
declare 237 {
    CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
declare 237 {deprecated {No longer in use, changed to macro}} {
    const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
	    const char *newValue, int flags)
}
declare 238 {
    CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
    const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, const char *newValue, int flags)
}
declare 239 {
    CONST84_RETURN char *Tcl_SignalId(int sig)
    const char *Tcl_SignalId(int sig)
}
declare 240 {
    CONST84_RETURN char *Tcl_SignalMsg(int sig)
    const char *Tcl_SignalMsg(int sig)
}
declare 241 {
    void Tcl_SourceRCFile(Tcl_Interp *interp)
}
declare 242 {
    int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
	    CONST84 char ***argvPtr)
	    const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
    void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr)
    void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}
declare 244 {
    void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
declare 245 {
    int Tcl_StringMatch(const char *str, const char *pattern)
}
# Obsolete
declare 246 {
declare 246 {deprecated {}} {
    int Tcl_TellOld(Tcl_Channel chan)
}
declare 247 {
declare 247 {deprecated {No longer in use, changed to macro}} {
    int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
	    Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 248 {
    int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags, Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 249 {
    char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name,
	    Tcl_DString *bufferPtr)
}
declare 250 {
    int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead)
}
declare 251 {
    void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName)
}
declare 252 {
    int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 253 {
declare 253 {deprecated {No longer in use, changed to macro}} {
    int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
}
declare 254 {
    int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags)
}
declare 255 {
declare 255 {deprecated {No longer in use, changed to macro}} {
    void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
	    Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 256 {
    void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *proc,
	    ClientData clientData)
}
declare 257 {
    void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}
declare 258 {
declare 258 {deprecated {No longer in use, changed to macro}} {
    int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
	    const char *varName, const char *localName, int flags)
}
declare 259 {
    int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1,
	    const char *part2, const char *localName, int flags)
}
declare 260 {
    int Tcl_VarEval(Tcl_Interp *interp, ...)
}
declare 261 {
declare 261 {deprecated {No longer in use, changed to macro}} {
    ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
}
declare 262 {
    ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *procPtr,
	    ClientData prevClientData)
941
942
943
944
945
946
947
948

949
950
951

952
953
954
955
956
957
958
959


960
961
962


963
964
965
966

967
968
969
970

971
972
973
974
975
976


977
978
979

980
981
982

983
984
985
986
987
988

989
990
991
992
993
994
995
938
939
940
941
942
943
944

945
946
947

948
949
950
951
952
953
954


955
956
957


958
959
960
961
962

963
964
965
966

967
968
969
970
971


972
973
974
975

976
977
978

979
980
981
982
983
984

985
986
987
988
989
990
991
992







-
+


-
+






-
-
+
+

-
-
+
+



-
+



-
+




-
-
+
+


-
+


-
+





-
+







}
declare 265 {
    int Tcl_DumpActiveMemory(const char *fileName)
}
declare 266 {
    void Tcl_ValidateAllMemory(const char *file, int line)
}
declare 267 {
declare 267 {deprecated {see TIP #422}} {
    void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
}
declare 268 {
declare 268 {deprecated {see TIP #422}} {
    void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
declare 269 {
    char *Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 {
    CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
	    CONST84 char **termPtr)
    const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
	    const char **termPtr)
}
declare 271 {
    CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
declare 271 {deprecated {No longer in use, changed to macro}} {
    const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
	    const char *version, int exact)
}
declare 272 {
    CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
    const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
}
declare 273 {
declare 273 {deprecated {No longer in use, changed to macro}} {
    int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
	    const char *version)
}
# TIP #268: The internally used new Require function is in slot 573.
declare 274 {
    CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
declare 274 {deprecated {No longer in use, changed to macro}} {
    const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
	    const char *version, int exact)
}
declare 275 {
declare 275 {deprecated {see TIP #422}} {
    void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
declare 276 {
declare 276 {deprecated {see TIP #422}} {
    int  Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
}
declare 277 {
    Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
declare 278 {
declare 278 {deprecated {see TIP #422}} {
    TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
}
declare 279 {
    void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
}
declare 280 {
    void Tcl_InitMemory(Tcl_Interp *interp)
1083
1084
1085
1086
1087
1088
1089
1090

1091
1092
1093
1094
1095
1096
1097
1080
1081
1082
1083
1084
1085
1086

1087
1088
1089
1090
1091
1092
1093
1094







-
+







declare 300 {
    Tcl_ThreadId Tcl_GetCurrentThread(void)
}
declare 301 {
    Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
}
declare 302 {
    CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding)
    const char *Tcl_GetEncodingName(Tcl_Encoding encoding)
}
declare 303 {
    void Tcl_GetEncodingNames(Tcl_Interp *interp)
}
declare 304 {
    int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    const void *tablePtr, int offset, const char *msg, int flags,
1144
1145
1146
1147
1148
1149
1150
1151

1152
1153
1154

1155
1156
1157

1158
1159
1160

1161
1162
1163
1164
1165
1166

1167
1168
1169
1170
1171
1172
1173
1174
1175

1176
1177
1178

1179
1180
1181

1182
1183
1184

1185
1186
1187
1188
1189
1190
1191
1141
1142
1143
1144
1145
1146
1147

1148
1149
1150

1151
1152
1153

1154
1155
1156

1157
1158
1159
1160
1161
1162

1163
1164
1165
1166
1167
1168
1169
1170
1171

1172
1173
1174

1175
1176
1177

1178
1179
1180

1181
1182
1183
1184
1185
1186
1187
1188







-
+


-
+


-
+


-
+





-
+








-
+


-
+


-
+


-
+







    void Tcl_ThreadAlert(Tcl_ThreadId threadId)
}
declare 319 {
    void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr,
	    Tcl_QueuePosition position)
}
declare 320 {
    Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index)
    int Tcl_UniCharAtIndex(const char *src, int index)
}
declare 321 {
    Tcl_UniChar Tcl_UniCharToLower(int ch)
    int Tcl_UniCharToLower(int ch)
}
declare 322 {
    Tcl_UniChar Tcl_UniCharToTitle(int ch)
    int Tcl_UniCharToTitle(int ch)
}
declare 323 {
    Tcl_UniChar Tcl_UniCharToUpper(int ch)
    int Tcl_UniCharToUpper(int ch)
}
declare 324 {
    int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
    CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index)
    const char *Tcl_UtfAtIndex(const char *src, int index)
}
declare 326 {
    int Tcl_UtfCharComplete(const char *src, int length)
}
declare 327 {
    int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
}
declare 328 {
    CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch)
    const char *Tcl_UtfFindFirst(const char *src, int ch)
}
declare 329 {
    CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch)
    const char *Tcl_UtfFindLast(const char *src, int ch)
}
declare 330 {
    CONST84_RETURN char *Tcl_UtfNext(const char *src)
    const char *Tcl_UtfNext(const char *src)
}
declare 331 {
    CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start)
    const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 332 {
    int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
	    const char *src, int srcLen, int flags,
	    Tcl_EncodingState *statePtr, char *dst, int dstLen,
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
1210
1211
1212
1213
1214
1215
1216
1217
1218


1219
1220

1221
1222
1223
1224
1225
1226
1227
1207
1208
1209
1210
1211
1212
1213


1214
1215
1216

1217
1218
1219
1220
1221
1222
1223
1224







-
-
+
+

-
+







}
declare 339 {
    int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
    char *Tcl_GetString(Tcl_Obj *objPtr)
}
declare 341 {
    CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void)
declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
    const char *Tcl_GetDefaultEncodingDir(void)
}
declare 342 {
declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
    void Tcl_SetDefaultEncodingDir(const char *path)
}
declare 343 {
    void Tcl_AlertNotifier(ClientData clientData)
}
declare 344 {
    void Tcl_ServiceModeHook(int mode)
1262
1263
1264
1265
1266
1267
1268
1269

1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282

1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295

1296
1297
1298
1299
1300
1301
1302
1259
1260
1261
1262
1263
1264
1265

1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278

1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291

1292
1293
1294
1295
1296
1297
1298
1299







-
+












-
+












-
+







    Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src,
	    int length, Tcl_DString *dsPtr)
}
declare 356 {
    Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
	    int flags)
}
declare 357 {
declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
    Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
	    int count)
}
declare 358 {
    void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
declare 359 {
    void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script,
	    const char *command, int length)
}
declare 360 {
    int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes,
	    Tcl_Parse *parsePtr, int append, CONST84 char **termPtr)
	    Tcl_Parse *parsePtr, int append, const char **termPtr)
}
declare 361 {
    int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes,
	    int nested, Tcl_Parse *parsePtr)
}
declare 362 {
    int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes,
	    Tcl_Parse *parsePtr)
}
declare 363 {
    int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
	    int numBytes, Tcl_Parse *parsePtr, int append,
	    CONST84 char **termPtr)
	    const char **termPtr)
}
declare 364 {
    int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes,
	    Tcl_Parse *parsePtr, int append)
}
# These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir,
# Tcl_FSAccess and Tcl_FSStat
1347
1348
1349
1350
1351
1352
1353
1354

1355
1356

1357
1358
1359
1360
1361
1362
1363
1344
1345
1346
1347
1348
1349
1350

1351
1352

1353
1354
1355
1356
1357
1358
1359
1360







-
+

-
+







    void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
	    int numChars)
}
declare 380 {
    int Tcl_GetCharLength(Tcl_Obj *objPtr)
}
declare 381 {
    Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
    int Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
}
declare 382 {
declare 382 {deprecated {No longer in use, changed to macro}} {
    Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
}
declare 383 {
    Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last)
}
declare 384 {
    void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
1404
1405
1406
1407
1408
1409
1410
1411

1412
1413
1414
1415
1416
1417
1418
1401
1402
1403
1404
1405
1406
1407

1408
1409
1410
1411
1412
1413
1414
1415







-
+







declare 396 {
    Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan)
}
declare 397 {
    int Tcl_ChannelBuffered(Tcl_Channel chan)
}
declare 398 {
    CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
    const char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
}
declare 399 {
    Tcl_ChannelTypeVersion Tcl_ChannelVersion(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 400 {
    Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc(
1544
1545
1546
1547
1548
1549
1550
1551

1552
1553
1554
1555
1556

1557
1558
1559
1560
1561
1562
1563
1541
1542
1543
1544
1545
1546
1547

1548
1549
1550
1551
1552

1553
1554
1555
1556
1557
1558
1559
1560







-
+




-
+








# introduced in 8.4a3
declare 434 {
    Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}

# TIP#15 (math function introspection) dkf
declare 435 {
declare 435 {deprecated {}} {
    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,
	    Tcl_MathProc **procPtr, ClientData *clientDataPtr)
}
declare 436 {
declare 436 {deprecated {}} {
    Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
}

# TIP#36 (better access to 'subst') dkf
declare 437 {
    Tcl_Obj *Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338

















2339
2340
2341
2342
2343
2344
2345
2326
2327
2328
2329
2330
2331
2332



2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356







-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# TIP #456
declare 631 {
    Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service,
	    const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc,
	    ClientData callbackData)
}

# ----- BASELINE -- FOR -- 8.7.0 ----- #


# TIP #430
declare 632 {
    int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint,
	    const char *zipname, const char *passwd)
}
declare 633 {
    int TclZipfs_Unmount(Tcl_Interp *interp, const char *mountPoint)
}
declare 634 {
    Tcl_Obj *TclZipfs_TclLibrary(void)
}
declare 635 {
    int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint,
	    unsigned char *data, size_t datalen, int copy)
}

# ----- BASELINE -- FOR -- 8.7.0 ----- #

##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

interface tclPlat
2377
2378
2379
2380
2381
2382
2383




2384
2385
2386
2387
2388
2389
2390
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405







+
+
+
+







##############################################################################

# Public functions that are not accessible via the stubs table.

export {
    void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
}
export {
    void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc,
    Tcl_Interp *interp)
}
export {
    const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
	int exact)
}
export {
    const char *TclTomMathInitializeStubs(Tcl_Interp* interp,
	const char* version, int epoch, int revision)

Changes to generic/tcl.h.

48
49
50
51
52
53
54
55
56


57
58

59
60
61


62
63
64
65
66
67
68
48
49
50
51
52
53
54


55
56
57

58
59


60
61
62
63
64
65
66
67
68







-
-
+
+

-
+

-
-
+
+







 * macosx/Tcl.xcode/default.pbxuser (not patchlevel) 1 LOC
 * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC
 * win/README		(not patchlevel) (sections 0 and 2)
 * unix/tcl.spec	(1 LOC patch)
 * tools/tcl.hpj.in	(not patchlevel, for windows installer)
 */

#define TCL_MAJOR_VERSION   9
#define TCL_MINOR_VERSION   0
#define TCL_MAJOR_VERSION   8
#define TCL_MINOR_VERSION   7
#define TCL_RELEASE_LEVEL   TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL  0
#define TCL_RELEASE_SERIAL  2

#define TCL_VERSION	    "9.0"
#define TCL_PATCH_LEVEL	    "9.0a0"
#define TCL_VERSION	    "8.7"
#define TCL_PATCH_LEVEL	    "8.7a2"

#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
/*
 *----------------------------------------------------------------------------
 * The following definitions set up the proper options for Windows compilers.
 * We use this method because there is no autoconf equivalent.
 */
85
86
87
88
89
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
85
86
87
88
89
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







+
+
+
+














-
+
-


-

-
-
-







#  define STRINGIFY(x) STRINGIFY1(x)
#  define STRINGIFY1(x) #x
#endif
#ifndef JOIN
#  define JOIN(a,b) JOIN1(a,b)
#  define JOIN1(a,b) a##b
#endif

#ifndef TCL_THREADS
#   define TCL_THREADS 1
#endif
#endif /* !TCL_NO_DEPRECATED */

/*
 * A special definition used to allow this header file to be included from
 * windows resource files so that they can obtain version information.
 * RC_INVOKED is defined by default by the windows RC tool.
 *
 * Resource compilers don't like all the C stuff, like typedefs and function
 * declarations, that occur below, so block them out.
 */

#ifndef RC_INVOKED

/*
 * Special macro to define mutexes, that doesn't do anything if we are not
 * Special macro to define mutexes.
 * using threads.
 */

#ifdef TCL_THREADS
#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;
#else
#define TCL_DECLARE_MUTEX(name)
#endif

/*
 * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
 * SEEK_END, all #define'd by stdio.h .
 *
 * Also, many extensions need stdio.h, and they've grown accustomed to tcl.h
 * providing it for them rather than #include-ing it themselves as they
133
134
135
136
137
138
139
140

141
142
143
144
145
146
147
132
133
134
135
136
137
138

139
140
141
142
143
144
145
146







-
+







 * written for older versions of Tcl where the macros permitted
 * support for the varargs.h system as well as stdarg.h .
 *
 * New code should just directly be written to use stdarg.h conventions.
 */

#include <stdarg.h>
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#    define TCL_VARARGS(type, name) (type name, ...)
#    define TCL_VARARGS_DEF(type, name) (type name, ...)
#    define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
#endif /* !TCL_NO_DEPRECATED */
#if defined(__GNUC__) && (__GNUC__ > 2)
#   define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
#   define TCL_NORETURN __attribute__ ((noreturn))
221
222
223
224
225
226
227
228

229
230
231
232
233
234
235
220
221
222
223
224
225
226

227
228
229
230
231
232
233
234







-
+








/*
 * These macros are used to control whether functions are being declared for
 * import or export. If a function is being declared while it is being built
 * to be included in a shared library, then it should have the DLLEXPORT
 * storage class. If is being declared for use by a module that is going to
 * link against the shared library, then it should have the DLLIMPORT storage
 * class. If the symbol is beind declared for a static build or for use from a
 * class. If the symbol is being declared for a static build or for use from a
 * stub library, then the storage class should be empty.
 *
 * The convention is that a macro called BUILD_xxxx, where xxxx is the name of
 * a library we are building, is set on the compile line for sources that are
 * to be placed in the library. When this macro is set, the storage class will
 * be set to DLLEXPORT. At the end of the header file, the storage class will
 * be reset to DLLIMPORT.
250
251
252
253
254
255
256
257

258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294

295
296
297

298
299
300
301
302
303
304
249
250
251
252
253
254
255

256
257
258

259
260
261
262
263
264
265
266
267






268
269
270
271















272
273
274

275
276
277
278
279
280
281
282







-
+


-









-
-
-
-
-
-




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+


-
+







 * The following _ANSI_ARGS_ macro is to support old extensions
 * written for older versions of Tcl where it permitted support
 * for compilers written in the pre-prototype era of C.
 *
 * New code should use prototypes.
 */

#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#   undef _ANSI_ARGS_
#   define _ANSI_ARGS_(x)	x
#endif /* !TCL_NO_DEPRECATED */

/*
 * Definitions that allow this header file to be used either with or without
 * ANSI C features.
 */

#ifndef INLINE
#   define INLINE
#endif

#ifdef NO_CONST
#   ifndef const
#      define const
#   endif
#endif
#ifndef CONST
#   define CONST const
#endif

#ifdef USE_NON_CONST
#   ifdef USE_COMPAT_CONST
#      error define at most one of USE_NON_CONST and USE_COMPAT_CONST
#   endif
#   define CONST84
#   define CONST84_RETURN
#else
#   ifdef USE_COMPAT_CONST
#      define CONST84
#      define CONST84_RETURN const
#   else
#      define CONST84 const
#      define CONST84_RETURN const
#   endif
#endif
#endif /* !TCL_NO_DEPRECATED */

#ifndef CONST86
#      define CONST86 CONST84
#      define CONST86 const
#endif

/*
 * Make sure EXTERN isn't defined elsewhere.
 */

#ifdef EXTERN
314
315
316
317
318
319
320

321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337

338
339
340
341

342
343
344
345
346
347
348
349

350
351
352
353
354
355
356
357
358
359
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314


315



316
317
318
319
320
321
322
323


324



325
326
327
328
329
330
331







+















-
-
+
-
-
-

+






-
-
+
-
-
-







/*
 *----------------------------------------------------------------------------
 * The following code is copied from winnt.h. If we don't replicate it here,
 * then <windows.h> can't be included after tcl.h, since tcl.h also defines
 * VOID. This block is skipped under Cygwin and Mingw.
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
#ifndef VOID
#define VOID void
typedef char CHAR;
typedef short SHORT;
typedef long LONG;
#endif
#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */

/*
 * Macro to use instead of "void" for arguments that must have type "void *"
 * in ANSI C; maps them to type "char *" in non-ANSI systems.
 */

#ifndef __VXWORKS__
#   ifndef NO_VOID
#	define VOID void
#   define VOID void
#   else
#	define VOID char
#   endif
#endif
#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */

/*
 * Miscellaneous declarations.
 */

#ifndef _CLIENTDATA
#   ifndef NO_VOID
	typedef void *ClientData;
    typedef void *ClientData;
#   else
	typedef int *ClientData;
#   endif
#   define _CLIENTDATA
#endif

/*
 * Darwin specific configure overrides (to support fat compiles, where
 * configure runs only once for multiple architectures):
 */
392
393
394
395
396
397
398



399
400
401

402
403
404
405
406
407
408

409
410
411
412
413
414
415
416
417
418




419
420
421
422
423
424
425
426
427




428
429

430
431
432
433
434
435





436
437
438
439
440
441
442
443
364
365
366
367
368
369
370
371
372
373
374


375
376
377
378
379
380
381

382
383


384
385
386




387
388
389
390
391
392
393
394





395
396
397
398


399






400
401
402
403
404

405
406
407
408
409
410
411







+
+
+

-
-
+






-
+

-
-



-
-
-
-
+
+
+
+




-
-
-
-
-
+
+
+
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+
-







 * sprintf(...,"%" TCL_LL_MODIFIER "d",...).
 */

#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
#   if defined(_WIN32)
#      define TCL_WIDE_INT_TYPE __int64
#      define TCL_LL_MODIFIER	"I64"
#      if defined(_WIN64)
#         define TCL_Z_MODIFIER	"I"
#      endif
#   elif defined(__GNUC__)
#      define TCL_WIDE_INT_TYPE long long
#      define TCL_LL_MODIFIER	"ll"
#      define TCL_Z_MODIFIER	"z"
#   else /* ! _WIN32 && ! __GNUC__ */
/*
 * Don't know what platform it is and configure hasn't discovered what is
 * going on for us. Try to guess...
 */
#      include <limits.h>
#      if (INT_MAX < LONG_MAX)
#      if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX)
#         define TCL_WIDE_INT_IS_LONG	1
#      else
#         define TCL_WIDE_INT_TYPE long long
#      endif
#   endif /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
#ifdef TCL_WIDE_INT_IS_LONG
#   undef TCL_WIDE_INT_TYPE
#   define TCL_WIDE_INT_TYPE	long
#endif /* TCL_WIDE_INT_IS_LONG */

#ifndef TCL_WIDE_INT_TYPE
#   define TCL_WIDE_INT_TYPE		long long
#endif /* !TCL_WIDE_INT_TYPE */

typedef TCL_WIDE_INT_TYPE		Tcl_WideInt;
typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;

#ifdef TCL_WIDE_INT_IS_LONG
#   ifndef TCL_LL_MODIFIER
#      define TCL_LL_MODIFIER		"l"
#   endif /* !TCL_LL_MODIFIER */
#else /* TCL_WIDE_INT_IS_LONG */
#ifndef TCL_LL_MODIFIER
#   define TCL_LL_MODIFIER	"ll"
#endif /* !TCL_LL_MODIFIER */
#ifndef TCL_Z_MODIFIER
/*
 * The next short section of defines are only done when not running on Windows
#   if defined(__GNUC__) && !defined(_WIN32)
 * or some other strange platform.
 */
#   ifndef TCL_LL_MODIFIER
#      define TCL_LL_MODIFIER		"ll"
#   endif /* !TCL_LL_MODIFIER */
#endif /* TCL_WIDE_INT_IS_LONG */
#	define TCL_Z_MODIFIER	"z"
#   else
#	define TCL_Z_MODIFIER	""
#   endif
#endif /* !TCL_Z_MODIFIER */

#define Tcl_WideAsLong(val)	((long)((Tcl_WideInt)(val)))
#define Tcl_LongAsWide(val)	((Tcl_WideInt)((long)(val)))
#define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
#define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))

#if defined(_WIN32)
#   ifdef __BORLANDC__
488
489
490
491
492
493
494
495











496
497
498
499
500
501
502
456
457
458
459
460
461
462

463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480







-
+
+
+
+
+
+
+
+
+
+
+







 * "real" definition in tclInt.h.
 *
 * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc.
 * Instead, they set a Tcl_Obj member in the "real" structure that can be
 * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
 */

typedef struct Tcl_Interp Tcl_Interp;
typedef struct Tcl_Interp
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{
    /* TIP #330: Strongly discourage extensions from using the string
     * result. */
    char *resultDontUse; /* Don't use in extensions! */
    void (*freeProcDontUse) (char *); /* Don't use in extensions! */
    int errorLineDontUse; /* Don't use in extensions! */
}
#endif /* !TCL_NO_DEPRECATED */
Tcl_Interp;

typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
typedef struct Tcl_Command_ *Tcl_Command;
typedef struct Tcl_Condition_ *Tcl_Condition;
typedef struct Tcl_Dict_ *Tcl_Dict;
637
638
639
640
641
642
643




644
645
646
647
648
649
650
651
652
653
654
655
656
657

658
659
660
661
662
663
664
665
666
667
668




669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689

690
691
692

693
694
695
696
697
698
699
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675

676
677
678

679
680
681
682
683
684
685
686







+
+
+
+














+











+
+
+
+




















-
+


-
+








#define TCL_OK			0
#define TCL_ERROR		1
#define TCL_RETURN		2
#define TCL_BREAK		3
#define TCL_CONTINUE		4

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TCL_RESULT_SIZE		200
#endif

/*
 *----------------------------------------------------------------------------
 * Flags to control what substitutions are performed by Tcl_SubstObj():
 */

#define TCL_SUBST_COMMANDS	001
#define TCL_SUBST_VARIABLES	002
#define TCL_SUBST_BACKSLASHES	004
#define TCL_SUBST_ALL		007

/*
 * Argument descriptors for math function callbacks in expressions:
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
typedef enum {
    TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
} Tcl_ValueType;

typedef struct Tcl_Value {
    Tcl_ValueType type;		/* Indicates intValue or doubleValue is valid,
				 * or both. */
    long intValue;		/* Integer value. */
    double doubleValue;		/* Double-precision floating value. */
    Tcl_WideInt wideValue;	/* Wide (min. 64-bit) integer value. */
} Tcl_Value;
#else
#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */
#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */
#endif

/*
 * Forward declaration of Tcl_Obj to prevent an error when the forward
 * reference to Tcl_Obj is encountered in the function types declared below.
 */

struct Tcl_Obj;

/*
 *----------------------------------------------------------------------------
 * Function types defined by Tcl:
 */

typedef int (Tcl_AppInitProc) (Tcl_Interp *interp);
typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp,
	int code);
typedef void (Tcl_ChannelProc) (ClientData clientData, int mask);
typedef void (Tcl_CloseProc) (ClientData data);
typedef void (Tcl_CmdDeleteProc) (ClientData clientData);
typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp,
	int argc, CONST84 char *argv[]);
	int argc, const char *argv[]);
typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp,
	int level, char *command, Tcl_CmdProc *proc,
	ClientData cmdClientData, int argc, CONST84 char *argv[]);
	ClientData cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, int objc,
	struct Tcl_Obj *const *objv);
typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData);
typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
	struct Tcl_Obj *dupPtr);
typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src,
722
723
724
725
726
727
728
729

730
731
732
733
734
735
736
709
710
711
712
713
714
715

716
717
718
719
720
721
722
723







-
+







typedef void (Tcl_PanicProc) (const char *format, ...);
typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan,
	char *address, int port);
typedef void (Tcl_TimerProc) (ClientData clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp,
	CONST84 char *part1, CONST84 char *part2, int flags);
	const char *part1, const char *part2, int flags);
typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp,
	const char *oldName, const char *newName, int flags);
typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
	ClientData clientData);
typedef void (Tcl_DeleteFileHandlerProc) (int fd);
typedef void (Tcl_AlertNotifierProc) (ClientData clientData);
typedef void (Tcl_ServiceModeHookProc) (int mode);
821
822
823
824
825
826
827
828
829



830
831








832

833
834
835
836
837
838
839
808
809
810
811
812
813
814


815
816
817
818
819
820
821
822
823
824
825
826
827

828
829
830
831
832
833
834
835







-
-
+
+
+


+
+
+
+
+
+
+
+
-
+








void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
int		Tcl_IsShared(Tcl_Obj *objPtr);

/*
 *----------------------------------------------------------------------------
 * The following type contains the state needed by Tcl_SaveResult. It
 * is typically allocated on the stack.
 * The following structure contains the state needed by Tcl_SaveResult. No-one
 * outside of Tcl should access any of these fields. This structure is
 * typically allocated on the stack.
 */

typedef struct Tcl_SavedResult {
    char *result;
    Tcl_FreeProc *freeProc;
    Tcl_Obj *objResultPtr;
    char *appendResult;
    int appendAvl;
    int appendUsed;
    char resultSpace[200+1];
typedef Tcl_Obj *Tcl_SavedResult;
} Tcl_SavedResult;

/*
 *----------------------------------------------------------------------------
 * The following definitions support Tcl's namespace facility. Note: the first
 * five fields must match exactly the fields in a Namespace structure (see
 * tclInt.h).
 */
950
951
952
953
954
955
956
957

958
959
960
961
962
963
964
946
947
948
949
950
951
952

953
954
955
956
957
958
959
960







-
+







    char staticSpace[TCL_DSTRING_STATIC_SIZE];
				/* Space to use in common case where string is
				 * small. */
} Tcl_DString;

#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#   define Tcl_DStringTrunc Tcl_DStringSetLength
#endif /* !TCL_NO_DEPRECATED */

/*
 * Definitions for the maximum number of digits of precision that may be
 * specified in the "tcl_precision" variable, and the number of bytes of
 * buffer space required by Tcl_PrintDouble.
1078
1079
1080
1081
1082
1083
1084
1085

1086
1087
1088
1089
1090
1091
1092
1074
1075
1076
1077
1078
1079
1080

1081
1082
1083
1084
1085
1086
1087
1088







-
+







/*
 * The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now
 * always parsed whenever the part2 is NULL. (This is to avoid a common error
 * when converting code to use the new object based APIs and forgetting to
 * give the flag)
 */

#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#   define TCL_PARSE_PART1	0x400
#endif /* !TCL_NO_DEPRECATED */

/*
 * Types for linked variables:
 */

1431
1432
1433
1434
1435
1436
1437
1438

1439
1440
1441
1442
1443
1444
1445

1446
1447
1448
1449
1450
1451
1452
1427
1428
1429
1430
1431
1432
1433

1434
1435
1436
1437
1438
1439
1440

1441
1442
1443
1444
1445
1446
1447
1448







-
+






-
+







typedef int	(Tcl_DriverCloseProc) (ClientData instanceData,
			Tcl_Interp *interp);
typedef int	(Tcl_DriverClose2Proc) (ClientData instanceData,
			Tcl_Interp *interp, int flags);
typedef int	(Tcl_DriverInputProc) (ClientData instanceData, char *buf,
			int toRead, int *errorCodePtr);
typedef int	(Tcl_DriverOutputProc) (ClientData instanceData,
			CONST84 char *buf, int toWrite, int *errorCodePtr);
			const char *buf, int toWrite, int *errorCodePtr);
typedef int	(Tcl_DriverSeekProc) (ClientData instanceData, long offset,
			int mode, int *errorCodePtr);
typedef int	(Tcl_DriverSetOptionProc) (ClientData instanceData,
			Tcl_Interp *interp, const char *optionName,
			const char *value);
typedef int	(Tcl_DriverGetOptionProc) (ClientData instanceData,
			Tcl_Interp *interp, CONST84 char *optionName,
			Tcl_Interp *interp, const char *optionName,
			Tcl_DString *dsPtr);
typedef void	(Tcl_DriverWatchProc) (ClientData instanceData, int mask);
typedef int	(Tcl_DriverGetHandleProc) (ClientData instanceData,
			int direction, ClientData *handlePtr);
typedef int	(Tcl_DriverFlushProc) (ClientData instanceData);
typedef int	(Tcl_DriverHandlerProc) (ClientData instanceData,
			int interestMask);
1931
1932
1933
1934
1935
1936
1937
1938

1939
1940
1941
1942
1943
1944
1945
1927
1928
1929
1930
1931
1932
1933

1934
1935
1936
1937
1938
1939
1940
1941







-
+







 *				is described by a TCL_TOKEN_SUB_EXPR token
 *				followed by the TCL_TOKEN_OPERATOR token for
 *				the operator, then TCL_TOKEN_SUB_EXPR tokens
 *				for the left then the right operands.
 * TCL_TOKEN_OPERATOR -		The token describes one expression operator.
 *				An operator might be the name of a math
 *				function such as "abs". A TCL_TOKEN_OPERATOR
 *				token is always preceeded by one
 *				token is always preceded by one
 *				TCL_TOKEN_SUB_EXPR token for the operator's
 *				subexpression, and is followed by zero or more
 *				TCL_TOKEN_SUB_EXPR tokens for the operator's
 *				operands. NumComponents is always 0.
 * TCL_TOKEN_EXPAND_WORD -	This token is just like TCL_TOKEN_WORD except
 *				that it marks a word that began with the
 *				literal character prefix "{*}". This word is
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154



2155
2156
2157
2158
2159
2160
2161

2162
2163
2164
2165
2166
2167
2168
2141
2142
2143
2144
2145
2146
2147



2148
2149
2150
2151
2152
2153
2154
2155
2156

2157
2158
2159
2160
2161
2162
2163
2164







-
-
-
+
+
+






-
+







#define TCL_CONVERT_MULTIBYTE	(-1)
#define TCL_CONVERT_SYNTAX	(-2)
#define TCL_CONVERT_UNKNOWN	(-3)
#define TCL_CONVERT_NOSPACE	(-4)

/*
 * The maximum number of bytes that are necessary to represent a single
 * Unicode character in UTF-8. The valid values should be 3, 4 or 6
 * (or perhaps 1 if we want to support a non-unicode enabled core). If 3 or
 * 4, then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
 * Unicode character in UTF-8. The valid values are 4 and 6
 * (or perhaps 1 if we want to support a non-unicode enabled core). If 4,
 * then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
 * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode
 * is the default and recommended mode. UCS-4 is experimental and not
 * recommended. It works for the core, but most extensions expect UCS-2.
 */

#ifndef TCL_UTF_MAX
#define TCL_UTF_MAX		3
#define TCL_UTF_MAX		4
#endif

/*
 * This represents a Unicode character. Any changes to this should also be
 * reflected in regcustom.h.
 */

2333
2334
2335
2336
2337
2338
2339







2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351

2352
2353
2354

2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366





2367
2368
2369
2370
2371
2372
2373
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353

2354
2355
2356

2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381







+
+
+
+
+
+
+











-
+


-
+












+
+
+
+
+







/*
 *----------------------------------------------------------------------------
 * Definitions needed for the Tcl_OpenTcpServerEx function. [TIP #456]
 */
#define TCL_TCPSERVER_REUSEADDR (1<<0)
#define TCL_TCPSERVER_REUSEPORT (1<<1)

/*
 * Constants for special int-typed values, see TIP #494
 */

#define TCL_IO_FAILURE	(-1)
#define TCL_AUTO_LENGTH	(-1)

/*
 *----------------------------------------------------------------------------
 * Single public declaration for NRE.
 */

typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
				int result);

/*
 *----------------------------------------------------------------------------
 * The following constant is used to test for older versions of Tcl in the
 * stubs tables.
 * stubs tables. If TCL_UTF_MAX>4 use a different value.
 */

#define TCL_STUB_MAGIC		((int) 0xFCA3BACF)
#define TCL_STUB_MAGIC		((int) 0xFCA3BACF + (TCL_UTF_MAX>4))

/*
 * The following function is required to be defined in all stubs aware
 * extensions. The function is actually implemented in the stub library, not
 * the main Tcl library, although there is a trivial implementation in the
 * main library in case an extension is statically linked into an application.
 */

const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
			    int exact, int magic);
const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
			    const char *version, int epoch, int revision);
#if defined(_WIN32)
    TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...);
#else
#   define Tcl_ConsolePanic ((Tcl_PanicProc *)0)
#endif

#ifdef USE_TCL_STUBS
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
	    TCL_STUB_MAGIC)
2391
2392
2393
2394
2395
2396
2397
2398

2399
2400
2401
2402
2403



2404
2405
2406
2407
2408
2409
2410
2399
2400
2401
2402
2403
2404
2405

2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421







-
+





+
+
+








/*
 * Public functions that are not accessible via the stubs table.
 * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
 */

#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
	    ((Tcl_CreateInterp)()))
	    (((Tcl_SetPanicProc)(Tcl_ConsolePanic), Tcl_CreateInterp)()))
EXTERN void		Tcl_MainEx(int argc, char **argv,
			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
			    const char *version, int exact);
EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
#ifndef _WIN32
EXTERN int		TclZipfs_AppHook(int *argc, char ***argv);
#endif

/*
 *----------------------------------------------------------------------------
 * Include the public function declarations that are accessible via the stubs
 * table.
 */

2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2521
2522
2523
2524
2525
2526
2527



2528
2529
2530



2531
2532
2533
2534
2535
2536
2537







-
-
-



-
-
-







     Tcl_DbNewLongObj((val)!=0, __FILE__, __LINE__)
#  undef  Tcl_NewByteArrayObj
#  define Tcl_NewByteArrayObj(bytes, len) \
     Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
#  undef  Tcl_NewDoubleObj
#  define Tcl_NewDoubleObj(val) \
     Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
#  undef  Tcl_NewIntObj
#  define Tcl_NewIntObj(val) \
     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
#  undef  Tcl_NewListObj
#  define Tcl_NewListObj(objc, objv) \
     Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
#  undef  Tcl_NewLongObj
#  define Tcl_NewLongObj(val) \
     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
#  undef  Tcl_NewObj
#  define Tcl_NewObj() \
     Tcl_DbNewObj(__FILE__, __LINE__)
#  undef  Tcl_NewStringObj
#  define Tcl_NewStringObj(bytes, len) \
     Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__)
#  undef  Tcl_NewWideIntObj
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588

2589
2590
2591

2592
2593
2594
2595
2596
2597
2598
2560
2561
2562
2563
2564
2565
2566





















2567
2568
2569
2570
2571

2572
2573
2574

2575
2576
2577
2578
2579
2580
2581
2582







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
+


-
+







#undef  Tcl_FindHashEntry
#define Tcl_FindHashEntry(tablePtr, key) \
	(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
#undef  Tcl_CreateHashEntry
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
	(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)

/*
 *----------------------------------------------------------------------------
 * Macros that eliminate the overhead of the thread synchronization functions
 * when compiling without thread support.
 */

#ifndef TCL_THREADS
#undef  Tcl_MutexLock
#define Tcl_MutexLock(mutexPtr)
#undef  Tcl_MutexUnlock
#define Tcl_MutexUnlock(mutexPtr)
#undef  Tcl_MutexFinalize
#define Tcl_MutexFinalize(mutexPtr)
#undef  Tcl_ConditionNotify
#define Tcl_ConditionNotify(condPtr)
#undef  Tcl_ConditionWait
#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
#undef  Tcl_ConditionFinalize
#define Tcl_ConditionFinalize(condPtr)
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------------
 * Deprecated Tcl functions:
 */

#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
 * These function have been renamed. The old names are deprecated, but we
 * define these macros for backwards compatibilty.
 * define these macros for backwards compatibility.
 */

#   define Tcl_Ckalloc		Tcl_Alloc
#   define Tcl_Ckfree		Tcl_Free
#   define Tcl_Ckrealloc	Tcl_Realloc
#   define Tcl_Return		Tcl_SetResult
#   define Tcl_TildeSubst	Tcl_TranslateFileName

Changes to generic/tclAlloc.c.

18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32







-
+








/*
 * Windows and Unix use an alternative allocator when building with threads
 * that has significantly reduced lock contention.
 */

#include "tclInt.h"
#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
#if !TCL_THREADS || !defined(USE_THREAD_ALLOC)

#if USE_TCLALLOC

/*
 * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait
 * until Tcl uses config.h properly.
 */
117
118
119
120
121
122
123
124

125
126
127
128
129
130
131
117
118
119
120
121
122
123

124
125
126
127
128
129
130
131







-
+







/*
 * The allocator is protected by a special mutex that must be explicitly
 * initialized. Futhermore, because Tcl_Alloc may be used before anything else
 * in Tcl, we make this module self-initializing after all with the allocInit
 * variable.
 */

#ifdef TCL_THREADS
#if TCL_THREADS
static Tcl_Mutex *allocMutexPtr;
#endif
static int allocInit = 0;

#ifdef MSTATS

/*
167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
167
168
169
170
171
172
173

174
175
176
177
178
179
180
181







-
+







 */

void
TclInitAlloc(void)
{
    if (!allocInit) {
	allocInit = 1;
#ifdef TCL_THREADS
#if TCL_THREADS
	allocMutexPtr = Tcl_GetAllocMutex();
#endif
    }
}

/*
 *-------------------------------------------------------------------------
657
658
659
660
661
662
663
664

665
666
667
668
669
670
671




672
673
674
675
676
677
678
657
658
659
660
661
662
663

664
665
666
667




668
669
670
671
672
673
674
675
676
677
678







-
+



-
-
-
-
+
+
+
+







	    fprintf(stderr, " %u", j);
	}
	totalFree += ((size_t)j) * (1 << (i + 3));
    }

    fprintf(stderr, "\nused:\t");
    for (i = 0; i < NBUCKETS; i++) {
	fprintf(stderr, " %" TCL_LL_MODIFIER "d", (Tcl_WideInt)numMallocs[i]);
	fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]);
	totalUsed += numMallocs[i] * (1 << (i + 3));
    }

    fprintf(stderr, "\n\tTotal small in use: %" TCL_LL_MODIFIER "d, total free: %" TCL_LL_MODIFIER "d\n",
	(Tcl_WideInt)totalUsed, (Tcl_WideInt)totalFree);
    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_LL_MODIFIER "d\n",
	    MAXMALLOC, (Tcl_WideInt)numMallocs[NBUCKETS]);
    fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "u, total free: %" TCL_Z_MODIFIER "u\n",
	totalUsed, totalFree);
    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n",
	    MAXMALLOC, numMallocs[NBUCKETS]);

    Tcl_MutexUnlock(allocMutexPtr);
}
#endif

#else	/* !USE_TCLALLOC */


Changes to generic/tclAssembly.c.

2242
2243
2244
2245
2246
2247
2248
2249
2250


2251
2252
2253
2254
2255
2256


2257
2258
2259

2260
2261



2262


2263
2264
2265

2266
2267
2268
2269
2270
2271
2272
2242
2243
2244
2245
2246
2247
2248


2249
2250
2251





2252
2253
2254
2255
2256
2257
2258

2259
2260
2261
2262
2263
2264
2265


2266
2267
2268
2269
2270
2271
2272
2273







-
-
+
+

-
-
-
-
-
+
+



+

-
+
+
+

+
+

-
-
+







    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code */
    Tcl_Obj* intObj;		/* Integer from the source code */
    int status;			/* Tcl status return */
    Tcl_Obj *value;
    int status;

    /*
     * Extract the next token as a string.
     */

    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
    /* General operand validity check */
    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &value) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Convert to an integer, advance to the next token and return. */
    /*
     * Convert to an integer, advance to the next token and return.
     * NOTE: Indexing a list with an index before it yields the
     * same result as indexing after it, and might be more easily portable
     * when list size limits grow.
     */
    status = TclIndexEncode(interp, value,
	    TCL_INDEX_BEFORE,TCL_INDEX_BEFORE, result);

    status = TclGetIntForIndex(interp, intObj, -2, result);
    Tcl_DecrRefCount(intObj);
    Tcl_DecrRefCount(value);
    *tokenPtrPtr = TokenAfter(tokenPtr);
    return status;
}

/*
 *-----------------------------------------------------------------------------
 *
4262
4263
4264
4265
4266
4267
4268
4269

4270
4271
4272
4273
4274
4275
4276
4263
4264
4265
4266
4267
4268
4269

4270
4271
4272
4273
4274
4275
4276
4277







-
+








    Tcl_AddErrorInfo(interp, "\n    in assembly code between lines ");
    lineNo = Tcl_NewIntObj(bbPtr->startLine);
    Tcl_IncrRefCount(lineNo);
    Tcl_AppendObjToErrorInfo(interp, lineNo);
    Tcl_AddErrorInfo(interp, " and ");
    if (bbPtr->successor1 != NULL) {
	TclSetLongObj(lineNo, bbPtr->successor1->startLine);
	TclSetIntObj(lineNo, bbPtr->successor1->startLine);
	Tcl_AppendObjToErrorInfo(interp, lineNo);
    } else {
	Tcl_AddErrorInfo(interp, "end of assembly code");
    }
    Tcl_DecrRefCount(lineNo);
}


Changes to generic/tclBasic.c.

67
68
69
70
71
72
73
74












75
76
77
78
79
80
81
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92







-
+
+
+
+
+
+
+
+
+
+
+
+







				 * a default result. */
    int length;			/* Length of the above error message. */
    ClientData clientData;	/* Ignored */
    int flags;			/* Additional flags */
} CancelInfo;
static Tcl_HashTable cancelTable;
static int cancelTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(cancelLock)
TCL_DECLARE_MUTEX(cancelLock);

/*
 * Table used to map command implementation functions to a human-readable type
 * name, for [info type]. The keys in the table are function addresses, and
 * the values in the table are static char* containing strings in Tcl's
 * internal encoding (almost UTF-8).
 */

static Tcl_HashTable commandTypeTable;
static int commandTypeInit = 0;
TCL_DECLARE_MUTEX(commandTypeLock);

/*
 * Declarations for managing contexts for non-recursive coroutines. Contexts
 * are used to save the evaluation state between NR calls to each coro.
 */

#define SAVE_CONTEXT(context)				\
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
128
129
130
131
132

133
134

135
136
137
138
139
140
141
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
128

129
130
131
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







+




















-



+
+












+


+







    iPtr->cmdFramePtr = (context).cmdFramePtr;		\
    iPtr->lineLABCPtr = (context).lineLABCPtr

/*
 * Static functions in this file:
 */

static Tcl_ObjCmdProc   BadEnsembleSubcommand;
static char *		CallCommandTraces(Interp *iPtr, Command *cmdPtr,
			    const char *oldName, const char *newName,
			    int flags);
static int		CancelEvalProc(ClientData clientData,
			    Tcl_Interp *interp, int code);
static int		CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void		DeleteCoroutine(ClientData clientData);
static void		DeleteInterpProc(Tcl_Interp *interp);
static void		DeleteOpCmdClientData(ClientData clientData);
#ifdef USE_DTRACE
static Tcl_ObjCmdProc	DTraceObjCmd;
static Tcl_NRPostProc	DTraceCmdReturn;
#else
#   define DTraceCmdReturn	NULL
#endif /* USE_DTRACE */
static Tcl_ObjCmdProc	ExprAbsFunc;
static Tcl_ObjCmdProc	ExprBinaryFunc;
static Tcl_ObjCmdProc	ExprBoolFunc;
static Tcl_ObjCmdProc	ExprCeilFunc;
static Tcl_ObjCmdProc	ExprDoubleFunc;
static Tcl_ObjCmdProc	ExprEntierFunc;
static Tcl_ObjCmdProc	ExprFloorFunc;
static Tcl_ObjCmdProc	ExprIntFunc;
static Tcl_ObjCmdProc	ExprIsqrtFunc;
static Tcl_ObjCmdProc	ExprMaxFunc;
static Tcl_ObjCmdProc	ExprMinFunc;
static Tcl_ObjCmdProc	ExprRandFunc;
static Tcl_ObjCmdProc	ExprRoundFunc;
static Tcl_ObjCmdProc	ExprSqrtFunc;
static Tcl_ObjCmdProc	ExprSrandFunc;
static Tcl_ObjCmdProc	ExprUnaryFunc;
static Tcl_ObjCmdProc	ExprWideFunc;
static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
			    int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc	NRCoroutineCallerCallback;
static Tcl_NRPostProc	NRCoroutineExitCallback;
static Tcl_NRPostProc	NRCommand;

#if !defined(TCL_NO_DEPRECATED)
static Tcl_ObjCmdProc	OldMathFuncProc;
static void		OldMathFuncDeleteProc(ClientData clientData);
#endif /* !defined(TCL_NO_DEPRECATED) */
static void		ProcessUnexpectedResult(Tcl_Interp *interp,
			    int returnCode);
static int		RewindCoroutine(CoroutineData *corPtr, int result);
static void		TEOV_SwitchVarFrame(Tcl_Interp *interp);
static void		TEOV_PushExceptionHandlers(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[], int flags);
static inline Command *	TEOV_LookupCmdFromObj(Tcl_Interp *interp,
187
188
189
190
191
192
193


















194
195
196
197
198
199
200
201
202
203
204
205
206

207
208
209
210
211
212
213
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

239
240
241
242
243
244
245
246







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












-
+







#define 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
 * structs.) Alas, we can't sensibly just store the information directly in
 * the commands.
 */

typedef struct {
    const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for
                                 * 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. */
} UnsafeEnsembleInfo;

/*
 * The built-in commands, and the functions that implement them:
 */

static const CmdInfo builtInCmds[] = {
    /*
     * Commands in the generic core.
     */

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
#endif
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
230
231
232
233
234
235
236
237

238
239
240
241
242
243
244
263
264
265
266
267
268
269

270
271
272
273
274
275
276
277







-
+







    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},
    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	NULL,	CMD_IS_SAFE},
    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	NULL,	CMD_IS_SAFE},
287
288
289
290
291
292
293






























































294
295
296
297
298
299
300
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {NULL,		NULL,			NULL,			NULL,	0}
};

/*
 * Information about which pieces of ensembles to hide when making an
 * interpreter safe:
 */

static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
    /* [encoding] has two unsafe commands. Assumed by older security policies
     * to be overall unsafe; it isn't but... */
    {"encoding", NULL},
    {"encoding", "dirs"},
    {"encoding", "system"},
    /* [file] has MANY unsafe commands! Assumed by older security policies to
     * be overall unsafe; it isn't but... */
    {"file", NULL},
    {"file", "atime"},
    {"file", "attributes"},
    {"file", "copy"},
    {"file", "delete"},
    {"file", "dirname"},
    {"file", "executable"},
    {"file", "exists"},
    {"file", "extension"},
    {"file", "isdirectory"},
    {"file", "isfile"},
    {"file", "link"},
    {"file", "lstat"},
    {"file", "mtime"},
    {"file", "mkdir"},
    {"file", "nativename"},
    {"file", "normalize"},
    {"file", "owned"},
    {"file", "readable"},
    {"file", "readlink"},
    {"file", "rename"},
    {"file", "rootname"},
    {"file", "size"},
    {"file", "stat"},
    {"file", "tail"},
    {"file", "tempfile"},
    {"file", "type"},
    {"file", "volumes"},
    {"file", "writable"},
    /* [info] has two unsafe commands */
    {"info", "cmdtype"},
    {"info", "nameofexecutable"},
    /* [tcl::process] has ONLY unsafe commands! */
    {"process", "list"},
    {"process", "status"},
    {"process", "purge"},
    {"process", "autopurge"},
    /* [zipfs] has MANY unsafe commands! */
    {"zipfs", "lmkimg"},
    {"zipfs", "lmkzip"},
    {"zipfs", "mkimg"},
    {"zipfs", "mkkey"},
    {"zipfs", "mkzip"},
    {"zipfs", "mount"},
    {"zipfs", "mount_data"},
    {"zipfs", "unmount"},
    {NULL, NULL}
};

/*
 * Math functions. All are safe.
 */

typedef struct {
    const char *name;		/* Name of the function. The full name is
				 * "::tcl::mathfunc::<name>". */
308
309
310
311
312
313
314
315

316
317
318
319
320
321
322
323


324
325
326
327
328
329
330
403
404
405
406
407
408
409

410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427







-
+








+
+







    { "atan",	ExprUnaryFunc,	(ClientData) atan	},
    { "atan2",	ExprBinaryFunc,	(ClientData) atan2	},
    { "bool",	ExprBoolFunc,	NULL			},
    { "ceil",	ExprCeilFunc,	NULL			},
    { "cos",	ExprUnaryFunc,	(ClientData) cos	},
    { "cosh",	ExprUnaryFunc,	(ClientData) cosh	},
    { "double",	ExprDoubleFunc,	NULL			},
    { "entier",	ExprEntierFunc,	NULL			},
    { "entier",	ExprIntFunc,	NULL			},
    { "exp",	ExprUnaryFunc,	(ClientData) exp	},
    { "floor",	ExprFloorFunc,	NULL			},
    { "fmod",	ExprBinaryFunc,	(ClientData) fmod	},
    { "hypot",	ExprBinaryFunc,	(ClientData) hypot	},
    { "int",	ExprIntFunc,	NULL			},
    { "isqrt",	ExprIsqrtFunc,	NULL			},
    { "log",	ExprUnaryFunc,	(ClientData) log	},
    { "log10",	ExprUnaryFunc,	(ClientData) log10	},
    { "max",	ExprMaxFunc,	NULL			},
    { "min",	ExprMinFunc,	NULL			},
    { "pow",	ExprBinaryFunc,	(ClientData) pow	},
    { "rand",	ExprRandFunc,	NULL			},
    { "round",	ExprRoundFunc,	NULL			},
    { "sin",	ExprUnaryFunc,	(ClientData) sin	},
    { "sinh",	ExprUnaryFunc,	(ClientData) sinh	},
    { "sqrt",	ExprSqrtFunc,	NULL			},
    { "srand",	ExprSrandFunc,	NULL			},
421
422
423
424
425
426
427







428
429
430
431
432
433
434
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538







+
+
+
+
+
+
+







{
    Tcl_MutexLock(&cancelLock);
    if (cancelTableInitialized == 1) {
	Tcl_DeleteHashTable(&cancelTable);
	cancelTableInitialized = 0;
    }
    Tcl_MutexUnlock(&cancelLock);

    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit) {
        Tcl_DeleteHashTable(&commandTypeTable);
        commandTypeInit = 0;
    }
    Tcl_MutexUnlock(&commandTypeLock);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --
 *
494
495
496
497
498
499
500

501
502













503
504
505
506
507
508
509
510
511
512

513
514



515
516


517
518
519
520
521
522
523
524
525
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631


632
633
634


635
636
637

638
639
640
641
642
643
644







+


+
+
+
+
+
+
+
+
+
+
+
+
+










+
-
-
+
+
+
-
-
+
+

-








    if (cancelTableInitialized == 0) {
	Tcl_MutexLock(&cancelLock);
	if (cancelTableInitialized == 0) {
	    Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
	    cancelTableInitialized = 1;
	}

	Tcl_MutexUnlock(&cancelLock);
    }

    if (commandTypeInit == 0) {
        TclRegisterCommandTypeName(TclObjInterpProc, "proc");
        TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble");
        TclRegisterCommandTypeName(TclAliasObjCmd, "alias");
        TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias");
        TclRegisterCommandTypeName(TclSlaveObjCmd, "slave");
        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
     * object type table and other object management code.
     */

    iPtr = ckalloc(sizeof(Interp));
    interp = (Tcl_Interp *) iPtr;

#ifdef TCL_NO_DEPRECATED
    iPtr->legacyResult = NULL;
    /* Special invalid value: Any attempt to free the legacy result
    iPtr->result = &tclEmptyString;
#else
    iPtr->result = iPtr->resultSpace;
     * will cause a crash. */
    iPtr->legacyFreeProc = (void (*) (void))-1;
#endif
    iPtr->freeProc = NULL;
    iPtr->errorLine = 0;
    iPtr->stubTable = &tclStubs;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;

568
569
570
571
572
573
574






575
576
577
578
579
580
581
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706







+
+
+
+
+
+







    TclNewLiteralStringObj(iPtr->ecVar, "::errorCode");
    Tcl_IncrRefCount(iPtr->ecVar);
    iPtr->returnLevel = 1;
    iPtr->returnCode = TCL_OK;

    iPtr->rootFramePtr = NULL;	/* Initialise as soon as :: is available */
    iPtr->lookupNsPtr = NULL;

#ifndef TCL_NO_DEPRECATED
    iPtr->appendResult = NULL;
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;
#endif

    Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
    iPtr->packageUnknown = NULL;

    /* TIP #268 */
#if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)
    if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
597
598
599
600
601
602
603



604
605
606
607
608
609
610
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738







+
+
+







    iPtr->activeCmdTracePtr = NULL;
    iPtr->activeInterpTracePtr = NULL;
    iPtr->assocData = NULL;
    iPtr->execEnvPtr = NULL;	/* Set after namespaces initialized. */
    iPtr->emptyObjPtr = Tcl_NewObj();
				/* Another empty object. */
    Tcl_IncrRefCount(iPtr->emptyObjPtr);
#ifndef TCL_NO_DEPRECATED
    iPtr->resultSpace[0] = 0;
#endif
    iPtr->threadId = Tcl_GetCurrentThread();

    /* TIP #378 */
#ifdef TCL_INTERP_DEBUG_FRAME
    iPtr->flags |= INTERP_DEBUG_FRAME;
#else
    if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
706
707
708
709
710
711
712






713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730

731
732
733
734
735
736
737
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863

864
865
866
867
868
869
870
871







+
+
+
+
+
+

















-
+








    statsPtr->numLiteralsCreated = 0;
    statsPtr->totalLitStringBytes = 0.0;
    statsPtr->currentLitStringBytes = 0.0;
    memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
#endif /* TCL_COMPILE_STATS */

    /*
     * Initialise the stub table pointer.
     */

    iPtr->stubTable = &tclStubs;

    /*
     * Initialize the ensemble error message rewriting support.
     */

    TclResetRewriteEnsemble(interp, 1);

    /*
     * TIP#143: Initialise the resource limit support.
     */

    TclInitLimitSupport(interp);

    /*
     * Initialise the thread-specific data ekeko. Note that the thread's alloc
     * cache was already initialised by the call to alloc the interp struct.
     */

#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;
793
794
795
796
797
798
799

800
801
802
803
804
805
806
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941







+







    TclInitDictCmd(interp);
    TclInitEncodingCmd(interp);
    TclInitFileCmd(interp);
    TclInitInfoCmd(interp);
    TclInitNamespaceCmd(interp);
    TclInitStringCmd(interp);
    TclInitPrefixCmd(interp);
    TclInitProcessCmd(interp);

    /*
     * Register "clock" subcommands. These *do* go through
     * Tcl_CreateObjCommand, since they aren't in the global namespace and
     * involve ensembles.
     */

930
931
932
933
934
935
936

937
938
939

940
941
942

943
944
945
946
947
948
949
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078

1079
1080
1081
1082
1083
1084
1085
1086







+



+


-
+








    /*
     * Set up other variables such as tcl_version and tcl_library
     */

    Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Tcl_TraceVar2(interp, "tcl_precision", NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    TclPrecTraceProc, NULL);
#endif /* !TCL_NO_DEPRECATED */
    TclpSetVariables(interp);

#ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * The existence of the "threaded" element of the tcl_platform array
     * indicates that this particular Tcl shell has been compiled with threads
     * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can
     * introspect on the interpreter level of thread safety.
     */

970
971
972
973
974
975
976



977
978
979
980
981
982
983
984
985
986
987
988
989
990

































































991
992
993
994
995
996
997
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202







+
+
+














+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







     * compile and link against.
     */

#ifdef HAVE_ZLIB
    if (TclZlibInit(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
    }
    if (TclZipfs_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
    }
#endif

    TOP_CB(iPtr) = NULL;
    return interp;
}

static void
DeleteOpCmdClientData(
    ClientData clientData)
{
    TclOpCmdClientData *occdPtr = clientData;

    ckfree(occdPtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * TclRegisterCommandTypeName, TclGetCommandTypeName --
 *
 *      Command type registration and lookup mechanism. Everything is keyed by
 *      the Tcl_ObjCmdProc for the command, and that is used as the *key* into
 *      the hash table that maps to constant strings that are names. (It is
 *      recommended that those names be ASCII.)
 *
 * ---------------------------------------------------------------------
 */

void
TclRegisterCommandTypeName(
    Tcl_ObjCmdProc *implementationProc,
    const char *nameStr)
{
    Tcl_HashEntry *hPtr;

    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit == 0) {
        Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS);
        commandTypeInit = 1;
    }
    if (nameStr != NULL) {
        int isNew;

        hPtr = Tcl_CreateHashEntry(&commandTypeTable,
                (void *) implementationProc, &isNew);
        Tcl_SetHashValue(hPtr, (void *) nameStr);
    } else {
        hPtr = Tcl_FindHashEntry(&commandTypeTable,
                (void *) implementationProc);
        if (hPtr != NULL) {
            Tcl_DeleteHashEntry(hPtr);
        }
    }
    Tcl_MutexUnlock(&commandTypeLock);
}

const char *
TclGetCommandTypeName(
    Tcl_Command command)
{
    Command *cmdPtr = (Command *) command;
    void *procPtr = cmdPtr->objProc;
    const char *name = "native";

    if (procPtr == NULL) {
        procPtr = cmdPtr->nreProc;
    }
    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit) {
        Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr);

        if (hPtr && Tcl_GetHashValue(hPtr)) {
            name = (const char *) Tcl_GetHashValue(hPtr);
        }
    }
    Tcl_MutexUnlock(&commandTypeLock);

    return name;
}

/*
 *----------------------------------------------------------------------
 *
 * TclHideUnsafeCommands --
 *
 *	Hides base commands that are not marked as safe from this interpreter.
1006
1007
1008
1009
1010
1011
1012

1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023







































1024
1025


































1026
1027
1028
1029
1030
1031
1032
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227


1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309







+









-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 */

int
TclHideUnsafeCommands(
    Tcl_Interp *interp)		/* Hide commands in this interpreter. */
{
    register const CmdInfo *cmdInfoPtr;
    register const UnsafeEnsembleInfo *unsafePtr;

    if (interp == NULL) {
	return TCL_ERROR;
    }
    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
	if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
	}
    }
    TclMakeEncodingCommandSafe(interp); /* Ugh! */
    TclMakeFileCommandSafe(interp);     /* Ugh! */

    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_GetString(Tcl_GetObjResult(interp)));
            }
            Tcl_CreateObjCommand(interp, TclGetString(cmdName),
                    BadEnsembleSubcommand, (ClientData) 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_GetString(Tcl_GetObjResult(interp)));
            }
        }
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * BadEnsembleSubcommand --
 *
 *	Command used to act as a backstop implementation when subcommands of
 *	ensembles are unsafe (the real implementations of the subcommands are
 *	hidden). The clientData is description of what was hidden.
 *
 * Results:
 *	A standard Tcl result (always a TCL_ERROR).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
BadEnsembleSubcommand(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const UnsafeEnsembleInfo *infoPtr = clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "not allowed to invoke subcommand %s of %s",
            infoPtr->commandName, infoPtr->ensembleNsName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_CallWhenDeleted --
 *
 *	Arrange for a function to be called before a given interpreter is
1501
1502
1503
1504
1505
1506
1507

1508
1509
1510
1511
1512
1513
1514
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792







+








    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */

    Tcl_FreeResult(interp);
    iPtr->result = NULL;
    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = NULL;
    Tcl_DecrRefCount(iPtr->ecVar);
    if (iPtr->errorCode) {
	Tcl_DecrRefCount(iPtr->errorCode);
	iPtr->errorCode = NULL;
    }
1522
1523
1524
1525
1526
1527
1528






1529
1530
1531
1532
1533
1534
1535
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819







+
+
+
+
+
+







    Tcl_DecrRefCount(iPtr->upLiteral);
    Tcl_DecrRefCount(iPtr->callLiteral);
    Tcl_DecrRefCount(iPtr->innerLiteral);
    Tcl_DecrRefCount(iPtr->innerContext);
    if (iPtr->returnOpts) {
	Tcl_DecrRefCount(iPtr->returnOpts);
    }
#ifndef TCL_NO_DEPRECATED
    if (iPtr->appendResult != NULL) {
	ckfree(iPtr->appendResult);
	iPtr->appendResult = NULL;
    }
#endif
    TclFreePackageInfo(iPtr);
    while (iPtr->tracePtr != NULL) {
	Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
    }
    if (iPtr->execEnvPtr != NULL) {
	TclDeleteExecEnv(iPtr->execEnvPtr);
    }
2071
2072
2073
2074
2075
2076
2077
2078

2079
2080
2081
2082
2083
2084

2085
2086
2087
2088
2089
2090
2091
2355
2356
2357
2358
2359
2360
2361

2362
2363
2364
2365
2366
2367

2368
2369
2370
2371
2372
2373
2374
2375







-
+





-
+







        } else {
	    nsPtr = iPtr->globalNsPtr;
	    tail = cmdName;
        }

        hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);

        if (isNew || deleted) {
	if (isNew || deleted) {
	    /*
	     * isNew - No conflict with existing command.
	     * deleted - We've already deleted a conflicting command
	     */
	    break;
        }
	}

	/* An existing command conflicts. Try to delete it.. */
	cmdPtr = Tcl_GetHashValue(hPtr);

	/*
	 * Be careful to preserve
	 * any existing import links so we can restore them down below. That
2218
2219
2220
2221
2222
2223
2224
2225

2226
2227

2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259





2260
2261
2262


2263
2264
2265
2266
2267
2268
2269
2270
2271
2272









2273

































2274

2275
2276

2277
2278
2279
2280
2281
2282

2283

2284



2285
2286
2287
2288
2289
2290
2291
2292





2293
2294
2295
2296
2297
2298
2299
2502
2503
2504
2505
2506
2507
2508

2509
2510
2511
2512
2513
2514

2515


2516


2517
2518
2519
2520
2521
2522

2523
2524
2525













2526
2527
2528
2529
2530
2531


2532
2533
2534









2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577

2578
2579

2580
2581
2582
2583
2584
2585

2586
2587
2588

2589
2590
2591
2592
2593
2594





2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606







-
+


+


-

-
-

-
-






-



-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+

-
+





-
+

+
-
+
+
+



-
-
-
-
-
+
+
+
+
+







				 * 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. */
    ClientData 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;
    ImportRef *oldRefPtr = NULL;
    Namespace *nsPtr;
    Command *cmdPtr;
    Tcl_HashEntry *hPtr;
    const char *tail;
    int isNew = 0, deleted = 0;
    ImportedCmdData *dataPtr;

    if (iPtr->flags & DELETED) {
	/*
	 * The interpreter is being deleted. Don't create any new commands;
	 * it's not safe to muck with the interpreter anymore.
	 */

	return (Tcl_Command) NULL;
    }

    /*
     * If the command name we seek to create already exists, we need to
     * delete that first.  That can be tricky in the presence of traces.
     * 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;
	 * otherwise, we always put it in the global 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) {
	    Namespace *dummy1, *dummy2;
    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;
	    }
        } else {
	    nsPtr = iPtr->globalNsPtr;
	    tail = cmdName;
        }
	TclGetNamespaceForQualName(interp, cmdName, NULL,
	    TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
	if ((nsPtr == NULL) || (tail == NULL)) {
	    return (Tcl_Command) NULL;
	}
    } else {
	nsPtr = iPtr->globalNsPtr;
	tail = cmdName;
    }

    return TclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
	proc, clientData, deleteProc);
}

Tcl_Command
TclCreateObjCommandInNs(
    Tcl_Interp *interp,
    const char *cmdName,	/* Name of command, without any namespace
                                 * components. */
    Tcl_Namespace *namespace,   /* The namespace to create the command in */
    Tcl_ObjCmdProc *proc,	/* Object-based function to associate with
				 * name. */
    ClientData clientData,	/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc)
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
{
    int deleted = 0, isNew = 0;
    Command *cmdPtr;
    ImportRef *oldRefPtr = NULL;
    ImportedCmdData *dataPtr;
    Tcl_HashEntry *hPtr;
    Namespace *nsPtr = (Namespace *) namespace;

    /*
     * If the command name we seek to create already exists, we need to delete
     * that first. That can be tricky in the presence of traces. 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) {
        hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);

        if (isNew || deleted) {
	if (isNew || deleted) {
	    /*
	     * isNew - No conflict with existing command.
	     * deleted - We've already deleted a conflicting command
	     */
	    break;
        }
	}

	/*
	/* An existing command conflicts. Try to delete it.. */
         * An existing command conflicts. Try to delete it.
         */

	cmdPtr = Tcl_GetHashValue(hPtr);

	/*
	 * [***] This is wrong.  See Tcl Bug a16752c252.
	 * However, this buggy behavior is kept under particular
	 * circumstances to accommodate deployed binaries of the
	 * "tclcompiler" program. http://sourceforge.net/projects/tclpro/
	 * that crash if the bug is fixed.
	 * [***] This is wrong. See Tcl Bug a16752c252. However, this buggy
	 * behavior is kept under particular circumstances to accommodate
	 * deployed binaries of the "tclcompiler" program
	 *     http://sourceforge.net/projects/tclpro/
         * that crash if the bug is fixed.
	 */

	if (cmdPtr->objProc == TclInvokeStringCommand
		&& cmdPtr->clientData == clientData
		&& cmdPtr->deleteData == clientData
		&& cmdPtr->deleteProc == deleteProc) {
	    cmdPtr->objProc = proc;
2309
2310
2311
2312
2313
2314
2315






2316



2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330



2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347

2348
2349
2350
2351
2352
2353
2354
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640

2641
2642



2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661

2662
2663
2664
2665
2666
2667
2668
2669







+
+
+
+
+
+

+
+
+








-


-
-
-
+
+
+
















-
+







	 */

	cmdPtr->refCount++;
	if (cmdPtr->importRefPtr) {
	    cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
	}

	/*
         * Make sure namespace doesn't get deallocated.
         */

	cmdPtr->nsPtr->refCount++;

	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
	nsPtr = (Namespace *) TclEnsureNamespace(interp,
                (Tcl_Namespace *) cmdPtr->nsPtr);
	TclNsDecrRefCount(cmdPtr->nsPtr);

	if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
	    oldRefPtr = cmdPtr->importRefPtr;
	    cmdPtr->importRefPtr = NULL;
	}
	TclCleanupCommandMacro(cmdPtr);
	deleted = 1;
    }

    if (!isNew) {
	/*
	 * If the deletion callback recreated the command, just throw away
	 * the new command (if we try to delete it again, we could get
	 * stuck in an infinite loop).
	 * If the deletion callback recreated the command, just throw away the
	 * new command (if we try to delete it again, we could get stuck in an
	 * infinite loop).
	 */

	ckfree(Tcl_GetHashValue(hPtr));
    }

    if (!deleted) {
	/*
	 * Command resolvers (per-interp, per-namespace) might have resolved
	 * to a command for the given namespace scope with this command not
	 * being registered with the namespace's command table. During BC
	 * compilation, the so-resolved command turns into a CmdName literal.
	 * Without invalidating a possible CmdName literal here explicitly,
	 * such literals keep being reused while pointing to overhauled
	 * commands.
	 */

	TclInvalidateCmdLiteral(interp, tail, nsPtr);
	TclInvalidateCmdLiteral(interp, cmdName, nsPtr);

	/*
	 * The list of command exported from the namespace might have changed.
	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

2378
2379
2380
2381
2382
2383
2384

2385
2386
2387
2388
2389
2390
2391
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707







+







     * all of these references to point to the new command.
     */

    if (oldRefPtr != NULL) {
	cmdPtr->importRefPtr = oldRefPtr;
	while (oldRefPtr != NULL) {
	    Command *refCmdPtr = oldRefPtr->importedCmdPtr;

	    dataPtr = refCmdPtr->objClientData;
	    dataPtr->realCmdPtr = cmdPtr;
	    oldRefPtr = oldRefPtr->nextPtr;
	}
    }

    /*
2455
2456
2457
2458
2459
2460
2461
2462

2463
2464
2465
2466
2467
2468
2469
2771
2772
2773
2774
2775
2776
2777

2778
2779
2780
2781
2782
2783
2784
2785







-
+







 *	"Wrapper" Tcl_CmdProc used to call an existing object-based
 *	Tcl_ObjCmdProc if no string-based function exists for a command. A
 *	pointer to this function is stored as the Tcl_CmdProc in a Command
 *	structure. It simply turns around and calls the object Tcl_ObjCmdProc
 *	in the Command structure.
 *
 * Results:
 *	A standard Tcl result value.
 *	A standard Tcl string result value.
 *
 * Side effects:
 *	Besides those side effects of the called Tcl_ObjCmdProc,
 *	TclInvokeObjectCommand allocates and frees storage.
 *
 *----------------------------------------------------------------------
 */
2495
2496
2497
2498
2499
2500
2501







2502
2503
2504
2505
2506
2507
2508
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831







+
+
+
+
+
+
+







    if (cmdPtr->objProc != NULL) {
	result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
    } else {
	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
		cmdPtr->objClientData, argc, objv);
    }

    /*
     * Move the interpreter's object result to the string result, then reset
     * the object result.
     */

    (void) Tcl_GetStringResult(interp);

    /*
     * Decrement the ref counts for the argument objects created above, then
     * free the objv array if malloc'ed storage was used.
     */

    for (i = 0; i < argc; i++) {
	objPtr = objv[i];
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582

2583
2584
2585





2586
2587
2588
2589
2590
2591
2592
2886
2887
2888
2889
2890
2891
2892




2893
2894
2895
2896
2897
2898
2899
2900

2901

2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915







-
-
-
-








-
+
-


+
+
+
+
+







	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't %s \"%s\": command doesn't exist",
		((newName == NULL)||(*newName == '\0'))? "delete":"rename",
		oldName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
	return TCL_ERROR;
    }
    cmdNsPtr = cmdPtr->nsPtr;
    oldFullName = Tcl_NewObj();
    Tcl_IncrRefCount(oldFullName);
    Tcl_GetCommandFullName(interp, cmd, oldFullName);

    /*
     * If the new command name is NULL or empty, delete the command. Do this
     * with Tcl_DeleteCommandFromToken, since we already have the command.
     */

    if ((newName == NULL) || (*newName == '\0')) {
	Tcl_DeleteCommandFromToken(interp, cmd);
	result = TCL_OK;
	return TCL_OK;
	goto done;
    }

    cmdNsPtr = cmdPtr->nsPtr;
    oldFullName = Tcl_NewObj();
    Tcl_IncrRefCount(oldFullName);
    Tcl_GetCommandFullName(interp, cmd, oldFullName);

    /*
     * Make sure that the destination command does not already exist. The
     * rename operation is like creating a command, so we should automatically
     * create the containing namespaces just like Tcl_CreateCommand would.
     */

    TclGetNamespaceForQualName(interp, newName, NULL,
3089
3090
3091
3092
3093
3094
3095


3096
3097
3098
3099
3100
3101
3102
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427







+
+








    cmdPtr->flags |= CMD_IS_DELETED;

    /*
     * Call trace functions for the command being deleted. Then delete its
     * traces.
     */

    cmdPtr->nsPtr->refCount++;

    if (cmdPtr->tracePtr != NULL) {
	CommandTrace *tracePtr;
	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);

	/*
	 * Now delete these traces.
3117
3118
3119
3120
3121
3122
3123

3124
3125
3126
3127
3128
3129
3130
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456







+







    /*
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough.
     */

    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
    TclNsDecrRefCount(cmdPtr->nsPtr);

    /*
     * If the command being deleted has a compile function, increment the
     * interpreter's compileEpoch to invalidate its compiled code. This makes
     * sure that we don't later try to execute old code compiled with
     * command-specific (i.e., inline) bytecodes for the now-deleted command.
     * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose
3454
3455
3456
3457
3458
3459
3460

3461
3462
3463
3464
3465
3466
3467
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794







+







 *	an instruction specific to the replaced function. In addition,
 *	redefioning a non-builtin function will force existing code to be
 *	invalidated if the number of arguments has changed.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED)
void
Tcl_CreateMathFunc(
    Tcl_Interp *interp,		/* Interpreter in which function is to be
				 * available. */
    const char *name,		/* Name of function (e.g. "sin"). */
    int numArgs,		/* Nnumber of arguments required by
				 * function. */
3504
3505
3506
3507
3508
3509
3510
3511

3512
3513
3514
3515
3516
3517
3518
3831
3832
3833
3834
3835
3836
3837

3838
3839
3840
3841
3842
3843
3844
3845







-
+







 *	Whatever the math function does.
 *
 *----------------------------------------------------------------------
 */

static int
OldMathFuncProc(
    ClientData clientData,	/* Ponter to OldMathFuncData describing the
    ClientData clientData,	/* Pointer to OldMathFuncData describing the
				 * function being called */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    Tcl_Obj *valuePtr;
    OldMathFuncData *dataPtr = clientData;
3549
3550
3551
3552
3553
3554
3555

3556
3557
3558
3559
3560
3561
3562
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890







+







	    /*
	     * We have a non-numeric argument.
	     */

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument to math function didn't have numeric value",
		    -1));
	    TclCheckBadOctal(interp, TclGetString(valuePtr));
	    ckfree(args);
	    return TCL_ERROR;
	}

	/*
	 * Copy the object's numeric value to the argument record, converting
	 * it if necessary.
3616
3617
3618
3619
3620
3621
3622
3623

3624
3625
3626
3627
3628
3629
3630
3944
3945
3946
3947
3948
3949
3950

3951
3952
3953
3954
3955
3956
3957
3958







-
+







    }

    /*
     * Return the result of the call.
     */

    if (funcResult.type == TCL_INT) {
	TclNewLongObj(valuePtr, funcResult.intValue);
	TclNewIntObj(valuePtr, funcResult.intValue);
    } else if (funcResult.type == TCL_WIDE_INT) {
	valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
    } else {
	return CheckDoubleResult(interp, funcResult.doubleValue);
    }
    Tcl_SetObjResult(interp, valuePtr);
    return TCL_OK;
3784
3785
3786
3787
3788
3789
3790

3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805

3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818


3819
3820
3821
3822
3823
3824
3825
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133

4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145


4146
4147
4148
4149
4150
4151
4152
4153
4154







+














-
+











-
-
+
+







	result = Tcl_NewObj();
    }
    Tcl_DecrRefCount(script);
    Tcl_RestoreInterpState(interp, state);

    return result;
}
#endif /* !defined(TCL_NO_DEPRECATED) */

/*
 *----------------------------------------------------------------------
 *
 * TclInterpReady --
 *
 *	Check if an interpreter is ready to eval commands or scripts, i.e., if
 *	it was not deleted and if the nesting level is not too high.
 *
 * Results:
 *	The return value is TCL_OK if it the interpreter is ready, TCL_ERROR
 *	otherwise.
 *
 * Side effects:
 *	The interpreter's result is cleared.
 *	The interpreters object and string results are cleared.
 *
 *----------------------------------------------------------------------
 */

int
TclInterpReady(
    Tcl_Interp *interp)
{
    register Interp *iPtr = (Interp *) interp;

    /*
     * Reset the interpreter's result and clear out any previous error
     * information.
     * Reset both the interpreter's string and object results and clear out
     * any previous error information.
     */

    Tcl_ResetResult(interp);

    /*
     * If the interpreter has been deleted, return an error.
     */
4391
4392
4393
4394
4395
4396
4397



4398
4399
4400


















4401
4402
4403
4404
4405
4406
4407
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757







+
+
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







TclNRRunCallbacks(
    Tcl_Interp *interp,
    int result,
    struct NRE_callback *rootPtr)
				/* All callbacks down to rootPtr not inclusive
				 * are to be run. */
{
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Interp *iPtr = (Interp *) interp;
#endif /* !defined(TCL_NO_DEPRECATED) */
    NRE_callback *callbackPtr;
    Tcl_NRPostProc *procPtr;

    /*
     * If the interpreter has a non-empty string result, the result object is
     * either empty or stale because some function set interp->result
     * directly. If so, move the string result to the result object, then
     * reset the string result.
     *
     * This only needs to be done for the first item in the list: all other
     * are for NR function calls, and those are Tcl_Obj based.
     */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    if (*(iPtr->result) != 0) {
	(void) Tcl_GetObjResult(interp);
    }
#endif /* !defined(TCL_NO_DEPRECATED) */

    /* This is the trampoline. */

    while (TOP_CB(interp) != rootPtr) {
	callbackPtr = TOP_CB(interp);
	procPtr = callbackPtr->procPtr;
	TOP_CB(interp) = callbackPtr->nextPtr;
	result = procPtr(callbackPtr->data, interp, result);
	TCLNR_FREE(interp, callbackPtr);
    }
4527
4528
4529
4530
4531
4532
4533
4534

4535
4536
4537
4538
4539
4540
4541
4877
4878
4879
4880
4881
4882
4883

4884
4885
4886
4887
4888
4889
4890
4891







-
+







    Interp *iPtr = (Interp *) interp;
    int allowExceptions = (PTR2INT(data[0]) & TCL_ALLOW_EXCEPTIONS);

    if (result != TCL_OK) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_ERROR) && !allowExceptions) {
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	}
    }

    /*
     * We are returning to level 0, so should process TclResetCancellation. As
4708
4709
4710
4711
4712
4713
4714
4715

4716
4717
4718
4719
4720
4721
4722
5058
5059
5060
5061
5062
5063
5064

5065
5066
5067
5068
5069
5070
5071
5072







-
+







    Command **cmdPtrPtr,
    Tcl_Obj *commandPtr,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int length, traceCode = TCL_OK;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the
4851
4852
4853
4854
4855
4856
4857

4858
4859
4860
4861
4862
4863
4864
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215







+







    int count)			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
	    NULL, NULL);
}

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalTokens --
 *
 *	Given an array of tokens parsed from a Tcl command (e.g., the tokens
 *	that make up a word or the index for an array variable) this function
4898
4899
4900
4901
4902
4903
4904

4905
4906
4907
4908
4909
4910
4911
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263







+







	return NULL;
    }
    resPtr = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(resPtr);
    Tcl_ResetResult(interp);
    return resPtr;
}
#endif /* !TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalEx, TclEvalEx --
 *
 *	This function evaluates a Tcl script without using the compiler or
5861
5862
5863
5864
5865
5866
5867
5868










5869
5870
5871
5872
5873
5874
5875
6213
6214
6215
6216
6217
6218
6219

6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236







-
+
+
+
+
+
+
+
+
+
+







#undef Tcl_Eval
int
Tcl_Eval(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *script)		/* Pointer to TCL command to execute. */
{
    return Tcl_EvalEx(interp, script, -1, 0);
    int code = Tcl_EvalEx(interp, script, -1, 0);

    /*
     * For backwards compatibility with old C code that predates the object
     * system in Tcl 8.0, we have to mirror the object result back into the
     * string result (some callers may expect it there).
     */

    (void) Tcl_GetStringResult(interp);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObj, Tcl_GlobalEvalObj --
 *
6284
6285
6286
6287
6288
6289
6290



6291
6292
6293
6294
6295
6296
6297
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661







+
+
+








	*ptr = 0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, -1);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprLongObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
	if (result != TCL_OK) {
	    (void) Tcl_GetStringResult(interp);
	}
    }
    return result;
}

int
Tcl_ExprDouble(
    Tcl_Interp *interp,		/* Context in which to evaluate the
6310
6311
6312
6313
6314
6315
6316



6317
6318
6319
6320
6321
6322
6323
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690







+
+
+







	*ptr = 0.0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, -1);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
				/* Discard the expression object. */
	if (result != TCL_OK) {
	    (void) Tcl_GetStringResult(interp);
	}
    }
    return result;
}

int
Tcl_ExprBoolean(
    Tcl_Interp *interp,		/* Context in which to evaluate the
6335
6336
6337
6338
6339
6340
6341








6342
6343
6344
6345
6346
6347
6348
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723







+
+
+
+
+
+
+
+







    } else {
	int result;
	Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1);

	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
	if (result != TCL_OK) {
	    /*
	     * Move the interpreter's object result to the string result, then
	     * reset the object result.
	     */

	    (void) Tcl_GetStringResult(interp);
	}
	return result;
    }
}

/*
 *--------------------------------------------------------------
 *
6393
6394
6395
6396
6397
6398
6399
6400

6401
6402
6403
6404
6405
6406
6407
6408
6768
6769
6770
6771
6772
6773
6774

6775

6776
6777
6778
6779
6780
6781
6782







-
+
-







	Tcl_DecrRefCount(resultPtr);
	if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
	    return TCL_ERROR;
	}
	resultPtr = Tcl_NewBignumObj(&big);
	/* FALLTHROUGH */
    }
    case TCL_NUMBER_LONG:
    case TCL_NUMBER_INT:
    case TCL_NUMBER_WIDE:
    case TCL_NUMBER_BIG:
	result = TclGetLongFromObj(interp, resultPtr, ptr);
	break;

    case TCL_NUMBER_NAN:
	Tcl_GetDoubleFromObj(interp, resultPtr, &d);
	result = TCL_ERROR;
6649
6650
6651
6652
6653
6654
6655






6656
6657
6658
6659
6660
6661
6662
7023
7024
7025
7026
7027
7028
7029
7030
7031
7032
7033
7034
7035
7036
7037
7038
7039
7040
7041
7042







+
+
+
+
+
+







	code = Tcl_ExprObj(interp, exprObj, &resultPtr);
	Tcl_DecrRefCount(exprObj);
	if (code == TCL_OK) {
	    Tcl_SetObjResult(interp, resultPtr);
	    Tcl_DecrRefCount(resultPtr);
	}
    }

    /*
     * Force the string rep of the interp result.
     */

    (void) Tcl_GetStringResult(interp);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendObjToErrorInfo --
6755
6756
6757
6758
6759
6760
6761













6762

6763
6764
6765
6766
6767
6768
6769
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149
7150
7151
7152
7153
7154

7155
7156
7157
7158
7159
7160
7161
7162







+
+
+
+
+
+
+
+
+
+
+
+
+
-
+







    /*
     * If we are just starting to log an error, errorInfo is initialized from
     * the error message in the interpreter's result.
     */

    iPtr->flags |= ERR_LEGACY_COPY;
    if (iPtr->errorInfo == NULL) {
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	if (*(iPtr->result) != 0) {
	    /*
	     * The interp's string result is set, apparently by some extension
	     * making a deprecated direct write to it. That extension may
	     * expect interp->result to continue to be set, so we'll take
	     * special pains to avoid clearing it, until we drop support for
	     * interp->result completely.
	     */

	    iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
	} else
#endif /* !defined(TCL_NO_DEPRECATED) */
        iPtr->errorInfo = iPtr->objResultPtr;
	    iPtr->errorInfo = iPtr->objResultPtr;
	Tcl_IncrRefCount(iPtr->errorInfo);
	if (!iPtr->errorCode) {
	    Tcl_SetErrorCode(interp, "NONE", NULL);
	}
    }

    /*
6833
6834
6835
6836
6837
6838
6839
6840

6841
6842
6843
6844
6845
6846
6847
7226
7227
7228
7229
7230
7231
7232

7233
7234
7235
7236
7237
7238
7239
7240







-
+







 * Tcl_VarEval --
 *
 *	Given a variable number of string arguments, concatenate them all
 *	together and execute the result as a Tcl command.
 *
 * Results:
 *	A standard Tcl return result. An error message or other result may be
 *	left in the interp.
 *	left in interp->result.
 *
 * Side effects:
 *	Depends on what was done by the command.
 *
 *----------------------------------------------------------------------
 */
	/* ARGSUSED */
7351
7352
7353
7354
7355
7356
7357
7358
7359


7360
7361

7362
7363

7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376


7377
7378
7379

7380
7381
7382
7383
7384
7385
7386
7744
7745
7746
7747
7748
7749
7750


7751
7752
7753

7754
7755

7756
7757
7758
7759
7760
7761
7762
7763
7764
7765
7766
7767


7768
7769
7770
7771

7772
7773
7774
7775
7776
7777
7778
7779







-
-
+
+

-
+

-
+











-
-
+
+


-
+







	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_LONG) {
	long l = *((const long *) ptr);
    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > (long)0) {
	if (l > (Tcl_WideInt)0) {
	    goto unChanged;
	} else if (l == (long)0) {
	} else if (l == (Tcl_WideInt)0) {
	    const char *string = objv[1]->bytes;
	    if (string) {
		while (*string != '0') {
		    if (*string == '-') {
			Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
			return TCL_OK;
		    }
		    string++;
		}
	    }
	    goto unChanged;
	} else if (l == LONG_MIN) {
	    TclInitBignumFromLong(&big, l);
	} else if (l == WIDE_MIN) {
	    TclInitBignumFromWideInt(&big, l);
	    goto tooLarge;
	}
	Tcl_SetObjResult(interp, Tcl_NewLongObj(-l));
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
	return TCL_OK;
    }

    if (type == TCL_NUMBER_DOUBLE) {
	double d = *((const double *) ptr);
	static const double poszero = 0.0;

7396
7397
7398
7399
7400
7401
7402
7403
7404
7405
7406
7407
7408
7409
7410
7411
7412
7413
7414
7415
7416
7417
7418
7419
7420

7421
7422
7423
7424
7425
7426
7427
7789
7790
7791
7792
7793
7794
7795
















7796

7797
7798
7799
7800
7801
7802
7803
7804







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+







	} else if (d > -0.0) {
	    goto unChanged;
	}
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
	return TCL_OK;
    }

#ifndef TCL_WIDE_INT_IS_LONG
    if (type == TCL_NUMBER_WIDE) {
	Tcl_WideInt w = *((const Tcl_WideInt *) ptr);

	if (w >= (Tcl_WideInt)0) {
	    goto unChanged;
	}
	if (w == LLONG_MIN) {
	    TclInitBignumFromWideInt(&big, w);
	    goto tooLarge;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w));
	return TCL_OK;
    }
#endif

    if (type == TCL_NUMBER_BIG) {
	if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) {
	if (mp_isneg((const mp_int *) ptr)) {
	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
	tooLarge:
	    mp_neg(&big, &big);
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	} else {
	unChanged:
	    Tcl_SetObjResult(interp, objv[1]);
7488
7489
7490
7491
7492
7493
7494
7495

7496
7497
7498
7499
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511
7512
7513
7514
7515
7516

7517
7518
7519
7520
7521
7522
7523
7524
7525
7526

7527
7528

7529
7530
7531
7532
7533
7534
7535
7865
7866
7867
7868
7869
7870
7871

7872
7873
7874
7875
7876
7877
7878
7879
7880
7881
7882
7883
7884
7885
7886
7887
7888
7889
7890
7891
7892

7893
7894
7895
7896
7897
7898
7899
7900
7901
7902

7903
7904

7905
7906
7907
7908
7909
7910
7911
7912







-
+




















-
+









-
+

-
+







	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
    return TCL_OK;
}

static int
ExprEntierFunc(
ExprIntFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    double d;
    int type;
    ClientData ptr;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_DOUBLE) {
	d = *((const double *) ptr);
	if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
	if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) {
	    mp_int big;

	    if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
		/* Infinity */
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	    return TCL_OK;
	} else {
	    long result = (long) d;
	    Tcl_WideInt result = (Tcl_WideInt) d;

	    Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
	    return TCL_OK;
	}
    }

    if (type != TCL_NUMBER_NAN) {
	/*
	 * All integers are already of integer type.
7543
7544
7545
7546
7547
7548
7549
7550
7551
7552
7553
7554
7555
7556
7557
7558
7559
7560
7561
7562
7563
7564
7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591
7592
7593

7594
7595
7596

7597
7598
7599
7600
7601
7602
7603
7604
7605
7606
7607
7608
7609
7610
7611
7612
7613

































































7614
7615
7616
7617
7618
7619
7620
7920
7921
7922
7923
7924
7925
7926
































7927
7928
7929
7930
7931
7932
7933
7934
7935

7936

7937
7938
7939

7940














7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962
7963
7964
7965
7966
7967
7968
7969
7970
7971
7972
7973
7974
7975
7976
7977
7978
7979
7980
7981
7982
7983
7984
7985
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
7997
7998
7999
8000
8001
8002
8003
8004
8005
8006
8007
8008
8009
8010
8011
8012
8013
8014
8015







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-

-
+


-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







     * Get the error message for NaN.
     */

    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

static int
ExprIntFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    long iResult;
    Tcl_Obj *objPtr;
    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }
    objPtr = Tcl_GetObjResult(interp);
    if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) {
	/*
	 * Truncate the bignum; keep only bits in long range.
	 */

	mp_int big;

	Tcl_GetBignumFromObj(NULL, objPtr, &big);
	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
	objPtr = Tcl_NewBignumObj(&big);
	Tcl_IncrRefCount(objPtr);
	TclGetLongFromObj(NULL, objPtr, &iResult);
	Tcl_DecrRefCount(objPtr);
    }
    Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
    return TCL_OK;
}

static int
ExprWideFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    Tcl_WideInt wResult;
    Tcl_Obj *objPtr;

    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
    if (ExprIntFunc(NULL, interp, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }
    objPtr = Tcl_GetObjResult(interp);
    TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult);
    if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
	/*
	 * Truncate the bignum; keep only bits in wide int range.
	 */

	mp_int big;

	Tcl_GetBignumFromObj(NULL, objPtr, &big);
	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
	objPtr = Tcl_NewBignumObj(&big);
	Tcl_IncrRefCount(objPtr);
	TclGetWideIntFromObj(NULL, objPtr, &wResult);
	Tcl_DecrRefCount(objPtr);
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
    return TCL_OK;
}

/*
 * Common implmentation of max() and min().
 */
static int
ExprMaxMinFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv,	/* Actual parameter vector. */
    int op)			/* Comparison direction */
{
    Tcl_Obj *res;
    double d;
    int type, i;
    ClientData ptr;

    if (objc < 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    res = objv[1];
    for (i = 1; i < objc; i++) {
        if (TclGetNumberFromObj(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;
}

static int
ExprMaxFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    return ExprMaxMinFunc(clientData, interp, objc, objv, MP_GT);
}

static int
ExprMinFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    return ExprMaxMinFunc(clientData, interp, objc, objv, MP_LT);
}

static int
ExprRandFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
7631
7632
7633
7634
7635
7636
7637
7638

7639
7640
7641
7642
7643
7644
7645
7646
7647
7648

7649
7650
7651
7652
7653
7654
7655
8026
8027
8028
8029
8030
8031
8032

8033
8034
8035
8036
8037
8038
8039
8040
8041
8042

8043
8044
8045
8046
8047
8048
8049
8050







-
+









-
+







	return TCL_ERROR;
    }

    if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
	iPtr->flags |= RAND_SEED_INITIALIZED;

	/*
	 * To ensure different seeds in different threads (bug #416643), 
	 * To ensure different seeds in different threads (bug #416643),
	 * take into consideration the thread this interp is running in.
	 */

	iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);

	/*
	 * Make sure 1 <= randSeed <= (2^31) - 2. See below.
	 */

	iPtr->randSeed &= (unsigned long) 0x7fffffff;
	iPtr->randSeed &= 0x7fffffff;
	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
	    iPtr->randSeed ^= 123459876;
	}
    }

    /*
     * Generate the random number using the linear congruential generator
7785
7786
7787
7788
7789
7790
7791
7792

7793
7794
7795
7796
7797
7798
7799
7800
7801
7802
7803

7804
7805
7806
7807
7808
7809

7810
7811
7812
7813
7814
7815
7816
7817
7818
7819
7820
7821
7822
7823
7824
7825

7826
7827
7828
7829
7830
7831
7832
7833
8180
8181
8182
8183
8184
8185
8186

8187
8188
8189
8190
8191
8192
8193
8194
8195
8196
8197

8198






8199







8200
8201
8202
8203
8204
8205
8206
8207

8208

8209
8210
8211
8212
8213
8214
8215







-
+










-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-








-
+
-







    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    Interp *iPtr = (Interp *) interp;
    long i = 0;			/* Initialized to avoid compiler warning. */
    Tcl_WideInt w = 0;			/* Initialized to avoid compiler warning. */

    /*
     * Convert argument and use it to reset the seed.
     */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) {
    if (TclGetWideBitsFromObj(NULL, objv[1], &w) != TCL_OK) {
	Tcl_Obj *objPtr;
	mp_int big;

	if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
	    /* TODO: more ::errorInfo here? or in caller? */
	    return TCL_ERROR;
	return TCL_ERROR;
	}

	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
	objPtr = Tcl_NewBignumObj(&big);
	Tcl_IncrRefCount(objPtr);
	TclGetLongFromObj(NULL, objPtr, &i);
	Tcl_DecrRefCount(objPtr);
    }

    /*
     * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in
     * ExprRandFunc for more details.
     */

    iPtr->flags |= RAND_SEED_INITIALIZED;
    iPtr->randSeed = i;
    iPtr->randSeed = (long) w & 0x7fffffff;
    iPtr->randSeed &= (unsigned long) 0x7fffffff;
    if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
	iPtr->randSeed ^= 123459876;
    }

    /*
     * To avoid duplicating the random number generation code we simply clean
     * up our state and call the real random number function. That function
8091
8092
8093
8094
8095
8096
8097
8098




















8099
8100
8101
8102
8103
8104
8105
8473
8474
8475
8476
8477
8478
8479

8480
8481
8482
8483
8484
8485
8486
8487
8488
8489
8490
8491
8492
8493
8494
8495
8496
8497
8498
8499
8500
8501
8502
8503
8504
8505
8506







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    ClientData 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);
	    Tcl_CreateObjCommand(interp, cmdName, proc, clientData,
                    deleteProc);

    cmdPtr->nreProc = nreProc;
    return (Tcl_Command) cmdPtr;
}

Tcl_Command
TclNRCreateCommandInNs(
    Tcl_Interp *interp,
    const char *cmdName,
    Tcl_Namespace *nsPtr,
    Tcl_ObjCmdProc *proc,
    Tcl_ObjCmdProc *nreProc,
    ClientData clientData,
    Tcl_CmdDeleteProc *deleteProc)
{
    Command *cmdPtr = (Command *)
            TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData,
                    deleteProc);

    cmdPtr->nreProc = nreProc;
    return (Tcl_Command) cmdPtr;
}

/****************************************************************************
 * Stuff for the public api
8195
8196
8197
8198
8199
8200
8201
8202
8203
8204
8205
8206
8207
8208
8209
8596
8597
8598
8599
8600
8601
8602

8603
8604
8605
8606
8607
8608
8609







-







void
TclPushTailcallPoint(
    Tcl_Interp *interp)
{
    TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
    ((Interp *) interp)->numLevels++;
}


/*
 *----------------------------------------------------------------------
 *
 * TclSetTailcall --
 *
 *	Splice a tailcall command in the proper spot of the NRE callback
8231
8232
8233
8234
8235
8236
8237
8238
8239
8240
8241
8242
8243
8244
8245
8631
8632
8633
8634
8635
8636
8637

8638
8639
8640
8641
8642
8643
8644







-







        }
    }
    if (!runPtr) {
        Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
    }
    runPtr->data[1] = listPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * TclNRTailcallObjCmd --
 *
 *	Prepare the tailcall as a list and store it in the current
8289
8290
8291
8292
8293
8294
8295
8296
8297
8298
8299
8300
8301
8302
8303
8304
8305

8306
8307
8308
8309
8310
8311
8312
8313
8314
8315
8316
8317
8318
8319
8320
8321
8688
8689
8690
8691
8692
8693
8694

8695
8696
8697
8698


8699


8700


8701
8702
8703
8704
8705
8706

8707
8708
8709
8710
8711
8712
8713







-




-
-

-
-
+
-
-






-







     * 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;
        Tcl_Namespace *ns1Ptr;

        /* The tailcall data is in a Tcl list: the first element is the
         * namespace, the rest the command to be tailcalled. */

        listPtr = Tcl_NewListObj(objc, objv);

        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
        if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
                || (nsPtr != ns1Ptr)) {
        listPtr = Tcl_NewListObj(objc, objv);
            Tcl_Panic("Tailcall failed to find the proper namespace");
        }
 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

        iPtr->varFramePtr->tailcallPtr = listPtr;
    }
    return TCL_RETURN;
}


/*
 *----------------------------------------------------------------------
 *
 * TclNRTailcallEval --
 *
 *	This NREcallback actually causes the tailcall to be evaluated.
8375
8376
8377
8378
8379
8380
8381
8382
8383
8384
8385
8386
8387
8388
8389
8767
8768
8769
8770
8771
8772
8773

8774
8775
8776
8777
8778
8779
8780







-







	} else {
	    break;
	}
	i++;
    }
    return result;
}


void
Tcl_NRAddCallback(
    Tcl_Interp *interp,
    Tcl_NRPostProc *postProcPtr,
    ClientData data0,
    ClientData data1,
8881
8882
8883
8884
8885
8886
8887
8888
8889
8890



8891
8892
8893
8894
8895
8896
8897
8898
8899
8900
8901
8902
8903
8904
8905



8906
8907
8908
8909
8910

8911
8912
8913
8914

8915
8916
8917

8918
8919
8920
8921
8922
8923
8924
8925
8926
8927
8928
8929
8930
8931
8932
8933
8934
8935
8936
8937
8938
8939
8940
8941
8942
8943
8944
8945


8946

8947
8948
8949
8950
8951
8952
8953
9272
9273
9274
9275
9276
9277
9278



9279
9280
9281
9282
9283
9284
9285
9286
9287
9288








9289
9290
9291
9292
9293
9294
9295

9296
9297
9298
9299

9300
9301
9302

9303








9304
9305
9306
9307
9308
9309
9310
9311
9312
9313
9314









9315
9316

9317
9318
9319
9320
9321
9322
9323
9324







-
-
-
+
+
+







-
-
-
-
-
-
-
-
+
+
+




-
+



-
+


-
+
-
-
-
-
-
-
-
-











-
-
-
-
-
-
-
-
-
+
+
-
+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Command *cmdPtr;
    CoroutineData *corPtr;
    const char *fullName, *procName;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
    Tcl_DString ds;
    const char *procName, *simpleName;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr,
	*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
    Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * FIXME: this is copy/pasted from Tcl_ProcObjCommand. Should have
     * something in tclUtil.c to find the FQ name.
     */

    fullName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
    procName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, procName, inNsPtr, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't create procedure \"%s\": unknown namespace",
                fullName));
                procName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
	return TCL_ERROR;
    }
    if (procName == NULL) {
    if (simpleName == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't create procedure \"%s\": bad procedure name",
                fullName));
                procName));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
	return TCL_ERROR;
    }
    if ((nsPtr != iPtr->globalNsPtr)
	    && (procName != NULL) && (procName[0] == ':')) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't create procedure \"%s\" in non-global namespace with"
                " name starting with \":\"", procName));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
	return TCL_ERROR;
    }

    /*
     * We ARE creating the coroutine command: allocate the corresponding
     * struct and create the corresponding command.
     */

    corPtr = ckalloc(sizeof(CoroutineData));

    Tcl_DStringInit(&ds);
    if (nsPtr != iPtr->globalNsPtr) {
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	TclDStringAppendLiteral(&ds, "::");
    }
    Tcl_DStringAppend(&ds, procName, -1);

    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
	    /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine);
    cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
	    (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
    Tcl_DStringFree(&ds);
	    corPtr, DeleteCoroutine);

    corPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;

    /*
     * #280.
     * Provide the new coroutine with its own copy of the lineLABCPtr

Changes to generic/tclBinary.c.

1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1959
1960
1961
1962
1963
1964
1965

1966
1967
1968
1969
1970
1971
1972







-







FormatNumber(
    Tcl_Interp *interp,		/* Current interpreter, used to report
				 * errors. */
    int type,			/* Type of number to format. */
    Tcl_Obj *src,		/* Number to format. */
    unsigned char **cursorPtr)	/* Pointer to index into destination buffer. */
{
    long value;
    double dvalue;
    Tcl_WideInt wvalue;
    float fvalue;

    switch (type) {
    case 'd':
    case 'q':
2021
2022
2023
2024
2025
2026
2027
2028

2029
2030
2031
2032
2033
2034
2035
2020
2021
2022
2023
2024
2025
2026

2027
2028
2029
2030
2031
2032
2033
2034







-
+








	/*
	 * 64-bit integer values.
	 */
    case 'w':
    case 'W':
    case 'm':
	if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
2051
2052
2053
2054
2055
2056
2057
2058

2059
2060
2061
2062
2063
2064
2065




2066
2067
2068
2069
2070




2071
2072
2073
2074
2075
2076
2077
2078
2079
2080

2081
2082
2083
2084
2085


2086
2087
2088


2089
2090
2091
2092
2093
2094
2095
2096

2097
2098
2099

2100
2101
2102
2103
2104
2105
2106
2050
2051
2052
2053
2054
2055
2056

2057
2058
2059
2060




2061
2062
2063
2064
2065




2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078

2079
2080
2081
2082


2083
2084
2085


2086
2087
2088
2089
2090
2091
2092
2093
2094

2095
2096
2097

2098
2099
2100
2101
2102
2103
2104
2105







-
+



-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+









-
+



-
-
+
+

-
-
+
+







-
+


-
+








	/*
	 * 32-bit integer values.
	 */
    case 'i':
    case 'I':
    case 'n':
	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(value);
	    *(*cursorPtr)++ = UCHAR(value >> 8);
	    *(*cursorPtr)++ = UCHAR(value >> 16);
	    *(*cursorPtr)++ = UCHAR(value >> 24);
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
	} else {
	    *(*cursorPtr)++ = UCHAR(value >> 24);
	    *(*cursorPtr)++ = UCHAR(value >> 16);
	    *(*cursorPtr)++ = UCHAR(value >> 8);
	    *(*cursorPtr)++ = UCHAR(value);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue);
	}
	return TCL_OK;

	/*
	 * 16-bit integer values.
	 */
    case 's':
    case 'S':
    case 't':
	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(value);
	    *(*cursorPtr)++ = UCHAR(value >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	} else {
	    *(*cursorPtr)++ = UCHAR(value >> 8);
	    *(*cursorPtr)++ = UCHAR(value);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue);
	}
	return TCL_OK;

	/*
	 * 8-bit integer values.
	 */
    case 'c':
	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	    return TCL_ERROR;
	}
	*(*cursorPtr)++ = UCHAR(value);
	*(*cursorPtr)++ = UCHAR(wvalue);
	return TCL_OK;

    default:
	Tcl_Panic("unexpected fallthrough");
	return TCL_ERROR;
    }
}
2480
2481
2482
2483
2484
2485
2486
2487
2488


2489
2490
2491
2492
2493
2494
2495
2479
2480
2481
2482
2483
2484
2485


2486
2487
2488
2489
2490
2491
2492
2493
2494







-
-
+
+







	for (i=0 ; i<2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit((int) c)) {
		if (strict || !isspace(c)) {
	    if (!isxdigit(UCHAR(c))) {
		if (strict || !TclIsSpaceProc(c)) {
		    goto badChar;
		}
		i--;
		continue;
	    }

	    value <<= 4;
2828
2829
2830
2831
2832
2833
2834
2835

2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853

2854
2855
2856
2857
2858
2859
2860
2827
2828
2829
2830
2831
2832
2833

2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851

2852
2853
2854
2855
2856
2857
2858
2859







-
+

















-
+








    while (data < dataend) {
	char d[4] = {0, 0, 0, 0};

	if (lineLen < 0) {
	    c = *data++;
	    if (c < 32 || c > 96) {
		if (strict || !isspace(c)) {
		if (strict || !TclIsSpaceProc(c)) {
		    goto badUu;
		}
		i--;
		continue;
	    }
	    lineLen = (c - 32) & 0x3f;
	}

	/*
	 * Now we read a four-character grouping.
	 */

	for (i=0 ; i<4 ; i++) {
	    if (data < dataend) {
		d[i] = c = *data++;
		if (c < 32 || c > 96) {
		    if (strict) {
			if (!isspace(c)) {
			if (!TclIsSpaceProc(c)) {
			    goto badUu;
			} else if (c == '\n') {
			    goto shortUu;
			}
		    }
		    i--;
		    continue;
2890
2891
2892
2893
2894
2895
2896
2897

2898
2899
2900
2901
2902
2903
2904
2889
2890
2891
2892
2893
2894
2895

2896
2897
2898
2899
2900
2901
2902
2903







-
+







	    do {
		c = *data++;
		if (c == '\n') {
		    break;
		} else if (c >= 32 && c <= 96) {
		    data--;
		    break;
		} else if (strict || !isspace(c)) {
		} else if (strict || !TclIsSpaceProc(c)) {
		    goto badUu;
		}
	    } while (data < dataend);
	}
    }

    /*
3015
3016
3017
3018
3019
3020
3021
3022

3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040

3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061

3062
3063
3064
3065
3066
3067
3068
3014
3015
3016
3017
3018
3019
3020

3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038

3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059

3060
3061
3062
3063
3064
3065
3066
3067







-
+

















-
+




















-
+







	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		     value <<= 6;
		     cut++;
		} else if (!strict && isspace(c)) {
		} else if (!strict && TclIsSpaceProc(c)) {
		     i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3f);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=') {
		value <<= 6;
		cut++;
	    } else if (strict || !isspace(c)) {
	    } else if (strict || !TclIsSpaceProc(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);
	*cursor++ = UCHAR((value >> 8) & 0xff);
	*cursor++ = UCHAR(value & 0xff);

	/*
	 * Since = is only valid within the final block, if it was encountered
	 * but there are still more input characters, confirm that strict mode
	 * is off and all subsequent characters are whitespace.
	 */

	if (cut && data < dataend) {
	    if (strict) {
		goto bad64;
	    }
	    for (; data < dataend; data++) {
		if (!isspace(*data)) {
		if (!TclIsSpaceProc(*data)) {
		    goto bad64;
		}
	    }
	}
    }
    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
    Tcl_SetObjResult(interp, resultObj);

Changes to generic/tclCkalloc.c.

152
153
154
155
156
157
158
159

160
161
162
163
164
165
166
152
153
154
155
156
157
158

159
160
161
162
163
164
165
166







-
+








void
TclInitDbCkalloc(void)
{
    if (!ckallocInit) {
	ckallocInit = 1;
	ckallocMutexPtr = Tcl_GetAllocMutex();
#ifndef TCL_THREADS
#if !TCL_THREADS
	/* Silence compiler warning */
	(void)ckallocMutexPtr;
#endif
    }
}

/*
183
184
185
186
187
188
189
190

191
192

193
194
195
196

197
198

199
200
201
202
203
204
205
183
184
185
186
187
188
189

190
191

192
193
194
195

196
197

198
199
200
201
202
203
204
205







-
+

-
+



-
+

-
+







    if (clientData == NULL) {
        return 0;
    }
    sprintf(buf,
	    "total mallocs             %10u\n"
	    "total frees               %10u\n"
	    "current packets allocated %10u\n"
	    "current bytes allocated   %10" TCL_LL_MODIFIER "u\n"
	    "current bytes allocated   %10" TCL_Z_MODIFIER "u\n"
	    "maximum packets allocated %10u\n"
	    "maximum bytes allocated   %10" TCL_LL_MODIFIER "u\n",
	    "maximum bytes allocated   %10" TCL_Z_MODIFIER "u\n",
	    total_mallocs,
	    total_frees,
	    current_malloc_packets,
	    (Tcl_WideInt)current_bytes_malloced,
	    current_bytes_malloced,
	    maximum_malloc_packets,
	    (Tcl_WideInt)maximum_bytes_malloced);
	    maximum_bytes_malloced);
    if (flags == 0) {
	fprintf((FILE *)clientData, "%s", buf);
    } else {
	/* Assume objPtr to append to */
	Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1);
    }
    return 1;
250
251
252
253
254
255
256
257

258
259
260
261
262
263
264
250
251
252
253
254
255
256

257
258
259
260
261
262
263
264







-
+







	}
    }
    if (guard_failed) {
	TclDumpMemoryInfo((ClientData) stderr, 0);
	fprintf(stderr, "low guard failed at %p, %s %d\n",
		memHeaderP->body, file, line);
	fflush(stderr);			/* In case name pointer is bad. */
	fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n", (Tcl_WideInt) memHeaderP->length,
	fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length,
		memHeaderP->file, memHeaderP->line);
	Tcl_Panic("Memory validation failure");
    }

    hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
    for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) {
	byte = *(hiPtr + idx);
272
273
274
275
276
277
278
279
280


281
282
283
284
285
286
287
272
273
274
275
276
277
278


279
280
281
282
283
284
285
286
287







-
-
+
+







    }

    if (guard_failed) {
	TclDumpMemoryInfo((ClientData) stderr, 0);
	fprintf(stderr, "high guard failed at %p, %s %d\n",
		memHeaderP->body, file, line);
	fflush(stderr);			/* In case name pointer is bad. */
	fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n",
		(Tcl_WideInt)memHeaderP->length, memHeaderP->file,
	fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n",
		memHeaderP->length, memHeaderP->file,
		memHeaderP->line);
	Tcl_Panic("Memory validation failure");
    }

    if (nukeGuards) {
	memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
	memset(hiPtr, 0, HIGH_GUARD_SIZE);
355
356
357
358
359
360
361
362

363
364

365
366
367
368
369
370
371
355
356
357
358
359
360
361

362
363

364
365
366
367
368
369
370
371







-
+

-
+







	    return TCL_ERROR;
	}
    }

    Tcl_MutexLock(ckallocMutexPtr);
    for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
	address = &memScanP->body[0];
	fprintf(fileP, "%p - %p  %" TCL_LL_MODIFIER "d @ %s %d %s",
	fprintf(fileP, "%p - %p  %" TCL_Z_MODIFIER "u @ %s %d %s",
		address, address + memScanP->length - 1,
		(Tcl_WideInt)memScanP->length, memScanP->file, memScanP->line,
		memScanP->length, memScanP->file, memScanP->line,
		(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
	(void) fputc('\n', fileP);
    }
    Tcl_MutexUnlock(ckallocMutexPtr);

    if (fileP != stderr) {
	fclose(fileP);
607
608
609
610
611
612
613
614
615


616
617
618
619
620
621
622
607
608
609
610
611
612
613


614
615
616
617
618
619
620
621
622







-
-
+
+







     * such as Crays (will subtract only bytes, even though BODY_OFFSET is in
     * words on these machines).
     */

    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    if (alloc_tracing) {
	fprintf(stderr, "ckfree %p %" TCL_LL_MODIFIER "d %s %d\n",
		memp->body, (Tcl_WideInt) memp->length, file, line);
	fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n",
		memp->body, memp->length, file, line);
    }

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

    Tcl_MutexLock(ckallocMutexPtr);
855
856
857
858
859
860
861
862

863
864
865

866
867

868
869
870
871
872
873
874
855
856
857
858
859
860
861

862
863
864

865
866

867
868
869
870
871
872
873
874







-
+


-
+

-
+







	    return TCL_ERROR;
	}
	break_on_malloc = (unsigned int) value;
	return TCL_OK;
    }
    if (strcmp(argv[1],"info") == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_LL_MODIFIER"d\n%-25s %10u\n%-25s %10" TCL_LL_MODIFIER "d\n",
		"%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n",
		"total mallocs", total_mallocs, "total frees", total_frees,
		"current packets allocated", current_malloc_packets,
		"current bytes allocated", (Tcl_WideInt)current_bytes_malloced,
		"current bytes allocated", current_bytes_malloced,
		"maximum packets allocated", maximum_malloc_packets,
		"maximum bytes allocated", (Tcl_WideInt)maximum_bytes_malloced));
		"maximum bytes allocated", maximum_bytes_malloced));
	return TCL_OK;
    }
    if (strcmp(argv[1], "init") == 0) {
	if (argc != 3) {
	    goto bad_suboption;
	}
	init_malloced_bodies = (strcmp(argv[2],"on") == 0);

Changes to generic/tclCmdAH.c.

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
42
43
44
45
46
47
48



49
50
51
52
53
54
55







-
-
-








/*
 * Prototypes for local procedures defined in this file:
 */

static int		CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    int mode);
static int		BadEncodingSubcommand(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		EncodingConvertfromObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		EncodingConverttoObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		EncodingDirsObjCmd(ClientData dummy,
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
77
78
79
80
81
82
83

84
85
86
87
88
89
90







-







static Tcl_NRPostProc	ForSetupCallback;
static Tcl_NRPostProc	ForCondCallback;
static Tcl_NRPostProc	ForNextCallback;
static Tcl_NRPostProc	ForPostNextCallback;
static Tcl_NRPostProc	ForeachLoopStep;
static Tcl_NRPostProc	EvalCmdErrMsg;

static Tcl_ObjCmdProc	BadFileSubcommand;
static Tcl_ObjCmdProc FileAttrAccessTimeCmd;
static Tcl_ObjCmdProc FileAttrIsDirectoryCmd;
static Tcl_ObjCmdProc FileAttrIsExecutableCmd;
static Tcl_ObjCmdProc FileAttrIsExistingCmd;
static Tcl_ObjCmdProc FileAttrIsFileCmd;
static Tcl_ObjCmdProc FileAttrIsOwnedCmd;
static Tcl_ObjCmdProc FileAttrIsReadableCmd;
160
161
162
163
164
165
166
167

168
169
170
171
172
173
174
156
157
158
159
160
161
162

163
164
165
166
167
168
169
170







-
+







 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	/* ARGSUSED */
int
Tcl_CaseObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
504
505
506
507
508
509
510

























































511
512
513
514
515
516
517







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    return TCL_CONTINUE;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EncodingObjCmd --
 *
 *	This command manipulates encodings.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_EncodingObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index;

    static const char *const optionStrings[] = {
	"convertfrom", "convertto", "dirs", "names", "system",
	NULL
    };
    enum options {
	ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum options) index) {
    case ENC_CONVERTTO:
	return EncodingConverttoObjCmd(dummy, interp, objc, objv);
    case ENC_CONVERTFROM:
	return EncodingConvertfromObjCmd(dummy, interp, objc, objv);
    case ENC_DIRS:
	return EncodingDirsObjCmd(dummy, interp, objc, objv);
    case ENC_NAMES:
	return EncodingNamesObjCmd(dummy, interp, objc, objv);
    case ENC_SYSTEM:
	return EncodingSystemObjCmd(dummy, interp, objc, objv);
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * TclInitEncodingCmd --
 *
 *	This function creates the 'encoding' ensemble.
589
590
591
592
593
594
595
596

597
598

599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
528
529
530
531
532
533
534

535
536

537
538
539
540
541
542











































































































543
544
545
546
547
548
549







-
+

-
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







Tcl_Command
TclInitEncodingCmd(
    Tcl_Interp* interp)		/* Tcl interpreter */
{
    static const EnsembleImplMap encodingImplMap[] = {
	{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"convertto",   EncodingConverttoObjCmd,   TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"names",       EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},
	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{NULL,          NULL,                      NULL,                      NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "encoding", encodingImplMap);
}

/*
 *-----------------------------------------------------------------------------
 *
 * TclMakeEncodingCommandSafe --
 *
 *	This function hides the unsafe 'dirs' and 'system' subcommands of
 *	the "encoding" Tcl command ensemble. It must be called only from
 *	TclHideUnsafeCommands.
 *
 * Results:
 *	A standard Tcl result
 *
 * Side effects:
 *	Adds commands to the table of hidden commands.
 *
 *-----------------------------------------------------------------------------
 */

int
TclMakeEncodingCommandSafe(
    Tcl_Interp* interp)		/* Tcl interpreter */
{
    static const struct {
	const char *cmdName;
	int unsafe;
    } unsafeInfo[] = {
	{"convertfrom", 0},
	{"convertto",   0},
	{"dirs",        1},
	{"names",       0},
	{"system",      0},
	{NULL,          0}
    };

    int i;
    Tcl_DString oldBuf, newBuf;

    Tcl_DStringInit(&oldBuf);
    TclDStringAppendLiteral(&oldBuf, "::tcl::encoding::");
    Tcl_DStringInit(&newBuf);
    TclDStringAppendLiteral(&newBuf, "tcl:encoding:");
    for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
	if (unsafeInfo[i].unsafe) {
	    const char *oldName, *newName;

	    Tcl_DStringSetLength(&oldBuf, 17);
	    oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
	    Tcl_DStringSetLength(&newBuf, 13);
	    newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
	    if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
		    || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
		Tcl_Panic("problem making 'encoding %s' safe: %s",
			unsafeInfo[i].cmdName,
			Tcl_GetString(Tcl_GetObjResult(interp)));
	    }
	    Tcl_CreateObjCommand(interp, oldName, BadEncodingSubcommand,
		    (ClientData) unsafeInfo[i].cmdName, NULL);
	}
    }
    Tcl_DStringFree(&oldBuf);
    Tcl_DStringFree(&newBuf);

    /*
     * Ugh. The [encoding] command is now actually safe, but it is assumed by
     * scripts that it is not, which messes up security policies.
     */

    if (Tcl_HideCommand(interp, "encoding", "encoding") != TCL_OK) {
	Tcl_Panic("problem making 'encoding' safe: %s",
		Tcl_GetString(Tcl_GetObjResult(interp)));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * BadEncodingSubcommand --
 *
 *	Command used to act as a backstop implementation when subcommands of
 *	"encoding" are unsafe (the real implementations of the subcommands are
 *	hidden). The clientData is always the full official subcommand name.
 *
 * Results:
 *	A standard Tcl result (always a TCL_ERROR).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
BadEncodingSubcommand(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *subcommandName = (const char *) clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "not allowed to invoke subcommand %s of encoding", subcommandName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * EncodingConvertfromObjCmd --
 *
 *	This command converts a byte array in an external encoding into a
1227
1228
1229
1230
1231
1232
1233
1234
1235


1236
1237
1238
1239
1240
1241
1242
1243
1244








1245
1246
1247
1248
1249
1250
1251
1252







1253
1254
1255
1256
1257




1258
1259

1260
1261

1262
1263
1264
1265
1266
1267





1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1059
1060
1061
1062
1063
1064
1065


1066
1067
1068








1069
1070
1071
1072
1073
1074
1075
1076
1077







1078
1079
1080
1081
1082
1083
1084
1085




1086
1087
1088
1089
1090

1091
1092

1093
1094





1095
1096
1097
1098
1099
1100
1101
1102
1103







































































































































1104
1105
1106
1107
1108
1109
1110







-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
+

-
+

-
-
-
-
-
+
+
+
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    /*
     * Note that most subcommands are unsafe because either they manipulate
     * the native filesystem or because they reveal information about the
     * native filesystem.
     */

    static const EnsembleImplMap initMap[] = {
	{"atime",	FileAttrAccessTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"attributes",	TclFileAttrsCmd,	NULL, NULL, NULL, 0},
	{"atime",	FileAttrAccessTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
	{"attributes",	TclFileAttrsCmd,	NULL, NULL, NULL, 1},
	{"channels",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"copy",	TclFileCopyCmd,		NULL, NULL, NULL, 0},
	{"delete",	TclFileDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
	{"dirname",	PathDirNameCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"executable",	FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"exists",	FileAttrIsExistingCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"extension",	PathExtensionCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"isdirectory",	FileAttrIsDirectoryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"isfile",	FileAttrIsFileCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"copy",	TclFileCopyCmd,		NULL, NULL, NULL, 1},
	{"delete",	TclFileDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"dirname",	PathDirNameCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"executable",	FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"exists",	FileAttrIsExistingCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"extension",	PathExtensionCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"isdirectory",	FileAttrIsDirectoryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"isfile",	FileAttrIsFileCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"join",	PathJoinCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
	{"link",	TclFileLinkCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"lstat",	FileAttrLinkStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"mtime",	FileAttrModifyTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"mkdir",	TclFileMakeDirsCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
	{"nativename",	PathNativeNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"normalize",	PathNormalizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"owned",	FileAttrIsOwnedCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"link",	TclFileLinkCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 1},
	{"lstat",	FileAttrLinkStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
	{"mtime",	FileAttrModifyTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
	{"mkdir",	TclFileMakeDirsCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"nativename",	PathNativeNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"normalize",	PathNormalizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"owned",	FileAttrIsOwnedCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"pathtype",	PathTypeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"readable",	FileAttrIsReadableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"readlink",	TclFileReadLinkCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"rename",	TclFileRenameCmd,	NULL, NULL, NULL, 0},
	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"readable",	FileAttrIsReadableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"readlink",	TclFileReadLinkCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"rename",	TclFileRenameCmd,	NULL, NULL, NULL, 1},
	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"separator",	FilesystemSeparatorCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"split",	PathSplitCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
	{"system",	PathFilesystemCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 0},
	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 1},
	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    return TclMakeEnsemble(interp, "file", initMap);
}

/*
 *----------------------------------------------------------------------
 *
 * TclMakeFileCommandSafe --
 *
 *	This function hides the unsafe subcommands of the "file" Tcl command
 *	ensemble. It must only be called from TclHideUnsafeCommands.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Adds commands to the table of hidden commands.
 *
 *----------------------------------------------------------------------
 */

int
TclMakeFileCommandSafe(
    Tcl_Interp *interp)
{
    static const struct {
	const char *cmdName;
	int unsafe;
    } unsafeInfo[] = {
	{"atime",	 1},
	{"attributes",	 1},
	{"channels",	 0},
	{"copy",	 1},
	{"delete",	 1},
	{"dirname",	 1},
	{"executable",	 1},
	{"exists",	 1},
	{"extension",	 1},
	{"isdirectory",	 1},
	{"isfile",	 1},
	{"join",	 0},
	{"link",	 1},
	{"lstat",	 1},
	{"mtime",	 1},
	{"mkdir",	 1},
	{"nativename",	 1},
	{"normalize",	 1},
	{"owned",	 1},
	{"pathtype",	 0},
	{"readable",	 1},
	{"readlink",	 1},
	{"rename",	 1},
	{"rootname",	 1},
	{"separator",	 0},
	{"size",	 1},
	{"split",	 0},
	{"stat",	 1},
	{"system",	 0},
	{"tail",	 1},
	{"tempfile",	 1},
	{"type",	 1},
	{"volumes",	 1},
	{"writable",	 1},
	{NULL, 0}
    };
    int i;
    Tcl_DString oldBuf, newBuf;

    Tcl_DStringInit(&oldBuf);
    TclDStringAppendLiteral(&oldBuf, "::tcl::file::");
    Tcl_DStringInit(&newBuf);
    TclDStringAppendLiteral(&newBuf, "tcl:file:");
    for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
	if (unsafeInfo[i].unsafe) {
	    const char *oldName, *newName;

	    Tcl_DStringSetLength(&oldBuf, 13);
	    oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
	    Tcl_DStringSetLength(&newBuf, 9);
	    newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
	    if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
		    || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
		Tcl_Panic("problem making 'file %s' safe: %s",
			unsafeInfo[i].cmdName,
			Tcl_GetString(Tcl_GetObjResult(interp)));
	    }
	    Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand,
		    (ClientData) unsafeInfo[i].cmdName, NULL);
	}
    }
    Tcl_DStringFree(&oldBuf);
    Tcl_DStringFree(&newBuf);

    /*
     * Ugh. The [file] command is now actually safe, but it is assumed by
     * scripts that it is not, which messes up security policies. [Bug
     * 3211758]
     */

    if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) {
	Tcl_Panic("problem making 'file' safe: %s",
		Tcl_GetString(Tcl_GetObjResult(interp)));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * BadFileSubcommand --
 *
 *	Command used to act as a backstop implementation when subcommands of
 *	"file" are unsafe (the real implementations of the subcommands are
 *	hidden). The clientData is always the full official subcommand name.
 *
 * Results:
 *	A standard Tcl result (always a TCL_ERROR).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
BadFileSubcommand(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *subcommandName = (const char *) clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "not allowed to invoke subcommand %s of file", subcommandName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrAccessTimeCmd --
 *
 *	This function is invoked to process the "file atime" Tcl command. See
1451
1452
1453
1454
1455
1456
1457
1458

1459
1460

1461
1462
1463
1464
1465
1466
1467
1148
1149
1150
1151
1152
1153
1154

1155
1156

1157
1158
1159
1160
1161
1162
1163
1164







-
+

-
+








    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	long newTime;
	Tcl_WideInt newTime;

	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = newTime;
	tval.modtime = buf.st_mtime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
1532
1533
1534
1535
1536
1537
1538
1539

1540
1541

1542
1543
1544
1545
1546
1547
1548
1229
1230
1231
1232
1233
1234
1235

1236
1237

1238
1239
1240
1241
1242
1243
1244
1245







-
+

-
+







#endif
    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	long newTime;
	Tcl_WideInt newTime;

	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = buf.st_atime;
	tval.modtime = newTime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {

Changes to generic/tclCmdIL.c.

60
61
62
63
64
65
66
67
68



69
70
71
72
73
74
75
60
61
62
63
64
65
66


67
68
69
70
71
72
73
74
75
76







-
-
+
+
+







    int isIncreasing;		/* Nonzero means sort in increasing order. */
    int sortMode;		/* The sort mode. One of SORTMODE_* values
				 * defined below. */
    Tcl_Obj *compareCmdPtr;	/* The Tcl comparison command when sortMode is
				 * SORTMODE_COMMAND. Pre-initialized to hold
				 * base of command. */
    int *indexv;		/* If the -index option was specified, this
				 * holds the indexes contained in the list
				 * supplied as an argument to that option.
				 * holds an encoding of the indexes contained
				 * in the list supplied as an argument to
				 * that option.
				 * NULL if no indexes supplied, and points to
				 * singleIndex field when only one
				 * supplied. */
    int indexc;			/* Number of indexes in indexv array. */
    int singleIndex;		/* Static space for common index case. */
    int unique;
    int numElements;
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
89
90
91
92
93
94
95








96
97
98
99
100
101
102







-
-
-
-
-
-
-
-







#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

/*
 * Magic values for the index field of the SortInfo structure. Note that the
 * index "end-1" will be translated to SORTIDX_END-1, etc.
 */

#define SORTIDX_NONE	-1	/* Not indexed; use whole value. */
#define SORTIDX_END	-2	/* Indexed from end. */

/*
 * Forward declarations for procedures defined in this file:
 */

static int		DictionaryCompare(const char *left, const char *right);
static Tcl_NRPostProc	IfConditionCallback;
static int		InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
140
141
142
143
144
145
146


147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165

166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

181
182
183
184
185
186
187
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175

176
177
178
179
180
181
182
183







+
+



















+














-
+







static int		InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoProcsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoCmdTypeCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static SortElement *	MergeLists(SortElement *leftPtr, SortElement *rightPtr,
			    SortInfo *infoPtr);
static int		SortCompare(SortElement *firstPtr, SortElement *second,
			    SortInfo *infoPtr);
static Tcl_Obj *	SelectObjFromSublist(Tcl_Obj *firstPtr,
			    SortInfo *infoPtr);

/*
 * Array of values describing how to implement each standard subcommand of the
 * "info" command.
 */

static const EnsembleImplMap defaultInfoMap[] = {
    {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"cmdtype",		   InfoCmdTypeCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
    {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"coroutine",	   TclInfoCoroutineCmd,     TclCompileInfoCoroutineCmd, NULL, NULL, 0},
    {"default",		   InfoDefaultCmd,	    TclCompileBasic3ArgCmd, NULL, NULL, 0},
    {"errorstack",	   InfoErrorStackCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd, NULL, NULL, 0},
    {"frame",		   InfoFrameCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"functions",	   InfoFunctionsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"globals",		   TclInfoGlobalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"hostname",	   InfoHostnameCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"level",		   InfoLevelCmd,	    TclCompileInfoLevelCmd, NULL, NULL, 0},
    {"library",		   InfoLibraryCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"loaded",		   InfoLoadedCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"locals",		   TclInfoLocalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
    {"patchlevel",	   InfoPatchLevelCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"vars",		   TclInfoVarsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
2135
2136
2137
2138
2139
2140
2141






















































2142
2143
2144
2145
2146
2147
2148
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoCmdTypeCmd --
 *
 *	Called to implement the "info cmdtype" command that returns the type
 *	of a given command. Handles the following syntax:
 *
 *	    info cmdtype cmdName
 *
 * Results:
 *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
 *
 * Side effects:
 *	Returns a type name. If there is an error, the result is an error
 *	message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoCmdTypeCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Command command;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "commandName");
	return TCL_ERROR;
    }
    command = Tcl_FindCommand(interp, Tcl_GetString(objv[1]), NULL,
	    TCL_LEAVE_ERR_MSG);
    if (command == NULL) {
	return TCL_ERROR;
    }

    /*
     * There's one special case: safe slave interpreters can't see aliases as
     * aliases as they're part of the security mechanisms.
     */

    if (Tcl_IsSafe(interp)
	    && (((Command *) command)->objProc == TclAliasObjCmd)) {
	Tcl_AppendResult(interp, "native", NULL);
    } else {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj(TclGetCommandTypeName(command), -1));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_JoinObjCmd --
 *
 *	This procedure is invoked to process the "join" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
2156
2157
2158
2159
2160
2161
2162
2163

2164
2165
2166
2167
2168
2169
2170
2206
2207
2208
2209
2210
2211
2212

2213
2214
2215
2216
2217
2218
2219
2220







-
+







int
Tcl_JoinObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int listLen;
    int length, listLen;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

2187
2188
2189
2190
2191
2192
2193

2194
2195


2196
2197
2198
2199
2200
2201
2202
2203
2237
2238
2239
2240
2241
2242
2243
2244


2245
2246

2247
2248
2249
2250
2251
2252
2253







+
-
-
+
+
-







	Tcl_SetObjResult(interp, elemPtrs[0]);
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) Tcl_GetStringFromObj(joinObjPtr, &length);
    if (Tcl_GetCharLength(joinObjPtr) == 0) {
	TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs,
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
		&resObjPtr);
    } else {
	int i;

	resObjPtr = Tcl_NewObj();
	for (i = 0;  i < listLen;  i++) {
	    if (i > 0) {

2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575

2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610

2611
2612
2613
2614
2615
2616
2617
2618
2619
2589
2590
2591
2592
2593
2594
2595

2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612



2613
2614
2615
2616
2617
2618



2619



































2620


2621
2622
2623
2624
2625
2626
2627







-

















-
-
-






-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-







Tcl_LrangeObjCmd(
    ClientData notUsed,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    register Tcl_Obj *const objv[])
				/* Argument objects. */
{
    Tcl_Obj **elemPtrs;
    int listLen, first, last, result;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
	return TCL_ERROR;
    }

    result = TclListObjLength(interp, objv[1], &listLen);
    if (result != TCL_OK) {
	return result;
    }

    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
	    &first);
    if (result != TCL_OK) {
	return result;
    }
    if (first < 0) {
	first = 0;
    }

    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
	    &last);
    if (result != TCL_OK) {
	return result;
    }
    if (last >= listLen) {
	last = listLen - 1;
    }


    if (first > last) {
	/*
	 * Returning an empty list is easy.
	 */

	return TCL_OK;
    }

    result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
    if (result != TCL_OK) {
	return result;
    }

    if (Tcl_IsShared(objv[1]) ||
	    ((ListRepPtr(objv[1])->refCount > 1))) {
	Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
		&elemPtrs[first]));
    } else {
	/*
	 * In-place is possible.
	 */

	if (last < (listLen - 1)) {
	    Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last,
		    0, NULL);
	}

	/*
	 * This one is not conditioned on (first > 0) in order to preserve the
	 * string-canonizing effect of [lrange 0 end].
	 */

	Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL);
	Tcl_SetObjResult(interp, objv[1]);
    Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LrepeatObjCmd --
2775
2776
2777
2778
2779
2780
2781
2782

2783
2784
2785
2786

2787
2788
2789

2790
2791
2792
2793
2794
2795
2796

2797
2798
2799
2800
2801
2802
2803
2783
2784
2785
2786
2787
2788
2789

2790




2791



2792







2793
2794
2795
2796
2797
2798
2799
2800







-
+
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
+







    if (result != TCL_OK) {
	return result;
    }

    if (first < 0) {
	first = 0;
    }

    if (first > listLen) {
    /*
     * Complain if the user asked for a start element that is greater than the
     * list length. This won't ever trigger for the "end-*" case as that will
     * be properly constrained by TclGetIntForIndex because we use listLen-1
	first = listLen;
     * (to allow for replacing the last elem).
     */

    }
    if ((first > listLen) && (listLen > 0)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"list doesn't contain element %s", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
		NULL);
	return TCL_ERROR;
    }

    if (last >= listLen) {
	last = listLen - 1;
    }
    if (first <= last) {
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
2934
2935
2936
2937
2938
2939
2940
2941
2942



2943
2944
2945
2946
2947
2948

2949
2950
2951
2952
2953
2954

2955
2956
2957
2958
2959
2960
2961
2962

2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981

2982


2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
2931
2932
2933
2934
2935
2936
2937


2938
2939
2940
2941
2942
2943
2944
2945

2946
2947
2948
2949
2950
2951

2952
2953
2954
2955
2956
2957
2958
2959

2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980

2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999



3000
3001
3002
3003
3004
3005
3006







-
-
+
+
+





-
+





-
+







-
+



















+
-
+
+

















-
-
-







Tcl_LsearchObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    const char *bytes, *patternBytes;
    int i, match, index, result, listc, length, elemLen, bisect;
    int dataType, isIncreasing, lower, upper, offset;
    int i, match, index, result=TCL_OK, listc, length, elemLen, bisect;
    int allocatedIndexVector = 0;
    int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset;
    Tcl_WideInt patWide, objWide;
    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
    double patDouble, objDouble;
    SortInfo sortInfo;
    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
    SortStrCmpFn_t strCmpFn = strcmp;
    SortStrCmpFn_t strCmpFn = TclUtfCmp;
    Tcl_RegExp regexp = NULL;
    static const char *const options[] = {
	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
	"-exact",   "-glob",    "-increasing", "-index",
	"-inline",  "-integer", "-nocase",     "-not",
	"-real",    "-regexp",  "-sorted",     "-start",
	"-real",    "-regexp",  "-sorted",     "-start", "-stride",
	"-subindices", NULL
    };
    enum options {
	LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_BISECT, LSEARCH_DECREASING,
	LSEARCH_DICTIONARY, LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING,
	LSEARCH_INDEX, LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE,
	LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED,
	LSEARCH_START, LSEARCH_SUBINDICES
	LSEARCH_START, LSEARCH_STRIDE, LSEARCH_SUBINDICES
    };
    enum datatypes {
	ASCII, DICTIONARY, INTEGER, REAL
    };
    enum modes {
	EXACT, GLOB, REGEXP, SORTED
    };
    enum modes mode;

    mode = GLOB;
    dataType = ASCII;
    isIncreasing = 1;
    allMatches = 0;
    inlineReturn = 0;
    returnSubindices = 0;
    negatedMatch = 0;
    bisect = 0;
    listPtr = NULL;
    startPtr = NULL;
    groupSize = 1;
    offset = 0;
    groupOffset = 0;
    start = 0;
    noCase = 0;
    sortInfo.compareCmdPtr = NULL;
    sortInfo.isIncreasing = 1;
    sortInfo.sortMode = 0;
    sortInfo.interp = interp;
    sortInfo.resultCode = TCL_OK;
    sortInfo.indexv = NULL;
    sortInfo.indexc = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
		!= TCL_OK) {
	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
	    }
	    result = TCL_ERROR;
	    goto done;
	}
	switch ((enum options) index) {
	case LSEARCH_ALL:		/* -all */
	    allMatches = 1;
	    break;
3060
3061
3062
3063
3064
3065
3066

3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086

3087










3088













3089
3090
3091
3092
3093
3094

3095

3096
3097
3098
3099
3100
3101
3102
3103
3104
3105


3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120


3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131


3132
3133
3134
3135
3136
3137
3138
3139
3140

3141
3142














3143
3144
3145
3146
3147

3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166


3167
3168
3169
3170
3171
3172
3173
3174


3175
3176
3177
3178
3179
3180
3181
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085

3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114

3115
3116
3117
3118
3119



3120
3121
3122
3123

3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136




3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161


3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177

3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191



3192
3193
3194
3195

3196
3197
3198
3199
3200
3201
3202
3203
3204

3205
3206
3207
3208
3209
3210
3211
3212
3213







+




















+
-
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+





-
+

+


-
-
-




-
+
+











-
-
-
-
+
+











+
+









+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-


+











-
-
-




-
+
+







-
+
+







	    /*
	     * If there was a previous -start option, release its saved index
	     * because it will either be replaced or there will be an error.
	     */

	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
		startPtr = NULL;
	    }
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing starting index", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    i++;
	    if (objv[i] == objv[objc - 2]) {
		/*
		 * Take copy to prevent shimmering problems. Note that it does
		 * not matter if the index obj is also a component of the list
		 * being searched. We only need to copy where the list and the
		 * index are one-and-the-same.
		 */

		startPtr = Tcl_DuplicateObj(objv[i]);
	    } else {
		startPtr = objv[i];
	    }
		Tcl_IncrRefCount(startPtr);
	    Tcl_IncrRefCount(startPtr);
	    break;
	case LSEARCH_STRIDE:		/* -stride */
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option must be "
			"followed by stride length", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    if (groupSize < 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"stride length must be at least 1", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADSTRIDE", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    i++;
	    break;
	case LSEARCH_INDEX: {		/* -index */
	    Tcl_Obj **indices;
	    int j;

	    if (sortInfo.indexc > 1) {
	    if (allocatedIndexVector) {
		TclStackFree(interp, sortInfo.indexv);
		allocatedIndexVector = 0;
	    }
	    if (i > objc-4) {
		if (startPtr != NULL) {
		    Tcl_DecrRefCount(startPtr);
		}
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option must be followed by list index",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
		result = TCL_ERROR;
		goto done;
	    }

	    /*
	     * Store the extracted indices for processing by sublist
	     * extraction. Note that we don't do this using objects because
	     * that has shimmering problems.
	     */

	    i++;
	    if (TclListObjGetElements(interp, objv[i],
		    &sortInfo.indexc, &indices) != TCL_OK) {
		if (startPtr != NULL) {
		    Tcl_DecrRefCount(startPtr);
		}
		return TCL_ERROR;
		result = TCL_ERROR;
		goto done;
	    }
	    switch (sortInfo.indexc) {
	    case 0:
		sortInfo.indexv = NULL;
		break;
	    case 1:
		sortInfo.indexv = &sortInfo.singleIndex;
		break;
	    default:
		sortInfo.indexv =
			TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
		allocatedIndexVector = 1; /* Cannot use indexc field, as it
					   * might be decreased by 1 later. */
	    }

	    /*
	     * Fill the array by parsing each index. We don't know whether
	     * their scale is sensible yet, but we at least perform the
	     * syntactic check here.
	     */

	    for (j=0 ; j<sortInfo.indexc ; j++) {
		int encoded = 0;
		if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
			&sortInfo.indexv[j]) != TCL_OK) {
		if (TclIndexEncode(interp, indices[j], TCL_INDEX_BEFORE,
			TCL_INDEX_AFTER, &encoded) != TCL_OK) {
		    result = TCL_ERROR;
		}
		if ((encoded == TCL_INDEX_BEFORE)
			|| (encoded == TCL_INDEX_AFTER)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" cannot select an element "
			    "from any list", Tcl_GetString(indices[j])));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			    "OUTOFRANGE", NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %d)", j));
		    result = TCL_ERROR;
		    goto done;
		}
		sortInfo.indexv[j] = encoded;
	    }
	    break;
	}
	}
    }

    /*
     * Subindices only make sense if asked for with -index option set.
     */

    if (returnSubindices && sortInfo.indexc==0) {
	if (startPtr != NULL) {
	    Tcl_DecrRefCount(startPtr);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"-subindices cannot be used without -index option", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
		"BAD_OPTION_MIX", NULL);
	return TCL_ERROR;
	result = TCL_ERROR;
	goto done;
    }

    if (bisect && (allMatches || negatedMatch)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"-bisect is not compatible with -all or -not", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
		"BAD_OPTION_MIX", NULL);
	return TCL_ERROR;
	result = TCL_ERROR;
	goto done;
    }

    if (mode == REGEXP) {
	/*
	 * We can shimmer regexp/list if listv[i] == pattern, so get the
	 * regexp rep before the list rep. First time round, omit the interp
	 * and hope that the compilation will succeed. If it fails, we'll
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214


3215
3216















3217














3218
3219














3220
3221
3222
3223
3224
3225
3226

3227
3228
3229
3230
3231
3232


3233
3234
3235
3236
3237
3238
3239
3240

3241
3242
3243
3244
3245
3246
3247
3248


3249







3250
3251
3252
3253
3254
3255
3256
3225
3226
3227
3228
3229
3230
3231



3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245


3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275


3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295

3296

3297
3298
3299


3300
3301
3302
3303
3304
3305
3306
3307
3308

3309



3310
3311
3312
3313
3314
3315
3316

3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330







-
-
-












+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+
-



-
-
+
+







-
+
-
-
-





+
+
-
+
+
+
+
+
+
+







	     */

	    regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
		    TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
	}

	if (regexp == NULL) {
	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
	    }
	    result = TCL_ERROR;
	    goto done;
	}
    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * pointer to its array of element pointers.
     */

    result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
    if (result != TCL_OK) {
	goto done;
    }
	if (startPtr != NULL) {
	    Tcl_DecrRefCount(startPtr);

    /*
     * Check for sanity when grouping elements of the overall list together
     * because of the -stride option. [TIP #351]
     */

    if (groupSize > 1) {
	if (listc % groupSize) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list size must be a multiple of the stride length",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE",
		    NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (sortInfo.indexc > 0) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
	    if (groupOffset < 0 || groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
			"BADINDEX", NULL);
		result = TCL_ERROR;
	goto done;
    }
		goto done;
	    }
	    if (sortInfo.indexc == 1) {
		sortInfo.indexc = 0;
		sortInfo.indexv = NULL;
	    } else {
		sortInfo.indexc--;

		for (i = 0; i < sortInfo.indexc; i++) {
		    sortInfo.indexv[i] = sortInfo.indexv[i+1];
		}
	    }
	}
    }

    /*
     * Get the user-specified start offset.
     */

    if (startPtr) {
	result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset);
	result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
	Tcl_DecrRefCount(startPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	if (offset < 0) {
	    offset = 0;
	if (start < 0) {
	    start = 0;
	}

	/*
	 * If the search started past the end of the list, we just return a
	 * "did not match anything at all" result straight away. [Bug 1374778]
	 */

	if (offset > listc-1) {
	if (start > listc-1) {
	    if (sortInfo.indexc > 1) {
		TclStackFree(interp, sortInfo.indexv);
	    }
	    if (allMatches || inlineReturn) {
		Tcl_ResetResult(interp);
	    } else {
		Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	    }
	    goto done;
	}
	    return TCL_OK;

	/*
	 * If start points within a group, it points to the start of the group.
	 */

	if (groupSize > 1) {
	    start -= (start % groupSize);
	}
    }

    patObj = objv[objc - 1];
    patternBytes = NULL;
    if (mode == EXACT || mode == SORTED) {
	switch ((enum datatypes) dataType) {
3301
3302
3303
3304
3305
3306
3307




3308

3309
3310

3311

3312
3313

3314
3315
3316
3317
3318
3319

3320
3321
3322
3323
3324
3325
3326
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385

3386
3387

3388
3389
3390
3391

3392
3393
3394
3395
3396
3397

3398
3399
3400
3401
3402
3403
3404
3405







+
+
+
+
-
+

-
+

+

-
+





-
+







	/*
	 * If the data is sorted, we can do a more intelligent search. Note
	 * that there is no point in being smart when -all was specified; in
	 * that case, we have to look at all items anyway, and there is no
	 * sense in doing this when the match sense is inverted.
	 */

	/*
	 * With -stride, lower, upper and i are kept as multiples of groupSize.
	 */

	lower = offset - 1;
	lower = start - groupSize;
	upper = listc;
	while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) {
	while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
	    i = (lower + upper)/2;
	    i -= i % groupSize;
	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    result = sortInfo.resultCode;
		    goto done;
		}
	    } else {
		itemPtr = listv[i];
		itemPtr = listv[i+groupOffset];
	    }
	    switch ((enum datatypes) dataType) {
	    case ASCII:
		bytes = TclGetString(itemPtr);
		match = strCmpFn(patternBytes, bytes);
		break;
	    case DICTIONARY:
3401
3402
3403
3404
3405
3406
3407
3408

3409
3410
3411

3412
3413
3414
3415
3416
3417
3418
3419
3420

3421
3422
3423
3424
3425
3426
3427
3480
3481
3482
3483
3484
3485
3486

3487
3488
3489

3490
3491
3492
3493
3494
3495
3496
3497
3498

3499
3500
3501
3502
3503
3504
3505
3506







-
+


-
+








-
+







	 *   - our matching sense is negated
	 *   - we're building a list of all matched items
	 */

	if (allMatches) {
	    listPtr = Tcl_NewListObj(0, NULL);
	}
	for (i = offset; i < listc; i++) {
	for (i = start; i < listc; i += groupSize) {
	    match = 0;
	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    if (listPtr != NULL) {
			Tcl_DecrRefCount(listPtr);
		    }
		    result = sortInfo.resultCode;
		    goto done;
		}
	    } else {
		itemPtr = listv[i];
		itemPtr = listv[i+groupOffset];
	    }

	    switch (mode) {
	    case SORTED:
	    case EXACT:
		switch ((enum datatypes) dataType) {
		case ASCII:
3503
3504
3505
3506
3507
3508
3509
3510






3511
3512
3513
3514


3515
3516
3517
3518

3519
3520
3521


3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540

3541
3542
3543


3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556






3557


3558
3559
3560
3561
3562
3563
3564
3565
3566




3567
3568
3569
3570
3571
3572
3573
3582
3583
3584
3585
3586
3587
3588

3589
3590
3591
3592
3593
3594
3595
3596


3597
3598
3599
3600
3601

3602
3603


3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623

3624
3625


3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646

3647
3648
3649
3650
3651
3652
3653
3654
3655
3656

3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667







-
+
+
+
+
+
+


-
-
+
+



-
+

-
-
+
+


















-
+

-
-
+
+













+
+
+
+
+
+
-
+
+








-
+
+
+
+







		break;
	    } else if (inlineReturn) {
		/*
		 * Note that these appends are not expected to fail.
		 */

		if (returnSubindices && (sortInfo.indexc != 0)) {
		    itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
		    itemPtr = SelectObjFromSublist(listv[i+groupOffset],
			    &sortInfo);
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		} else if (groupSize > 1) {
		    Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
			    groupSize, &listv[i]);
		} else {
		    itemPtr = listv[i];
		}
		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		}
	    } else if (returnSubindices) {
		int j;

		itemPtr = Tcl_NewIntObj(i);
		itemPtr = Tcl_NewIntObj(i+groupOffset);
		for (j=0 ; j<sortInfo.indexc ; j++) {
		    Tcl_ListObjAppendElement(interp, itemPtr,
			    Tcl_NewIntObj(sortInfo.indexv[j]));
		    Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
			    TclIndexDecode(sortInfo.indexv[j], listc)));
		}
		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
	    } else {
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(i));
	    }
	}
    }

    /*
     * Return everything or a single value.
     */

    if (allMatches) {
	Tcl_SetObjResult(interp, listPtr);
    } else if (!inlineReturn) {
	if (returnSubindices) {
	    int j;

	    itemPtr = Tcl_NewIntObj(index);
	    itemPtr = Tcl_NewIntObj(index+groupOffset);
	    for (j=0 ; j<sortInfo.indexc ; j++) {
		Tcl_ListObjAppendElement(interp, itemPtr,
			Tcl_NewIntObj(sortInfo.indexv[j]));
		Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
			TclIndexDecode(sortInfo.indexv[j], listc)));
	    }
	    Tcl_SetObjResult(interp, itemPtr);
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
	}
    } else if (index < 0) {
	/*
	 * Is this superfluous? The result should be a blank object by
	 * default...
	 */

	Tcl_SetObjResult(interp, Tcl_NewObj());
    } else {
	if (returnSubindices) {
	    Tcl_SetObjResult(interp, SelectObjFromSublist(listv[i+groupOffset],
		    &sortInfo));
	} else if (groupSize > 1) {
	    Tcl_SetObjResult(interp, Tcl_NewListObj(groupSize, &listv[index]));
	} else {
	Tcl_SetObjResult(interp, listv[index]);
	    Tcl_SetObjResult(interp, listv[index]);
	}
    }
    result = TCL_OK;

    /*
     * Cleanup the index list array.
     */

  done:
    if (sortInfo.indexc > 1) {
    if (startPtr != NULL) {
	Tcl_DecrRefCount(startPtr);
    }
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
3753
3754
3755
3756
3757
3758
3759
3760

3761
3762
3763
3764
3765
3766
3767
3847
3848
3849
3850
3851
3852
3853

3854
3855
3856
3857
3858
3859
3860
3861







-
+







	case LSORT_DICTIONARY:
	    sortInfo.sortMode = SORTMODE_DICTIONARY;
	    break;
	case LSORT_INCREASING:
	    sortInfo.isIncreasing = 1;
	    break;
	case LSORT_INDEX: {
	    int indexc, dummy;
	    int indexc;
	    Tcl_Obj **indexv;

	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option must be followed by list index",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
3779
3780
3781
3782
3783
3784
3785

3786
3787













3788
3789
3790
3791
3792
3793
3794
3873
3874
3875
3876
3877
3878
3879
3880


3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900







+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







	     * we do not store the converted values here because we do not
	     * know if this is the only -index option yet and so we can't
	     * allocate any space; that happens after the scan through all the
	     * options is done.
	     */

	    for (j=0 ; j<indexc ; j++) {
		int encoded = 0;
		if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
			&dummy) != TCL_OK) {
		int result = TclIndexEncode(interp, indexv[j],
			TCL_INDEX_BEFORE, TCL_INDEX_AFTER, &encoded);

		if ((result == TCL_OK) && ((encoded == TCL_INDEX_BEFORE)
			|| (encoded == TCL_INDEX_AFTER))) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" cannot select an element "
			    "from any list", Tcl_GetString(indexv[j])));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			    "OUTOFRANGE", NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %d)", j));
		    sortInfo.resultCode = TCL_ERROR;
		    goto done;
		}
	    }
	    indexPtr = objv[i+1];
3860
3861
3862
3863
3864
3865
3866
3867
3868


3869
3870
3871
3872
3873
3874
3875
3966
3967
3968
3969
3970
3971
3972


3973
3974
3975
3976
3977
3978
3979
3980
3981







-
-
+
+







	default:
	    sortInfo.indexv =
		    TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
	    allocatedIndexVector = 1;	/* Cannot use indexc field, as it
					 * might be decreased by 1 later. */
	}
	for (j=0 ; j<sortInfo.indexc ; j++) {
	    TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
		    &sortInfo.indexv[j]);
	    /* Prescreened values, no errors or out of range possible */
	    TclIndexEncode(NULL, indexv[j], 0, 0, &sortInfo.indexv[j]);
	}
    }

    listObj = objv[objc-1];

    if (sortInfo.sortMode == SORTMODE_COMMAND) {
	Tcl_Obj *newCommandPtr, *newObjPtr;
3932
3933
3934
3935
3936
3937
3938
3939

3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960



3961
3962
3963
3964
3965
3966
3967
4038
4039
4040
4041
4042
4043
4044

4045



4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073







-
+
-
-
-


















+
+
+







	length = length / groupSize;
	if (sortInfo.indexc > 0) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = sortInfo.indexv[0];
	    groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
	    if (groupOffset <= SORTIDX_END) {
		groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
	    }
	    if (groupOffset < 0 || groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADINDEX", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    if (sortInfo.indexc == 1) {
		sortInfo.indexc = 0;
		sortInfo.indexv = NULL;
	    } else {
		sortInfo.indexc--;

		/*
		 * Do not shrink the actual memory block used; that doesn't
		 * work with TclStackAlloc-allocated memory. [Bug 2918962]
		 *
		 * TODO: Consider a pointer increment to replace this
		 * array shift.
		 */

		for (i = 0; i < sortInfo.indexc; i++) {
		    sortInfo.indexv[i] = sortInfo.indexv[i+1];
		}
	    }
	}
4259
4260
4261
4262
4263
4264
4265
4266

4267
4268
4269
4270
4271
4272
4273
4365
4366
4367
4368
4369
4370
4371

4372
4373
4374
4375
4376
4377
4378
4379







-
+







				/* Values to be compared. */
    SortInfo *infoPtr)		/* Information passed from the top-level
				 * "lsort" command. */
{
    int order = 0;

    if (infoPtr->sortMode == SORTMODE_ASCII) {
	order = strcmp(elemPtr1->collationKey.strValuePtr,
	order = TclUtfCmp(elemPtr1->collationKey.strValuePtr,
		elemPtr2->collationKey.strValuePtr);
    } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
	order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr,
		elemPtr2->collationKey.strValuePtr);
    } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
	order = DictionaryCompare(elemPtr1->collationKey.strValuePtr,
		elemPtr2->collationKey.strValuePtr);
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534

4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4628
4629
4630
4631
4632
4633
4634

4635




4636



4637
4638
4639
4640
4641
4642
4643







-

-
-
-
-
+
-
-
-







	int listLen, index;
	Tcl_Obj *currentObj;

	if (TclListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	index = infoPtr->indexv[i];

	/*
	 * Adjust for end-based indexing.
	 */

	index = TclIndexDecode(infoPtr->indexv[i], listLen - 1);
	if (index < SORTIDX_NONE) {
	    index += listLen + 1;
	}

	if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
		&currentObj) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	if (currentObj == NULL) {

Changes to generic/tclCmdMZ.c.

254
255
256
257
258
259
260
261

262
263
264
265
266
267
268
254
255
256
257
258
259
260

261
262
263
264
265
266
267
268







-
+







     * regexp to avoid shimmering problems.
     */

    objPtr = objv[1];
    stringLength = Tcl_GetCharLength(objPtr);

    if (startIndex) {
	TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
305
306
307
308
309
310
311
312

313
314
315
316
317
318
319
305
306
307
308
309
310
311

312
313
314
315
316
317
318
319







-
+







	 * start of the string unless the previous character is a newline.
	 */

	if (offset == 0) {
	    eflags = 0;
	} else if (offset > stringLength) {
	    eflags = TCL_REG_NOTBOL;
	} else if (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n') {
	} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}

	match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
		numMatchesSaved, eflags);
487
488
489
490
491
492
493
494

495
496
497
498
499
500
501
487
488
489
490
491
492
493

494
495
496
497
498
499
500
501







-
+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
    int start, end, subStart, subEnd, match, command, numParts;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",
	"-linestop",	"-lineanchor",	"-nocase",	"-start",
	"--",		NULL
    };
    enum options {
578
579
580
581
582
583
584
585

586
587
588
589
590
591
592
593
594
595
596
597
598
599
600

601
602

603
604
605
606
607
608
609
578
579
580
581
582
583
584

585
586
587
588
589
590
591
592
593
594
595
596
597
598
599

600
601

602
603
604
605
606
607
608
609







-
+














-
+

-
+








    objc -= idx;
    objv += idx;

    if (startIndex) {
	int stringLength = Tcl_GetCharLength(objv[1]);

	TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

    if (all && (offset == 0) && (command == 0)
	    && (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
	    && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
	/*
	 * This is a simple one pair string map situation. We make use of a
	 * slightly modified version of the one pair STR_MAP code.
	 */

	int slen, nocase;
	int slen, nocase, wsrclc;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
	Tcl_UniChar *p, wsrclc;
	Tcl_UniChar *p;

	numMatches = 0;
	nocase = (cflags & TCL_REG_NOCASE);
	strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;

	wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen);
	wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen);
1212
1213
1214
1215
1216
1217
1218

1219








1220
1221
1222
1223
1224
1225

1226
1227
1228
1229
1230
1231
1232
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233

1234
1235
1236
1237
1238
1239
1240
1241







+

+
+
+
+
+
+
+
+





-
+







	 * is a *major* win when splitting on a long string (especially in the
	 * megabyte range!) - DKF
	 */

	Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);

	for ( ; stringPtr < end; stringPtr += len) {
		int fullchar;
	    len = TclUtfToUniChar(stringPtr, &ch);
	    fullchar = ch;

#if TCL_UTF_MAX <= 4
	    if (!len) {
		len += TclUtfToUniChar(stringPtr, &ch);
		fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
	    }
#endif

	    /*
	     * Assume Tcl_UniChar is an integral type...
	     */

	    hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR((int) ch),
	    hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(fullchar),
		    &isNew);
	    if (isNew) {
		TclNewStringObj(objPtr, stringPtr, len);

		/*
		 * Don't need to fiddle with refcount...
		 */
1322
1323
1324
1325
1326
1327
1328
1329

1330
1331
1332
1333
1334

1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1331
1332
1333
1334
1335
1336
1337

1338





1339




1340
1341
1342
1343
1344
1345
1346







-
+
-
-
-
-
-
+
-
-
-
-








    if (objc == 4) {
	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
	    return TCL_ERROR;
	}

    }
	if (start < 0) {
	    start = 0;
	}
	if (start >= size) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
    Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFirst(objv[1],
	    return TCL_OK;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFind(objv[1],
	    objv[2], start)));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1376
1377
1378
1379
1380
1381
1382








1383
1384
1385
1386
1387
1388
1389







-
-
-
-
-
-
-
-








    if (objc == 4) {
	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {
	    return TCL_ERROR;
	}

	if (last < 0) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	    return TCL_OK;
	}
	if (last >= size) {
	    last = size - 1;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringLast(objv[1],
	    objv[2], last)));
    return TCL_OK;
}

/*
1422
1423
1424
1425
1426
1427
1428
1429

1430
1431
1432
1433
1434
1435
1436
1437
1438





1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450

1451
1452



1453
1454
1455
1456
1457
1458
1459
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
1444
1445
1446

1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459







-
+








-
+
+
+
+
+











-
+


+
+
+








    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string charIndex");
	return TCL_ERROR;
    }

    /*
     * Get the char length to calulate what 'end' means.
     * Get the char length to calculate what 'end' means.
     */

    length = Tcl_GetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if ((index >= 0) && (index < length)) {
	Tcl_UniChar ch = Tcl_GetUniChar(objv[1], index);
	int ch = Tcl_GetUniChar(objv[1], index);

	if (ch == -1) {
	    return TCL_OK;
	}

	/*
	 * If we have a ByteArray object, we're careful to generate a new
	 * bytearray for a result.
	 */

	if (TclIsPureByteArray(objv[1])) {
	    unsigned char uch = (unsigned char) ch;

	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
	} else {
	    char buf[TCL_UTF_MAX];
	    char buf[4];

	    length = Tcl_UniCharToUtf(ch, buf);
	    if (!length) {
		length = Tcl_UniCharToUtf(-1, buf);
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
	}
    }
    return TCL_OK;
}

/*
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584



1585
1586


1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1575
1576
1577
1578
1579
1580
1581



1582
1583
1584


1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595

1596
1597



1598
1599
1600
1601
1602
1603
1604







-
-
-
+
+
+
-
-
+
+









-


-
-
-







		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
	    if (strict) {
		result = 0;
	    } else {
		string1 = TclGetStringFromObj(objPtr, &length1);
		result = length1 == 0;
	    }
	} else if (((index == STR_IS_TRUE) &&
		objPtr->internalRep.longValue == 0)
	    || ((index == STR_IS_FALSE) &&
	} else if (index != STR_IS_BOOL) {
	    TclGetBooleanFromObj(NULL, objPtr, &i);
	    if ((index == STR_IS_TRUE) ^ i) {
		objPtr->internalRep.longValue != 0)) {
	    result = 0;
		result = 0;
	    }
	}
	break;
    case STR_IS_CONTROL:
	chcomp = Tcl_UniCharIsControl;
	break;
    case STR_IS_DIGIT:
	chcomp = Tcl_UniCharIsDigit;
	break;
    case STR_IS_DOUBLE: {
	/* TODO */
	if ((objPtr->typePtr == &tclDoubleType) ||
		(objPtr->typePtr == &tclIntType) ||
#ifndef TCL_WIDE_INT_IS_LONG
		(objPtr->typePtr == &tclWideIntType) ||
#endif
		(objPtr->typePtr == &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1619
1620
1621
1622
1623
1624
1625




1626
1627



1628
1629
1630
1631
1632
1633
1634







-
-
-
-


-
-
-







	}
	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:
	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
	    break;
	}
	goto failedIntParse;
    case STR_IS_ENTIER:
	if ((objPtr->typePtr == &tclIntType) ||
#ifndef TCL_WIDE_INT_IS_LONG
		(objPtr->typePtr == &tclWideIntType) ||
#endif
		(objPtr->typePtr == &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1666
1667
1668
1669
1670
1671
1672

1673
1674
1675
1676
1677
1678
1679







-







	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

    failedIntParse:
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
1810
1811
1812
1813
1814
1815
1816

1817







1818

1819
1820
1821
1822
1823
1824
1825
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813

1814
1815
1816
1817
1818
1819
1820
1821







+

+
+
+
+
+
+
+
-
+







	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	for (; string1 < end; string1 += length2, failat++) {
	    int fullchar;
	    length2 = TclUtfToUniChar(string1, &ch);
	    fullchar = ch;
#if TCL_UTF_MAX <= 4
	    if (!length2) {
	    	length2 = TclUtfToUniChar(string1, &ch);
	    	fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
	    }
#endif
	    if (!chcomp(ch)) {
	    if (!chcomp(fullchar)) {
		result = 0;
		break;
	    }
	}
    }

    /*
1844
1845
1846
1847
1848
1849
1850
1851

1852
1853
1854
1855
1856
1857
1858
1840
1841
1842
1843
1844
1845
1846

1847
1848
1849
1850
1851
1852
1853
1854







-
+







    return (character >= 0) && (character < 0x80);
}

static int
UniCharIsHexDigit(
    int character)
{
    return (character >= 0) && (character < 0x80) && isxdigit(character);
    return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
}

/*
 *----------------------------------------------------------------------
 *
 * StringMapCmd --
 *
1999
2000
2001
2002
2003
2004
2005
2006
2007


2008
2009
2010
2011
2012
2013
2014
1995
1996
1997
1998
1999
2000
2001


2002
2003
2004
2005
2006
2007
2008
2009
2010







-
-
+
+







	/*
	 * Special case for one map pair which avoids the extra for loop and
	 * extra calls to get Unicode data. The algorithm is otherwise
	 * identical to the multi-pair case. This will be >30% faster on
	 * larger strings.
	 */

	int mapLen;
	Tcl_UniChar *mapString, u2lc;
	int mapLen, u2lc;
	Tcl_UniChar *mapString;

	ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
	p = ustring1;
	if ((length2 > length1) || (length2 == 0)) {
	    /*
	     * Match string is either longer than input or empty.
	     */
2031
2032
2033
2034
2035
2036
2037
2038
2039


2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051

2052
2053
2054
2055
2056
2057
2058
2027
2028
2029
2030
2031
2032
2033


2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046

2047
2048
2049
2050
2051
2052
2053
2054







-
-
+
+











-
+







		    ustring1 = p - 1;

		    Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
		}
	    }
	}
    } else {
	Tcl_UniChar **mapStrings, *u2lc = NULL;
	int *mapLens;
	Tcl_UniChar **mapStrings;
	int *mapLens, *u2lc = NULL;

	/*
	 * Precompute pointers to the unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
	mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
	if (nocase) {
	    u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
	    u2lc = TclStackAlloc(interp, mapElemc * sizeof(int));
	}
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
		    mapLens+index);
	    if (nocase && ((index % 2) == 0)) {
		u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
	    }
2273
2274
2275
2276
2277
2278
2279
2280
2281




2282
2283
2284

2285
2286
2287
2288
2289
2290
2291
2269
2270
2271
2272
2273
2274
2275


2276
2277
2278
2279
2280


2281
2282
2283
2284
2285
2286
2287
2288







-
-
+
+
+
+

-
-
+







    if (count == 1) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    } else if (count < 1) {
	return TCL_OK;
    }

    if (TCL_OK != TclStringRepeat(interp, objv[1], count, &resultPtr)) {
	return TCL_ERROR;
    resultPtr = TclStringRepeat(interp, objv[1], count, TCL_STRING_IN_PLACE);
    if (resultPtr) {
	Tcl_SetObjResult(interp, resultPtr);
	return TCL_OK;
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * StringRplcCmd --
 *
2305
2306
2307
2308
2309
2310
2311
2312
2313

2314
2315
2316
2317
2318
2319
2320
2321


2322
2323
2324


2325
2326
2327








2328






2329
2330
2331
2332
2333
2334
2335
2336
2337
2338


2339

2340
2341
2342
2343

2344
2345
2346
2347




2348
2349
2350
2351
2352
2353
2354
2302
2303
2304
2305
2306
2307
2308


2309
2310
2311
2312
2313
2314
2315


2316
2317
2318


2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331

2332
2333
2334
2335
2336
2337
2338
2339
2340
2341



2342
2343
2344
2345
2346

2347




2348




2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359







-
-
+






-
-
+
+

-
-
+
+



+
+
+
+
+
+
+
+
-
+
+
+
+
+
+




-
-
-



+
+
-
+
-
-
-
-
+
-
-
-
-
+
+
+
+







static int
StringRplcCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *ustring;
    int first, last, length;
    int first, last, length, end;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
	return TCL_ERROR;
    }

    ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
    length--;
    length = Tcl_GetCharLength(objv[1]);
    end = length - 1;

    if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK){
    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){
	return TCL_ERROR;
    }

    /*
     * 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 */
	    (first > end) ||	/* Range begins after end of string */
	    (last < first)) {	/* Range begins after it starts */
    if ((last < first) || (last < 0) || (first > length)) {

	/*
	 * BUT!!! when (end < 0) -- an empty original string -- we can
	 * have (first <= end < 0 <= last) and an empty string is permitted
	 * to be replaced.
	 */
	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;

	ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
	length--;

	if (first < 0) {
	    first = 0;
	}
	if (last > end) {
	    last = end;

	}
	resultPtr = Tcl_NewUnicodeObj(ustring, first);
	if (objc == 5) {
	    Tcl_AppendObjToObj(resultPtr, objv[4]);
	}

	if (last < length) {
	    Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
		    length - last);
	}
	resultPtr = TclStringReplace(interp, objv[1], first,
		last + 1 - first, (objc == 5) ? objv[4] : NULL,
		TCL_STRING_IN_PLACE);

	Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
2376
2377
2378
2379
2380
2381
2382
2383

2384
2385
2386
2387
2388
2389
2390
2381
2382
2383
2384
2385
2386
2387

2388
2389
2390
2391
2392
2393
2394
2395







-
+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclStringObjReverse(objv[1]));
    Tcl_SetObjResult(interp, TclStringReverse(objv[1], TCL_STRING_IN_PLACE));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringStartCmd --
2535
2536
2537
2538
2539
2540
2541
2542
2543


2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556


2557
2558
2559


2560
2561
2562
2563
2564
2565
2566
2540
2541
2542
2543
2544
2545
2546


2547
2548


2549
2550
2551
2552
2553
2554
2555
2556
2557


2558
2559
2560


2561
2562
2563
2564
2565
2566
2567
2568
2569







-
-
+
+
-
-









-
-
+
+

-
-
+
+







{
    /*
     * Remember to keep code here in some sync with the byte-compiled versions
     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    const char *string1, *string2;
    int length1, length2, i, match, length, nocase = 0, reqlength = -1;
    const char *string2;
    int length, i, match, nocase = 0, reqlength = -1;
    typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
    strCmpFn_t strCmpFn;

    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string2 = TclGetStringFromObj(objv[i], &length2);
	if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
	string2 = TclGetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string2, "-nocase", (size_t)length)) {
	    nocase = 1;
	} else if ((length2 > 1)
		&& !strncmp(string2, "-length", (size_t)length2)) {
	} else if ((length > 1)
		&& !strncmp(string2, "-length", (size_t)length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588

2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2580
2581
2582
2583
2584
2585
2586





2587



































































2588
2589
2590
2591
2592
2593
2594







-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    /*
     * From now on, we only access the two objects at the end of the argument
     * array.
     */

    objv += objc-2;

    if ((reqlength == 0) || (objv[0] == objv[1])) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 */

    match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
	return TCL_OK;
    }

    if (!nocase && TclIsPureByteArray(objv[0]) &&
	    TclIsPureByteArray(objv[1])) {
	/*
	 * Use binary versions of comparisons since that won't cause undue
	 * type conversions and it is much faster. Only do this if we're
	 * case-sensitive (which is all that really makes sense with byte
	 * arrays anyway, and we have no memcasecmp() for some reason... :^)
	 */

	string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
	string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
	strCmpFn = (strCmpFn_t) memcmp;
    } else if ((objv[0]->typePtr == &tclStringType)
	    && (objv[1]->typePtr == &tclStringType)) {
	/*
	 * Do a unicode-specific comparison if both of the args are of String
	 * type. In benchmark testing this proved the most efficient check
	 * between the unicode and string comparison operations.
	 */

	string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
	string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
	strCmpFn = (strCmpFn_t)
		(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
    } else {
	/*
	 * As a catch-all we will work with UTF-8. We cannot use memcmp() as
	 * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
	 * utf rep). We can use the more efficient TclpUtfNcmp2 if we are
	 * case-sensitive and no specific length was requested.
	 */

	string1 = (char *) TclGetStringFromObj(objv[0], &length1);
	string2 = (char *) TclGetStringFromObj(objv[1], &length2);
	if ((reqlength < 0) && !nocase) {
	    strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
	} else {
	    length1 = Tcl_NumUtfChars(string1, length1);
	    length2 = Tcl_NumUtfChars(string2, length2);
	    strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
	}
    }

    if ((reqlength < 0) && (length1 != length2)) {
	match = 1;		/* This will be reversed below. */
    } else {
	length = (length1 < length2) ? length1 : length2;
	if (reqlength > 0 && reqlength < length) {
	    length = reqlength;
	} else if (reqlength < 0) {
	    /*
	     * The requested length is negative, so we ignore it by setting it
	     * to length + 1 so we correct the match var.
	     */

	    reqlength = length + 1;
	}

	match = strCmpFn(string1, string2, (unsigned) length);
	if ((match == 0) && (reqlength > length)) {
	    match = length1 - length2;
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
2685
2686
2687
2688
2689
2690
2691

2692
2693
2694
2695
2696
























2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709





2710
2711
2712
2713
2714

2715
2716
2717
2718
2719
2720

2721
2722

2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2617
2618
2619
2620
2621
2622
2623
2624





2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656





2657
2658
2659
2660
2661
2662
2663
2664
2665

2666
2667
2668
2669
2670
2671

2672
2673

2674
2675
2676
2677















































































2678
2679
2680
2681
2682
2683
2684







+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
+
+
+
+
+




-
+





-
+

-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







{
    /*
     * Remember to keep code here in some sync with the byte-compiled versions
     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    int match, nocase, reqlength, status;
    const char *string1, *string2;
    int length1, length2, i, match, length, nocase = 0, reqlength = -1;
    typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
    strCmpFn_t strCmpFn;


    status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
    if (status != TCL_OK) {
	return status;
    }

    objv += objc-2;
    match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
    return TCL_OK;
}

int TclStringCmpOpts(
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    int *nocase,
    int *reqlength)
{
    int i, length;
    const char *string;

    *reqlength = -1;
    *nocase = 0;
    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string2 = TclGetStringFromObj(objv[i], &length2);
	if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
	    nocase = 1;
	} else if ((length2 > 1)
		&& !strncmp(string2, "-length", (size_t)length2)) {
	string = TclGetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string, "-nocase", (size_t)length)) {
	    *nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string, "-length", (size_t)length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
	    if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
		    string2));
		    string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string2, NULL);
		    string, NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * From now on, we only access the two objects at the end of the argument
     * array.
     */

    objv += objc-2;

    if ((reqlength == 0) || (objv[0] == objv[1])) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 */

	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
	return TCL_OK;
    }

    if (!nocase && TclIsPureByteArray(objv[0]) &&
	    TclIsPureByteArray(objv[1])) {
	/*
	 * Use binary versions of comparisons since that won't cause undue
	 * type conversions and it is much faster. Only do this if we're
	 * case-sensitive (which is all that really makes sense with byte
	 * arrays anyway, and we have no memcasecmp() for some reason... :^)
	 */

	string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
	string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
	strCmpFn = (strCmpFn_t) memcmp;
    } else if ((objv[0]->typePtr == &tclStringType)
	    && (objv[1]->typePtr == &tclStringType)) {
	/*
	 * Do a unicode-specific comparison if both of the args are of String
	 * type. In benchmark testing this proved the most efficient check
	 * between the unicode and string comparison operations.
	 */

	string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
	string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
	strCmpFn = (strCmpFn_t)
		(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
    } else {
	/*
	 * As a catch-all we will work with UTF-8. We cannot use memcmp() as
	 * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
	 * utf rep). We can use the more efficient TclpUtfNcmp2 if we are
	 * case-sensitive and no specific length was requested.
	 */

	string1 = (char *) TclGetStringFromObj(objv[0], &length1);
	string2 = (char *) TclGetStringFromObj(objv[1], &length2);
	if ((reqlength < 0) && !nocase) {
	    strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
	} else {
	    length1 = Tcl_NumUtfChars(string1, length1);
	    length2 = Tcl_NumUtfChars(string2, length2);
	    strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
	}
    }

    length = (length1 < length2) ? length1 : length2;
    if (reqlength > 0 && reqlength < length) {
	length = reqlength;
    } else if (reqlength < 0) {
	/*
	 * The requested length is negative, so we ignore it by setting it to
	 * length + 1 so we correct the match var.
	 */

	reqlength = length + 1;
    }

    match = strCmpFn(string1, string2, (unsigned) length);
    if ((match == 0) && (reqlength > length)) {
	match = length1 - length2;
    }

    Tcl_SetObjResult(interp,
	    Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringCatCmd --
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848


2849
2850
2851

2852
2853
2854
2855
2856
2857
2858

2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2698
2699
2700
2701
2702
2703
2704

2705
2706
2707
2708
2709
2710
2711
2712
2713







2714
2715
2716


2717


2718
2719
2720
2721

2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742

2743
2744
2745
2746
2747
2748
2749







-









-
-
-
-
-
-
-
+
+

-
-
+
-
-




-
+




















-







static int
StringCatCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int code;
    Tcl_Obj *objResultPtr;

    if (objc < 2) {
	/*
	 * If there are no args, the result is an empty object.
	 * Just leave the preset empty interp result.
	 */
	return TCL_OK;
    }
    if (objc == 2) {
	/*
	 * Other trivial case, single arg, just return it.
	 */
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

    objResultPtr = TclStringCat(interp, objc-1, objv+1, TCL_STRING_IN_PLACE);

    code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1,
	    &objResultPtr);
    if (objResultPtr) {

    if (code == TCL_OK) {
	Tcl_SetObjResult(interp, objResultPtr);
	return TCL_OK;
    }

    return code;
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * StringBytesCmd --
 *
 *	This procedure is invoked to process the "string bytelength" Tcl
 *	command. See the user documentation for details on what it does. Note
 *	that this command only functions correctly on properly formed Tcl UTF
 *	strings.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringBytesCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
3220
3221
3222
3223
3224
3225
3226
3227

3228
3229
3230
3231
3232
3233
3234
3235
3083
3084
3085
3086
3087
3088
3089

3090

3091
3092
3093
3094
3095
3096
3097







-
+
-







	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    triml = TclTrimLeft(string1, length1, string2, length2);
    triml = TclTrim(string1, length1, string2, length2, &trimr);
    trimr = TclTrimRight(string1 + triml, length1 - triml, string2, length2);

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
    return TCL_OK;
}

/*
3526
3527
3528
3529
3530
3531
3532
3533

3534
3535
3536
3537
3538
3539
3540
3388
3389
3390
3391
3392
3393
3394

3395
3396
3397
3398
3399
3400
3401
3402







-
+







	"--", NULL
    };
    enum options {
	OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP,
	OPT_LAST
    };
    typedef int (*strCmpFn_t)(const char *, const char *);
    strCmpFn_t strCmpFn = strcmp;
    strCmpFn_t strCmpFn = TclUtfCmp;

    mode = OPT_EXACT;
    foundmode = 0;
    indexVarObj = NULL;
    matchVarObj = NULL;
    numMatchesSaved = 0;
    noCase = 0;
4289
4290
4291
4292
4293
4294
4295
4296

4297
4298
4299
4300
4301
4302
4303
4151
4152
4153
4154
4155
4156
4157

4158
4159
4160
4161
4162
4163
4164
4165







-
+







	commonHandler:
	    if (Tcl_ListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
		Tcl_DecrRefCount(handlersObj);
		return TCL_ERROR;
	    }

	    info[0] = objv[i];			/* type */
	    TclNewLongObj(info[1], code);	/* returnCode */
	    TclNewIntObj(info[1], code);	/* returnCode */
	    if (info[2] == NULL) {		/* errorCodePrefix */
		TclNewObj(info[2]);
	    }
	    info[3] = objv[i+2];		/* bindVariables */
	    info[4] = objv[i+3];		/* script */

	    bodyShared = !strcmp(TclGetString(objv[i+3]), "-");

Changes to generic/tclCompCmds.c.

318
319
320
321
322
323
324









325
326
327
328
329


330
331
332
333
334
335
336
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347







+
+
+
+
+
+
+
+
+





+
+







    isDataEven = (isDataValid && (len & 1) == 0);

    /*
     * Special case: literal odd-length argument is always an error.
     */

    if (isDataValid && !isDataEven) {
	/* Abandon custom compile and let invocation raise the error */
	code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	goto done;

	/*
	 * We used to compile to the bytecode that would throw the error,
	 * but that was wrong because it would not invoke the array trace
	 * on the variable.
	 *
	PushStringLiteral(envPtr, "list must have an even number of elements");
	PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
	TclEmitInt4(		0,				envPtr);
	goto done;
	 *
	 */
    }

    /*
     * Except for the special "ensure array" case below, when we're not in
     * a proc, we cannot do a better compile than generic.
     */

400
401
402
403
404
405
406




407
408
409
410
411
412
413
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428







+
+
+
+







    infoPtr->varLists[0]->varIndexes[1] = valVar;
    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);

    /*
     * Start issuing instructions to write to the array.
     */

    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);

    CompileWord(envPtr, dataTokenPtr, interp, 2);
    if (!isDataLiteral || !isDataValid) {
	/*
	 * Only need this safety check if we're handling a non-literal or list
	 * containing an invalid literal; with valid list literals, we've
	 * already checked (worth it because literals are a very common
	 * use-case with [array set]).
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
439
440
441
442
443
444
445



446
447
448
449
450
451
452







-
-
-







	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
	TclEmitInt4(		0,				envPtr);
	TclAdjustStackDepth(-1, envPtr);
	fwd = CurrentOffset(envPtr) - offsetFwd;
	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
    }

    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
    TclEmitInstInt4(INST_FOREACH_START, infoIndex,	envPtr);
    offsetBack = CurrentOffset(envPtr);
    Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
    Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
    Emit14Inst(	INST_STORE_ARRAY, localIndex,		envPtr);
    TclEmitOpcode(	INST_POP,			envPtr);
    infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */

Changes to generic/tclCompCmdsGR.c.

23
24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39


40
41
42
43
44
45

46

47
48
49
50
51
52


53


54

55
56
57

58
59

60
61
62
63
64
65
66
67
68


69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
23
24
25
26
27
28
29


30
31
32
33

34
35


36
37

38
39
40
41
42
43

44
45
46
47
48


49
50
51
52
53

54
55
56

57
58

59









60
61






62





63
64
65
66
67
68
69







-
-




-
+

-
-
+
+
-





+
-
+




-
-
+
+

+
+
-
+


-
+

-
+
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-

-
-
-
-
-







 */

static void		CompileReturnInternal(CompileEnv *envPtr,
			    unsigned char op, int code, int level,
			    Tcl_Obj *returnOpts);
static int		IndexTailVarIfKnown(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr);

#define INDEX_END	(-2)

/*
 *----------------------------------------------------------------------
 *
 * GetIndexFromToken --
 * TclGetIndexFromToken --
 *
 *	Parse a token and get the encoded version of the index (as understood
 *	by TEBC), assuming it is at all knowable at compile time. Only handles
 *	Parse a token to determine if an index value is known at
 *	compile time.
 *	indices that are integers or 'end' or 'end-integer'.
 *
 * Returns:
 *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
 *
 * Side effects:
 *	When TCL_OK is returned, the encoded index value is written
 *	Sets *index to the index value if successful.
 *	to *index.
 *
 *----------------------------------------------------------------------
 */

static inline int
GetIndexFromToken(
int
TclGetIndexFromToken(
    Tcl_Token *tokenPtr,
    int before,
    int after,
    int *index)
    int *indexPtr)
{
    Tcl_Obj *tmpObj = Tcl_NewObj();
    int result, idx;
    int result = TCL_ERROR;

    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
    if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
	Tcl_DecrRefCount(tmpObj);
	return TCL_ERROR;
    }

    result = TclGetIntFromObj(NULL, tmpObj, &idx);
    if (result == TCL_OK) {
	if (idx < 0) {
	    result = TCL_ERROR;
	}
	result = TclIndexEncode(NULL, tmpObj, before, after, indexPtr);
    }
    } else {
	result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
	if (result == TCL_OK && idx > INDEX_END) {
	    result = TCL_ERROR;
	}
    }
    Tcl_DecrRefCount(tmpObj);

    if (result == TCL_OK) {
	*index = idx;
    }

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileGlobalCmd --
140
141
142
143
144
145
146

147
148
149





150
151
152
153
154
155
156
122
123
124
125
126
127
128
129



130
131
132
133
134
135
136
137
138
139
140
141







+
-
-
-
+
+
+
+
+







    for (i=1; i<numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if (localIndex < 0) {
	    return TCL_ERROR;
	}

	/*
	/* TODO: Consider what value can pass throug the
	 * IndexTailVarIfKnown() screen.  Full CompileWord()
	 * likely does not apply here.  Push known value instead. */
	 * TODO: Consider what value can pass through the
	 * IndexTailVarIfKnown() screen. Full CompileWord() likely does not
	 * apply here. Push known value instead.
	 */

	CompileWord(envPtr, varTokenPtr, interp, i);
	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */
283
284
285
286
287
288
289
290

291
292
293
294
295
296
297
268
269
270
271
272
273
274

275
276
277
278
279
280
281
282







-
+







		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
		    TclExpandJumpFixupArray(&jumpFalseFixupArray);
		}
		jumpIndex = jumpFalseFixupArray.next;
		jumpFalseFixupArray.next++;
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
			jumpFalseFixupArray.fixup+jumpIndex);
			jumpFalseFixupArray.fixup + jumpIndex);
	    }
	    code = TCL_OK;
	}

	/*
	 * Skip over the optional "then" before the then clause.
	 */
330
331
332
333
334
335
336
337

338
339
340
341
342
343
344
345
346
347
348
349

350
351
352
353
354
355
356
315
316
317
318
319
320
321

322
323
324
325
326
327
328
329
330
331
332
333

334
335
336
337
338
339
340
341







-
+











-
+







	     */

	    if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
		TclExpandJumpFixupArray(&jumpEndFixupArray);
	    }
	    jumpEndFixupArray.next++;
	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
		    jumpEndFixupArray.fixup+jumpIndex);
		    jumpEndFixupArray.fixup + jumpIndex);

	    /*
	     * Fix the target of the jumpFalse after the test. Generate a 4
	     * byte jump if the distance is > 120 bytes. This is conservative,
	     * and ensures that we won't have to replace this jump if we later
	     * also need to replace the proceeding jump to the end of the "if"
	     * with a 4 byte jump.
	     */

	    TclAdjustStackDepth(-1, envPtr);
	    if (TclFixupForwardJumpToHere(envPtr,
		    jumpFalseFixupArray.fixup+jumpIndex, 120)) {
		    jumpFalseFixupArray.fixup + jumpIndex, 120)) {
		/*
		 * Adjust the code offset for the proceeding jump to the end
		 * of the "if" command.
		 */

		jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
	    }
425
426
427
428
429
430
431
432

433
434
435
436
437
438
439
410
411
412
413
414
415
416

417
418
419
420
421
422
423
424







-
+







    /*
     * Fix the unconditional jumps to the end of the "if" command.
     */

    for (j = jumpEndFixupArray.next;  j > 0;  j--) {
	jumpIndex = (j - 1);	/* i.e. process the closest jump first. */
	if (TclFixupForwardJumpToHere(envPtr,
		jumpEndFixupArray.fixup+jumpIndex, 127)) {
		jumpEndFixupArray.fixup + jumpIndex, 127)) {
	    /*
	     * Adjust the immediately preceeding "ifFalse" jump. We moved it's
	     * target (just after this jump) down three bytes.
	     */

	    unsigned char *ifFalsePc = envPtr->codeStart
		    + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
933
934
935
936
937
938
939
940

941
942
943
944
945
946
947
918
919
920
921
922
923
924

925
926
927
928
929
930
931
932







-
+







    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
	    &localIndex, &isScalar, 1);
    valueTokenPtr = TokenAfter(varTokenPtr);
    for (i = 2 ; i < numWords ; i++) {
	CompileWord(envPtr, valueTokenPtr, interp, i);
	valueTokenPtr = TokenAfter(valueTokenPtr);
    }
    TclEmitInstInt4(	    INST_LIST, numWords-2,		envPtr);
    TclEmitInstInt4(	    INST_LIST, numWords - 2,		envPtr);
    if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(  INST_LAPPEND_LIST_STK,		envPtr);
	} else {
	    TclEmitInstInt4(INST_LAPPEND_LIST, localIndex,	envPtr);
	}
    } else {
1010
1011
1012
1013
1014
1015
1016
1017

1018
1019
1020
1021
1022
1023
1024
995
996
997
998
999
1000
1001

1002
1003
1004
1005
1006
1007
1008
1009







-
+







	tokenPtr = TokenAfter(tokenPtr);

	/*
	 * Generate the next variable name.
	 */

	PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
		&isScalar, idx+2);
		&isScalar, idx + 2);

	/*
	 * Emit instructions to get the idx'th item out of the list value on
	 * the stack and assign it to the variable.
	 */

	if (isScalar) {
1049
1050
1051
1052
1053
1054
1055
1056

1057
1058
1059
1060
1061
1062
1063
1034
1035
1036
1037
1038
1039
1040

1041
1042
1043
1044
1045
1046
1047
1048







-
+







    }

    /*
     * Generate code to leave the rest of the list on the stack.
     */

    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx,	envPtr);
    TclEmitInt4(			INDEX_END,		envPtr);
    TclEmitInt4(			TCL_INDEX_END,		envPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1100
1101
1102
1103
1104
1105
1106

1107

1108
1109
1110
1111
1112




1113
1114

1115
1116
1117
1118
1119
1120
1121
1085
1086
1087
1088
1089
1090
1091
1092

1093
1094




1095
1096
1097
1098


1099
1100
1101
1102
1103
1104
1105
1106







+
-
+

-
-
-
-
+
+
+
+
-
-
+








    valTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (numWords != 3) {
	goto emitComplexLindex;
    }

    idxTokenPtr = TokenAfter(valTokenPtr);
    if (TclGetIndexFromToken(idxTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_BEFORE,
    if (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) {
	    &idx) == TCL_OK) {
	/*
	 * All checks have been completed, and we have exactly one of these
	 * constructs:
	 *	 lindex <arbitraryValue> <posInt>
	 *	 lindex <arbitraryValue> end-<posInt>
	 * The idxTokenPtr parsed as a valid index value and was
	 * encoded as expected by INST_LIST_INDEX_IMM.
	 *
	 * NOTE: that we rely on indexing before a list producing the
	 * This is best compiled as a push of the arbitrary value followed by
	 * an "immediate lindex" which is the most efficient variety.
	 * same result as indexing after a list.
	 */

	CompileWord(envPtr, valTokenPtr, interp, 1);
	TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
	return TCL_OK;
    }

1254
1255
1256
1257
1258
1259
1260
1261

1262
1263
1264
1265
1266
1267
1268
1239
1240
1241
1242
1243
1244
1245

1246
1247
1248
1249
1250
1251
1252
1253







-
+







     * at this point. We use an [lrange ... 0 end] for this (instead of
     * [llength], as with literals) as we must drop any string representation
     * that might be hanging around.
     */

    if (concat && numWords == 2) {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,	envPtr);
	TclEmitInt4(			INDEX_END,	envPtr);
	TclEmitInt4(			TCL_INDEX_END,	envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341

1342

1343
1344




1345
1346

1347

1348
1349




1350
1351
1352
1353
1354
1355
1356
1313
1314
1315
1316
1317
1318
1319






1320
1321

1322
1323
1324
1325
1326
1327
1328
1329
1330
1331

1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345







-
-
-
-
-
-

+
-
+


+
+
+
+


+
-
+


+
+
+
+







    int idx1, idx2;

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Parse the indices. Will only compile if both are constants and not an
     * _integer_ less than zero (since we reserve negative indices here for
     * end-relative indexing) or an end-based index greater than 'end' itself.
     */

    tokenPtr = TokenAfter(listTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
    if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
	    &idx1) != TCL_OK) {
	return TCL_ERROR;
    }
    /*
     * Token was an index value, and we treat all "first" indices
     * before the list same as the start of the list.
     */

    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
    if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
	    &idx2) != TCL_OK) {
	return TCL_ERROR;
    }
    /*
     * Token was an index value, and we treat all "last" indices
     * after the list same as the end of the list.
     */

    /*
     * Issue instructions. It's not safe to skip doing the LIST_RANGE, as
     * we've not proved that the 'list' argument is really a list. Not that it
     * is worth trying to do that given current knowledge.
     */

1392
1393
1394
1395
1396
1397
1398









1399

1400
1401
1402
1403
1404
1405
1406

1407
1408
1409
1410
1411
1412
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
1444
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396

1397
1398
1399
1400
1401
1402
1403

1404
1405
1406
1407
1408
1409
1410

1411
1412
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

1444
1445
1446

1447
1448
1449
1450
1451
1452
1453
1454







+
+
+
+
+
+
+
+
+
-
+






-
+






-
+







-
+

-
+


-
+


+
+
+
+
+
+
+
+
+
+
+
+
-
+




-
+


-
+







    /*
     * Parse the index. Will only compile if it is constant and not an
     * _integer_ less than zero (since we reserve negative indices here for
     * end-relative indexing) or an end-based index greater than 'end' itself.
     */

    tokenPtr = TokenAfter(listTokenPtr);

    /*
     * NOTE: This command treats all inserts at indices before the list
     * the same as inserts at the start of the list, and all inserts
     * after the list the same as inserts at the end of the list. We
     * make that transformation here so we can use the optimized bytecode
     * as much as possible.
     */
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_END,
    if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) {
	    &idx) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * There are four main cases. If there are no values to insert, this is
     * just a confirm-listiness check. If the index is '0', this is a prepend.
     * If the index is 'end' (== INDEX_END), this is an append. Otherwise,
     * If the index is 'end' (== TCL_INDEX_END), this is an append. Otherwise,
     * this is a splice (== split, insert values as list, concat-3).
     */

    CompileWord(envPtr, listTokenPtr, interp, 1);
    if (parsePtr->numWords == 3) {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			INDEX_END,		envPtr);
	TclEmitInt4(			TCL_INDEX_END,		envPtr);
	return TCL_OK;
    }

    for (i=3 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }
    TclEmitInstInt4(		INST_LIST, i-3,			envPtr);
    TclEmitInstInt4(		INST_LIST, i - 3,		envPtr);

    if (idx == 0 /*start*/) {
    if (idx == TCL_INDEX_START) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    } else if (idx == INDEX_END /*end*/) {
    } else if (idx == TCL_INDEX_END) {
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    } else {
	/*
	 * Here we handle two ranges for idx. First when idx > 0, we
	 * want the first half of the split to end at index idx-1 and
	 * the second half to start at index idx.
	 * Second when idx < TCL_INDEX_END, indicating "end-N" indexing,
	 * we want the first half of the split to end at index end-N and
	 * the second half to start at index end-N+1. We accomplish this
	 * with a pre-adjustment of the end-N value.
	 * The root of this is that the commands [lrange] and [linsert]
	 * differ in their interpretation of the "end" index.
	 */

	if (idx < 0) {
	if (idx < TCL_INDEX_END) {
	    idx++;
	}
	TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			idx-1,			envPtr);
	TclEmitInt4(			idx - 1,		envPtr);
	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx,	envPtr);
	TclEmitInt4(			INDEX_END,		envPtr);
	TclEmitInt4(			TCL_INDEX_END,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    }

    return TCL_OK;
}

1460
1461
1462
1463
1464
1465
1466
1467
1468


1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481

1482

1483
1484
1485
1486

1487

1488
1489
1490
1491
1492




1493

1494

1495
1496
1497
1498
1499

1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522



1523
1524
1525

1526
1527
1528
1529
1530





1531
1532

1533
1534
1535


1536
1537
1538
1539

1540
1541



1542
1543
1544
1545
1546
1547
1548











1549
1550
1551
1552
1553
1554

1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572

1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586

1587
1588
1589
1590
1591
1592
1593
1594
1595

1596
1597
1598
1599
1600
1601
1602

1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631




1632
1633

1634
1635
1636





1637
1638
1639
1640
1641


1642

1643
1644
1645



1646
1647

1648
1649
1650
1651
1652





1653
1654

1655
1656
1657
1658
1659
1660

1661
1662
1663

1664
1665
1666
1667
1668
1669
1670
1671
1672




1673
1674
1675
1676

1677

1678
1679
1680
1681
1682
1683


1684
1685
1686
1687
1688
1689
1690

1691
1692



1693
1694
1695
1696

1697
1698


1699
1700
1701
1702

1703
1704
1705
1706

1707
1708
1709
1710

1711
1712
1713
1714
1715
1716
1717
1470
1471
1472
1473
1474
1475
1476


1477
1478
1479
1480
1481
1482
1483
1484






1485
1486

1487
1488
1489
1490
1491
1492

1493
1494
1495
1496
1497

1498
1499
1500
1501
1502
1503

1504





1505




1506




1507













1508
1509
1510



1511





1512
1513
1514
1515
1516


1517



1518
1519




1520


1521
1522
1523







1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534






1535


















1536














1537


1538






1539







1540



1541

























1542
1543
1544
1545


1546



1547
1548
1549
1550
1551




1552
1553
1554

1555



1556
1557
1558


1559





1560
1561
1562
1563
1564


1565






1566



1567









1568
1569
1570
1571



1572
1573

1574






1575
1576







1577


1578
1579
1580




1581


1582
1583




1584




1585




1586
1587
1588
1589
1590
1591
1592
1593







-
-
+
+






-
-
-
-
-
-

+
-
+




+
-
+




-
+
+
+
+

+
-
+
-
-
-
-
-
+
-
-
-
-

-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
+
+
-
-
-
-
+
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-

-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
+
-
-
-
+
+
+
+
+
-
-
-
-

+
+
-
+
-
-
-
+
+
+
-
-
+
-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-

+
-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
+
-
-
+
+
+
-
-
-
-
+
-
-
+
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
+







				 * command. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *tokenPtr, *listTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    Tcl_Obj *tmpObj;
    int idx1, idx2, i, offset, offset2;
    int idx1, idx2, i;
    int emptyPrefix=1, suffixStart = 0;

    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Parse the indices. Will only compile if both are constants and not an
     * _integer_ less than zero (since we reserve negative indices here for
     * end-relative indexing) or an end-based index greater than 'end' itself.
     */

    tokenPtr = TokenAfter(listTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
    if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
	    &idx1) != TCL_OK) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
    if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
	    &idx2) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * idx1, idx2 are now in canonical form:
     * General structure of the [lreplace] result is
     *		prefix replacement suffix
     * In a few cases we can predict various parts will be empty and
     * take advantage.
     *
     * The proper suffix begins with the greater of indices idx1 or
     *  - integer:	[0,len+1]
     * idx2 + 1. If we cannot tell at compile time which is greater,
     *  - end index:    INDEX_END
     *  - -ive offset:  INDEX_END-[len-1,0]
     *  - +ive offset:  INDEX_END+1
     */

     * we must defer to direct evaluation.
    /*
     * Compilation fails when one index is end-based but the other isn't.
     * Fixing this will require more bytecodes, but this is a workaround for
     * now. [Bug 47ac84309b]
     */

    if ((idx1 <= INDEX_END) != (idx2 <= INDEX_END)) {
	return TCL_ERROR;
    }

    if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
	idx2 = idx1 - 1;
    }

    /*
     * Work out what this [lreplace] is actually doing.
     */

    tmpObj = NULL;
    CompileWord(envPtr, listTokenPtr, interp, 1);
    if (parsePtr->numWords == 4) {
	if (idx1 == 0) {
	    if (idx2 == INDEX_END) {
    if (idx1 == TCL_INDEX_AFTER) {
	suffixStart = idx1;
    } else if (idx2 == TCL_INDEX_BEFORE) {
		goto dropAll;
	    }
	    idx1 = idx2 + 1;
	suffixStart = idx1;
	    idx2 = INDEX_END;
	    goto dropEnd;
	} else if (idx2 == INDEX_END) {
	    idx2 = idx1 - 1;
	    idx1 = 0;
    } else if (idx2 == TCL_INDEX_END) {
	suffixStart = TCL_INDEX_AFTER;
    } else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END))
	    || ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) {
	suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
	    goto dropEnd;
	} else {
    } else {
	    if (idx2 < idx1) {
		idx2 = idx1 - 1;
	    }
	return TCL_ERROR;
    }
	    if (idx1 > 0) {
		tmpObj = Tcl_NewIntObj(idx1);
		Tcl_IncrRefCount(tmpObj);
	    }

	    goto dropRange;
	}
    /* All paths start with computing/pushing the original value. */
    CompileWord(envPtr, listTokenPtr, interp, 1);

    }

    tokenPtr = TokenAfter(tokenPtr);
    for (i=4 ; i<parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    /*
     * Push all the replacement values next so any errors raised in
     * creating them get raised first.
     */
    if (parsePtr->numWords > 4) {
	/* Push the replacement arguments */
	tokenPtr = TokenAfter(tokenPtr);
	for (i=4 ; i<parsePtr->numWords ; i++) {
	    CompileWord(envPtr, tokenPtr, interp, i);
	    tokenPtr = TokenAfter(tokenPtr);
	}
    TclEmitInstInt4(		INST_LIST, i - 4,		envPtr);
    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
    if (idx1 == 0) {
	if (idx2 == INDEX_END) {
	    goto replaceAll;
	}

	idx1 = idx2 + 1;
	idx2 = INDEX_END;
	goto replaceHead;
    } else if (idx2 == INDEX_END) {
	idx2 = idx1 - 1;
	idx1 = 0;
	goto replaceTail;
    } else {
	if (idx2 < idx1) {
	    idx2 = idx1 - 1;
	}
	if (idx1 > 0) {
	    tmpObj = Tcl_NewIntObj(idx1);
	    Tcl_IncrRefCount(tmpObj);
	}
	goto replaceRange;
    }

	/* Make a list of them... */
    /*
     * Issue instructions to perform the operations relating to configurations
     * that just drop. The only argument pushed on the stack is the list to
     * operate on.
     */

  dropAll:			/* This just ensures the arg is a list. */
    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);
    PushStringLiteral(envPtr,	"");
    goto done;

  dropEnd:
    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
	TclEmitInstInt4(	INST_LIST, i - 4,		envPtr);
    TclEmitInt4(			idx2,			envPtr);
    goto done;

  dropRange:
    if (tmpObj != NULL) {
	/*
	 * Emit bytecode to check the list length.
	 */

	emptyPrefix = 0;
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
	TclEmitOpcode(		INST_GE,			envPtr);
	offset = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);

    }
	/*
	 * Emit an error if we've been given an empty list.
	 */

	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	offset2 = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
		"list doesn't contain element %d", idx1), NULL), envPtr);
	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
		envPtr->codeStart + offset + 1);
	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
		envPtr->codeStart + offset2 + 1);
	TclAdjustStackDepth(-1, envPtr);
    }
    TclEmitOpcode(		INST_DUP,			envPtr);
    TclEmitInstInt4(		INST_LIST_RANGE_IMM, 0,		envPtr);
    TclEmitInt4(			idx1 - 1,		envPtr);
    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx2 + 1,	envPtr);
    TclEmitInt4(			INDEX_END,		envPtr);
    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    goto done;

    /*
     * Issue instructions to perform the operations relating to configurations
    if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
	/*
	 * This is a "no-op". Example: [lreplace {a b c} 2 0]
	 * We still do a list operation to get list-verification
     * that do real replacement. All arguments are pushed and assembled into a
     * pair: the list of values to replace with, and the list to do the
	 * and canonicalization side effects.
     * surgery on.
     */

	 */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			TCL_INDEX_END,		envPtr);
	return TCL_OK;
    }
  replaceAll:
    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);
    goto done;

    if (idx1 != TCL_INDEX_START) {
	/* Prefix may not be empty; generate bytecode to push it */
  replaceHead:
	if (emptyPrefix) {
    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
    TclEmitInt4(			idx2,			envPtr);
    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
	    TclEmitOpcode(	INST_DUP,			envPtr);
	} else {
	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
    goto done;

	}
  replaceTail:
    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
    TclEmitInt4(			idx2,			envPtr);
    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			idx1 - 1,		envPtr);
	if (!emptyPrefix) {
	    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
    goto done;

	}
  replaceRange:
    if (tmpObj != NULL) {
	/*
	 * Emit bytecode to check the list length.
	 */

	emptyPrefix = 0;
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);

    }
	/*
	 * Check the list length vs idx1.
	 */

	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
	TclEmitOpcode(		INST_GE,			envPtr);
	offset = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);


    if (!emptyPrefix) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
    }
	/*
	 * Emit an error if we've been given an empty list.
	 */

    if (suffixStart == TCL_INDEX_AFTER) {
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	offset2 = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
		"list doesn't contain element %d", idx1), NULL), envPtr);
	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
	if (emptyPrefix) {
	    PushStringLiteral(envPtr, "");
		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
		envPtr->codeStart + offset + 1);
	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
		envPtr->codeStart + offset2 + 1);
	TclAdjustStackDepth(-1, envPtr);
    }
	}
    TclEmitOpcode(		INST_DUP,			envPtr);
    TclEmitInstInt4(		INST_LIST_RANGE_IMM, 0,		envPtr);
    } else {
	/* Suffix may not be empty; generate bytecode to push it */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, suffixStart, envPtr);
    TclEmitInt4(			idx1 - 1,		envPtr);
    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx2 + 1,	envPtr);
    TclEmitInt4(			INDEX_END,		envPtr);
	TclEmitInt4(			TCL_INDEX_END,		envPtr);
    TclEmitInstInt4(		INST_REVERSE, 3,		envPtr);
    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
	if (!emptyPrefix) {
	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    goto done;

	}
    /*
     * Clean up the allocated memory.
     */

    }
  done:
    if (tmpObj != NULL) {
	Tcl_DecrRefCount(tmpObj);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLsetCmd --
2305
2306
2307
2308
2309
2310
2311
2312

2313
2314
2315
2316
2317
2318
2319
2320

2321
2322
2323
2324
2325
2326
2327
2181
2182
2183
2184
2185
2186
2187

2188
2189
2190
2191
2192
2193
2194
2195

2196
2197
2198
2199
2200
2201
2202
2203







-
+







-
+







	    simple = 1;
	    PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
	    Tcl_DStringFree(&ds);
	}
    }

    if (!simple) {
	CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
	CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 2);
    }

    /*
     * Push the string arg.
     */

    varTokenPtr = TokenAfter(varTokenPtr);
    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 1);

    if (simple) {
	if (exact && !nocase) {
	    TclEmitOpcode(	INST_STR_EQ,			envPtr);
	} else {
	    TclEmitInstInt1(	INST_STR_MATCH, nocase,		envPtr);
	}
2497
2498
2499
2500
2501
2502
2503
2504

2505
2506
2507
2508
2509
2510
2511
2373
2374
2375
2376
2377
2378
2379

2380
2381
2382
2383
2384
2385
2386
2387







-
+







     */

    result = TCL_OK;
    bytes = Tcl_DStringValue(&pattern) + 1;
    PushLiteral(envPtr,	bytes, len);
    bytes = TclGetStringFromObj(replacementObj, &len);
    PushLiteral(envPtr,	bytes, len);
    CompileWord(envPtr,	stringTokenPtr, interp, parsePtr->numWords-2);
    CompileWord(envPtr,	stringTokenPtr, interp, parsePtr->numWords - 2);
    TclEmitOpcode(	INST_STR_MAP,	envPtr);

  done:
    Tcl_DStringFree(&pattern);
    if (patternObj) {
	Tcl_DecrRefCount(patternObj);
    }
2626
2627
2628
2629
2630
2631
2632
2633

2634
2635
2636
2637
2638
2639
2640
2502
2503
2504
2505
2506
2507
2508

2509
2510
2511
2512
2513
2514
2515
2516







-
+








    /*
     * All options are known at compile time, so we're going to bytecompile.
     * Emit instructions to push the result on the stack.
     */

    if (explicitResult) {
	 CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
	 CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
    } else {
	/*
	 * No explict result argument, so default result is empty string.
	 */

	PushStringLiteral(envPtr, "");
    }
2704
2705
2706
2707
2708
2709
2710
2711

2712
2713
2714
2715
2716
2717
2718
2580
2581
2582
2583
2584
2585
2586

2587
2588
2589
2590
2591
2592
2593
2594







-
+







    TclEmitInstInt4(INST_LIST, numOptionWords, envPtr);

    /*
     * Push the result.
     */

    if (explicitResult) {
	CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
	CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
    } else {
	PushStringLiteral(envPtr, "");
    }

    /*
     * Issue the RETURN itself.
     */
2929
2930
2931
2932
2933
2934
2935
2936

2937
2938
2939
2940
2941
2942

2943
2944
2945
2946
2947

2948
2949
2950
2951
2952
2953
2954
2805
2806
2807
2808
2809
2810
2811

2812
2813
2814
2815
2816
2817

2818
2819
2820
2821
2822

2823
2824
2825
2826
2827
2828
2829
2830







-
+





-
+




-
+








	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if (localIndex < 0) {
	    return TCL_ERROR;
	}

	/* TODO: Consider what value can pass throug the
	/* TODO: Consider what value can pass through the
	 * IndexTailVarIfKnown() screen.  Full CompileWord()
	 * likely does not apply here.  Push known value instead. */
	CompileWord(envPtr, varTokenPtr, interp, i);
	TclEmitInstInt4(	INST_VARIABLE, localIndex,	envPtr);

	if (i+1 < numWords) {
	if (i + 1 < numWords) {
	    /*
	     * A value has been given: set the variable, pop the value
	     */

	    CompileWord(envPtr, valueTokenPtr, interp, i+1);
	    CompileWord(envPtr, valueTokenPtr, interp, i + 1);
	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
	    TclEmitOpcode(	INST_POP,			envPtr);
	}
    }

    /*
     * Set the result to empty
3016
3017
3018
3019
3020
3021
3022
3023

3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037

3038
3039
3040
3041
3042
3043
3044
2892
2893
2894
2895
2896
2897
2898

2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912

2913
2914
2915
2916
2917
2918
2919
2920







-
+













-
+







	}
	Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size);
    }

    tailName = TclGetStringFromObj(tailPtr, &len);

    if (len) {
	if (*(tailName+len-1) == ')') {
	if (*(tailName + len - 1) == ')') {
	    /*
	     * Possible array: bail out
	     */

	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}

	/*
	 * Get the tail: immediately after the last '::'
	 */

	for (p = tailName + len -1; p > tailName; p--) {
	    if ((*p == ':') && (*(p-1) == ':')) {
	    if ((*p == ':') && (*(p - 1) == ':')) {
		p++;
		break;
	    }
	}
	if (!full && (p == tailName)) {
	    /*
	     * No :: in the last component.

Changes to generic/tclCompCmdsSZ.c.

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
128
129
130
131
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
161
162
163
164
165
166
167
168
103
104
105
106
107
108
109




















































110
111
112
113
114
115
116







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







#define LOAD(idx) \
    if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
#define STORE(idx) \
    if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
#define INVOKE(name) \
    TclEmitInvoke(envPtr,INST_##name)

#define INDEX_END	(-2)

/*
 *----------------------------------------------------------------------
 *
 * GetIndexFromToken --
 *
 *	Parse a token and get the encoded version of the index (as understood
 *	by TEBC), assuming it is at all knowable at compile time. Only handles
 *	indices that are integers or 'end' or 'end-integer'.
 *
 * Returns:
 *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
 *
 * Side effects:
 *	Sets *index to the index value if successful.
 *
 *----------------------------------------------------------------------
 */

static inline int
GetIndexFromToken(
    Tcl_Token *tokenPtr,
    int *index)
{
    Tcl_Obj *tmpObj = Tcl_NewObj();
    int result, idx;

    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
	Tcl_DecrRefCount(tmpObj);
	return TCL_ERROR;
    }

    result = TclGetIntFromObj(NULL, tmpObj, &idx);
    if (result == TCL_OK) {
	if (idx < 0) {
	    result = TCL_ERROR;
	}
    } else {
	result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
	if (result == TCL_OK && idx > INDEX_END) {
	    result = TCL_ERROR;
	}
    }
    Tcl_DecrRefCount(tmpObj);

    if (result == TCL_OK) {
	*index = idx;
    }

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileSetCmd --
 *
 *	Procedure called to compile the "set" command.
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753

754
755
756
757
758
759
760
687
688
689
690
691
692
693




694
695
696
697
698
699
700
701
702
703
704
705







-
-
-
-




+







	} else {
	    OP(		NUM_TYPE);
	    OP(		DUP);
	    JUMP1(	JUMP_FALSE, end);
	}

	switch (t) {
	case STR_IS_INT:
	    PUSH(	"1");
	    OP(		EQ);
	    break;
	case STR_IS_WIDE:
	    PUSH(	"2");
	    OP(		LE);
	    break;
	case STR_IS_INT:
	case STR_IS_ENTIER:
	    PUSH(	"3");
	    OP(		LE);
	    break;
	}
	FIXJUMP1(	end);
	return TCL_OK;
978
979
980
981
982
983
984



985
986
987
988
989


990
991













992

993










994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025

1026
1027

1028
1029
1030
1031


1032

1033
1034
1035
1036








1037
1038
1039
1040

1041
1042
1043
1044
1045
1046
1047



1048
1049
1050
1051
1052
1053
1054
















1055
1056
1057
1058
1059
1060
1061











1062
1063
1064

1065
1066









1067






1068

1069
1070

1071
1072
1073
1074
1075
1076






1077
1078
1079
1080
1081
1082
1083


1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096


































1097



1098
1099
1100
1101
1102
1103
1104











1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115


1116


1117
1118
1119
1120




1121
1122
1123
1124
1125
1126



1127
1128


























1129
1130
1131
1132
1133
1134

1135
1136


1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
923
924
925
926
927
928
929
930
931
932
933
934
935
936

937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953

954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971

972
973
974
975
976
977
978
979

980
981
982
983
984
985
986
987
988
989
990
991
992
993
994

995
996

997
998
999
1000
1001
1002
1003
1004
1005




1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016

1017



1018



1019
1020
1021
1022
1023
1024




1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041






1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052



1053
1054

1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070

1071


1072






1073
1074
1075
1076
1077
1078







1079
1080













1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118







1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129











1130
1131

1132
1133
1134

1135

1136
1137
1138
1139
1140
1141




1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173

1174
1175
1176
1177
1178


1179
1180
1181
1182
1183
1184
1185

1186
1187
1188
1189
1190
1191
1192







+
+
+




-
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
-
+

+
+
+
+
+
+
+
+
+
+






-








-















-
+

-
+




+
+

+
-
-
-
-
+
+
+
+
+
+
+
+



-
+
-
-
-

-
-
-
+
+
+



-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+

-
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
-
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
-
+
+

-

-
+
+
+
+


-
-
-
-
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-




+
-
-
+
+





-







    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    stringTokenPtr = TokenAfter(parsePtr->tokenPtr);
    fromTokenPtr = TokenAfter(stringTokenPtr);
    toTokenPtr = TokenAfter(fromTokenPtr);

    /* Every path must push the string argument */
    CompileWord(envPtr, stringTokenPtr,			interp, 1);

    /*
     * Parse the two indices.
     */

    if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) {
    if (TclGetIndexFromToken(fromTokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
	    &idx1) != TCL_OK) {
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices before
     * the string the same as the start of the string.
     */

    if (idx1 == TCL_INDEX_AFTER) {
	/* [string range $s end+1 $last] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
    if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) {
	    &idx2) != TCL_OK) {
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices after
     * the string the same as the end of the string.
     */
    if (idx2 == TCL_INDEX_BEFORE) {
	/* [string range $s $first -1] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    /*
     * Push the operand onto the stack and then the substring operation.
     */

    CompileWord(envPtr, stringTokenPtr,			interp, 1);
    OP44(		STR_RANGE_IMM, idx1, idx2);
    return TCL_OK;

    /*
     * Push the operands onto the stack and then the substring operation.
     */

  nonConstantIndices:
    CompileWord(envPtr, stringTokenPtr,			interp, 1);
    CompileWord(envPtr, fromTokenPtr,			interp, 2);
    CompileWord(envPtr, toTokenPtr,			interp, 3);
    OP(			STR_RANGE);
    return TCL_OK;
}

int
TclCompileStringReplaceCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for context. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
				 * command. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *tokenPtr, *valueTokenPtr, *replacementTokenPtr = NULL;
    Tcl_Token *tokenPtr, *valueTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int idx1, idx2;
    int first, last;

    if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
	return TCL_ERROR;
    }

    /* Bytecode to compute/push string argument being replaced */
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, valueTokenPtr, interp, 1);
    if (parsePtr->numWords == 5) {
	tokenPtr = TokenAfter(valueTokenPtr);
	tokenPtr = TokenAfter(tokenPtr);
	replacementTokenPtr = TokenAfter(tokenPtr);

    /*
     * Check for first index known and useful at compile time.
     */
    tokenPtr = TokenAfter(valueTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
	    &first) != TCL_OK) {
	goto genericReplace;
    }

    /*
     * Parse the indices. Will only compile special cases if both are
     * Check for last index known and useful at compile time.
     * constants and not an _integer_ less than zero (since we reserve
     * negative indices here for end-relative indexing) or an end-based index
     * greater than 'end' itself.
     */

    tokenPtr = TokenAfter(valueTokenPtr);
    if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
	    &last) != TCL_OK) {
	goto genericReplace;
    }

    tokenPtr = TokenAfter(tokenPtr);
    if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
	goto genericReplace;
    }
    /*
     * [string replace] is an odd bird.  For many arguments it is
     * a conventional substring replacer.  However it also goes out
     * of its way to become a no-op for many cases where it would be
     * replacing an empty substring.  Precisely, it is a no-op when
     *
     *		(last < first)		OR
     *		(last < 0)		OR
     *		(end < first)
     *
     * For some compile-time values we can detect these cases, and
     * compile direct to bytecode implementing the no-op.
     */

    if ((last == TCL_INDEX_BEFORE)		/* Know (last < 0) */
	    || (first == TCL_INDEX_AFTER)	/* Know (first > end) */

    /*
     * We handle these replacements specially: first character (where
     * idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything
     * else and the semantics get rather screwy.
     */

	/*
	 * Tricky to determine when runtime (last < first) can be
	 * certainly known based on the encoded values. Consider the
	 * cases...
	 *
	 * (first <= TCL_INDEX_END) &&
	 *	(last == TCL_INDEX_AFTER) => cannot tell REJECT
	 *	(last <= TCL_INDEX END) && (last < first) => ACCEPT
	 *	else => cannot tell REJECT
	 */
	    || ((first <= TCL_INDEX_END) && (last <= TCL_INDEX_END)
    if (idx1 == 0 && idx2 == 0) {
	int notEq, end;

		&& (last < first))		/* Know (last < first) */
	/*
	 * Just working with the first character.
	 * (first == TCL_INDEX_BEFORE) &&
	 *	(last == TCL_INDEX_AFTER) => (first < last) REJECT
	 *	(last <= TCL_INDEX_END) => cannot tell REJECT
	 *	else		=> (first < last) REJECT
	 *
	 * else [[first >= TCL_INDEX_START]] &&
	 *	(last == TCL_INDEX_AFTER) => cannot tell REJECT
	 *	(last <= TCL_INDEX_END) => cannot tell REJECT
	 *	else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT
	 */
	    || ((first >= TCL_INDEX_START) && (last >= TCL_INDEX_START)
		&& (last < first))) {		/* Know (last < first) */
	if (parsePtr->numWords == 5) {
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, 4);
	    OP(		POP);		/* Pop newString */

	}
	CompileWord(envPtr, valueTokenPtr, interp, 1);
	if (replacementTokenPtr == NULL) {
	/* Original string argument now on TOS as result */
	    /* Drop first */
	    OP44(	STR_RANGE_IMM, 1, INDEX_END);
	    return TCL_OK;
	}
	/* Replace first */
	CompileWord(envPtr, replacementTokenPtr, interp, 4);
	return TCL_OK;
    }

    if (parsePtr->numWords == 5) {
    /*
     * When we have a string replacement, we have to take care about
	OP4(		OVER, 1);
	PUSH(		"");
	OP(		STR_EQ);
	JUMP1(		JUMP_FALSE, notEq);
	OP(		POP);
	JUMP1(		JUMP, end);
	FIXJUMP1(notEq);
     * not replacing empty substrings that [string replace] promises
     * not to replace
	TclAdjustStackDepth(1, envPtr);
	OP4(		REVERSE, 2);
	OP44(		STR_RANGE_IMM, 1, INDEX_END);
	OP1(		STR_CONCAT1, 2);
	FIXJUMP1(end);
	return TCL_OK;

    } else if (idx1 == INDEX_END && idx2 == INDEX_END) {
	int notEq, end;

	/*
	 * Just working with the last character.
	 */
     *
     * 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_BEFORE) 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 indices (last >= TCL_INDEX_START) and
     * (last == TCL_INDEX_AFTER) 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_BEFORE)
     * or (last == TCL_INDEX_AFTER). These also permit simplification
     * of the prefix|replace|suffix construction. The other constraints,
     * though, interfere with getting a guarantee that first <= last.
     */

    if ((first == TCL_INDEX_BEFORE) && (last >= TCL_INDEX_START)) {
	/* empty prefix */
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, valueTokenPtr, interp, 1);
	if (replacementTokenPtr == NULL) {
	    /* Drop last */
	    OP44(	STR_RANGE_IMM, 0, INDEX_END-1);
	    return TCL_OK;
	}
	/* Replace last */
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP4(		REVERSE, 2);
	if (last == TCL_INDEX_AFTER) {
	    OP(		POP);		/* Pop  original */
	} else {
	    OP44(	STR_RANGE_IMM, last + 1, TCL_INDEX_END);
	    OP1(	STR_CONCAT1, 2);
	}
	return TCL_OK;
    }

	CompileWord(envPtr, replacementTokenPtr, interp, 4);
	OP4(		OVER, 1);
	PUSH(		"");
	OP(		STR_EQ);
	JUMP1(		JUMP_FALSE, notEq);
	OP(		POP);
	JUMP1(		JUMP, end);
	FIXJUMP1(notEq);
	TclAdjustStackDepth(1, envPtr);
	OP4(		REVERSE, 2);
	OP44(		STR_RANGE_IMM, 0, INDEX_END-1);
    if ((last == TCL_INDEX_AFTER) && (first <= TCL_INDEX_END)) {
	OP44(		STR_RANGE_IMM, 0, first-1);
	OP4(		REVERSE, 2);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP1(		STR_CONCAT1, 2);
	FIXJUMP1(end);
	return TCL_OK;

    }

	/* FLOW THROUGH TO genericReplace */

    } else {
	/*
	 * Need to process indices at runtime. This could be because the
	 * indices are not constants, or because we need to resolve them to
	 * absolute indices to work out if a replacement is going to happen.
	 * In any case, to runtime it is.
	 * When we have no replacement string to worry about, we may
	 * have more luck, because the forbidden empty string replacements
	 * are harmless when they are replaced by another empty string.
	 */

	if ((first == TCL_INDEX_BEFORE) || (first == TCL_INDEX_START)) {
	    /* empty prefix - build suffix only */

	    if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) {
		/* empty suffix too => empty result */
		OP(	POP);		/* Pop  original */
		PUSH	(	"");
		return TCL_OK;
	    }
	    OP44(	STR_RANGE_IMM, last + 1, TCL_INDEX_END);
	    return TCL_OK;
	} else {
	    if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) {
		/* empty suffix - build prefix only */
		OP44(	STR_RANGE_IMM, 0, first-1);
		return TCL_OK;
	    }
	    OP(		DUP);
	    OP44(	STR_RANGE_IMM, 0, first-1);
	    OP4(	REVERSE, 2);
	    OP44(	STR_RANGE_IMM, last + 1, TCL_INDEX_END);
	    OP1(	STR_CONCAT1, 2);
	    return TCL_OK;
	}
    }

    genericReplace:
	CompileWord(envPtr, valueTokenPtr, interp, 1);
	tokenPtr = TokenAfter(valueTokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 3);
	if (parsePtr->numWords == 5) {
	if (replacementTokenPtr != NULL) {
	    CompileWord(envPtr, replacementTokenPtr, interp, 4);
	    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. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
1303
1304
1305
1306
1307
1308
1309
1310

1311
1312
1313
1314
1315
1316
1317
1346
1347
1348
1349
1350
1351
1352

1353
1354
1355
1356
1357
1358
1359
1360







-
+







    return (character >= 0) && (character < 0x80);
}

static int
UniCharIsHexDigit(
    int character)
{
    return (character >= 0) && (character < 0x80) && isxdigit(character);
    return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
}

StringClassDesc const tclStringClassTable[] = {
    {"alnum",	Tcl_UniCharIsAlnum},
    {"alpha",	Tcl_UniCharIsAlpha},
    {"ascii",	UniCharIsAscii},
    {"control", Tcl_UniCharIsControl},

Changes to generic/tclCompExpr.c.

1755
1756
1757
1758
1759
1760
1761
1762

1763
1764
1765
1766
1767
1768
1769
1755
1756
1757
1758
1759
1760
1761

1762
1763
1764
1765
1766
1767
1768
1769







-
+







		 */

		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		subExprTokenPtr->size = start - subExprTokenPtr->start;

		/*
		 * All the Tcl_Tokens allocated and filled belong to
		 * this subexpresion. The first token is the leading
		 * this subexpression. The first token is the leading
		 * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
		 * are its components.
		 */

		subExprTokenPtr->numComponents =
			(parsePtr->numTokens - subExprTokenIdx) - 1;

Changes to generic/tclCompile.h.

421
422
423
424
425
426
427
428

429
430
431
432

433
434
435
436
437
438
439
421
422
423
424
425
426
427

428
429
430
431

432
433
434
435
436
437
438
439







-
+



-
+







				 * 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
				 * different namespace, it must be
				 * recompiled. */
    size_t nsEpoch;		/* Value of nsPtr->resolverEpoch when this
    unsigned int nsEpoch;	/* Value of nsPtr->resolverEpoch when this
				 * ByteCode was compiled. Used to invalidate
				 * code when new namespace resolution rules
				 * are put into effect. */
    int refCount;		/* Reference count: set 1 when created plus 1
    unsigned int refCount;	/* Reference count: set 1 when created plus 1
				 * for each execution of the code currently
				 * active. This structure can be freed when
				 * refCount becomes zero. */
    unsigned int flags;		/* flags describing state for the codebyte.
				 * this variable holds ORed values from the
				 * TCL_BYTECODE_ masks defined above */
    const char *source;		/* The source string from which this ByteCode
1116
1117
1118
1119
1120
1121
1122


1123
1124
1125
1126
1127
1128
1129
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131







+
+







MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclGetIndexFromToken(Tcl_Token *tokenPtr,
			    int before, int after, int *indexPtr);
MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    int numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
1467
1468
1469
1470
1471
1472
1473
1474

1475
1476
1477
1478
1479
1480
1481
1469
1470
1471
1472
1473
1474
1475

1476
1477
1478
1479
1480
1481
1482
1483







-
+







#   define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
#else
#   define TclGetInt1AtPtr(p) \
    (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
#endif

#define TclGetInt4AtPtr(p) \
    (((int) TclGetInt1AtPtr(p) << 24) |				\
    (((int) (TclGetUInt1AtPtr(p) << 24)) |				\
		     (*((p)+1) << 16) |				\
		     (*((p)+2) <<  8) |				\
		     (*((p)+3)))

#define TclGetUInt1AtPtr(p) \
    ((unsigned int) *(p))
#define TclGetUInt4AtPtr(p) \

Changes to generic/tclDate.c.

1

2
3

4
5
6

7
8

9
10
11


12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28

1
2

3
4


5
6

7
8


9
10
11
12
13
14
15
16
17

18


19
20
21
22
23
24
25
-
+

-
+

-
-
+

-
+

-
-
+
+







-
+
-
-







/* A Bison parser, made by GNU Bison 2.3.  */
/* A Bison parser, made by GNU Bison 3.1.  */

/* Skeleton implementation for Bison's Yacc-like parsers in C
/* Bison implementation for Yacc-like parsers in C

   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
   Free Software Foundation, Inc.
   Copyright (C) 1984, 1989-1990, 2000-2015, 2018 Free Software Foundation, Inc.

   This program is free software; you can redistribute it and/or modify
   This program is free software: you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.
   the Free Software Foundation, either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
   Foundation, Inc., 51 Franklin Street, Fifth Floor,
   Boston, MA 02110-1301, USA.  */

/* As a special exception, you may create a larger work that contains
   part or all of the Bison parser skeleton and distribute that work
   under terms of your choice, so long as that work isn't itself a
   parser generator using the skeleton or a modified version thereof
   as a parser skeleton.  Alternatively, if you modify or redistribute
   the parser skeleton itself, you may (at your option) remove this
43
44
45
46
47
48
49
50

51
52
53
54
55
56
57


58
59



60

61
62
63
64



65
66
67
68


69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131

132
133
134
135
136
137
138
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54
55
56


57
58
59
60
61
62



63
64
65




66
67















































68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91







-
+







+
+
-
-
+
+
+

+

-
-
-
+
+
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
















+







   define necessary library symbols; they are noted "INFRINGES ON
   USER NAME SPACE" below.  */

/* Identify Bison output.  */
#define YYBISON 1

/* Bison version.  */
#define YYBISON_VERSION "2.3"
#define YYBISON_VERSION "3.1"

/* Skeleton name.  */
#define YYSKELETON_NAME "yacc.c"

/* Pure parsers.  */
#define YYPURE 1

/* Push parsers.  */
#define YYPUSH 0
/* Using locations.  */
#define YYLSP_NEEDED 1

/* Pull parsers.  */
#define YYPULL 1


/* Substitute the variable and function names.  */
#define yyparse TclDateparse
#define yylex   TclDatelex
#define yyerror TclDateerror
#define yyparse         TclDateparse
#define yylex           TclDatelex
#define yyerror         TclDateerror
#define yylval  TclDatelval
#define yychar  TclDatechar
#define yydebug TclDatedebug
#define yynerrs TclDatenerrs
#define yydebug         TclDatedebug
#define yynerrs         TclDatenerrs
#define yylloc TclDatelloc

/* Tokens.  */
#ifndef YYTOKENTYPE
# define YYTOKENTYPE
   /* Put the tokens into the symbol table, so that GDB and other debuggers
      know about them.  */
   enum yytokentype {
     tAGO = 258,
     tDAY = 259,
     tDAYZONE = 260,
     tID = 261,
     tMERIDIAN = 262,
     tMONTH = 263,
     tMONTH_UNIT = 264,
     tSTARDATE = 265,
     tSEC_UNIT = 266,
     tSNUMBER = 267,
     tUNUMBER = 268,
     tZONE = 269,
     tEPOCH = 270,
     tDST = 271,
     tISOBASE = 272,
     tDAY_UNIT = 273,
     tNEXT = 274
   };
#endif
/* Tokens.  */
#define tAGO 258
#define tDAY 259
#define tDAYZONE 260
#define tID 261
#define tMERIDIAN 262
#define tMONTH 263
#define tMONTH_UNIT 264
#define tSTARDATE 265
#define tSEC_UNIT 266
#define tSNUMBER 267
#define tUNUMBER 268
#define tZONE 269
#define tEPOCH 270
#define tDST 271
#define tISOBASE 272
#define tDAY_UNIT 273
#define tNEXT 274




/* Copy the first part of user declarations.  */


/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file
 *	tclGetDate.y. It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
#include "tclInt.h"

/*
 * Bison generates several labels that happen to be unused. MS Visual C++
 * doesn't like that, and complains. Tell it to shut up.
 */
252
253
254
255
256
257
258
259
260
261
262








263
264
265
266
267
268
269
270
271
272
273
274
































275
276

277

278
279
280




281
282
283
284



285
286

287
288
289


290
291

292
293


294
295
296
297
298
299

300
301
302
303





304
305
306
307
308
309
310
205
206
207
208
209
210
211




212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228



229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265



266
267
268
269
270
271


272
273
274
275

276



277
278
279
280
281
282

283
284
285
286
287
288
289

290

291
292
293
294
295
296
297
298
299
300
301
302
303
304
305







-
-
-
-
+
+
+
+
+
+
+
+









-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+

+
-
-
-
+
+
+
+


-
-
+
+
+

-
+
-
-
-
+
+


+

-
+
+





-
+
-



+
+
+
+
+








typedef enum _MERIDIAN {
    MERam, MERpm, MER24
} MERIDIAN;



/* Enabling traces.  */
#ifndef YYDEBUG
# define YYDEBUG 0
#endif

# ifndef YY_NULLPTR
#  if defined __cplusplus && 201103L <= __cplusplus
#   define YY_NULLPTR nullptr
#  else
#   define YY_NULLPTR 0
#  endif
# endif

/* Enabling verbose error messages.  */
#ifdef YYERROR_VERBOSE
# undef YYERROR_VERBOSE
# define YYERROR_VERBOSE 1
#else
# define YYERROR_VERBOSE 0
#endif

/* Enabling the token table.  */
#ifndef YYTOKEN_TABLE
# define YYTOKEN_TABLE 0

/* Debug traces.  */
#ifndef YYDEBUG
# define YYDEBUG 0
#endif
#if YYDEBUG
extern int TclDatedebug;
#endif

/* Token type.  */
#ifndef YYTOKENTYPE
# define YYTOKENTYPE
  enum yytokentype
  {
    tAGO = 258,
    tDAY = 259,
    tDAYZONE = 260,
    tID = 261,
    tMERIDIAN = 262,
    tMONTH = 263,
    tMONTH_UNIT = 264,
    tSTARDATE = 265,
    tSEC_UNIT = 266,
    tSNUMBER = 267,
    tUNUMBER = 268,
    tZONE = 269,
    tEPOCH = 270,
    tDST = 271,
    tISOBASE = 272,
    tDAY_UNIT = 273,
    tNEXT = 274
  };
#endif

/* Value type.  */
#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED

typedef union YYSTYPE

{
union YYSTYPE
{


    time_t Number;
    enum _MERIDIAN Meridian;
}
/* Line 187 of yacc.c.  */


};

	YYSTYPE;
typedef union YYSTYPE YYSTYPE;
# define yystype YYSTYPE /* obsolescent; will be withdrawn */
# define YYSTYPE_IS_DECLARED 1
# define YYSTYPE_IS_TRIVIAL 1
# define YYSTYPE_IS_TRIVIAL 1
# define YYSTYPE_IS_DECLARED 1
#endif

/* Location type.  */
#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
typedef struct YYLTYPE
typedef struct YYLTYPE YYLTYPE;
struct YYLTYPE
{
  int first_line;
  int first_column;
  int last_line;
  int last_column;
} YYLTYPE;
};
# define yyltype YYLTYPE /* obsolescent; will be withdrawn */
# define YYLTYPE_IS_DECLARED 1
# define YYLTYPE_IS_TRIVIAL 1
#endif



int TclDateparse (DateInfo* info);



/* Copy the second part of user declarations.  */



/*
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344

345
346
347
348
349
350

351
352
353
354
355
356

357
358
359
360
361





362
363

364
365
366
367
368
369
370

371
372
373

374
375
376
377




























378
379
380
381
382
383

384
385

386
387

388
389
390







391
392
393




394
395
396


397
398

399

400
401

402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423

424
425

426
427


428
429
430
431
432
433
434
435
436


437
438
439
440
441
442
443
444
445
446
447
448
449
450

451
452

453
454
455


456
457
458
459
460

461
462
463
464
465
466
467

468
469
470
471
472
473
474
475
476
477
478
479


480
481
482
483
484
485
486



487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502

503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530










531
532




















533
534
535
536
537
538
539
540
541
542
543
544
545

546
547
548


549
550
551
552
553


554
555


556
557
558
559
560
561
562
313
314
315
316
317
318
319


320
321
322
323
324
325
326
327
328
329
330
331
332



333

334
335
336
337
338
339

340
341
342
343
344
345

346
347
348
349
350
351
352
353
354
355
356
357

358
359
360
361
362
363
364

365
366
367

368
369
370
371

372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404

405
406

407
408
409
410



411
412
413
414
415
416
417
418


419
420
421
422



423
424


425

426
427

428



429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446

447

448
449


450
451
452
453
454
455
456
457
458


459
460
461
462
463
464
465
466
467
468
469
470
471
472
473

474
475

476
477


478
479
480
481
482
483

484

485
486
487
488
489

490

491
492
493
494
495
496
497
498
499


500
501
502
503
504
505



506
507
508
509
510
511
512
513
514
515
516
517
518
519





520












521
522
523
524
525
526










527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570

571
572
573

574
575
576
577
578


579
580
581

582
583
584
585
586
587
588
589
590







-
-













-
-
-

-
+





-
+





-
+





+
+
+
+
+

-
+






-
+


-
+



-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+

-
+


+
-
-
-
+
+
+
+
+
+
+

-
-
+
+
+
+
-
-
-
+
+
-
-
+
-
+

-
+
-
-
-


















-
+
-

+
-
-
+
+







-
-
+
+













-
+

-
+

-
-
+
+




-
+
-





-
+
-









-
-
+
+




-
-
-
+
+
+











-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












-
+


-
+
+



-
-
+
+

-
+
+







				   DateInfo* info);
static time_t		ToSeconds(time_t Hours, time_t Minutes,
			    time_t Seconds, MERIDIAN Meridian);
MODULE_SCOPE int	yyparse(DateInfo*);



/* Line 216 of yacc.c.  */


#ifdef short
# undef short
#endif

#ifdef YYTYPE_UINT8
typedef YYTYPE_UINT8 yytype_uint8;
#else
typedef unsigned char yytype_uint8;
#endif

#ifdef YYTYPE_INT8
typedef YYTYPE_INT8 yytype_int8;
#elif (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
typedef signed char yytype_int8;
#else
typedef short int yytype_int8;
typedef signed char yytype_int8;
#endif

#ifdef YYTYPE_UINT16
typedef YYTYPE_UINT16 yytype_uint16;
#else
typedef unsigned short int yytype_uint16;
typedef unsigned short yytype_uint16;
#endif

#ifdef YYTYPE_INT16
typedef YYTYPE_INT16 yytype_int16;
#else
typedef short int yytype_int16;
typedef short yytype_int16;
#endif

#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
#  define YYSIZE_T __SIZE_TYPE__
# elif defined size_t
#  define YYSIZE_T size_t
# elif ! defined YYSIZE_T
#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
#  define YYSIZE_T size_t
# else
#  define YYSIZE_T size_t
#  define YYSIZE_T unsigned
# endif
#endif

#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)

#ifndef YY_
# if YYENABLE_NLS
# if defined YYENABLE_NLS && YYENABLE_NLS
#  if ENABLE_NLS
#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
#   define YY_(msgid) dgettext ("bison-runtime", msgid)
#   define YY_(Msgid) dgettext ("bison-runtime", Msgid)
#  endif
# endif
# ifndef YY_
#  define YY_(msgid) msgid
#  define YY_(Msgid) Msgid
# endif
#endif

#ifndef YY_ATTRIBUTE
# if (defined __GNUC__                                               \
      && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__)))  \
     || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C
#  define YY_ATTRIBUTE(Spec) __attribute__(Spec)
# else
#  define YY_ATTRIBUTE(Spec) /* empty */
# endif
#endif

#ifndef YY_ATTRIBUTE_PURE
# define YY_ATTRIBUTE_PURE   YY_ATTRIBUTE ((__pure__))
#endif

#ifndef YY_ATTRIBUTE_UNUSED
# define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__))
#endif

#if !defined _Noreturn \
     && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112)
# if defined _MSC_VER && 1200 <= _MSC_VER
#  define _Noreturn __declspec (noreturn)
# else
#  define _Noreturn YY_ATTRIBUTE ((__noreturn__))
# endif
#endif

/* Suppress unused-variable warnings by "using" E.  */
#if ! defined lint || defined __GNUC__
# define YYUSE(e) ((void) (e))
# define YYUSE(E) ((void) (E))
#else
# define YYUSE(e) /* empty */
# define YYUSE(E) /* empty */
#endif

#if defined __GNUC__ && ! defined __ICC && 407 <= __GNUC__ * 100 + __GNUC_MINOR__
/* Identity function, used to suppress warnings about constant conditions.  */
#ifndef lint
# define YYID(n) (n)
/* Suppress an incorrect diagnostic about yylval being uninitialized.  */
# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \
    _Pragma ("GCC diagnostic push") \
    _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\
    _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"")
# define YY_IGNORE_MAYBE_UNINITIALIZED_END \
    _Pragma ("GCC diagnostic pop")
#else
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
# define YY_INITIAL_VALUE(Value) Value
#endif
#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
static int
YYID (int i)
#else
# define YY_IGNORE_MAYBE_UNINITIALIZED_END
#endif
static int
YYID (i)
#ifndef YY_INITIAL_VALUE
    int i;
# define YY_INITIAL_VALUE(Value) /* Nothing. */
#endif
{

  return i;
}
#endif

#if ! defined yyoverflow || YYERROR_VERBOSE

/* The parser invokes alloca or malloc; define the necessary symbols.  */

# ifdef YYSTACK_USE_ALLOCA
#  if YYSTACK_USE_ALLOCA
#   ifdef __GNUC__
#    define YYSTACK_ALLOC __builtin_alloca
#   elif defined __BUILTIN_VA_ARG_INCR
#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
#   elif defined _AIX
#    define YYSTACK_ALLOC __alloca
#   elif defined _MSC_VER
#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
#    define alloca _alloca
#   else
#    define YYSTACK_ALLOC alloca
#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
#    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS
     || defined __cplusplus || defined _MSC_VER)
#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
      /* Use EXIT_SUCCESS as a witness for stdlib.h.  */
#     ifndef _STDLIB_H
#      define _STDLIB_H 1
#     ifndef EXIT_SUCCESS
#      define EXIT_SUCCESS 0
#     endif
#    endif
#   endif
#  endif
# endif

# ifdef YYSTACK_ALLOC
   /* Pacify GCC's `empty if-body' warning.  */
#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
   /* Pacify GCC's 'empty if-body' warning.  */
#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
#  ifndef YYSTACK_ALLOC_MAXIMUM
    /* The OS might guarantee only one guard page at the bottom of the stack,
       and a page size can be as small as 4096 bytes.  So we cannot safely
       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
       to allow for a few compiler-allocated temporary stack slots.  */
#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
#  endif
# else
#  define YYSTACK_ALLOC YYMALLOC
#  define YYSTACK_FREE YYFREE
#  ifndef YYSTACK_ALLOC_MAXIMUM
#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
#  endif
#  if (defined __cplusplus && ! defined _STDLIB_H \
#  if (defined __cplusplus && ! defined EXIT_SUCCESS \
       && ! ((defined YYMALLOC || defined malloc) \
	     && (defined YYFREE || defined free)))
             && (defined YYFREE || defined free)))
#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
#   ifndef _STDLIB_H
#    define _STDLIB_H 1
#   ifndef EXIT_SUCCESS
#    define EXIT_SUCCESS 0
#   endif
#  endif
#  ifndef YYMALLOC
#   define YYMALLOC malloc
#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
#   if ! defined malloc && ! defined EXIT_SUCCESS
     || defined __cplusplus || defined _MSC_VER)
void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
#   endif
#  endif
#  ifndef YYFREE
#   define YYFREE free
#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
#   if ! defined free && ! defined EXIT_SUCCESS
     || defined __cplusplus || defined _MSC_VER)
void free (void *); /* INFRINGES ON USER NAME SPACE */
#   endif
#  endif
# endif
#endif /* ! defined yyoverflow || YYERROR_VERBOSE */


#if (! defined yyoverflow \
     && (! defined __cplusplus \
	 || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
	     && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
         || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
             && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))

/* A type that is properly aligned for any stack member.  */
union yyalloc
{
  yytype_int16 yyss;
  YYSTYPE yyvs;
    YYLTYPE yyls;
  yytype_int16 yyss_alloc;
  YYSTYPE yyvs_alloc;
  YYLTYPE yyls_alloc;
};

/* The size of the maximum gap between one aligned stack and the next.  */
# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)

/* The size of an array large to enough to hold all stacks, each with
   N elements.  */
# define YYSTACK_BYTES(N) \
     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \
      + 2 * YYSTACK_GAP_MAXIMUM)

/* Copy COUNT objects from FROM to TO.  The source and destination do
   not overlap.  */
# ifndef YYCOPY
#  if defined __GNUC__ && 1 < __GNUC__
#   define YYCOPY(To, From, Count) \
# define YYCOPY_NEEDED 1
      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
#  else
#   define YYCOPY(To, From, Count)		\
      do					\
	{					\
	  YYSIZE_T yyi;				\
	  for (yyi = 0; yyi < (Count); yyi++)	\
	    (To)[yyi] = (From)[yyi];		\
	}					\
      while (YYID (0))
#  endif
# endif

/* Relocate STACK from its old location to the new one.  The
   local variables YYSIZE and YYSTACKSIZE give the old and new number of
   elements in the stack, and YYPTR gives the new location of the
   stack.  Advance YYPTR to a properly aligned location for the next
   stack.  */
# define YYSTACK_RELOCATE(Stack)					\
    do									\
      {									\
	YYSIZE_T yynewbytes;						\
	YYCOPY (&yyptr->Stack, Stack, yysize);				\
	Stack = &yyptr->Stack;						\
	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
	yyptr += yynewbytes / sizeof (*yyptr);				\
      }									\
    while (YYID (0))
# define YYSTACK_RELOCATE(Stack_alloc, Stack)                           \
    do                                                                  \
      {                                                                 \
        YYSIZE_T yynewbytes;                                            \
        YYCOPY (&yyptr->Stack_alloc, Stack, yysize);                    \
        Stack = &yyptr->Stack_alloc;                                    \
        yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
        yyptr += yynewbytes / sizeof (*yyptr);                          \
      }                                                                 \
    while (0)

#endif

#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
/* Copy COUNT objects from SRC to DST.  The source and destination do
   not overlap.  */
# ifndef YYCOPY
#  if defined __GNUC__ && 1 < __GNUC__
#   define YYCOPY(Dst, Src, Count) \
      __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
#  else
#   define YYCOPY(Dst, Src, Count)              \
      do                                        \
        {                                       \
          YYSIZE_T yyi;                         \
          for (yyi = 0; yyi < (Count); yyi++)   \
            (Dst)[yyi] = (Src)[yyi];            \
        }                                       \
      while (0)
#  endif
# endif
#endif /* !YYCOPY_NEEDED */

/* YYFINAL -- State number of the termination state.  */
#define YYFINAL  2
/* YYLAST -- Last index in YYTABLE.  */
#define YYLAST   79

/* YYNTOKENS -- Number of terminals.  */
#define YYNTOKENS  26
/* YYNNTS -- Number of nonterminals.  */
#define YYNNTS  16
/* YYNRULES -- Number of rules.  */
#define YYNRULES  56
/* YYNRULES -- Number of states.  */
/* YYNSTATES -- Number of states.  */
#define YYNSTATES  83

/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
/* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned
   by yylex, with out-of-bounds checking.  */
#define YYUNDEFTOK  2
#define YYMAXUTOK   274

#define YYTRANSLATE(YYX)						\
  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
#define YYTRANSLATE(YYX)                                                \
  ((unsigned) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)

/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM
   as returned by yylex, without out-of-bounds checking.  */
static const yytype_uint8 yytranslate[] =
{
       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,    25,    22,    21,    24,    23,     2,     2,
582
583
584
585
586
587
588
589

590
591

592

593
594


595
596
597
598
599
600

601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623

624
625
626
627
628
629
630
631
632

633
634
635
636

637
638
639
640
641
642
643
644
645
646
647

648
649
650
651
652
653


654
655
656
657
658
659
660
661

662
663
664




665
666
667
668
669



670
671
672
673
674





675
676
677
678
679
680
681









682
683
684
685
686



687
688
689
690
691
692
693
694
695
696
697
698
699







700

701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731


732
733

734
735
736
737
738
739
740
741
610
611
612
613
614
615
616

617


618
619
620


621
622






623























624









625
626
627
628

629
630
631
632
633
634
635
636
637
638
639

640
641
642
643
644


645
646
647
648
649
650
651
652
653
654
655



656
657
658
659





660
661
662





663
664
665
666
667
668






669
670
671
672
673
674
675
676
677
678
679



680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702

703
704
705
706
707
708
709

























710
711


712

713
714
715
716
717
718
719







-
+
-
-
+

+
-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+



-
+










-
+




-
-
+
+








+
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


-
-
-
+
+
+













+
+
+
+
+
+
+
-
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
+
-







       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     1,     2,     3,     4,
       5,     6,     7,     8,     9,    10,    11,    12,    13,    14,
      15,    16,    17,    18,    19
};

#if YYDEBUG
/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
  /* YYRLINE[YYN] -- Source line where rule number YYN was defined.  */
   YYRHS.  */
static const yytype_uint8 yyprhs[] =
static const yytype_uint16 yyrline[] =
{
       0,   223,   223,   224,   227,   230,   233,   236,   239,   242,
       0,     0,     3,     4,     7,     9,    11,    13,    15,    17,
      19,    21,    23,    25,    28,    33,    39,    46,    54,    57,
     245,   249,   254,   257,   263,   269,   277,   283,   294,   298,
     302,   308,   312,   316,   320,   324,   330,   334,   339,   344,
      59,    61,    63,    66,    69,    73,    76,    80,    86,    88,
      94,   100,   103,   108,   111,   113,   117,   120,   124,   128,
     136,   139,   144,   147,   149,   153,   156,   159,   163,   165,
     167,   169,   171,   173,   175,   177,   178
};

     349,   354,   358,   363,   367,   372,   379,   383,   389,   398,
/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
static const yytype_int8 yyrhs[] =
{
      27,     0,    -1,    -1,    27,    28,    -1,    29,    -1,    30,
      -1,    32,    -1,    33,    -1,    31,    -1,    36,    -1,    34,
      -1,    35,    -1,    40,    -1,    13,     7,    -1,    13,    20,
      13,    41,    -1,    13,    20,    13,    21,    13,    -1,    13,
      20,    13,    20,    13,    41,    -1,    13,    20,    13,    20,
      13,    21,    13,    -1,    14,    16,    -1,    14,    -1,     5,
      -1,     4,    -1,     4,    22,    -1,    13,     4,    -1,    38,
      13,     4,    -1,    19,     4,    -1,    13,    23,    13,    -1,
      13,    23,    13,    23,    13,    -1,    17,    -1,    13,    21,
       8,    21,    13,    -1,    13,    21,    13,    21,    13,    -1,
       8,    13,    -1,     8,    13,    22,    13,    -1,    13,     8,
      -1,    15,    -1,    13,     8,    13,    -1,    19,     8,    -1,
      19,    13,     8,    -1,    17,    14,    17,    -1,    17,    14,
      13,    20,    13,    20,    13,    -1,    17,    17,    -1,    10,
      13,    24,    13,    -1,    37,     3,    -1,    37,    -1,    38,
      13,    39,    -1,    13,    39,    -1,    19,    39,    -1,    19,
      13,    39,    -1,    39,    -1,    21,    -1,    25,    -1,    11,
      -1,    18,    -1,     9,    -1,    13,    -1,    -1,     7,    -1
};

     407,   417,   431,   436,   439,   442,   445,   448,   451,   456,
/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
static const yytype_uint16 yyrline[] =
{
       0,   225,   225,   226,   229,   232,   235,   238,   241,   244,
     247,   251,   256,   259,   265,   271,   279,   285,   296,   300,
     304,   310,   314,   318,   322,   326,   332,   336,   341,   346,
     351,   356,   360,   365,   369,   374,   381,   385,   391,   400,
     409,   419,   433,   438,   441,   444,   447,   450,   453,   458,
     461,   466,   470,   474,   480,   498,   501
     459,   464,   468,   472,   478,   496,   499
};
#endif

#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
#if YYDEBUG || YYERROR_VERBOSE || 0
/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
static const char *const yytname[] =
{
  "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID",
  "tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT",
  "tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST", "tISOBASE",
  "tDAY_UNIT", "tNEXT", "':'", "'-'", "','", "'/'", "'.'", "'+'",
  "$accept", "spec", "item", "time", "zone", "day", "date", "ordMonth",
  "iso", "trek", "relspec", "relunits", "sign", "unit", "number",
  "o_merid", 0
  "o_merid", YY_NULLPTR
};
#endif

# ifdef YYPRINT
/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
   token YYLEX-NUM.  */
/* YYTOKNUM[NUM] -- (External) token number corresponding to the
   (internal) symbol number NUM (which must be that of a token).  */
static const yytype_uint16 yytoknum[] =
{
       0,   256,   257,   258,   259,   260,   261,   262,   263,   264,
     265,   266,   267,   268,   269,   270,   271,   272,   273,   274,
      58,    45,    44,    47,    46,    43
};
# endif

#define YYPACT_NINF -22
/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
static const yytype_uint8 yyr1[] =
{

#define yypact_value_is_default(Yystate) \
  (!!((Yystate) == (-22)))

       0,    26,    27,    27,    28,    28,    28,    28,    28,    28,
      28,    28,    28,    29,    29,    29,    29,    29,    30,    30,
      30,    31,    31,    31,    31,    31,    32,    32,    32,    32,
      32,    32,    32,    32,    32,    32,    33,    33,    34,    34,
      34,    35,    36,    36,    37,    37,    37,    37,    37,    38,
#define YYTABLE_NINF -1

#define yytable_value_is_error(Yytable_value) \
      38,    39,    39,    39,    40,    41,    41
};

/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
static const yytype_uint8 yyr2[] =
  0

  /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
     STATE-NUM.  */
static const yytype_int8 yypact[] =
{
       0,     2,     0,     2,     1,     1,     1,     1,     1,     1,
       1,     1,     1,     2,     4,     5,     6,     7,     2,     1,
       1,     1,     2,     2,     3,     2,     3,     5,     1,     5,
       5,     2,     4,     2,     1,     3,     2,     3,     3,     7,
       2,     4,     2,     1,     3,     2,     2,     3,     1,     1,
       1,     1,     1,     1,     1,     0,     1
     -22,     2,   -22,   -21,   -22,    -4,   -22,     1,   -22,    22,
      18,   -22,     8,   -22,    40,   -22,   -22,   -22,   -22,   -22,
     -22,   -22,   -22,   -22,   -22,   -22,    32,    28,   -22,   -22,
     -22,    24,    26,   -22,   -22,    42,    47,    -5,    49,   -22,
     -22,    15,   -22,   -22,   -22,    48,   -22,   -22,    43,    50,
      51,   -22,    17,    44,    46,    45,    52,   -22,   -22,   -22,
     -22,   -22,   -22,   -22,   -22,    56,    57,   -22,    58,    60,
      61,    62,    -3,   -22,   -22,   -22,   -22,    59,    63,   -22,
      64,   -22,   -22
};

/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
   means the default is an error.  */
  /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM.
     Performed when YYTABLE does not specify something else to do.  Zero
     means the default is an error.  */
static const yytype_uint8 yydefact[] =
{
       2,     0,     1,    21,    20,     0,    53,     0,    51,    54,
      19,    34,    28,    52,     0,    49,    50,     3,     4,     5,
       8,     6,     7,    10,    11,     9,    43,     0,    48,    12,
      22,    31,     0,    23,    13,    33,     0,     0,     0,    45,
      18,     0,    40,    25,    36,     0,    46,    42,     0,     0,
       0,    35,    55,     0,     0,    26,     0,    38,    37,    47,
      24,    44,    32,    41,    56,     0,     0,    14,     0,     0,
       0,     0,    55,    15,    29,    30,    27,     0,     0,    16,
       0,    17,    39
};

  /* YYPGOTO[NTERM-NUM].  */
static const yytype_int8 yypgoto[] =
{
     -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,
     -22,   -22,   -22,    -9,   -22,     6
};

/* YYDEFGOTO[NTERM-NUM].  */
  /* YYDEFGOTO[NTERM-NUM].  */
static const yytype_int8 yydefgoto[] =
{
      -1,     1,    17,    18,    19,    20,    21,    22,    23,    24,
      25,    26,    27,    28,    29,    67
};

/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
   STATE-NUM.  */
#define YYPACT_NINF -22
static const yytype_int8 yypact[] =
{
     -22,     2,   -22,   -21,   -22,    -4,   -22,     1,   -22,    22,
      18,   -22,     8,   -22,    40,   -22,   -22,   -22,   -22,   -22,
     -22,   -22,   -22,   -22,   -22,   -22,    32,    28,   -22,   -22,
     -22,    24,    26,   -22,   -22,    42,    47,    -5,    49,   -22,
     -22,    15,   -22,   -22,   -22,    48,   -22,   -22,    43,    50,
      51,   -22,    17,    44,    46,    45,    52,   -22,   -22,   -22,
     -22,   -22,   -22,   -22,   -22,    56,    57,   -22,    58,    60,
      61,    62,    -3,   -22,   -22,   -22,   -22,    59,    63,   -22,
      64,   -22,   -22
};

/* YYPGOTO[NTERM-NUM].  */
static const yytype_int8 yypgoto[] =
{
     -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,
     -22,   -22,   -22,    -9,   -22,     6
};

/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
   positive, shift that token.  If negative, reduce the rule which
  /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM.  If
     positive, shift that token.  If negative, reduce the rule whose
   number is the opposite.  If zero, do what YYDEFACT says.
   If YYTABLE_NINF, syntax error.  */
     number is the opposite.  If YYTABLE_NINF, syntax error.  */
#define YYTABLE_NINF -1
static const yytype_uint8 yytable[] =
{
      39,    30,     2,    53,    64,    46,     3,     4,    54,    31,
       5,     6,     7,     8,    32,     9,    10,    11,    78,    12,
      13,    14,    41,    15,    64,    42,    33,    16,    56,    34,
      35,     6,    57,     8,    40,    47,    59,    65,    66,    61,
      13,    48,    36,    37,    43,    38,    49,    60,    44,     6,
752
753
754
755
756
757
758
759
760


761
762
763
764
765
766
767
768
769
770
771
772
773























774
775
776
777




778
779
780
781



782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797






798
799
800
801
802
803






804
805
806
807



808
809
810
811



812
813
814
815
816
817
818
819
820

821
822


823
824
825
826
827





828
829


830
831
832
833
834





835
836


837
838
839

840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876





877
878
879
880
881
882
883
884
885



















886
887
888
889
890
891
892









































893
894
895
896
897
898
899
900
901
902
903



904
905
906


907
908
909
910
911
912
913
914
915
916
917
918
919

920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946

947
948

949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964

965
966
967
968
969
970
971
972
973
974





975
976
977
978
979
980
981
982





983
984
985
986
987
988
989
990
991
992

993
994
995
996
997
998
999
1000
1001

1002
1003
1004
1005
1006

1007
1008
1009
1010
1011
1012
1013
1014






1015
1016
1017
1018
1019
1020
1021
1022





1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036

1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
730
731
732
733
734
735
736


737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774




775
776
777
778
779



780
781
782
783






784
785
786






787
788
789
790
791
792






793
794
795
796
797
798
799



800
801
802
803



804
805
806
807
808
809
810
811
812

813

814


815
816





817
818
819
820
821


822
823





824
825
826
827
828


829
830
831
832

833



834



















835
836
837
838
839
840
841
842
843





844
845
846
847
848
849








850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868







869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910



911
912





913
914
915



916
917


918
919


920
921
922


923

924




925
926
927
928
929
930
931


932
933









934


935


936
937
938
939
940
941
942
943
944
945
946
947
948


949

950






951
952


953
954
955
956
957
958
959
960





961
962
963
964
965
966
967
968
969
970
971


972

973








974
975
976
977

978

979
980
981
982





983
984
985
986
987
988
989
990
991





992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009

1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024

1025
1026
1027
1028
1029
1030
1031
1032


1033
1034





1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049


1050
1051






1052
1053
1054
1055
1056
1057
1058







-
-
+
+













+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-



-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+






-

-
+
-
-
+
+
-
-
-
-
-
+
+
+
+
+
-
-
+
+
-
-
-
-
-
+
+
+
+
+
-
-
+
+


-
+
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-


-
-
-
-
-
+
+
+
-
-
-
+
+
-
-


-
-



-
-

-
+
-
-
-
-







-
-


-
-
-
-
-
-
-
-
-

-
-
+
-
-
+












-
-

-
+
-
-
-
-
-
-


-
-
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+






-
-

-
+
-
-
-
-
-
-
-
-

+


-

-
+



-
-
-
-
-
+
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+













-
+














-








-
-


-
-
-
-
-















-
-


-
-
-
-
-
-







       8,     9,    17,    11,    16,     3,    45,    20,    21,    48,
      18,    13,    20,    21,     4,    23,    22,     4,     8,     9,
      24,    11,     9,    13,    11,    13,     8,     9,    18,    11,
      13,    18,    13,    13,    13,    21,    18,    21,    23,    13,
      13,    13,    20,    13,    13,    13,    13,    13,    72,    20
};

/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
   symbol of state STATE-NUM.  */
  /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
     symbol of state STATE-NUM.  */
static const yytype_uint8 yystos[] =
{
       0,    27,     0,     4,     5,     8,     9,    10,    11,    13,
      14,    15,    17,    18,    19,    21,    25,    28,    29,    30,
      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
      22,    13,    13,     4,     7,     8,    20,    21,    23,    39,
      16,    14,    17,     4,     8,    13,    39,     3,    13,    22,
      24,    13,    13,     8,    13,    13,    13,    17,     8,    39,
       4,    39,    13,    13,     7,    20,    21,    41,    21,    21,
      23,    20,    13,    13,    13,    13,    13,    13,    21,    41,
      20,    13,    13
};

  /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
static const yytype_uint8 yyr1[] =
{
       0,    26,    27,    27,    28,    28,    28,    28,    28,    28,
      28,    28,    28,    29,    29,    29,    29,    29,    30,    30,
      30,    31,    31,    31,    31,    31,    32,    32,    32,    32,
      32,    32,    32,    32,    32,    32,    33,    33,    34,    34,
      34,    35,    36,    36,    37,    37,    37,    37,    37,    38,
      38,    39,    39,    39,    40,    41,    41
};

  /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN.  */
static const yytype_uint8 yyr2[] =
{
       0,     2,     0,     2,     1,     1,     1,     1,     1,     1,
       1,     1,     1,     2,     4,     5,     6,     7,     2,     1,
       1,     1,     2,     2,     3,     2,     3,     5,     1,     5,
       5,     2,     4,     2,     1,     3,     2,     3,     3,     7,
       2,     4,     2,     1,     3,     2,     2,     3,     1,     1,
       1,     1,     1,     1,     1,     0,     1
};


#define yyerrok		(yyerrstatus = 0)
#define yyclearin	(yychar = YYEMPTY)
#define YYEMPTY		(-2)
#define YYEOF		0
#define yyerrok         (yyerrstatus = 0)
#define yyclearin       (yychar = YYEMPTY)
#define YYEMPTY         (-2)
#define YYEOF           0

#define YYACCEPT	goto yyacceptlab
#define YYABORT		goto yyabortlab
#define YYERROR		goto yyerrorlab
#define YYACCEPT        goto yyacceptlab
#define YYABORT         goto yyabortlab
#define YYERROR         goto yyerrorlab


/* Like YYERROR except do call yyerror.  This remains here temporarily
   to ease the transition to the new meaning of YYERROR, for GCC.
   Once GCC version 2 has supplanted version 1, this can go.  */

#define YYFAIL		goto yyerrlab

#define YYRECOVERING()  (!!yyerrstatus)

#define YYBACKUP(Token, Value)					\
do								\
  if (yychar == YYEMPTY && yylen == 1)				\
    {								\
      yychar = (Token);						\
      yylval = (Value);						\
#define YYBACKUP(Token, Value)                                  \
do                                                              \
  if (yychar == YYEMPTY)                                        \
    {                                                           \
      yychar = (Token);                                         \
      yylval = (Value);                                         \
      yytoken = YYTRANSLATE (yychar);				\
      YYPOPSTACK (1);						\
      goto yybackup;						\
    }								\
  else								\
    {								\
      YYPOPSTACK (yylen);                                       \
      yystate = *yyssp;                                         \
      goto yybackup;                                            \
    }                                                           \
  else                                                          \
    {                                                           \
      yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \
      YYERROR;							\
    }								\
while (YYID (0))
      YYERROR;                                                  \
    }                                                           \
while (0)


#define YYTERROR	1
#define YYERRCODE	256
/* Error token number */
#define YYTERROR        1
#define YYERRCODE       256


/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
   If N is 0, then set CURRENT to the empty location which ends
   the previous symbol: RHS[0] (always defined).  */

#define YYRHSLOC(Rhs, K) ((Rhs)[K])
#ifndef YYLLOC_DEFAULT
# define YYLLOC_DEFAULT(Current, Rhs, N)				\
# define YYLLOC_DEFAULT(Current, Rhs, N)                                \
    do									\
      if (YYID (N))                                                    \
    do                                                                  \
      if (N)                                                            \
	{								\
	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
        {                                                               \
          (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;        \
          (Current).first_column = YYRHSLOC (Rhs, 1).first_column;      \
          (Current).last_line    = YYRHSLOC (Rhs, N).last_line;         \
          (Current).last_column  = YYRHSLOC (Rhs, N).last_column;       \
	}								\
      else								\
        }                                                               \
      else                                                              \
	{								\
	  (Current).first_line   = (Current).last_line   =		\
	    YYRHSLOC (Rhs, 0).last_line;				\
	  (Current).first_column = (Current).last_column =		\
	    YYRHSLOC (Rhs, 0).last_column;				\
        {                                                               \
          (Current).first_line   = (Current).last_line   =              \
            YYRHSLOC (Rhs, 0).last_line;                                \
          (Current).first_column = (Current).last_column =              \
            YYRHSLOC (Rhs, 0).last_column;                              \
	}								\
    while (YYID (0))
        }                                                               \
    while (0)
#endif


#define YYRHSLOC(Rhs, K) ((Rhs)[K])
/* YY_LOCATION_PRINT -- Print the location on the stream.
   This macro was not mandated originally: define only if we know
   we won't break user code: when these are the locations we know.  */

#ifndef YY_LOCATION_PRINT
# if YYLTYPE_IS_TRIVIAL
#  define YY_LOCATION_PRINT(File, Loc)			\
     fprintf (File, "%d.%d-%d.%d",			\
	      (Loc).first_line, (Loc).first_column,	\
	      (Loc).last_line,  (Loc).last_column)
# else
#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
# endif
#endif


/* YYLEX -- calling `yylex' with the right arguments.  */

#ifdef YYLEX_PARAM
# define YYLEX yylex (&yylval, &yylloc, YYLEX_PARAM)
#else
# define YYLEX yylex (&yylval, &yylloc, info)
#endif

/* Enable debugging if requested.  */
#if YYDEBUG

# ifndef YYFPRINTF
#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
#  define YYFPRINTF fprintf
# endif

# define YYDPRINTF(Args)			\
do {						\
  if (yydebug)					\
    YYFPRINTF Args;				\
} while (YYID (0))
# define YYDPRINTF(Args)                        \
do {                                            \
  if (yydebug)                                  \
    YYFPRINTF Args;                             \
} while (0)

# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
do {									  \
  if (yydebug)								  \
    {									  \
      YYFPRINTF (stderr, "%s ", Title);					  \
      yy_symbol_print (stderr,						  \
		  Type, Value, Location, info); \
      YYFPRINTF (stderr, "\n");						  \

/* YY_LOCATION_PRINT -- Print the location on the stream.
   This macro was not mandated originally: define only if we know
   we won't break user code: when these are the locations we know.  */

#ifndef YY_LOCATION_PRINT
# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL

/* Print *YYLOCP on YYO.  Private, do not rely on its existence. */

YY_ATTRIBUTE_UNUSED
static unsigned
yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp)
{
  unsigned res = 0;
  int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0;
  if (0 <= yylocp->first_line)
    {
      res += YYFPRINTF (yyo, "%d", yylocp->first_line);
    }									  \
} while (YYID (0))


/*--------------------------------.
| Print this symbol on YYOUTPUT.  |
`--------------------------------*/
      if (0 <= yylocp->first_column)
        res += YYFPRINTF (yyo, ".%d", yylocp->first_column);
    }
  if (0 <= yylocp->last_line)
    {
      if (yylocp->first_line < yylocp->last_line)
        {
          res += YYFPRINTF (yyo, "-%d", yylocp->last_line);
          if (0 <= end_col)
            res += YYFPRINTF (yyo, ".%d", end_col);
        }
      else if (0 <= end_col && yylocp->first_column < end_col)
        res += YYFPRINTF (yyo, "-%d", end_col);
    }
  return res;
 }

#  define YY_LOCATION_PRINT(File, Loc)          \
  yy_location_print_ (File, &(Loc))

# else
#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
# endif
#endif


# define YY_SYMBOL_PRINT(Title, Type, Value, Location)                    \
do {                                                                      \
  if (yydebug)                                                            \
    {                                                                     \
      YYFPRINTF (stderr, "%s ", Title);                                   \
      yy_symbol_print (stderr,                                            \
                  Type, Value, Location, info); \
      YYFPRINTF (stderr, "\n");                                           \
    }                                                                     \
} while (0)


/*----------------------------------------.
| Print this symbol's value on YYOUTPUT.  |
`----------------------------------------*/

/*ARGSUSED*/
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
#else
static void
yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info)
    FILE *yyoutput;
    int yytype;
{
  FILE *yyo = yyoutput;
  YYUSE (yyo);
    YYSTYPE const * const yyvaluep;
    YYLTYPE const * const yylocationp;
    DateInfo* info;
  YYUSE (yylocationp);
  YYUSE (info);
#endif
{
  if (!yyvaluep)
    return;
  YYUSE (yylocationp);
  YYUSE (info);
# ifdef YYPRINT
  if (yytype < YYNTOKENS)
    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
# else
  YYUSE (yyoutput);
# endif
  switch (yytype)
  YYUSE (yytype);
    {
      default:
	break;
    }
}


/*--------------------------------.
| Print this symbol on YYOUTPUT.  |
`--------------------------------*/

#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
#else
static void
yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info)
    FILE *yyoutput;
    int yytype;
    YYSTYPE const * const yyvaluep;
    YYLTYPE const * const yylocationp;
    DateInfo* info;
#endif
{
  if (yytype < YYNTOKENS)
    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
  YYFPRINTF (yyoutput, "%s %s (",
  else
    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
             yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]);

  YY_LOCATION_PRINT (yyoutput, *yylocationp);
  YYFPRINTF (yyoutput, ": ");
  yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info);
  YYFPRINTF (yyoutput, ")");
}

/*------------------------------------------------------------------.
| yy_stack_print -- Print the state stack from its BOTTOM up to its |
| TOP (included).                                                   |
`------------------------------------------------------------------*/

#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
#else
static void
yy_stack_print (bottom, top)
    yytype_int16 *bottom;
    yytype_int16 *top;
#endif
{
  YYFPRINTF (stderr, "Stack now");
  for (; bottom <= top; ++bottom)
    YYFPRINTF (stderr, " %d", *bottom);
  for (; yybottom <= yytop; yybottom++)
    {
      int yybot = *yybottom;
      YYFPRINTF (stderr, " %d", yybot);
    }
  YYFPRINTF (stderr, "\n");
}

# define YY_STACK_PRINT(Bottom, Top)				\
do {								\
  if (yydebug)							\
    yy_stack_print ((Bottom), (Top));				\
} while (YYID (0))
# define YY_STACK_PRINT(Bottom, Top)                            \
do {                                                            \
  if (yydebug)                                                  \
    yy_stack_print ((Bottom), (Top));                           \
} while (0)


/*------------------------------------------------.
| Report that the YYRULE is going to be reduced.  |
`------------------------------------------------*/

#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_reduce_print (YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
#else
static void
yy_reduce_print (yyvsp, yylsp, yyrule, info)
    YYSTYPE *yyvsp;
    YYLTYPE *yylsp;
    int yyrule;
    DateInfo* info;
#endif
{
  unsigned long yylno = yyrline[yyrule];
  int yynrhs = yyr2[yyrule];
  int yyi;
  unsigned long int yylno = yyrline[yyrule];
  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
	     yyrule - 1, yylno);
             yyrule - 1, yylno);
  /* The symbols being reduced.  */
  for (yyi = 0; yyi < yynrhs; yyi++)
    {
      fprintf (stderr, "   $%d = ", yyi + 1);
      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
		       &(yyvsp[(yyi + 1) - (yynrhs)])
		       , &(yylsp[(yyi + 1) - (yynrhs)])		       , info);
      fprintf (stderr, "\n");
      YYFPRINTF (stderr, "   $%d = ", yyi + 1);
      yy_symbol_print (stderr,
                       yystos[yyssp[yyi + 1 - yynrhs]],
                       &(yyvsp[(yyi + 1) - (yynrhs)])
                       , &(yylsp[(yyi + 1) - (yynrhs)])                       , info);
      YYFPRINTF (stderr, "\n");
    }
}

# define YY_REDUCE_PRINT(Rule)		\
do {					\
  if (yydebug)				\
    yy_reduce_print (yyvsp, yylsp, Rule, info); \
} while (YYID (0))
# define YY_REDUCE_PRINT(Rule)          \
do {                                    \
  if (yydebug)                          \
    yy_reduce_print (yyssp, yyvsp, yylsp, Rule, info); \
} while (0)

/* Nonzero means print parse trace.  It is left uninitialized so that
   multiple parsers can coexist.  */
int yydebug;
#else /* !YYDEBUG */
# define YYDPRINTF(Args)
# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
# define YY_STACK_PRINT(Bottom, Top)
# define YY_REDUCE_PRINT(Rule)
#endif /* !YYDEBUG */


/* YYINITDEPTH -- initial size of the parser's stacks.  */
#ifndef	YYINITDEPTH
#ifndef YYINITDEPTH
# define YYINITDEPTH 200
#endif

/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
   if the built-in stack extension method is used).

   Do not make this value too large; the results are undefined if
   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
   evaluated with infinite-precision integer arithmetic.  */

#ifndef YYMAXDEPTH
# define YYMAXDEPTH 10000
#endif



#if YYERROR_VERBOSE

# ifndef yystrlen
#  if defined __GLIBC__ && defined _STRING_H
#   define yystrlen strlen
#  else
/* Return the length of YYSTR.  */
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static YYSIZE_T
yystrlen (const char *yystr)
#else
static YYSIZE_T
yystrlen (yystr)
    const char *yystr;
#endif
{
  YYSIZE_T yylen;
  for (yylen = 0; yystr[yylen]; yylen++)
    continue;
  return yylen;
}
#  endif
# endif

# ifndef yystpcpy
#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
#   define yystpcpy stpcpy
#  else
/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
   YYDEST.  */
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static char *
yystpcpy (char *yydest, const char *yysrc)
#else
static char *
yystpcpy (yydest, yysrc)
    char *yydest;
    const char *yysrc;
#endif
{
  char *yyd = yydest;
  const char *yys = yysrc;

  while ((*yyd++ = *yys++) != '\0')
    continue;

1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127





1128
1129
1130
1131
1132
1133
1134
1135
1136
1137









1138
1139
1140
1141
1142
1143





1144
1145
1146
1147
1148
1149
1150
1151
1152
1153

1154

1155
1156
1157
1158
1159
1160
1161
1162








1163
1164
1165

1166
1167
1168
1169

1170
1171
1172


1173
1174
1175
1176
1177








1178


1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201































1202
1203
1204
1205
1206




1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217








1218
1219
1220
1221
1222
1223
1224









1225
1226
1227
1228
1229
1230






1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244






































1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256











1257
1258

1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293

1294
1295
1296
1297
1298
1299


1300
1301

1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347

1348
1349

1350
1351





1352








1353
1354
1355
1356





























1357



1358


1359
1360
1361
1362
1363

1364





1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409





1410
1411
1412
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
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456






1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469













1470
1471
1472
1473
1474
1475
1476
1477

1478
1479
1480

1481
1482
1483
1484
1485
1486
1487
1488
1489
1490








1491
1492
1493


1494
1495
1496
1497
1498
1499
1500
1501
1502
1503

1504
1505
1506

1507
1508
1509



1510
1511
1512
1513
1514
1515
1516
1517
1518
1519

1520
1521

1522
1523

1524
1525
1526

1527
1528

1529
1530
1531
1532

1533
1534
1535
1536
1537
1538
1539
1074
1075
1076
1077
1078
1079
1080





1081
1082
1083
1084
1085
1086









1087
1088
1089
1090
1091
1092
1093
1094
1095
1096





1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112

1113








1114
1115
1116
1117
1118
1119
1120
1121



1122




1123



1124
1125





1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136























1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167





1168
1169
1170
1171
1172










1173
1174
1175
1176
1177
1178
1179
1180







1181
1182
1183
1184
1185
1186
1187
1188
1189






1190
1191
1192
1193
1194
1195














1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233












1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244


1245

1246
1247

1248
1249
1250
1251
1252



1253
1254









1255
1256
1257
1258

1259
1260
1261
1262



1263






1264
1265


1266















1267
1268
1269
1270
1271
1272
1273
1274



1275










1276






1277

1278
1279
1280
1281


1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295




1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328

1329
1330
1331
1332



1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346

























1347
1348







1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362

1363









1364






1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384






1385
1386
1387
1388
1389
1390
1391












1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411

1412
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
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456

1457
1458

1459
1460

1461
1462
1463

1464
1465

1466
1467
1468
1469

1470
1471
1472
1473
1474
1475
1476
1477







-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+










+
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+

+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-


-





-
-
-


-
-
-
-
-
-
-
-
-




-




-
-
-
+
-
-
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
-

-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-

-
+


+
-
-
+
+
+
+
+

+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
+
+


-
-
-
+

+
+
+
+
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-




+
+
+
+
+





-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-




















-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+


-
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+









-
+


-
+



+
+
+









-
+

-
+

-
+


-
+

-
+



-
+







{
  if (*yystr == '"')
    {
      YYSIZE_T yyn = 0;
      char const *yyp = yystr;

      for (;;)
	switch (*++yyp)
	  {
	  case '\'':
	  case ',':
	    goto do_not_strip_quotes;
        switch (*++yyp)
          {
          case '\'':
          case ',':
            goto do_not_strip_quotes;

	  case '\\':
	    if (*++yyp != '\\')
	      goto do_not_strip_quotes;
	    /* Fall through.  */
	  default:
	    if (yyres)
	      yyres[yyn] = *yyp;
	    yyn++;
	    break;
          case '\\':
            if (*++yyp != '\\')
              goto do_not_strip_quotes;
            /* Fall through.  */
          default:
            if (yyres)
              yyres[yyn] = *yyp;
            yyn++;
            break;

	  case '"':
	    if (yyres)
	      yyres[yyn] = '\0';
	    return yyn;
	  }
          case '"':
            if (yyres)
              yyres[yyn] = '\0';
            return yyn;
          }
    do_not_strip_quotes: ;
    }

  if (! yyres)
    return yystrlen (yystr);

  return yystpcpy (yyres, yystr) - yyres;
}
# endif

/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
/* Copy into YYRESULT an error message about the unexpected token
   about the unexpected token YYTOKEN for the state stack whose top is
   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
   including the terminating null byte.  If YYRESULT is null, do not
   copy anything; just return the number of bytes that would be
   copied.  As a special case, return 0 if an ordinary "syntax error"
   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
   size calculation.  */
static YYSIZE_T
yysyntax_error (char *yyresult, int yystate, int yychar)
   YYSSP.

   Return 0 if *YYMSG was successfully written.  Return 1 if *YYMSG is
   not large enough to hold the message.  In that case, also set
   *YYMSG_ALLOC to the required number of bytes.  Return 2 if the
   required number of bytes is too large to store.  */
static int
yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,
{
  int yyn = yypact[yystate];

                yytype_int16 *yyssp, int yytoken)
  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
    return 0;
  else
    {
{
      int yytype = YYTRANSLATE (yychar);
      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
      YYSIZE_T yysize = yysize0;
  YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]);
  YYSIZE_T yysize = yysize0;
      YYSIZE_T yysize1;
      int yysize_overflow = 0;
      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
      int yyx;
  enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
  /* Internationalized format string. */
  const char *yyformat = YY_NULLPTR;
  /* Arguments of yyformat. */
  char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
  /* Number of reported tokens (one for the "unexpected", one per
     "expected"). */
  int yycount = 0;

  /* There are many possibilities here to consider:
     - If this state is a consistent state with a default action, then
# if 0
      /* This is so xgettext sees the translatable formats that are
	 constructed on the fly.  */
      YY_("syntax error, unexpected %s");
      YY_("syntax error, unexpected %s, expecting %s");
      YY_("syntax error, unexpected %s, expecting %s or %s");
      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
# endif
      char *yyfmt;
      char const *yyf;
      static char const yyunexpected[] = "syntax error, unexpected %s";
      static char const yyexpecting[] = ", expecting %s";
      static char const yyor[] = " or %s";
      char yyformat[sizeof yyunexpected
		    + sizeof yyexpecting - 1
		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
		       * (sizeof yyor - 1))];
      char const *yyprefix = yyexpecting;

      /* Start YYX at -YYN if negative to avoid negative indexes in
	 YYCHECK.  */
      int yyxbegin = yyn < 0 ? -yyn : 0;
       the only way this function was invoked is if the default action
       is an error action.  In that case, don't check for expected
       tokens because there are none.
     - The only way there can be no lookahead present (in yychar) is if
       this state is a consistent state with a default action.  Thus,
       detecting the absence of a lookahead is sufficient to determine
       that there is no unexpected or expected token to report.  In that
       case, just report a simple "syntax error".
     - Don't assume there isn't a lookahead just because this state is a
       consistent state with a default action.  There might have been a
       previous inconsistent state, consistent state with a non-default
       action, or user semantic action that manipulated yychar.
     - Of course, the expected token list depends on states to have
       correct lookahead information, and it depends on the parser not
       to perform extra reductions after fetching a lookahead from the
       scanner and before detecting a syntax error.  Thus, state merging
       (from LALR or IELR) and default reductions corrupt the expected
       token list.  However, the list is correct for canonical LR with
       one exception: it will still contain any token that will not be
       accepted due to an error action in a later state.
  */
  if (yytoken != YYEMPTY)
    {
      int yyn = yypact[*yyssp];
      yyarg[yycount++] = yytname[yytoken];
      if (!yypact_value_is_default (yyn))
        {
          /* Start YYX at -YYN if negative to avoid negative indexes in
             YYCHECK.  In other words, skip the first -YYN actions for
             this state because they are default actions.  */
          int yyxbegin = yyn < 0 ? -yyn : 0;

      /* Stay within bounds of both yycheck and yytname.  */
      int yychecklim = YYLAST - yyn + 1;
      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
      int yycount = 1;
          /* Stay within bounds of both yycheck and yytname.  */
          int yychecklim = YYLAST - yyn + 1;
          int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
          int yyx;

      yyarg[0] = yytname[yytype];
      yyfmt = yystpcpy (yyformat, yyunexpected);

      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
	  {
	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
	      {
		yycount = 1;
		yysize = yysize0;
          for (yyx = yyxbegin; yyx < yyxend; ++yyx)
            if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
                && !yytable_value_is_error (yytable[yyx + yyn]))
              {
                if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
                  {
                    yycount = 1;
                    yysize = yysize0;
		yyformat[sizeof yyunexpected - 1] = '\0';
		break;
	      }
	    yyarg[yycount++] = yytname[yyx];
	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
	    yysize_overflow |= (yysize1 < yysize);
	    yysize = yysize1;
                    break;
                  }
                yyarg[yycount++] = yytname[yyx];
                {
                  YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]);
                  if (! (yysize <= yysize1
                         && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
                    return 2;
                  yysize = yysize1;
	    yyfmt = yystpcpy (yyfmt, yyprefix);
	    yyprefix = yyor;
	  }

      yyf = YY_(yyformat);
      yysize1 = yysize + yystrlen (yyf);
                }
              }
        }
    }

  switch (yycount)
      yysize_overflow |= (yysize1 < yysize);
      yysize = yysize1;

      if (yysize_overflow)
	return YYSIZE_MAXIMUM;

      if (yyresult)
	{
	  /* Avoid sprintf, as that infringes on the user's name space.
	     Don't have undefined behavior even if the translation
	     produced a string with the wrong number of "%s"s.  */
	  char *yyp = yyresult;
	  int yyi = 0;
	  while ((*yyp = *yyf) != '\0')
    {
# define YYCASE_(N, S)                      \
      case N:                               \
        yyformat = S;                       \
      break
    default: /* Avoid compiler warnings. */
      YYCASE_(0, YY_("syntax error"));
      YYCASE_(1, YY_("syntax error, unexpected %s"));
      YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
      YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
      YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
      YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
# undef YYCASE_
    }

  {
    YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
    if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
      return 2;
    yysize = yysize1;
  }

  if (*yymsg_alloc < yysize)
    {
      *yymsg_alloc = 2 * yysize;
      if (! (yysize <= *yymsg_alloc
             && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
        *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
      return 1;
    }

  /* Avoid sprintf, as that infringes on the user's name space.
     Don't have undefined behavior even if the translation
     produced a string with the wrong number of "%s"s.  */
  {
    char *yyp = *yymsg;
    int yyi = 0;
    while ((*yyp = *yyformat) != '\0')
	    {
	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
		{
		  yyp += yytnamerr (yyp, yyarg[yyi++]);
		  yyf += 2;
		}
	      else
		{
		  yyp++;
		  yyf++;
		}
	    }
      if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
        {
          yyp += yytnamerr (yyp, yyarg[yyi++]);
          yyformat += 2;
        }
      else
        {
          yyp++;
          yyformat++;
        }
  }
	}
      return yysize;
  return 0;
    }
}
#endif /* YYERROR_VERBOSE */


/*-----------------------------------------------.
| Release the memory associated to this symbol.  |
`-----------------------------------------------*/

/*ARGSUSED*/
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info)
#else
static void
yydestruct (yymsg, yytype, yyvaluep, yylocationp, info)
    const char *yymsg;
    int yytype;
    YYSTYPE *yyvaluep;
    YYLTYPE *yylocationp;
    DateInfo* info;
#endif
{
  YYUSE (yyvaluep);
  YYUSE (yylocationp);
  YYUSE (info);

  if (!yymsg)
    yymsg = "Deleting";
  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);

  switch (yytype)
    {

  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
      default:
	break;
    }
}


  YYUSE (yytype);
  YY_IGNORE_MAYBE_UNINITIALIZED_END
/* Prevent warnings from -Wmissing-prototypes.  */

}
#ifdef YYPARSE_PARAM
#if defined __STDC__ || defined __cplusplus
int yyparse (void *YYPARSE_PARAM);
#else
int yyparse ();
#endif
#else /* ! YYPARSE_PARAM */
#if defined __STDC__ || defined __cplusplus
int yyparse (DateInfo* info);
#else
int yyparse ();
#endif
#endif /* ! YYPARSE_PARAM */






/*----------.
| yyparse.  |
`----------*/

#ifdef YYPARSE_PARAM
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
int
yyparse (void *YYPARSE_PARAM)
#else
int
yyparse (YYPARSE_PARAM)
    void *YYPARSE_PARAM;
#endif
#else /* ! YYPARSE_PARAM */
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
int
yyparse (DateInfo* info)
#else
int
yyparse (info)
    DateInfo* info;
#endif
#endif
{
  /* The look-ahead symbol.  */
/* The lookahead symbol.  */
int yychar;


/* The semantic value of the look-ahead symbol.  */
YYSTYPE yylval;
/* The semantic value of the lookahead symbol.  */
/* Default value used for initialization, for pacifying older GCCs
   or non-GCC compilers.  */
YY_INITIAL_VALUE (static YYSTYPE yyval_default;)
YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default);

/* Location data for the lookahead symbol.  */
static YYLTYPE yyloc_default
# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
  = { 1, 1, 1, 1 }
# endif
;
YYLTYPE yylloc = yyloc_default;

/* Number of syntax errors so far.  */
int yynerrs;
/* Location data for the look-ahead symbol.  */
YYLTYPE yylloc;
    /* Number of syntax errors so far.  */
    int yynerrs;

    int yystate;
    /* Number of tokens to shift before error messages enabled.  */
    int yyerrstatus;

    /* The stacks and their tools:
       'yyss': related to states.
       'yyvs': related to semantic values.
       'yyls': related to locations.

       Refer to the stacks through separate pointers, to allow yyoverflow
       to reallocate them elsewhere.  */

    /* The state stack.  */
    yytype_int16 yyssa[YYINITDEPTH];
    yytype_int16 *yyss;
    yytype_int16 *yyssp;

    /* The semantic value stack.  */
    YYSTYPE yyvsa[YYINITDEPTH];
    YYSTYPE *yyvs;
    YYSTYPE *yyvsp;

    /* The location stack.  */
    YYLTYPE yylsa[YYINITDEPTH];
    YYLTYPE *yyls;
    YYLTYPE *yylsp;

    /* The locations where the error started and ended.  */
    YYLTYPE yyerror_range[3];

  int yystate;
    YYSIZE_T yystacksize;

  int yyn;
  int yyresult;
  /* Number of tokens to shift before error messages enabled.  */
  int yyerrstatus;
  /* Look-ahead token as an internal (translated) token number.  */
  /* Lookahead token as an internal (translated) token number.  */
  int yytoken = 0;
  /* The variables used to return semantic value and location from the
     action routines.  */
  YYSTYPE yyval;
  YYLTYPE yyloc;

#if YYERROR_VERBOSE
  /* Buffer for error messages, and its allocated size.  */
  char yymsgbuf[128];
  char *yymsg = yymsgbuf;
  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
#endif

  /* Three stacks and their tools:
     `yyss': related to states,
     `yyvs': related to semantic values,
     `yyls': related to locations.

     Refer to the stacks thru separate pointers, to allow yyoverflow
     to reallocate them elsewhere.  */

  /* The state stack.  */
  yytype_int16 yyssa[YYINITDEPTH];
  yytype_int16 *yyss = yyssa;
  yytype_int16 *yyssp;

  /* The semantic value stack.  */
  YYSTYPE yyvsa[YYINITDEPTH];
  YYSTYPE *yyvs = yyvsa;
  YYSTYPE *yyvsp;

  /* The location stack.  */
  YYLTYPE yylsa[YYINITDEPTH];
  YYLTYPE *yyls = yylsa;
  YYLTYPE *yylsp;
  /* The locations where the error started and ended.  */
  YYLTYPE yyerror_range[2];

#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N), yylsp -= (N))

  YYSIZE_T yystacksize = YYINITDEPTH;

  /* The variables used to return semantic value and location from the
     action routines.  */
  YYSTYPE yyval;
  YYLTYPE yyloc;

  /* The number of symbols on the RHS of the reduced rule.
     Keep to zero when no symbol should be popped.  */
  int yylen = 0;

  yyssp = yyss = yyssa;
  yyvsp = yyvs = yyvsa;
  yylsp = yyls = yylsa;
  yystacksize = YYINITDEPTH;

  YYDPRINTF ((stderr, "Starting parse\n"));

  yystate = 0;
  yyerrstatus = 0;
  yynerrs = 0;
  yychar = YYEMPTY;		/* Cause a token to be read.  */
  yychar = YYEMPTY; /* Cause a token to be read.  */

  /* Initialize stack pointers.
     Waste one element of value and location stack
     so that they stay on the same level as the state stack.
     The wasted elements are never initialized.  */

  yyssp = yyss;
  yyvsp = yyvs;
  yylsp = yyls;
  yylsp[0] = yylloc;
#if YYLTYPE_IS_TRIVIAL
  /* Initialize the default location before parsing starts.  */
  yylloc.first_line   = yylloc.last_line   = 1;
  yylloc.first_column = yylloc.last_column = 0;
#endif

  goto yysetstate;

/*------------------------------------------------------------.
| yynewstate -- Push a new state, which is found in yystate.  |
`------------------------------------------------------------*/
 yynewstate:
  /* In all cases, when you get here, the value and location stacks
     have just been pushed.  So pushing a state here evens the stacks.  */
  yyssp++;

 yysetstate:
  *yyssp = yystate;

  if (yyss + yystacksize - 1 <= yyssp)
    {
      /* Get the current used size of the three stacks, in elements.  */
      YYSIZE_T yysize = yyssp - yyss + 1;

#ifdef yyoverflow
      {
	/* Give user a chance to reallocate the stack.  Use copies of
	   these so that the &'s don't force the real ones into
	   memory.  */
	YYSTYPE *yyvs1 = yyvs;
	yytype_int16 *yyss1 = yyss;
	YYLTYPE *yyls1 = yyls;
        /* Give user a chance to reallocate the stack.  Use copies of
           these so that the &'s don't force the real ones into
           memory.  */
        YYSTYPE *yyvs1 = yyvs;
        yytype_int16 *yyss1 = yyss;
        YYLTYPE *yyls1 = yyls;

	/* Each stack pointer address is followed by the size of the
	   data in use in that stack, in bytes.  This used to be a
	   conditional around just the two extra args, but that might
	   be undefined if yyoverflow is a macro.  */
	yyoverflow (YY_("memory exhausted"),
		    &yyss1, yysize * sizeof (*yyssp),
		    &yyvs1, yysize * sizeof (*yyvsp),
		    &yyls1, yysize * sizeof (*yylsp),
		    &yystacksize);
	yyls = yyls1;
	yyss = yyss1;
	yyvs = yyvs1;
        /* Each stack pointer address is followed by the size of the
           data in use in that stack, in bytes.  This used to be a
           conditional around just the two extra args, but that might
           be undefined if yyoverflow is a macro.  */
        yyoverflow (YY_("memory exhausted"),
                    &yyss1, yysize * sizeof (*yyssp),
                    &yyvs1, yysize * sizeof (*yyvsp),
                    &yyls1, yysize * sizeof (*yylsp),
                    &yystacksize);

        yyls = yyls1;
        yyss = yyss1;
        yyvs = yyvs1;
      }
#else /* no yyoverflow */
# ifndef YYSTACK_RELOCATE
      goto yyexhaustedlab;
# else
      /* Extend the stack our own way.  */
      if (YYMAXDEPTH <= yystacksize)
	goto yyexhaustedlab;
        goto yyexhaustedlab;
      yystacksize *= 2;
      if (YYMAXDEPTH < yystacksize)
	yystacksize = YYMAXDEPTH;
        yystacksize = YYMAXDEPTH;

      {
	yytype_int16 *yyss1 = yyss;
	union yyalloc *yyptr =
	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
	if (! yyptr)
	  goto yyexhaustedlab;
	YYSTACK_RELOCATE (yyss);
	YYSTACK_RELOCATE (yyvs);
	YYSTACK_RELOCATE (yyls);
        yytype_int16 *yyss1 = yyss;
        union yyalloc *yyptr =
          (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
        if (! yyptr)
          goto yyexhaustedlab;
        YYSTACK_RELOCATE (yyss_alloc, yyss);
        YYSTACK_RELOCATE (yyvs_alloc, yyvs);
        YYSTACK_RELOCATE (yyls_alloc, yyls);
#  undef YYSTACK_RELOCATE
	if (yyss1 != yyssa)
	  YYSTACK_FREE (yyss1);
        if (yyss1 != yyssa)
          YYSTACK_FREE (yyss1);
      }
# endif
#endif /* no yyoverflow */

      yyssp = yyss + yysize - 1;
      yyvsp = yyvs + yysize - 1;
      yylsp = yyls + yysize - 1;

      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
		  (unsigned long int) yystacksize));
                  (unsigned long) yystacksize));

      if (yyss + yystacksize - 1 <= yyssp)
	YYABORT;
        YYABORT;
    }

  YYDPRINTF ((stderr, "Entering state %d\n", yystate));

  if (yystate == YYFINAL)
    YYACCEPT;

  goto yybackup;

/*-----------.
| yybackup.  |
`-----------*/
yybackup:

  /* Do appropriate processing given the current state.  Read a
     look-ahead token if we need one and don't already have one.  */
     lookahead token if we need one and don't already have one.  */

  /* First try to decide what to do without reference to look-ahead token.  */
  /* First try to decide what to do without reference to lookahead token.  */
  yyn = yypact[yystate];
  if (yyn == YYPACT_NINF)
  if (yypact_value_is_default (yyn))
    goto yydefault;

  /* Not known => get a look-ahead token if don't already have one.  */
  /* Not known => get a lookahead token if don't already have one.  */

  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
  /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
  if (yychar == YYEMPTY)
    {
      YYDPRINTF ((stderr, "Reading a token: "));
      yychar = YYLEX;
      yychar = yylex (&yylval, &yylloc, info);
    }

  if (yychar <= YYEOF)
    {
      yychar = yytoken = YYEOF;
      YYDPRINTF ((stderr, "Now at end of input.\n"));
    }
1547
1548
1549
1550
1551
1552
1553
1554
1555


1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568

1569
1570
1571

1572
1573

1574
1575

1576

1577
1578
1579
1580
1581
1582
1583
1485
1486
1487
1488
1489
1490
1491


1492
1493
1494
1495
1496
1497



1498
1499
1500
1501
1502

1503
1504
1505

1506


1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519







-
-
+
+




-
-
-





-
+


-
+
-
-
+


+

+







     detect an error, take that action.  */
  yyn += yytoken;
  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
    goto yydefault;
  yyn = yytable[yyn];
  if (yyn <= 0)
    {
      if (yyn == 0 || yyn == YYTABLE_NINF)
	goto yyerrlab;
      if (yytable_value_is_error (yyn))
        goto yyerrlab;
      yyn = -yyn;
      goto yyreduce;
    }

  if (yyn == YYFINAL)
    YYACCEPT;

  /* Count tokens shifted since error; after three, turn off error
     status.  */
  if (yyerrstatus)
    yyerrstatus--;

  /* Shift the look-ahead token.  */
  /* Shift the lookahead token.  */
  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);

  /* Discard the shifted token unless it is eof.  */
  /* Discard the shifted token.  */
  if (yychar != YYEOF)
    yychar = YYEMPTY;
  yychar = YYEMPTY;

  yystate = yyn;
  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
  *++yyvsp = yylval;
  YY_IGNORE_MAYBE_UNINITIALIZED_END
  *++yylsp = yylloc;
  goto yynewstate;


/*-----------------------------------------------------------.
| yydefault -- do the default action for the current state.  |
`-----------------------------------------------------------*/
1592
1593
1594
1595
1596
1597
1598
1599

1600
1601
1602
1603
1604
1605
1606
1607
1608

1609

1610
1611
1612
1613
1614
1615
1616

1617

1618
1619
1620
1621
1622
1623

1624

1625
1626
1627
1628
1629
1630

1631

1632
1633
1634
1635
1636
1637

1638

1639
1640
1641
1642
1643
1644

1645

1646
1647
1648
1649
1650
1651

1652

1653
1654
1655
1656
1657
1658
1659

1660

1661
1662
1663
1664
1665
1666
1667
1668

1669

1670
1671
1672
1673
1674
1675

1676
1677
1678
1679



1680
1681
1682
1683
1684
1685
1686


1687
1688
1689



1690
1691
1692
1693
1694
1695
1696


1697
1698
1699

1700

1701

1702
1703
1704
1705
1706
1707
1708
1709
1710
1711






1712
1713
1714
1715
1716
1717
1718
1719



1720
1721
1722

1723

1724

1725
1726
1727
1728
1729
1730

1731

1732

1733
1734
1735
1736
1737
1738

1739

1740

1741
1742
1743
1744
1745
1746

1747

1748

1749
1750
1751
1752
1753
1754
1755
1756



1757
1758
1759
1760
1761
1762
1763
1764



1765
1766
1767
1768
1769
1770
1771
1772




1773
1774
1775
1776
1777
1778
1779
1780




1781
1782
1783
1784
1785
1786
1787
1788



1789
1790
1791
1792
1793
1794
1795
1796




1797
1798
1799
1800
1801
1802
1803
1804
1805





1806
1807
1808
1809
1810
1811
1812
1813
1814





1815
1816
1817
1818
1819
1820
1821
1822
1823





1824
1825
1826
1827
1828
1829
1830
1831
1832





1833
1834
1835
1836
1837
1838
1839
1840




1841
1842
1843
1844
1845
1846
1847
1848
1849





1850
1851
1852
1853
1854
1855
1856
1857




1858
1859
1860
1861
1862
1863
1864
1865

1866

1867
1868
1869
1870
1871
1872
1873
1874
1875





1876
1877
1878
1879
1880
1881
1882
1883



1884
1885
1886
1887
1888
1889
1890
1891




1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904









1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917









1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929








1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940

1941
1942
1943
1944
1945




1946
1947
1948
1949
1950
1951
1952
1953

1954

1955
1956
1957
1958
1959
1960
1961



1962
1963
1964
1965
1966
1967
1968



1969
1970
1971
1972
1973
1974
1975



1976
1977
1978
1979
1980
1981
1982



1983
1984
1985
1986
1987
1988
1989



1990
1991
1992
1993
1994
1995

1996

1997
1998
1999
2000
2001
2002

2003

2004
2005
2006
2007
2008
2009

2010

2011

2012
2013
2014
2015
2016
2017

2018

2019

2020
2021
2022
2023
2024
2025

2026

2027

2028
2029
2030
2031
2032
2033
2034

2035
2036
2037
2038

2039
2040
2041
2042


2043
2044
2045
2046

2047

2048
2049
2050
2051
2052
2053

2054

2055
2056
2057
2058
2059
2060
2061



2062
2063
2064
2065
2066
2067
2068











2069
2070
2071
2072
2073
2074
2075
2076
2077
2078

2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095



2096




2097
2098
2099
2100
2101
2102
2103


2104

2105
2106
2107






2108
2109
2110
2111
2112
2113
2114




2115
2116
2117
2118
2119
2120





2121
2122

2123
2124
2125
2126
2127




2128
2129
2130
2131
2132
2133





2134

2135
2136
2137
2138

2139
2140
2141
2142
2143


2144
2145
2146
2147
2148
2149
2150





2151
2152
2153
2154
2155
2156





2157
2158
2159

2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176

2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189

2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203










2204
2205
2206
2207

2208
2209

2210
2211

2212
2213
2214
2215
2216
2217
2218
2219

2220

2221
2222

2223
2224
2225


2226
2227
2228
2229
2230
2231
2232
1528
1529
1530
1531
1532
1533
1534

1535
1536
1537
1538
1539
1540
1541
1542
1543

1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554

1555
1556
1557
1558
1559
1560
1561
1562

1563
1564
1565
1566
1567
1568
1569
1570

1571
1572
1573
1574
1575
1576
1577
1578

1579
1580
1581
1582
1583
1584
1585
1586

1587
1588
1589
1590
1591
1592
1593
1594

1595
1596
1597
1598
1599
1600
1601
1602
1603

1604
1605
1606
1607
1608
1609
1610
1611
1612
1613

1614
1615
1616
1617
1618
1619

1620
1621
1622


1623
1624
1625
1626
1627
1628
1629
1630


1631
1632
1633


1634
1635
1636
1637
1638
1639
1640
1641


1642
1643
1644
1645

1646
1647
1648

1649
1650
1651
1652
1653
1654





1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665



1666
1667
1668
1669
1670

1671
1672
1673

1674
1675
1676
1677
1678
1679

1680
1681
1682

1683
1684
1685
1686
1687
1688

1689
1690
1691

1692
1693
1694
1695
1696
1697

1698
1699
1700

1701
1702
1703
1704
1705
1706
1707


1708
1709
1710
1711
1712
1713
1714
1715
1716


1717
1718
1719
1720
1721
1722
1723
1724



1725
1726
1727
1728
1729
1730
1731
1732
1733



1734
1735
1736
1737
1738
1739
1740
1741
1742
1743


1744
1745
1746
1747
1748
1749
1750
1751



1752
1753
1754
1755
1756
1757
1758
1759
1760




1761
1762
1763
1764
1765
1766
1767
1768
1769
1770




1771
1772
1773
1774
1775
1776
1777
1778
1779
1780




1781
1782
1783
1784
1785
1786
1787
1788
1789
1790




1791
1792
1793
1794
1795
1796
1797
1798
1799
1800



1801
1802
1803
1804
1805
1806
1807
1808
1809




1810
1811
1812
1813
1814
1815
1816
1817
1818
1819



1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832

1833
1834
1835
1836
1837
1838




1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849


1850
1851
1852
1853
1854
1855
1856
1857



1858
1859
1860
1861
1862
1863
1864
1865
1866








1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880








1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894







1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912

1913
1914
1915



1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928

1929
1930
1931
1932
1933
1934


1935
1936
1937
1938
1939
1940
1941
1942


1943
1944
1945
1946
1947
1948
1949
1950


1951
1952
1953
1954
1955
1956
1957
1958


1959
1960
1961
1962
1963
1964
1965
1966


1967
1968
1969
1970
1971
1972
1973
1974
1975
1976

1977
1978
1979
1980
1981
1982
1983
1984

1985
1986
1987
1988
1989
1990

1991
1992
1993

1994
1995
1996
1997
1998
1999

2000
2001
2002

2003
2004
2005
2006
2007
2008

2009
2010
2011

2012
2013
2014
2015
2016
2017
2018

2019
2020
2021
2022

2023
2024
2025


2026
2027
2028
2029
2030
2031
2032

2033
2034
2035
2036
2037
2038
2039
2040

2041
2042
2043
2044
2045
2046


2047
2048
2049
2050
2051
2052

2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075

2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090



2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109



2110
2111
2112
2113
2114
2115







2116
2117
2118
2119






2120
2121
2122
2123
2124


2125





2126
2127
2128
2129






2130
2131
2132
2133
2134

2135
2136
2137
2138

2139
2140
2141
2142


2143
2144
2145
2146





2147
2148
2149
2150
2151
2152





2153
2154
2155
2156
2157
2158
2159

2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175


2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188

2189
2190
2191
2192
2193










2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206

2207
2208

2209
2210

2211
2212
2213
2214
2215
2216



2217
2218
2219
2220

2221
2222


2223
2224
2225
2226
2227
2228
2229
2230
2231







-
+








-
+

+







+
-
+






+
-
+






+
-
+






+
-
+






+
-
+






+
-
+







+
-
+








+
-
+





-
+


-
-
+
+
+





-
-
+
+

-
-
+
+
+





-
-
+
+


-
+

+
-
+





-
-
-
-
-
+
+
+
+
+
+





-
-
-
+
+
+


-
+

+
-
+





-
+

+
-
+





-
+

+
-
+





-
+

+
-
+






-
-
+
+
+






-
-
+
+
+





-
-
-
+
+
+
+





-
-
-
+
+
+
+






-
-
+
+
+





-
-
-
+
+
+
+





-
-
-
-
+
+
+
+
+





-
-
-
-
+
+
+
+
+





-
-
-
-
+
+
+
+
+





-
-
-
-
+
+
+
+
+





-
-
-
+
+
+
+





-
-
-
-
+
+
+
+
+





-
-
-
+
+
+
+








+
-
+





-
-
-
-
+
+
+
+
+






-
-
+
+
+





-
-
-
+
+
+
+





-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+





-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+





-
-
-
-
-
-
-
+
+
+
+
+
+
+
+










-
+


-
-
-
+
+
+
+








+
-
+





-
-
+
+
+





-
-
+
+
+





-
-
+
+
+





-
-
+
+
+





-
-
+
+
+






+
-
+






+
-
+





-
+

+
-
+





-
+

+
-
+





-
+

+
-
+






-
+



-
+


-
-
+
+




+
-
+






+
-
+





-
-
+
+
+



-



+
+
+
+
+
+
+
+
+
+
+









-
+














-
-
-
+
+
+

+
+
+
+







+
+

+
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
+



-
+



-
-
+
+


-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+


-
+















-
-
+












-
+




-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+



-
+

-
+

-
+





-
-
-
+

+

-
+

-
-
+
+







| yyreduce -- Do a reduction.  |
`-----------------------------*/
yyreduce:
  /* yyn is the number of a rule to reduce with.  */
  yylen = yyr2[yyn];

  /* If YYLEN is nonzero, implement the default value of the action:
     `$$ = $1'.
     '$$ = $1'.

     Otherwise, the following line sets YYVAL to garbage.
     This behavior is undocumented and Bison
     users should not rely upon it.  Assigning to YYVAL
     unconditionally makes the parser a bit smaller, and it avoids a
     GCC warning that YYVAL may be used uninitialized.  */
  yyval = yyvsp[1-yylen];

  /* Default location.  */
  /* Default location. */
  YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen);
  yyerror_range[1] = yyloc;
  YY_REDUCE_PRINT (yyn);
  switch (yyn)
    {
        case 4:

    {
	    yyHaveTime++;
	}
	;}

    break;

  case 5:

    {
	    yyHaveZone++;
	}
	;}

    break;

  case 6:

    {
	    yyHaveDate++;
	}
	;}

    break;

  case 7:

    {
	    yyHaveOrdinalMonth++;
	}
	;}

    break;

  case 8:

    {
	    yyHaveDay++;
	}
	;}

    break;

  case 9:

    {
	    yyHaveRel++;
	}
	;}

    break;

  case 10:

    {
	    yyHaveTime++;
	    yyHaveDate++;
	}
	;}

    break;

  case 11:

    {
	    yyHaveTime++;
	    yyHaveDate++;
	    yyHaveRel++;
	}
	;}

    break;

  case 13:

    {
	    yyHour = (yyvsp[(1) - (2)].Number);
	    yyHour = (yyvsp[-1].Number);
	    yyMinutes = 0;
	    yySeconds = 0;
	    yyMeridian = (yyvsp[(2) - (2)].Meridian);
	;}
	    yyMeridian = (yyvsp[0].Meridian);
	}

    break;

  case 14:

    {
	    yyHour = (yyvsp[(1) - (4)].Number);
	    yyMinutes = (yyvsp[(3) - (4)].Number);
	    yyHour = (yyvsp[-3].Number);
	    yyMinutes = (yyvsp[-1].Number);
	    yySeconds = 0;
	    yyMeridian = (yyvsp[(4) - (4)].Meridian);
	;}
	    yyMeridian = (yyvsp[0].Meridian);
	}

    break;

  case 15:

    {
	    yyHour = (yyvsp[(1) - (5)].Number);
	    yyMinutes = (yyvsp[(3) - (5)].Number);
	    yyHour = (yyvsp[-4].Number);
	    yyMinutes = (yyvsp[-2].Number);
	    yyMeridian = MER24;
	    yyDSTmode = DSToff;
	    yyTimezone = ((yyvsp[(5) - (5)].Number) % 100 + ((yyvsp[(5) - (5)].Number) / 100) * 60);
	    yyTimezone = ((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
	    ++yyHaveZone;
	}
	;}

    break;

  case 16:

    {
	    yyHour = (yyvsp[(1) - (6)].Number);
	    yyMinutes = (yyvsp[(3) - (6)].Number);
	    yySeconds = (yyvsp[(5) - (6)].Number);
	    yyMeridian = (yyvsp[(6) - (6)].Meridian);
	;}
	    yyHour = (yyvsp[-5].Number);
	    yyMinutes = (yyvsp[-3].Number);
	    yySeconds = (yyvsp[-1].Number);
	    yyMeridian = (yyvsp[0].Meridian);
	}

    break;

  case 17:

    {
	    yyHour = (yyvsp[(1) - (7)].Number);
	    yyMinutes = (yyvsp[(3) - (7)].Number);
	    yySeconds = (yyvsp[(5) - (7)].Number);
	    yyHour = (yyvsp[-6].Number);
	    yyMinutes = (yyvsp[-4].Number);
	    yySeconds = (yyvsp[-2].Number);
	    yyMeridian = MER24;
	    yyDSTmode = DSToff;
	    yyTimezone = ((yyvsp[(7) - (7)].Number) % 100 + ((yyvsp[(7) - (7)].Number) / 100) * 60);
	    yyTimezone = ((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
	    ++yyHaveZone;
	}
	;}

    break;

  case 18:

    {
	    yyTimezone = (yyvsp[(1) - (2)].Number);
	    yyTimezone = (yyvsp[-1].Number);
	    yyDSTmode = DSTon;
	}
	;}

    break;

  case 19:

    {
	    yyTimezone = (yyvsp[(1) - (1)].Number);
	    yyTimezone = (yyvsp[0].Number);
	    yyDSTmode = DSToff;
	}
	;}

    break;

  case 20:

    {
	    yyTimezone = (yyvsp[(1) - (1)].Number);
	    yyTimezone = (yyvsp[0].Number);
	    yyDSTmode = DSTon;
	}
	;}

    break;

  case 21:

    {
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[(1) - (1)].Number);
	;}
	    yyDayNumber = (yyvsp[0].Number);
	}

    break;

  case 22:

    {
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[(1) - (2)].Number);
	;}
	    yyDayNumber = (yyvsp[-1].Number);
	}

    break;

  case 23:

    {
	    yyDayOrdinal = (yyvsp[(1) - (2)].Number);
	    yyDayNumber = (yyvsp[(2) - (2)].Number);
	;}
	    yyDayOrdinal = (yyvsp[-1].Number);
	    yyDayNumber = (yyvsp[0].Number);
	}

    break;

  case 24:

    {
	    yyDayOrdinal = (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number);
	    yyDayNumber = (yyvsp[(3) - (3)].Number);
	;}
	    yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number);
	    yyDayNumber = (yyvsp[0].Number);
	}

    break;

  case 25:

    {
	    yyDayOrdinal = 2;
	    yyDayNumber = (yyvsp[(2) - (2)].Number);
	;}
	    yyDayNumber = (yyvsp[0].Number);
	}

    break;

  case 26:

    {
	    yyMonth = (yyvsp[(1) - (3)].Number);
	    yyDay = (yyvsp[(3) - (3)].Number);
	;}
	    yyMonth = (yyvsp[-2].Number);
	    yyDay = (yyvsp[0].Number);
	}

    break;

  case 27:

    {
	    yyMonth = (yyvsp[(1) - (5)].Number);
	    yyDay = (yyvsp[(3) - (5)].Number);
	    yyYear = (yyvsp[(5) - (5)].Number);
	;}
	    yyMonth = (yyvsp[-4].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}

    break;

  case 28:

    {
	    yyYear = (yyvsp[(1) - (1)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (1)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (1)].Number) % 100;
	;}
	    yyYear = (yyvsp[0].Number) / 10000;
	    yyMonth = ((yyvsp[0].Number) % 10000)/100;
	    yyDay = (yyvsp[0].Number) % 100;
	}

    break;

  case 29:

    {
	    yyDay = (yyvsp[(1) - (5)].Number);
	    yyMonth = (yyvsp[(3) - (5)].Number);
	    yyYear = (yyvsp[(5) - (5)].Number);
	;}
	    yyDay = (yyvsp[-4].Number);
	    yyMonth = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}

    break;

  case 30:

    {
	    yyMonth = (yyvsp[(3) - (5)].Number);
	    yyDay = (yyvsp[(5) - (5)].Number);
	    yyYear = (yyvsp[(1) - (5)].Number);
	;}
	    yyMonth = (yyvsp[-2].Number);
	    yyDay = (yyvsp[0].Number);
	    yyYear = (yyvsp[-4].Number);
	}

    break;

  case 31:

    {
	    yyMonth = (yyvsp[(1) - (2)].Number);
	    yyDay = (yyvsp[(2) - (2)].Number);
	;}
	    yyMonth = (yyvsp[-1].Number);
	    yyDay = (yyvsp[0].Number);
	}

    break;

  case 32:

    {
	    yyMonth = (yyvsp[(1) - (4)].Number);
	    yyDay = (yyvsp[(2) - (4)].Number);
	    yyYear = (yyvsp[(4) - (4)].Number);
	;}
	    yyMonth = (yyvsp[-3].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}

    break;

  case 33:

    {
	    yyMonth = (yyvsp[(2) - (2)].Number);
	    yyDay = (yyvsp[(1) - (2)].Number);
	;}
	    yyMonth = (yyvsp[0].Number);
	    yyDay = (yyvsp[-1].Number);
	}

    break;

  case 34:

    {
	    yyMonth = 1;
	    yyDay = 1;
	    yyYear = EPOCH;
	}
	;}

    break;

  case 35:

    {
	    yyMonth = (yyvsp[(2) - (3)].Number);
	    yyDay = (yyvsp[(1) - (3)].Number);
	    yyYear = (yyvsp[(3) - (3)].Number);
	;}
	    yyMonth = (yyvsp[-1].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	}

    break;

  case 36:

    {
	    yyMonthOrdinal = 1;
	    yyMonth = (yyvsp[(2) - (2)].Number);
	;}
	    yyMonth = (yyvsp[0].Number);
	}

    break;

  case 37:

    {
	    yyMonthOrdinal = (yyvsp[(2) - (3)].Number);
	    yyMonth = (yyvsp[(3) - (3)].Number);
	;}
	    yyMonthOrdinal = (yyvsp[-1].Number);
	    yyMonth = (yyvsp[0].Number);
	}

    break;

  case 38:

    {
	    if ((yyvsp[(2) - (3)].Number) != HOUR( 7)) YYABORT;
	    yyYear = (yyvsp[(1) - (3)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (3)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (3)].Number) % 100;
	    yyHour = (yyvsp[(3) - (3)].Number) / 10000;
	    yyMinutes = ((yyvsp[(3) - (3)].Number) % 10000)/100;
	    yySeconds = (yyvsp[(3) - (3)].Number) % 100;
	;}
	    if ((yyvsp[-1].Number) != HOUR( 7)) YYABORT;
	    yyYear = (yyvsp[-2].Number) / 10000;
	    yyMonth = ((yyvsp[-2].Number) % 10000)/100;
	    yyDay = (yyvsp[-2].Number) % 100;
	    yyHour = (yyvsp[0].Number) / 10000;
	    yyMinutes = ((yyvsp[0].Number) % 10000)/100;
	    yySeconds = (yyvsp[0].Number) % 100;
	}

    break;

  case 39:

    {
	    if ((yyvsp[(2) - (7)].Number) != HOUR( 7)) YYABORT;
	    yyYear = (yyvsp[(1) - (7)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (7)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (7)].Number) % 100;
	    yyHour = (yyvsp[(3) - (7)].Number);
	    yyMinutes = (yyvsp[(5) - (7)].Number);
	    yySeconds = (yyvsp[(7) - (7)].Number);
	;}
	    if ((yyvsp[-5].Number) != HOUR( 7)) YYABORT;
	    yyYear = (yyvsp[-6].Number) / 10000;
	    yyMonth = ((yyvsp[-6].Number) % 10000)/100;
	    yyDay = (yyvsp[-6].Number) % 100;
	    yyHour = (yyvsp[-4].Number);
	    yyMinutes = (yyvsp[-2].Number);
	    yySeconds = (yyvsp[0].Number);
	}

    break;

  case 40:

    {
	    yyYear = (yyvsp[(1) - (2)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (2)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (2)].Number) % 100;
	    yyHour = (yyvsp[(2) - (2)].Number) / 10000;
	    yyMinutes = ((yyvsp[(2) - (2)].Number) % 10000)/100;
	    yySeconds = (yyvsp[(2) - (2)].Number) % 100;
	;}
	    yyYear = (yyvsp[-1].Number) / 10000;
	    yyMonth = ((yyvsp[-1].Number) % 10000)/100;
	    yyDay = (yyvsp[-1].Number) % 100;
	    yyHour = (yyvsp[0].Number) / 10000;
	    yyMinutes = ((yyvsp[0].Number) % 10000)/100;
	    yySeconds = (yyvsp[0].Number) % 100;
	}

    break;

  case 41:

    {
	    /*
	     * Offset computed year by -377 so that the returned years will be
	     * in a range accessible with a 32 bit clock seconds value.
	     */

	    yyYear = (yyvsp[(2) - (4)].Number)/1000 + 2323 - 377;
	    yyYear = (yyvsp[-2].Number)/1000 + 2323 - 377;
	    yyDay  = 1;
	    yyMonth = 1;
	    yyRelDay += (((yyvsp[(2) - (4)].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
	    yyRelSeconds += (yyvsp[(4) - (4)].Number) * 144 * 60;
	;}
	    yyRelDay += (((yyvsp[-2].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
	    yyRelSeconds += (yyvsp[0].Number) * 144 * 60;
	}

    break;

  case 42:

    {
	    yyRelSeconds *= -1;
	    yyRelMonth *= -1;
	    yyRelDay *= -1;
	}
	;}

    break;

  case 44:

    {
	    *yyRelPointer += (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
	;}
	    *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number);
	}

    break;

  case 45:

    {
	    *yyRelPointer += (yyvsp[(1) - (2)].Number) * (yyvsp[(2) - (2)].Number);
	;}
	    *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
	}

    break;

  case 46:

    {
	    *yyRelPointer += (yyvsp[(2) - (2)].Number);
	;}
	    *yyRelPointer += (yyvsp[0].Number);
	}

    break;

  case 47:

    {
	    *yyRelPointer += (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
	;}
	    *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
	}

    break;

  case 48:

    {
	    *yyRelPointer += (yyvsp[(1) - (1)].Number);
	;}
	    *yyRelPointer += (yyvsp[0].Number);
	}

    break;

  case 49:

    {
	    (yyval.Number) = -1;
	}
	;}

    break;

  case 50:

    {
	    (yyval.Number) =  1;
	}
	;}

    break;

  case 51:

    {
	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
	    (yyval.Number) = (yyvsp[0].Number);
	    yyRelPointer = &yyRelSeconds;
	}
	;}

    break;

  case 52:

    {
	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
	    (yyval.Number) = (yyvsp[0].Number);
	    yyRelPointer = &yyRelDay;
	}
	;}

    break;

  case 53:

    {
	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
	    (yyval.Number) = (yyvsp[0].Number);
	    yyRelPointer = &yyRelMonth;
	}
	;}

    break;

  case 54:

    {
	    if (yyHaveTime && yyHaveDate && !yyHaveRel) {
		yyYear = (yyvsp[(1) - (1)].Number);
		yyYear = (yyvsp[0].Number);
	    } else {
		yyHaveTime++;
		if (yyDigitCount <= 2) {
		    yyHour = (yyvsp[(1) - (1)].Number);
		    yyHour = (yyvsp[0].Number);
		    yyMinutes = 0;
		} else {
		    yyHour = (yyvsp[(1) - (1)].Number) / 100;
		    yyMinutes = (yyvsp[(1) - (1)].Number) % 100;
		    yyHour = (yyvsp[0].Number) / 100;
		    yyMinutes = (yyvsp[0].Number) % 100;
		}
		yySeconds = 0;
		yyMeridian = MER24;
	    }
	}
	;}

    break;

  case 55:

    {
	    (yyval.Meridian) = MER24;
	}
	;}

    break;

  case 56:

    {
	    (yyval.Meridian) = (yyvsp[(1) - (1)].Meridian);
	;}
	    (yyval.Meridian) = (yyvsp[0].Meridian);
	}

    break;


/* Line 1267 of yacc.c.  */

      default: break;
    }
  /* User semantic actions sometimes alter yychar, and that requires
     that yytoken be updated with the new translation.  We take the
     approach of translating immediately before every use of yytoken.
     One alternative is translating here after every semantic action,
     but that translation would be missed if the semantic action invokes
     YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
     if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an
     incorrect destructor might then be invoked immediately.  In the
     case of YYERROR or YYBACKUP, subsequent parser actions might lead
     to an incorrect destructor call or verbose syntax error message
     before the lookahead is translated.  */
  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);

  YYPOPSTACK (yylen);
  yylen = 0;
  YY_STACK_PRINT (yyss, yyssp);

  *++yyvsp = yyval;
  *++yylsp = yyloc;

  /* Now `shift' the result of the reduction.  Determine what state
  /* Now 'shift' the result of the reduction.  Determine what state
     that goes to, based on the state we popped back to and the rule
     number reduced by.  */

  yyn = yyr1[yyn];

  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
    yystate = yytable[yystate];
  else
    yystate = yydefgoto[yyn - YYNTOKENS];

  goto yynewstate;


/*------------------------------------.
| yyerrlab -- here on detecting error |
`------------------------------------*/
/*--------------------------------------.
| yyerrlab -- here on detecting error.  |
`--------------------------------------*/
yyerrlab:
  /* Make sure we have latest lookahead translation.  See comments at
     user semantic actions for why this is necessary.  */
  yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);

  /* If not already recovering from an error, report this error.  */
  if (!yyerrstatus)
    {
      ++yynerrs;
#if ! YYERROR_VERBOSE
      yyerror (&yylloc, info, YY_("syntax error"));
#else
# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
                                        yyssp, yytoken)
      {
        char const *yymsgp = YY_("syntax error");
	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
	  {
        int yysyntax_error_status;
        yysyntax_error_status = YYSYNTAX_ERROR;
        if (yysyntax_error_status == 0)
          yymsgp = yymsg;
        else if (yysyntax_error_status == 1)
          {
	    YYSIZE_T yyalloc = 2 * yysize;
	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
	    if (yymsg != yymsgbuf)
	      YYSTACK_FREE (yymsg);
	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
	    if (yymsg)
            if (yymsg != yymsgbuf)
              YYSTACK_FREE (yymsg);
            yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
            if (!yymsg)
	      yymsg_alloc = yyalloc;
	    else
	      {
		yymsg = yymsgbuf;
		yymsg_alloc = sizeof yymsgbuf;
	      }
              {
                yymsg = yymsgbuf;
                yymsg_alloc = sizeof yymsgbuf;
                yysyntax_error_status = 2;
              }
	  }

            else
	if (0 < yysize && yysize <= yymsg_alloc)
	  {
	    (void) yysyntax_error (yymsg, yystate, yychar);
	    yyerror (&yylloc, info, yymsg);
	  }
              {
                yysyntax_error_status = YYSYNTAX_ERROR;
                yymsgp = yymsg;
              }
	else
	  {
	    yyerror (&yylloc, info, YY_("syntax error"));
	    if (yysize != 0)
	      goto yyexhaustedlab;
	  }
          }
        yyerror (&yylloc, info, yymsgp);
        if (yysyntax_error_status == 2)
          goto yyexhaustedlab;
      }
      }
# undef YYSYNTAX_ERROR
#endif
    }

  yyerror_range[0] = yylloc;
  yyerror_range[1] = yylloc;

  if (yyerrstatus == 3)
    {
      /* If just tried and failed to reuse look-ahead token after an
	 error, discard it.  */
      /* If just tried and failed to reuse lookahead token after an
         error, discard it.  */

      if (yychar <= YYEOF)
	{
	  /* Return failure if at end of input.  */
	  if (yychar == YYEOF)
	    YYABORT;
	}
        {
          /* Return failure if at end of input.  */
          if (yychar == YYEOF)
            YYABORT;
        }
      else
	{
	  yydestruct ("Error: discarding",
		      yytoken, &yylval, &yylloc, info);
	  yychar = YYEMPTY;
	}
        {
          yydestruct ("Error: discarding",
                      yytoken, &yylval, &yylloc, info);
          yychar = YYEMPTY;
        }
    }

  /* Else will try to reuse look-ahead token after shifting the error
  /* Else will try to reuse lookahead token after shifting the error
     token.  */
  goto yyerrlab1;


/*---------------------------------------------------.
| yyerrorlab -- error raised explicitly by YYERROR.  |
`---------------------------------------------------*/
yyerrorlab:

  /* Pacify compilers like GCC when the user code never invokes
     YYERROR and the label yyerrorlab therefore never appears in user
     code.  */
  if (/*CONSTCOND*/ 0)
     goto yyerrorlab;

  yyerror_range[0] = yylsp[1-yylen];
  /* Do not reclaim the symbols of the rule which action triggered
  /* Do not reclaim the symbols of the rule whose action triggered
     this YYERROR.  */
  YYPOPSTACK (yylen);
  yylen = 0;
  YY_STACK_PRINT (yyss, yyssp);
  yystate = *yyssp;
  goto yyerrlab1;


/*-------------------------------------------------------------.
| yyerrlab1 -- common code for both syntax error and YYERROR.  |
`-------------------------------------------------------------*/
yyerrlab1:
  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
  yyerrstatus = 3;      /* Each real token shifted decrements this.  */

  for (;;)
    {
      yyn = yypact[yystate];
      if (yyn != YYPACT_NINF)
	{
	  yyn += YYTERROR;
	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
	    {
	      yyn = yytable[yyn];
	      if (0 < yyn)
		break;
	    }
	}
      if (!yypact_value_is_default (yyn))
        {
          yyn += YYTERROR;
          if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
            {
              yyn = yytable[yyn];
              if (0 < yyn)
                break;
            }
        }

      /* Pop the current state because it cannot handle the error token.  */
      if (yyssp == yyss)
	YYABORT;
        YYABORT;

      yyerror_range[0] = *yylsp;
      yyerror_range[1] = *yylsp;
      yydestruct ("Error: popping",
		  yystos[yystate], yyvsp, yylsp, info);
                  yystos[yystate], yyvsp, yylsp, info);
      YYPOPSTACK (1);
      yystate = *yyssp;
      YY_STACK_PRINT (yyss, yyssp);
    }

  if (yyn == YYFINAL)
    YYACCEPT;

  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
  *++yyvsp = yylval;
  YY_IGNORE_MAYBE_UNINITIALIZED_END

  yyerror_range[1] = yylloc;
  yyerror_range[2] = yylloc;
  /* Using YYLLOC is tempting, but would change the location of
     the look-ahead.  YYLOC is available though.  */
  YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2);
     the lookahead.  YYLOC is available though.  */
  YYLLOC_DEFAULT (yyloc, yyerror_range, 2);
  *++yylsp = yyloc;

  /* Shift the error token.  */
  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);

  yystate = yyn;
  goto yynewstate;
2242
2243
2244
2245
2246
2247
2248
2249

2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263









2264
2265
2266
2267
2268
2269
2270

2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282

2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2241
2242
2243
2244
2245
2246
2247

2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258




2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273

2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284


2285
2286


2287
2288
2289
2290
2291
2292
2293







-
+










-
-
-
-
+
+
+
+
+
+
+
+
+






-
+










-
-
+

-
-







/*-----------------------------------.
| yyabortlab -- YYABORT comes here.  |
`-----------------------------------*/
yyabortlab:
  yyresult = 1;
  goto yyreturn;

#ifndef yyoverflow
#if !defined yyoverflow || YYERROR_VERBOSE
/*-------------------------------------------------.
| yyexhaustedlab -- memory exhaustion comes here.  |
`-------------------------------------------------*/
yyexhaustedlab:
  yyerror (&yylloc, info, YY_("memory exhausted"));
  yyresult = 2;
  /* Fall through.  */
#endif

yyreturn:
  if (yychar != YYEOF && yychar != YYEMPTY)
     yydestruct ("Cleanup: discarding lookahead",
		 yytoken, &yylval, &yylloc, info);
  /* Do not reclaim the symbols of the rule which action triggered
  if (yychar != YYEMPTY)
    {
      /* Make sure we have latest lookahead translation.  See comments at
         user semantic actions for why this is necessary.  */
      yytoken = YYTRANSLATE (yychar);
      yydestruct ("Cleanup: discarding lookahead",
                  yytoken, &yylval, &yylloc, info);
    }
  /* Do not reclaim the symbols of the rule whose action triggered
     this YYABORT or YYACCEPT.  */
  YYPOPSTACK (yylen);
  YY_STACK_PRINT (yyss, yyssp);
  while (yyssp != yyss)
    {
      yydestruct ("Cleanup: popping",
		  yystos[*yyssp], yyvsp, yylsp, info);
                  yystos[*yyssp], yyvsp, yylsp, info);
      YYPOPSTACK (1);
    }
#ifndef yyoverflow
  if (yyss != yyssa)
    YYSTACK_FREE (yyss);
#endif
#if YYERROR_VERBOSE
  if (yymsg != yymsgbuf)
    YYSTACK_FREE (yymsg);
#endif
  /* Make sure YYID is used.  */
  return YYID (yyresult);
  return yyresult;
}




/*
 * Month and day table.
 */

static const TABLE MonthDayTable[] = {
2676
2677
2678
2679
2680
2681
2682
2683

2684
2685
2686
2687
2688
2689
2690
2677
2678
2679
2680
2681
2682
2683

2684
2685
2686
2687
2688
2689
2690
2691







-
+







    register char c;
    register char *p;
    char buff[20];
    int Count;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {
	while (TclIsSpaceProc(*yyInput)) {
	while (TclIsSpaceProc(UCHAR(*yyInput))) {
	    yyInput++;
	}

	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
	    /*
	     * Convert the string into a number; count the number of digits.
	     */
2907
2908
2909
2910
2911
2912
2913
2914
2908
2909
2910
2911
2912
2913
2914








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

Changes to generic/tclDecls.h.

49
50
51
52
53
54
55
56

57
58
59
60
61
62
63
49
50
51
52
53
54
55

56
57
58
59
60
61
62
63







-
+







 */

/* 0 */
EXTERN int		Tcl_PkgProvideEx(Tcl_Interp *interp,
				const char *name, const char *version,
				const void *clientData);
/* 1 */
EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
EXTERN const char *	Tcl_PkgRequireEx(Tcl_Interp *interp,
				const char *name, const char *version,
				int exact, void *clientDataPtr);
/* 2 */
EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
EXTERN char *		Tcl_Alloc(unsigned int size);
/* 4 */
115
116
117
118
119
120
121

122

123
124
125
126
127
128
129
130
131
132
133

134

135
136
137
138
139
140
141
115
116
117
118
119
120
121
122

123
124
125
126
127
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143







+
-
+











+
-
+







/* 20 */
EXTERN void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
				int line);
/* 21 */
EXTERN int		Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
				int line);
/* 22 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj(int boolValue, const char *file,
Tcl_Obj *		Tcl_DbNewBooleanObj(int boolValue, const char *file,
				int line);
/* 23 */
EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj(const unsigned char *bytes,
				int length, const char *file, int line);
/* 24 */
EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj(double doubleValue,
				const char *file, int line);
/* 25 */
EXTERN Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
				const char *file, int line);
/* 26 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN Tcl_Obj *	Tcl_DbNewLongObj(long longValue, const char *file,
Tcl_Obj *		Tcl_DbNewLongObj(long longValue, const char *file,
				int line);
/* 27 */
EXTERN Tcl_Obj *	Tcl_DbNewObj(const char *file, int line);
/* 28 */
EXTERN Tcl_Obj *	Tcl_DbNewStringObj(const char *bytes, int length,
				const char *file, int line);
/* 29 */
154
155
156
157
158
159
160

161
162


163
164
165
166
167
168
169
170
156
157
158
159
160
161
162
163


164
165

166
167
168
169
170
171
172







+
-
-
+
+
-







/* 34 */
EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, const char *src,
				double *doublePtr);
/* 35 */
EXTERN int		Tcl_GetDoubleFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, double *doublePtr);
/* 36 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN int		Tcl_GetIndexFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr,
int			Tcl_GetIndexFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const char *const *tablePtr,
				CONST84 char *const *tablePtr,
				const char *msg, int flags, int *indexPtr);
/* 37 */
EXTERN int		Tcl_GetInt(Tcl_Interp *interp, const char *src,
				int *intPtr);
/* 38 */
EXTERN int		Tcl_GetIntFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *intPtr);
195
196
197
198
199
200
201

202

203
204
205
206
207
208

209

210
211
212

213

214
215
216
217
218

219

220
221
222
223
224
225
226
227

228

229
230
231
232

233

234
235
236
237
238
239

240

241
242

243

244
245
246
247
248
249
250
197
198
199
200
201
202
203
204

205
206
207
208
209
210
211
212

213
214
215
216
217

218
219
220
221
222
223
224

225
226
227
228
229
230
231
232
233
234

235
236
237
238
239
240

241
242
243
244
245
246
247
248

249
250
251
252

253
254
255
256
257
258
259
260







+
-
+






+
-
+



+
-
+





+
-
+








+
-
+




+
-
+






+
-
+


+
-
+







EXTERN int		Tcl_ListObjLength(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int *lengthPtr);
/* 48 */
EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int first, int count,
				int objc, Tcl_Obj *const objv[]);
/* 49 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN Tcl_Obj *	Tcl_NewBooleanObj(int boolValue);
Tcl_Obj *		Tcl_NewBooleanObj(int boolValue);
/* 50 */
EXTERN Tcl_Obj *	Tcl_NewByteArrayObj(const unsigned char *bytes,
				int length);
/* 51 */
EXTERN Tcl_Obj *	Tcl_NewDoubleObj(double doubleValue);
/* 52 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN Tcl_Obj *	Tcl_NewIntObj(int intValue);
Tcl_Obj *		Tcl_NewIntObj(int intValue);
/* 53 */
EXTERN Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* 54 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN Tcl_Obj *	Tcl_NewLongObj(long longValue);
Tcl_Obj *		Tcl_NewLongObj(long longValue);
/* 55 */
EXTERN Tcl_Obj *	Tcl_NewObj(void);
/* 56 */
EXTERN Tcl_Obj *	Tcl_NewStringObj(const char *bytes, int length);
/* 57 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN void		Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
void			Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
/* 58 */
EXTERN unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
/* 59 */
EXTERN void		Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
				const unsigned char *bytes, int length);
/* 60 */
EXTERN void		Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* 61 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN void		Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
void			Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
/* 62 */
EXTERN void		Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
				Tcl_Obj *const objv[]);
/* 63 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN void		Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
void			Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
/* 64 */
EXTERN void		Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
/* 65 */
EXTERN void		Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
				int length);
/* 66 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN void		Tcl_AddErrorInfo(Tcl_Interp *interp,
void			Tcl_AddErrorInfo(Tcl_Interp *interp,
				const char *message);
/* 67 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN void		Tcl_AddObjErrorInfo(Tcl_Interp *interp,
void			Tcl_AddObjErrorInfo(Tcl_Interp *interp,
				const char *message, int length);
/* 68 */
EXTERN void		Tcl_AllowExceptions(Tcl_Interp *interp);
/* 69 */
EXTERN void		Tcl_AppendElement(Tcl_Interp *interp,
				const char *element);
/* 70 */
259
260
261
262
263
264
265

266

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

284
285
286
287
288
289
290
291
292
293
294

295
296
297
298
299
300
301
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293

294
295
296
297
298
299
300
301
302
303
304

305
306
307
308
309
310
311
312







+
-
+
















-
+










-
+







/* 74 */
EXTERN void		Tcl_AsyncMark(Tcl_AsyncHandler async);
/* 75 */
EXTERN int		Tcl_AsyncReady(void);
/* 76 */
EXTERN void		Tcl_BackgroundError(Tcl_Interp *interp);
/* 77 */
TCL_DEPRECATED("Use Tcl_UtfBackslash")
EXTERN char		Tcl_Backslash(const char *src, int *readPtr);
char			Tcl_Backslash(const char *src, int *readPtr);
/* 78 */
EXTERN int		Tcl_BadChannelOption(Tcl_Interp *interp,
				const char *optionName,
				const char *optionList);
/* 79 */
EXTERN void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc,
				ClientData clientData);
/* 80 */
EXTERN void		Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
				ClientData clientData);
/* 81 */
EXTERN int		Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
/* 82 */
EXTERN int		Tcl_CommandComplete(const char *cmd);
/* 83 */
EXTERN char *		Tcl_Concat(int argc, CONST84 char *const *argv);
EXTERN char *		Tcl_Concat(int argc, const char *const *argv);
/* 84 */
EXTERN int		Tcl_ConvertElement(const char *src, char *dst,
				int flags);
/* 85 */
EXTERN int		Tcl_ConvertCountedElement(const char *src,
				int length, char *dst, int flags);
/* 86 */
EXTERN int		Tcl_CreateAlias(Tcl_Interp *slave,
				const char *slaveCmd, Tcl_Interp *target,
				const char *targetCmd, int argc,
				CONST84 char *const *argv);
				const char *const *argv);
/* 87 */
EXTERN int		Tcl_CreateAliasObj(Tcl_Interp *slave,
				const char *slaveCmd, Tcl_Interp *target,
				const char *targetCmd, int objc,
				Tcl_Obj *const objv[]);
/* 88 */
EXTERN Tcl_Channel	Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
318
319
320
321
322
323
324

325

326
327
328
329
330
331
332
329
330
331
332
333
334
335
336

337
338
339
340
341
342
343
344







+
-
+







				ClientData clientData);
/* 93 */
EXTERN void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* 94 */
EXTERN Tcl_Interp *	Tcl_CreateInterp(void);
/* 95 */
TCL_DEPRECATED("")
EXTERN void		Tcl_CreateMathFunc(Tcl_Interp *interp,
void			Tcl_CreateMathFunc(Tcl_Interp *interp,
				const char *name, int numArgs,
				Tcl_ValueType *argTypes, Tcl_MathProc *proc,
				ClientData clientData);
/* 96 */
EXTERN Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				ClientData clientData,
408
409
410
411
412
413
414
415

416
417

418
419
420
421
422
423

424

425
426
427
428
429
430
431
420
421
422
423
424
425
426

427
428

429
430
431
432
433
434
435
436

437
438
439
440
441
442
443
444







-
+

-
+






+
-
+







/* 124 */
EXTERN void		Tcl_DStringSetLength(Tcl_DString *dsPtr, int length);
/* 125 */
EXTERN void		Tcl_DStringStartSublist(Tcl_DString *dsPtr);
/* 126 */
EXTERN int		Tcl_Eof(Tcl_Channel chan);
/* 127 */
EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
EXTERN const char *	Tcl_ErrnoId(void);
/* 128 */
EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
EXTERN const char *	Tcl_ErrnoMsg(int err);
/* 129 */
EXTERN int		Tcl_Eval(Tcl_Interp *interp, const char *script);
/* 130 */
EXTERN int		Tcl_EvalFile(Tcl_Interp *interp,
				const char *fileName);
/* 131 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN int		Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
int			Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
/* 132 */
EXTERN void		Tcl_EventuallyFree(ClientData clientData,
				Tcl_FreeProc *freeProc);
/* 133 */
EXTERN TCL_NORETURN void Tcl_Exit(int status);
/* 134 */
EXTERN int		Tcl_ExposeCommand(Tcl_Interp *interp,
465
466
467
468
469
470
471
472
473


474
475
476
477
478

479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497

498
499
500
501
502
503
504
505
506
507
508

509
510
511
512
513

514
515
516
517
518
519
520
478
479
480
481
482
483
484


485
486
487
488
489
490

491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509

510
511
512
513
514
515
516
517
518
519
520

521
522
523
524
525

526
527
528
529
530
531
532
533







-
-
+
+




-
+


















-
+










-
+




-
+







EXTERN int		Tcl_Flush(Tcl_Channel chan);
/* 147 */
EXTERN void		Tcl_FreeResult(Tcl_Interp *interp);
/* 148 */
EXTERN int		Tcl_GetAlias(Tcl_Interp *interp,
				const char *slaveCmd,
				Tcl_Interp **targetInterpPtr,
				CONST84 char **targetCmdPtr, int *argcPtr,
				CONST84 char ***argvPtr);
				const char **targetCmdPtr, int *argcPtr,
				const char ***argvPtr);
/* 149 */
EXTERN int		Tcl_GetAliasObj(Tcl_Interp *interp,
				const char *slaveCmd,
				Tcl_Interp **targetInterpPtr,
				CONST84 char **targetCmdPtr, int *objcPtr,
				const char **targetCmdPtr, int *objcPtr,
				Tcl_Obj ***objv);
/* 150 */
EXTERN ClientData	Tcl_GetAssocData(Tcl_Interp *interp,
				const char *name,
				Tcl_InterpDeleteProc **procPtr);
/* 151 */
EXTERN Tcl_Channel	Tcl_GetChannel(Tcl_Interp *interp,
				const char *chanName, int *modePtr);
/* 152 */
EXTERN int		Tcl_GetChannelBufferSize(Tcl_Channel chan);
/* 153 */
EXTERN int		Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
				ClientData *handlePtr);
/* 154 */
EXTERN ClientData	Tcl_GetChannelInstanceData(Tcl_Channel chan);
/* 155 */
EXTERN int		Tcl_GetChannelMode(Tcl_Channel chan);
/* 156 */
EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan);
EXTERN const char *	Tcl_GetChannelName(Tcl_Channel chan);
/* 157 */
EXTERN int		Tcl_GetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,
				Tcl_DString *dsPtr);
/* 158 */
EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
/* 159 */
EXTERN int		Tcl_GetCommandInfo(Tcl_Interp *interp,
				const char *cmdName, Tcl_CmdInfo *infoPtr);
/* 160 */
EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
EXTERN const char *	Tcl_GetCommandName(Tcl_Interp *interp,
				Tcl_Command command);
/* 161 */
EXTERN int		Tcl_GetErrno(void);
/* 162 */
EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
EXTERN const char *	Tcl_GetHostName(void);
/* 163 */
EXTERN int		Tcl_GetInterpPath(Tcl_Interp *askInterp,
				Tcl_Interp *slaveInterp);
/* 164 */
EXTERN Tcl_Interp *	Tcl_GetMaster(Tcl_Interp *interp);
/* 165 */
EXTERN const char *	Tcl_GetNameOfExecutable(void);
542
543
544
545
546
547
548
549

550

551
552


553
554
555


556
557
558
559
560

561

562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581

582
583
584
585
586
587
588
589
590
591
592
593
594

595
596
597
598
599
600
601
602
603
604
605
606
607
608

609
610
611
612
613
614
615
555
556
557
558
559
560
561

562
563
564


565
566
567


568
569

570
571
572
573
574

575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594

595
596
597
598
599
600
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615
616
617
618
619
620
621

622
623
624
625
626
627
628
629







-
+

+
-
-
+
+

-
-
+
+
-




+
-
+



















-
+












-
+













-
+







EXTERN int		Tcl_GetServiceMode(void);
/* 172 */
EXTERN Tcl_Interp *	Tcl_GetSlave(Tcl_Interp *interp,
				const char *slaveName);
/* 173 */
EXTERN Tcl_Channel	Tcl_GetStdChannel(int type);
/* 174 */
EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp);
EXTERN const char *	Tcl_GetStringResult(Tcl_Interp *interp);
/* 175 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp,
				const char *varName, int flags);
const char *		Tcl_GetVar(Tcl_Interp *interp, const char *varName,
				int flags);
/* 176 */
EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp,
				const char *part1, const char *part2,
EXTERN const char *	Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
				int flags);
/* 177 */
EXTERN int		Tcl_GlobalEval(Tcl_Interp *interp,
				const char *command);
/* 178 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN int		Tcl_GlobalEvalObj(Tcl_Interp *interp,
int			Tcl_GlobalEvalObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 179 */
EXTERN int		Tcl_HideCommand(Tcl_Interp *interp,
				const char *cmdName,
				const char *hiddenCmdToken);
/* 180 */
EXTERN int		Tcl_Init(Tcl_Interp *interp);
/* 181 */
EXTERN void		Tcl_InitHashTable(Tcl_HashTable *tablePtr,
				int keyType);
/* 182 */
EXTERN int		Tcl_InputBlocked(Tcl_Channel chan);
/* 183 */
EXTERN int		Tcl_InputBuffered(Tcl_Channel chan);
/* 184 */
EXTERN int		Tcl_InterpDeleted(Tcl_Interp *interp);
/* 185 */
EXTERN int		Tcl_IsSafe(Tcl_Interp *interp);
/* 186 */
EXTERN char *		Tcl_JoinPath(int argc, CONST84 char *const *argv,
EXTERN char *		Tcl_JoinPath(int argc, const char *const *argv,
				Tcl_DString *resultPtr);
/* 187 */
EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
				char *addr, int type);
/* Slot 188 is reserved */
/* 189 */
EXTERN Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
/* 190 */
EXTERN int		Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(ClientData tcpSocket);
/* 192 */
EXTERN char *		Tcl_Merge(int argc, CONST84 char *const *argv);
EXTERN char *		Tcl_Merge(int argc, const char *const *argv);
/* 193 */
EXTERN Tcl_HashEntry *	Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
/* 194 */
EXTERN void		Tcl_NotifyChannel(Tcl_Channel channel, int mask);
/* 195 */
EXTERN Tcl_Obj *	Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, int flags);
/* 196 */
EXTERN Tcl_Obj *	Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
				int flags);
/* 197 */
EXTERN Tcl_Channel	Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
				CONST84 char **argv, int flags);
				const char **argv, int flags);
/* 198 */
EXTERN Tcl_Channel	Tcl_OpenFileChannel(Tcl_Interp *interp,
				const char *fileName, const char *modeString,
				int permissions);
/* 199 */
EXTERN Tcl_Channel	Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
				const char *address, const char *myaddr,
623
624
625
626
627
628
629
630

631
632
633
634
635
636
637
637
638
639
640
641
642
643

644
645
646
647
648
649
650
651







-
+







EXTERN void		Tcl_Preserve(ClientData data);
/* 202 */
EXTERN void		Tcl_PrintDouble(Tcl_Interp *interp, double value,
				char *dst);
/* 203 */
EXTERN int		Tcl_PutEnv(const char *assignment);
/* 204 */
EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp);
EXTERN const char *	Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
EXTERN void		Tcl_QueueEvent(Tcl_Event *evPtr,
				Tcl_QueuePosition position);
/* 206 */
EXTERN int		Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);
/* 207 */
EXTERN void		Tcl_ReapDetachedProcs(void);
653
654
655
656
657
658
659
660

661
662
663
664
665
666
667
668
669
670
671

672

673
674
675
676
677
678
679
667
668
669
670
671
672
673

674

675
676
677
678
679
680
681
682
683
684
685

686
687
688
689
690
691
692
693







-
+
-










+
-
+







EXTERN int		Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
				const char *text, const char *start);
/* 214 */
EXTERN int		Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
				const char *pattern);
/* 215 */
EXTERN void		Tcl_RegExpRange(Tcl_RegExp regexp, int index,
				CONST84 char **startPtr,
				const char **startPtr, const char **endPtr);
				CONST84 char **endPtr);
/* 216 */
EXTERN void		Tcl_Release(ClientData clientData);
/* 217 */
EXTERN void		Tcl_ResetResult(Tcl_Interp *interp);
/* 218 */
EXTERN int		Tcl_ScanElement(const char *src, int *flagPtr);
/* 219 */
EXTERN int		Tcl_ScanCountedElement(const char *src, int length,
				int *flagPtr);
/* 220 */
TCL_DEPRECATED("")
EXTERN int		Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
int			Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
/* 221 */
EXTERN int		Tcl_ServiceAll(void);
/* 222 */
EXTERN int		Tcl_ServiceEvent(int flags);
/* 223 */
EXTERN void		Tcl_SetAssocData(Tcl_Interp *interp,
				const char *name, Tcl_InterpDeleteProc *proc,
709
710
711
712
713
714
715

716
717


718
719
720
721
722



723
724

725
726

727
728
729
730
731
732

733
734
735

736
737
738
739
740
741
742
743

744

745

746

747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766

767

768
769
770
771
772

773

774
775
776
777
778
779
780
781
782
783
784
785

786

787
788
789
790
791
792
793
794
795

796

797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814

815

816
817

818

819
820
821
822
823
824


825

826
827


828
829
830

831
832
833

834

835
836

837
838


839
840

841

842
843

844

845
846
847

848

849
850
851
852
853
854
855
723
724
725
726
727
728
729
730


731
732

733



734
735
736
737

738
739

740
741
742
743
744
745

746
747
748

749
750
751
752
753
754
755
756
757
758

759
760
761

762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783

784
785
786
787
788
789
790

791
792
793
794
795
796
797
798
799
800
801
802
803
804

805
806
807
808
809
810
811
812
813
814
815

816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835

836
837
838
839

840
841
842
843
844


845
846
847
848


849
850

851

852
853
854
855
856

857
858
859
860


861
862

863
864

865
866
867
868

869
870
871
872
873

874
875
876
877
878
879
880
881







+
-
-
+
+
-

-
-
-
+
+
+

-
+

-
+





-
+


-
+








+
-
+

+
-
+




















+
-
+





+
-
+












+
-
+









+
-
+


















+
-
+


+
-
+




-
-
+
+

+
-
-
+
+
-

-
+



+
-
+


+
-
-
+
+
-

+
-
+


+
-
+



+
-
+







				Tcl_Obj *errorObjPtr);
/* 235 */
EXTERN void		Tcl_SetObjResult(Tcl_Interp *interp,
				Tcl_Obj *resultObjPtr);
/* 236 */
EXTERN void		Tcl_SetStdChannel(Tcl_Channel channel, int type);
/* 237 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp,
				const char *varName, const char *newValue,
const char *		Tcl_SetVar(Tcl_Interp *interp, const char *varName,
				const char *newValue, int flags);
				int flags);
/* 238 */
EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				const char *newValue, int flags);
EXTERN const char *	Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, const char *newValue,
				int flags);
/* 239 */
EXTERN CONST84_RETURN char * Tcl_SignalId(int sig);
EXTERN const char *	Tcl_SignalId(int sig);
/* 240 */
EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig);
EXTERN const char *	Tcl_SignalMsg(int sig);
/* 241 */
EXTERN void		Tcl_SourceRCFile(Tcl_Interp *interp);
/* 242 */
EXTERN int		Tcl_SplitList(Tcl_Interp *interp,
				const char *listStr, int *argcPtr,
				CONST84 char ***argvPtr);
				const char ***argvPtr);
/* 243 */
EXTERN void		Tcl_SplitPath(const char *path, int *argcPtr,
				CONST84 char ***argvPtr);
				const char ***argvPtr);
/* 244 */
EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
				const char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
/* 245 */
EXTERN int		Tcl_StringMatch(const char *str, const char *pattern);
/* 246 */
TCL_DEPRECATED("")
EXTERN int		Tcl_TellOld(Tcl_Channel chan);
int			Tcl_TellOld(Tcl_Channel chan);
/* 247 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN int		Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
int			Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
				int flags, Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 248 */
EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 249 */
EXTERN char *		Tcl_TranslateFileName(Tcl_Interp *interp,
				const char *name, Tcl_DString *bufferPtr);
/* 250 */
EXTERN int		Tcl_Ungets(Tcl_Channel chan, const char *str,
				int len, int atHead);
/* 251 */
EXTERN void		Tcl_UnlinkVar(Tcl_Interp *interp,
				const char *varName);
/* 252 */
EXTERN int		Tcl_UnregisterChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 253 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN int		Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
int			Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
				int flags);
/* 254 */
EXTERN int		Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* 255 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN void		Tcl_UntraceVar(Tcl_Interp *interp,
void			Tcl_UntraceVar(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 256 */
EXTERN void		Tcl_UntraceVar2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 257 */
EXTERN void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
				const char *varName);
/* 258 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN int		Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
int			Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
				const char *varName, const char *localName,
				int flags);
/* 259 */
EXTERN int		Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
				const char *part1, const char *part2,
				const char *localName, int flags);
/* 260 */
EXTERN int		Tcl_VarEval(Tcl_Interp *interp, ...);
/* 261 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN ClientData	Tcl_VarTraceInfo(Tcl_Interp *interp,
ClientData		Tcl_VarTraceInfo(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_VarTraceProc *procPtr,
				ClientData prevClientData);
/* 262 */
EXTERN ClientData	Tcl_VarTraceInfo2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *procPtr,
				ClientData prevClientData);
/* 263 */
EXTERN int		Tcl_Write(Tcl_Channel chan, const char *s, int slen);
/* 264 */
EXTERN void		Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], const char *message);
/* 265 */
EXTERN int		Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
EXTERN void		Tcl_ValidateAllMemory(const char *file, int line);
/* 267 */
TCL_DEPRECATED("see TIP #422")
EXTERN void		Tcl_AppendResultVA(Tcl_Interp *interp,
void			Tcl_AppendResultVA(Tcl_Interp *interp,
				va_list argList);
/* 268 */
TCL_DEPRECATED("see TIP #422")
EXTERN void		Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
void			Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
				va_list argList);
/* 269 */
EXTERN char *		Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
				const char *start, CONST84 char **termPtr);
EXTERN const char *	Tcl_ParseVar(Tcl_Interp *interp, const char *start,
				const char **termPtr);
/* 271 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp,
				const char *name, const char *version,
const char *		Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
				const char *version, int exact);
				int exact);
/* 272 */
EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
EXTERN const char *	Tcl_PkgPresentEx(Tcl_Interp *interp,
				const char *name, const char *version,
				int exact, void *clientDataPtr);
/* 273 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN int		Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
int			Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
				const char *version);
/* 274 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
				const char *name, const char *version,
const char *		Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
				const char *version, int exact);
				int exact);
/* 275 */
TCL_DEPRECATED("see TIP #422")
EXTERN void		Tcl_SetErrorCodeVA(Tcl_Interp *interp,
void			Tcl_SetErrorCodeVA(Tcl_Interp *interp,
				va_list argList);
/* 276 */
TCL_DEPRECATED("see TIP #422")
EXTERN int		Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
int			Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
/* 277 */
EXTERN Tcl_Pid		Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
TCL_DEPRECATED("see TIP #422")
EXTERN TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
TCL_NORETURN void	Tcl_PanicVA(const char *format, va_list argList);
/* 279 */
EXTERN void		Tcl_GetVersion(int *major, int *minor,
				int *patchLevel, int *type);
/* 280 */
EXTERN void		Tcl_InitMemory(Tcl_Interp *interp);
/* 281 */
EXTERN Tcl_Channel	Tcl_StackChannel(Tcl_Interp *interp,
906
907
908
909
910
911
912
913

914
915
916
917
918
919
920
932
933
934
935
936
937
938

939
940
941
942
943
944
945
946







-
+







/* 299 */
EXTERN void		Tcl_FreeEncoding(Tcl_Encoding encoding);
/* 300 */
EXTERN Tcl_ThreadId	Tcl_GetCurrentThread(void);
/* 301 */
EXTERN Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
/* 302 */
EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding);
EXTERN const char *	Tcl_GetEncodingName(Tcl_Encoding encoding);
/* 303 */
EXTERN void		Tcl_GetEncodingNames(Tcl_Interp *interp);
/* 304 */
EXTERN int		Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const void *tablePtr,
				int offset, const char *msg, int flags,
				int *indexPtr);
955
956
957
958
959
960
961
962

963
964

965
966

967
968

969
970
971
972

973
974
975
976
977
978
979

980
981

982
983

984
985

986
987
988
989
990
991
992
981
982
983
984
985
986
987

988
989

990
991

992
993

994
995
996
997

998
999
1000
1001
1002
1003
1004

1005
1006

1007
1008

1009
1010

1011
1012
1013
1014
1015
1016
1017
1018







-
+

-
+

-
+

-
+



-
+






-
+

-
+

-
+

-
+







				int flags);
/* 318 */
EXTERN void		Tcl_ThreadAlert(Tcl_ThreadId threadId);
/* 319 */
EXTERN void		Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
				Tcl_Event *evPtr, Tcl_QueuePosition position);
/* 320 */
EXTERN Tcl_UniChar	Tcl_UniCharAtIndex(const char *src, int index);
EXTERN int		Tcl_UniCharAtIndex(const char *src, int index);
/* 321 */
EXTERN Tcl_UniChar	Tcl_UniCharToLower(int ch);
EXTERN int		Tcl_UniCharToLower(int ch);
/* 322 */
EXTERN Tcl_UniChar	Tcl_UniCharToTitle(int ch);
EXTERN int		Tcl_UniCharToTitle(int ch);
/* 323 */
EXTERN Tcl_UniChar	Tcl_UniCharToUpper(int ch);
EXTERN int		Tcl_UniCharToUpper(int ch);
/* 324 */
EXTERN int		Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index);
EXTERN const char *	Tcl_UtfAtIndex(const char *src, int index);
/* 326 */
EXTERN int		Tcl_UtfCharComplete(const char *src, int length);
/* 327 */
EXTERN int		Tcl_UtfBackslash(const char *src, int *readPtr,
				char *dst);
/* 328 */
EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch);
EXTERN const char *	Tcl_UtfFindFirst(const char *src, int ch);
/* 329 */
EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch);
EXTERN const char *	Tcl_UtfFindLast(const char *src, int ch);
/* 330 */
EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src);
EXTERN const char *	Tcl_UtfNext(const char *src);
/* 331 */
EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start);
EXTERN const char *	Tcl_UtfPrev(const char *src, const char *start);
/* 332 */
EXTERN int		Tcl_UtfToExternal(Tcl_Interp *interp,
				Tcl_Encoding encoding, const char *src,
				int srcLen, int flags,
				Tcl_EncodingState *statePtr, char *dst,
				int dstLen, int *srcReadPtr,
				int *dstWrotePtr, int *dstCharsPtr);
1006
1007
1008
1009
1010
1011
1012

1013

1014

1015

1016
1017
1018
1019
1020
1021
1022
1032
1033
1034
1035
1036
1037
1038
1039

1040
1041
1042

1043
1044
1045
1046
1047
1048
1049
1050







+
-
+

+
-
+







EXTERN int		Tcl_WriteChars(Tcl_Channel chan, const char *src,
				int srcLen);
/* 339 */
EXTERN int		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);
/* 341 */
TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath")
EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
const char *		Tcl_GetDefaultEncodingDir(void);
/* 342 */
TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath")
EXTERN void		Tcl_SetDefaultEncodingDir(const char *path);
void			Tcl_SetDefaultEncodingDir(const char *path);
/* 343 */
EXTERN void		Tcl_AlertNotifier(ClientData clientData);
/* 344 */
EXTERN void		Tcl_ServiceModeHook(int mode);
/* 345 */
EXTERN int		Tcl_UniCharIsAlnum(int ch);
/* 346 */
1043
1044
1045
1046
1047
1048
1049

1050

1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062

1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074

1075
1076
1077
1078
1079
1080
1081
1071
1072
1073
1074
1075
1076
1077
1078

1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090

1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102

1103
1104
1105
1106
1107
1108
1109
1110







+
-
+











-
+











-
+







/* 355 */
EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString(const char *src, int length,
				Tcl_DString *dsPtr);
/* 356 */
EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
				Tcl_Obj *patObj, int flags);
/* 357 */
TCL_DEPRECATED("Use Tcl_EvalTokensStandard")
EXTERN Tcl_Obj *	Tcl_EvalTokens(Tcl_Interp *interp,
Tcl_Obj *		Tcl_EvalTokens(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, int count);
/* 358 */
EXTERN void		Tcl_FreeParse(Tcl_Parse *parsePtr);
/* 359 */
EXTERN void		Tcl_LogCommandInfo(Tcl_Interp *interp,
				const char *script, const char *command,
				int length);
/* 360 */
EXTERN int		Tcl_ParseBraces(Tcl_Interp *interp,
				const char *start, int numBytes,
				Tcl_Parse *parsePtr, int append,
				CONST84 char **termPtr);
				const char **termPtr);
/* 361 */
EXTERN int		Tcl_ParseCommand(Tcl_Interp *interp,
				const char *start, int numBytes, int nested,
				Tcl_Parse *parsePtr);
/* 362 */
EXTERN int		Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
				int numBytes, Tcl_Parse *parsePtr);
/* 363 */
EXTERN int		Tcl_ParseQuotedString(Tcl_Interp *interp,
				const char *start, int numBytes,
				Tcl_Parse *parsePtr, int append,
				CONST84 char **termPtr);
				const char **termPtr);
/* 364 */
EXTERN int		Tcl_ParseVarName(Tcl_Interp *interp,
				const char *start, int numBytes,
				Tcl_Parse *parsePtr, int append);
/* 365 */
EXTERN char *		Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 366 */
1113
1114
1115
1116
1117
1118
1119
1120

1121

1122

1123
1124
1125
1126
1127
1128
1129
1142
1143
1144
1145
1146
1147
1148

1149
1150
1151

1152
1153
1154
1155
1156
1157
1158
1159







-
+

+
-
+







				int numChars);
/* 379 */
EXTERN void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, int numChars);
/* 380 */
EXTERN int		Tcl_GetCharLength(Tcl_Obj *objPtr);
/* 381 */
EXTERN Tcl_UniChar	Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
EXTERN int		Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
/* 382 */
TCL_DEPRECATED("No longer in use, changed to macro")
EXTERN Tcl_UniChar *	Tcl_GetUnicode(Tcl_Obj *objPtr);
Tcl_UniChar *		Tcl_GetUnicode(Tcl_Obj *objPtr);
/* 383 */
EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
/* 384 */
EXTERN void		Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, int length);
/* 385 */
EXTERN int		Tcl_RegExpMatchObj(Tcl_Interp *interp,
1157
1158
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168
1169
1170
1171
1172
1187
1188
1189
1190
1191
1192
1193


1194
1195
1196
1197
1198
1199
1200
1201







-
-
+







EXTERN int		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
				int srcLen);
/* 396 */
EXTERN Tcl_Channel	Tcl_GetTopChannel(Tcl_Channel chan);
/* 397 */
EXTERN int		Tcl_ChannelBuffered(Tcl_Channel chan);
/* 398 */
EXTERN CONST84_RETURN char * Tcl_ChannelName(
				const Tcl_ChannelType *chanTypePtr);
EXTERN const char *	Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
/* 399 */
EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
				const Tcl_ChannelType *chanTypePtr);
/* 400 */
EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
				const Tcl_ChannelType *chanTypePtr);
/* 401 */
1264
1265
1266
1267
1268
1269
1270

1271

1272
1273
1274
1275
1276

1277

1278
1279
1280
1281
1282
1283
1284
1293
1294
1295
1296
1297
1298
1299
1300

1301
1302
1303
1304
1305
1306
1307

1308
1309
1310
1311
1312
1313
1314
1315







+
-
+





+
-
+







EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
/* 433 */
EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* 435 */
TCL_DEPRECATED("")
EXTERN int		Tcl_GetMathFuncInfo(Tcl_Interp *interp,
int			Tcl_GetMathFuncInfo(Tcl_Interp *interp,
				const char *name, int *numArgsPtr,
				Tcl_ValueType **argTypesPtr,
				Tcl_MathProc **procPtr,
				ClientData *clientDataPtr);
/* 436 */
TCL_DEPRECATED("")
EXTERN Tcl_Obj *	Tcl_ListMathFuncs(Tcl_Interp *interp,
Tcl_Obj *		Tcl_ListMathFuncs(Tcl_Interp *interp,
				const char *pattern);
/* 437 */
EXTERN Tcl_Obj *	Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 438 */
EXTERN int		Tcl_DetachChannel(Tcl_Interp *interp,
				Tcl_Channel channel);
1827
1828
1829
1830
1831
1832
1833













1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846

1847
1848
1849
1850
1851
1852
1853
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889

1890
1891
1892
1893
1894
1895
1896
1897







+
+
+
+
+
+
+
+
+
+
+
+
+












-
+







				Tcl_Obj *compressionDictionaryObj);
/* 631 */
EXTERN Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
				const char *service, const char *host,
				unsigned int flags,
				Tcl_TcpAcceptProc *acceptProc,
				ClientData callbackData);
/* 632 */
EXTERN int		TclZipfs_Mount(Tcl_Interp *interp,
				const char *mountPoint, const char *zipname,
				const char *passwd);
/* 633 */
EXTERN int		TclZipfs_Unmount(Tcl_Interp *interp,
				const char *mountPoint);
/* 634 */
EXTERN Tcl_Obj *	TclZipfs_TclLibrary(void);
/* 635 */
EXTERN int		TclZipfs_MountBuffer(Tcl_Interp *interp,
				const char *mountPoint, unsigned char *data,
				size_t datalen, int copy);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

typedef struct TclStubs {
    int magic;
    const TclStubHooks *hooks;

    int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
    CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
    const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
    TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
    char * (*tcl_Alloc) (unsigned int size); /* 3 */
    void (*tcl_Free) (char *ptr); /* 4 */
    char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */
    char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */
    void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */
    char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */
1876
1877
1878
1879
1880
1881
1882
1883

1884
1885
1886
1887

1888
1889
1890
1891
1892
1893
1894
1895
1896
1897

1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910

1911
1912
1913

1914
1915

1916
1917
1918

1919
1920
1921
1922

1923
1924

1925
1926
1927
1928


1929
1930
1931
1932
1933
1934
1935
1936
1937
1938

1939
1940
1941
1942
1943
1944

1945
1946
1947

1948
1949
1950
1951
1952
1953
1954
1955
1956

1957
1958
1959
1960
1961
1962
1963
1920
1921
1922
1923
1924
1925
1926

1927
1928
1929
1930

1931
1932
1933
1934
1935
1936
1937
1938
1939
1940

1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953

1954
1955
1956

1957
1958

1959
1960
1961

1962
1963
1964
1965

1966
1967

1968
1969
1970


1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981

1982
1983
1984
1985
1986
1987

1988
1989
1990

1991
1992
1993
1994
1995
1996
1997
1998
1999

2000
2001
2002
2003
2004
2005
2006
2007







-
+



-
+









-
+












-
+


-
+

-
+


-
+



-
+

-
+


-
-
+
+









-
+





-
+


-
+








-
+







    void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */
    void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 16 */
    Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */
    int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */
    void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
    void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
    int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
    Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
    Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
    Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
    Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
    Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
    Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
    Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */
    Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
    void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
    int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */
    int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
    int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
    int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
    int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
    int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
    int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
    int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
    CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
    char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
    void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
    int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
    int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
    int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
    int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
    int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
    Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
    Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
    Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
    Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
    Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
    Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
    Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
    Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
    void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
    unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
    void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
    void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
    void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
    void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
    void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
    void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
    void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
    void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
    void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
    void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
    void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
    void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
    Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */
    void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */
    int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */
    void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
    int (*tcl_AsyncReady) (void); /* 75 */
    void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
    char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
    TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
    int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
    void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
    void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
    int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
    int (*tcl_CommandComplete) (const char *cmd); /* 82 */
    char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
    char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */
    int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
    int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
    int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
    int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */
    int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
    Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
    void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
    void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
    Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */
    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
    Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
    void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
    TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
    Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */
    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */
1981
1982
1983
1984
1985
1986
1987
1988
1989


1990
1991
1992

1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010


2011
2012
2013
2014
2015
2016
2017

2018
2019
2020
2021

2022
2023

2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045



2046
2047

2048
2049
2050
2051
2052
2053
2054
2055

2056
2057
2058
2059
2060
2061

2062
2063
2064
2065
2066

2067
2068
2069
2070
2071
2072
2073

2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084

2085
2086
2087
2088
2089

2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109




2110
2111
2112


2113
2114
2115
2116


2117
2118
2119
2120
2121
2122

2123
2124

2125
2126
2127

2128
2129
2130

2131
2132
2133
2134
2135
2136
2137


2138
2139
2140
2141
2142
2143
2144
2145







2146
2147

2148
2149
2150
2151
2152
2153
2154
2025
2026
2027
2028
2029
2030
2031


2032
2033
2034
2035

2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052


2053
2054
2055
2056
2057
2058
2059
2060

2061
2062
2063
2064

2065
2066

2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086



2087
2088
2089
2090

2091
2092
2093
2094
2095
2096
2097
2098

2099
2100
2101
2102
2103
2104

2105
2106
2107
2108
2109

2110
2111
2112
2113
2114
2115
2116

2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127

2128
2129
2130
2131
2132

2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149




2150
2151
2152
2153
2154


2155
2156
2157
2158


2159
2160
2161
2162
2163
2164
2165

2166
2167

2168
2169
2170

2171
2172
2173

2174
2175
2176
2177
2178
2179


2180
2181
2182







2183
2184
2185
2186
2187
2188
2189
2190

2191
2192
2193
2194
2195
2196
2197
2198







-
-
+
+


-
+
















-
-
+
+






-
+



-
+

-
+



















-
-
-
+
+
+

-
+







-
+





-
+




-
+






-
+










-
+




-
+
















-
-
-
-
+
+
+
+

-
-
+
+


-
-
+
+





-
+

-
+


-
+


-
+





-
-
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+







    void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */
    void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */
    void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */
    void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */
    void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
    void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
    int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
    CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */
    CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */
    const char * (*tcl_ErrnoId) (void); /* 127 */
    const char * (*tcl_ErrnoMsg) (int err); /* 128 */
    int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
    int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
    int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
    void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
    TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
    int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
    int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
    int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
    int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */
    int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
    int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr); /* 139 */
    int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */
    int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
    int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
    void (*tcl_Finalize) (void); /* 143 */
    void (*tcl_FindExecutable) (const char *argv0); /* 144 */
    Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
    int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
    void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
    int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
    int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
    int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
    int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
    ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
    Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
    int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
    int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
    ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
    int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
    CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
    const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
    int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
    CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
    int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
    CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
    const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
    int (*tcl_GetErrno) (void); /* 161 */
    CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
    const char * (*tcl_GetHostName) (void); /* 162 */
    int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
    Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
    const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
    Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* MACOSX */
    Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */
    int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
    int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
    int (*tcl_GetServiceMode) (void); /* 171 */
    Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
    Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
    CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
    CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
    CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
    const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
    const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
    int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */
    int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
    int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
    int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
    void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
    int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */
    int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
    int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
    int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
    char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */
    char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
    int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
    void (*reserved188)(void);
    Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
    int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
    Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
    char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */
    char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
    Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
    void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
    Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
    Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
    Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */
    Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */
    Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
    Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
    Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
    void (*tcl_Preserve) (ClientData data); /* 201 */
    void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
    int (*tcl_PutEnv) (const char *assignment); /* 203 */
    CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
    const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
    void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
    int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
    void (*tcl_ReapDetachedProcs) (void); /* 207 */
    int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */
    int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */
    void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */
    void (*tcl_RegisterObjType) (const Tcl_ObjType *typePtr); /* 211 */
    Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */
    int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */
    int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */
    void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */
    void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */
    void (*tcl_Release) (ClientData clientData); /* 216 */
    void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
    int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
    int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
    int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
    TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
    int (*tcl_ServiceAll) (void); /* 221 */
    int (*tcl_ServiceEvent) (int flags); /* 222 */
    void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
    void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */
    int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */
    int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */
    void (*tcl_SetErrno) (int err); /* 227 */
    void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
    void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
    void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */
    int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
    void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */
    int (*tcl_SetServiceMode) (int mode); /* 233 */
    void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
    void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
    void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
    CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
    CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
    CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */
    CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
    const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
    const char * (*tcl_SignalId) (int sig); /* 239 */
    const char * (*tcl_SignalMsg) (int sig); /* 240 */
    void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
    int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */
    void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */
    int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
    void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
    void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
    int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
    int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
    int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
    TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
    int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
    int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
    void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
    int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
    int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */
    int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
    void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
    void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
    void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
    int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
    int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
    int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */
    ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
    ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
    int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
    void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
    int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
    void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
    void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
    void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
    TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
    TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
    char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
    CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
    CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
    CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
    int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
    CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
    void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
    int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
    const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
    const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
    TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
    TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
    Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
    TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
    TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
    void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
    void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
    Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
    int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */
    Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */
    void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */
    void (*reserved285)(void);
2164
2165
2166
2167
2168
2169
2170
2171

2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192




2193
2194

2195
2196
2197
2198
2199
2200




2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211


2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226

2227
2228
2229

2230
2231
2232

2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251


2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267

2268
2269
2270
2271
2272
2273
2274
2208
2209
2210
2211
2212
2213
2214

2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232




2233
2234
2235
2236
2237

2238
2239
2240




2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253


2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269

2270
2271
2272

2273
2274
2275

2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293


2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310

2311
2312
2313
2314
2315
2316
2317
2318







-
+

















-
-
-
-
+
+
+
+

-
+


-
-
-
-
+
+
+
+









-
-
+
+














-
+


-
+


-
+

















-
-
+
+















-
+







    int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */
    char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */
    void (*tcl_FinalizeThread) (void); /* 297 */
    void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */
    void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
    Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
    Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
    CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
    const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
    void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
    int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */
    void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
    Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */
    ClientData (*tcl_InitNotifier) (void); /* 307 */
    void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */
    void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */
    void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */
    void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */
    int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */
    int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */
    void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */
    void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */
    int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */
    Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
    void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
    void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */
    Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
    Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */
    Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */
    Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */
    int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
    int (*tcl_UniCharToLower) (int ch); /* 321 */
    int (*tcl_UniCharToTitle) (int ch); /* 322 */
    int (*tcl_UniCharToUpper) (int ch); /* 323 */
    int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
    CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
    const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
    int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */
    int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
    CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
    CONST84_RETURN char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
    CONST84_RETURN char * (*tcl_UtfNext) (const char *src); /* 330 */
    CONST84_RETURN char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
    const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
    const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
    const char * (*tcl_UtfNext) (const char *src); /* 330 */
    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
    int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
    char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
    int (*tcl_UtfToLower) (char *src); /* 334 */
    int (*tcl_UtfToTitle) (char *src); /* 335 */
    int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr); /* 336 */
    int (*tcl_UtfToUpper) (char *src); /* 337 */
    int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
    int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
    char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
    CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
    void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
    TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
    TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
    void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
    void (*tcl_ServiceModeHook) (int mode); /* 344 */
    int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
    int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
    int (*tcl_UniCharIsDigit) (int ch); /* 347 */
    int (*tcl_UniCharIsLower) (int ch); /* 348 */
    int (*tcl_UniCharIsSpace) (int ch); /* 349 */
    int (*tcl_UniCharIsUpper) (int ch); /* 350 */
    int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
    int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */
    int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */
    char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
    Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
    Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
    TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
    void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
    void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
    int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */
    int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
    int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
    int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
    int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */
    int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */
    int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
    char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
    int (*tcl_Chdir) (const char *dirName); /* 366 */
    int (*tcl_Access) (const char *path, int mode); /* 367 */
    int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */
    int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */
    int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */
    int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */
    int (*tcl_UniCharIsControl) (int ch); /* 372 */
    int (*tcl_UniCharIsGraph) (int ch); /* 373 */
    int (*tcl_UniCharIsPrint) (int ch); /* 374 */
    int (*tcl_UniCharIsPunct) (int ch); /* 375 */
    int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */
    void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */
    Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */
    void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */
    int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
    Tcl_UniChar (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
    Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
    int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
    void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
    int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
    void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */
    Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
    int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
    int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */
    void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
    void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
    int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */
    int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */
    int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */
    Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
    int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
    CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
    const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
    Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
    Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */
    Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr); /* 403 */
    Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr); /* 404 */
    Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 405 */
2297
2298
2299
2300
2301
2302
2303
2304
2305


2306
2307
2308
2309
2310
2311
2312
2341
2342
2343
2344
2345
2346
2347


2348
2349
2350
2351
2352
2353
2354
2355
2356







-
-
+
+







    char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */
    char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */
    char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */
    char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */
    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
    int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
    Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
    TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
    TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
    Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
    int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
    int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
    int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
    int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
    int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
    int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */
2494
2495
2496
2497
2498
2499
2500




2501
2502
2503
2504
2505
2506
2507
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555







+
+
+
+







    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
    void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
    Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
    int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
    int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
    Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
    int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
3788
3789
3790
3791
3792
3793
3794








3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823

3824
3825
3826
3827
3828
3829
3830
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861

3862
3863
3864
3865
3866
3867


3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884







+
+
+
+
+
+
+
+











-






-
-









+







	(tclStubsPtr->tcl_FindSymbol) /* 628 */
#define Tcl_FSUnloadFile \
	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
#define Tcl_OpenTcpServerEx \
	(tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */
#define TclZipfs_Mount \
	(tclStubsPtr->tclZipfs_Mount) /* 632 */
#define TclZipfs_Unmount \
	(tclStubsPtr->tclZipfs_Unmount) /* 633 */
#define TclZipfs_TclLibrary \
	(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
#define TclZipfs_MountBuffer \
	(tclStubsPtr->tclZipfs_MountBuffer) /* 635 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp
#   undef Tcl_FindExecutable
#   undef Tcl_GetStringResult
#   undef Tcl_Init
#   undef Tcl_SetPanicProc
#   undef Tcl_SetVar
#   undef Tcl_ObjSetVar2
#   undef Tcl_StaticPackage
#   define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
#   define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
#   define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
#   define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc))
#   define Tcl_SetVar(interp, varName, newValue, flags) \
	    (tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags))
#   define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
	    (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
#endif

#if defined(_WIN32) && defined(UNICODE)
#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#   define Tcl_MainEx Tcl_MainExW
    EXTERN void Tcl_MainExW(int argc, wchar_t **argv,
	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
    EXTERN int		TclZipfs_AppHook(int *argc, wchar_t ***argv);
#endif

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#undef Tcl_SeekOld
#undef Tcl_TellOld
3884
3885
3886
3887
3888
3889
3890
3891
3892


3893
3894
3895
3896
3897
3898
3899
3900


3901
3902
3903
3904

3905
3906
3907
3908
3909
3910
3911
3938
3939
3940
3941
3942
3943
3944


3945
3946
3947
3948
3949
3950
3951
3952


3953
3954
3955
3956
3957

3958
3959
3960
3961
3962
3963
3964
3965







-
-
+
+






-
-
+
+



-
+







	Tcl_EvalEx(interp, objPtr, -1, 0)
#undef Tcl_GlobalEval
#define Tcl_GlobalEval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL)
#undef Tcl_SaveResult
#define Tcl_SaveResult(interp, statePtr) \
	do { \
	    *(statePtr) = Tcl_GetObjResult(interp); \
	    Tcl_IncrRefCount(*(statePtr)); \
	    (statePtr)->objResultPtr = Tcl_GetObjResult(interp); \
	    Tcl_IncrRefCount((statePtr)->objResultPtr); \
	    Tcl_SetObjResult(interp, Tcl_NewObj()); \
	} while(0)
#undef Tcl_RestoreResult
#define Tcl_RestoreResult(interp, statePtr) \
	do { \
	    Tcl_ResetResult(interp); \
   	    Tcl_SetObjResult(interp, *(statePtr)); \
   	    Tcl_DecrRefCount(*(statePtr)); \
   	    Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \
   	    Tcl_DecrRefCount((statePtr)->objResultPtr); \
	} while(0)
#undef Tcl_DiscardResult
#define Tcl_DiscardResult(statePtr) \
	Tcl_DecrRefCount(*(statePtr))
	Tcl_DecrRefCount((statePtr)->objResultPtr)
#undef Tcl_SetResult
#define Tcl_SetResult(interp, result, freeProc) \
	do { \
	    char *__result = result; \
	    Tcl_FreeProc *__freeProc = freeProc; \
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
	    if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3977
3978
3979
3980
3981
3982
3983

3984


3985
3986
3987
3988
3989
3990

3991


3992
3993
3994
3995
3996
3997
3998







-

-
-






-

-
-







/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
 * we have to make sure that all stub entries on Cygwin64 follow the
 * Win64 signature. Cygwin64 stubbed extensions cannot use those stub
 * entries any more, they should use the 64-bit alternatives where
 * possible. Tcl 9 must find a better solution, but that cannot be done
 * without introducing a binary incompatibility.
 */
#	undef Tcl_DbNewLongObj
#	undef Tcl_GetLongFromObj
#	undef Tcl_NewLongObj
#	undef Tcl_SetLongObj
#	undef Tcl_ExprLong
#	undef Tcl_ExprLongObj
#	undef Tcl_UniCharNcmp
#	undef Tcl_UtfNcmp
#	undef Tcl_UtfNcasecmp
#	undef Tcl_UniCharNcasecmp
#	define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj)
#	define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
#	define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj)
#	define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj)
#	define Tcl_ExprLong TclExprLong
	static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){
	    int intValue;
	    int result = tclStubsPtr->tcl_ExprLong(interp, string, (long *)&intValue);
	    if (result == TCL_OK) *ptr = (long)intValue;
	    return result;
	}
3962
3963
3964
3965
3966
3967
3968













3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041







+
+
+
+
+
+
+
+
+
+
+
+
+












#	define Tcl_UtfNcasecmp(s1,s2,n) \
		((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n))
#	define Tcl_UniCharNcasecmp(ucs,uct,n) \
		((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n))
#   endif
#endif

#undef Tcl_NewLongObj
#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
#undef Tcl_NewIntObj
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
#undef Tcl_DbNewLongObj
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
#undef Tcl_SetIntObj
#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
#undef Tcl_SetLongObj
#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))
#undef Tcl_GetUnicode
#define Tcl_GetUnicode(objPtr)	Tcl_GetUnicodeFromObj((objPtr), NULL)

/*
 * Deprecated Tcl procedures:
 */

#undef Tcl_EvalObj
#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)

#endif /* _TCLDECLS */

Changes to generic/tclDictObj.c.

149
150
151
152
153
154
155
156

157
158
159
160
161
162
163
149
150
151
152
153
154
155

156
157
158
159
160
161
162
163







-
+







} Dict;

/*
 * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this
 * must be assignable as well as readable.
 */

#define DICT(dictObj)   (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1))
#define DICT(dictObj)   ((dictObj)->internalRep.twoPtrValue.ptr1)

/*
 * The structure below defines the dictionary object type by means of
 * functions that can be invoked by generic object code.
 */

const Tcl_ObjType tclDictType = {
483
484
485
486
487
488
489
490
491


492
493
494
495
496
497
498
499
500
501
502
503
504
505
483
484
485
486
487
488
489


490
491
492
493
494
495
496
497

498
499
500
501
502
503
504







-
-
+
+






-







 *----------------------------------------------------------------------
 */

static void
UpdateStringOfDict(
    Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 20
    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict = DICT(dictPtr);
    ChainEntry *cPtr;
    Tcl_Obj *keyPtr, *valuePtr;
    int i, length, bytesNeeded = 0;
    const char *elem;
    char *dst;
    const int maxFlags = UINT_MAX / sizeof(int);

    /*
     * This field is the most useful one in the whole hash structure, and it
     * is not exposed by any API function...
     */

    int numElems = dict->table.numEntries * 2;
513
514
515
516
517
518
519
520
521
522
523

524
525
526
527
528
529
530
512
513
514
515
516
517
518


519

520
521
522
523
524
525
526
527







-
-

-
+








    /*
     * Pass 1: estimate space, gather flags.
     */

    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else if (numElems > maxFlags) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    } else {
	flagPtr = ckalloc(numElems * sizeof(int));
	flagPtr = ckalloc(numElems);
    }
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	/*
	 * Assume that cPtr is never NULL since we know the number of array
	 * elements already.
	 */

2308
2309
2310
2311
2312
2313
2314
2315
2316
2317






2318
2319
2320
2321
2322
2323
2324
2305
2306
2307
2308
2309
2310
2311



2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324







-
-
-
+
+
+
+
+
+







	Tcl_Obj *appendObjPtr = NULL;

	if (objc > 3) {
	    /* Something to append */

	    if (objc == 4) {
		appendObjPtr = objv[3];
	    } else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
		    objc-3, objv+3, &appendObjPtr)) {
		return TCL_ERROR;
	    } else {
		appendObjPtr = TclStringCat(interp, objc-3, objv+3,
			TCL_STRING_IN_PLACE);
		if (appendObjPtr == NULL) {
		    return TCL_ERROR;
		}
	    }
	}

	if (appendObjPtr == NULL) {
	    /* => (objc == 3) => (valuePtr == NULL) */
	    TclNewObj(valuePtr);
	} else if (valuePtr == NULL) {

Changes to generic/tclDisassemble.c.

250
251
252
253
254
255
256
257

258
259
260
261
262
263
264
250
251
252
253
254
255
256

257
258
259
260
261
262
263
264







-
+







    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
    Interp *iPtr = (Interp *) *codePtr->interpHandle;
    Tcl_Obj *bufferObj, *fileObj;

    TclNewObj(bufferObj);
    if (codePtr->refCount <= 0) {
    if (!codePtr->refCount) {
	return bufferObj;	/* Already freed. */
    }

    codeStart = codePtr->codeStart;
    codeLimit = codeStart + codePtr->numCodeBytes;
    numCmds = codePtr->numCommands;

308
309
310
311
312
313
314
315

316
317
318
319
320
321
322
308
309
310
311
312
313
314

315
316
317
318
319
320
321
322







-
+







     */

    if (codePtr->procPtr != NULL) {
	Proc *procPtr = codePtr->procPtr;
	int numCompiledLocals = procPtr->numCompiledLocals;

	Tcl_AppendPrintfToObj(bufferObj,
		"  Proc %p, refCt %d, args %d, compiled locals %d\n",
		"  Proc %p, refCt %u, args %d, compiled locals %d\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		numCompiledLocals);
	if (numCompiledLocals > 0) {
	    CompiledLocal *localPtr = procPtr->firstLocalPtr;

	    for (i = 0;  i < numCompiledLocals;  i++) {
		Tcl_AppendPrintfToObj(bufferObj,
793
794
795
796
797
798
799
800

801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821


822
823
824
825


826
827
828

829
830

831
832
833
834
835
836
837
793
794
795
796
797
798
799

800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819


820
821

822


823
824
825
826

827
828
829
830
831
832
833
834
835
836
837







-
+



















-
-
+
+
-

-
-
+
+


-
+


+







Tcl_Obj *
TclNewInstNameObj(
    unsigned char inst)
{
    Tcl_Obj *objPtr = Tcl_NewObj();

    objPtr->typePtr = &tclInstNameType;
    objPtr->internalRep.longValue = (long) inst;
    objPtr->internalRep.wideValue = (long) inst;
    objPtr->bytes = NULL;

    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfInstName --
 *
 *	Update the string representation for an instruction name object.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfInstName(
    Tcl_Obj *objPtr)
{
    int inst = objPtr->internalRep.longValue;
    char *s, buf[20];
    size_t len, inst = (size_t)objPtr->internalRep.wideValue;
    char *s, buf[TCL_INTEGER_SPACE + 5];
    int len;

    if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
        sprintf(buf, "inst_%d", inst);
    if (inst > LAST_INST_OPCODE) {
        sprintf(buf, "inst_%" TCL_Z_MODIFIER "d", inst);
        s = buf;
    } else {
        s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
        s = (char *) tclInstructionTable[inst].name;
    }
    len = strlen(s);
    /* assert (len < UINT_MAX) */
    objPtr->bytes = ckalloc(len + 1);
    memcpy(objPtr->bytes, s, len + 1);
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------
890
891
892
893
894
895
896
897

898
899
900
901
902
903
904
890
891
892
893
894
895
896

897
898
899
900
901
902
903
904







-
+







	    continue;
	default:
#if TCL_UTF_MAX > 4
	    if (ch > 0xffff) {
		Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch);
		i += 10;
	    } else
#elif TCL_UTF_MAX > 3
#else
	    /* If len == 0, this means we have a char > 0xffff, resulting in
	     * TclUtfToUniChar producing a surrogate pair. We want to output
	     * this pair as a single Unicode character.
	     */
	    if (len == 0) {
		int upper = ((ch & 0x3ff) + 1) << 10;
		len = TclUtfToUniChar(p, &ch);
1606
1607
1608
1609
1610
1611
1612
1613

1614
1615
1616
1617
1618
1619
1620
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615
1616
1617
1618
1619
1620







-
+







    if (BYTECODE(codeObjPtr)->flags & TCL_BYTECODE_PRECOMPILED) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not disassemble prebuilt bytecode", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		"BYTECODE", NULL);
	return TCL_ERROR;
    }
    if (PTR2INT(clientData)) {
    if (clientData) {
	Tcl_SetObjResult(interp,
		DisassembleByteCodeAsDicts(interp, codeObjPtr));
    } else {
	Tcl_SetObjResult(interp,
		DisassembleByteCodeObj(interp, codeObjPtr));
    }
    return TCL_OK;

Changes to generic/tclEncoding.c.

14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28







-
+







typedef size_t (LengthProc)(const char *src);

/*
 * The following data structure represents an encoding, which describes how to
 * convert between various character sets and UTF-8.
 */

typedef struct Encoding {
typedef struct {
    char *name;			/* Name of encoding. Malloced because (1) hash
				 * table entry that owns this encoding may be
				 * freed prior to this encoding being freed,
				 * (2) string passed in the Tcl_EncodingType
				 * structure may not be persistent. */
    Tcl_EncodingConvertProc *toUtfProc;
				/* Function to convert from external encoding
53
54
55
56
57
58
59
60

61
62
63
64
65
66
67
53
54
55
56
57
58
59

60
61
62
63
64
65
66
67







-
+







/*
 * The following structure is the clientData for a dynamically-loaded,
 * table-driven encoding created by LoadTableEncoding(). It maps between
 * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only)
 * encoding.
 */

typedef struct TableEncodingData {
typedef struct {
    int fallback;		/* Character (in this encoding) to substitute
				 * when this encoding cannot represent a UTF-8
				 * character. */
    char prefixBytes[256];	/* If a byte in the input stream is a lead
				 * byte for a 2-byte sequence, the
				 * corresponding entry in this array is 1,
				 * otherwise it is 0. */
87
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102
103

104
105
106
107
108
109
110
87
88
89
90
91
92
93

94
95
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110







-
+








-
+







 * escape-driven encoding that is itself comprised of other simpler encodings.
 * An example is "iso-2022-jp", which uses escape sequences to switch between
 * ascii, jis0208, jis0212, gb2312, and ksc5601. Note that "escape-driven"
 * does not necessarily mean that the ESCAPE character is the character used
 * for switching character sets.
 */

typedef struct EscapeSubTable {
typedef struct {
    unsigned sequenceLen;	/* Length of following string. */
    char sequence[16];		/* Escape code that marks this encoding. */
    char name[32];		/* Name for encoding. */
    Encoding *encodingPtr;	/* Encoding loaded using above name, or NULL
				 * if this sub-encoding has not been needed
				 * yet. */
} EscapeSubTable;

typedef struct EscapeEncodingData {
typedef struct {
    int fallback;		/* Character (in this encoding) to substitute
				 * when this encoding cannot represent a UTF-8
				 * character. */
    unsigned initLen;		/* Length of following string. */
    char init[16];		/* String to emit or expect before first char
				 * in conversion. */
    unsigned finalLen;		/* Length of following string. */
689
690
691
692
693
694
695

696
697
698
699
700
701
702
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703







+







 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
const char *
Tcl_GetDefaultEncodingDir(void)
{
    int numDirs;
    Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();

    Tcl_ListObjLength(NULL, searchPath, &numDirs);
732
733
734
735
736
737
738

739
740
741
742
743
744
745
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747







+







    Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath();
    Tcl_Obj *directory = Tcl_NewStringObj(path, -1);

    searchPath = Tcl_DuplicateObj(searchPath);
    Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory);
    Tcl_SetEncodingSearchPath(searchPath);
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncoding --
 *
 *	Given the name of a encoding, find the corresponding Tcl_Encoding
2052
2053
2054
2055
2056
2057
2058
2059

2060
2061
2062
2063
2064
2065
2066
2054
2055
2056
2057
2058
2059
2060

2061
2062
2063
2064
2065
2066
2067
2068







-
+







    dataPtr->initLen = strlen(init);
    memcpy(dataPtr->init, init, (unsigned) dataPtr->initLen + 1);
    dataPtr->finalLen = strlen(final);
    memcpy(dataPtr->final, final, (unsigned) dataPtr->finalLen + 1);
    dataPtr->numSubTables =
	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
	    (size_t) Tcl_DStringLength(&escapeData));
	    Tcl_DStringLength(&escapeData));
    Tcl_DStringFree(&escapeData);

    memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
    for (i = 0; i < dataPtr->numSubTables; i++) {
	dataPtr->prefixBytes[UCHAR(dataPtr->subTables[i].sequence[0])] = 1;
    }
    if (dataPtr->init[0] != '\0') {
2353
2354
2355
2356
2357
2358
2359





2360
2361




2362
2363
2364
2365
2366
2367
2368
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366


2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377







+
+
+
+
+
-
-
+
+
+
+







	     * incomplete char its bytes are made to represent themselves.
	     */

	    *chPtr = (unsigned char) *src;
	    src += 1;
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
	} else {
	    int len = TclUtfToUniChar(src, chPtr);
	    src += len;
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
#if TCL_UTF_MAX <= 4
	    if (!len) {
	    src += TclUtfToUniChar(src, chPtr);
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
		src += TclUtfToUniChar(src, chPtr);
		dst += Tcl_UniCharToUtf(*chPtr, dst);
	    }
#endif
	}
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
2760
2761
2762
2763
2764
2765
2766
2767

2768
2769
2770
2771
2772
2773
2774
2775




2776
2777
2778
2779
2780
2781
2782
2769
2770
2771
2772
2773
2774
2775

2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795







-
+








+
+
+
+







	     */

	    result = TCL_CONVERT_MULTIBYTE;
	    break;
	}
	len = TclUtfToUniChar(src, &ch);

#if TCL_UTF_MAX > 3
#if TCL_UTF_MAX > 4
	/*
	 * This prevents a crash condition. More evaluation is required for
	 * full support of int Tcl_UniChar. [Bug 1004065]
	 */

	if (ch & 0xffff0000) {
	    word = 0;
	} else
#else
	if (!len) {
	    word = 0;
	} else
#endif
	    word = fromUnicode[(ch >> 8)][ch & 0xff];

	if ((word == 0) && (ch != 0)) {
	    if (flags & TCL_ENCODING_STOPONERROR) {
		result = TCL_CONVERT_UNKNOWN;
		break;
2966
2967
2968
2969
2970
2971
2972
2973





2974
2975
2976
2977
2978



2979
2980
2981
2982
2983
2984
2985
2979
2980
2981
2982
2983
2984
2985

2986
2987
2988
2989
2990
2991
2992
2993
2994

2995
2996
2997
2998
2999
3000
3001
3002
3003
3004







-
+
+
+
+
+




-
+
+
+







	}
	len = TclUtfToUniChar(src, &ch);

	/*
	 * Check for illegal characters.
	 */

	if (ch > 0xff) {
	if (ch > 0xff
#if TCL_UTF_MAX <= 4
		|| !len
#endif
		) {
	    if (flags & TCL_ENCODING_STOPONERROR) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }

#if TCL_UTF_MAX <= 4
	    if (!len) len = 4;
#endif
	    /*
	     * Plunge on, using '?' as a fallback character.
	     */

	    ch = (Tcl_UniChar) '?';
	}

3605
3606
3607
3608
3609
3610
3611
3612

3613
3614
3615
3616
3617
3618
3619
3624
3625
3626
3627
3628
3629
3630

3631
3632
3633
3634
3635
3636
3637
3638







-
+







 *
 *-------------------------------------------------------------------------
 */

static void
InitializeEncodingSearchPath(
    char **valuePtr,
    size_t *lengthPtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *bytes;
    int i, numDirs;
    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;

    TclNewLiteralStringObj(encodingObj, "encoding");

Changes to generic/tclEnsemble.c.

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
17
18
19
20
21
22
23


24
25
26
27
28
29
30







-
-







 * Declarations for functions local to this file:
 */

static inline Tcl_Obj *	NewNsObj(Tcl_Namespace *namespacePtr);
static inline int	EnsembleUnknownCallback(Tcl_Interp *interp,
			    EnsembleConfig *ensemblePtr, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
static int		NsEnsembleImplementationCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NsEnsembleImplementationCmdNR(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static void		BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
static int		NsEnsembleStringOrder(const void *strPtr1,
			    const void *strPtr2);
static void		DeleteEnsembleConfig(ClientData clientData);
static void		MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
83
84
85
86
87
88
89
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
81
82
83
84
85
86
87


88
89
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







-
-
+
+



-
+





-
-
+
+

-









-
-

+







    FreeEnsembleCmdRep,		/* freeIntRepProc */
    DupEnsembleCmdRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */
};

/*
 * The internal rep for caching ensemble subcommand lookups and
 * spell corrections.
 * The internal rep for caching ensemble subcommand lookups and spelling
 * corrections.
 */

typedef struct {
    size_t epoch;               /* Used to confirm when the data in this
    unsigned int 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_HashEntry *hPtr;        /* Direct link to entry in the subcommand hash
                                 * table. */
} EnsembleCmdRep;


static inline Tcl_Obj *
NewNsObj(
    Tcl_Namespace *namespacePtr)
{
    register Namespace *nsPtr = (Namespace *) namespacePtr;

    if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
	return Tcl_NewStringObj("::", 2);
    } else {
	return Tcl_NewStringObj(nsPtr->fullName, -1);
    }
    return Tcl_NewStringObj(nsPtr->fullName, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNamespaceEnsembleCmd --
 *
142
143
144
145
146
147
148
149


150
151
152

153
154
155
156
157
158
159
138
139
140
141
142
143
144

145
146
147
148
149
150
151
152
153
154
155
156
157







-
+
+



+







TclNamespaceEnsembleCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Namespace *namespacePtr;
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
	    *foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
    Tcl_Command token;
    Tcl_DictSearch search;
    Tcl_Obj *listObj;
    const char *simpleName;
    int index, done;

    if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tried to manipulate ensemble of deleted namespace",
		    -1));
191
192
193
194
195
196
197
198
199
200
201
202
203
204


205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223

224
225
226
227
228
229
230
189
190
191
192
193
194
195







196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224







-
-
-
-
-
-
-
+
+



















+







	if (objc & 1) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?");
	    return TCL_ERROR;
	}
	objv += 2;
	objc -= 2;

	/*
	 * Work out what name to use for the command to create. If supplied,
	 * it is either fully specified or relative to the current namespace.
	 * If not supplied, it is exactly the name of the current namespace.
	 */

	name = nsPtr->fullName;
	name = nsPtr->name;
	cxtPtr = (Namespace *) nsPtr->parentPtr;

	/*
	 * Parse the option list, applying type checks as we go. Note that we
	 * are not incrementing any reference counts in the objects at this
	 * stage, so the presence of an option multiple times won't cause any
	 * memory leaks.
	 */

	for (; objc>1 ; objc-=2,objv+=2) {
	    if (Tcl_GetIndexFromObj(interp, objv[0], ensembleCreateOptions,
		    "option", 0, &index) != TCL_OK) {
		if (allocatedMapFlag) {
		    Tcl_DecrRefCount(mapObj);
		}
		return TCL_ERROR;
	    }
	    switch ((enum EnsCreateOpts) index) {
	    case CRT_CMD:
		name = TclGetString(objv[1]);
		cxtPtr = nsPtr;
		continue;
	    case CRT_SUBCMDS:
		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
300
301
302
303
304
305
306
307


308
309
310
311
312
313
314
294
295
296
297
298
299
300

301
302
303
304
305
306
307
308
309







-
+
+







			Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
			if (patchedDict == NULL) {
			    patchedDict = Tcl_DuplicateObj(objv[1]);
			}
			Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
				newList);
		    }
		    Tcl_DictObjNext(&search, &subcmdWordsObj,&listObj, &done);
		    Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
			    &done);
		} while (!done);

		if (allocatedMapFlag) {
		    Tcl_DecrRefCount(mapObj);
		}
		mapObj = (patchedDict ? patchedDict : objv[1]);
		if (patchedDict) {
333
334
335
336
337
338
339




340
341
342
343
344
345
346
347


348
349
350
351
352
353
354
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345

346
347
348
349
350
351
352
353
354







+
+
+
+







-
+
+







		    return TCL_ERROR;
		}
		unknownObj = (len > 0 ? objv[1] : NULL);
		continue;
	    }
	}

	TclGetNamespaceForQualName(interp, name, cxtPtr,
		TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr,
		&actualCxtPtr, &simpleName);

	/*
	 * Create the ensemble. Note that this might delete another ensemble
	 * linked to the same namespace, so we must be careful. However, we
	 * should be OK because we only link the namespace into the list once
	 * we've created it (and after any deletions have occurred.)
	 */

	token = Tcl_CreateEnsemble(interp, name, NULL,
	token = TclCreateEnsembleInNs(interp, simpleName,
		(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
		(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
	Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
	Tcl_SetEnsembleMappingDict(interp, token, mapObj);
	Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
	Tcl_SetEnsembleParameterList(interp, token, paramObj);

	/*
569
570
571
572
573
574
575
576


577
578
579
580
581
582
583
569
570
571
572
573
574
575

576
577
578
579
580
581
582
583
584







-
+
+







			    Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
			    Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);

			    if (nsPtr->parentPtr) {
				Tcl_AppendStringsToObj(newCmd, "::", NULL);
			    }
			    Tcl_AppendObjToObj(newCmd, listv[0]);
			    Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
			    Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
				    &newCmd);
			    if (patchedDict == NULL) {
				patchedDict = Tcl_DuplicateObj(objv[1]);
			    }
			    Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
				    newList);
			}
			Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
632
633
634
635
636
637
638
639

640
641

642
643
644

645
646
647
648
649
650
651
652
653

654
655
656






657
658
659
660


661
662

663
664
665
666


667
668
669
670
671

672
673
674



675
676
677


678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693

694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711


712
713
714
715







































716
717
718
719
720
721
722
723
633
634
635
636
637
638
639

640
641

642



643



644
645
646
647
648

649
650


651
652
653
654
655
656
657
658


659
660


661




662
663





664



665
666
667



668
669



670
671
672
673
674
675
676
677
678
679
680
681

682


683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700




701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747







-
+

-
+
-
-
-
+
-
-
-





-
+

-
-
+
+
+
+
+
+


-
-
+
+
-
-
+
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
+
+
+
-
-
-
+
+
-
-
-












-
+
-
-
















+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateEnsemble --
 * TclCreateEnsembleInNs --
 *
 *	Create a simple ensemble attached to the given namespace.
 *	Like Tcl_CreateEnsemble, but additionally accepts as an argument the
 *
 * Results:
 *	The token for the command created.
 *	name of the namespace to create the command in.
 *
 * Side effects:
 *	The ensemble is created and marked for compilation.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_CreateEnsemble(
TclCreateEnsembleInNs(
    Tcl_Interp *interp,
    const char *name,
    Tcl_Namespace *namespacePtr,
    const char *name,		/* Simple name of command to create (no
				 * namespace components). */
    Tcl_Namespace *nameNsPtr,	/* Name of namespace to create the command
				 * in. */
    Tcl_Namespace *ensembleNsPtr,
				/* Name of the namespace for the ensemble. */
    int flags)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;
    EnsembleConfig *ensemblePtr = ckalloc(sizeof(EnsembleConfig));
    Namespace *nsPtr = (Namespace *) ensembleNsPtr;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *nameObj = NULL;

    Tcl_Command token;
    if (nsPtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }


    ensemblePtr = ckalloc(sizeof(EnsembleConfig));
    /*
     * Make the name of the ensemble into a fully qualified name. This might
     * allocate a temporary object.
     */

    token = TclNRCreateCommandInNs(interp, name,
    if (!(name[0] == ':' && name[1] == ':')) {
	nameObj = NewNsObj((Tcl_Namespace *) nsPtr);
	if (nsPtr->parentPtr == NULL) {
	    (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd,
	    NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
    if (token == NULL) {
	    Tcl_AppendStringsToObj(nameObj, name, NULL);
	} else {
	    Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
	ckfree(ensemblePtr);
	return NULL;
	}
	Tcl_IncrRefCount(nameObj);
	name = TclGetString(nameObj);
    }

    ensemblePtr->nsPtr = nsPtr;
    ensemblePtr->epoch = 0;
    Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS);
    ensemblePtr->subcommandArrayPtr = NULL;
    ensemblePtr->subcmdList = NULL;
    ensemblePtr->subcommandDict = NULL;
    ensemblePtr->flags = flags;
    ensemblePtr->numParameters = 0;
    ensemblePtr->parameterList = NULL;
    ensemblePtr->unknownHandler = NULL;
    ensemblePtr->token = Tcl_NRCreateCommand(interp, name,
    ensemblePtr->token = token;
	    NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR,
	    ensemblePtr, DeleteEnsembleConfig);
    ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    nsPtr->exportLookupEpoch++;

    if (flags & ENSEMBLE_COMPILE) {
	((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
    }

    return ensemblePtr->token;
}
    if (nameObj != NULL) {
	TclDecrRefCount(nameObj);
    }
    return ensemblePtr->token;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateEnsemble
 *
 *	Create a simple ensemble attached to the given namespace. Deprecated
 *	(internally) by TclCreateEnsembleInNs.
 *
 * Value
 *
 *	The token for the command created.
 *
 * Effect
 *	The ensemble is created and marked for compilation.
 *
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_CreateEnsemble(
    Tcl_Interp *interp,
    const char *name,
    Tcl_Namespace *namespacePtr,
    int flags)
{
    Namespace *nsPtr = (Namespace *) namespacePtr, *foundNsPtr, *altNsPtr,
	    *actualNsPtr;
    const char * simpleName;

    if (nsPtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }

    TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN,
	    &foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
    return TclCreateEnsembleInNs(interp, simpleName,
	    (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetEnsembleSubcommandList --
 *
 *	Set the subcommand list for a particular ensemble.
738
739
740
741
742
743
744
745

746
747
748
749
750
751
752
762
763
764
765
766
767
768

769
770
771
772
773
774
775
776







-
+







    Tcl_Command token,
    Tcl_Obj *subcmdList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (subcmdList != NULL) {
	int length;
814
815
816
817
818
819
820
821

822
823
824
825
826
827
828
838
839
840
841
842
843
844

845
846
847
848
849
850
851
852







-
+







    Tcl_Obj *paramList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;
    int length;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (paramList == NULL) {
	length = 0;
890
891
892
893
894
895
896
897

898
899
900
901
902
903
904
914
915
916
917
918
919
920

921
922
923
924
925
926
927
928







-
+







    Tcl_Command token,
    Tcl_Obj *mapDict)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldDict;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (mapDict != NULL) {
	int size, done;
989
990
991
992
993
994
995
996

997
998
999
1000
1001
1002
1003
1013
1014
1015
1016
1017
1018
1019

1020
1021
1022
1023
1024
1025
1026
1027







-
+







    Tcl_Command token,
    Tcl_Obj *unknownList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (unknownList != NULL) {
	int length;
1055
1056
1057
1058
1059
1060
1061
1062

1063
1064
1065
1066
1067
1068
1069
1079
1080
1081
1082
1083
1084
1085

1086
1087
1088
1089
1090
1091
1092
1093







-
+







    Tcl_Command token,
    int flags)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    int wasCompiled;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
1131
1132
1133
1134
1135
1136
1137
1138

1139
1140
1141
1142
1143
1144
1145
1155
1156
1157
1158
1159
1160
1161

1162
1163
1164
1165
1166
1167
1168
1169







-
+







    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **subcmdListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    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", NULL);
	}
	return TCL_ERROR;
    }
1173
1174
1175
1176
1177
1178
1179
1180

1181
1182
1183
1184
1185
1186
1187
1197
1198
1199
1200
1201
1202
1203

1204
1205
1206
1207
1208
1209
1210
1211







-
+







    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **paramListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    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", NULL);
	}
	return TCL_ERROR;
    }
1215
1216
1217
1218
1219
1220
1221
1222

1223
1224
1225
1226
1227
1228
1229
1239
1240
1241
1242
1243
1244
1245

1246
1247
1248
1249
1250
1251
1252
1253







-
+







    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **mapDictPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    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", NULL);
	}
	return TCL_ERROR;
    }
1256
1257
1258
1259
1260
1261
1262
1263

1264
1265
1266
1267
1268
1269
1270
1280
1281
1282
1283
1284
1285
1286

1287
1288
1289
1290
1291
1292
1293
1294







-
+







    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **unknownListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    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", NULL);
	}
	return TCL_ERROR;
    }
1297
1298
1299
1300
1301
1302
1303
1304

1305
1306
1307
1308
1309
1310
1311
1321
1322
1323
1324
1325
1326
1327

1328
1329
1330
1331
1332
1333
1334
1335







-
+







    Tcl_Interp *interp,
    Tcl_Command token,
    int *flagsPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    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", NULL);
	}
	return TCL_ERROR;
    }
1338
1339
1340
1341
1342
1343
1344
1345

1346
1347
1348
1349
1350
1351
1352
1362
1363
1364
1365
1366
1367
1368

1369
1370
1371
1372
1373
1374
1375
1376







-
+







    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Namespace **namespacePtrPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    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", NULL);
	}
	return TCL_ERROR;
    }
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402
1403


1404
1405
1406
1407
1408
1409
1410
1412
1413
1414
1415
1416
1417
1418

1419
1420
1421
1422
1423
1424
1425
1426

1427
1428
1429
1430
1431
1432
1433
1434
1435







-
+







-
+
+








    cmdPtr = (Command *)
	    Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
    if (cmdPtr == NULL) {
	return NULL;
    }

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	/*
	 * Reuse existing infrastructure for following import link chains
	 * rather than duplicating it.
	 */

	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);

	if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){
	if (cmdPtr == NULL
		|| cmdPtr->objProc != TclEnsembleImplementationCmd) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" is not an ensemble command",
			TclGetString(cmdNameObj)));
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
			TclGetString(cmdNameObj), NULL);
	    }
1434
1435
1436
1437
1438
1439
1440
1441

1442
1443
1444
1445

1446
1447
1448
1449
1450
1451
1452
1459
1460
1461
1462
1463
1464
1465

1466
1467
1468
1469

1470
1471
1472
1473
1474
1475
1476
1477







-
+



-
+








int
Tcl_IsEnsemble(
    Tcl_Command token)
{
    Command *cmdPtr = (Command *) token;

    if (cmdPtr->objProc == NsEnsembleImplementationCmd) {
    if (cmdPtr->objProc == TclEnsembleImplementationCmd) {
	return 1;
    }
    cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
    if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
    if (cmdPtr == NULL || cmdPtr->objProc != TclEnsembleImplementationCmd) {
	return 0;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
1609
1610
1611
1612
1613
1614
1615
1616

1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636


1637
1638
1639
1640
1641
1642
1643
1634
1635
1636
1637
1638
1639
1640

1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659


1660
1661
1662
1663
1664
1665
1666
1667
1668







-
+


















-
-
+
+







    }
    return ensemble;
}

/*
 *----------------------------------------------------------------------
 *
 * NsEnsembleImplementationCmd --
 * TclEnsembleImplementationCmd --
 *
 *	Implements an ensemble of commands (being those exported by a
 *	namespace other than the global namespace) as a command with the same
 *	(short) name as the namespace in the parent namespace.
 *
 * Results:
 *	A standard Tcl result code. Will be TCL_ERROR if the command is not an
 *	unambiguous prefix of any command exported by the ensemble's
 *	namespace.
 *
 * Side effects:
 *	Depends on the command within the namespace that gets executed. If the
 *	ensemble itself returns TCL_ERROR, a descriptive error message will be
 *	placed in the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

static int
NsEnsembleImplementationCmd(
int
TclEnsembleImplementationCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return Tcl_NRCallObjProc(interp, NsEnsembleImplementationCmdNR,
	    clientData, objc, objv);
1881
1882
1883
1884
1885
1886
1887

1888
1889
1890
1891
1892
1893
1894
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920







+








	/*
	 * Hand off to the target command.
	 */

	TclSkipTailcall(interp);
	Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
	((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
	return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
    }

  unknownOrAmbiguousSubcommand:
    /*
     * Have not been able to match the subcommand asked for with a real
     * subcommand that we export. See whether a handler has been registered
2080
2081
2082
2083
2084
2085
2086

2087


2088
2089
2090

2091
2092
2093

2094


2095
2096
2097
2098
2099
2100
2101


2102

2103
2104
2105
2106
2107
2108
2109
2106
2107
2108
2109
2110
2111
2112
2113

2114
2115
2116
2117

2118
2119
2120
2121
2122

2123
2124
2125
2126
2127
2128
2129


2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140







+
-
+
+


-
+



+
-
+
+





-
-
+
+

+








    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }

    /*
    /* Compute the valid length of the ensemble root */
     * Compute the valid length of the ensemble root.
     */

    size = iPtr->ensembleRewrite.numRemovedObjs + objc
		- iPtr->ensembleRewrite.numInsertedObjs;
	    - iPtr->ensembleRewrite.numInsertedObjs;

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	/*
	/* Awful casting abuse here */
	 * Awful casting abuse here...
	 */
	search = (Tcl_Obj *const *) search[1];
    }

    if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
	/*
	 * Misspelled value was inserted. We cannot directly jump
	 * to the bad value, but have to search.
	 * Misspelled value was inserted. We cannot directly jump to the bad
	 * value, but have to search.
	 */

	idx = 1;
	while (idx < size) {
	    if (search[idx] == bad) {
		break;
	    }
	    idx++;
	}
2119
2120
2121
2122
2123
2124
2125
2126
2127


2128

2129
2130
2131
2132



2133
2134
2135
2136
2137
2138
2139
2150
2151
2152
2153
2154
2155
2156


2157
2158
2159
2160
2161



2162
2163
2164
2165
2166
2167
2168
2169
2170
2171







-
-
+
+

+

-
-
-
+
+
+







	if (search[idx] != bad) {
	    Tcl_Panic("SpellFix: programming error");
	}
    }

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	store = (Tcl_Obj **)search[2];
    }  else {
	store = (Tcl_Obj **) search[2];
    } else {
	Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));

	tmp[0] = NULL;
	tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs;
	tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *));
	memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *));
	tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs;
	tmp[2] = (Tcl_Obj *) ckalloc(size * sizeof(Tcl_Obj *));
	memcpy(tmp[2], tmp[1], size * sizeof(Tcl_Obj *));

	iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
	TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
	store = (Tcl_Obj **)tmp[2];
    }

    store[idx] = fix;
2393
2394
2395
2396
2397
2398
2399




















2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458


2459
2460
2461
2462
2463
2464
2465







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-







 *	None.
 *
 * Side effects:
 *	Memory is (eventually) deallocated.
 *
 *----------------------------------------------------------------------
 */

static void
ClearTable(
    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_GetHashValue(hPtr);
            Tcl_DecrRefCount(prefixObj);
            hPtr = Tcl_NextHashEntry(&search);
        }
        ckfree((char *) ensemblePtr->subcommandArrayPtr);
    }
    Tcl_DeleteHashTable(hash);
}

static void
DeleteEnsembleConfig(
    ClientData clientData)
{
    EnsembleConfig *ensemblePtr = clientData;
    Namespace *nsPtr = ensemblePtr->nsPtr;
    Tcl_HashSearch search;
    Tcl_HashEntry *hEnt;

    /*
     * Unlink from the ensemble chain if it has not been marked as having been
     * done already.
     */

    if (ensemblePtr->next != ensemblePtr) {
2435
2436
2437
2438
2439
2440
2441
2442
2443

2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2485
2486
2487
2488
2489
2490
2491


2492









2493
2494
2495
2496
2497
2498
2499







-
-
+
-
-
-
-
-
-
-
-
-








    ensemblePtr->flags |= ENSEMBLE_DEAD;

    /*
     * Kill the pointer-containing fields.
     */

    if (ensemblePtr->subcommandTable.numEntries != 0) {
	ckfree(ensemblePtr->subcommandArrayPtr);
    ClearTable(ensemblePtr);
    }
    hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
    while (hEnt != NULL) {
	Tcl_Obj *prefixObj = Tcl_GetHashValue(hEnt);

	Tcl_DecrRefCount(prefixObj);
	hEnt = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
    if (ensemblePtr->subcmdList != NULL) {
	Tcl_DecrRefCount(ensemblePtr->subcmdList);
    }
    if (ensemblePtr->parameterList != NULL) {
	Tcl_DecrRefCount(ensemblePtr->parameterList);
    }
    if (ensemblePtr->subcommandDict != NULL) {
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514

2515
2516
2517
2518

2519
2520
2521
2522
2523
2524








2525
2526

2527
2528
2529
2530



2531

2532
2533




2534

2535
2536
2537

2538
2539

2540
2541
2542
2543
2544




















2545
2546



2547
2548
2549



2550
2551
2552
2553



2554
2555
2556


2557
2558
2559
2560
2561
2562
2563






2564
2565
2566
2567
2568
2569






2570
2571

2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586











2587
2588
2589
2590



2591
2592
2593
2594
2595




2596
2597
2598
2599
2600
2601





2602
2603
2604
2605
2606
2607
2608
2541
2542
2543
2544
2545
2546
2547







2548




2549






2550
2551
2552
2553
2554
2555
2556
2557
2558

2559




2560
2561
2562
2563
2564


2565
2566
2567
2568

2569
2570


2571


2572





2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597



2598
2599
2600
2601



2602
2603
2604
2605


2606
2607







2608
2609
2610
2611
2612
2613
2614





2615
2616
2617
2618
2619
2620
2621

2622















2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634



2635
2636
2637
2638




2639
2640
2641
2642
2643





2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655







-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+
-
-
-
-
+
+
+

+
-
-
+
+
+
+
-
+

-
-
+
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+







{
    Tcl_HashSearch search;	/* Used for scanning the set of commands in
				 * the namespace that backs up this
				 * ensemble. */
    int i, j, isNew;
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
    Tcl_HashEntry *hPtr;

    if (hash->numEntries != 0) {
	/*
	 * Remove pre-existing table.
	 */

	ckfree(ensemblePtr->subcommandArrayPtr);
    Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
	hPtr = Tcl_FirstHashEntry(hash, &search);
	while (hPtr != NULL) {
	    Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);

    Tcl_Obj *subList = ensemblePtr->subcmdList;
	    Tcl_DecrRefCount(prefixObj);
	    hPtr = Tcl_NextHashEntry(&search);
	}
	Tcl_DeleteHashTable(hash);
	Tcl_InitHashTable(hash, TCL_STRING_KEYS);
    }

    ClearTable(ensemblePtr);
    Tcl_InitHashTable(hash, TCL_STRING_KEYS);

    if (subList) {
        int subc;
        Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
        char *name;

    /*
        /*
     * See if we've got an export list. If so, we will only export exactly
     * those commands, which may be either implemented by the prefix in the
     * subcommandDict or mapped directly onto the namespace's commands.
     */
         * There is a list of exactly what subcommands go in the table.
         * Must determine the target for each.
         */

        Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
    if (ensemblePtr->subcmdList != NULL) {
	Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
        if (subList == mapDict) {
            /*
             * Strange case where explicit list of subcommands is same value
             * as the dict mapping to targets.
	int subcmdc;
             */

	TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
		&subcmdv);
            for (i = 0; i < subc; i += 2) {
	for (i=0 ; i<subcmdc ; i++) {
	    const char *name = TclGetString(subcmdv[i]);
                name = TclGetString(subv[i]);

	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);

	    /*
	     * Skip non-unique cases.
                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;
	    }
                if (!isNew) {
                    continue;
                }

	    /*
	     * Look in our dictionary (if present) for the command.
	     */
                /*
		 * Lookup target in the dictionary.
		 */

	    if (ensemblePtr->subcommandDict != NULL) {
		Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
                if (mapDict) {
                    Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
			&target);
		if (target != NULL) {
		    Tcl_SetHashValue(hPtr, target);
		    Tcl_IncrRefCount(target);
		    continue;
		}
	    }
                    if (target) {
                        Tcl_SetHashValue(hPtr, target);
                        Tcl_IncrRefCount(target);
                        continue;
                    }
                }

	    /*
	     * Not there, so map onto the namespace. Note in this case that we
	     * do not guarantee that the command is actually there; that is
	     * the programmer's responsibility (or [::unknown] of course).
	     */
                /*
                 * target was not in the dictionary so map onto the namespace.
                 * Note in this case that we do not guarantee that the command
                 * is actually there; that is the programmer's responsibility
                 * (or [::unknown] of course).
                 */

	    cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
                cmdObj = Tcl_NewStringObj(name, -1);
	    if (ensemblePtr->nsPtr->parentPtr != NULL) {
		Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
	    } else {
		Tcl_AppendStringsToObj(cmdObj, name, NULL);
	    }
	    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
	    Tcl_SetHashValue(hPtr, cmdPrefixObj);
	    Tcl_IncrRefCount(cmdPrefixObj);
	}
    } else if (ensemblePtr->subcommandDict != NULL) {
	/*
	 * No subcmd list, but we do have a mapping dictionary so we should
	 * use the keys of that. Convert the dictionary's contents into the
	 * form required for the ensemble's internal hashtable.
	 */
                cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
                Tcl_SetHashValue(hPtr, cmdPrefixObj);
                Tcl_IncrRefCount(cmdPrefixObj);
            }
        }
    } else if (mapDict) {
        /*
         * No subcmd list, but we do have a mapping dictionary so we should
         * use the keys of that. Convert the dictionary's contents into the
         * form required for the ensemble's internal hashtable.
         */

	Tcl_DictSearch dictSearch;
	Tcl_Obj *keyObj, *valueObj;
	int done;
        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);
        Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
                &keyObj, &valueObj, &done);
        while (!done) {
            char *name = TclGetString(keyObj);

	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
	    Tcl_SetHashValue(hPtr, valueObj);
	    Tcl_IncrRefCount(valueObj);
	    Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
	}
            hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
            Tcl_SetHashValue(hPtr, valueObj);
            Tcl_IncrRefCount(valueObj);
            Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
        }
    } else {
	/*
	 * Discover what commands are actually exported by the namespace.
	 * What we have is an array of patterns and a hash table whose keys
	 * are the command names exported by the namespace (the contents do
	 * not matter here.) We must find out what commands are actually
	 * exported by filtering each command in the namespace against each of
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641

2642
2643
2644
2645
2646
2647
2648
2677
2678
2679
2680
2681
2682
2683





2684
2685
2686
2687
2688
2689
2690
2691







-
-
-
-
-
+







		     * substituted part of the command (as a list) as their
		     * content!
		     */

		    if (isNew) {
			Tcl_Obj *cmdObj, *cmdPrefixObj;

			TclNewObj(cmdObj);
			Tcl_AppendStringsToObj(cmdObj,
				ensemblePtr->nsPtr->fullName,
				(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
				nsCmdName, NULL);
			cmdObj = Tcl_NewStringObj(nsCmdName, -1);
			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
			Tcl_SetHashValue(hPtr, cmdPrefixObj);
			Tcl_IncrRefCount(cmdPrefixObj);
		    }
		    break;
		}
	    }

Changes to generic/tclEnv.c.

719
720
721
722
723
724
725
726


727
728
729






730
731
732
733




734
735
736
737
738
739
740
719
720
721
722
723
724
725

726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751







-
+
+



+
+
+
+
+
+




+
+
+
+







TclFinalizeEnvironment(void)
{
    /*
     * For now we just deallocate the cache array and none of the environment
     * strings. This may leak more memory that strictly necessary, since some
     * of the strings may no longer be in the environment. However,
     * determining which ones are ok to delete is n-squared, and is pretty
     * unlikely, so we don't bother.
     * unlikely, so we don't bother.  However, in the case of DPURIFY, just
     * free all strings in the cache.
     */

    if (env.cache) {
#ifdef PURIFY
	int i;
	for (i = 0; i < env.cacheSize; i++) {
	    ckfree(env.cache[i]);
	}
#endif
	ckfree(env.cache);
	env.cache = NULL;
	env.cacheSize = 0;
#ifndef USE_PUTENV
	if ((env.ourEnviron != NULL)) {
	    ckfree(env.ourEnviron);
	    env.ourEnviron = NULL;
	}
	env.ourEnvironSize = 0;
#endif
    }
}

/*
 * Local Variables:

Changes to generic/tclEvent.c.

96
97
98
99
100
101
102
103

104
105
106
107
108
109
110
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110







-
+







				 * thread. */
    int inExit;			/* True when this thread is exiting. This is
				 * used as a hack to decide to close the
				 * standard channels. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

#ifdef TCL_THREADS
#if TCL_THREADS
typedef struct {
    Tcl_ThreadCreateProc *proc;	/* Main() function of the thread */
    ClientData clientData;	/* The one argument to Main() */
} ThreadClientData;
static Tcl_ThreadCreateType NewThreadProc(ClientData clientData);
#endif /* TCL_THREADS */

1039
1040
1041
1042
1043
1044
1045
1046

1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1039
1040
1041
1042
1043
1044
1045

1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059

1060
1061
1062
1063
1064
1065
1066







-
+













-







	     */

	    TclInitThreadStorage();     /* Creates master hash table for
					 * thread local storage */
#if USE_TCLALLOC
	    TclInitAlloc();		/* Process wide mutex init */
#endif
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
	    TclInitThreadAlloc();	/* Setup thread allocator caches */
#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc();		/* Process wide mutex init */
#endif

	    TclpInitPlatform();		/* Creates signal handler(s) */
	    TclInitDoubleConversion();	/* Initializes constants for
					 * converting to/from double. */
	    TclInitObjSubsystem();	/* Register obj types, create
					 * mutexes. */
	    TclInitIOSubsystem();	/* Inits a tsd key (noop). */
	    TclInitEncodingSubsystem();	/* Process wide encoding init. */
	    TclpSetInterfaces();
	    TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
	    subsystemsInitialized = 1;
	}
	TclpInitUnlock();
    }
    TclInitNotifier();
}
1217
1218
1219
1220
1221
1222
1223
1224

1225
1226
1227
1228
1229
1230
1231
1216
1217
1218
1219
1220
1221
1222

1223
1224
1225
1226
1227
1228
1229
1230







-
+








    TclFinalizeSynchronization();

    /*
     * Close down the thread-specific object allocator.
     */

#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    TclFinalizeThreadAlloc();
#endif

    /*
     * We defer unloading of packages until very late to avoid memory access
     * issues. Both exit callbacks and synchronization variables may be stored
     * in packages.
1535
1536
1537
1538
1539
1540
1541
1542

1543
1544
1545
1546
1547
1548
1549
1534
1535
1536
1537
1538
1539
1540

1541
1542
1543
1544
1545
1546
1547
1548







-
+







     * executed commands.
     */

    Tcl_ResetResult(interp);
    return TCL_OK;
}

#ifdef TCL_THREADS
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * NewThreadProc --
 *
 *	Bootstrap function of a new Tcl thread.
 *
1598
1599
1600
1601
1602
1603
1604
1605

1606
1607
1608
1609
1610
1611
1612
1597
1598
1599
1600
1601
1602
1603

1604
1605
1606
1607
1608
1609
1610
1611







-
+







    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#ifdef TCL_THREADS
#if TCL_THREADS
    ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
    int result;

    cdPtr->proc = proc;
    cdPtr->clientData = clientData;
    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
    if (result != TCL_OK) {

Changes to generic/tclExecute.c.

321
322
323
324
325
326
327
328

329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349

350
351
352
353
354
355
356
357
358
359
360

361
362
363
364
365
366
367
368
369

370
371
372
373
374
375
376
321
322
323
324
325
326
327

328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348

349
350
351
352
353
354
355
356
357
358
359

360
361
362
363
364
365
366
367
368

369
370
371
372
373
374
375
376







-
+




















-
+










-
+








-
+







	    NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
	case INST_JUMP_FALSE4:						\
	    NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
	case INST_JUMP_TRUE4:						\
	    NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
	default:							\
	    if ((condition) < 0) {					\
		TclNewLongObj(objResultPtr, -1);				\
		TclNewIntObj(objResultPtr, -1);				\
	    } else {							\
		objResultPtr = TCONST((condition) > 0);			\
	    }								\
	    NEXT_INST_F(0, (cleanup), 1);				\
	}								\
    } while (0)
#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
    do {								\
	pc += (pcAdjustment);						\
	switch (*pc) {							\
	case INST_JUMP_FALSE1:						\
	    NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
	case INST_JUMP_TRUE1:						\
	    NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
	case INST_JUMP_FALSE4:						\
	    NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
	case INST_JUMP_TRUE4:						\
	    NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
	default:							\
	    if ((condition) < 0) {					\
		TclNewLongObj(objResultPtr, -1);				\
		TclNewIntObj(objResultPtr, -1);				\
	    } else {							\
		objResultPtr = TCONST((condition) > 0);			\
	    }								\
	    NEXT_INST_V(0, (cleanup), 1);				\
	}								\
    } while (0)
#else /* TCL_COMPILE_DEBUG */
#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
    do{									\
	if ((condition) < 0) {						\
	    TclNewLongObj(objResultPtr, -1);				\
	    TclNewIntObj(objResultPtr, -1);				\
	} else {							\
	    objResultPtr = TCONST((condition) > 0);			\
	}								\
	NEXT_INST_F((pcAdjustment), (cleanup), 1);			\
    } while (0)
#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
    do{									\
	if ((condition) < 0) {						\
	    TclNewLongObj(objResultPtr, -1);				\
	    TclNewIntObj(objResultPtr, -1);				\
	} else {							\
	    objResultPtr = TCONST((condition) > 0);			\
	}								\
	NEXT_INST_V((pcAdjustment), (cleanup), 1);			\
    } while (0)
#endif

494
495
496
497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
494
495
496
497
498
499
500

501
502

503



















504
505
506
507
508
509
510
511
512
513
514















515
516
517
518
519
520
521







-


-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * Macro used in this file to save a function call for common uses of
 * TclGetNumberFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			ClientData *ptrPtr, int *tPtr);
 */

#ifdef TCL_WIDE_INT_IS_LONG
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
    (((objPtr)->typePtr == &tclIntType)					\
	?	(*(tPtr) = TCL_NUMBER_LONG,				\
	?	(*(tPtr) = TCL_NUMBER_INT,				\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.longValue)), TCL_OK) :	\
    ((objPtr)->typePtr == &tclDoubleType)				\
	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
	? TCL_ERROR :			\
    TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
#else /* !TCL_WIDE_INT_IS_LONG */
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
    (((objPtr)->typePtr == &tclIntType)					\
	?	(*(tPtr) = TCL_NUMBER_LONG,				\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.longValue)), TCL_OK) :	\
    ((objPtr)->typePtr == &tclWideIntType)				\
	?	(*(tPtr) = TCL_NUMBER_WIDE,				\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
    ((objPtr)->typePtr == &tclDoubleType)				\
	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
	? TCL_ERROR :			\
    TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
#endif /* TCL_WIDE_INT_IS_LONG */

/*
 * Macro used in this file to save a function call for common uses of
 * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			int *boolPtr);
 */

#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
    ((((objPtr)->typePtr == &tclIntType)				\
	|| ((objPtr)->typePtr == &tclBooleanType))			\
	? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK)	\
	: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))

/*
 * Macro used to make the check for type overflow more mnemonic. This works by
 * comparing sign bits; the rest of the word is irrelevant. The ANSI C
 * "prototype" (where inttype_t is any integer type) is:
 *
 * MODULE_SCOPE int Overflowing(inttype_t a, inttype_t b, inttype_t sum);
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
537
538
539
540
541
542
543


































544
545
546
547
548
549
550







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







#define IsErroringNaNType(type)		0
#endif

/*
 * Auxiliary tables used to compute powers of small integers.
 */

#if (LONG_MAX == 0x7fffffff)

/*
 * Maximum base that, when raised to powers 2, 3, ... 8, fits in a 32-bit
 * signed integer.
 */

static const long MaxBase32[] = {46340, 1290, 215, 73, 35, 21, 14};
static const size_t MaxBase32Size = sizeof(MaxBase32)/sizeof(long);

/*
 * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., as far as they
 * fit in a 32-bit signed integer. Exp32Index[i] gives the starting index of
 * powers of i+3; Exp32Value[i] gives the corresponding powers.
 */

static const unsigned short Exp32Index[] = {
    0, 11, 18, 23, 26, 29, 31, 32, 33
};
static const size_t Exp32IndexSize =
    sizeof(Exp32Index) / sizeof(unsigned short);
static const long Exp32Value[] = {
    19683, 59049, 177147, 531441, 1594323, 4782969, 14348907, 43046721,
    129140163, 387420489, 1162261467, 262144, 1048576, 4194304,
    16777216, 67108864, 268435456, 1073741824, 1953125, 9765625,
    48828125, 244140625, 1220703125, 10077696, 60466176, 362797056,
    40353607, 282475249, 1977326743, 134217728, 1073741824, 387420489,
    1000000000
};
static const size_t Exp32ValueSize = sizeof(Exp32Value)/sizeof(long);
#endif /* LONG_MAX == 0x7fffffff -- 32 bit machine */

#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)

/*
 * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a
 * Tcl_WideInt.
 */

static const Tcl_WideInt MaxBase64[] = {
    (Tcl_WideInt)46340*65536+62259,	/* 3037000499 == isqrt(2**63-1) */
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
640
641
642
643
644
645
646

647
648
649
650
651
652
653







-







    (Tcl_WideInt)100000*100000*100000*10*10*10,
    (Tcl_WideInt)161051*161051*161051*11*11,
    (Tcl_WideInt)161051*161051*161051*11*11*11,
    (Tcl_WideInt)248832*248832*248832*12*12,
    (Tcl_WideInt)371293*371293*371293*13*13
};
static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
#endif /* (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) */

/*
 * Markers for ExecuteExtendedBinaryMathOp.
 */

#define DIVIDED_BY_ZERO		((Tcl_Obj *) -1)
#define EXPONENT_OF_ZERO	((Tcl_Obj *) -2)
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
670
671
672
673
674
675
676


677
678
679
680
681
682
683







-
-







			    const unsigned char *pc, int stackTop,
			    int checkStack);
#endif /* TCL_COMPILE_DEBUG */
static ByteCode *	CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		DeleteExecStack(ExecStack *esPtr);
static void		DupExprCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
			    Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
			    int opcode, Tcl_Obj **constants,
			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
			    Tcl_Obj *valuePtr);
static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
904
905
906
907
908
909
910
911

912
913

914
915
916
917
918
919
920
832
833
834
835
836
837
838

839
840

841
842
843
844
845
846
847
848







-
+

-
+







				 * [sizeof(Tcl_Obj*)] */
{
    ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
    ExecStack *esPtr = ckalloc(sizeof(ExecStack)
	    + (size_t) (size-1) * sizeof(Tcl_Obj *));

    eePtr->execStackPtr = esPtr;
    TclNewLongObj(eePtr->constants[0], 0);
    TclNewIntObj(eePtr->constants[0], 0);
    Tcl_IncrRefCount(eePtr->constants[0]);
    TclNewLongObj(eePtr->constants[1], 1);
    TclNewIntObj(eePtr->constants[1], 1);
    Tcl_IncrRefCount(eePtr->constants[1]);
    eePtr->interp = interp;
    eePtr->callbackPtr = NULL;
    eePtr->corPtr = NULL;
    eePtr->rewind = 0;

    esPtr->prevPtr = NULL;
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941

1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1801
1802
1803
1804
1805
1806
1807































1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824

1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836

1837
1838
1839
1840

1841
1842
1843
1844
1845
1846
1847







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

















-












-
+



-







	 */

	TclGetIntFromObj(interp, incrPtr, &type1);
	Tcl_AddErrorInfo(interp, "\n    (reading increment)");
	return TCL_ERROR;
    }

    if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	long augend = *((const long *) ptr1);
	long addend = *((const long *) ptr2);
	long sum = augend + addend;

	/*
	 * Overflow when (augend and sum have different sign) and (augend and
	 * addend have the same sign). This is encapsulated in the Overflowing
	 * macro.
	 */

	if (!Overflowing(augend, addend, sum)) {
	    TclSetLongObj(valuePtr, sum);
	    return TCL_OK;
	}
#ifndef TCL_WIDE_INT_IS_LONG
	{
	    Tcl_WideInt w1 = (Tcl_WideInt) augend;
	    Tcl_WideInt w2 = (Tcl_WideInt) addend;

	    /*
	     * We know the sum value is outside the long range, so we use the
	     * macro form that doesn't range test again.
	     */

	    TclSetWideIntObj(valuePtr, w1 + w2);
	    return TCL_OK;
	}
#endif
    }

    if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
	/*
	 * Produce error message (reparse?!)
	 */

	return TclGetIntFromObj(interp, valuePtr, &type1);
    }
    if ((type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) {
	/*
	 * Produce error message (reparse?!)
	 */

	TclGetIntFromObj(interp, incrPtr, &type1);
	Tcl_AddErrorInfo(interp, "\n    (reading increment)");
	return TCL_ERROR;
    }

#ifndef TCL_WIDE_INT_IS_LONG
    if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
	Tcl_WideInt w1, w2, sum;

	TclGetWideIntFromObj(NULL, valuePtr, &w1);
	TclGetWideIntFromObj(NULL, incrPtr, &w2);
	sum = w1 + w2;

	/*
	 * Check for overflow.
	 */

	if (!Overflowing(w1, w2, sum)) {
	    Tcl_SetWideIntObj(valuePtr, sum);
	    TclSetIntObj(valuePtr, sum);
	    return TCL_OK;
	}
    }
#endif

    Tcl_TakeBignumFromObj(interp, valuePtr, &value);
    Tcl_GetBignumFromObj(interp, incrPtr, &incr);
    mp_add(&value, &incr, &value);
    mp_clear(&incr);
    Tcl_SetBignumObj(valuePtr, &value);
    return TCL_OK;
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689



2690
2691
2692
2693
2694
2695
2696
2575
2576
2577
2578
2579
2580
2581



2582
2583
2584
2585
2586
2587
2588
2589
2590
2591







-
-
-
+
+
+







	TRACE(("%u => OK\n", opnd));
	NEXT_INST_F(5, 0, 0);
    }

    case INST_STR_CONCAT1:

	opnd = TclGetUInt1AtPtr(pc+1);

	if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
		opnd, &OBJ_AT_DEPTH(opnd-1), &objResultPtr)) {
	objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
		TCL_STRING_IN_PLACE);
	if (objResultPtr == NULL) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(2, opnd, 1);

3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3517
3518
3519
3520
3521
3522
3523

3524

3525
3526
3527
3528
3529
3530
3531







-

-







     * common execution code.
     */

/*TODO: Consider more untangling here; merge with LOAD and STORE ? */

    {
	Tcl_Obj *incrPtr;
#ifndef TCL_WIDE_INT_IS_LONG
	Tcl_WideInt w;
#endif
	long increment;

    case INST_INCR_SCALAR1:
    case INST_INCR_ARRAY1:
    case INST_INCR_ARRAY_STK:
    case INST_INCR_SCALAR_STK:
    case INST_INCR_STK:
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732



3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744

3745
3746
3747
3748
3749

3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770

3771
3772
3773
3774

3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817

3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831

3832
3833
3834
3835
3836
3837
3838
3616
3617
3618
3619
3620
3621
3622



3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636

3637
3638
3639
3640
3641

3642
3643
3644
3645

3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661

3662
3663
3664


3665

































3666
3667
3668
3669
3670
3671
3672
3673
3674

3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688

3689
3690
3691
3692
3693
3694
3695
3696







-
-
-
+
+
+











-
+




-
+



-
















-
+


-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
+













-
+








	if (TclIsVarDirectModifyable(varPtr)) {
	    ClientData ptr;
	    int type;

	    objPtr = varPtr->value.objPtr;
	    if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
		if (type == TCL_NUMBER_LONG) {
		    long augend = *((const long *)ptr);
		    long sum = augend + increment;
		if (type == TCL_NUMBER_INT) {
		    Tcl_WideInt augend = *((const Tcl_WideInt *)ptr);
		    Tcl_WideInt sum = augend + increment;

		    /*
		     * Overflow when (augend and sum have different sign) and
		     * (augend and increment have the same sign). This is
		     * encapsulated in the Overflowing macro.
		     */

		    if (!Overflowing(augend, increment, sum)) {
			TRACE(("%u %ld => ", opnd, increment));
			if (Tcl_IsShared(objPtr)) {
			    objPtr->refCount--;	/* We know it's shared. */
			    TclNewLongObj(objResultPtr, sum);
			    TclNewIntObj(objResultPtr, sum);
			    Tcl_IncrRefCount(objResultPtr);
			    varPtr->value.objPtr = objResultPtr;
			} else {
			    objResultPtr = objPtr;
			    TclSetLongObj(objPtr, sum);
			    TclSetIntObj(objPtr, sum);
			}
			goto doneIncr;
		    }
#ifndef TCL_WIDE_INT_IS_LONG
		    w = (Tcl_WideInt)augend;

		    TRACE(("%u %ld => ", opnd, increment));
		    if (Tcl_IsShared(objPtr)) {
			objPtr->refCount--;	/* We know it's shared. */
			objResultPtr = Tcl_NewWideIntObj(w+increment);
			Tcl_IncrRefCount(objResultPtr);
			varPtr->value.objPtr = objResultPtr;
		    } else {
			objResultPtr = objPtr;

			/*
			 * We know the sum value is outside the long range;
			 * use macro form that doesn't range test again.
			 */

			TclSetWideIntObj(objPtr, w+increment);
			TclSetIntObj(objPtr, w+increment);
		    }
		    goto doneIncr;
#endif
		}	/* end if (type == TCL_NUMBER_LONG) */
		}	/* end if (type == TCL_NUMBER_INT) */
#ifndef TCL_WIDE_INT_IS_LONG
		if (type == TCL_NUMBER_WIDE) {
		    Tcl_WideInt sum;

		    w = *((const Tcl_WideInt *) ptr);
		    sum = w + increment;

		    /*
		     * Check for overflow.
		     */

		    if (!Overflowing(w, increment, sum)) {
			TRACE(("%u %ld => ", opnd, increment));
			if (Tcl_IsShared(objPtr)) {
			    objPtr->refCount--;	/* We know it's shared. */
			    objResultPtr = Tcl_NewWideIntObj(sum);
			    Tcl_IncrRefCount(objResultPtr);
			    varPtr->value.objPtr = objResultPtr;
			} else {
			    objResultPtr = objPtr;

			    /*
			     * We *do not* know the sum value is outside the
			     * long range (wide + long can yield long); use
			     * the function call that checks range.
			     */

			    Tcl_SetWideIntObj(objPtr, sum);
			}
			goto doneIncr;
		    }
		}
#endif
	    }
	    if (Tcl_IsShared(objPtr)) {
		objPtr->refCount--;	/* We know it's shared */
		objResultPtr = Tcl_DuplicateObj(objPtr);
		Tcl_IncrRefCount(objResultPtr);
		varPtr->value.objPtr = objResultPtr;
	    } else {
		objResultPtr = objPtr;
	    }
	    TclNewLongObj(incrPtr, increment);
	    TclNewIntObj(incrPtr, increment);
	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
		Tcl_DecrRefCount(incrPtr);
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    Tcl_DecrRefCount(incrPtr);
	    goto doneIncr;
	}

	/*
	 * All other cases, flow through to generic handling.
	 */

	TclNewLongObj(incrPtr, increment);
	TclNewIntObj(incrPtr, increment);
	Tcl_IncrRefCount(incrPtr);

    doIncrScalar:
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
4028
4029
4030
4031
4032
4033
4034
4035


4036
4037
4038
4039
4040
4041
4042
3886
3887
3888
3889
3890
3891
3892

3893
3894
3895
3896
3897
3898
3899
3900
3901







-
+
+







	part2Ptr = OBJ_AT_TOS;
	arrayPtr = LOCAL(opnd);
	while (TclIsVarLink(arrayPtr)) {
	    arrayPtr = arrayPtr->value.linkPtr;
	}
	TRACE(("%s %u \"%.30s\" => ",
		(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)
		&& !(arrayPtr->flags & VAR_SEARCH_ACTIVE)) {
	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
	    if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
		/*
		 * No nasty traces and element exists, so we can proceed to
		 * unset it. Might still not exist though...
		 */

4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163


4164
4165
4166
4167
4168
4169




4170
4171
4172
4173
4174
4175
4176
4177
4012
4013
4014
4015
4016
4017
4018




4019
4020






4021
4022
4023
4024

4025
4026
4027
4028
4029
4030
4031







-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
-







	pcAdjustment = 1;
	cleanup = 1;
	part1Ptr = OBJ_AT_TOS;
	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
	varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL,
		/*createPart1*/0, /*createPart2*/0, &arrayPtr);
    doArrayExists:
	if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
		&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	    DECACHE_STACK_INFO();
	    result = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
	DECACHE_STACK_INFO();
	result = TclCheckArrayTraces(interp, varPtr, arrayPtr, part1Ptr, opnd);
		    NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|
		    TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);
	    CACHE_STACK_INFO();
	    if (result == TCL_ERROR) {
		TRACE_ERROR(interp);
		goto gotError;
	CACHE_STACK_INFO();
	if (result == TCL_ERROR) {
	    TRACE_ERROR(interp);
	    goto gotError;
	    }
	}
	if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	    objResultPtr = TCONST(1);
	} else {
	    objResultPtr = TCONST(0);
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
4212
4213
4214
4215
4216
4217
4218
4219

4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4066
4067
4068
4069
4070
4071
4072

4073



4074
4075
4076
4077
4078
4079
4080







-
+
-
-
-







			"variable isn't array", opnd);
		DECACHE_STACK_INFO();
		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    TclSetVarArray(varPtr);
	    TclInitArrayVar(varPtr);
	    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
	    TclInitVarHashTable(varPtr->value.tablePtr,
		    TclGetVarNsPtr(varPtr));
#ifdef TCL_COMPILE_DEBUG
	    TRACE_APPEND(("done\n"));
	} else {
	    TRACE_APPEND(("nothing to do\n"));
#endif
	}
	NEXT_INST_V(pcAdjustment, cleanup, 0);
4522
4523
4524
4525
4526
4527
4528
4529

4530
4531
4532
4533
4534
4535
4536
4373
4374
4375
4376
4377
4378
4379

4380
4381
4382
4383
4384
4385
4386
4387







-
+







	    Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr,
		    objResultPtr);
	}
	TRACE_WITH_OBJ(("=> "), objResultPtr);
	NEXT_INST_F(1, 0, 1);
    }
    case INST_INFO_LEVEL_NUM:
	TclNewLongObj(objResultPtr, iPtr->varFramePtr->level);
	TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
	TRACE_WITH_OBJ(("=> "), objResultPtr);
	NEXT_INST_F(1, 0, 1);
    case INST_INFO_LEVEL_ARGS: {
	int level;
	register CallFrame *framePtr = iPtr->varFramePtr;
	register CallFrame *rootFramePtr = iPtr->rootFramePtr;

4891
4892
4893
4894
4895
4896
4897
4898

4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913

4914
4915
4916
4917
4918
4919
4920
4742
4743
4744
4745
4746
4747
4748

4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763

4764
4765
4766
4767
4768
4769
4770
4771







-
+














-
+








    case INST_LIST_LENGTH:
	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
	if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TclNewLongObj(objResultPtr, length);
	TclNewIntObj(objResultPtr, length);
	TRACE_APPEND(("%d\n", length));
	NEXT_INST_F(1, 1, 1);

    case INST_LIST_INDEX:	/* lindex with objc == 3 */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Extract the desired list element.
	 */

	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& (value2Ptr->typePtr != &tclListType)
		&& (TclGetIntForIndexM(NULL , value2Ptr, objc-1,
		&& (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
			&index) == TCL_OK)) {
	    TclDecrRefCount(value2Ptr);
	    tosPtr--;
	    pcAdjustment = 1;
	    goto lindexFastPath;
	}

4948
4949
4950
4951
4952
4953
4954
4955
4956
4957

4958
4959
4960
4961
4962
4963

4964
4965
4966
4967
4968
4969
4970
4971
4799
4800
4801
4802
4803
4804
4805



4806

4807




4808

4809
4810
4811
4812
4813
4814
4815







-
-
-
+
-

-
-
-
-
+
-







	 */

	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/*
	 * Select the list item based on the index. Negative operand means
	 * end-based indexing.
	/* Decode end-offset index values. */
	 */

	if (opnd < -1) {
	    index = opnd+1 + objc;
	} else {
	    index = opnd;
	index = TclIndexDecode(opnd, objc - 1);
	}
	pcAdjustment = 5;

    lindexFastPath:
	if (index >= 0 && index < objc) {
	    objResultPtr = objv[index];
	} else {
	    TclNewObj(objResultPtr);
5085
5086
5087
5088
5089
5090
5091
5092

5093
5094
5095
5096

5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116


5117
5118
5119
5120



5121
5122
5123

5124
5125
5126
5127
5128


5129
5130


5131
5132

5133
5134
5135

5136
5137

5138
5139
5140
5141


5142
5143
5144
5145
5146



5147
5148
5149
5150
5151
5152
5153



















5154




5155
5156
5157
5158
5159
5160
5161
4929
4930
4931
4932
4933
4934
4935

4936
4937
4938
4939

4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955





4956
4957




4958
4959
4960



4961





4962
4963


4964
4965


4966



4967
4968

4969




4970
4971





4972
4973
4974







4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005







-
+



-
+















-
-
-
-
-
+
+
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
+
+
-
-
+
+
-
-
+
-
-
-
+

-
+
-
-
-
-
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+







	valuePtr = OBJ_AT_TOS;
	fromIdx = TclGetInt4AtPtr(pc+1);
	toIdx = TclGetInt4AtPtr(pc+5);
	TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), TclGetInt4AtPtr(pc+1),
		TclGetInt4AtPtr(pc+5)));

	/*
	 * Get the contents of the list, making sure that it really is a list
	 * Get the length of the list, making sure that it really is a list
	 * in the process.
	 */

	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
	if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/*
	 * Skip a lot of work if we're about to throw the result away (common
	 * with uses of [lassign]).
	 */

#ifndef TCL_COMPILE_DEBUG
	if (*(pc+9) == INST_POP) {
	    NEXT_INST_F(10, 1, 0);
	}
#endif

	/*
	 * Adjust the indices for end-based handling.
	 */

	if (fromIdx < -1) {
	/* Every range of an empty list is an empty list */
	if (objc == 0) {
	    fromIdx += 1+objc;
	    if (fromIdx < -1) {
		fromIdx = -1;
	    }
	    TRACE_APPEND(("\n"));
	    NEXT_INST_F(9, 0, 0);
	}
	} else if (fromIdx > objc) {
	    fromIdx = objc;
	}

	if (toIdx < -1) {
	    toIdx += 1 + objc;
	    if (toIdx < -1) {
		toIdx = -1;
	    }
	/* Decode index value operands. */

	} else if (toIdx > objc) {
	    toIdx = objc;
	/*
	assert ( toIdx != TCL_INDEX_AFTER);
	}

	 *
	/*
	 * Check if we are referring to a valid, non-empty list range, and if
	 * so, build the list of elements in that range.
	 * Extra safety for legacy bytecodes:
	 */

	if (toIdx == TCL_INDEX_AFTER) {
	if (fromIdx<=toIdx && fromIdx<objc && toIdx>=0) {
	    if (fromIdx < 0) {
		fromIdx = 0;
	    }
	    toIdx = TCL_INDEX_END;
	}
	    if (toIdx >= objc) {
		toIdx = objc-1;
	    }
	    if (fromIdx == 0 && toIdx != objc-1 && !Tcl_IsShared(valuePtr)) {
		Tcl_ListObjReplace(interp, valuePtr,

	if ((toIdx == TCL_INDEX_BEFORE) || (fromIdx == TCL_INDEX_AFTER)) {
	emptyList:
			toIdx + 1, LIST_MAX, 0, NULL);
		TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
		NEXT_INST_F(9, 0, 0);
	    }
	    objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
	} else {
	    TclNewObj(objResultPtr);
	    objResultPtr = Tcl_NewObj();
	    TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	    NEXT_INST_F(9, 1, 1);
	}
	toIdx = TclIndexDecode(toIdx, objc - 1);
	if (toIdx < 0) {
	    goto emptyList;
	} else if (toIdx >= objc) {
	    toIdx = objc - 1;
	}

	assert ( toIdx >= 0 && toIdx < objc);
	/*
	assert ( fromIdx != TCL_INDEX_BEFORE );
	 *
	 * Extra safety for legacy bytecodes:
	 */
	if (fromIdx == TCL_INDEX_BEFORE) {
	    fromIdx = TCL_INDEX_START;
	}

	fromIdx = TclIndexDecode(fromIdx, objc - 1);

	objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);

	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
	value2Ptr = OBJ_AT_TOS;
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252

5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314

5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5081
5082
5083
5084
5085
5086
5087









5088


5089
5090


























































5091











5092
5093
5094
5095
5096
5097
5098







-
-
-
-
-
-
-
-
-
+
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-







    case INST_STR_EQ:
    case INST_STR_NEQ:		/* String (in)equality check */
    case INST_STR_CMP:		/* String compare. */
    stringCompare:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	if (valuePtr == value2Ptr) {
	    match = 0;
	} else {
	    /*
	     * We only need to check (in)equality when we have equal length
	     * strings.  We can use memcmp in all (n)eq cases because we
	     * don't need to worry about lexical LE/BE variance.
	     */

	{
	    typedef int (*memCmpFn_t)(const void*, const void*, size_t);
	    memCmpFn_t memCmpFn;
	    int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
		    || (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));

	    if (TclIsPureByteArray(valuePtr)
		    && TclIsPureByteArray(value2Ptr)) {
		s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
		s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
		memCmpFn = memcmp;
	    } else if ((valuePtr->typePtr == &tclStringType)
		    && (value2Ptr->typePtr == &tclStringType)) {
		/*
		 * Do a unicode-specific comparison if both of the args are of
		 * String type. If the char length == byte length, we can do a
		 * memcmp. In benchmark testing this proved the most efficient
		 * check between the unicode and string comparison operations.
		 */

		s1len = Tcl_GetCharLength(valuePtr);
		s2len = Tcl_GetCharLength(value2Ptr);
		if ((s1len == valuePtr->length)
			&& (valuePtr->bytes != NULL)
			&& (s2len == value2Ptr->length)
			&& (value2Ptr->bytes != NULL)) {
		    s1 = valuePtr->bytes;
		    s2 = value2Ptr->bytes;
		    memCmpFn = memcmp;
		} else {
		    s1 = (char *) Tcl_GetUnicode(valuePtr);
		    s2 = (char *) Tcl_GetUnicode(value2Ptr);
		    if (
#ifdef WORDS_BIGENDIAN
			1
#else
			checkEq
#endif
			) {
			memCmpFn = memcmp;
			s1len *= sizeof(Tcl_UniChar);
			s2len *= sizeof(Tcl_UniChar);
		    } else {
			memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
		    }
		}
	    } else {
		/*
		 * strcmp can't do a simple memcmp in order to handle the
		 * special Tcl \xC0\x80 null encoding for utf-8.
		 */

		s1 = TclGetStringFromObj(valuePtr, &s1len);
		s2 = TclGetStringFromObj(value2Ptr, &s2len);
		if (checkEq) {
		    memCmpFn = memcmp;
		} else {
		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
		}
	    }

	    if (checkEq && (s1len != s2len)) {
		match = 1;
	    match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, -1);
	    } else {
		/*
		 * The comparison function should compare up to the minimum
		 * byte length only.
		 */
		match = memCmpFn(s1, s2,
			(size_t) ((s1len < s2len) ? s1len : s2len));
		if (match == 0) {
		    match = s1len - s2len;
		}
	    }
	}

	/*
	 * Make sure only -1,0,1 is returned
	 * TODO: consider peephole opt.
	 */

5362
5363
5364
5365
5366
5367
5368
5369

5370
5371
5372
5373
5374
5375
5376
5128
5129
5130
5131
5132
5133
5134

5135
5136
5137
5138
5139
5140
5141
5142







-
+







	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
		(match < 0 ? -1 : match > 0 ? 1 : 0)));
	JUMP_PEEPHOLE_F(match, 1, 2);

    case INST_STR_LEN:
	valuePtr = OBJ_AT_TOS;
	length = Tcl_GetCharLength(valuePtr);
	TclNewLongObj(objResultPtr, length);
	TclNewIntObj(objResultPtr, length);
	TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_UPPER:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
5442
5443
5444
5445
5446
5447
5448
5449
5450


5451
5452
5453
5454
5455
5456
5457
5458
5459









5460
5461
5462
5463
5464
5465
5466
5208
5209
5210
5211
5212
5213
5214


5215
5216
5217
5218
5219
5220
5221
5222



5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238







-
-
+
+






-
-
-
+
+
+
+
+
+
+
+
+







	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
	} else if (valuePtr->bytes && length == valuePtr->length) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[TCL_UTF_MAX];
	    Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index);
	    char buf[4];
	    int ch = Tcl_GetUniChar(valuePtr, index);

	    /*
	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
	     * but creating the object as a string seems to be faster in
	     * practical use.
	     */

	    length = Tcl_UniCharToUtf(ch, buf);
	    objResultPtr = Tcl_NewStringObj(buf, length);
	    if (ch == -1) {
		objResultPtr = Tcl_NewObj();
	    } else {
		length = Tcl_UniCharToUtf(ch, buf);
		if (!length) {
		    length = Tcl_UniCharToUtf(-1, buf);
		}
		objResultPtr = Tcl_NewStringObj(buf, length);
	    }
	}

	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_RANGE:
	TRACE(("\"%.20s\" %.20s %.20s =>",
5491
5492
5493
5494
5495
5496
5497








5498
5499




5500


5501
5502


5503
5504
5505
5506


5507
5508
5509
5510
5511




5512
5513
5514
5515


5516



5517

5518











5519
5520
5521
5522

5523
5524
5525
5526
5527
5528
5529
5530

5531
5532
5533
5534
5535
5536

5537
5538
5539

5540
5541

5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555




5556
5557
5558
5559
5560




5561
5562


5563
5564
5565

5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586

5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608

5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278

5279
5280
5281
5282
5283
5284
5285


5286
5287




5288
5289





5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303

5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328

5329
5330
5331
5332
5333
5334

5335
5336
5337

5338
5339

5340
5341
5342
5343
5344
5345
5346
5347
5348
5349





5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362


5363
5364
5365
5366

5367
5368
5369
5370
5371
5372
5373















5374






















5375




5376


































5377
5378
5379
5380
5381
5382
5383







+
+
+
+
+
+
+
+

-
+
+
+
+

+
+
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
+
+
+
+




+
+

+
+
+
-
+

+
+
+
+
+
+
+
+
+
+
+




+







-
+





-
+


-
+

-
+









-
-
-
-
-
+
+
+
+





+
+
+
+
-
-
+
+


-
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    case INST_STR_RANGE_IMM:
	valuePtr = OBJ_AT_TOS;
	fromIdx = TclGetInt4AtPtr(pc+1);
	toIdx = TclGetInt4AtPtr(pc+5);
	length = Tcl_GetCharLength(valuePtr);
	TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx));

	/* Every range of an empty value is an empty value */
	if (length == 0) {
	    TRACE_APPEND(("\n"));
	    NEXT_INST_F(9, 0, 0);
	}

	/* Decode index operands. */

	/*
	 * Adjust indices for end-based indexing.
	assert ( toIdx != TCL_INDEX_BEFORE );
	assert ( toIdx != TCL_INDEX_AFTER);
	 *
	 * Extra safety for legacy bytecodes:
	 */
	if (toIdx == TCL_INDEX_BEFORE) {
	    goto emptyRange;

	if (fromIdx < -1) {
	}
	if (toIdx == TCL_INDEX_AFTER) {
	    fromIdx += 1 + length;
	    if (fromIdx < 0) {
		fromIdx = 0;
	    }
	    toIdx = TCL_INDEX_END;
	}
	} else if (fromIdx >= length) {
	    fromIdx = length;
	}
	if (toIdx < -1) {
	    toIdx += 1 + length;

	toIdx = TclIndexDecode(toIdx, length - 1);
	if (toIdx < 0) {
	    goto emptyRange;
	} else if (toIdx >= length) {
	    toIdx = length - 1;
	}

	assert ( toIdx >= 0 && toIdx < length );

	/*
	assert ( fromIdx != TCL_INDEX_BEFORE );
	assert ( fromIdx != TCL_INDEX_AFTER);
	 *
	 * Check if we can do a sane substring.
	 * Extra safety for legacy bytecodes:
	 */
	if (fromIdx == TCL_INDEX_BEFORE) {
	    fromIdx = TCL_INDEX_START;
	}
	if (fromIdx == TCL_INDEX_AFTER) {
	    goto emptyRange;
	}

	fromIdx = TclIndexDecode(fromIdx, length - 1);
	if (fromIdx < 0) {
	    fromIdx = 0;
	}

	if (fromIdx <= toIdx) {
	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
	} else {
	emptyRange:
	    TclNewObj(objResultPtr);
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    {
	Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
	int length3;
	int length3, endIdx;
	Tcl_Obj *value3Ptr;

    case INST_STR_REPLACE:
	value3Ptr = POP_OBJECT();
	valuePtr = OBJ_AT_DEPTH(2);
	length = Tcl_GetCharLength(valuePtr) - 1;
	endIdx = Tcl_GetCharLength(valuePtr) - 1;
	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx,
		    &fromIdx) != TCL_OK
	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx,
		    &toIdx) != TCL_OK) {
	    TclDecrRefCount(value3Ptr);
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();
	if (fromIdx < 0) {
	    fromIdx = 0;
	}

	if (fromIdx > toIdx || fromIdx > length) {

	if ((toIdx < 0) ||
		(fromIdx > endIdx) ||
		(toIdx < fromIdx)) {
	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
	    TclDecrRefCount(value3Ptr);
	    NEXT_INST_F(1, 0, 0);
	}

	if (fromIdx < 0) {
	    fromIdx = 0;
	}

	if (toIdx > length) {
	    toIdx = length;
	if (toIdx > endIdx) {
	    toIdx = endIdx;
	}

	if (fromIdx == 0 && toIdx == length) {
	if (fromIdx == 0 && toIdx == endIdx) {
	    TclDecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}

	length3 = Tcl_GetCharLength(value3Ptr);

	/*
	 * See if we can splice in place. This happens when the number of
	 * characters being replaced is the same as the number of characters
	 * in the string to be inserted.
	 */

	if (length3 - 1 == toIdx - fromIdx) {
	    unsigned char *bytes1, *bytes2;

	    if (Tcl_IsShared(valuePtr)) {
		objResultPtr = Tcl_DuplicateObj(valuePtr);
	    } else {
		objResultPtr = valuePtr;
	objResultPtr = TclStringReplace(interp, valuePtr, fromIdx,
	    }
	    if (TclIsPureByteArray(objResultPtr)
		    && TclIsPureByteArray(value3Ptr)) {
		bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
		bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
		memcpy(bytes1 + fromIdx, bytes2, length3);
	    } else {
		ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
		ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
		memcpy(ustring1 + fromIdx, ustring2,
			length3 * sizeof(Tcl_UniChar));
	    }
	    Tcl_InvalidateStringRep(objResultPtr);
	    TclDecrRefCount(value3Ptr);
	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	    if (objResultPtr == valuePtr) {
		NEXT_INST_F(1, 0, 0);
	    } else {
		NEXT_INST_F(1, 1, 1);
	    }
	}

		toIdx - fromIdx + 1, value3Ptr, TCL_STRING_IN_PLACE);
	/*
	 * Get the unicode representation; this is where we guarantee to lose
	 * bytearrays.
	 */

	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	length--;

	/*
	 * Remove substring using copying.
	 */

	objResultPtr = NULL;
	if (fromIdx > 0) {
	    objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
	}
	if (length3 > 0) {
	    if (objResultPtr) {
		Tcl_AppendObjToObj(objResultPtr, value3Ptr);
	    } else if (Tcl_IsShared(value3Ptr)) {
		objResultPtr = Tcl_DuplicateObj(value3Ptr);
	    } else {
		objResultPtr = value3Ptr;
	    }
	}
	if (toIdx < length) {
	    if (objResultPtr) {
		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			length - toIdx);
	    } else {
		objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
			length - toIdx);
	    }
	}
	if (objResultPtr == NULL) {
	    /* This has to be the case [string replace $s 0 end {}] */
	    /* which has result {} which is same as value3Ptr. */
	    objResultPtr = value3Ptr;
	}
	if (objResultPtr == value3Ptr) {
	    /* See [Bug 82e7f67325] */
	    TclDecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}
5713
5714
5715
5716
5717
5718
5719
5720

5721
5722
5723
5724

5725
5726
5727
5728
5729
5730
5731
5732

5733
5734
5735
5736
5737
5738
5739
5442
5443
5444
5445
5446
5447
5448

5449
5450
5451
5452

5453
5454
5455
5456
5457
5458
5459
5460

5461
5462
5463
5464
5465
5466
5467
5468







-
+



-
+







-
+







	}
    doneStringMap:
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
	match = TclStringFind(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
	match = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
	TclNewLongObj(objResultPtr, match);
	TclNewIntObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	match = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
	TclNewLongObj(objResultPtr, match);
	TclNewIntObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);
	valuePtr = OBJ_AT_TOS;
	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
		O2S(valuePtr)));
5815
5816
5817
5818
5819
5820
5821
5822

5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5544
5545
5546
5547
5548
5549
5550

5551





5552
5553
5554
5555
5556
5557
5558







-
+
-
-
-
-
-







	trim1 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &length);
	trim1 = TclTrimLeft(string1, length, string2, length2);
	trim1 = TclTrim(string1, length, string2, length2, &trim2);
	if (trim1 < length) {
	    trim2 = TclTrimRight(string1, length, string2, length2);
	} else {
	    trim2 = 0;
	}
    createTrimmedString:
	/*
	 * Careful here; trim set often contains non-ASCII characters so we
	 * take care when printing. [Bug 971cb4f1db]
	 */

#ifdef TCL_COMPILE_DEBUG
5898
5899
5900
5901
5902
5903
5904
5905

5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929

5930
5931
5932
5933

5934
5935
5936

5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949








5950
5951
5952
5953
5954
5955
5956
5622
5623
5624
5625
5626
5627
5628

5629
5630
5631
5632
5633

















5634
5635

5636
5637
5638
5639

5640
5641
5642

5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671







-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+



-
+


-
+













+
+
+
+
+
+
+
+







     * -----------------------------------------------------------------
     *	   Start of numeric operator instructions.
     */

    {
	ClientData ptr1, ptr2;
	int type1, type2;
	long l1, l2, lResult;
	Tcl_WideInt w1, w2, wResult;

    case INST_NUM_TYPE:
	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;
	} else if (type1 == TCL_NUMBER_LONG) {
	    /* value is between LONG_MIN and LONG_MAX */
	    /* [string is integer] is -UINT_MAX to UINT_MAX range */
	    int i;

	    if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
		type1 = TCL_NUMBER_WIDE;
	    }
#ifndef TCL_WIDE_INT_IS_LONG
	} else if (type1 == TCL_NUMBER_WIDE) {
	    /* value is between WIDE_MIN and WIDE_MAX */
	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
	    int i;
	    if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
		type1 = TCL_NUMBER_LONG;
	    }
#endif
	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
	    /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
	    Tcl_WideInt w;

	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_WIDE;
		type1 = TCL_NUMBER_INT;
	    }
	}
	TclNewLongObj(objResultPtr, type1);
	TclNewIntObj(objResultPtr, type1);
	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
	NEXT_INST_F(1, 1, 1);

    case INST_EQ:
    case INST_NEQ:
    case INST_LT:
    case INST_GT:
    case INST_LE:
    case INST_GE: {
	int iResult = 0, compare = 0;

	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.
	*/
	if (TclCheckEmptyString(valuePtr) > 0 || TclCheckEmptyString(value2Ptr) > 0) {
	    goto stringCompare;
	}

	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK
		|| GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
	    /*
	     * At least one non-numeric argument - compare as strings.
	     */

5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974




5975
5976
5977
5978
5979
5980
5981
5679
5680
5681
5682
5683
5684
5685




5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696







-
-
-
-
+
+
+
+







	    iResult = (*pc == INST_NEQ);
	    goto foundResult;
	}
	if (valuePtr == value2Ptr) {
	    compare = MP_EQ;
	    goto convertComparison;
	}
	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	    l1 = *((const long *)ptr1);
	    l2 = *((const long *)ptr2);
	    compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	    w2 = *((const Tcl_WideInt *)ptr2);
	    compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
	} else {
	    compare = TclCompareTwoNumbers(valuePtr, value2Ptr);
	}

	/*
	 * Turn comparison outcome into appropriate result for opcode.
	 */
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052



6053
6054
6055
6056

6057
6058
6059
6060

6061
6062
6063
6064
6065
6066
6067
6068
6069

6070
6071
6072
6073
6074
6075
6076
6077
6078
6079

6080
6081
6082
6083
6084
6085
6086
6087
6088
6089




6090
6091
6092


6093
6094
6095
6096

6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107

6108
6109
6110
6111
6112
6113
6114
6115
6116
6117

6118
6119
6120
6121
6122
6123
6124
6125
6126

6127
6128
6129

6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140


6141
6142
6143
6144

6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155

6156
6157
6158
6159
6160

6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175
6176
6177
6178

6179
6180
6181
6182
6183
6184
6185


6186
6187
6188


6189
6190
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201


6202
6203
6204


6205
6206
6207


6208
6209
6210
6211
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
5758
5759
5760
5761
5762
5763
5764



5765
5766
5767
5768
5769
5770

5771
5772
5773
5774

5775
5776
5777
5778
5779
5780
5781
5782
5783

5784
5785
5786
5787
5788
5789
5790
5791
5792
5793

5794
5795
5796
5797
5798
5799
5800




5801
5802
5803
5804
5805


5806
5807
5808
5809
5810

5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821

5822
5823
5824
5825
5826
5827
5828
5829
5830
5831

5832
5833
5834
5835
5836
5837
5838
5839
5840

5841
5842
5843

5844
5845
5846
5847
5848
5849
5850
5851
5852
5853


5854
5855
5856
5857
5858

5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869

5870
5871
5872
5873
5874

5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892

5893
5894
5895
5896
5897
5898


5899
5900
5901


5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914


5915
5916
5917


5918
5919
5920


5921
5922









5923
5924
5925
5926
5927
5928
5929







-
-
-
+
+
+



-
+



-
+








-
+









-
+






-
-
-
-
+
+
+
+

-
-
+
+



-
+










-
+









-
+








-
+


-
+









-
-
+
+



-
+










-
+




-
+

















-
+





-
-
+
+

-
-
+
+











-
-
+
+

-
-
+
+

-
-
+
+
-
-
-
-
-
-
-
-
-







	    goto gotError;
	}

	/*
	 * Check for common, simple case.
	 */

	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	    l1 = *((const long *)ptr1);
	    l2 = *((const long *)ptr2);
	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	    w2 = *((const Tcl_WideInt *)ptr2);

	    switch (*pc) {
	    case INST_MOD:
		if (l2 == 0) {
		if (w2 == 0) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
			    O2S(value2Ptr)));
		    goto divideByZero;
		} else if ((l2 == 1) || (l2 == -1)) {
		} else if ((w2 == 1) || (w2 == -1)) {
		    /*
		     * Div. by |1| always yields remainder of 0.
		     */

		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		} else if (l1 == 0) {
		} else if (w1 == 0) {
		    /*
		     * 0 % (non-zero) always yields remainder of 0.
		     */

		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		} else {
		    lResult = l1 / l2;
		    wResult = w1 / w2;

		    /*
		     * Force Tcl's integer division rules.
		     * TODO: examine for logic simplification
		     */

		    if ((lResult < 0 || (lResult == 0 &&
			    ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
			    (lResult * l2 != l1)) {
			lResult -= 1;
		    if ((wResult < 0 || (wResult == 0 &&
			    ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
			    (wResult * w2 != w1)) {
			wResult -= 1;
		    }
		    lResult = l1 - l2*lResult;
		    goto longResultOfArithmetic;
		    wResult = w1 - w2*wResult;
		    goto wideResultOfArithmetic;
		}

	    case INST_RSHIFT:
		if (l2 < 0) {
		if (w2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
		    goto gotError;
		} else if (l1 == 0) {
		} else if (w1 == 0) {
		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		} else {
		    /*
		     * Quickly force large right shifts to 0 or -1.
		     */

		    if (l2 >= (long)(CHAR_BIT*sizeof(long))) {
		    if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) {
			/*
			 * We assume that INT_MAX is much larger than the
			 * number of bits in a long. This is a pretty safe
			 * assumption, given that the former is usually around
			 * 4e9 and the latter 32 or 64...
			 */

			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
			if (l1 > 0L) {
			if (w1 > 0L) {
			    objResultPtr = TCONST(0);
			} else {
			    TclNewLongObj(objResultPtr, -1);
			    TclNewIntObj(objResultPtr, -1);
			}
			TRACE(("%s\n", O2S(objResultPtr)));
			NEXT_INST_F(1, 2, 1);
		    }

		    /*
		     * Handle shifts within the native long range.
		     */

		    lResult = l1 >> ((int) l2);
		    goto longResultOfArithmetic;
		    wResult = w1 >> ((int) w2);
		    goto wideResultOfArithmetic;
		}

	    case INST_LSHIFT:
		if (l2 < 0) {
		if (w2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
		    goto gotError;
		} else if (l1 == 0) {
		} else if (w1 == 0) {
		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		} else if (l2 > (long) INT_MAX) {
		} else if (w2 > INT_MAX) {
		    /*
		     * Technically, we could hold the value (1 << (INT_MAX+1))
		     * in an mp_int, but since we're using mp_mul_2d() to do
		     * the work, and it takes only an int argument, that's a
		     * good place to draw the line.
		     */

		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "integer value too large to represent", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			    "integer value too large to represent", NULL);
		    CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
		    goto gotError;
		} else {
		    int shift = (int) l2;
		    int shift = (int) w2;

		    /*
		     * Handle shifts within the native long range.
		     */

		    if ((size_t) shift < CHAR_BIT*sizeof(long) && (l1 != 0)
			    && !((l1>0 ? l1 : ~l1) &
		    if ((size_t) shift < CHAR_BIT*sizeof(long) && (w1 != 0)
			    && !((w1>0 ? w1 : ~w1) &
				-(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
			lResult = l1 << shift;
			goto longResultOfArithmetic;
			wResult = w1 << shift;
			goto wideResultOfArithmetic;
		    }
		}

		/*
		 * Too large; need to use the broken-out function.
		 */

		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		break;

	    case INST_BITAND:
		lResult = l1 & l2;
		goto longResultOfArithmetic;
		wResult = w1 & w2;
		goto wideResultOfArithmetic;
	    case INST_BITOR:
		lResult = l1 | l2;
		goto longResultOfArithmetic;
		wResult = w1 | w2;
		goto wideResultOfArithmetic;
	    case INST_BITXOR:
		lResult = l1 ^ l2;
	    longResultOfArithmetic:
		wResult = w1 ^ w2;
		goto wideResultOfArithmetic;
		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		if (Tcl_IsShared(valuePtr)) {
		    TclNewLongObj(objResultPtr, lResult);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		}
		TclSetLongObj(valuePtr, lResult);
		TRACE(("%s\n", O2S(valuePtr)));
		NEXT_INST_F(1, 1, 0);
	    }
	}

	/*
	 * DO NOT MERGE THIS WITH THE EQUIVALENT SECTION LATER! That would
	 * encourage the compiler to inline ExecuteExtendedBinaryMathOp, which
	 * is highly undesirable due to the overall impact on size.
6292
6293
6294
6295
6296
6297
6298
6299

6300
6301
6302
6303


6304
6305
6306
6307
6308
6309
6310
6311
6312
6313
6314
6315
6316
6317
6318
6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347

6348
6349
6350
6351
6352

6353
6354
6355
6356

6357
6358

6359
6360
6361
6362
6363

6364
6365
6366
6367
6368
6369
6370
6371
6372
6373




6374
6375

6376
6377
6378
6379
6380
6381
6382
6383
6384
6385








6386
6387
6388
6389
6390
6391
6392
5998
5999
6000
6001
6002
6003
6004

6005




6006
6007
6008
6009
6010


6011

6012
6013
6014
6015
6016
6017
6018

6019
6020
6021


6022

6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035

6036
6037
6038
6039
6040
6041
6042

6043
6044
6045
6046
6047

6048
6049
6050
6051

6052
6053

6054
6055
6056
6057
6058

6059
6060
6061
6062
6063
6064
6065




6066
6067
6068
6069
6070

6071
6072
6073








6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088







-
+
-
-
-
-
+
+



-
-

-







-



-
-

-













-







-
+




-
+



-
+

-
+




-
+






-
-
-
-
+
+
+
+

-
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







#endif

	/*
	 * Handle (long,long) arithmetic as best we can without going out to
	 * an external function.
	 */

	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
	    Tcl_WideInt w1, w2, wResult;

	    l1 = *((const long *)ptr1);
	    l2 = *((const long *)ptr2);
	    w1 = *((const Tcl_WideInt *)ptr1);
	    w2 = *((const Tcl_WideInt *)ptr2);

	    switch (*pc) {
	    case INST_ADD:
		w1 = (Tcl_WideInt) l1;
		w2 = (Tcl_WideInt) l2;
		wResult = w1 + w2;
#ifdef TCL_WIDE_INT_IS_LONG
		/*
		 * Check for overflow.
		 */

		if (Overflowing(w1, w2, wResult)) {
		    goto overflow;
		}
#endif
		goto wideResultOfArithmetic;

	    case INST_SUB:
		w1 = (Tcl_WideInt) l1;
		w2 = (Tcl_WideInt) l2;
		wResult = w1 - w2;
#ifdef TCL_WIDE_INT_IS_LONG
		/*
		 * Must check for overflow. The macro tests for overflows in
		 * sums by looking at the sign bits. As we have a subtraction
		 * here, we are adding -w2. As -w2 could in turn overflow, we
		 * test with ~w2 instead: it has the opposite sign bit to w2
		 * so it does the job. Note that the only "bad" case (w2==0)
		 * is irrelevant for this macro, as in that case w1 and
		 * wResult have the same sign and there is no overflow anyway.
		 */

		if (Overflowing(w1, ~w2, wResult)) {
		    goto overflow;
		}
#endif
	    wideResultOfArithmetic:
		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		if (Tcl_IsShared(valuePtr)) {
		    objResultPtr = Tcl_NewWideIntObj(wResult);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		}
		Tcl_SetWideIntObj(valuePtr, wResult);
		TclSetIntObj(valuePtr, wResult);
		TRACE(("%s\n", O2S(valuePtr)));
		NEXT_INST_F(1, 1, 0);

	    case INST_DIV:
		if (l2 == 0) {
		if (w2 == 0) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n",
			    O2S(valuePtr), O2S(value2Ptr)));
		    goto divideByZero;
		} else if ((l1 == LONG_MIN) && (l2 == -1)) {
		} else if ((w1 == WIDE_MIN) && (w2 == -1)) {
		    /*
		     * Can't represent (-LONG_MIN) as a long.
		     * Can't represent (-WIDE_MIN) as a Tcl_WideInt.
		     */

		    goto overflow;
		}
		lResult = l1 / l2;
		wResult = w1 / w2;

		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification
		 */

		if (((lResult < 0) || ((lResult == 0) &&
			((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
			((lResult * l2) != l1)) {
		    lResult -= 1;
		if (((wResult < 0) || ((wResult == 0) &&
			((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
			((wResult * w2) != w1)) {
		    wResult -= 1;
		}
		goto longResultOfArithmetic;
		goto wideResultOfArithmetic;

	    case INST_MULT:
		if (((sizeof(long) >= 2*sizeof(int))
			&& (l1 <= INT_MAX) && (l1 >= INT_MIN)
			&& (l2 <= INT_MAX) && (l2 >= INT_MIN))
			|| ((sizeof(long) >= 2*sizeof(short))
			&& (l1 <= SHRT_MAX) && (l1 >= SHRT_MIN)
			&& (l2 <= SHRT_MAX) && (l2 >= SHRT_MIN))) {
		    lResult = l1 * l2;
		    goto longResultOfArithmetic;
		if (((sizeof(Tcl_WideInt) >= 2*sizeof(int))
			&& (w1 <= INT_MAX) && (w1 >= INT_MIN)
			&& (w2 <= INT_MAX) && (w2 >= INT_MIN))
			|| ((sizeof(Tcl_WideInt) >= 2*sizeof(short))
			&& (w1 <= SHRT_MAX) && (w1 >= SHRT_MIN)
			&& (w2 <= SHRT_MAX) && (w2 >= SHRT_MIN))) {
		    wResult = w1 * w2;
		    goto wideResultOfArithmetic;
		}
	    }

	    /*
	     * Fall through with INST_EXPON, INST_DIV and large multiplies.
	     */
	}
6445
6446
6447
6448
6449
6450
6451
6452
6453


6454
6455

6456
6457
6458
6459

6460
6461
6462
6463
6464
6465
6466
6141
6142
6143
6144
6145
6146
6147


6148
6149
6150

6151
6152
6153
6154

6155
6156
6157
6158
6159
6160
6161
6162







-
-
+
+

-
+



-
+







	    TRACE_APPEND(("ERROR: illegal type %s\n",
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	if (type1 == TCL_NUMBER_LONG) {
	    l1 = *((const long *) ptr1);
	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *) ptr1);
	    if (Tcl_IsShared(valuePtr)) {
		TclNewLongObj(objResultPtr, ~l1);
		TclNewIntObj(objResultPtr, ~w1);
		TRACE_APPEND(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 1, 1);
	    }
	    TclSetLongObj(valuePtr, ~l1);
	    TclSetIntObj(valuePtr, ~w1);
	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
	if (objResultPtr != NULL) {
	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491



6492
6493

6494
6495
6496
6497

6498
6499
6500
6501
6502
6503
6504
6178
6179
6180
6181
6182
6183
6184



6185
6186
6187
6188

6189
6190
6191
6192

6193
6194
6195
6196
6197
6198
6199
6200







-
-
-
+
+
+

-
+



-
+







	    goto gotError;
	}
	switch (type1) {
	case TCL_NUMBER_NAN:
	    /* -NaN => NaN */
	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	case TCL_NUMBER_LONG:
	    l1 = *((const long *) ptr1);
	    if (l1 != LONG_MIN) {
	case TCL_NUMBER_INT:
	    w1 = *((const Tcl_WideInt *) ptr1);
	    if (w1 != WIDE_MIN) {
		if (Tcl_IsShared(valuePtr)) {
		    TclNewLongObj(objResultPtr, -l1);
		    TclNewIntObj(objResultPtr, -w1);
		    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 1, 1);
		}
		TclSetLongObj(valuePtr, -l1);
		TclSetIntObj(valuePtr, -w1);
		TRACE_APPEND(("%s\n", O2S(valuePtr)));
		NEXT_INST_F(1, 0, 0);
	    }
	    /* FALLTHROUGH */
	}
	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
	if (objResultPtr != NULL) {
6634
6635
6636
6637
6638
6639
6640
6641


6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658

6659
6660
6661

6662
6663
6664
6665
6666
6667
6668
6330
6331
6332
6333
6334
6335
6336

6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354

6355
6356
6357

6358
6359
6360
6361
6362
6363
6364
6365







-
+
+
















-
+


-
+







	goto processExceptionReturn;

    {
	ForeachInfo *infoPtr;
	Var *iterVarPtr, *listVarPtr;
	Tcl_Obj *oldValuePtr, *listPtr, **elements;
	ForeachVarList *varListPtr;
	int numLists, iterNum, listTmpIndex, listLen, numVars;
	int numLists, listTmpIndex, listLen, numVars;
	size_t iterNum;
	int varIndex, valIndex, continueLoop, j, iterTmpIndex;
	long i;

    case INST_FOREACH_START4: /* DEPRECATED */
	/*
	 * Initialize the temporary local var that holds the count of the
	 * number of iterations of the loop body to -1.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
	iterTmpIndex = infoPtr->loopCtTemp;
	iterVarPtr = LOCAL(iterTmpIndex);
	oldValuePtr = iterVarPtr->value.objPtr;

	if (oldValuePtr == NULL) {
	    TclNewLongObj(iterVarPtr->value.objPtr, -1);
	    TclNewIntObj(iterVarPtr->value.objPtr, -1);
	    Tcl_IncrRefCount(iterVarPtr->value.objPtr);
	} else {
	    TclSetLongObj(oldValuePtr, -1);
	    TclSetIntObj(oldValuePtr, -1);
	}
	TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));

#ifndef TCL_COMPILE_DEBUG
	/*
	 * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately
	 * after INST_FOREACH_START4 - let us just fall through instead of
6688
6689
6690
6691
6692
6693
6694
6695
6696


6697
6698
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716

6717
6718
6719
6720
6721
6722
6723
6385
6386
6387
6388
6389
6390
6391


6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412

6413
6414
6415
6416
6417
6418
6419
6420







-
-
+
+



















-
+








	/*
	 * Increment the temp holding the loop iteration number.
	 */

	iterVarPtr = LOCAL(infoPtr->loopCtTemp);
	valuePtr = iterVarPtr->value.objPtr;
	iterNum = valuePtr->internalRep.longValue + 1;
	TclSetLongObj(valuePtr, iterNum);
	iterNum = (size_t)valuePtr->internalRep.wideValue + 1;
	TclSetIntObj(valuePtr, iterNum);

	/*
	 * Check whether all value lists are exhausted and we should stop the
	 * loop.
	 */

	continueLoop = 0;
	listTmpIndex = infoPtr->firstValueTemp;
	for (i = 0;  i < numLists;  i++) {
	    varListPtr = infoPtr->varLists[i];
	    numVars = varListPtr->numVars;

	    listVarPtr = LOCAL(listTmpIndex);
	    listPtr = listVarPtr->value.objPtr;
	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
		TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    if (listLen > iterNum * numVars) {
	    if ((size_t)listLen > iterNum * numVars) {
		continueLoop = 1;
	    }
	    listTmpIndex++;
	}

	/*
	 * If some var in some var list still has a remaining list element
6775
6776
6777
6778
6779
6780
6781
6782

6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800
6801
6802
6803
6804



6805
6806
6807
6808
6809
6810
6811
6472
6473
6474
6475
6476
6477
6478

6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499


6500
6501
6502
6503
6504
6505
6506
6507
6508
6509







-
+




















-
-
+
+
+







		    }
		    valIndex++;
		}
		TclDecrRefCount(listPtr);
		listTmpIndex++;
	    }
	}
	TRACE_APPEND(("%d lists, iter %d, %s loop\n",
	TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "d, %s loop\n",
		numLists, iterNum, (continueLoop? "continue" : "exit")));

	/*
	 * Run-time peep-hole optimisation: the compiler ALWAYS follows
	 * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
	 * instruction and jump direct from here.
	 */

	pc += 5;
	if (*pc == INST_JUMP_FALSE1) {
	    NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
	} else {
	    NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
	}

    }
    {
	ForeachInfo *infoPtr;
	Tcl_Obj *listPtr, **elements, *tmpPtr;
	ForeachVarList *varListPtr;
	int numLists, iterMax, listLen, numVars;
	int iterTmp, iterNum, listTmpDepth;
	int numLists, listLen, numVars;
	int listTmpDepth;
	size_t iterNum, iterMax, iterTmp;
	int varIndex, valIndex, j;
	long i;

    case INST_FOREACH_START:
	/*
	 * Initialize the data for the looping construct, pushing the
	 * corresponding Tcl_Objs to the stack.
6848
6849
6850
6851
6852
6853
6854
6855
6856


6857
6858
6859
6860
6861
6862
6863
6546
6547
6548
6549
6550
6551
6552


6553
6554
6555
6556
6557
6558
6559
6560
6561







-
-
+
+







	 * Store the iterNum and iterMax in a single Tcl_Obj; we keep a
	 * nul-string obj with the pointer stored in the ptrValue so that the
	 * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but
	 * it will never leave this scope and is read-only.
	 */

	TclNewObj(tmpPtr);
	tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
	tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
	tmpPtr->internalRep.twoPtrValue.ptr1 = NULL;
	tmpPtr->internalRep.twoPtrValue.ptr2 = (void *)iterMax;
	PUSH_OBJECT(tmpPtr); /* iterCounts object */

	/*
	 * Store a pointer to the ForeachInfo struct; same dirty trick
	 * as above
	 */

6881
6882
6883
6884
6885
6886
6887
6888
6889


6890
6891
6892
6893
6894
6895
6896
6897
6898
6899
6900
6901

6902
6903
6904
6905
6906
6907
6908
6579
6580
6581
6582
6583
6584
6585


6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598

6599
6600
6601
6602
6603
6604
6605
6606







-
-
+
+











-
+








	tmpPtr = OBJ_AT_TOS;
	infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE(("=> "));

	tmpPtr = OBJ_AT_DEPTH(1);
	iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
	iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
	iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1;
	iterMax = (size_t)tmpPtr->internalRep.twoPtrValue.ptr2;

	/*
	 * If some list still has a remaining list element iterate one more
	 * time. Assign to var the next element from its value list.
	 */

	if (iterNum < iterMax) {
	    /*
	     * Set the variables and jump back to run the body
	     */

	    tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
	    tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);

	    listTmpDepth = numLists + 1;

	    for (i = 0;  i < numLists;  i++) {
		varListPtr = infoPtr->varLists[i];
		numVars = varListPtr->numVars;

7022
7023
7024
7025
7026
7027
7028
7029

7030
7031
7032
7033
7034
7035
7036
6720
6721
6722
6723
6724
6725
6726

6727
6728
6729
6730
6731
6732
6733
6734







-
+








	TclNewObj(objPtr);
	Tcl_IncrRefCount(objPtr);
	iPtr->objResultPtr = objPtr;
	NEXT_INST_F(1, 0, -1);

    case INST_PUSH_RETURN_CODE:
	TclNewLongObj(objResultPtr, result);
	TclNewIntObj(objResultPtr, result);
	TRACE(("=> %u\n", result));
	NEXT_INST_F(1, 0, 1);

    case INST_PUSH_RETURN_OPTIONS:
	DECACHE_STACK_INFO();
	objResultPtr = Tcl_GetReturnOptions(interp, result);
	CACHE_STACK_INFO();
7688
7689
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7386
7387
7388
7389
7390
7391
7392

7393
7394
7395
7396
7397
7398
7399







-







	    case 3:		/* seconds */
		Tcl_GetTime(&now);
		wval = (Tcl_WideInt) now.sec;
		break;
	    default:
		Tcl_Panic("clockRead instruction with unknown clock#");
	    }
	    /* TclNewWideObj(objResultPtr, wval); doesn't exist */
	    objResultPtr = Tcl_NewWideIntObj(wval);
	    TRACE_WITH_OBJ(("=> "), objResultPtr);
	    NEXT_INST_F(2, 0, 1);
	}

    default:
	Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc);
8120
8121
8122
8123
8124
8125
8126
8127
8128
8129
8130
8131
8132
8133
8134
8135
8136
8137
8138
8139

8140
8141
8142
8143
8144
8145
8146
7817
7818
7819
7820
7821
7822
7823








7824
7825
7826
7827

7828
7829
7830
7831
7832
7833
7834
7835







-
-
-
-
-
-
-
-




-
+







ExecuteExtendedBinaryMathOp(
    Tcl_Interp *interp,		/* Where to report errors. */
    int opcode,			/* What operation to perform. */
    Tcl_Obj **constants,	/* The execution environment's constants. */
    Tcl_Obj *valuePtr,		/* The first operand on the stack. */
    Tcl_Obj *value2Ptr)		/* The second operand on the stack. */
{
#define LONG_RESULT(l) \
    if (Tcl_IsShared(valuePtr)) {		\
	TclNewLongObj(objResultPtr, l);		\
	return objResultPtr;			\
    } else {					\
	Tcl_SetLongObj(valuePtr, l);		\
	return NULL;				\
    }
#define WIDE_RESULT(w) \
    if (Tcl_IsShared(valuePtr)) {		\
	return Tcl_NewWideIntObj(w);		\
    } else {					\
	Tcl_SetWideIntObj(valuePtr, w);		\
	TclSetIntObj(valuePtr, w);		\
	return NULL;				\
    }
#define BIG_RESULT(b) \
    if (Tcl_IsShared(valuePtr)) {		\
	return Tcl_NewBignumObj(b);		\
    } else {					\
	Tcl_SetBignumObj(valuePtr, b);		\
8154
8155
8156
8157
8158
8159
8160
8161
8162
8163
8164
8165
8166
8167
8168
8169
8170
8171
8172
8173
8174
8175
8176
8177
8178




8179
8180
8181

8182
8183
8184
8185
8186
8187
8188
8189
8190

8191








8192
8193
8194
8195
8196
8197
8198
7843
7844
7845
7846
7847
7848
7849

7850
7851
7852
7853
7854
7855
7856
7857
7858
7859
7860
7861
7862




7863
7864
7865
7866
7867
7868

7869
7870
7871
7872
7873
7874
7875
7876


7877
7878
7879
7880
7881
7882
7883
7884
7885
7886
7887
7888
7889
7890
7891
7892
7893







-













-
-
-
-
+
+
+
+


-
+







-
-
+

+
+
+
+
+
+
+
+







	Tcl_SetDoubleObj(valuePtr, (d));	\
	return NULL;				\
    }

    int type1, type2;
    ClientData ptr1, ptr2;
    double d1, d2, dResult;
    long l1, l2, lResult;
    Tcl_WideInt w1, w2, wResult;
    mp_int big1, big2, bigResult, bigRemainder;
    Tcl_Obj *objResultPtr;
    int invalid, numPos, zero;
    long shift;

    (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
    (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);

    switch (opcode) {
    case INST_MOD:
	/* TODO: Attempts to re-use unshared operands on stack */

	l2 = 0;			/* silence gcc warning */
	if (type2 == TCL_NUMBER_LONG) {
	    l2 = *((const long *)ptr2);
	    if (l2 == 0) {
	w2 = 0;			/* silence gcc warning */
	if (type2 == TCL_NUMBER_INT) {
	    w2 = *((const Tcl_WideInt *)ptr2);
	    if (w2 == 0) {
		return DIVIDED_BY_ZERO;
	    }
	    if ((l2 == 1) || (l2 == -1)) {
	    if ((w2 == 1) || (w2 == -1)) {
		/*
		 * Div. by |1| always yields remainder of 0.
		 */

		return constants[0];
	    }
	}
#ifndef TCL_WIDE_INT_IS_LONG
	if (type1 == TCL_NUMBER_WIDE) {
	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *)ptr1);

	    if (w1 == 0) {
		/*
		 * 0 % (non-zero) always yields remainder of 0.
		 */

		return constants[0];
	    }
	    if (type2 != TCL_NUMBER_BIG) {
		Tcl_WideInt wQuotient, wRemainder;
		Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
		wQuotient = w1 / w2;

		/*
		 * Force Tcl's integer division rules.
8227
8228
8229
8230
8231
8232
8233
8234
8235
8236
8237
8238
8239
8240
8241
7922
7923
7924
7925
7926
7927
7928

7929
7930
7931
7932
7933
7934
7935







-







	    /*
	     * Arguments are same sign; remainder is first operand.
	     */

	    mp_clear(&big2);
	    return NULL;
	}
#endif
	Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	mp_init(&bigResult);
	mp_init(&bigRemainder);
	mp_div(&big1, &big2, &bigResult, &bigRemainder);
	if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) {
	    /*
8254
8255
8256
8257
8258
8259
8260
8261

8262
8263
8264
8265
8266
8267
8268
8269
8270
8271

8272
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287
8288

8289
8290
8291
8292
8293
8294
8295
8296
8297
8298
8299
8300
8301
8302


8303
8304
8305
8306
8307
8308
8309
8310
8311
8312
8313
8314

8315
8316
8317
8318
8319
8320
8321
8322
8323
8324
8325
8326
8327
8328
8329
8330
8331
8332
8333
8334
8335


8336
8337
8338
8339
8340
8341
8342
8343
8344
8345

8346
8347
8348
8349
8350
8351
8352
8353
8354
8355

8356
8357
8358
8359
8360
8361
8362
8363
8364
8365

8366
8367

8368
8369
8370
8371
8372
8373
8374

8375
8376
8377
8378
8379
8380

8381
8382
8383
8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395

8396
8397
8398
8399
8400
8401
8402
7948
7949
7950
7951
7952
7953
7954

7955




7956
7957

7958
7959

7960
7961
7962
7963
7964
7965
7966
7967
7968
7969
7970
7971
7972
7973
7974
7975
7976

7977
7978
7979
7980
7981
7982
7983
7984
7985
7986
7987
7988
7989


7990
7991
7992
7993
7994
7995
7996
7997
7998
7999
8000
8001
8002

8003
8004
8005
8006
8007
8008
8009
8010
8011
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022


8023
8024
8025
8026
8027
8028
8029
8030
8031
8032
8033

8034




8035
8036

8037
8038

8039
8040
8041
8042
8043
8044
8045
8046
8047
8048

8049
8050

8051
8052

8053
8054
8055
8056

8057
8058
8059
8060
8061
8062

8063
8064
8065
8066

8067
8068
8069
8070
8071
8072
8073
8074
8075
8076

8077
8078
8079
8080
8081
8082
8083
8084







-
+
-
-
-
-


-


-
+
















-
+












-
-
+
+











-
+



















-
-
+
+









-
+
-
-
-
-


-


-
+









-
+

-
+

-




-
+





-
+



-










-
+







    case INST_LSHIFT:
    case INST_RSHIFT: {
	/*
	 * Reject negative shift argument.
	 */

	switch (type2) {
	case TCL_NUMBER_LONG:
	case TCL_NUMBER_INT:
	    invalid = (*((const long *)ptr2) < 0L);
	    break;
#ifndef TCL_WIDE_INT_IS_LONG
	case TCL_NUMBER_WIDE:
	    invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
	    break;
#endif
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    invalid = (mp_cmp_d(&big2, 0) == MP_LT);
	    invalid = mp_isneg(&big2);
	    mp_clear(&big2);
	    break;
	default:
	    /* Unused, here to silence compiler warning */
	    invalid = 0;
	}
	if (invalid) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "negative shift argument", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}

	/*
	 * Zero shifted any number of bits is still zero.
	 */

	if ((type1==TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
	if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
	    return constants[0];
	}

	if (opcode == INST_LSHIFT) {
	    /*
	     * Large left shifts create integer overflow.
	     *
	     * BEWARE! Can't use Tcl_GetIntFromObj() here because that
	     * converts values in the (unsigned) range to their signed int
	     * counterparts, leading to incorrect results.
	     */

	    if ((type2 != TCL_NUMBER_LONG)
		    || (*((const long *)ptr2) > (long) INT_MAX)) {
	    if ((type2 != TCL_NUMBER_INT)
		    || (*((const Tcl_WideInt *)ptr2) > INT_MAX)) {
		/*
		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
		 * an mp_int, but since we're using mp_mul_2d() to do the
		 * work, and it takes only an int argument, that's a good
		 * place to draw the line.
		 */

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"integer value too large to represent", -1));
		return GENERAL_ARITHMETIC_ERROR;
	    }
	    shift = (int)(*((const long *)ptr2));
	    shift = (int)(*((const Tcl_WideInt *)ptr2));

	    /*
	     * Handle shifts within the native wide range.
	     */

	    if ((type1 != TCL_NUMBER_BIG)
		    && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
		TclGetWideIntFromObj(NULL, valuePtr, &w1);
		if (!((w1>0 ? w1 : ~w1)
			& -(((Tcl_WideInt)1)
			<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
		    WIDE_RESULT(w1 << shift);
		}
	    }
	} else {
	    /*
	     * Quickly force large right shifts to 0 or -1.
	     */

	    if ((type2 != TCL_NUMBER_LONG)
		    || (*(const long *)ptr2 > INT_MAX)) {
	    if ((type2 != TCL_NUMBER_INT)
		    || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) {
		/*
		 * Again, technically, the value to be shifted could be an
		 * mp_int so huge that a right shift by (INT_MAX+1) bits could
		 * not take us to the result of 0 or -1, but since we're using
		 * mp_div_2d to do the work, and it takes only an int
		 * argument, we draw the line there.
		 */

		switch (type1) {
		case TCL_NUMBER_LONG:
		case TCL_NUMBER_INT:
		    zero = (*(const long *)ptr1 > 0L);
		    break;
#ifndef TCL_WIDE_INT_IS_LONG
		case TCL_NUMBER_WIDE:
		    zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
		    break;
#endif
		case TCL_NUMBER_BIG:
		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
		    zero = (mp_cmp_d(&big1, 0) == MP_GT);
		    zero = (!mp_isneg(&big1));
		    mp_clear(&big1);
		    break;
		default:
		    /* Unused, here to silence compiler warning. */
		    zero = 0;
		}
		if (zero) {
		    return constants[0];
		}
		LONG_RESULT(-1);
		WIDE_RESULT(-1);
	    }
	    shift = (int)(*(const long *)ptr2);
	    shift = (int)(*(const Tcl_WideInt *)ptr2);

#ifndef TCL_WIDE_INT_IS_LONG
	    /*
	     * Handle shifts within the native wide range.
	     */

	    if (type1 == TCL_NUMBER_WIDE) {
	    if (type1 == TCL_NUMBER_INT) {
		w1 = *(const Tcl_WideInt *)ptr1;
		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
		    if (w1 >= (Tcl_WideInt)0) {
			return constants[0];
		    }
		    LONG_RESULT(-1);
		    WIDE_RESULT(-1);
		}
		WIDE_RESULT(w1 >> shift);
	    }
#endif
	}

	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);

	mp_init(&bigResult);
	if (opcode == INST_LSHIFT) {
	    mp_mul_2d(&big1, shift, &bigResult);
	} else {
	    mp_init(&bigRemainder);
	    mp_div_2d(&big1, shift, &bigResult, &bigRemainder);
	    if (mp_cmp_d(&bigRemainder, 0) == MP_LT) {
	    if (mp_isneg(&bigRemainder)) {
		/*
		 * Convert to Tcl's integer division rules.
		 */

		mp_sub_d(&bigResult, 1, &bigResult);
	    }
	    mp_clear(&bigRemainder);
8415
8416
8417
8418
8419
8420
8421
8422
8423


8424
8425
8426
8427
8428
8429

8430
8431
8432
8433
8434
8435
8436
8097
8098
8099
8100
8101
8102
8103


8104
8105
8106
8107
8108
8109
8110

8111
8112
8113
8114
8115
8116
8117
8118







-
-
+
+





-
+







	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);

	    /*
	     * Count how many positive arguments we have. If only one of the
	     * arguments is negative, store it in 'Second'.
	     */

	    if (mp_cmp_d(&big1, 0) != MP_LT) {
		numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT);
	    if (!mp_isneg(&big1)) {
		numPos = 1 + !mp_isneg(&big2);
		First = &big1;
		Second = &big2;
	    } else {
		First = &big2;
		Second = &big1;
		numPos = (mp_cmp_d(First, 0) != MP_LT);
		numPos = (!mp_isneg(First));
	    }
	    mp_init(&bigResult);

	    switch (opcode) {
	    case INST_BITAND:
		switch (numPos) {
		case 2:
8545
8546
8547
8548
8549
8550
8551
8552
8553

8554
8555
8556
8557
8558
8559
8560
8561
8562
8563
8564
8565
8566
8567
8568
8569
8570
8571
8572
8573
8574
8575


8576
8577
8578
8579

8580
8581
8582

8583
8584
8585

8586
8587
8588
8589

8590
8591

8592
8593
8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
8604
8605
8606
8607
8608
8609
8610




8611
8612
8613
8614
8615
8616

8617
8618
8619
8620
8621
8622
8623
8624
8625
8626

8627
8628
8629
8630
8631
8632
8633
8634
8635
8636
8637
8638
8639

8640
8641
8642
8643
8644
8645
8646
8647


8648
8649
8650
8651


8652
8653
8654
8655
8656
8657
8658
8659
8660

8661
8662
8663
8664
8665
8666
8667
8668
8669
8670
8671
8672
8673
8674
8675
8676
8677
8678
8679
8680
8681


8682
8683
8684
8685
8686
8687
8688
8689
8690
8691
8692
8693
8694
8695
8696
8697
8698

8699
8700
8701
8702
8703
8704
8705
8706
8707

8708
8709
8710
8711

8712
8713
8714
8715
8716
8717
8718


8719
8720
8721
8722
8723
8724
8725
8726
8727
8728


8729
8730
8731
8732
8733

8734
8735
8736
8737
8738
8739
8740
8741
8742
8743
8744
8745


8746
8747
8748
8749
8750
8751
8752
8753
8754
8755
8756
8757

8758
8759
8760
8761
8762
8763
8764
8765
8766
8767
8768
8769
8770
8771
8772
8773
8774
8775
8776
8777
8778
8779
8780
8781
8782
8783
8784
8785
8786
8787
8788
8789
8790
8791
8792
8793
8794
8795
8796
8797
8798
8799
8800
8801
8802
8803
8804
8805
8806
8807
8808
8809
8810
8811
8812
8813
8814
8815
8816
8817
8818
8819
8820

8821
8822
8823
8824
8825
8826
8827
8828
8829
8830
8831



8832
8833
8834
8835
8836
8837

8838
8839
8840
8841

8842
8843
8844
8845
8846
8847
8848
8227
8228
8229
8230
8231
8232
8233


8234
8235
8236
8237
8238
8239
8240
8241
8242
8243
8244
8245
8246
8247
8248
8249
8250
8251
8252
8253



8254
8255
8256
8257
8258

8259
8260
8261

8262
8263
8264

8265
8266
8267
8268

8269
8270

8271
8272
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286




8287
8288
8289
8290
8291
8292
8293
8294
8295

8296
8297
8298
8299
8300
8301
8302
8303
8304
8305

8306





8307
8308
8309
8310

8311
8312

8313
8314
8315
8316
8317
8318
8319


8320
8321
8322
8323


8324
8325
8326
8327
8328
8329
8330
8331
8332
8333

8334
8335
8336
8337
8338
8339
8340
8341
8342
8343
8344
8345
8346
8347
8348
8349
8350
8351
8352
8353


8354
8355
8356
8357
8358
8359
8360
8361
8362
8363
8364
8365
8366
8367
8368
8369
8370
8371

8372
8373
8374
8375
8376
8377
8378
8379
8380

8381
8382
8383
8384

8385
8386
8387
8388
8389
8390


8391
8392
8393
8394
8395
8396






8397
8398
8399

8400
8401

8402
8403
8404
8405
8406
8407
8408






8409
8410
8411

8412
8413








8414































































8415



8416

8417
8418
8419



8420
8421
8422
8423
8424
8425
8426
8427

8428
8429
8430
8431

8432
8433
8434
8435
8436
8437
8438
8439







-
-
+



















-
-
-
+
+



-
+


-
+


-
+



-
+

-
+















-
-
-
-
+
+
+
+





-
+









-
+
-
-
-
-
-




-


-
+






-
-
+
+


-
-
+
+








-
+



















-
-
+
+
















-
+








-
+



-
+





-
-
+
+




-
-
-
-
-
-
+
+

-


-
+






-
-
-
-
-
-
+
+

-


-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-

-



-
-
-
+
+
+





-
+



-
+







	    }

	    mp_clear(&big1);
	    mp_clear(&big2);
	    BIG_RESULT(&bigResult);
	}

#ifndef TCL_WIDE_INT_IS_LONG
	if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
	if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) {
	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);

	    switch (opcode) {
	    case INST_BITAND:
		wResult = w1 & w2;
		break;
	    case INST_BITOR:
		wResult = w1 | w2;
		break;
	    case INST_BITXOR:
		wResult = w1 ^ w2;
		break;
	    default:
		/* Unused, here to silence compiler warning. */
		wResult = 0;
	    }
	    WIDE_RESULT(wResult);
	}
#endif
	l1 = *((const long *)ptr1);
	l2 = *((const long *)ptr2);
	w1 = *((const Tcl_WideInt *)ptr1);
	w2 = *((const Tcl_WideInt *)ptr2);

	switch (opcode) {
	case INST_BITAND:
	    lResult = l1 & l2;
	    wResult = w1 & w2;
	    break;
	case INST_BITOR:
	    lResult = l1 | l2;
	    wResult = w1 | w2;
	    break;
	case INST_BITXOR:
	    lResult = l1 ^ l2;
	    wResult = w1 ^ w2;
	    break;
	default:
	    /* Unused, here to silence compiler warning. */
	    lResult = 0;
	    wResult = 0;
	}
	LONG_RESULT(lResult);
	WIDE_RESULT(wResult);

    case INST_EXPON: {
	int oddExponent = 0, negativeExponent = 0;
	unsigned short base;

	if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);

	    if (d1==0.0 && d2<0.0) {
		return EXPONENT_OF_ZERO;
	    }
	    dResult = pow(d1, d2);
	    goto doubleResult;
	}
	l1 = l2 = 0;
	if (type2 == TCL_NUMBER_LONG) {
	    l2 = *((const long *) ptr2);
	    if (l2 == 0) {
	w2 = 0;
	if (type2 == TCL_NUMBER_INT) {
	    w2 = *((const Tcl_WideInt *) ptr2);
	    if (w2 == 0) {
		/*
		 * Anything to the zero power is 1.
		 */

		return constants[1];
	    } else if (l2 == 1) {
	    } else if (w2 == 1) {
		/*
		 * Anything to the first power is itself
		 */

		return NULL;
	    }
	}

	switch (type2) {
	case TCL_NUMBER_LONG:
	case TCL_NUMBER_INT:
	    negativeExponent = (l2 < 0);
	    oddExponent = (int) (l2 & 1);
	    break;
#ifndef TCL_WIDE_INT_IS_LONG
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	    negativeExponent = (w2 < 0);
	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
	    break;
#endif
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
	    negativeExponent = mp_isneg(&big2);
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = !mp_iszero(&big2);
	    mp_clear(&big2);
	    break;
	}

	if (type1 == TCL_NUMBER_LONG) {
	    l1 = *((const long *)ptr1);
	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *)ptr1);
	}
	if (negativeExponent) {
	    if (type1 == TCL_NUMBER_LONG) {
		switch (l1) {
	    if (type1 == TCL_NUMBER_INT) {
		switch (w1) {
		case 0:
		    /*
		     * Zero to a negative power is div by zero error.
		     */

		    return EXPONENT_OF_ZERO;
		case -1:
		    if (oddExponent) {
			LONG_RESULT(-1);
			WIDE_RESULT(-1);
		    }
		    /* fallthrough */
		case 1:
		    /*
		     * 1 to any power is 1.
		     */

		    return constants[1];
		}
	    }

	    /*
	     * Integers with magnitude greater than 1 raise to a negative
	     * power yield the answer zero (see TIP 123).
	     */

	    return constants[0];
	}

	if (type1 == TCL_NUMBER_LONG) {
	    switch (l1) {
	if (type1 == TCL_NUMBER_INT) {
	    switch (w1) {
	    case 0:
		/*
		 * Zero to a positive power is zero.
		 */

		return constants[0];
	    case 1:
		/*
		 * 1 to any power is 1.
		 */

		return constants[1];
	    case -1:
		if (!oddExponent) {
		    return constants[1];
		}
		LONG_RESULT(-1);
		WIDE_RESULT(-1);
	    }
	}

	/*
	 * We refuse to accept exponent arguments that exceed one mp_digit
	 * which means the max exponent value is 2**28-1 = 0x0fffffff =
	 * 268435455, which fits into a signed 32 bit int which is within the
	 * range of the long int type. This means any numeric Tcl_Obj value
	 * not using TCL_NUMBER_LONG type must hold a value larger than we
	 * not using TCL_NUMBER_INT type must hold a value larger than we
	 * accept.
	 */

	if (type2 != TCL_NUMBER_LONG) {
	if (type2 != TCL_NUMBER_INT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}

	if (type1 == TCL_NUMBER_LONG) {
	    if (l1 == 2) {
	if (type1 == TCL_NUMBER_INT) {
	    if (w1 == 2) {
		/*
		 * Reduce small powers of 2 to shifts.
		 */

		if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
		    LONG_RESULT(1L << l2);
		}
#if !defined(TCL_WIDE_INT_IS_LONG)
		if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
		    WIDE_RESULT(((Tcl_WideInt) 1) << l2);
		if ((Tcl_WideUInt) w2 < (Tcl_WideUInt) CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
		    WIDE_RESULT(((Tcl_WideInt) 1) << (int)w2);
		}
#endif
		goto overflowExpon;
	    }
	    if (l1 == -2) {
	    if (w1 == -2) {
		int signum = oddExponent ? -1 : 1;

		/*
		 * Reduce small powers of 2 to shifts.
		 */

		if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
		    LONG_RESULT(signum * (1L << l2));
		}
#if !defined(TCL_WIDE_INT_IS_LONG)
		if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
		    WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2));
		if ((Tcl_WideUInt)w2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
		    WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2));
		}
#endif
		goto overflowExpon;
	    }
#if (LONG_MAX == 0x7fffffff)
	    if (l2 - 2 < (long)MaxBase32Size
		    && l1 <= MaxBase32[l2 - 2]
		    && l1 >= -MaxBase32[l2 - 2]) {
		/*
		 * Small powers of 32-bit integers.
		 */

	}
		lResult = l1 * l1;		/* b**2 */
		switch (l2) {
		case 2:
		    break;
		case 3:
		    lResult *= l1;		/* b**3 */
		    break;
		case 4:
		    lResult *= lResult;		/* b**4 */
		    break;
		case 5:
		    lResult *= lResult;		/* b**4 */
		    lResult *= l1;		/* b**5 */
		    break;
		case 6:
		    lResult *= l1;		/* b**3 */
		    lResult *= lResult;		/* b**6 */
		    break;
		case 7:
		    lResult *= l1;		/* b**3 */
		    lResult *= lResult;		/* b**6 */
		    lResult *= l1;		/* b**7 */
		    break;
		case 8:
		    lResult *= lResult;		/* b**4 */
		    lResult *= lResult;		/* b**8 */
		    break;
		}
		LONG_RESULT(lResult);
	    }

	    if (l1 - 3 >= 0 && l1 -2 < (long)Exp32IndexSize
		    && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
		base = Exp32Index[l1 - 3]
			+ (unsigned short) (l2 - 2 - MaxBase32Size);
		if (base < Exp32Index[l1 - 2]) {
		    /*
		     * 32-bit number raised to intermediate power, done by
		     * table lookup.
		     */

		    LONG_RESULT(Exp32Value[base]);
		}
	    }
	    if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize
		    && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
		base = Exp32Index[-l1 - 3]
			+ (unsigned short) (l2 - 2 - MaxBase32Size);
		if (base < Exp32Index[-l1 - 2]) {
		    /*
		     * 32-bit number raised to intermediate power, done by
		     * table lookup.
		     */

		    lResult = (oddExponent) ?
			    -Exp32Value[base] : Exp32Value[base];
		    LONG_RESULT(lResult);
		}
	    }
#endif
	}
#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
	if (type1 == TCL_NUMBER_LONG) {
	if (type1 == TCL_NUMBER_INT) {
	    w1 = l1;
#ifndef TCL_WIDE_INT_IS_LONG
	} else if (type1 == TCL_NUMBER_WIDE) {
	    w1 = *((const Tcl_WideInt *) ptr1);
#endif
	} else {
	    goto overflowExpon;
	}
	if (l2 - 2 < (long)MaxBase64Size
		&& w1 <=  MaxBase64[l2 - 2]
		&& w1 >= -MaxBase64[l2 - 2]) {
	if (w2 - 2 < (long)MaxBase64Size
		&& w1 <=  MaxBase64[w2 - 2]
		&& w1 >= -MaxBase64[w2 - 2]) {
	    /*
	     * Small powers of integers whose result is wide.
	     */

	    wResult = w1 * w1;		/* b**2 */
	    switch (l2) {
	    switch (w2) {
	    case 2:
		break;
	    case 3:
		wResult *= l1;		/* b**3 */
		wResult *= w1;		/* b**3 */
		break;
	    case 4:
		wResult *= wResult;	/* b**4 */
		break;
	    case 5:
		wResult *= wResult;	/* b**4 */
		wResult *= w1;		/* b**5 */
8911
8912
8913
8914
8915
8916
8917
8918

8919
8920

8921
8922
8923
8924
8925
8926
8927
8928
8929
8930
8931
8932

8933
8934

8935
8936
8937
8938
8939
8940
8941
8942
8943
8944
8945
8946
8947
8948
8949
8950
8951
8952
8502
8503
8504
8505
8506
8507
8508

8509
8510

8511
8512
8513
8514
8515
8516
8517
8518
8519
8520
8521
8522

8523
8524

8525
8526
8527
8528
8529
8530
8531
8532
8533
8534
8535

8536
8537
8538
8539
8540
8541
8542







-
+

-
+











-
+

-
+










-








	/*
	 * Handle cases of powers > 16 that still fit in a 64-bit word by
	 * doing table lookup.
	 */

	if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize
		&& l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
		&& w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
	    base = Exp64Index[w1 - 3]
		    + (unsigned short) (l2 - 2 - MaxBase64Size);
		    + (unsigned short) (w2 - 2 - MaxBase64Size);
	    if (base < Exp64Index[w1 - 2]) {
		/*
		 * 64-bit number raised to intermediate power, done by
		 * table lookup.
		 */

		WIDE_RESULT(Exp64Value[base]);
	    }
	}

	if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize
		&& l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
		&& w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
	    base = Exp64Index[-w1 - 3]
		    + (unsigned short) (l2 - 2 - MaxBase64Size);
		    + (unsigned short) (w2 - 2 - MaxBase64Size);
	    if (base < Exp64Index[-w1 - 2]) {
		/*
		 * 64-bit number raised to intermediate power, done by
		 * table lookup.
		 */

		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
		WIDE_RESULT(wResult);
	    }
	}
#endif

    overflowExpon:
	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	if (big2.used > 1) {
	    mp_clear(&big2);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
9018
9019
9020
9021
9022
9023
9024
9025
9026

9027
9028
9029
9030
9031
9032
9033
9034
9035
9036
9037
9038
9039
9040
9041
9042

9043
9044
9045
9046
9047
9048
9049
9050
9051
9052
9053
9054
9055
9056
9057
9058
9059
9060
9061
9062
9063

9064
9065
9066
9067
9068
9069
9070
9071
9072
9073
9074
9075
9076

9077
9078
9079

9080
9081
9082
9083
9084
9085
9086
8608
8609
8610
8611
8612
8613
8614


8615

8616
8617
8618
8619
8620
8621
8622
8623
8624
8625
8626
8627
8628


8629

8630
8631
8632
8633
8634
8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648

8649

8650
8651
8652
8653
8654
8655
8656
8657
8658
8659
8660

8661
8662
8663

8664
8665
8666
8667
8668
8669
8670
8671







-
-
+
-













-
-
+
-



















-
+
-











-
+


-
+







	if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);

	    switch (opcode) {
	    case INST_ADD:
		wResult = w1 + w2;
#ifndef TCL_WIDE_INT_IS_LONG
		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
		if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
#endif
		{
		    /*
		     * Check for overflow.
		     */

		    if (Overflowing(w1, w2, wResult)) {
			goto overflowBasic;
		    }
		}
		break;

	    case INST_SUB:
		wResult = w1 - w2;
#ifndef TCL_WIDE_INT_IS_LONG
		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
		if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
#endif
		{
		    /*
		     * Must check for overflow. The macro tests for overflows
		     * in sums by looking at the sign bits. As we have a
		     * subtraction here, we are adding -w2. As -w2 could in
		     * turn overflow, we test with ~w2 instead: it has the
		     * opposite sign bit to w2 so it does the job. Note that
		     * the only "bad" case (w2==0) is irrelevant for this
		     * macro, as in that case w1 and wResult have the same
		     * sign and there is no overflow anyway.
		     */

		    if (Overflowing(w1, ~w2, wResult)) {
			goto overflowBasic;
		    }
		}
		break;

	    case INST_MULT:
		if ((type1 != TCL_NUMBER_LONG) || (type2 != TCL_NUMBER_LONG)
		if ((w1 < INT_MIN) || (w1 > INT_MAX) || (w2 < INT_MIN) || (w2 > INT_MAX)) {
			|| (sizeof(Tcl_WideInt) < 2*sizeof(long))) {
		    goto overflowBasic;
		}
		wResult = w1 * w2;
		break;

	    case INST_DIV:
		if (w2 == 0) {
		    return DIVIDED_BY_ZERO;
		}

		/*
		 * Need a bignum to represent (LLONG_MIN / -1)
		 * Need a bignum to represent (WIDE_MIN / -1)
		 */

		if ((w1 == LLONG_MIN) && (w2 == -1)) {
		if ((w1 == WIDE_MIN) && (w2 == -1)) {
		    goto overflowBasic;
		}
		wResult = w1 / w2;

		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification
9160
9161
9162
9163
9164
9165
9166
9167
9168

9169
9170
9171
9172
9173
9174
9175
9176
9177
9178
9179
9180
9181
9182

9183
9184
9185
9186
9187
9188
9189
9190
9191
9192

9193
9194
9195
9196
9197
9198
9199
9200
9201
9202
9203
9204
9205
9206
9207
9208
9209
9210
9211
9212
9213
9214
9215
8745
8746
8747
8748
8749
8750
8751


8752
8753
8754
8755

8756
8757
8758
8759
8760
8761
8762
8763
8764

8765








8766

8767
8768
8769
8770
8771

8772
8773
8774
8775
8776
8777
8778
8779
8780
8781

8782
8783
8784
8785
8786
8787
8788







-
-
+



-









-
+
-
-
-
-
-
-
-
-

-
+




-










-







    mp_int big;
    Tcl_Obj *objResultPtr;

    (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);

    switch (opcode) {
    case INST_BITNOT:
#ifndef TCL_WIDE_INT_IS_LONG
	if (type == TCL_NUMBER_WIDE) {
	if (type == TCL_NUMBER_INT) {
	    w = *((const Tcl_WideInt *) ptr);
	    WIDE_RESULT(~w);
	}
#endif
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
	/* ~a = - a - 1 */
	mp_neg(&big, &big);
	mp_sub_d(&big, 1, &big);
	BIG_RESULT(&big);
    case INST_UMINUS:
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    DOUBLE_RESULT(-(*((const double *) ptr)));
	case TCL_NUMBER_LONG:
	case TCL_NUMBER_INT:
	    w = (Tcl_WideInt) (*((const long *) ptr));
	    if (w != LLONG_MIN) {
		WIDE_RESULT(-w);
	    }
	    TclInitBignumFromLong(&big, *(const long *) ptr);
	    break;
#ifndef TCL_WIDE_INT_IS_LONG
	case TCL_NUMBER_WIDE:
	    w = *((const Tcl_WideInt *) ptr);
	    if (w != LLONG_MIN) {
	    if (w != WIDE_MIN) {
		WIDE_RESULT(-w);
	    }
	    TclInitBignumFromWideInt(&big, w);
	    break;
#endif
	default:
	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
	}
	mp_neg(&big, &big);
	BIG_RESULT(&big);
    }

    Tcl_Panic("unexpected opcode");
    return NULL;
}
#undef LONG_RESULT
#undef WIDE_RESULT
#undef BIG_RESULT
#undef DOUBLE_RESULT

/*
 *----------------------------------------------------------------------
 *
9233
9234
9235
9236
9237
9238
9239
9240
9241
9242
9243
9244
9245
9246
9247
9248
9249
9250


9251
9252

9253
9254
9255
9256
9257
9258
9259
9260

9261

9262
9263
9264

9265
9266
9267
9268
9269
9270
9271
9272

9273
9274
9275
9276
9277
9278
9279
9280
9281
9282
9283
9284
9285
9286
9287
9288
9289

9290
9291
9292

9293
9294
9295
9296


9297
9298
9299

9300
9301
9302
9303
9304
9305
9306
9307
9308
9309
9310
9311
9312
9313
9314
9315
9316
9317
9318
9319
9320

9321
9322
9323
9324
9325
9326
9327
9328
9329
9330
9331
9332
9333
9334
9335
9336
9337
9338
9339
9340
9341
9342
9343
9344
9345
9346
9347
9348
9349
9350
9351
9352
9353
9354

9355
9356
9357
9358
9359
9360
9361
9362
9363
9364
9365
9366
9367
9368
9369
9370
9371
9372
9373
9374
9375
9376
9377

9378
9379
9380

9381
9382
9383
9384
9385
9386
9387
9388
9389
9390
9391
9392


9393
9394
9395
9396
9397
9398
9399
9400
9401
9402
9403
9404
9405
9406
9407
9408
9409
9410
9411
9412
9413
9414

9415
9416
9417
9418
9419
9420
9421
9422
9423
9424
9425
9426
9427

9428
9429
9430
9431
9432
9433
9434
8806
8807
8808
8809
8810
8811
8812


8813

8814
8815
8816
8817
8818


8819
8820
8821

8822





8823


8824

8825
8826
8827

8828
8829
8830
8831
8832
8833
8834
8835

8836
8837
8838
8839
8840
8841
8842
8843
8844
8845
8846
8847
8848
8849
8850
8851
8852

8853
8854
8855

8856
8857
8858


8859
8860
8861
8862

8863
8864
8865
8866
8867
8868
8869
8870
8871













8872



























8873
8874
8875
8876
8877
8878

8879
















8880
8881
8882
8883
8884
8885

8886
8887
8888

8889
8890
8891
8892
8893

8894
8895
8896
8897
8898


8899
8900
8901
8902
8903
8904
8905
8906
8907
8908
8909
8910
8911
8912
8913
8914
8915
8916
8917
8918
8919
8920


8921


8922
8923
8924
8925
8926
8927
8928
8929
8930
8931

8932
8933
8934
8935
8936
8937
8938
8939







-
-

-





-
-
+
+

-
+
-
-
-
-
-

-
-
+
-
+


-
+







-
+
















-
+


-
+


-
-
+
+


-
+








-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+


-
+




-





-
-
+
+




















-
-
+
-
-










-
+







    Tcl_Obj *valuePtr,
    Tcl_Obj *value2Ptr)
{
    int type1 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare;
    ClientData ptr1, ptr2;
    mp_int big1, big2;
    double d1, d2, tmp;
    long l1, l2;
#ifndef TCL_WIDE_INT_IS_LONG
    Tcl_WideInt w1, w2;
#endif

    (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
    (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);

    switch (type1) {
    case TCL_NUMBER_LONG:
	l1 = *((const long *)ptr1);
    case TCL_NUMBER_INT:
	w1 = *((const Tcl_WideInt *)ptr1);
	switch (type2) {
	case TCL_NUMBER_LONG:
	case TCL_NUMBER_INT:
	    l2 = *((const long *)ptr2);
	longCompare:
	    return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
#ifndef TCL_WIDE_INT_IS_LONG
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	    w1 = (Tcl_WideInt)l1;
	    goto wideCompare;
	wideCompare:
#endif
	    return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	    d1 = (double) l1;
	    d1 = (double) w1;

	    /*
	     * If the double has a fractional part, or if the long can be
	     * converted to double without loss of precision, then compare as
	     * doubles.
	     */

	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l1 == (long) d1
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) || w1 == (Tcl_WideInt) d1
		    || modf(d2, &tmp) != 0.0) {
		goto doubleCompare;
	    }

	    /*
	     * Otherwise, to make comparision based on full precision, need to
	     * convert the double to a suitably sized integer.
	     *
	     * Need this to get comparsions like
	     *	  expr 20000000000000003 < 20000000000000004.0
	     * right. Converting the first argument to double will yield two
	     * double values that are equivalent within double precision.
	     * Converting the double to an integer gets done exactly, then
	     * integer comparison can tell the difference.
	     */

	    if (d2 < (double)LONG_MIN) {
	    if (d2 < (double)WIDE_MIN) {
		return MP_GT;
	    }
	    if (d2 > (double)LONG_MAX) {
	    if (d2 > (double)WIDE_MAX) {
		return MP_LT;
	    }
	    l2 = (long) d2;
	    goto longCompare;
	    w2 = (Tcl_WideInt) d2;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if (mp_cmp_d(&big2, 0) == MP_LT) {
	    if (mp_isneg(&big2)) {
		compare = MP_GT;
	    } else {
		compare = MP_LT;
	    }
	    mp_clear(&big2);
	    return compare;
	}

#ifndef TCL_WIDE_INT_IS_LONG
    case TCL_NUMBER_WIDE:
	w1 = *((const Tcl_WideInt *)ptr1);
	switch (type2) {
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	wideCompare:
	    return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
	case TCL_NUMBER_LONG:
	    l2 = *((const long *)ptr2);
	    w2 = (Tcl_WideInt)l2;
	    goto wideCompare;
	case TCL_NUMBER_DOUBLE:
    case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	    d1 = (double) w1;
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
		    || w1 == (Tcl_WideInt) d1 || modf(d2, &tmp) != 0.0) {
		goto doubleCompare;
	    }
	    if (d2 < (double)LLONG_MIN) {
		return MP_GT;
	    }
	    if (d2 > (double)LLONG_MAX) {
		return MP_LT;
	    }
	    w2 = (Tcl_WideInt) d2;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if (mp_cmp_d(&big2, 0) == MP_LT) {
		compare = MP_GT;
	    } else {
		compare = MP_LT;
	    }
	    mp_clear(&big2);
	    return compare;
	}
#endif

    case TCL_NUMBER_DOUBLE:
	d1 = *((const double *)ptr1);
	switch (type2) {
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	doubleCompare:
	    return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
	case TCL_NUMBER_LONG:
	case TCL_NUMBER_INT:
	    l2 = *((const long *)ptr2);
	    d2 = (double) l2;
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l2 == (long) d2
		    || modf(d1, &tmp) != 0.0) {
		goto doubleCompare;
	    }
	    if (d1 < (double)LONG_MIN) {
		return MP_LT;
	    }
	    if (d1 > (double)LONG_MAX) {
		return MP_GT;
	    }
	    l1 = (long) d1;
	    goto longCompare;
#ifndef TCL_WIDE_INT_IS_LONG
	case TCL_NUMBER_WIDE:
	    w2 = *((const Tcl_WideInt *)ptr2);
	    d2 = (double) w2;
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
		    || w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
		goto doubleCompare;
	    }
	    if (d1 < (double)LLONG_MIN) {
	    if (d1 < (double)WIDE_MIN) {
		return MP_LT;
	    }
	    if (d1 > (double)LLONG_MAX) {
	    if (d1 > (double)WIDE_MAX) {
		return MP_GT;
	    }
	    w1 = (Tcl_WideInt) d1;
	    goto wideCompare;
#endif
	case TCL_NUMBER_BIG:
	    if (TclIsInfinite(d1)) {
		return (d1 > 0.0) ? MP_GT : MP_LT;
	    }
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
		if (mp_cmp_d(&big2, 0) == MP_LT) {
	    if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
		if (mp_isneg(&big2)) {
		    compare = MP_GT;
		} else {
		    compare = MP_LT;
		}
		mp_clear(&big2);
		return compare;
	    }
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
		    && modf(d1, &tmp) != 0.0) {
		d2 = TclBignumToDouble(&big2);
		mp_clear(&big2);
		goto doubleCompare;
	    }
	    Tcl_InitBignumFromDouble(NULL, d1, &big1);
	    goto bigCompare;
	}

    case TCL_NUMBER_BIG:
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	switch (type2) {
#ifndef TCL_WIDE_INT_IS_LONG
	case TCL_NUMBER_WIDE:
	case TCL_NUMBER_INT:
#endif
	case TCL_NUMBER_LONG:
	    compare = mp_cmp_d(&big1, 0);
	    mp_clear(&big1);
	    return compare;
	case TCL_NUMBER_DOUBLE:
	    d2 = *((const double *)ptr2);
	    if (TclIsInfinite(d2)) {
		compare = (d2 > 0.0) ? MP_LT : MP_GT;
		mp_clear(&big1);
		return compare;
	    }
	    if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) {
	    if ((d2 < (double)WIDE_MAX) && (d2 > (double)WIDE_MIN)) {
		compare = mp_cmp_d(&big1, 0);
		mp_clear(&big1);
		return compare;
	    }
	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
		    && modf(d2, &tmp) != 0.0) {
		d1 = TclBignumToDouble(&big1);
9474
9475
9476
9477
9478
9479
9480
9481
9482
9483



9484
9485
9486
9487
9488
9489
9490
8979
8980
8981
8982
8983
8984
8985



8986
8987
8988
8989
8990
8991
8992
8993
8994
8995







-
-
-
+
+
+







PrintByteCodeInfo(
    register ByteCode *codePtr)	/* The bytecode whose summary is printed to
				 * stdout. */
{
    Proc *procPtr = codePtr->procPtr;
    Interp *iPtr = (Interp *) *codePtr->interpHandle;

    fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_LL_MODIFIER "u, epoch %" TCL_LL_MODIFIER "u, interp 0x%p (epoch %" TCL_LL_MODIFIER "u)\n",
	    codePtr, (Tcl_WideInt)codePtr->refCount, (Tcl_WideInt)codePtr->compileEpoch, iPtr,
	    (Tcl_WideInt)iPtr->compileEpoch);
    fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n",
	    codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,
	    iPtr->compileEpoch);

    fprintf(stdout, "  Source: ");
    TclPrintSource(stdout, codePtr->source, 60);

    fprintf(stdout, "\n  Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
	    codePtr->numCommands, codePtr->numSrcBytes,
	    codePtr->numCodeBytes, codePtr->numLitObjects,
9622
9623
9624
9625
9626
9627
9628








9629


9630
9631
9632
9633
9634
9635
9636
9637
9638
9639
9640

9641
9642
9643
9644
9645
9646
9647
9648
9127
9128
9129
9130
9131
9132
9133
9134
9135
9136
9137
9138
9139
9140
9141

9142
9143
9144
9145
9146
9147
9148
9149
9150
9151
9152
9153

9154

9155
9156
9157
9158
9159
9160
9161







+
+
+
+
+
+
+
+
-
+
+










-
+
-







    if (opcode == INST_EXPON) {
	operator = "**";
    } else if (opcode <= INST_LNOT) {
	operator = operatorStrings[opcode - INST_LOR];
    }

    if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
	int numBytes;
	const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);

	if (numBytes == 0) {
	    description = "empty string";
	} else if (TclCheckBadOctal(NULL, bytes)) {
	    description = "invalid octal number";
	} else {
	description = "non-numeric string";
	    description = "non-numeric string";
	}
    } else if (type == TCL_NUMBER_NAN) {
	description = "non-numeric floating-point value";
    } else if (type == TCL_NUMBER_DOUBLE) {
	description = "floating-point value";
    } else {
	/* TODO: No caller needs this. Eliminate? */
	description = "(big) integer";
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "can't use %s \"%s\" as operand of \"%s\"", description,
	    "can't use %s as operand of \"%s\"", description, operator));
	    Tcl_GetString(opndPtr), operator));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --

Changes to generic/tclFCmd.c.

236
237
238
239
240
241
242


243
244


245
246
247
248
249
250
251
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255







+
+


+
+







	Tcl_IncrRefCount(split);
	if (pobjc == 0) {
	    errno = ENOENT;
	    errfile = objv[i];
	    break;
	}
	for (j = 0; j < pobjc; j++) {
	    int errCount = 2;

	    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.
	     */

	    if (Tcl_FSStat(target, &statBuf) == 0) {
265
266
267
268
269
270
271
272
273
274







275
276
277
278
279




280
281
282
283
284
285
286
287
288








289
290
291
292
293
294
295
269
270
271
272
273
274
275



276
277
278
279
280
281
282





283
284
285
286









287
288
289
290
291
292
293
294
295
296
297
298
299
300
301







-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







	    } else if (Tcl_FSCreateDirectory(target) != TCL_OK) {
		/*
		 * Create might have failed because of being in a race
		 * condition with another process trying to create the same
		 * subdirectory.
		 */

		if (errno != EEXIST) {
		    errfile = target;
		    goto done;
		if (errno == EEXIST) {
		    /* Be aware other workers could delete it immediately after
		     * creation, so give this worker still one chance (repeat once),
		     * see [270f78ca95] for description of the race-condition.
		     * Don't repeat the create always (to avoid endless loop). */
		    if (--errCount > 0) {
			goto createDir;
		} else if ((Tcl_FSStat(target, &statBuf) == 0)
			&& S_ISDIR(statBuf.st_mode)) {
		    /*
		     * It is a directory that wasn't there before, so keep
		     * going without error.
		    }
		    /* Already tried, with delete in-between directly after
		     * creation, so just continue (assume created successful). */
		    goto nextPart;
		     */

		    Tcl_ResetResult(interp);
		} else {
		    errfile = target;
		    goto done;
		}
	    }

		}

		/* return with error */
		errfile = target;
		goto done;
	    }

	nextPart:
	    /*
	     * Forget about this sub-path.
	     */

	    Tcl_DecrRefCount(target);
	    target = NULL;
	}
359
360
361
362
363
364
365
366
367
368
369
370
371
372

373
374
375
376
377
378
379
380
365
366
367
368
369
370
371







372

373
374
375
376
377
378
379







-
-
-
-
-
-
-
+
-







	}

	/*
	 * Call lstat() to get info so can delete symbolic link itself.
	 */

	if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
	    /*
	     * Trying to delete a file that does not exist is not considered
	     * an error, just a no-op
	     */

	    if (errno != ENOENT) {
		result = TCL_ERROR;
	    result = TCL_ERROR;
	    }
	} else if (S_ISDIR(statBuf.st_mode)) {
	    /*
	     * We own a reference count on errorBuffer, if it was set as a
	     * result of this call.
	     */

	    result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
402
403
404
405
406
407
408






409
410



411
412
413
414
415

416
417
418
419
420
421
422
401
402
403
404
405
406
407
408
409
410
411
412
413


414
415
416
417
418
419
420

421
422
423
424
425
426
427
428







+
+
+
+
+
+
-
-
+
+
+




-
+







		}
	    }
	} 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_ERROR;

		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) {
	if (errfile == NULL) {
	    /*
	     * We try to accomodate poor error results from our Tcl_FS calls.

Changes to generic/tclFileName.c.

1877
1878
1879
1880
1881
1882
1883
1884

1885
1886
1887
1888
1889
1890
1891
1877
1878
1879
1880
1881
1882
1883

1884
1885
1886
1887
1888
1889
1890
1891







-
+







	 * ':' 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] == '/') {
	if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') {
	    pathPrefix = Tcl_NewStringObj(tail, 1);
	    tail++;
	    Tcl_IncrRefCount(pathPrefix);
	}
    }

    /*

Changes to generic/tclGet.c.

138
139
140
141
142
143
144
145

146
147
148
149
150
151
152
138
139
140
141
142
143
144

145
146
147
148
149
150
151
152







-
+







    obj.typePtr = NULL;

    code = TclSetBooleanFromAny(interp, &obj);
    if (obj.refCount > 1) {
	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
    }
    if (code == TCL_OK) {
	*boolPtr = obj.internalRep.longValue;
	TclGetBooleanFromObj(NULL, &obj, boolPtr);
    }
    return code;
}

/*
 * Local Variables:
 * mode: c

Changes to generic/tclGetDate.y.

893
894
895
896
897
898
899
900

901
902
903
904
905
906
907
893
894
895
896
897
898
899

900
901
902
903
904
905
906
907







-
+







    register char c;
    register char *p;
    char buff[20];
    int Count;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {
	while (isspace(UCHAR(*yyInput))) {
	while (TclIsSpaceProc(UCHAR(*yyInput))) {
	    yyInput++;
	}

	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
	    /*
	     * Convert the string into a number; count the number of digits.
	     */

Changes to generic/tclHistory.c.

69
70
71
72
73
74
75







76
77
78
79
80
81
82
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89







+
+
+
+
+
+
+







	 * Call Tcl_RecordAndEvalObj to do the actual work.
	 */

	cmdPtr = Tcl_NewStringObj(cmd, -1);
	Tcl_IncrRefCount(cmdPtr);
	result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);

	/*
	 * Move the interpreter's object result to the string result, then
	 * reset the object result.
	 */

	(void) Tcl_GetStringResult(interp);

	/*
	 * Discard the Tcl object created to hold the command.
	 */

	Tcl_DecrRefCount(cmdPtr);
    } else {
	/*

Changes to generic/tclIO.c.

478
479
480
481
482
483
484
485

486
487

488
489
490
491


492
493
494
495
496
497
498
478
479
480
481
482
483
484

485
486

487
488
489


490
491
492
493
494
495
496
497
498







-
+

-
+


-
-
+
+








    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
	    chanPtr->typePtr->wideSeekProc != NULL) {
	return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
		offset, mode, errnoPtr);
    }

    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
    if (offset<LONG_MIN || offset>LONG_MAX) {
	*errnoPtr = EOVERFLOW;
	return Tcl_LongAsWide(-1);
	return -1;
    }

    return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData,
	    Tcl_WideAsLong(offset), mode, errnoPtr));
    return chanPtr->typePtr->seekProc(chanPtr->instanceData,
	    offset, mode, errnoPtr);
}

static inline void
ChanThreadAction(
    Channel *chanPtr,
    int action)
{
717
718
719
720
721
722
723

724
725
726

727
728
729
730

731
732
733
734

735
736
737
738
739
740
741
717
718
719
720
721
722
723
724
725
726

727
728
729
730

731
732
733
734

735
736
737
738
739
740
741
742







+


-
+



-
+



-
+







void
Tcl_SetStdChannel(
    Tcl_Channel channel,
    int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    int init = channel ? 1 : -1;
    switch (type) {
    case TCL_STDIN:
	tsdPtr->stdinInitialized = 1;
	tsdPtr->stdinInitialized = init;
	tsdPtr->stdinChannel = channel;
	break;
    case TCL_STDOUT:
	tsdPtr->stdoutInitialized = 1;
	tsdPtr->stdoutInitialized = init;
	tsdPtr->stdoutChannel = channel;
	break;
    case TCL_STDERR:
	tsdPtr->stderrInitialized = 1;
	tsdPtr->stderrInitialized = init;
	tsdPtr->stderrChannel = channel;
	break;
    }
}

/*
 *----------------------------------------------------------------------
764
765
766
767
768
769
770

771
772
773
774
775
776
777
778
779
780
781
782
783

784
785
786
787
788
789
790

791
792
793

794
795
796
797
798
799
800

801
802
803

804
805
806
807
808
809
810
765
766
767
768
769
770
771
772
773

774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794

795
796
797
798
799
800
801
802
803
804
805

806
807
808
809
810
811
812
813
814







+

-











+







+

-

+







+

-

+







     * If the channels were not created yet, create them now and store them in
     * the static variables.
     */

    switch (type) {
    case TCL_STDIN:
	if (!tsdPtr->stdinInitialized) {
	    tsdPtr->stdinInitialized = -1;
	    tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
	    tsdPtr->stdinInitialized = 1;

	    /*
	     * Artificially bump the refcount to ensure that the channel is
	     * only closed on exit.
	     *
	     * NOTE: Must only do this if stdinChannel is not NULL. It can be
	     * NULL in situations where Tcl is unable to connect to the
	     * standard input.
	     */

	    if (tsdPtr->stdinChannel != NULL) {
		tsdPtr->stdinInitialized = 1;
		Tcl_RegisterChannel(NULL, tsdPtr->stdinChannel);
	    }
	}
	channel = tsdPtr->stdinChannel;
	break;
    case TCL_STDOUT:
	if (!tsdPtr->stdoutInitialized) {
	    tsdPtr->stdoutInitialized = -1;
	    tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
	    tsdPtr->stdoutInitialized = 1;
	    if (tsdPtr->stdoutChannel != NULL) {
		tsdPtr->stdoutInitialized = 1;
		Tcl_RegisterChannel(NULL, tsdPtr->stdoutChannel);
	    }
	}
	channel = tsdPtr->stdoutChannel;
	break;
    case TCL_STDERR:
	if (!tsdPtr->stderrInitialized) {
	    tsdPtr->stderrInitialized = -1;
	    tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
	    tsdPtr->stderrInitialized = 1;
	    if (tsdPtr->stderrChannel != NULL) {
		tsdPtr->stderrInitialized = 1;
		Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel);
	    }
	}
	channel = tsdPtr->stderrChannel;
	break;
    }
    return channel;
1064
1065
1066
1067
1068
1069
1070
1071

1072
1073
1074
1075
1076
1077
1078
1079

1080
1081
1082
1083
1084
1085
1086
1087

1088
1089
1090
1091
1092
1093
1094
1068
1069
1070
1071
1072
1073
1074

1075
1076
1077
1078
1079
1080
1081
1082

1083
1084
1085
1086
1087
1088
1089
1090

1091
1092
1093
1094
1095
1096
1097
1098







-
+







-
+







-
+







static void
CheckForStdChannelsBeingClosed(
    Tcl_Channel chan)
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->stdinInitialized
    if (tsdPtr->stdinInitialized == 1
	    && tsdPtr->stdinChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stdinChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stdoutInitialized
    } else if (tsdPtr->stdoutInitialized == 1
	    && tsdPtr->stdoutChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stdoutChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stderrInitialized
    } else if (tsdPtr->stderrInitialized == 1
	    && tsdPtr->stderrChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stderrChannel = NULL;
	    return;
	}
6945
6946
6947
6948
6949
6950
6951
6952

6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963

6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979

6980
6981
6982
6983
6984
6985
6986
6987
6988
6989
6990
6991
6992

6993
6994
6995
6996
6997
6998
6999
6949
6950
6951
6952
6953
6954
6955

6956
6957
6958
6959
6960
6961
6962
6963
6964
6965
6966

6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982

6983
6984
6985
6986
6987
6988
6989
6990
6991
6992
6993
6994
6995

6996
6997
6998
6999
7000
7001
7002
7003







-
+










-
+















-
+












-
+







    int result;			/* Of device driver operations. */
    Tcl_WideInt curPos;		/* Position on the device. */
    int wasAsync;		/* Was the channel nonblocking before the seek
				 * operation? If so, must restore to
				 * non-blocking mode after the seek. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return Tcl_LongAsWide(-1);
	return -1;
    }

    /*
     * Disallow seek on dead channels - channels that have been closed but not
     * yet been deallocated. Such channels can be found if the exit handler
     * for channel cleanup has run but the channel is still registered in an
     * interpreter.
     */

    if (CheckForDeadChannel(NULL, statePtr)) {
	return Tcl_LongAsWide(-1);
	return -1;
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    /*
     * Disallow seek on channels whose type does not have a seek procedure
     * defined. This means that the channel does not support seeking.
     */

    if (chanPtr->typePtr->seekProc == NULL) {
	Tcl_SetErrno(EINVAL);
	return Tcl_LongAsWide(-1);
	return -1;
    }

    /*
     * Compute how much input and output is buffered. If both input and output
     * is buffered, cannot compute the current position.
     */

    inputBuffered = Tcl_InputBuffered(chan);
    outputBuffered = Tcl_OutputBuffered(chan);

    if ((inputBuffered != 0) && (outputBuffered != 0)) {
	Tcl_SetErrno(EFAULT);
	return Tcl_LongAsWide(-1);
	return -1;
    }

    /*
     * If we are seeking relative to the current position, compute the
     * corrected offset taking into account the amount of unread input.
     */

7028
7029
7030
7031
7032
7033
7034
7035

7036
7037
7038
7039
7040
7041
7042
7032
7033
7034
7035
7036
7037
7038

7039
7040
7041
7042
7043
7044
7045
7046







-
+







     */

    wasAsync = 0;
    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
	wasAsync = 1;
	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
	if (result != 0) {
	    return Tcl_LongAsWide(-1);
	    return -1;
	}
	ResetFlag(statePtr, CHANNEL_NONBLOCKING);
	if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
	}
    }

7053
7054
7055
7056
7057
7058
7059
7060

7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076

7077
7078
7079
7080
7081
7082
7083
7057
7058
7059
7060
7061
7062
7063

7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077
7078
7079

7080
7081
7082
7083
7084
7085
7086
7087







-
+















-
+







    } else {
	/*
	 * Now seek to the new position in the channel as requested by the
	 * caller.
	 */

	curPos = ChanSeek(chanPtr, offset, mode, &result);
	if (curPos == Tcl_LongAsWide(-1)) {
	if (curPos == -1) {
	    Tcl_SetErrno(result);
	}
    }

    /*
     * Restore to nonblocking mode if that was the previous behavior.
     *
     * NOTE: Even if there was an async flush active we do not restore it now
     * because we already flushed all the queued output, above.
     */

    if (wasAsync) {
	SetFlag(statePtr, CHANNEL_NONBLOCKING);
	result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
	if (result != 0) {
	    return Tcl_LongAsWide(-1);
	    return -1;
	}
    }

    return curPos;
}

/*
7109
7110
7111
7112
7113
7114
7115
7116

7117
7118
7119
7120
7121
7122
7123
7124
7125
7126
7127

7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143

7144
7145
7146
7147
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161


7162
7163

7164
7165
7166
7167
7168
7169
7170
7113
7114
7115
7116
7117
7118
7119

7120
7121
7122
7123
7124
7125
7126
7127
7128
7129
7130

7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146

7147
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163


7164
7165
7166

7167
7168
7169
7170
7171
7172
7173
7174







-
+










-
+















-
+
















-
-
+
+

-
+







				/* State info for channel */
    int inputBuffered, outputBuffered;
				/* # bytes held in buffers. */
    int result;			/* Of calling device driver. */
    Tcl_WideInt curPos;		/* Position on device. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return Tcl_LongAsWide(-1);
	return -1;
    }

    /*
     * Disallow tell on dead channels -- channels that have been closed but
     * not yet been deallocated. Such channels can be found if the exit
     * handler for channel cleanup has run but the channel is still registered
     * in an interpreter.
     */

    if (CheckForDeadChannel(NULL, statePtr)) {
	return Tcl_LongAsWide(-1);
	return -1;
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    /*
     * Disallow tell on channels whose type does not have a seek procedure
     * defined. This means that the channel does not support seeking.
     */

    if (chanPtr->typePtr->seekProc == NULL) {
	Tcl_SetErrno(EINVAL);
	return Tcl_LongAsWide(-1);
	return -1;
    }

    /*
     * Compute how much input and output is buffered. If both input and output
     * is buffered, cannot compute the current position.
     */

    inputBuffered = Tcl_InputBuffered(chan);
    outputBuffered = Tcl_OutputBuffered(chan);

    /*
     * Get the current position in the device and compute the position where
     * the next character will be read or written. Note that we prefer the
     * wideSeekProc if that is available and non-NULL...
     */

    curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result);
    if (curPos == Tcl_LongAsWide(-1)) {
    curPos = ChanSeek(chanPtr, 0, SEEK_CUR, &result);
    if (curPos == -1) {
	Tcl_SetErrno(result);
	return Tcl_LongAsWide(-1);
	return -1;
    }

    if (inputBuffered != 0) {
	return curPos - inputBuffered;
    }
    return curPos + outputBuffered;
}
9028
9029
9030
9031
9032
9033
9034

9035
9036
9037
9038
9039
9040
9041
9042
9043
9044
9045

9046
9047
9048
9049
9050
9051
9052
9032
9033
9034
9035
9036
9037
9038
9039
9040
9041
9042
9043
9044
9045
9046
9047
9048
9049
9050
9051
9052
9053
9054
9055
9056
9057
9058







+











+







 * Side effects:
 *	May schedule a background copy operation that causes both channels to
 *	be marked busy.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED)
int
TclCopyChannelOld(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Channel inChan,		/* Channel to read from. */
    Tcl_Channel outChan,	/* Channel to write to. */
    int toRead,			/* Amount of data to copy, or -1 for all. */
    Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */
{
    return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
            cmdPtr);
}
#endif

int
TclCopyChannel(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Channel inChan,		/* Channel to read from. */
    Tcl_Channel outChan,	/* Channel to write to. */
    Tcl_WideInt toRead,		/* Amount of data to copy, or -1 for all. */

Changes to generic/tclIOCmd.c.

133
134
135
136
137
138
139
140

141
142
143
144
145
146
147
133
134
135
136
137
138
139

140
141
142
143
144
145
146
147







-
+







    case 4:			/* [puts -nonewline $chan $x] or
				 * [puts $chan $x nonewline] */
	newline = 0;
	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
	    chanObjPtr = objv[2];
	    string = objv[3];
	    break;
#if TCL_MAJOR_VERSION < 9
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
	    /*
	     * The code below provides backwards compatibility with an old
	     * form of the command that is no longer recommended or
	     * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
	     * maybe even earlier.
	     */
435
436
437
438
439
440
441
442

443
444
445
446
447
448
449
450
451
452
453
454
455
456
457

458
459
460
461
462
463
464
435
436
437
438
439
440
441

442
443
444
445
446
447
448
449
450
451
452
453
454
455
456

457
458
459
460
461
462
463
464







-
+














-
+







     * Compute how many bytes to read.
     */

    toRead = -1;
    if (i < objc) {
	if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
		|| (toRead < 0)) {
#if TCL_MAJOR_VERSION < 9
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	    /*
	     * The code below provides backwards compatibility with an old
	     * form of the command that is no longer recommended or
	     * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
	     * maybe even earlier.
	     */

	    if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
#endif
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected non-negative integer but got \"%s\"",
			TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
		return TCL_ERROR;
#if TCL_MAJOR_VERSION < 9
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	    }
	    newline = 1;
#endif
	}
    }

    resultPtr = Tcl_NewObj();
555
556
557
558
559
560
561
562

563
564
565
566
567
568
569
555
556
557
558
559
560
561

562
563
564
565
566
567
568
569







-
+







	    return TCL_ERROR;
	}
	mode = modeArray[optionIndex];
    }

    TclChannelPreserve(chan);
    result = Tcl_Seek(chan, offset, mode);
    if (result == Tcl_LongAsWide(-1)) {
    if (result == -1) {
	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */

987
988
989
990
991
992
993
994

995
996
997
998
999
1000
1001
987
988
989
990
991
992
993

994
995
996
997
998
999
1000
1001







-
+







	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    resultPtr = Tcl_NewObj();
    if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
	if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
	if (Tcl_ReadChars(chan, resultPtr, -1, 0) == TCL_IO_FAILURE) {
	    /*
	     * TIP #219.
	     * Capture error messages put by the driver into the bypass area
	     * and put them into the regular interpreter result. Fall back to
	     * the regular message if nothing was found in the bypass.
	     */

1909
1910
1911
1912
1913
1914
1915
1916

1917
1918
1919
1920
1921
1922
1923
1909
1910
1911
1912
1913
1914
1915

1916
1917
1918
1919
1920
1921
1922
1923







-
+







	}
    } else {
	/*
	 * User wants to truncate to the current file position.
	 */

	length = Tcl_Tell(chan);
	if (length == Tcl_WideAsLong(-1)) {
	if (length == -1) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not determine current location in \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
    }

Changes to generic/tclIOGT.c.

906
907
908
909
910
911
912
913

914
915
916
917
918
919
920
921
922
923

924
925
926
927
928
929
930
931
906
907
908
909
910
911
912

913
914
915
916
917
918
919
920
921
922

923

924
925
926
927
928
929
930







-
+









-
+
-







    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
    Tcl_DriverWideSeekProc *parentWideSeekProc =
	    Tcl_ChannelWideSeekProc(parentType);
    ClientData parentData = Tcl_GetChannelInstanceData(parent);

    if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {
    if ((offset == 0) && (mode == SEEK_CUR)) {
	/*
	 * This is no seek but a request to tell the caller the current
	 * location. Simply pass the request down.
	 */

	if (parentWideSeekProc != NULL) {
	    return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
	}

	return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode,
	return parentSeekProc(parentData, 0, mode, errorCodePtr);
		errorCodePtr));
    }

    /*
     * It is a real request to change the position. Flush all data waiting for
     * output and discard everything in the input buffers. Then pass the
     * request down, unchanged.
     */
957
958
959
960
961
962
963
964

965
966

967
968
969
970


971
972
973
974
975
976
977
956
957
958
959
960
961
962

963
964

965
966
967


968
969
970
971
972
973
974
975
976







-
+

-
+


-
-
+
+







     * We're transferring to narrow seeks at this point; this is a bit complex
     * because we have to check whether the seek is possible first (i.e.
     * whether we are losing information in truncating the bits of the
     * offset). Luckily, there's a defined error for what happens when trying
     * to go out of the representable range.
     */

    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
    if (offset<LONG_MIN || offset>LONG_MAX) {
	*errorCodePtr = EOVERFLOW;
	return Tcl_LongAsWide(-1);
	return -1;
    }

    return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset),
	    mode, errorCodePtr));
    return parentSeekProc(parentData, offset,
	    mode, errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TransformSetOptionProc --
 *

Changes to generic/tclIORChan.c.

35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
35
36
37
38
39
40
41

42
43
44
45
46
47
48
49







-
+







			    Tcl_Interp *interp);
static int		ReflectInput(ClientData clientData, char *buf,
			    int toRead, int *errorCodePtr);
static int		ReflectOutput(ClientData clientData, const char *buf,
			    int toWrite, int *errorCodePtr);
static void		ReflectWatch(ClientData clientData, int mask);
static int		ReflectBlock(ClientData clientData, int mode);
#ifdef TCL_THREADS
#if TCL_THREADS
static void		ReflectThread(ClientData clientData, int action);
static int		ReflectEventRun(Tcl_Event *ev, int flags);
static int		ReflectEventDelete(Tcl_Event *ev, ClientData cd);
#endif
static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
			    Tcl_WideInt offset, int mode, int *errorCodePtr);
static int		ReflectSeek(ClientData clientData, long offset,
72
73
74
75
76
77
78
79

80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

101
102
103
104
105
106
107
72
73
74
75
76
77
78

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99

100
101
102
103
104
105
106
107







-
+




















-
+







    ReflectWatch,	   /* Initialize notifier			  */
    NULL,		   /* Get OS handle from the channel.	NULL'able */
    NULL,		   /* 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 */
#ifdef TCL_THREADS
#if TCL_THREADS
    ReflectThread,         /* thread action, tracking owner */
#else
    NULL,		   /* thread action */
#endif
    NULL		   /* truncate */
};

/*
 * Instance data for a reflected channel. ===========================
 */

typedef struct {
    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.
				 */
#ifdef TCL_THREADS
#if TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. == Handler 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 */

197
198
199
200
201
202
203
204

205
206
207
208
209
210
211
197
198
199
200
201
202
203

204
205
206
207
208
209
210
211







-
+







#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	(x & FLAG(f))

#ifdef TCL_THREADS
#if TCL_THREADS
/*
 * Thread specific types and structures.
 *
 * We are here essentially creating a very specific implementation of 'thread
 * send'.
 */

447
448
449
450
451
452
453
454

455
456
457
458
459
460
461
447
448
449
450
451
452
453

454
455
456
457
458
459
460
461







-
+







 * list-quoting to keep the words of the message together. See also [x].
 */

static const char *msg_read_toomuch = "{read delivered more than requested}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#ifdef TCL_THREADS
#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
#endif /* TCL_THREADS */
static const char *msg_send_dstlost    = "{Owner lost}";
static const char *msg_dstlost    = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";

/*
 * Main methods to plug into the 'chan' ensemble'. ==================
702
703
704
705
706
707
708
709

710
711
712
713
714
715
716
702
703
704
705
706
707
708

709
710
711
712
713
714
715
716







-
+







    rcmPtr = GetReflectedChannelMap(interp);
    hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
	    &isNew);
    if (!isNew && chanPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
    }
    Tcl_SetHashValue(hPtr, chan);
#ifdef TCL_THREADS
#if TCL_THREADS
    rcmPtr = GetThreadReflectedChannelMap();
    hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
	    &isNew);
    Tcl_SetHashValue(hPtr, chan);
#endif

    /*
746
747
748
749
750
751
752
753

754
755
756
757
758
759
760
746
747
748
749
750
751
752

753
754
755
756
757
758
759
760







-
+







 * Side effects:
 *	Posts events to a reflected channel, invokes event handlers. The
 *	latter implies that arbitrary side effects are possible.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_THREADS
#if TCL_THREADS
typedef struct {
    Tcl_Event header;
    ReflectedChannel *rcPtr;
    int events;
} ReflectEvent;

static int
913
914
915
916
917
918
919
920

921
922
923
924

925
926
927
928
929
930
931
913
914
915
916
917
918
919

920
921
922
923

924
925
926
927
928
929
930
931







-
+



-
+







	return TCL_ERROR;
    }

    /*
     * We have the channel and the events to post.
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rcPtr->owner == rcPtr->thread) {
#endif
        Tcl_NotifyChannel(chan, events);
#ifdef TCL_THREADS
#if TCL_THREADS
    } else {
        ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));

        ev->header.proc = ReflectEventRun;
        ev->events = events;
        ev->rcPtr = rcPtr;

1133
1134
1135
1136
1137
1138
1139
1140

1141
1142
1143
1144
1145
1146
1147
1133
1134
1135
1136
1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
1147







-
+







	 * THREADED => Forward this to the origin thread
	 *
	 * Note: DeleteThreadReflectedChannelMap() is the thread exit handler
	 * for the origin thread. Use this to clean up the structure? Except
	 * if lost?
	 */

#ifdef TCL_THREADS
#if TCL_THREADS
	if (rcPtr->thread != Tcl_GetCurrentThread()) {
	    ForwardParam p;

	    ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
	    result = p.base.code;

            /*
1165
1166
1167
1168
1169
1170
1171
1172

1173
1174
1175
1176
1177
1178
1179
1165
1166
1167
1168
1169
1170
1171

1172
1173
1174
1175
1176
1177
1178
1179







-
+







	return EOK;
    }

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
	result = p.base.code;

        /*
1212
1213
1214
1215
1216
1217
1218
1219

1220
1221
1222
1223
1224
1225
1226
1212
1213
1214
1215
1216
1217
1218

1219
1220
1221
1222
1223
1224
1225
1226







-
+







	    rcmPtr = GetReflectedChannelMap(rcPtr->interp);
	    hPtr = Tcl_FindHashEntry(&rcmPtr->map,
		    Tcl_GetChannelName(rcPtr->chan));
	    if (hPtr) {
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
#ifdef TCL_THREADS
#if TCL_THREADS
	rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
		Tcl_GetChannelName(rcPtr->chan));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
    }
1263
1264
1265
1266
1267
1268
1269
1270

1271
1272
1273
1274
1275
1276
1277
1263
1264
1265
1266
1267
1268
1269

1270
1271
1272
1273
1274
1275
1276
1277







-
+







    unsigned char *bytev;	/* Array of returned bytes */
    Tcl_Obj *resObj;		/* Result data for 'read' */

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.input.buf = buf;
	p.input.toRead = toRead;

	ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p);
1369
1370
1371
1372
1373
1374
1375
1376

1377
1378
1379
1380
1381
1382
1383
1369
1370
1371
1372
1373
1374
1375

1376
1377
1378
1379
1380
1381
1382
1383







-
+







    Tcl_Obj *resObj;		/* Result data for 'write' */
    int written;

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.output.buf = buf;
	p.output.toWrite = toWrite;

	ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p);
1498
1499
1500
1501
1502
1503
1504
1505

1506
1507
1508
1509
1510
1511
1512
1498
1499
1500
1501
1502
1503
1504

1505
1506
1507
1508
1509
1510
1511
1512







-
+







    Tcl_Obj *resObj;		/* Result for 'seek' */
    Tcl_WideInt newLoc;

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.seek.seekMode = seekMode;
	p.seek.offset = offset;

	ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p);
1540
1541
1542
1543
1544
1545
1546
1547

1548
1549
1550
1551
1552
1553
1554
1540
1541
1542
1543
1544
1545
1546

1547
1548
1549
1550
1551
1552
1553
1554







-
+







    }

    if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
        goto invalid;
    }

    if (newLoc < Tcl_LongAsWide(0)) {
    if (newLoc < 0) {
	SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
        goto invalid;
    }

    *errorCodePtr = EOK;
 stop:
    Tcl_DecrRefCount(offObj);
1572
1573
1574
1575
1576
1577
1578
1579

1580
1581
1582
1583
1584
1585
1586
1572
1573
1574
1575
1576
1577
1578

1579
1580
1581
1582
1583
1584
1585
1586







-
+







    /*
     * This function can be invoked from a transformation which is based on
     * standard seeking, i.e. non-wide. Because of this we have to implement
     * it, a dummy is not enough. We simply delegate the call to the wide
     * routine.
     */

    return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
    return ReflectSeekWide(clientData, offset, seekMode,
	    errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --
1621
1622
1623
1624
1625
1626
1627
1628

1629
1630
1631
1632
1633
1634
1635
1621
1622
1623
1624
1625
1626
1627

1628
1629
1630
1631
1632
1633
1634
1635







-
+







	return;
    }

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.watch.mask = mask;
	ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p);

	/*
1679
1680
1681
1682
1683
1684
1685
1686

1687
1688
1689
1690
1691
1692
1693
1679
1680
1681
1682
1683
1684
1685

1686
1687
1688
1689
1690
1691
1692
1693







-
+







    int errorNum;		/* EINVAL or EOK (success). */
    Tcl_Obj *resObj;		/* Result data for 'blocking' */

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.block.nonblocking = nonblocking;

	ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p);

1715
1716
1717
1718
1719
1720
1721
1722

1723
1724
1725
1726
1727
1728
1729
1715
1716
1717
1718
1719
1720
1721

1722
1723
1724
1725
1726
1727
1728
1729







-
+







    Tcl_DecrRefCount(blockObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */

    Tcl_Release(rcPtr);
    return errorNum;
}

#ifdef TCL_THREADS
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * ReflectThread --
 *
 *	This function is invoked to tell the channel about thread movements.
 *
1785
1786
1787
1788
1789
1790
1791
1792

1793
1794
1795
1796
1797
1798
1799
1785
1786
1787
1788
1789
1790
1791

1792
1793
1794
1795
1796
1797
1798
1799







-
+







    int result;			/* Result code for 'configure' */
    Tcl_Obj *resObj;		/* Result data for 'configure' */

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.setOpt.name = optionName;
	p.setOpt.value = newValue;

	ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p);
1864
1865
1866
1867
1868
1869
1870
1871

1872
1873
1874
1875
1876
1877
1878
1864
1865
1866
1867
1868
1869
1870

1871
1872
1873
1874
1875
1876
1877
1878







-
+







    Tcl_Obj **listv;
    MethodName method;

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	int opcode;
	ForwardParam p;

	p.getOpt.name = optionName;
	p.getOpt.value = dsPtr;

2127
2128
2129
2130
2131
2132
2133
2134

2135
2136
2137
2138
2139
2140
2141
2127
2128
2129
2130
2131
2132
2133

2134
2135
2136
2137
2138
2139
2140
2141







-
+







    rcPtr = ckalloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
#ifdef TCL_THREADS
#if TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    /* ASSERT: cmdpfxObj is a Tcl List */
    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
2502
2503
2504
2505
2506
2507
2508
2509

2510
2511
2512
2513
2514
2515
2516
2502
2503
2504
2505
2506
2507
2508

2509
2510
2511
2512
2513
2514
2515
2516







-
+







{
    ReflectedChannelMap *rcmPtr = clientData;
				/* The map */
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    ReflectedChannel *rcPtr;
    Tcl_Channel chan;
#ifdef TCL_THREADS
#if TCL_THREADS
    ForwardingResult *resultPtr;
    ForwardingEvent *evPtr;
    ForwardParam *paramPtr;
#endif

    /*
     * Delete all entries. The channels may have been closed already, or will
2532
2533
2534
2535
2536
2537
2538
2539

2540
2541
2542
2543
2544
2545
2546
2532
2533
2534
2535
2536
2537
2538

2539
2540
2541
2542
2543
2544
2545
2546







-
+








	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rcmPtr->map);
    ckfree(&rcmPtr->map);

#ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*
     * Go through the list of pending results and cancel all whose events were
     * destined for this interpreter. While this is in progress we block any
2618
2619
2620
2621
2622
2623
2624
2625

2626
2627
2628
2629
2630
2631
2632
2618
2619
2620
2621
2622
2623
2624

2625
2626
2627
2628
2629
2630
2631
2632







-
+








	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
#endif
}

#ifdef TCL_THREADS
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * GetThreadReflectedChannelMap --
 *
 *	Gets and potentially initializes the reflected channel map for a
 *	thread.
3075
3076
3077
3078
3079
3080
3081
3082

3083
3084
3085
3086
3087
3088
3089
3075
3076
3077
3078
3079
3080
3081

3082
3083
3084
3085
3086
3087
3088
3089







-
+







	     * Process a regular result. If the type is wrong this may change
	     * into an error.
	     */

	    Tcl_WideInt newLoc;

	    if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
		if (newLoc < Tcl_LongAsWide(0)) {
		if (newLoc < 0) {
		    ForwardSetStaticError(paramPtr, msg_seek_beforestart);
		    paramPtr->seek.offset = -1;
		} else {
		    paramPtr->seek.offset = newLoc;
		}
	    } else {
		Tcl_DecrRefCount(resObj);

Changes to generic/tclIORTrans.c.

83
84
85
86
87
88
89
90

91
92
93
94
95
96
97
83
84
85
86
87
88
89

90
91
92
93
94
95
96
97







-
+







};

/*
 * Structure of the buffer to hold transform results to be consumed by higher
 * layers upon reading from the channel, plus the functions to manage such.
 */

typedef struct _ResultBuffer_ {
typedef struct {
    unsigned char *buf;		/* Reference to the buffer area. */
    int allocated;		/* Allocated size of the buffer area. */
    int used;			/* Number of bytes in the buffer,
				 * <= allocated. */
} ResultBuffer;

#define ResultLength(r) ((r)->used)
123
124
125
126
127
128
129
130

131
132
133
134
135
136
137
123
124
125
126
127
128
129

130
131
132
133
134
135
136
137







-
+







				 * was pushed on. */
    Tcl_Interp *interp;		/* Reference to the interpreter containing the
				 * Tcl level part of the channel. */
    Tcl_Obj *handle;		/* Reference to transform handle. Also stored
				 * in the argv, see below. The separate field
				 * gives us direct access, needed when working
				 * with the reflection maps. */
#ifdef TCL_THREADS
#if TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
#endif

    Tcl_TimerToken timer;

    /* See [==] as well.
     * Storage for the command prefix and the additional words required for
216
217
218
219
220
221
222
223

224
225
226
227
228
229
230
216
217
218
219
220
221
222

223
224
225
226
227
228
229
230







-
+







#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	(x & FLAG(f))

#ifdef TCL_THREADS
#if TCL_THREADS
/*
 * Thread specific types and structures.
 *
 * We are here essentially creating a very specific implementation of 'thread
 * send'.
 */

249
250
251
252
253
254
255
256

257
258
259
260
261
262
263
249
250
251
252
253
254
255

256
257
258
259
260
261
262
263







-
+







 * command handler thread (CT), and the thread managing the channel (MT),
 * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
 * forward an operation code, the argument details, and reference to results.
 * The command is assembled in the CT and belongs fully to that thread. No
 * sharing problems.
 */

typedef struct ForwardParamBase {
typedef struct {
    int code;			/* O: Ok/Fail of the cmd handler */
    char *msgStr;		/* O: Error message for handler failure */
    int mustFree;		/* O: True if msgStr is allocated, false if
				 * otherwise (static). */
} ForwardParamBase;

/*
294
295
296
297
298
299
300
301

302
303
304
305
306
307
308
294
295
296
297
298
299
300

301
302
303
304
305
306
307
308







-
+








typedef struct ForwardingResult ForwardingResult;

/*
 * General event structure, with reference to operation specific data.
 */

typedef struct ForwardingEvent {
typedef struct {
    Tcl_Event event;		/* Basic event data, has to be first item */
    ForwardingResult *resultPtr;
    ForwardedOperation op;	/* Forwarded driver operation */
    ReflectedTransform *rtPtr;	/* Channel instance */
    ForwardParam *param;	/* Packaged arguments and return values, a
				 * ForwardParam pointer. */
} ForwardingEvent;
434
435
436
437
438
439
440
441

442
443
444
445
446
447
448
434
435
436
437
438
439
440

441
442
443
444
445
446
447
448







-
+







 * These string are used directly as bypass errors, thus they have to be valid
 * Tcl lists where the last element is the message itself. Hence the
 * list-quoting to keep the words of the message together. See also [x].
 */

static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
#ifdef TCL_THREADS
#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
static const char *msg_dstlost =
    "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";

/*
695
696
697
698
699
700
701
702

703
704
705
706
707
708
709
695
696
697
698
699
700
701

702
703
704
705
706
707
708
709







-
+








    rtmPtr = GetReflectedTransformMap(interp);
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
    if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
    }
    Tcl_SetHashValue(hPtr, rtPtr);
#ifdef TCL_THREADS
#if TCL_THREADS
    rtmPtr = GetThreadReflectedTransformMap();
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
    Tcl_SetHashValue(hPtr, rtPtr);
#endif /* TCL_THREADS */

    /*
     * Return the channel as the result of the command.
907
908
909
910
911
912
913
914

915
916
917
918
919
920
921
907
908
909
910
911
912
913

914
915
916
917
918
919
920
921







-
+







	 * THREADED => Forward this to the origin thread
	 *
	 * Note: DeleteThreadReflectedTransformMap() is the thread exit handler
	 * for the origin thread. Use this to clean up the structure? Except
	 * if lost?
	 */

#ifdef TCL_THREADS
#if TCL_THREADS
	if (rtPtr->thread != Tcl_GetCurrentThread()) {
	    ForwardParam p;

	    ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
	    result = p.base.code;

	    if (result != TCL_OK) {
934
935
936
937
938
939
940
941

942
943
944
945
946
947
948
949
950
951
952
953
954
955

956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971

972
973
974
975
976
977
978
934
935
936
937
938
939
940

941
942
943
944
945
946
947
948
949
950
951
952
953
954

955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970

971
972
973
974
975
976
977
978







-
+













-
+















-
+







     * be called. for transformations however we are not going through here on
     * such an abort, but directly through FreeReflectedTransform. So for us
     * that check is not necessary. We always go through 'finalize'.
     */

    if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
	if (!TransformDrain(rtPtr, &errorCode)) {
#ifdef TCL_THREADS
#if TCL_THREADS
	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
		Tcl_EventuallyFree(rtPtr,
			(Tcl_FreeProc *) FreeReflectedTransform);
		return errorCode;
	    }
#endif /* TCL_THREADS */
	    errorCodeSet = 1;
	    goto cleanup;
	}
    }

    if (HAS(rtPtr->methods, METH_FLUSH)) {
	if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
#ifdef TCL_THREADS
#if TCL_THREADS
	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
		Tcl_EventuallyFree(rtPtr,
			(Tcl_FreeProc *) FreeReflectedTransform);
		return errorCode;
	    }
#endif /* TCL_THREADS */
	    errorCodeSet = 1;
	    goto cleanup;
	}
    }

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
	result = p.base.code;

	Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
1021
1022
1023
1024
1025
1026
1027
1028

1029
1030
1031
1032
1033
1034
1035
1021
1022
1023
1024
1025
1026
1027

1028
1029
1030
1031
1032
1033
1034
1035







-
+








	/*
	 * In a threaded interpreter we manage a per-thread map as well,
	 * to allow us to survive if the script level pulls the rug out
	 * under a channel by deleting the owning thread.
	 */

#ifdef TCL_THREADS
#if TCL_THREADS
	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
#endif /* TCL_THREADS */
    }
1336
1337
1338
1339
1340
1341
1342
1343

1344
1345
1346
1347
1348
1349
1350
1336
1337
1338
1339
1340
1341
1342

1343
1344
1345
1346
1347
1348
1349
1350







-
+








    /*
     * Fail if the parent channel is not seekable.
     */

    if (seekProc == NULL) {
	Tcl_SetErrno(EINVAL);
	return Tcl_LongAsWide(-1);
	return -1;
    }

    /*
     * Check if we can leave out involving the Tcl level, i.e. transformation
     * handler. This is true for tell requests, and transformations which
     * support neither flush, nor drain. For these cases we can pass the
     * request down and the result back up unchanged.
1386
1387
1388
1389
1390
1391
1392
1393

1394
1395
1396

1397
1398
1399
1400



1401
1402

1403
1404
1405
1406
1407
1408
1409
1386
1387
1388
1389
1390
1391
1392

1393

1394

1395
1396



1397
1398
1399
1400

1401
1402
1403
1404
1405
1406
1407
1408







-
+
-

-
+

-
-
-
+
+
+

-
+







     * non-NULL...
     */

    if (HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) &&
	parent->typePtr->wideSeekProc != NULL) {
	curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
		seekMode, errorCodePtr);
    } else if (offset < Tcl_LongAsWide(LONG_MIN) ||
    } else if (offset < LONG_MIN || offset > LONG_MAX) {
	    offset > Tcl_LongAsWide(LONG_MAX)) {
	*errorCodePtr = EOVERFLOW;
	curPos = Tcl_LongAsWide(-1);
	curPos = -1;
    } else {
	curPos = Tcl_LongAsWide(parent->typePtr->seekProc(
		parent->instanceData, Tcl_WideAsLong(offset), seekMode,
		errorCodePtr));
	curPos = parent->typePtr->seekProc(
		parent->instanceData, offset, seekMode,
		errorCodePtr);
    }
    if (curPos == Tcl_LongAsWide(-1)) {
    if (curPos == -1) {
	Tcl_SetErrno(*errorCodePtr);
    }

    *errorCodePtr = EOK;
    Tcl_Release(rtPtr);
    return curPos;
}
1418
1419
1420
1421
1422
1423
1424
1425

1426
1427
1428
1429
1430
1431
1432
1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428
1429
1430
1431







-
+







    /*
     * This function can be invoked from a transformation which is based on
     * standard seeking, i.e. non-wide. Because of this we have to implement
     * it, a dummy is not enough. We simply delegate the call to the wide
     * routine.
     */

    return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
    return ReflectSeekWide(clientData, offset, seekMode,
	    errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --
1763
1764
1765
1766
1767
1768
1769
1770

1771
1772
1773
1774
1775
1776
1777
1762
1763
1764
1765
1766
1767
1768

1769
1770
1771
1772
1773
1774
1775
1776







-
+







    rtPtr = ckalloc(sizeof(ReflectedTransform));

    /* rtPtr->chan: Assigned by caller. Dummy data here. */
    /* rtPtr->methods: Assigned by caller. Dummy data here. */

    rtPtr->chan = NULL;
    rtPtr->methods = 0;
#ifdef TCL_THREADS
#if TCL_THREADS
    rtPtr->thread = Tcl_GetCurrentThread();
#endif
    rtPtr->parent = parentChan;
    rtPtr->interp = interp;
    rtPtr->handle = handleObj;
    Tcl_IncrRefCount(handleObj);
    rtPtr->timer = NULL;
2148
2149
2150
2151
2152
2153
2154
2155

2156
2157
2158
2159
2160
2161
2162
2147
2148
2149
2150
2151
2152
2153

2154
2155
2156
2157
2158
2159
2160
2161







-
+







    ClientData 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. */
    ReflectedTransform *rtPtr;
#ifdef TCL_THREADS
#if TCL_THREADS
    ForwardingResult *resultPtr;
    ForwardingEvent *evPtr;
    ForwardParam *paramPtr;
#endif /* TCL_THREADS */

    /*
     * Delete all entries. The channels may have been closed already, or will
2178
2179
2180
2181
2182
2183
2184
2185

2186
2187
2188
2189
2190
2191
2192
2177
2178
2179
2180
2181
2182
2183

2184
2185
2186
2187
2188
2189
2190
2191







-
+








	rtPtr->dead = 1;
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rtmPtr->map);
    ckfree(&rtmPtr->map);

#ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*
     * Get the map of all channels handled by the current thread. This is a
     * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
2250
2251
2252
2253
2254
2255
2256
2257

2258
2259
2260
2261
2262
2263
2264
2249
2250
2251
2252
2253
2254
2255

2256
2257
2258
2259
2260
2261
2262
2263







-
+








	Tcl_ConditionNotify(&resultPtr->done);
    }
    Tcl_MutexUnlock(&rtForwardMutex);
#endif /* TCL_THREADS */
}

#ifdef TCL_THREADS
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * GetThreadReflectedTransformMap --
 *
 *	Gets and potentially initializes the reflected channel map for a
 *	thread.
3084
3085
3086
3087
3088
3089
3090
3091

3092
3093
3094
3095
3096
3097
3098
3083
3084
3085
3086
3087
3088
3089

3090
3091
3092
3093
3094
3095
3096
3097







-
+







    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj,
		&(p.transform.size));

	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);
3140
3141
3142
3143
3144
3145
3146
3147

3148
3149
3150
3151
3152
3153
3154
3139
3140
3141
3142
3143
3144
3145

3146
3147
3148
3149
3150
3151
3152
3153







-
+







    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.transform.buf = (char *) buf;
	p.transform.size = toWrite;

	ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p);
3206
3207
3208
3209
3210
3211
3212
3213

3214
3215
3216
3217
3218
3219
3220
3205
3206
3207
3208
3209
3210
3211

3212
3213
3214
3215
3216
3217
3218
3219







-
+







    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
3256
3257
3258
3259
3260
3261
3262
3263

3264
3265
3266
3267
3268
3269
3270
3255
3256
3257
3258
3259
3260
3261

3262
3263
3264
3265
3266
3267
3268
3269







-
+







    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedFlush, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
3311
3312
3313
3314
3315
3316
3317
3318

3319
3320
3321
3322
3323
3324
3325
3310
3311
3312
3313
3314
3315
3316

3317
3318
3319
3320
3321
3322
3323
3324







-
+







TransformClear(
    ReflectedTransform *rtPtr)
{
    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
	return;
    }
#endif /* TCL_THREADS */
3343
3344
3345
3346
3347
3348
3349
3350

3351
3352
3353
3354
3355
3356
3357
3342
3343
3344
3345
3346
3347
3348

3349
3350
3351
3352
3353
3354
3355
3356







-
+







    Tcl_Obj *resObj;
    Tcl_InterpState sr;		/* State of handler interp */

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedLimit, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);

Changes to generic/tclIOSock.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21













-
+







/*
 * tclIOSock.c --
 *
 *	Common routines used by all socket based channel types.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#if defined(_WIN32) && defined(UNICODE)
#if defined(_WIN32)
/*
 * On Windows, we need to do proper Unicode->UTF-8 conversion.
 */

typedef struct {
    int initialized;
    Tcl_DString errorMsg; /* UTF-8 encoded error-message */

Changes to generic/tclIOUtil.c.

135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
135
136
137
138
139
140
141

142
143
144
145
146
147
148







-







Tcl_FSLstatProc			TclpObjLstat;
Tcl_FSCopyFileProc		TclpObjCopyFile;
Tcl_FSDeleteFileProc		TclpObjDeleteFile;
Tcl_FSRenameFileProc		TclpObjRenameFile;
Tcl_FSCreateDirectoryProc	TclpObjCreateDirectory;
Tcl_FSCopyDirectoryProc		TclpObjCopyDirectory;
Tcl_FSRemoveDirectoryProc	TclpObjRemoveDirectory;
Tcl_FSUnloadFileProc		TclpUnloadFile;
Tcl_FSLinkProc			TclpObjLink;
Tcl_FSListVolumesProc		TclpObjListVolumes;

/*
 * Define the native filesystem dispatch table. If necessary, it is ok to make
 * this non-static, but it should only be accessed by the functions actually
 * listed within it (or perhaps other helper functions of them). Anything
241
242
243
244
245
246
247
248

249
250
251
252
253
254
255
240
241
242
243
244
245
246

247
248
249
250
251
252
253
254







-
+







 * a file system by way of making a temporary copy of the file on the native
 * filesystem. We need to store both the actual unloadProc/clientData
 * combination which was used, and the original and modified filenames, so
 * that we can correctly undo the entire operation when we want to unload the
 * code.
 */

typedef struct FsDivertLoad {
typedef struct {
    Tcl_LoadHandle loadHandle;
    Tcl_FSUnloadFileProc *unloadProcPtr;
    Tcl_Obj *divertedFile;
    const Tcl_Filesystem *divertedFilesystem;
    ClientData divertedFileNativeRep;
} FsDivertLoad;

272
273
274
275
276
277
278
279
280


281
282
283
284
285
286
287
271
272
273
274
275
276
277


278
279
280
281
282
283
284
285
286







-
-
+
+







    ret = Tcl_FSStat(pathPtr, &buf);
    Tcl_DecrRefCount(pathPtr);
    if (ret != -1) {
#ifndef TCL_WIDE_INT_IS_LONG
	Tcl_WideInt tmp1, tmp2, tmp3 = 0;

# define OUT_OF_RANGE(x) \
	(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
	 ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
	(((Tcl_WideInt)(x)) < LONG_MIN || \
	 ((Tcl_WideInt)(x)) > LONG_MAX)
# define OUT_OF_URANGE(x) \
	(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))

	/*
	 * Perform the result-buffer overflow check manually.
	 *
	 * Note that ino_t/ino64_t is unsigned...
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
407
408
409
410
411
412
413

414
415
416
417
418
419
420







-







    }
    Tcl_DStringInit(cwdPtr);
    TclDStringAppendObj(cwdPtr, cwd);
    Tcl_DecrRefCount(cwd);
    return Tcl_DStringValue(cwdPtr);
}

/* Obsolete */
int
Tcl_EvalFile(
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    const char *fileName)	/* Name of file to process. Tilde-substitution
				 * will be performed on this name. */
{
    int ret;
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
825
826
827
828
829
830
831









832
833
834
835
836
837
838







-
-
-
-
-
-
-
-
-







void
TclResetFilesystem(void)
{
    filesystemList = &nativeFilesystemRecord;
    if (++theFilesystemEpoch == 0) {
	++theFilesystemEpoch;
    }

#ifdef _WIN32
    /*
     * Cleans up the win32 API filesystem proc lookup table. This must happen
     * very late in finalization so that deleting of copied dlls can occur.
     */

    TclWinResetInterfaces();
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSRegister --
 *
1397
1398
1399
1400
1401
1402
1403




1404
1405
1406
1407
1408







1409

1410













1411
1412
1413









1414
1415
1416
1417




1418
1419
1420
1421
1422




1423
1424
1425
1426
1427
1428






1429
1430
1431
1432
1433
1434
1435
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397




1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
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
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455







+
+
+
+

-
-
-
-
+
+
+
+
+
+
+

+

+
+
+
+
+
+
+
+
+
+
+
+
+



+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+







TclFSNormalizeToUniquePath(
    Tcl_Interp *interp,		/* Used for error messages. */
    Tcl_Obj *pathPtr,		/* The path to normalize in place. */
    int startAt)		/* Start at this char-offset. */
{
    FilesystemRecord *fsRecPtr, *firstFsRecPtr;

    int i;
    int isVfsPath = 0;
    char *path;

    /*
     * Call each of the "normalise path" functions in succession. This is a
     * special case, in which if we have a native filesystem handler, we call
     * it first. This is because the root of Tcl's filesystem is always a
     * native filesystem (i.e., '/' on unix is native).
     * Paths starting with a UNC prefix whose final character is a colon
     * are reserved for VFS use.  These names can not conflict with real
     * UNC paths per https://msdn.microsoft.com/en-us/library/gg465305.aspx
     * and rfc3986's definition of reg-name.
     *
     * We check these first to avoid useless calls to the native filesystem's
     * normalizePathProc.
     */
    path = Tcl_GetStringFromObj(pathPtr, &i);

    if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/')
		    || (path[0] == '\\' && path[1] == '\\') ) ) {
	for ( i = 2; ; i++) {
	    if (path[i] == '\0') break;
	    if (path[i] == path[0]) break;
	}
	--i;
	if (path[i] == ':') isVfsPath = 1;
    }

    /*
     * Call each of the "normalise path" functions in succession.
     */
    firstFsRecPtr = FsGetFirstFilesystem();

    Claim();

    if (!isVfsPath) {

	/*
	 * If we have a native filesystem handler, we call it first.  This is
	 * because the root of Tcl's filesystem is always a native filesystem
	 * (i.e., '/' on unix is native).
	 */

    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
	    continue;
	}
	for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
	    if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
		continue;
	    }

	/*
	 * TODO: Assume that we always find the native file system; it should
	 * always be there...
	 */
	    /*
	     * TODO: Assume that we always find the native file system; it should
	     * always be there...
	     */

	if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
	    startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
		    startAt);
	}
	break;
	    if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
		startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
			startAt);
	    }
	    break;
	}
    }

    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
	/*
	 * Skip the native system next time through.
	 */

1783
1784
1785
1786
1787
1788
1789
1790

1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805

1806
1807
1808
1809
1810
1811
1812
1803
1804
1805
1806
1807
1808
1809

1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824

1825
1826
1827
1828
1829
1830
1831
1832







-
+














-
+







    Tcl_IncrRefCount(objPtr);

    /*
     * Try to read first character of stream, so we can check for utf-8 BOM to
     * be handled especially.
     */

    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
    if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters,
     * otherwise replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
	    memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }

1918
1919
1920
1921
1922
1923
1924
1925

1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941

1942
1943
1944
1945
1946
1947
1948
1938
1939
1940
1941
1942
1943
1944

1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960

1961
1962
1963
1964
1965
1966
1967
1968







-
+















-
+







    Tcl_IncrRefCount(objPtr);

    /*
     * Try to read first character of stream, so we can check for utf-8 BOM to
     * be handled especially.
     */

    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
    if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters,
     * otherwise replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
	    memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }
3160
3161
3162
3163
3164
3165
3166
3167
3168


3169
3170
3171
3172
3173
3174
3175
3180
3181
3182
3183
3184
3185
3186


3187
3188
3189
3190
3191
3192
3193
3194
3195







-
-
+
+







 *     unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a
 *     users general request (unlink and not.
 *
 * By default the unlink is done (if not in AUFS). However if the variable is
 * present and set to true (any integer > 0) then the unlink is skipped.
 */

int
TclSkipUnlink(
static int
skipUnlink(
    Tcl_Obj *shlibFile)
{
    /*
     * Order of testing:
     * 1. On hpux we generally want to skip unlink in general
     *
     * Outside of hpux then:
3203
3204
3205
3206
3207
3208
3209
3210
3211


3212
3213
3214
3215
3216
3217
3218
3223
3224
3225
3226
3227
3228
3229


3230
3231
3232
3233
3234
3235
3236
3237
3238







-
-
+
+







	 *     http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h
	 *     http://aufs.sourceforge.net/
	 * Better reference will be gladly taken.
	 */
#ifndef AUFS_SUPER_MAGIC
#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
#endif /* AUFS_SUPER_MAGIC */
	if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
	    (fs.f_type == AUFS_SUPER_MAGIC)) {
	if ((statfs(Tcl_GetString(shlibFile), &fs) == 0)
		&& (fs.f_type == AUFS_SUPER_MAGIC)) {
	    return 1;
	}
    }
#endif /* ... NO_FSTATFS */
#endif /* ... TCL_TEMPLOAD_NO_UNLINK */

    /*
3419
3420
3421
3422
3423
3424
3425
3426

3427
3428
3429
3430
3431
3432
3433
3439
3440
3441
3442
3443
3444
3445

3446
3447
3448
3449
3450
3451
3452
3453







-
+







    }

    /*
     * Try to delete the file immediately - this is possible in some OSes, and
     * avoids any worries about leaving the copy laying around on exit.
     */

    if (!TclSkipUnlink(copyToPtr) &&
    if (!skipUnlink(copyToPtr) &&
	    (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
	Tcl_DecrRefCount(copyToPtr);

	/*
	 * We tell our caller about the real shared library which was loaded.
	 * Note that this does mean that the package list maintained by 'load'
	 * will store the original (vfs) path alongside the temporary load
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718

3719
3720
3721
3722
3723
3724
3725
3708
3709
3710
3711
3712
3713
3714





















3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



+







	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot unload: filesystem does not support unloading",
		    -1));
	}
	return TCL_ERROR;
    }
    TclpUnloadFile(handle);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpUnloadFile --
 *
 *	Unloads a library given its handle
 *
 * This function was once filesystem-specific, but has been made portable by
 * having TclpDlopen return a structure that includes procedure pointers.
 *
 *----------------------------------------------------------------------
 */

void
TclpUnloadFile(
    Tcl_LoadHandle handle)
{
    if (handle->unloadFileProcPtr != NULL) {
	handle->unloadFileProcPtr(handle);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSUnloadTempFile --
 *

Changes to generic/tclIndexObj.c.

872
873
874
875
876
877
878
879


880
881
882
883
884
885
886
872
873
874
875
876
877
878

879
880
881
882
883
884
885
886
887







-
+
+







    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. */
{
    Tcl_Obj *objPtr;
    int i, len, elemLen, flags;
    int i, len, elemLen;
    char flags;
    Interp *iPtr = (Interp *) interp;
    const char *elementStr;

    /*
     * [incr Tcl] does something fairly horrific when generating error
     * messages for its ensembles; it passes the whole set of ensemble
     * arguments as a list in the first argument. This means that this code

Changes to generic/tclInt.decls.

46
47
48
49
50
51
52
53

54
55
56
57
58
59
60
46
47
48
49
50
51
52

53
54
55
56
57
58
59
60







-
+







}
declare 6 {
    void TclCleanupCommand(Command *cmdPtr)
}
declare 7 {
    int TclCopyAndCollapse(int count, const char *src, char *dst)
}
declare 8 {
declare 8 {deprecated {}} {
    int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
}

# TclCreatePipeline unofficially exported for use by BLT.

declare 9 {
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

92
93
94
95
96
97
98
69
70
71
72
73
74
75

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

91
92
93
94
95
96
97
98







-
+














-
+







}
declare 11 {
    void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr)
}
declare 12 {
    void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
}
# Removed in 8.5
# Removed in 8.5:
#declare 13 {
#    int TclDoGlob(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
#}
declare 14 {
    int TclDumpMemoryInfo(ClientData clientData, int flags)
}
# Removed in 8.1:
#  declare 15 {
#      void TclExpandParseValue(ParseValue *pvPtr, int needed)
#  }
declare 16 {
    void TclExprFloatError(Tcl_Interp *interp, double value)
}
# Removed in 8.4
# Removed in 8.4:
#declare 17 {
#    int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
#}
#declare 18 {
#    int TclFileCopyCmd(Tcl_Interp *interp, int argc, char **argv)
#}
#declare 19 {
110
111
112
113
114
115
116
117

118
119
120
121
122
123
124
125
126

127
128
129
130
131
132
133
110
111
112
113
114
115
116

117
118
119
120
121
122
123
124
125

126
127
128
129
130
131
132
133







-
+








-
+







	    int *sizePtr, int *bracePtr)
}
declare 23 {
    Proc *TclFindProc(Interp *iPtr, const char *procName)
}
# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
declare 24 {
    int TclFormatInt(char *buffer, long n)
    int TclFormatInt(char *buffer, Tcl_WideInt n)
}
declare 25 {
    void TclFreePackageInfo(Interp *iPtr)
}
# Removed in 8.1:
#  declare 26 {
#      char *TclGetCwd(Tcl_Interp *interp)
#  }
# Removed in 8.5
# Removed in 8.5:
#declare 27 {
#    int TclGetDate(char *p, unsigned long now, long zone,
#	    unsigned long *timePtr)
#}
declare 28 {
    Tcl_Channel TclpGetDefaultStdChannel(int type)
}
143
144
145
146
147
148
149
150

151
152
153
154
155
156
157
158
159
160
161
162
163

164
165
166
167
168
169
170
143
144
145
146
147
148
149

150
151
152
153
154
155
156
157
158
159
160
161
162

163
164
165
166
167
168
169
170







-
+












-
+







declare 31 {
    const char *TclGetExtension(const char *name)
}
declare 32 {
    int TclGetFrame(Tcl_Interp *interp, const char *str,
	    CallFrame **framePtrPtr)
}
# Removed in Tcl 8.5
# Removed in 8.5:
#declare 33 {
#    TclCmdProcType TclGetInterpProc(void)
#}
declare 34 {
    int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int endValue, int *indexPtr)
}
# Removed in 8.4b2:
#declare 35 {
#    Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    int flags)
#}
# Removed in 8.6a2
# Removed in 8.6a2:
#declare 36 {
#    int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
#}
declare 37 {
    int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName)
}
declare 38 {
181
182
183
184
185
186
187
188

189
190

191
192
193
194
195
196
197
181
182
183
184
185
186
187

188
189

190
191
192
193
194
195
196
197







-
+

-
+







}
declare 41 {
    Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
    CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
}
# Removed in Tcl 8.5a2
# Removed in 8.5a2:
#declare 43 {
#    int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
#    int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
#	    int flags)
#}
declare 44 {
    int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr)
}
declare 45 {
    int TclHideUnsafeCommands(Tcl_Interp *interp)
216
217
218
219
220
221
222
223

224
225

226
227
228
229
230

231
232
233
234
235
236
237
216
217
218
219
220
221
222

223
224

225
226
227
228
229

230
231
232
233
234
235
236
237







-
+

-
+




-
+







declare 50 {
    void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr,
	    Namespace *nsPtr)
}
declare 51 {
    int TclInterpInit(Tcl_Interp *interp)
}
# Removed in Tcl 8.5a2
# Removed in 8.5a2:
#declare 52 {
#    int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
#    int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
#	    int flags)
#}
declare 53 {
    int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
	    int argc, CONST84 char **argv)
	    int argc, const char **argv)
}
declare 54 {
    int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 55 {
    Proc *TclIsProc(Command *cmdPtr)
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
269
270
271
272
273
274
275

276
277
278
279
280
281
282
283







-
+







    int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 64 {
    int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	    int flags)
}
# Removed in Tcl 8.5a2
# Removed in 8.5a2:
#declare 65 {
#    int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
#	    Tcl_Obj *const objv[], int flags)
#}
#declare 66 {
#    int TclOpenFileChannelDeleteProc(TclOpenFileChannelProc_ *proc)
#}
309
310
311
312
313
314
315
316
317
318

319
320
321
322
323
324
325
309
310
311
312
313
314
315



316
317
318
319
320
321
322
323







-
-
-
+







}
declare 75 {
    unsigned long TclpGetClicks(void)
}
declare 76 {
    unsigned long TclpGetSeconds(void)
}

# deprecated
declare 77 {
declare 77 {deprecated {}} {
    void TclpGetTime(Tcl_Time *time)
}
# Removed in 8.6:
#declare 78 {
#    int TclpGetTimeZone(unsigned long time)
#}
# Replaced by Tcl_FSListVolumes in 8.4:
353
354
355
356
357
358
359
360

361
362
363
364
365
366
367
351
352
353
354
355
356
357

358
359
360
361
362
363
364
365







-
+







#  declare 86 {
#      int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar,
#  	    int flags, char **termPtr, ParseValue *pvPtr)
#  }
#  declare 87 {
#      void TclPlatformInit(Tcl_Interp *interp)
#  }
declare 88 {
declare 88 {deprecated {}} {
    char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
	    const char *name1, const char *name2, int flags)
}
declare 89 {
    int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
	    Tcl_Command cmd)
}
376
377
378
379
380
381
382
383

384
385
386
387
388
389
390
374
375
376
377
378
379
380

381
382
383
384
385
386
387
388







-
+







    int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
	    Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description,
	    const char *procName)
}
declare 93 {
    void TclProcDeleteProc(ClientData clientData)
}
# Removed in Tcl 8.5:
# Removed in 8.5:
#declare 94 {
#    int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
#	    int argc, const char **argv)
#}
# Replaced by Tcl_FSStat in 8.4:
#declare 95 {
#    int TclpStat(const char *path, Tcl_StatBuf *buf)
415
416
417
418
419
420
421
422

423
424
425
426
427
428
429
413
414
415
416
417
418
419

420
421
422
423
424
425
426
427







-
+







declare 102 {
    void TclSetupEnv(Tcl_Interp *interp)
}
declare 103 {
    int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
	    int *portPtr)
}
declare 104 {
declare 104 {deprecated {}} {
    int TclSockMinimumBuffersOld(int sock, int size)
}
# Replaced by Tcl_FSStat in 8.4:
#declare 105 {
#    int TclStat(const char *path, Tcl_StatBuf *buf)
#}
#declare 106 {
451
452
453
454
455
456
457
458

459
460
461
462

463
464
465
466

467
468
469

470
471
472
473

474
475
476
477

478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493

494
495
496
497

498
499
500

501
502
503
504

505
506
507

508
509
510
511
512
513
514

515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535

536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553

554
555
556
557
558
559
560
561
562
563
564
565

566
567
568
569
570
571
572
449
450
451
452
453
454
455

456
457
458
459

460
461
462
463

464
465
466

467
468
469
470

471
472
473
474

475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490

491
492
493
494

495
496
497

498
499
500
501

502
503
504

505
506
507
508
509
510
511

512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532

533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550

551
552
553
554
555
556
557
558
559
560
561
562

563
564
565
566
567
568
569
570







-
+



-
+



-
+


-
+



-
+



-
+















-
+



-
+


-
+



-
+


-
+






-
+




















-
+

















-
+











-
+








declare 111 {
    void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name,
	    Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
	    Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 112 {
    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
    int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    Tcl_Obj *objPtr)
}
declare 113 {
    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
    Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name,
	    ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
declare 114 {
    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
    void TclDeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 115 {
    int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
    int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    const char *pattern, int resetListFirst)
}
declare 116 {
    Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
    Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
	    Tcl_Namespace *contextNsPtr, int flags)
}
declare 117 {
    Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
    Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name,
	    Tcl_Namespace *contextNsPtr, int flags)
}
declare 118 {
    int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name,
	    Tcl_ResolverInfo *resInfo)
}
declare 119 {
    int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr,
	    Tcl_ResolverInfo *resInfo)
}
declare 120 {
    Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name,
	    Tcl_Namespace *contextNsPtr, int flags)
}
declare 121 {
    int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
    int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    const char *pattern)
}
declare 122 {
    Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
    Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 123 {
    void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
    void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
	    Tcl_Obj *objPtr)
}
declare 124 {
    Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
    Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp)
}
declare 125 {
    Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
    Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp)
}
declare 126 {
    void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
	    Tcl_Obj *objPtr)
}
declare 127 {
    int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
    int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    const char *pattern, int allowOverwrite)
}
declare 128 {
    void Tcl_PopCallFrame(Tcl_Interp *interp)
}
declare 129 {
    int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr,
	    Tcl_Namespace *nsPtr, int isProcCallFrame)
}
declare 130 {
    int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name)
}
declare 131 {
    void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr,
	    Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
	    Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 132 {
    int TclpHasSockets(Tcl_Interp *interp)
}
declare 133 {
declare 133 {deprecated {}} {
    struct tm *TclpGetDate(const time_t *time, int useGMT)
}
# Removed in 8.5
#declare 134 {
#    size_t TclpStrftime(char *s, size_t maxsize, const char *format,
#	    const struct tm *t, int useGMT)
#}
#declare 135 {
#    int TclpCheckStackSpace(void)
#}

# Added in 8.1:

#declare 137 {
#   int TclpChdir(const char *dirName)
#}
declare 138 {
    CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
    const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
#    int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
#	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
#	    Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
#}
#declare 140 {
#    int TclLooksLikeInt(const char *bytes, int length)
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CompileHookProc *hookProc, ClientData clientData)
}
declare 143 {
    int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr,
621
622
623
624
625
626
627
628
629

630
631
632
633

634
635
636
637
638
639
640
619
620
621
622
623
624
625


626
627
628


629
630
631
632
633
634
635
636







-
-
+


-
-
+







declare 156 {
    void TclRegError(Tcl_Interp *interp, const char *msg,
	    int status)
}
declare 157 {
    Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
declare 158 {
declare 158 {deprecated {use public Tcl_SetStartupScript()}} {
    void TclSetStartupScriptFileName(const char *filename)
}
# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
declare 159 {
declare 159 {deprecated {use public Tcl_GetStartupScript()}} {
    const char *TclGetStartupScriptFileName(void)
}
#declare 160 {
#    int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *dirPtr, char *pattern, char *tail,
#	    GlobTypeData *types)
#}
672
673
674
675
676
677
678
679
680
681

682
683
684
685

686
687
688
689
690
691
692
668
669
670
671
672
673
674



675
676
677


678
679
680
681
682
683
684
685







-
-
-
+


-
-
+








# New function due to TIP #33
declare 166 {
    int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    int index, Tcl_Obj *valuePtr)
}

# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
declare 167 {
declare 167 {deprecated {use public Tcl_SetStartupScript()}} {
    void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
}
# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
declare 168 {
declare 168 {deprecated {use public Tcl_GetStartupScript()}} {
    Tcl_Obj *TclGetStartupScriptPath(void)
}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
declare 169 {
    int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n)
}
declare 170 {
726
727
728
729
730
731
732
733
734
735

736
737
738

739
740
741
742
743
744
745
746
747
748
749
750
751
752
753

754
755
756

757
758
759
760
761
762
763
719
720
721
722
723
724
725

726

727
728
729

730
731
732
733
734
735
736
737
738
739
740
741
742



743
744
745

746
747
748
749
750
751
752
753







-

-
+


-
+












-
-
-
+


-
+







declare 176 {
    void TclCleanupVar(Var *varPtr, Var *arrayPtr)
}
declare 177 {
    void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
	    const char *operation, const char *reason)
}
# TIP 338 made these public - now declared in tcl.h too
declare 178 {
    void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
    void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
}
declare 179 {
    Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
    Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr)
}

# REMOVED
# Allocate lists without copying arrays
# declare 180 {
#    Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv)
# }
#declare 181 {
#    Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
#	    const char *file, int line)
#}

# TclpGmtime and TclpLocaltime promoted to the generic interface from unix

declare 182 {
declare 182 {deprecated {}} {
     struct tm *TclpLocaltime(const time_t *clock)
}
declare 183 {
declare 183 {deprecated {}}  {
     struct tm *TclpGmtime(const time_t *clock)
}

# For the new "Thread Storage" subsystem.

### REMOVED on grounds it should never have been exposed. All these
### functions are now either static in tclThreadStorage.c or
933
934
935
936
937
938
939
940
941
942
943

944
945
946
947
948
949
950
923
924
925
926
927
928
929




930
931
932
933
934
935
936
937







-
-
-
-
+







declare 234 {
    Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
             int *newPtr)
}
declare 235 {
    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}


# TIP 337 made this one public
declare 236 {
declare 236 {deprecated {use Tcl_BackgroundException}} {
    void TclBackgroundException(Tcl_Interp *interp, int code)
}

# TIP #285: Script cancellation support.
declare 237 {
    int TclResetCancellation(Tcl_Interp *interp, int force)
}
1084
1085
1086
1087
1088
1089
1090
1091

1092
1093

1094
1095
1096
1097
1098
1099
1100
1071
1072
1073
1074
1075
1076
1077

1078
1079

1080
1081
1082
1083
1084
1085
1086
1087







-
+

-
+







    int TclpGetPid(Tcl_Pid pid)
}
declare 9 win {
    int TclWinGetPlatformId(void)
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 10 win {
    Tcl_DirEntry *TclpReaddir(DIR *dir)
    Tcl_DirEntry *TclpReaddir(TclDIR *dir)
}
# Removed in 8.3.1 (for Win32s only)
# Removed in 8.3.1 (for Win32s only):
#declare 10 win {
#    int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
#}

# Pipe channel functions

declare 11 win {
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1123
1124
1125
1126
1127
1128
1129

1130
1131
1132
1133
1134
1135
1136







-







}
declare 19 win {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
    void TclWinAddProcess(HANDLE hProcess, DWORD id)
}
# new for 8.4.20+/8.5.12+
declare 21 win {
    char *TclpInetNtoa(struct in_addr addr)
}
# removed permanently for 8.4
#declare 21 win {
#    void TclpAsyncMark(Tcl_AsyncHandler async)
#}
1222
1223
1224
1225
1226
1227
1228
1229

1230
1231
1232
1233
1234
1235
1236
1208
1209
1210
1211
1212
1213
1214

1215
1216
1217
1218
1219
1220
1221
1222







-
+







declare 9 unix {
    TclFile TclpCreateTempFile(const char *contents)
}

# Added in 8.4:

declare 10 unix {
    Tcl_DirEntry *TclpReaddir(DIR *dir)
    Tcl_DirEntry *TclpReaddir(TclDIR *dir)
}
# Slots 11 and 12 are forwarders for functions that were promoted to
# generic Stubs
declare 11 unix {
    struct tm *TclpLocaltime_unix(const time_t *clock)
}
declare 12 unix {

Changes to generic/tclInt.h.

33
34
35
36
37
38
39

















40
41
42
43
44
45
46
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * supporting all the re-invocation mechanisms extensions like Itcl 3
 * need.  As an absolute last resort, folks who must make Itcl 3 work
 * unchanged with Tcl 8.7 can remove this line to regain the migration
 * support.  Tcl 9 will no longer offer even that option.
 */

#define AVOID_HACKS_FOR_ITCL 1


/*
 * Used to tag functions that are only to be visible within the module being
 * built and not outside it (where this is supported by the linker).
 * Also used in the platform-specific *Port.h files.
 */

#ifndef MODULE_SCOPE
#   ifdef __cplusplus
#	define MODULE_SCOPE extern "C"
#   else
#	define MODULE_SCOPE extern
#   endif
#endif



/*
 * Common include files needed by most of the Tcl source files are included
 * here, so that system-dependent personalizations for the include files only
 * have to be made in once place. This results in a few extra includes, but
 * greater modularity. The order of the three groups of #includes is
 * important. For example, stdio.h is needed by tcl.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
128

129
130
131

132
133
134
135
136
137




















138
139
140
141
142
143
144
107
108
109
110
111
112
113













114
115
116
117
118
119
120
121
122

123
124
125

126
127
128
129
130
131

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
161
162
163
164
165
166
167
168







-
-
-
-
-
-
-
-
-
-
-
-
-









-
+


-
+





-
+


-
+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







#    ifdef LITTLE_ENDIAN
#	 if BYTE_ORDER == LITTLE_ENDIAN
#	     undef WORDS_BIGENDIAN
#	 endif
#    endif
#endif

/*
 * Used to tag functions that are only to be visible within the module being
 * built and not outside it (where this is supported by the linker).
 */

#ifndef MODULE_SCOPE
#   ifdef __cplusplus
#	define MODULE_SCOPE extern "C"
#   else
#	define MODULE_SCOPE extern
#   endif
#endif

/*
 * Macros used to cast between pointers and integers (e.g. when storing an int
 * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
 * to/from pointer from/to integer of different size".
 */

#if !defined(INT2PTR) && !defined(PTR2INT)
#   if defined(HAVE_INTPTR_T) || defined(intptr_t)
#	define INT2PTR(p) ((void *)(intptr_t)(p))
#	define PTR2INT(p) ((int)(intptr_t)(p))
#	define PTR2INT(p) ((intptr_t)(p))
#   else
#	define INT2PTR(p) ((void *)(p))
#	define PTR2INT(p) ((int)(p))
#	define PTR2INT(p) ((long)(p))
#   endif
#endif
#if !defined(UINT2PTR) && !defined(PTR2UINT)
#   if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
#	define UINT2PTR(p) ((void *)(uintptr_t)(p))
#	define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
#	define PTR2UINT(p) ((uintptr_t)(p))
#   else
#	define UINT2PTR(p) ((void *)(p))
#	define PTR2UINT(p) ((unsigned int)(p))
#	define PTR2UINT(p) ((unsigned long)(p))
#   endif
#endif

#if defined(_WIN32) && defined(_MSC_VER)
#   define vsnprintf _vsnprintf
#endif

#if !defined(TCL_THREADS)
#   define TCL_THREADS 1
#endif
#if !TCL_THREADS
#   undef TCL_DECLARE_MUTEX
#   define TCL_DECLARE_MUTEX(name)
#   undef  Tcl_MutexLock
#   define Tcl_MutexLock(mutexPtr)
#   undef  Tcl_MutexUnlock
#   define Tcl_MutexUnlock(mutexPtr)
#   undef  Tcl_MutexFinalize
#   define Tcl_MutexFinalize(mutexPtr)
#   undef  Tcl_ConditionNotify
#   define Tcl_ConditionNotify(condPtr)
#   undef  Tcl_ConditionWait
#   define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
#   undef  Tcl_ConditionFinalize
#   define Tcl_ConditionFinalize(condPtr)
#endif

/*
 * The following procedures allow namespaces to be customized to support
 * special name resolution rules for commands/variables.
 */

struct Tcl_ResolvedVarInfo;
156
157
158
159
160
161
162
163

164
165
166

167
168
169

170
171
172
173
174
175
176
180
181
182
183
184
185
186

187
188
189

190
191
192

193
194
195
196
197
198
199
200







-
+


-
+


-
+








typedef struct Tcl_ResolvedVarInfo {
    Tcl_ResolveRuntimeVarProc *fetchProc;
    Tcl_ResolveVarDeleteProc *deleteProc;
} Tcl_ResolvedVarInfo;

typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
	CONST84 char *name, int length, Tcl_Namespace *context,
	const char *name, int length, Tcl_Namespace *context,
	Tcl_ResolvedVarInfo **rPtr);

typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name,
typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name,
	Tcl_Namespace *context, int flags, Tcl_Var *rPtr);

typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name,
typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name,
	Tcl_Namespace *context, int flags, Tcl_Command *rPtr);

typedef struct Tcl_ResolverInfo {
    Tcl_ResolveCmdProc *cmdResProc;
				/* Procedure handling command name
				 * resolution. */
    Tcl_ResolveVarProc *varResProc;
261
262
263
264
265
266
267
268

269
270
271
272
273
274
275
276
277

278
279
280
281
282
283
284
285
286
287
288
289
290
291

292
293
294
295
296
297
298
299
300

301
302
303
304
305
306
307
308







-
+








-
+







				 * strings; values have type (Namespace *). */
#else
    Tcl_HashTable *childTablePtr;
				/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). If
				 * NULL, there are no children. */
#endif
    size_t nsId;		/* Unique id for the namespace. */
    unsigned long nsId;		/* Unique id for the namespace. */
    Tcl_Interp *interp;		/* The interpreter containing this
				 * namespace. */
    int flags;			/* OR-ed combination of the namespace status
				 * flags NS_DYING and NS_DEAD listed below. */
    int activationCount;	/* Number of "activations" or active call
				 * frames for this namespace that are on the
				 * Tcl call stack. The namespace won't be
				 * freed until activationCount becomes zero. */
    int refCount;		/* Count of references by namespaceName
    unsigned int refCount;	/* Count of references by namespaceName
				 * objects. The namespace can't be freed until
				 * refCount becomes zero. */
    Tcl_HashTable cmdTable;	/* Contains all the commands currently
				 * registered in the namespace. Indexed by
				 * strings; values have type (Command *).
				 * Commands imported by Tcl_Import have
				 * Command structures that point (via an
295
296
297
298
299
300
301
302

303
304
305
306
307

308
309
310
311
312
313
314
319
320
321
322
323
324
325

326
327
328
329
330

331
332
333
334
335
336
337
338







-
+




-
+







				 * commands; however, no namespace qualifiers
				 * are allowed. NULL if no export patterns are
				 * registered. */
    int numExportPatterns;	/* Number of export patterns currently
				 * registered using "namespace export". */
    int maxExportPatterns;	/* Mumber of export patterns for which space
				 * is currently allocated. */
    size_t cmdRefEpoch;		/* Incremented if a newly added command
    unsigned int 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. */
    size_t resolverEpoch;	/* Incremented whenever (a) the name
    unsigned int 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
				 * recompiled under the new rules.*/
    Tcl_ResolveCmdProc *cmdResProc;
327
328
329
330
331
332
333
334

335
336
337
338
339
340
341
351
352
353
354
355
356
357

358
359
360
361
362
363
364
365







-
+







    Tcl_ResolveCompiledVarProc *compiledVarResProc;
				/* If non-null, this procedure overrides the
				 * usual variable resolution mechanism in Tcl.
				 * This procedure is invoked within
				 * LookupCompiledLocal to resolve variable
				 * references within the namespace at compile
				 * time. */
    size_t exportLookupEpoch;	/* Incremented whenever a command is added to
    unsigned int exportLookupEpoch;	/* Incremented whenever a command is added to
				 * a namespace, removed from a namespace or
				 * the exports of a namespace are changed.
				 * Allows TIP#112-driven command lists to be
				 * validated efficiently. */
    Tcl_Ensemble *ensembles;	/* List of structures that contain the details
				 * of the ensembles that are implemented on
				 * top of this namespace. */
422
423
424
425
426
427
428
429

430
431
432
433
434
435

436
437
438
439
440
441
442
446
447
448
449
450
451
452

453
454
455
456
457
458

459
460
461
462
463
464
465
466







-
+





-
+







 * commands that are actually exported by the namespace, and an epoch counter
 * that, combined with the exportLookupEpoch field of the namespace structure,
 * defines whether the table contains valid data or will need to be recomputed
 * next time the ensemble command is called.
 */

typedef struct EnsembleConfig {
    Namespace *nsPtr;		/* The namspace backing this ensemble up. */
    Namespace *nsPtr;		/* The namespace backing this ensemble up. */
    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.) */
    size_t epoch;		/* The epoch at which this ensemble's table of
    unsigned int 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. */
    Tcl_HashTable subcommandTable;
				/* Hash table of ensemble subcommand names,
541
542
543
544
545
546
547
548

549
550
551
552
553
554
555
565
566
567
568
569
570
571

572
573
574
575
576
577
578
579







-
+







    ClientData 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
				 * particular command. */
    int refCount;		/* Used to ensure this structure is not
    size_t refCount;	/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
} CommandTrace;

/*
 * When a command trace is active (i.e. its associated procedure is executing)
614
615
616
617
618
619
620
621

622
623
624
625
626
627
628
638
639
640
641
642
643
644

645
646
647
648
649
650
651
652







-
+







				 * "upvar", this field points to the
				 * referenced variable's Var struct. */
    } value;
} Var;

typedef struct VarInHash {
    Var var;
    int refCount;		/* Counts number of active uses of this
    unsigned int refCount;	/* Counts number of active uses of this
				 * variable: 1 for the entry in the hash
				 * table, 1 for each additional variable whose
				 * linkPtr points here, 1 for each nested
				 * trace active on variable, and 1 if the
				 * variable is a namespace variable. This
				 * record can't be deleted until refCount
				 * becomes 0. */
946
947
948
949
950
951
952
953

954
955
956
957
958
959
960
970
971
972
973
974
975
976

977
978
979
980
981
982
983
984







-
+







 * collection of Tcl commands plus information about arguments and other local
 * variables recognized at compile time.
 */

typedef struct Proc {
    struct Interp *iPtr;	/* Interpreter for which this command is
				 * defined. */
    int refCount;		/* Reference count: 1 if still present in
    unsigned int refCount;	/* Reference count: 1 if still present in
				 * command table plus 1 for each call to the
				 * procedure that is currently active. This
				 * structure can be freed when refCount
				 * becomes zero. */
    struct Command *cmdPtr;	/* Points to the Command structure for this
				 * procedure. This is used to get the
				 * namespace in which to execute the
1063
1064
1065
1066
1067
1068
1069
1070

1071
1072
1073
1074
1075
1076
1077
1087
1088
1089
1090
1091
1092
1093

1094
1095
1096
1097
1098
1099
1100
1101







-
+








/*
 * Will be grown to contain: pointers to the varnames (allocated at the end),
 * plus the init values for each variable (suitable to be memcopied on init)
 */

typedef struct LocalCache {
    int refCount;
    unsigned int refCount;
    int numVars;
    Tcl_Obj *varName0;
} LocalCache;

#define localName(framePtr, i) \
    ((&((framePtr)->localCachePtr->varName0))[(i)])

1142
1143
1144
1145
1146
1147
1148




1149
1150
1151
1152
1153
1154
1155
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183







+
+
+
+







				 * 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
				 * 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
				/* 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,
 * uplevel, procedure bodies, ...). The runtime structure essentially contains
 * the stack trace as it would be if the currently executing command were to
1225
1226
1227
1228
1229
1230
1231
1232

1233
1234
1235
1236
1237
1238
1239
1253
1254
1255
1256
1257
1258
1259

1260
1261
1262
1263
1264
1265
1266
1267







-
+







				 * TclArgumentBCEnter(). These will be removed
				 * by TclArgumentBCRelease. */
} CmdFrame;

typedef struct CFWord {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int word;			/* Index of the word in the command. */
    int refCount;		/* Number of times the word is on the
    unsigned int refCount;	/* Number of times the word is on the
				 * stack. */
} CFWord;

typedef struct CFWordBC {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int pc;			/* Instruction pointer of a command in
				 * ExtCmdLoc.loc[.] */
1488
1489
1490
1491
1492
1493
1494
1495

1496
1497
1498
1499

1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519

1520
1521
1522
1523
1524
1525
1526
1516
1517
1518
1519
1520
1521
1522

1523
1524
1525
1526

1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546

1547
1548
1549
1550
1551
1552
1553
1554







-
+



-
+



















-
+








typedef struct LiteralEntry {
    struct LiteralEntry *nextPtr;
				/* Points to next entry in this hash bucket or
				 * NULL if end of chain. */
    Tcl_Obj *objPtr;		/* Points to Tcl object that holds the
				 * literal's bytes and length. */
    int refCount;		/* If in an interpreter's global literal
    size_t refCount;		/* If in an interpreter's global literal
				 * table, the number of ByteCode structures
				 * that share the literal object; the literal
				 * entry can be freed when refCount drops to
				 * 0. If in a local literal table, -1. */
				 * 0. If in a local literal table, (size_t)-1. */
    Namespace *nsPtr;		/* Namespace in which this literal is used. We
				 * try to avoid sharing literal non-FQ command
				 * names among different namespaces to reduce
				 * shimmering. */
} LiteralEntry;

typedef struct LiteralTable {
    LiteralEntry **buckets;	/* Pointer to bucket array. Each element
				 * 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. */
    int numBuckets;		/* Total number of buckets allocated at
				 * **buckets. */
    int numEntries;		/* Total number of entries present in
				 * table. */
    int rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    int mask;			/* Mask value used in hashing function. */
    unsigned int mask;		/* Mask value used in hashing function. */
} LiteralTable;

/*
 * The following structure defines for each Tcl interpreter various
 * statistics-related information about the bytecode compiler and
 * interpreter's operation in that interpreter.
 */
1630
1631
1632
1633
1634
1635
1636
1637

1638
1639
1640
1641
1642

1643
1644
1645
1646
1647
1648
1649
1658
1659
1660
1661
1662
1663
1664

1665
1666
1667
1668
1669

1670
1671
1672
1673
1674
1675
1676
1677







-
+




-
+







				 * from its Tcl_Command handle. NULL means
				 * that the hash table entry has been removed
				 * already (this can happen if deleteProc
				 * causes the command to be deleted or
				 * recreated). */
    Namespace *nsPtr;		/* Points to the namespace containing this
				 * command. */
    int refCount;		/* 1 if in command hashtable plus 1 for each
    unsigned int refCount;	/* 1 if in command hashtable plus 1 for each
				 * reference from a CmdName Tcl object
				 * representing a command's name in a ByteCode
				 * instruction sequence. This structure can be
				 * freed when refCount becomes zero. */
    size_t cmdEpoch;		/* Incremented to invalidate any references
    unsigned int cmdEpoch;	/* Incremented to invalidate any references
				 * that point to this command when it is
				 * renamed, deleted, hidden, or exposed. */
    CompileProc *compileProc;	/* Procedure called to compile command. NULL
				 * if no compile proc exists for command. */
    Tcl_ObjCmdProc *objProc;	/* Object-based command procedure. */
    ClientData objClientData;	/* Arbitrary value passed to object proc. */
    Tcl_CmdProc *proc;		/* String-based command procedure. */
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778



1779
1780
1781
1782
1783










1784
1785
1786
1787










1788
1789
1790
1791
1792
1793
1794
1795




1796
1797

1798
1799

1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819

1820
1821
1822
1823
1824
1825
1826
1797
1798
1799
1800
1801
1802
1803



1804
1805
1806





1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818


1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832




1833
1834
1835
1836


1837


1838

1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856

1857
1858
1859
1860
1861
1862
1863
1864







-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+
+




-
-
-
-
+
+
+
+
-
-
+
-
-
+
-


















-
+







 * variable storage. Primary responsibility for this data structure is in
 * tclBasic.c, but almost every Tcl source file uses something in here.
 *----------------------------------------------------------------
 */

typedef struct Interp {
    /*
     * The first two fields were named "result" and "freeProc" in earlier
     * versions of Tcl.  They are no longer used within Tcl, and are no
     * longer available to be accessed by extensions.  However, they cannot
     * Note: the first three fields must match exactly the fields in a
     * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the
     * other.
     * be removed.  Why?  There is a deployed base of stub-enabled extensions
     * that query the value of iPtr->stubTable.  For them to continue to work,
     * the location of the field "stubTable" within the Interp struct cannot
     * change.  The most robust way to assure that is to leave all fields up to
     * that one undisturbed.
     *
     * The interpreter's result is held in both the string and the
     * objResultPtr fields. These fields hold, respectively, the result's
     * string or object value. The interpreter's result is always in the
     * result field if that is non-empty, otherwise it is in objResultPtr.
     * The two fields are kept consistent unless some C code sets
     * interp->result directly. Programs should not access result and
     * objResultPtr directly; instead, they should always get and set the
     * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and
     * Tcl_GetStringResult. See the SetResult man page for details.
     */

    const char *legacyResult;
    void (*legacyFreeProc) (void);
    char *result;		/* If the last command returned a string
				 * result, this points to it. Should not be
				 * accessed directly; see comment above. */
    Tcl_FreeProc *freeProc;	/* Zero means a string result is statically
				 * allocated. TCL_DYNAMIC means string result
				 * was allocated with ckalloc and should be
				 * freed with ckfree. Other values give
				 * address of procedure to invoke to free the
				 * string result. Tcl_Eval must free it before
				 * executing next command. */
    int errorLine;		/* When TCL_ERROR is returned, this gives the
				 * line number in the command where the error
				 * occurred (1 means first line). */
    const struct TclStubs *stubTable;
				/* Pointer to the exported Tcl stub table.  In
				 * ancient pre-8.1 versions of Tcl this was a
				 * pointer to the objResultPtr or a pointer to a
				 * buckets array in a hash table. Deployed stubs
				/* Pointer to the exported Tcl stub table. On
				 * previous versions of Tcl this is a pointer
				 * to the objResultPtr or a pointer to a
				 * buckets array in a hash table. We therefore
				 * enabled extensions check for a NULL pointer value
				 * and for a TCL_STUBS_MAGIC value to verify they
				 * have to do some careful checking before we
				 * are not [load]ing into one of those pre-stubs
				 * interps.
				 * can use this. */
				 */

    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. */
    ClientData interpInfo;	/* Information used by tclInterp.c to keep
				 * track of master/slave interps on a
				 * per-interp basis. */
    union {
	void (*optimizer)(void *envPtr);
	Tcl_HashTable unused2;	/* No longer used (was mathFuncTable). The
				 * unused space in interp was repurposed for
				 * pluggable bytecode optimizers. The core
				 * contains one optimizer, which can be
				 * selectively overriden by extensions. */
				 * selectively overridden by extensions. */
    } extra;

    /*
     * Information related to procedures and variables. See tclProc.c and
     * tclVar.c for usage.
     */

1843
1844
1845
1846
1847
1848
1849



















1850
1851
1852
1853
1854
1855
1856
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







				 * or NULL if no active traces. */
    int returnCode;		/* [return -code] parameter. */
    CallFrame *rootFramePtr;	/* Global frame pointer for this
				 * interpreter. */
    Namespace *lookupNsPtr;	/* Namespace to use ONLY on the next
				 * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */

    /*
     * Information used by Tcl_AppendResult to keep track of partial results.
     * See Tcl_AppendResult code for details.
     */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    char *appendResult;		/* Storage space for results generated by
				 * Tcl_AppendResult. Ckalloc-ed. NULL means
				 * not yet allocated. */
    int appendAvl;		/* Total amount of space available at
				 * partialResult. */
    int appendUsed;		/* Number of non-null bytes currently stored
				 * at partialResult. */
#else
    char *appendResultDontUse;
    int appendAvlDontUse;
    int appendUsedDontUse;
#endif

    /*
     * Information about packages. Used only in tclPkg.c.
     */

    Tcl_HashTable packageTable;	/* Describes all of the packages loaded in or
				 * available to this interpreter. Keys are
				 * package names, values are (Package *)
1865
1866
1867
1868
1869
1870
1871

1872
1873
1874
1875
1876
1877
1878
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936







+








    int cmdCount;		/* Total number of times a command procedure
				 * has been called for this interpreter. */
    int evalFlags;		/* Flags to control next call to Tcl_Eval.
				 * Normally zero, but may be set before
				 * calling Tcl_Eval. See below for valid
				 * values. */
    int unused1;		/* No longer used (was termOffset) */
    LiteralTable literalTable;	/* Contains LiteralEntry's describing all Tcl
				 * objects holding literals of scripts
				 * compiled by the interpreter. Indexed by the
				 * string representations of literals. Used to
				 * avoid creating duplicate objects. */
    unsigned int compileEpoch;	/* Holds the current "compilation epoch" for
				 * this interpreter. This is incremented to
1902
1903
1904
1905
1906
1907
1908








1909
1910
1911
1912
1913
1914
1915
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981







+
+
+
+
+
+
+
+







    struct ExecEnv *execEnvPtr;	/* Execution environment for Tcl bytecode
				 * execution. Contains a pointer to the Tcl
				 * evaluation stack. */
    Tcl_Obj *emptyObjPtr;	/* Points to an object holding an empty
				 * string. Returned by Tcl_ObjSetVar2 when
				 * variable traces change a variable in a
				 * gross way. */
#if TCL_MAJOR_VERSION < 9
# if !defined(TCL_NO_DEPRECATED)
    char resultSpace[TCL_DSTRING_STATIC_SIZE+1];
				/* Static space holding small results. */
# else
    char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
# endif
#endif
    Tcl_Obj *objResultPtr;	/* If the last command returned an object
				 * result, this points to it. Should not be
				 * accessed directly; see comment above. */
    Tcl_ThreadId threadId;	/* ID of thread that owns the interpreter. */

    ActiveCommandTrace *activeCmdTracePtr;
				/* First in list of active command traces for
2211
2212
2213
2214
2215
2216
2217
2218

2219
2220
2221
2222
2223
2224
2225
2277
2278
2279
2280
2281
2282
2283

2284
2285
2286
2287
2288
2289
2290
2291







-
+







 *			instructions. This is set 1, for example, when command
 *			traces are requested.
 * RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the interp
 *			has not be initialized. This is set 1 when we first
 *			use the rand() or srand() functions.
 * SAFE_INTERP:		Non zero means that the current interp is a safe
 *			interp (i.e. it has only the safe commands installed,
 *			less priviledge than a regular interp).
 *			less privilege than a regular interp).
 * INTERP_DEBUG_FRAME:	Used for switching on various extra interpreter
 *			debug/info mechanisms (e.g. info frame eval/uplevel
 *			tracing) which are performance intensive.
 * INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently
 *			active; so no further trace callbacks should be
 *			invoked.
 * INTERP_ALTERNATE_WRONG_ARGS: Used for listing second and subsequent forms
2344
2345
2346
2347
2348
2349
2350
2351

2352
2353
2354
2355
2356
2357
2358
2359

2360
2361
2362
2363
2364
2365
2366
2410
2411
2412
2413
2414
2415
2416

2417
2418
2419
2420
2421
2422
2423
2424

2425
2426
2427
2428
2429
2430
2431
2432







-
+







-
+







 * struct is grown (reallocated and copied) as necessary to hold all the
 * list's element pointers. The struct might contain more slots than currently
 * used to hold all element pointers. This is done to make append operations
 * faster.
 */

typedef struct List {
    int refCount;
    unsigned int refCount;
    int maxElemCount;		/* Total number of element array slots. */
    int elemCount;		/* Current number of list elements. */
    int canonicalFlag;		/* Set if the string representation was
				 * derived from the list representation. May
				 * be ignored if there is no string rep at
				 * all.*/
    Tcl_Obj *elements;		/* First list element; the struct is grown to
				 * accomodate all elements. */
				 * accommodate all elements. */
} List;

#define LIST_MAX \
	(1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *)))
#define LIST_SIZE(numElems) \
	(unsigned)(sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *)))

2405
2406
2407
2408
2409
2410
2411
2412
2413



2414
2415
2416
2417
2418
2419
2420
2421






2422
2423
2424


2425
2426
2427
2428
2429
2430
2431
2432











2433
2434
2435
2436
2437



2438
2439
2440
2441
2442
2443



2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464

2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481

2482
2483
2484
2485
2486
2487

2488
2489
2490
2491
2492
2493
2494
2471
2472
2473
2474
2475
2476
2477


2478
2479
2480
2481
2482
2483
2484




2485
2486
2487
2488
2489
2490
2491


2492
2493
2494







2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507



2508
2509
2510
2511
2512
2513



2514
2515
2516
2517

2518
2519
2520
2521
2522
2523
2524
2525
2526

2527
2528
2529






2530



2531

2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542

2543
2544
2545
2546
2547
2548

2549
2550
2551
2552
2553
2554
2555
2556







-
-
+
+
+




-
-
-
-
+
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+


-
-
-
+
+
+



-
-
-
+
+
+

-









-



-
-
-
-
-
-
+
-
-
-

-











-
+





-
+







 * 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] */

/*
 * Macros providing a faster path to integers: Tcl_GetLongFromObj,
 * Tcl_GetIntFromObj and TclGetIntForIndex.
 * Macros providing a faster path to booleans and integers:
 * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
 * and TclGetIntForIndex.
 *
 * WARNING: these macros eval their args more than once.
 */

#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType)	\
	    ? ((*(longPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
    (((objPtr)->typePtr == &tclIntType)			\
	? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
	: ((objPtr)->typePtr == &tclBooleanType)			\
	? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK)	\
	: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))

#if (LONG_MAX == INT_MAX)
#define TclGetIntFromObj(interp, objPtr, intPtr) \
#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType)	\
	    ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
    (((objPtr)->typePtr == &tclIntType)	\
	    ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
	    : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
#else
	    ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX))	\
	    ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#endif

#define TclGetIntFromObj(interp, objPtr, intPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.longValue >= -(Tcl_WideInt)(UINT_MAX) \
	    && (objPtr)->internalRep.longValue <= (Tcl_WideInt)(UINT_MAX))	\
	    ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
	    && (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) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.longValue >= INT_MIN \
	    && (objPtr)->internalRep.longValue <= INT_MAX)	\
	    ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
	    && (objPtr)->internalRep.wideValue >= INT_MIN \
	    && (objPtr)->internalRep.wideValue <= INT_MAX)	\
	    ? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
#endif

/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			Tcl_WideInt *wideIntPtr);
 */

#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
    (((objPtr)->typePtr == &tclIntType)					\
	? (*(wideIntPtr) = (Tcl_WideInt)				\
		((objPtr)->internalRep.longValue), TCL_OK) :		\
	Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
#else /* !TCL_WIDE_INT_IS_LONG */
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr)		\
    (((objPtr)->typePtr == &tclWideIntType)				\
	? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) :	\
		((objPtr)->internalRep.wideValue), TCL_OK) :		\
    ((objPtr)->typePtr == &tclIntType)					\
	? (*(wideIntPtr) = (Tcl_WideInt)				\
		((objPtr)->internalRep.longValue), TCL_OK) :		\
	Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
#endif /* TCL_WIDE_INT_IS_LONG */

/*
 * Flag values for TclTraceDictPath().
 *
 * DICT_PATH_READ indicates that all entries on the path must exist but no
 * updates will be needed.
 *
 * DICT_PATH_UPDATE indicates that we are going to be doing an update at the
 * tip of the path, so duplication of shared objects should be done along the
 * way.
 *
 * DICT_PATH_EXISTS indicates that we are performing an existance test and a
 * DICT_PATH_EXISTS indicates that we are performing an existence test and a
 * lookup failure should therefore not be an error. If (and only if) this flag
 * is set, TclTraceDictPath() will return the special value
 * 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-existant dictionaries on the path.
 * 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

2586
2587
2588
2589
2590
2591
2592
2593

2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605

2606
2607

2608
2609
2610
2611
2612
2613
2614
2648
2649
2650
2651
2652
2653
2654

2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666

2667
2668

2669
2670
2671
2672
2673
2674
2675
2676







-
+











-
+

-
+








/*
 *----------------------------------------------------------------
 * Data structures for process-global values.
 *----------------------------------------------------------------
 */

typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr,
	Tcl_Encoding *encodingPtr);

/*
 * 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
 * the value, and the master is kept as a counted string, with epoch and mutex
 * control. Each ProcessGlobalValue struct should be a static variable in some
 * file.
 */

typedef struct ProcessGlobalValue {
    size_t epoch;		/* Epoch counter to detect changes in the
    unsigned int epoch;		/* Epoch counter to detect changes in the
				 * master value. */
    size_t numBytes;		/* Length of the master string. */
    unsigned int numBytes;	/* Length of the master string. */
    char *value;		/* The master string value. */
    Tcl_Encoding encoding;	/* system encoding when master string was
				 * initialized. */
    TclInitProcessGlobalValueProc *proc;
    				/* A procedure to initialize the master string
				 * copy when a "get" request comes in before
				 * any "set" request has been received. */
2643
2644
2645
2646
2647
2648
2649
2650
2651





2652
2653
2654
2655
2656
2657
2658
2705
2706
2707
2708
2709
2710
2711


2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723







-
-
+
+
+
+
+








/*
 *----------------------------------------------------------------------
 * Type values TclGetNumberFromObj
 *----------------------------------------------------------------------
 */

#define TCL_NUMBER_LONG		1
#define TCL_NUMBER_WIDE		2
#define TCL_NUMBER_INT		2
#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED)
#   define TCL_NUMBER_LONG		1 /* deprecated, not used any more */
#   define TCL_NUMBER_WIDE		TCL_NUMBER_INT /* deprecated */
#endif
#define TCL_NUMBER_BIG		3
#define TCL_NUMBER_DOUBLE	4
#define TCL_NUMBER_NAN		5

/*
 *----------------------------------------------------------------
 * Variables shared among Tcl modules but not used by the outside world.
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2753
2754
2755
2756
2757
2758
2759



2760
2761
2762
2763
2764
2765
2766







-
-
-







MODULE_SCOPE const Tcl_ObjType tclEndOffsetType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
#ifndef TCL_WIDE_INT_IS_LONG
MODULE_SCOPE const Tcl_ObjType tclWideIntType;
#endif
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;

/*
 * Variables denoting the hash key types defined in the core.
 */

2725
2726
2727
2728
2729
2730
2731




2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746

2747
2748
2749
2750
2751
2752
2753
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820







+
+
+
+















+







 * Pointer to a heap-allocated string of length zero that the Tcl core uses as
 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */

MODULE_SCOPE char	tclEmptyString;

enum CheckEmptyStringResult {
	TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES
};

/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world,
 * introduced by/for NRE.
 *----------------------------------------------------------------
 */

MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd;

2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868





2869
2870
2871
2872


2873
2874
2875
2876
2877
2878
2879
2880
2881







2882
2883
2884
2885
2886
2887

2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908

2909


2910
2911
2912
2913
2914
2915
2916
2920
2921
2922
2923
2924
2925
2926


2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965

2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986

2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997







-
-







+
+
+
+
+




+
+









+
+
+
+
+
+
+





-
+




















-
+

+
+







MODULE_SCOPE void	TclArgumentBCEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc,
			    void *codePtr, CmdFrame *cfPtr, int cmd, int pc);
MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
MODULE_SCOPE double	TclBignumToDouble(const mp_int *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    int strLen, const unsigned char *pattern,
			    int ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const mp_int *a);
MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int	TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp,
			    const char *value);
MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
			    Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
			    Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
			    int *loc);
MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
			    int start, int *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
			    Tcl_Obj *originObjPtr);
MODULE_SCOPE int	TclConvertElement(const char *src, int length,
			    char *dst, int flags);
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, ClientData clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
			    const char *name, Tcl_Namespace *nameNamespacePtr,
			    Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
			    const char *dict, int dictLength,
			    const char **elementPtr, const char **nextPtr,
			    int *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evulation, with line information. */
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
			    int numBytes, int flags, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
			    Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *const *	TclFetchEnsembleRoot(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int *objcPtr);
MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
MODULE_SCOPE void	TclFinalizeEnvironment(void);
MODULE_SCOPE void	TclFinalizeEvaluation(void);
MODULE_SCOPE void	TclFinalizeExecution(void);
2929
2930
2931
2932
2933
2934
2935





2936
2937
2938
2939
2940
2941
2942
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028







+
+
+
+
+







MODULE_SCOPE void	TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void	TclFinalizeThreadData(int quick);
MODULE_SCOPE void	TclFinalizeThreadObjects(void);
MODULE_SCOPE double	TclFloor(const mp_int *a);
MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
			    const char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
			    ClientData clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    const char *encodingName);
MODULE_SCOPE void	TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
MODULE_SCOPE int *	TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
2954
2955
2956
2957
2958
2959
2960


2961
2962
2963
2964
2965
2966
2967
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055







+
+







MODULE_SCOPE Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
			    unsigned int *sizePtr);
MODULE_SCOPE int	TclGetLoadedPackagesEx(Tcl_Interp *interp,
				const char *targetName,
				const char *packageName);
MODULE_SCOPE int	TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
				Tcl_WideInt *);
MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
			    Tcl_Obj *unquotedPrefix, int globFlags,
			    Tcl_GlobTypeData *types);
MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
3001
3002
3003
3004
3005
3006
3007


3008
3009
3010
3011
3012
3013
3014
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104







+
+







			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    int indexCount, Tcl_Obj *const indexArray[]);
/* TIP #280 */
MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, int line, int n,
			    int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Obj *listPtr, int fromIdx,
			    int toIdx);
MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    int indexCount, Tcl_Obj *const indexArray[],
			    Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
			    const EnsembleImplMap map[]);
3055
3056
3057
3058
3059
3060
3061
3062

3063
3064
3065
3066
3067
3068
3069
3145
3146
3147
3148
3149
3150
3151

3152
3153
3154
3155
3156
3157
3158
3159







-
+







			    const char *host, int port, int willBind,
			    const char **errorMsgPtr);
MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
			    Tcl_ThreadCreateProc *proc, ClientData clientData,
			    int stackSize, int flags);
MODULE_SCOPE int	TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
			    size_t *lengthPtr, Tcl_Encoding *encodingPtr);
			    unsigned int *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void	TclpInitLock(void);
MODULE_SCOPE void	TclpInitPlatform(void);
MODULE_SCOPE void	TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj *	TclpObjListVolumes(void);
MODULE_SCOPE void	TclpMasterLock(void);
MODULE_SCOPE void	TclpMasterUnlock(void);
MODULE_SCOPE int	TclpMatchFiles(Tcl_Interp *interp, char *separators,
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110

3111
3112
3113
3114
3115


3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126

3127
3128


3129
3130

3131
3132
3133


3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151


3152
3153
3154
3155





3156
3157
3158
3159
3160
3161
3162
3179
3180
3181
3182
3183
3184
3185

3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198

3199
3200
3201
3202
3203

3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217


3218
3219


3220



3221
3222
3223
3224
3225
3226



3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255







-













-
+




-
+
+











+
-
-
+
+
-
-
+
-
-
-
+
+




-
-
-











+
+




+
+
+
+
+







			    Tcl_Obj *resultingNameObj);
MODULE_SCOPE void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName);
MODULE_SCOPE void *TclInitPkgFiles(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_PathPart portion);
MODULE_SCOPE char *	TclpReadlink(const char *fileName,
			    Tcl_DString *linkPtr);
MODULE_SCOPE void	TclpSetInterfaces(void);
MODULE_SCOPE void	TclpSetVariables(Tcl_Interp *interp);
MODULE_SCOPE void *	TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr);
MODULE_SCOPE void	TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
			    void *data);
MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status);
MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
			    int *quantifiersFoundPtr);
MODULE_SCOPE int	TclScanElement(const char *string, int length,
			    int *flagPtr);
			    char *flagPtr);
MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix);
MODULE_SCOPE void	TclSetBignumIntRep(Tcl_Obj *objPtr,
			    mp_int *bignumValue);
MODULE_SCOPE int	TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE int	TclSetBooleanFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int	TclStringCatObjv(Tcl_Interp *interp, int inPlace,
			    int objc, Tcl_Obj *const objv[],
MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
			    int checkEq, int nocase, int reqlength);
			    Tcl_Obj **objPtrPtr);
MODULE_SCOPE int	TclStringFind(Tcl_Obj *needle, Tcl_Obj *haystack,
MODULE_SCOPE int	TclStringCmpOpts(Tcl_Interp *interp, int objc,
			    int start);
MODULE_SCOPE int	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int last);
			    Tcl_Obj *const objv[], int *nocase,
			    int *reqlength);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int count, Tcl_Obj **objPtrPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, int numOpts,
			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, Tcl_Parse *parsePtr,
			    Tcl_InterpState *statePtr);
MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
			    int count, int *tokensLeftPtr, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE int	TclTrim(const char *bytes, int numBytes,
			    const char *trim, int numTrim, int *trimRight);
MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
MODULE_SCOPE void	TclRegisterCommandTypeName(
			    Tcl_ObjCmdProc *implementationProc,
			    const char *nameStr);
MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCount(int ch);
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
3171
3172
3173
3174
3175
3176
3177




3178
3179
3180
3181





3182
3183
3184
3185
3186
3187
3188
3189
3190
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284

3285
3286
3287
3288
3289
3290
3291







+
+
+
+




+
+
+
+
+

-







MODULE_SCOPE void	TclFinalizeThreadDataThread(void);
MODULE_SCOPE void	TclFinalizeThreadStorage(void);
#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
#endif
MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE int	TclZipfsInit(Tcl_Interp *interp);
MODULE_SCOPE int        TclZipfsMount(Tcl_Interp *interp, const char *zipname,
			 const char *mntpt, const char *passwd);
MODULE_SCOPE int 	TclZipfsUnmount(Tcl_Interp *interp, const char *zipname);
MODULE_SCOPE void *	TclpThreadCreateKey(void);
MODULE_SCOPE void	TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void	TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void *	TclpThreadGetMasterTSD(void *tsdKeyPtr);
MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
			    const char *msg, int length);
/* Tip 430 */
MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);
MODULE_SCOPE int    TclZipfs_SafeInit(Tcl_Interp *interp);

MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);

/*
 *----------------------------------------------------------------
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */

3198
3199
3200
3201
3202
3203
3204
3205

3206
3207
3208
3209
3210
3211
3212
3299
3300
3301
3302
3303
3304
3305

3306
3307
3308
3309
3310
3311
3312
3313







-
+







			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_BreakObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
MODULE_SCOPE int	Tcl_CaseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#endif
MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3359
3360
3361
3362
3363
3364
3365

3366
3367
3368
3369
3370
3371
3372







-







MODULE_SCOPE int	Tcl_AssembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRAssembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclMakeEncodingCommandSafe(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_EofObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ErrorObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_EvalObjCmd(ClientData clientData,
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3387
3388
3389
3390
3391
3392
3393

3394
3395
3396
3397
3398
3399
3400







-







MODULE_SCOPE int	Tcl_FconfigureObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FcopyObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclMakeFileCommandSafe(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_FileEventObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FlushObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForObjCmd(ClientData clientData,
3937
3938
3939
3940
3941
3942
3943























3944
3945
3946
3947
3948
3949
3950
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

/*
 * Routines that provide the [string] ensemble functionality. Possible
 * candidates for public interface.
 */

MODULE_SCOPE Tcl_Obj *	TclStringCat(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int flags);
MODULE_SCOPE int	TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int start);
MODULE_SCOPE int	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int last);
MODULE_SCOPE Tcl_Obj *	TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int count, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int first, int 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)

/*
 * 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.
 */

MODULE_SCOPE Var *	TclObjLookupVarEx(Tcl_Interp * interp,
3992
3993
3994
3995
3996
3997
3998



























































3999
4000
4001
4002
4003
4004
4005
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








MODULE_SCOPE int	TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
MODULE_SCOPE void	TclFreeObjEntry(Tcl_HashEntry *hPtr);
MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);

MODULE_SCOPE int	TclFullFinalizationRequested(void);

/*
 * Just for the purposes of command-type registration.
 */

MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclLocalAliasObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclSlaveObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInvokeImportedCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOPublicObjectCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOPrivateObjectCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOMyClassObjCmd;

/*
 * TIP #462.
 */

/*
 * The following enum values give the status of a spawned process.
 */

typedef enum TclProcessWaitStatus {
    TCL_PROCESS_ERROR = -1,	/* Error waiting for process to exit */
    TCL_PROCESS_UNCHANGED = 0,	/* No change since the last call. */
    TCL_PROCESS_EXITED = 1,	/* Process has exited. */
    TCL_PROCESS_SIGNALED = 2,	/* Child killed because of a signal. */
    TCL_PROCESS_STOPPED = 3,	/* Child suspended because of a signal. */
    TCL_PROCESS_UNKNOWN_STATUS = 4
				/* Child wait status didn't make sense. */
} TclProcessWaitStatus;

MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,
			    Tcl_Obj **errorObjPtr);

/*
 * TIP #508: [array default]
 */

MODULE_SCOPE void	TclInitArrayVar(Var *arrayPtr);
MODULE_SCOPE Tcl_Obj *	TclGetArrayDefault(Var *arrayPtr);

/*
 * Utility routines for encoding index values as integers. Used by both
 * some of the command compilers and by [lsort] and [lsearch].
 */

MODULE_SCOPE int	TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int before, int after, int *indexPtr);
MODULE_SCOPE int	TclIndexDecode(int encoded, int endValue);

/* Constants used in index value encoding routines. */
#define TCL_INDEX_END           (-2)
#define TCL_INDEX_BEFORE        (-1)
#define TCL_INDEX_START         (0)
#define TCL_INDEX_AFTER         (INT_MAX)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and release Tcl objects.
 * TclNewObj(objPtr) creates a new object denoting an empty string.
 * TclDecrRefCount(objPtr) decrements the object's reference count, and frees
 * the object if its reference count is zero. These macros are inline versions
 * of Tcl_NewObj() and Tcl_DecrRefCount(). Notice that the names differ in not
4077
4078
4079
4080
4081
4082
4083




4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102

4103
4104
4105
4106
4107
4108
4109
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286

4287
4288
4289
4290
4291
4292
4293
4294







+
+
+
+


















-
+







	    (objPtr)->length = -1; \
	    TclFreeObjStorage(objPtr); \
	    TclIncrObjsFreed(); \
	} else { \
	    TclFreeObj(objPtr); \
	} \
    }

#if TCL_THREADS && !defined(USE_THREAD_ALLOC)
#   define USE_THREAD_ALLOC 1
#endif

#if defined(PURIFY)

/*
 * The PURIFY mode is like the regular mode, but instead of doing block
 * Tcl_Obj allocation and keeping a freed list for efficiency, it always
 * allocates and frees a single Tcl_Obj so that tools like Purify can better
 * track memory leaks.
 */

#  define TclAllocObjStorageEx(interp, objPtr) \
	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))

#  define TclFreeObjStorageEx(interp, objPtr) \
	ckfree(objPtr)

#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
#elif TCL_THREADS && defined(USE_THREAD_ALLOC)

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
 * per-thread caches.
 */

MODULE_SCOPE Tcl_Obj *	TclThreadAllocObj(void);
4160
4161
4162
4163
4164
4165
4166
4167

4168
4169
4170
4171
4172
4173
4174
4345
4346
4347
4348
4349
4350
4351

4352
4353
4354
4355
4356
4357
4358
4359







-
+







#if defined(USE_TCLALLOC) && USE_TCLALLOC
    MODULE_SCOPE void TclFinalizeAllocSubsystem();
    MODULE_SCOPE void TclInitAlloc();
#else
#   define USE_TCLALLOC 0
#endif

#ifdef TCL_THREADS
#if TCL_THREADS
/* declared in tclObj.c */
MODULE_SCOPE Tcl_Mutex	tclObjMutex;
#endif

#  define TclAllocObjStorageEx(interp, objPtr) \
    do {								\
	Tcl_MutexLock(&tclObjMutex);					\
4376
4377
4378
4379
4380
4381
4382
4383

4384
4385
4386
4387
4388
4389
4390
4561
4562
4563
4564
4565
4566
4567

4568
4569
4570
4571
4572
4573
4574
4575







-
+







 * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclUtfToUniChar(const char *string, Tcl_UniChar *ch);
 *----------------------------------------------------------------
 */

#define TclUtfToUniChar(str, chPtr) \
	((((unsigned char) *(str)) < 0xC0) ?		\
	((((unsigned char) *(str)) < 0x80) ?		\
	    ((*(chPtr) = (unsigned char) *(str)), 1)	\
	    : Tcl_UtfToUniChar(str, chPtr))

/*
 *----------------------------------------------------------------
 * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
 * -sensitive points where it pays to avoid a function call in the common case
4420
4421
4422
4423
4424
4425
4426



4427
4428
4429
4430
4431
4432
4433
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621







+
+
+







 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclIsPureDict(objPtr) \
	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for
 * this macro is:
4501
4502
4503
4504
4505
4506
4507
4508
4509

4510
4511
4512
4513
4514

4515
4516
4517
4518

4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547

4548
4549
4550
4551
4552
4553
4554
4555
4556

4557
4558
4559
4560
4561
4562

4563
4564
4565
4566
4567
4568
4569
4689
4690
4691
4692
4693
4694
4695


4696
4697
4698
4699
4700

4701
4702
4703
4704

4705
4706
4707
4708










4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722


4723
4724
4725
4726
4727
4728
4729
4730
4731

4732
4733
4734
4735
4736
4737

4738
4739
4740
4741
4742
4743
4744
4745







-
-
+




-
+



-
+



-
-
-
-
-
-
-
-
-
-














-
-
+








-
+





-
+







/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to set a Tcl_Obj's numeric representation
 * avoiding the corresponding function calls in time critical parts of the
 * core. They should only be called on unshared objects. The ANSI C
 * "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	TclSetLongObj(Tcl_Obj *objPtr, long longValue);
 * MODULE_SCOPE void	TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclSetIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclSetDoubleObj(Tcl_Obj *objPtr, double d);
 *----------------------------------------------------------------
 */

#define TclSetLongObj(objPtr, i) \
#define TclSetIntObj(objPtr, i) \
    do {						\
	TclInvalidateStringRep(objPtr);			\
	TclFreeIntRep(objPtr);				\
	(objPtr)->internalRep.longValue = (long)(i);	\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(i);	\
	(objPtr)->typePtr = &tclIntType;		\
    } while (0)

#ifndef TCL_WIDE_INT_IS_LONG
#define TclSetWideIntObj(objPtr, w) \
    do {							\
	TclInvalidateStringRep(objPtr);				\
	TclFreeIntRep(objPtr);					\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
	(objPtr)->typePtr = &tclWideIntType;			\
    } while (0)
#endif

#define TclSetDoubleObj(objPtr, d) \
    do {							\
	TclInvalidateStringRep(objPtr);				\
	TclFreeIntRep(objPtr);					\
	(objPtr)->internalRep.doubleValue = (double)(d);	\
	(objPtr)->typePtr = &tclDoubleType;			\
    } while (0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and initialise objects of standard
 * types, avoiding the corresponding function calls in time critical parts of
 * the core. The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	TclNewLongObj(Tcl_Obj *objPtr, long l);
 * MODULE_SCOPE void	TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclNewDoubleObj(Tcl_Obj *objPtr, double d);
 * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len);
 * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
 *
 *----------------------------------------------------------------
 */

#ifndef TCL_MEM_DEBUG
#define TclNewLongObj(objPtr, i) \
#define TclNewIntObj(objPtr, i) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.longValue = (long)(i);	\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(i);	\
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewDoubleObj(objPtr, d) \
    do {							\
	TclIncrObjsAllocated();					\
4582
4583
4584
4585
4586
4587
4588
4589
4590


4591
4592
4593
4594
4595
4596
4597
4758
4759
4760
4761
4762
4763
4764


4765
4766
4767
4768
4769
4770
4771
4772
4773







-
-
+
+







	(objPtr)->refCount = 0;					\
	TclInitStringRep((objPtr), (s), (len));			\
	(objPtr)->typePtr = NULL;				\
	TCL_DTRACE_OBJ_CREATE(objPtr);				\
    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewLongObj(objPtr, l) \
    (objPtr) = Tcl_NewLongObj(l)
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)

#define TclNewDoubleObj(objPtr, d) \
    (objPtr) = Tcl_NewDoubleObj(d)

#define TclNewStringObj(objPtr, s, len) \
    (objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */

Changes to generic/tclIntDecls.h.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43














44
45

46
47
48
49
50
51
52
24
25
26
27
28
29
30













31
32
33
34
35
36
37
38
39
40
41
42
43
44


45
46
47
48
49
50
51
52







-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+







#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif

/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
#undef Tcl_CreateNamespace
#undef Tcl_DeleteNamespace
#undef Tcl_AppendExportList
#undef Tcl_Export
#undef Tcl_Import
#undef Tcl_ForgetImport
#undef Tcl_GetCurrentNamespace
#undef Tcl_GetGlobalNamespace
#undef Tcl_FindNamespace
#undef Tcl_FindCommand
#undef Tcl_GetCommandFromObj
#undef Tcl_GetCommandFullName
#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
/* Those macro's are especially for Itcl 3.4 compatibility */
#   define tclCreateNamespace tcl_CreateNamespace
#   define tclDeleteNamespace tcl_DeleteNamespace
#   define tclAppendExportList tcl_AppendExportList
#   define tclExport tcl_Export
#   define tclImport tcl_Import
#   define tclForgetImport tcl_ForgetImport
#   define tclGetCurrentNamespace_ tcl_GetCurrentNamespace
#   define tclGetGlobalNamespace_ tcl_GetGlobalNamespace
#   define tclFindNamespace tcl_FindNamespace
#   define tclFindCommand tcl_FindCommand
#   define tclGetCommandFromObj tcl_GetCommandFromObj
#   define tclGetCommandFullName tcl_GetCommandFullName
#undef Tcl_SetStartupScript
#undef Tcl_GetStartupScript
#endif /* !defined(TCL_NO_DEPRECATED) */

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tclInt.decls script.
 */

71
72
73
74
75
76
77

78

79
80
81
82
83
84
85
71
72
73
74
75
76
77
78

79
80
81
82
83
84
85
86







+
-
+







				Tcl_Pid *pidPtr, Tcl_Channel errorChan);
/* 6 */
EXTERN void		TclCleanupCommand(Command *cmdPtr);
/* 7 */
EXTERN int		TclCopyAndCollapse(int count, const char *src,
				char *dst);
/* 8 */
TCL_DEPRECATED("")
EXTERN int		TclCopyChannelOld(Tcl_Interp *interp,
int			TclCopyChannelOld(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				int toRead, Tcl_Obj *cmdPtr);
/* 9 */
EXTERN int		TclCreatePipeline(Tcl_Interp *interp, int argc,
				const char **argv, Tcl_Pid **pidArrayPtr,
				TclFile *inPipePtr, TclFile *outPipePtr,
				TclFile *errFilePtr);
109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
110
111
112
113
114
115
116

117
118
119
120
121
122
123
124







-
+







				const char *listStr, int listLength,
				const char **elementPtr,
				const char **nextPtr, int *sizePtr,
				int *bracePtr);
/* 23 */
EXTERN Proc *		TclFindProc(Interp *iPtr, const char *procName);
/* 24 */
EXTERN int		TclFormatInt(char *buffer, long n);
EXTERN int		TclFormatInt(char *buffer, Tcl_WideInt n);
/* 25 */
EXTERN void		TclFreePackageInfo(Interp *iPtr);
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* 28 */
EXTERN Tcl_Channel	TclpGetDefaultStdChannel(int type);
/* Slot 29 is reserved */
169
170
171
172
173
174
175
176

177
178
179
180
181
182
183
170
171
172
173
174
175
176

177
178
179
180
181
182
183
184







-
+







				CallFrame *framePtr, Namespace *nsPtr);
/* 51 */
EXTERN int		TclInterpInit(Tcl_Interp *interp);
/* Slot 52 is reserved */
/* 53 */
EXTERN int		TclInvokeObjectCommand(ClientData clientData,
				Tcl_Interp *interp, int argc,
				CONST84 char **argv);
				const char **argv);
/* 54 */
EXTERN int		TclInvokeStringCommand(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 55 */
EXTERN Proc *		TclIsProc(Command *cmdPtr);
/* Slot 56 is reserved */
214
215
216
217
218
219
220

221

222
223
224
225
226
227
228
229
230
231
232
233

234

235
236
237
238
239
240
241
215
216
217
218
219
220
221
222

223
224
225
226
227
228
229
230
231
232
233
234
235
236

237
238
239
240
241
242
243
244







+
-
+












+
-
+







/* 74 */
EXTERN void		TclpFree(char *ptr);
/* 75 */
EXTERN unsigned long	TclpGetClicks(void);
/* 76 */
EXTERN unsigned long	TclpGetSeconds(void);
/* 77 */
TCL_DEPRECATED("")
EXTERN void		TclpGetTime(Tcl_Time *time);
void			TclpGetTime(Tcl_Time *time);
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
EXTERN char *		TclpRealloc(char *ptr, unsigned int size);
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* 88 */
TCL_DEPRECATED("")
EXTERN char *		TclPrecTraceProc(ClientData clientData,
char *			TclPrecTraceProc(ClientData clientData,
				Tcl_Interp *interp, const char *name1,
				const char *name2, int flags);
/* 89 */
EXTERN int		TclPreventAliasLoop(Tcl_Interp *interp,
				Tcl_Interp *cmdInterp, Tcl_Command cmd);
/* Slot 90 is reserved */
/* 91 */
263
264
265
266
267
268
269

270

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287

288
289
290

291
292
293
294

295
296

297
298
299

300
301
302

303
304
305
306
307
308
309
310
311
312
313
314
315
316
317

318
319
320

321
322
323

324
325
326

327
328

329
330
331
332
333

334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352

353

354
355
356
357
358
359
360

361
362
363
364
365

366
367
368
369
370
371
372
266
267
268
269
270
271
272
273

274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290

291
292
293

294
295
296
297

298
299

300
301
302

303
304
305

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320

321
322
323

324
325
326

327
328
329

330
331

332
333
334
335
336

337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357

358
359
360
361
362
363


364
365
366
367


368
369
370
371
372
373
374
375







+
-
+
















-
+


-
+



-
+

-
+


-
+


-
+














-
+


-
+


-
+


-
+

-
+




-
+



















+
-
+





-
-
+



-
-
+







EXTERN CONST86 char *	TclSetPreInitScript(const char *string);
/* 102 */
EXTERN void		TclSetupEnv(Tcl_Interp *interp);
/* 103 */
EXTERN int		TclSockGetPort(Tcl_Interp *interp, const char *str,
				const char *proto, int *portPtr);
/* 104 */
TCL_DEPRECATED("")
EXTERN int		TclSockMinimumBuffersOld(int sock, int size);
int			TclSockMinimumBuffersOld(int sock, int size);
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
/* 108 */
EXTERN void		TclTeardownNamespace(Namespace *nsPtr);
/* 109 */
EXTERN int		TclUpdateReturnInfo(Interp *iPtr);
/* 110 */
EXTERN int		TclSockMinimumBuffers(void *sock, int size);
/* 111 */
EXTERN void		Tcl_AddInterpResolvers(Tcl_Interp *interp,
				const char *name,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 112 */
EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
EXTERN int		TclAppendExportList(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 113 */
EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
EXTERN Tcl_Namespace *	TclCreateNamespace(Tcl_Interp *interp,
				const char *name, ClientData clientData,
				Tcl_NamespaceDeleteProc *deleteProc);
/* 114 */
EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
EXTERN void		TclDeleteNamespace(Tcl_Namespace *nsPtr);
/* 115 */
EXTERN int		Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
EXTERN int		TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
				const char *pattern, int resetListFirst);
/* 116 */
EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, const char *name,
EXTERN Tcl_Command	TclFindCommand(Tcl_Interp *interp, const char *name,
				Tcl_Namespace *contextNsPtr, int flags);
/* 117 */
EXTERN Tcl_Namespace *	Tcl_FindNamespace(Tcl_Interp *interp,
EXTERN Tcl_Namespace *	TclFindNamespace(Tcl_Interp *interp,
				const char *name,
				Tcl_Namespace *contextNsPtr, int flags);
/* 118 */
EXTERN int		Tcl_GetInterpResolvers(Tcl_Interp *interp,
				const char *name, Tcl_ResolverInfo *resInfo);
/* 119 */
EXTERN int		Tcl_GetNamespaceResolvers(
				Tcl_Namespace *namespacePtr,
				Tcl_ResolverInfo *resInfo);
/* 120 */
EXTERN Tcl_Var		Tcl_FindNamespaceVar(Tcl_Interp *interp,
				const char *name,
				Tcl_Namespace *contextNsPtr, int flags);
/* 121 */
EXTERN int		Tcl_ForgetImport(Tcl_Interp *interp,
EXTERN int		TclForgetImport(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, const char *pattern);
/* 122 */
EXTERN Tcl_Command	Tcl_GetCommandFromObj(Tcl_Interp *interp,
EXTERN Tcl_Command	TclGetCommandFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 123 */
EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
EXTERN void		TclGetCommandFullName(Tcl_Interp *interp,
				Tcl_Command command, Tcl_Obj *objPtr);
/* 124 */
EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace(Tcl_Interp *interp);
EXTERN Tcl_Namespace *	TclGetCurrentNamespace_(Tcl_Interp *interp);
/* 125 */
EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace(Tcl_Interp *interp);
EXTERN Tcl_Namespace *	TclGetGlobalNamespace_(Tcl_Interp *interp);
/* 126 */
EXTERN void		Tcl_GetVariableFullName(Tcl_Interp *interp,
				Tcl_Var variable, Tcl_Obj *objPtr);
/* 127 */
EXTERN int		Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
EXTERN int		TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
				const char *pattern, int allowOverwrite);
/* 128 */
EXTERN void		Tcl_PopCallFrame(Tcl_Interp *interp);
/* 129 */
EXTERN int		Tcl_PushCallFrame(Tcl_Interp *interp,
				Tcl_CallFrame *framePtr,
				Tcl_Namespace *nsPtr, int isProcCallFrame);
/* 130 */
EXTERN int		Tcl_RemoveInterpResolvers(Tcl_Interp *interp,
				const char *name);
/* 131 */
EXTERN void		Tcl_SetNamespaceResolvers(
				Tcl_Namespace *namespacePtr,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 132 */
EXTERN int		TclpHasSockets(Tcl_Interp *interp);
/* 133 */
TCL_DEPRECATED("")
EXTERN struct tm *	TclpGetDate(const time_t *time, int useGMT);
struct tm *		TclpGetDate(const time_t *time, int useGMT);
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
/* 138 */
EXTERN CONST84_RETURN char * TclGetEnv(const char *name,
				Tcl_DString *valuePtr);
EXTERN const char *	TclGetEnv(const char *name, Tcl_DString *valuePtr);
/* Slot 139 is reserved */
/* Slot 140 is reserved */
/* 141 */
EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp,
				Tcl_DString *cwdPtr);
EXTERN const char *	TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 142 */
EXTERN int		TclSetByteCodeFromAny(Tcl_Interp *interp,
				Tcl_Obj *objPtr, CompileHookProc *hookProc,
				ClientData clientData);
/* 143 */
EXTERN int		TclAddLiteralObj(struct CompileEnv *envPtr,
				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
397
398
399
400
401
402
403

404

405

406

407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424

425

426

427

428
429
430
431
432
433
434
400
401
402
403
404
405
406
407

408
409
410

411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430

431
432
433

434
435
436
437
438
439
440
441







+
-
+

+
-
+


















+
-
+

+
-
+







/* 156 */
EXTERN void		TclRegError(Tcl_Interp *interp, const char *msg,
				int status);
/* 157 */
EXTERN Var *		TclVarTraceExists(Tcl_Interp *interp,
				const char *varName);
/* 158 */
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
EXTERN void		TclSetStartupScriptFileName(const char *filename);
void			TclSetStartupScriptFileName(const char *filename);
/* 159 */
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
EXTERN const char *	TclGetStartupScriptFileName(void);
const char *		TclGetStartupScriptFileName(void);
/* Slot 160 is reserved */
/* 161 */
EXTERN int		TclChannelTransform(Tcl_Interp *interp,
				Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
/* 162 */
EXTERN void		TclChannelEventScriptInvoker(ClientData clientData,
				int flags);
/* 163 */
EXTERN const void *	TclGetInstructionTable(void);
/* 164 */
EXTERN void		TclExpandCodeArray(void *envPtr);
/* 165 */
EXTERN void		TclpSetInitialEncodings(void);
/* 166 */
EXTERN int		TclListObjSetElement(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int index,
				Tcl_Obj *valuePtr);
/* 167 */
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
EXTERN void		TclSetStartupScriptPath(Tcl_Obj *pathPtr);
void			TclSetStartupScriptPath(Tcl_Obj *pathPtr);
/* 168 */
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
EXTERN Tcl_Obj *	TclGetStartupScriptPath(void);
Tcl_Obj *		TclGetStartupScriptPath(void);
/* 169 */
EXTERN int		TclpUtfNcmp2(const char *s1, const char *s2,
				unsigned long n);
/* 170 */
EXTERN int		TclCheckInterpTraces(Tcl_Interp *interp,
				const char *command, int numChars,
				Command *cmdPtr, int result, int traceFlags,
453
454
455
456
457
458
459
460

461
462
463

464
465
466

467

468

469

470
471
472
473
474
475
476
460
461
462
463
464
465
466

467
468
469

470
471
472
473
474

475
476
477

478
479
480
481
482
483
484
485







-
+


-
+



+
-
+

+
-
+







/* 176 */
EXTERN void		TclCleanupVar(Var *varPtr, Var *arrayPtr);
/* 177 */
EXTERN void		TclVarErrMsg(Tcl_Interp *interp, const char *part1,
				const char *part2, const char *operation,
				const char *reason);
/* 178 */
EXTERN void		Tcl_SetStartupScript(Tcl_Obj *pathPtr,
EXTERN void		TclSetStartupScript(Tcl_Obj *pathPtr,
				const char *encodingName);
/* 179 */
EXTERN Tcl_Obj *	Tcl_GetStartupScript(const char **encodingNamePtr);
EXTERN Tcl_Obj *	TclGetStartupScript(const char **encodingNamePtr);
/* Slot 180 is reserved */
/* Slot 181 is reserved */
/* 182 */
TCL_DEPRECATED("")
EXTERN struct tm *	TclpLocaltime(const time_t *clock);
struct tm *		TclpLocaltime(const time_t *clock);
/* 183 */
TCL_DEPRECATED("")
EXTERN struct tm *	TclpGmtime(const time_t *clock);
struct tm *		TclpGmtime(const time_t *clock);
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
/* Slot 187 is reserved */
/* Slot 188 is reserved */
/* Slot 189 is reserved */
/* Slot 190 is reserved */
566
567
568
569
570
571
572

573

574
575
576
577
578
579
580
575
576
577
578
579
580
581
582

583
584
585
586
587
588
589
590







+
-
+







/* 234 */
EXTERN Var *		TclVarHashCreateVar(TclVarHashTable *tablePtr,
				const char *key, int *newPtr);
/* 235 */
EXTERN void		TclInitVarHashTable(TclVarHashTable *tablePtr,
				Namespace *nsPtr);
/* 236 */
TCL_DEPRECATED("use Tcl_BackgroundException")
EXTERN void		TclBackgroundException(Tcl_Interp *interp, int code);
void			TclBackgroundException(Tcl_Interp *interp, int code);
/* 237 */
EXTERN int		TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
EXTERN int		TclNRInterpProc(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 239 */
648
649
650
651
652
653
654
655

656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671

672
673
674
675
676
677
678
658
659
660
661
662
663
664

665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680

681
682
683
684
685
686
687
688







-
+















-
+







    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*tclAllocateFreeObjects) (void); /* 3 */
    void (*reserved4)(void);
    int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
    void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
    int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
    int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
    TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
    int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
    int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
    void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
    void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */
    void (*reserved13)(void);
    int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */
    void (*reserved15)(void);
    void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */
    void (*reserved17)(void);
    void (*reserved18)(void);
    void (*reserved19)(void);
    void (*reserved20)(void);
    void (*reserved21)(void);
    int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */
    Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
    int (*tclFormatInt) (char *buffer, long n); /* 24 */
    int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */
    void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
    void (*reserved26)(void);
    void (*reserved27)(void);
    Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
    void (*reserved29)(void);
    void (*reserved30)(void);
    const char * (*tclGetExtension) (const char *name); /* 31 */
693
694
695
696
697
698
699
700

701
702
703
704
705
706
707
703
704
705
706
707
708
709

710
711
712
713
714
715
716
717







-
+







    int (*tclInExit) (void); /* 46 */
    void (*reserved47)(void);
    void (*reserved48)(void);
    void (*reserved49)(void);
    void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
    int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
    void (*reserved52)(void);
    int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */
    int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */
    int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
    Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
    void (*reserved56)(void);
    void (*reserved57)(void);
    Var * (*tclLookupVar) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */
    void (*reserved59)(void);
    int (*tclNeedSpace) (const char *start, const char *end); /* 60 */
717
718
719
720
721
722
723
724

725
726
727
728
729
730
731
732
733
734
735

736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751

752
753
754
755
756
757
758
759
760
761
762
763
764






765
766
767
768
769
770
771
772





773
774

775
776
777
778
779
780

781
782
783
784
785

786
787
788

789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806


807
808
809
810
811
812
813
814
815


816
817
818
819
820
821
822
823
824
825
826


827
828
829
830


831
832
833
834
835
836
837
727
728
729
730
731
732
733

734
735
736
737
738
739
740
741
742
743
744

745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760

761
762
763
764
765
766
767
768






769
770
771
772
773
774
775
776
777





778
779
780
781
782
783

784
785
786
787
788
789

790
791
792
793
794

795
796
797

798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814


815
816
817
818
819
820
821
822
823


824
825
826
827
828
829
830
831
832
833
834


835
836
837
838


839
840
841
842
843
844
845
846
847







-
+










-
+















-
+







-
-
-
-
-
-
+
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+

-
+





-
+




-
+


-
+
















-
-
+
+







-
-
+
+









-
-
+
+


-
-
+
+







    void (*reserved70)(void);
    void (*reserved71)(void);
    void (*reserved72)(void);
    void (*reserved73)(void);
    void (*tclpFree) (char *ptr); /* 74 */
    unsigned long (*tclpGetClicks) (void); /* 75 */
    unsigned long (*tclpGetSeconds) (void); /* 76 */
    void (*tclpGetTime) (Tcl_Time *time); /* 77 */
    TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */
    void (*reserved78)(void);
    void (*reserved79)(void);
    void (*reserved80)(void);
    char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
    void (*reserved82)(void);
    void (*reserved83)(void);
    void (*reserved84)(void);
    void (*reserved85)(void);
    void (*reserved86)(void);
    void (*reserved87)(void);
    char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
    TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
    int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
    void (*reserved90)(void);
    void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
    int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */
    void (*tclProcDeleteProc) (ClientData clientData); /* 93 */
    void (*reserved94)(void);
    void (*reserved95)(void);
    int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */
    void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
    int (*tclServiceIdle) (void); /* 98 */
    void (*reserved99)(void);
    void (*reserved100)(void);
    CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
    void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
    int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
    int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
    TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
    void (*reserved105)(void);
    void (*reserved106)(void);
    void (*reserved107)(void);
    void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */
    int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
    int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
    void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
    int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
    void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
    int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
    Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
    void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
    int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
    Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
    Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
    int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
    int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
    Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
    int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
    Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
    void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
    Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */
    Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */
    int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
    Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
    void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
    Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */
    Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */
    void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
    int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
    int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
    void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
    int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
    int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
    void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
    int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
    struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
    TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
    void (*reserved134)(void);
    void (*reserved135)(void);
    void (*reserved136)(void);
    void (*reserved137)(void);
    CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
    const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
    void (*reserved139)(void);
    void (*reserved140)(void);
    CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
    const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
    int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */
    int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
    void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
    const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */
    TclHandle (*tclHandleCreate) (void *ptr); /* 146 */
    void (*tclHandleFree) (TclHandle handle); /* 147 */
    TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
    void (*tclHandleRelease) (TclHandle handle); /* 149 */
    int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */
    void (*tclRegExpRangeUniChar) (Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 151 */
    void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */
    Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */
    void (*reserved154)(void);
    void (*reserved155)(void);
    void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
    Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
    void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
    const char * (*tclGetStartupScriptFileName) (void); /* 159 */
    TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
    TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */
    void (*reserved160)(void);
    int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
    void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
    const void * (*tclGetInstructionTable) (void); /* 163 */
    void (*tclExpandCodeArray) (void *envPtr); /* 164 */
    void (*tclpSetInitialEncodings) (void); /* 165 */
    int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
    void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
    Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
    TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
    TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
    int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */
    int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
    int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
    int (*tclInThreadExit) (void); /* 172 */
    int (*tclUniCharMatch) (const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* 173 */
    void (*reserved174)(void);
    int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
    void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
    void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
    void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
    Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */
    void (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
    Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */
    void (*reserved180)(void);
    void (*reserved181)(void);
    struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
    struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
    TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
    TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
    void (*reserved184)(void);
    void (*reserved185)(void);
    void (*reserved186)(void);
    void (*reserved187)(void);
    void (*reserved188)(void);
    void (*reserved189)(void);
    void (*reserved190)(void);
876
877
878
879
880
881
882
883

884
885
886
887
888
889
890
886
887
888
889
890
891
892

893
894
895
896
897
898
899
900







-
+







    int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
    Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
    int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
    int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
    void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
    Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
    void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
    void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
    TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
    int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
    int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
    int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
    int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
    int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
    int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
    void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102












1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118










1119
1120
1121
1122


1123
1124
1125
1126
1127
1128
1129
1094
1095
1096
1097
1098
1099
1100












1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118










1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130


1131
1132
1133
1134
1135
1136
1137
1138
1139







-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
+
+







	(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
#define TclUpdateReturnInfo \
	(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
#define TclSockMinimumBuffers \
	(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#define Tcl_AddInterpResolvers \
	(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
#define Tcl_AppendExportList \
	(tclIntStubsPtr->tcl_AppendExportList) /* 112 */
#define Tcl_CreateNamespace \
	(tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
#define Tcl_DeleteNamespace \
	(tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
#define Tcl_Export \
	(tclIntStubsPtr->tcl_Export) /* 115 */
#define Tcl_FindCommand \
	(tclIntStubsPtr->tcl_FindCommand) /* 116 */
#define Tcl_FindNamespace \
	(tclIntStubsPtr->tcl_FindNamespace) /* 117 */
#define TclAppendExportList \
	(tclIntStubsPtr->tclAppendExportList) /* 112 */
#define TclCreateNamespace \
	(tclIntStubsPtr->tclCreateNamespace) /* 113 */
#define TclDeleteNamespace \
	(tclIntStubsPtr->tclDeleteNamespace) /* 114 */
#define TclExport \
	(tclIntStubsPtr->tclExport) /* 115 */
#define TclFindCommand \
	(tclIntStubsPtr->tclFindCommand) /* 116 */
#define TclFindNamespace \
	(tclIntStubsPtr->tclFindNamespace) /* 117 */
#define Tcl_GetInterpResolvers \
	(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
#define Tcl_GetNamespaceResolvers \
	(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
#define Tcl_FindNamespaceVar \
	(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
#define Tcl_ForgetImport \
	(tclIntStubsPtr->tcl_ForgetImport) /* 121 */
#define Tcl_GetCommandFromObj \
	(tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
#define Tcl_GetCommandFullName \
	(tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
#define Tcl_GetCurrentNamespace \
	(tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
#define Tcl_GetGlobalNamespace \
	(tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
#define TclForgetImport \
	(tclIntStubsPtr->tclForgetImport) /* 121 */
#define TclGetCommandFromObj \
	(tclIntStubsPtr->tclGetCommandFromObj) /* 122 */
#define TclGetCommandFullName \
	(tclIntStubsPtr->tclGetCommandFullName) /* 123 */
#define TclGetCurrentNamespace_ \
	(tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */
#define TclGetGlobalNamespace_ \
	(tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */
#define Tcl_GetVariableFullName \
	(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
#define Tcl_Import \
	(tclIntStubsPtr->tcl_Import) /* 127 */
#define TclImport \
	(tclIntStubsPtr->tclImport) /* 127 */
#define Tcl_PopCallFrame \
	(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#define Tcl_PushCallFrame \
	(tclIntStubsPtr->tcl_PushCallFrame) /* 129 */
#define Tcl_RemoveInterpResolvers \
	(tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */
#define Tcl_SetNamespaceResolvers \
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216




1217
1218
1219
1220
1221
1222
1223
1216
1217
1218
1219
1220
1221
1222




1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233







-
-
-
-
+
+
+
+







/* Slot 174 is reserved */
#define TclCallVarTraces \
	(tclIntStubsPtr->tclCallVarTraces) /* 175 */
#define TclCleanupVar \
	(tclIntStubsPtr->tclCleanupVar) /* 176 */
#define TclVarErrMsg \
	(tclIntStubsPtr->tclVarErrMsg) /* 177 */
#define Tcl_SetStartupScript \
	(tclIntStubsPtr->tcl_SetStartupScript) /* 178 */
#define Tcl_GetStartupScript \
	(tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
#define TclSetStartupScript \
	(tclIntStubsPtr->tclSetStartupScript) /* 178 */
#define TclGetStartupScript \
	(tclIntStubsPtr->tclGetStartupScript) /* 179 */
/* Slot 180 is reserved */
/* Slot 181 is reserved */
#define TclpLocaltime \
	(tclIntStubsPtr->tclpLocaltime) /* 182 */
#define TclpGmtime \
	(tclIntStubsPtr->tclpGmtime) /* 183 */
/* Slot 184 is reserved */
1346
1347
1348
1349
1350
1351
1352

1353
1354
1355
1356
1357





1358
1359
1360

1361
1362
1363

1364
1365
1366

1367
1368
1369

1370
1371
1372
1373
1374
1375

1376
1377
1378

1379
1380
1381

1382
1383
1384
1385


1386
1387

1388
1389
1390
1391
1392
1393

1394
1395
1396
1397
1398
1399
1400





1401
1402
1403
1404
1405
1406
1407
1356
1357
1358
1359
1360
1361
1362
1363





1364
1365
1366
1367
1368



1369



1370



1371



1372






1373



1374



1375




1376
1377


1378






1379







1380
1381
1382
1383
1384

1385
1386



1387







+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
-


-
-
-

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#if defined(USE_TCL_STUBS)
#undef TclGetStartupScriptFileName
#undef TclSetStartupScriptFileName
#undef TclGetStartupScriptPath
#undef TclSetStartupScriptPath
#undef TclBackgroundException
#   undef TclGetStartupScriptFileName
#   undef TclSetStartupScriptFileName
#   undef TclGetStartupScriptPath
#   undef TclSetStartupScriptPath
#   undef TclBackgroundException

#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
#   undef Tcl_SetStartupScript
#   undef TclSetStartupScript
#   define Tcl_SetStartupScript \
	    (tclStubsPtr->tcl_SetStartupScript) /* 622 */
#   undef Tcl_GetStartupScript
#   undef TclGetStartupScript
#   define Tcl_GetStartupScript \
	    (tclStubsPtr->tcl_GetStartupScript) /* 623 */
#   undef Tcl_CreateNamespace
#   undef TclCreateNamespace
#   define Tcl_CreateNamespace \
	   (tclStubsPtr->tcl_CreateNamespace) /* 506 */
#   undef Tcl_DeleteNamespace
#   undef TclDeleteNamespace
#   define Tcl_DeleteNamespace \
	   (tclStubsPtr->tcl_DeleteNamespace) /* 507 */
#   undef Tcl_AppendExportList
#   define Tcl_AppendExportList \
	   (tclStubsPtr->tcl_AppendExportList) /* 508 */
#   undef Tcl_Export
#   undef TclAppendExportList
#   define Tcl_Export \
	   (tclStubsPtr->tcl_Export) /* 509 */
#   undef Tcl_Import
#   undef TclExport
#   define Tcl_Import \
	   (tclStubsPtr->tcl_Import) /* 510 */
#   undef Tcl_ForgetImport
#   undef TclImport
#   define Tcl_ForgetImport \
	   (tclStubsPtr->tcl_ForgetImport) /* 511 */
#   undef Tcl_GetCurrentNamespace
#   define Tcl_GetCurrentNamespace \
#   undef TclForgetImport
#   undef TclGetCurrentNamespace_
	   (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
#   undef Tcl_GetGlobalNamespace
#   undef TclGetGlobalNamespace_
#   define Tcl_GetGlobalNamespace \
	   (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
#   undef Tcl_FindNamespace
#   define Tcl_FindNamespace \
	   (tclStubsPtr->tcl_FindNamespace) /* 514 */
#   undef Tcl_FindCommand
#   undef TclFindNamespace
#   define Tcl_FindCommand \
	   (tclStubsPtr->tcl_FindCommand) /* 515 */
#   undef Tcl_GetCommandFromObj
#   define Tcl_GetCommandFromObj \
	   (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
#   undef Tcl_GetCommandFullName
#   define Tcl_GetCommandFullName \
#   undef TclFindCommand
#   undef TclGetCommandFromObj
#   undef TclGetCommandFullName
#   undef TclCopyChannelOld
#   undef TclSockMinimumBuffersOld
	   (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
#endif

#undef TclCopyChannelOld
#undef TclSockMinimumBuffersOld

#endif /* _TCLINTDECLS */

Changes to generic/tclIntPlatDecls.h.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
9
10
11
12
13
14
15





16
17
18
19
20
21
22







-
-
-
-
-







 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * All rights reserved.
 */

#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS

#ifdef _WIN32
#   define Tcl_DirEntry void
#   define DIR void
#endif

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
#   define TCL_STORAGE_CLASS DLLEXPORT
#else
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
68
69
70
71
72
73
74
75

76
77
78
79
80
81
82
63
64
65
66
67
68
69

70
71
72
73
74
75
76
77







-
+







/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
/* 13 */
EXTERN char *		TclpInetNtoa(struct in_addr addr);
/* 14 */
125
126
127
128
129
130
131
132

133
134
135
136
137
138
139
120
121
122
123
124
125
126

127
128
129
130
131
132
133
134







-
+







EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
				const char *optval, int optlen);
/* 8 */
EXTERN int		TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int		TclWinGetPlatformId(void);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 12 */
EXTERN int		TclpCloseFile(TclFile file);
/* 13 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
202
203
204
205
206
207
208
209

210
211
212
213
214
215
216
197
198
199
200
201
202
203

204
205
206
207
208
209
210
211







-
+







/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
/* 13 */
EXTERN char *		TclpInetNtoa(struct in_addr addr);
/* 14 */
265
266
267
268
269
270
271
272

273
274
275
276
277
278
279
260
261
262
263
264
265
266

267
268
269
270
271
272
273
274







-
+







    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    void (*reserved5)(void);
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
    Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
    char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
    void (*reserved15)(void);
    void (*reserved16)(void);
    void (*reserved17)(void);
298
299
300
301
302
303
304
305

306
307
308
309
310
311
312
293
294
295
296
297
298
299

300
301
302
303
304
305
306
307







-
+







    int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
    int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    int (*tclWinGetPlatformId) (void); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
    Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    int (*tclpIsAtty) (int fd); /* 16 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
331
332
333
334
335
336
337
338

339
340
341
342
343
344
345
326
327
328
329
330
331
332

333
334
335
336
337
338
339
340







-
+







    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    void (*reserved5)(void);
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
    Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
    char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
551
552
553
554
555
556
557




558
559
560
561








562
563
564
565
566
567
546
547
548
549
550
551
552
553
554
555
556




557
558
559
560
561
562
563
564
565
566
567
568
569
570







+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+






#define TclpInetNtoa inet_ntoa

#if defined(_WIN32)
#   undef TclWinNToHS
#   undef TclWinGetServByName
#   undef TclWinGetSockOpt
#   undef TclWinSetSockOpt
#   undef TclWinGetPlatformId
#   undef TclWinResetInterfaces
#   undef TclWinSetInterfaces
#   if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#   define TclWinNToHS ntohs
#   define TclWinGetServByName getservbyname
#   define TclWinGetSockOpt getsockopt
#   define TclWinSetSockOpt setsockopt
#	define TclWinNToHS ntohs
#	define TclWinGetServByName getservbyname
#	define TclWinGetSockOpt getsockopt
#	define TclWinSetSockOpt setsockopt
#	define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
#	define TclWinResetInterfaces() /* nop */
#	define TclWinSetInterfaces(dummy) /* nop */
#   endif /* TCL_NO_DEPRECATED */
#else
#   undef TclpGetPid
#   define TclpGetPid(pid) ((unsigned long) (pid))
#endif

#endif /* _TCLINTPLATDECLS */

Changes to generic/tclInterp.c.

218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
218
219
220
221
222
223
224



225
226
227
228
229
230
231







-
-
-







			    Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
			    Tcl_Obj *const objv[]);
static int		AliasDelete(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, Tcl_Obj *namePtr);
static int		AliasDescribe(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
static int		AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
static int		AliasObjCmd(ClientData dummy,
			    Tcl_Interp *currentInterp, int objc,
			    Tcl_Obj *const objv[]);
static int		AliasNRCmd(ClientData dummy,
			    Tcl_Interp *currentInterp, int objc,
			    Tcl_Obj *const objv[]);
static void		AliasObjCmdDeleteProc(ClientData clientData);
static Tcl_Interp *	GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static Tcl_Interp *	GetInterp2(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
250
251
252
253
254
255
256


257
258
259
260
261
262
263







-
-







			    Tcl_Interp *slaveInterp);
static int		SlaveInvokeHidden(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp,
			    const char *namespaceName,
			    int objc, Tcl_Obj *const objv[]);
static int		SlaveMarkTrusted(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp);
static int		SlaveObjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static void		SlaveObjCmdDeleteProc(ClientData clientData);
static int		SlaveRecursionLimit(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int objc,
			    Tcl_Obj *const objv[]);
static int		SlaveCommandLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int consumedObjc,
			    int objc, Tcl_Obj *const objv[]);
410
411
412
413
414
415
416

417
418
419
420
421
422
423
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419







+







"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
"	}\n"
"	if {[info exists tclDefaultLibrary]} {\n"
"	    lappend scripts {set tclDefaultLibrary}\n"
"	} else {\n"
"	    lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
"	}\n"
"	lappend scripts {::tcl::zipfs::tcl_library_init}\n"
"	lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
"file join $parentDir lib tcl[info tclversion]} \\\n"
"	{file join $grandParentDir lib tcl[info tclversion]} \\\n"
"	{file join $parentDir library} \\\n"
"	{file join $grandParentDir library} \\\n"
1414
1415
1416
1417
1418
1419
1420
1421


1422
1423
1424
1425
1426
1427
1428
1410
1411
1412
1413
1414
1415
1416

1417
1418
1419
1420
1421
1422
1423
1424
1425







-
+
+







    Command *aliasCmdPtr;

    /*
     * If we are not creating or renaming an alias, then it is always OK to
     * create or rename the command.
     */

    if (cmdPtr->objProc != AliasObjCmd) {
    if (cmdPtr->objProc != TclAliasObjCmd
	    && cmdPtr->objProc != TclLocalAliasObjCmd) {
	return TCL_OK;
    }

    /*
     * OK, we are dealing with an alias, so traverse the chain of aliases. If
     * we encounter the alias we are defining (or renaming to) any in the
     * chain then we have a loop.
1469
1470
1471
1472
1473
1474
1475
1476


1477
1478
1479
1480
1481
1482
1483
1466
1467
1468
1469
1470
1471
1472

1473
1474
1475
1476
1477
1478
1479
1480
1481







-
+
+








	/*
	 * Otherwise, follow the chain one step further. See if the target
	 * command is an alias - if so, follow the loop to its target command.
	 * Otherwise we do not have a loop.
	 */

	if (aliasCmdPtr->objProc != AliasObjCmd) {
	if (aliasCmdPtr->objProc != TclAliasObjCmd
		&& aliasCmdPtr->objProc != TclLocalAliasObjCmd) {
	    return TCL_OK;
	}
	nextAliasPtr = aliasCmdPtr->objClientData;
    }

    /* NOTREACHED */
}
1535
1536
1537
1538
1539
1540
1541
1542
1543


1544
1545
1546
1547



1548
1549
1550
1551
1552
1553
1554
1533
1534
1535
1536
1537
1538
1539


1540
1541
1542



1543
1544
1545
1546
1547
1548
1549
1550
1551
1552







-
-
+
+

-
-
-
+
+
+







    }

    Tcl_Preserve(slaveInterp);
    Tcl_Preserve(masterInterp);

    if (slaveInterp == masterInterp) {
	aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
		TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr,
		AliasObjCmdDeleteProc);
		TclGetString(namePtr), TclLocalAliasObjCmd, AliasNRCmd,
		aliasPtr, AliasObjCmdDeleteProc);
    } else {
    aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
	    TclGetString(namePtr), AliasObjCmd, aliasPtr,
	    AliasObjCmdDeleteProc);
	aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
		TclGetString(namePtr), TclAliasObjCmd, aliasPtr,
		AliasObjCmdDeleteProc);
    }

    if (TclPreventAliasLoop(interp, slaveInterp,
	    aliasPtr->slaveCmd) != TCL_OK) {
	/*
	 * Found an alias loop! The last call to Tcl_CreateObjCommand made the
	 * alias point to itself. Delete the command and its alias record. Be
1776
1777
1778
1779
1780
1781
1782
1783

1784
1785
1786
1787
1788
1789





1790
1791
1792
1793
1794
1795
1796
1774
1775
1776
1777
1778
1779
1780

1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799







-
+






+
+
+
+
+







    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AliasObjCmd --
 * TclAliasObjCmd, TclLocalAliasObjCmd --
 *
 *	This is the function that services invocations of aliases in a slave
 *	interpreter. One such command exists for each alias. When invoked,
 *	this function redirects the invocation to the target command in the
 *	master interpreter as designated by the Alias record associated with
 *	this command.
 *
 *	TclLocalAliasObjCmd is a stripped down version used when the source
 *	and target interpreters of the alias are the same. That lets a number
 *	of safety precautions be avoided: the state is much more precisely
 *	known.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Causes forwarding of the invocation; all possible side effects may
 *	occur as a result of invoking the command to which the invocation is
1843
1844
1845
1846
1847
1848
1849
1850
1851


1852
1853
1854
1855
1856
1857
1858
1846
1847
1848
1849
1850
1851
1852


1853
1854
1855
1856
1857
1858
1859
1860
1861







-
-
+
+







    if (TclInitRewriteEnsemble(interp, 1, prefc, objv)) {
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
    }
    TclSkipTailcall(interp);
    return Tcl_NREvalObj(interp, listPtr, flags);
}

static int
AliasObjCmd(
int
TclAliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = clientData;
1923
1924
1925
1926
1927
1928
1929



































































1930
1931
1932
1933
1934
1935
1936
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







     * on the target interpreter.
     */

    if (targetInterp != interp) {
	Tcl_TransferResult(targetInterp, result, interp);
	Tcl_Release(targetInterp);
    }

    for (i=0; i<cmdc; i++) {
	Tcl_DecrRefCount(cmdv[i]);
    }
    if (cmdv != cmdArr) {
	TclStackFree(interp, cmdv);
    }
    return result;
#undef ALIAS_CMDV_PREALLOC
}

int
TclLocalAliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = clientData;
    int result, prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
    Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
    Interp *iPtr = (Interp *) interp;
    int isRootEnsemble;

    /*
     * Append the arguments to the command prefix and invoke the command in
     * the global namespace.
     */

    prefc = aliasPtr->objc;
    prefv = &aliasPtr->objPtr;
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
    }

    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

    /*
     * Use the ensemble rewriting machinery to ensure correct error messages:
     * only the source command should show, not the full target prefix.
     */

    isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)iPtr, 1, prefc, objv);

    /*
     * Execute the target command in the target interpreter.
     */

    result = Tcl_EvalObjv(interp, cmdc, cmdv, TCL_EVAL_INVOKE);

    /*
     * Clean up the ensemble rewrite info if we set it in the first place.
     */

    if (isRootEnsemble) {
	TclResetRewriteEnsemble((Tcl_Interp *)iPtr, 1);
    }

    for (i=0; i<cmdc; i++) {
	Tcl_DecrRefCount(cmdv[i]);
    }
    if (cmdv != cmdArr) {
	TclStackFree(interp, cmdv);
    }
2372
2373
2374
2375
2376
2377
2378
2379

2380
2381
2382
2383
2384
2385
2386
2442
2443
2444
2445
2446
2447
2448

2449
2450
2451
2452
2453
2454
2455
2456







-
+








    slaveInterp = Tcl_CreateInterp();
    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
    slavePtr->masterInterp = masterInterp;
    slavePtr->slaveEntryPtr = hPtr;
    slavePtr->slaveInterp = slaveInterp;
    slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
	    SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
	    TclSlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
    Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
    Tcl_SetHashValue(hPtr, slavePtr);
    Tcl_SetVar2(slaveInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);

    /*
     * Inherit the recursion limit.
     */
2440
2441
2442
2443
2444
2445
2446
2447

2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462


2463
2464
2465
2466
2467
2468
2469
2510
2511
2512
2513
2514
2515
2516

2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530


2531
2532
2533
2534
2535
2536
2537
2538
2539







-
+













-
-
+
+








    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * SlaveObjCmd --
 * TclSlaveObjCmd --
 *
 *	Command to manipulate an interpreter, e.g. to send commands to it to
 *	be evaluated. One such command exists for each slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

static int
SlaveObjCmd(
int
TclSlaveObjCmd(
    ClientData clientData,	/* Slave interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRSlaveCmd, clientData, objc, objv);
}
2487
2488
2489
2490
2491
2492
2493
2494

2495
2496
2497
2498
2499
2500
2501
2557
2558
2559
2560
2561
2562
2563

2564
2565
2566
2567
2568
2569
2570
2571







-
+







	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_DEBUG,
	OPT_EVAL,	OPT_EXPOSE,	OPT_HIDE,	OPT_HIDDEN,
	OPT_ISSAFE,	OPT_INVOKEHIDDEN, OPT_LIMIT,	OPT_MARKTRUSTED,
	OPT_RECLIMIT
    };

    if (slaveInterp == NULL) {
	Tcl_Panic("SlaveObjCmd: interpreter has been deleted");
	Tcl_Panic("TclSlaveObjCmd: interpreter has been deleted");
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3274
3275
3276
3277
3278
3279
3280




3281
3282
3283
3284
3285
3286
3287







-
-
-
-







	 * master; the overall implementations are safe, but they're normally
	 * defined by init.tcl which is not sourced by safe interpreters.
	 * Assume these functions all work. [Bug 2895741]
	 */

	(void) Tcl_EvalEx(interp,
		"namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0);
	(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
		"::tcl::mathfunc::min", 0, NULL);
	(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
		"::tcl::mathfunc::max", 0, NULL);
    }

    iPtr->flags |= SAFE_INTERP;

    /*
     * Unsetting variables : (which should not have been set in the first
     * place, but...)

Changes to generic/tclLink.c.

650
651
652
653
654
655
656
657

658
659
660
661
662
663
664
650
651
652
653
654
655
656

657
658
659
660
661
662
663
664







-
+







static int SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);

static Tcl_ObjType invalidRealType = {
    "invalidReal",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    SetInvalidRealFromAny		/* setFromAnyProc */
    NULL				/* setFromAnyProc */
};

static int
SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
    const char *str;
    const char *endPtr;

Changes to generic/tclListObj.c.

51
52
53
54
55
56
57
58
59
60
61




62
63
64

65
66
67
68



69
70

71
72
73


74
75
76
77
78
79
80
51
52
53
54
55
56
57




58
59
60
61
62
63

64




65
66
67
68

69



70
71
72
73
74
75
76
77
78







-
-
-
-
+
+
+
+


-
+
-
-
-
-
+
+
+

-
+
-
-
-
+
+







#endif

/*
 *----------------------------------------------------------------------
 *
 * NewListIntRep --
 *
 *	Creates a 'List' structure with space for 'objc' elements.  'objc' must
 *	be > 0.  If 'objv' is not NULL, The list is initialized with first
 *	'objc' values in that array.  Otherwise the list is initialized to have
 *	0 elements, with space to add 'objc' more.  Flag value 'p' indicates
 *	Creates a list internal rep with space for objc elements.  objc
 *	must be > 0.  If objv!=NULL, initializes with the first objc values
 *	in that array.  If objv==NULL, initalize list internal rep to have
 *	0 elements, with space to add objc more.  Flag value "p" indicates
 *	how to behave on failure.
 *
 * Value
 * Results:
 *
 *	A new 'List' structure with refCount 0. If some failure
 *	prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic'
 *	is called if it is not.
 *	A new List struct with refCount 0 is returned. If some failure
 *	prevents this then if p=0, NULL is returned and otherwise the
 *	routine panics.
 *
 * Effect
 * Side effects:
 *
 *	The refCount of each value in 'objv' is incremented as it is added
 *	to the list.
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

static List *
NewListIntRep(
    int objc,
130
131
132
133
134
135
136
137

138







139
140







141
142
143
144
145
146
147
128
129
130
131
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







-
+

+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+







    }
    return listRepPtr;
}

/*
 *----------------------------------------------------------------------
 *
 *  AttemptNewList --
 * AttemptNewList --
 *
 *	Creates a list internal rep with space for objc elements.  objc
 *	must be > 0.  If objv!=NULL, initializes with the first objc values
 *	in that array.  If objv==NULL, initalize list internal rep to have
 *	0 elements, with space to add objc more.
 *
 * Results:
 *	A new List struct with refCount 0 is returned. If some failure
 *	Like NewListIntRep, but additionally sets an error message on failure. 
 * 
 *	prevents this then NULL is returned, and an error message is left
 *	in the interp result, unless interp is NULL.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

static List *
AttemptNewList(
    Tcl_Interp *interp,
    int objc,
165
166
167
168
169
170
171

172

173


174
175


176

177
178
179
180




181
182

183
184
185


186
187
188
189
190
191
192
175
176
177
178
179
180
181
182

183

184
185
186

187
188
189
190




191
192
193
194
195

196



197
198
199
200
201
202
203
204
205







+
-
+
-
+
+

-
+
+

+
-
-
-
-
+
+
+
+

-
+
-
-
-
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewListObj --
 *
 *	This function is normally called when not debugging: i.e., when
 *	Creates a new list object and adds values to it. When TCL_MEM_DEBUG is
 *	TCL_MEM_DEBUG is not defined. It creates a new list object from an
 *	defined, 'Tcl_DbNewListObj' is called instead.
 *	(objc,objv) array: that is, each of the objc elements of the array
 *	referenced by objv is inserted as an element into a new Tcl object.
 *
 * Value
 *	When TCL_MEM_DEBUG is defined, this function just returns the result
 *	of calling the debugging version Tcl_DbNewListObj.
 *
 * Results:
 *	A new list 'Tcl_Obj' to which is appended values from 'objv', or if
 *	'objc' is less than or equal to zero, a list 'Tcl_Obj' having no
 *	elements.  The string representation of the new 'Tcl_Obj' is set to
 *	NULL.  The refCount of the list is 0.
 *	A new list object is returned that is initialized from the object
 *	pointers in objv. If objc is less than or equal to zero, an empty
 *	object is returned. The new object's string representation is left
 *	NULL. The resulting new list object has ref count 0.
 *
 * Effect
 * Side effects:
 *
 *	The refCount of each elements in 'objv' is incremented as it is added
 *	to the list.
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewListObj

229
230
231
232
233
234
235
236
237
238
239
240
241
242
243






















244
245
246
247
248
249
250
242
243
244
245
246
247
248








249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    return listPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 *  Tcl_DbNewListObj --
 * 
 *	Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the
 *	file name and line number from its caller.  This simplifies debugging
 *	since the [memory active] command will report the correct file
 *	name and line number when reporting objects that haven't been freed.
 * 
 *	When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead.
 * Tcl_DbNewListObj --
 *
 *	This function is normally called when debugging: i.e., when
 *	TCL_MEM_DEBUG is defined. It creates new list objects. It is the same
 *	as the Tcl_NewListObj function above except that it calls
 *	Tcl_DbCkalloc directly with the file name and line number from its
 *	caller. This simplifies debugging since then the [memory active]
 *	command will report the correct file name and line number when
 *	reporting objects that haven't been freed.
 *
 *	When TCL_MEM_DEBUG is not defined, this function just returns the
 *	result of calling Tcl_NewListObj.
 *
 * Results:
 *	A new list object is returned that is initialized from the object
 *	pointers in objv. If objc is less than or equal to zero, an empty
 *	object is returned. The new object's string representation is left
 *	NULL. The new list object has ref count 0.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
297
298
299
300
301
302
303
304
305













306
307
308
309
310
311
312
324
325
326
327
328
329
330


331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350







-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetListObj --
 *
 *	Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of
 *	creating a new one.
 *	Modify an object to be a list containing each of the objc elements of
 *	the object array referenced by objv.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object is made a list object and is initialized from the object
 *	pointers in objv. If objc is less than or equal to zero, an empty
 *	object is returned. The new object's string representation is left
 *	NULL. The ref counts of the elements in objv are incremented since the
 *	list now refers to them. The object's old string and internal
 *	representations are freed and its type is set NULL.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetListObj(
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
342
343
344
345
346
347
348
349
350
351



352
353
354
355
356
357





358
359
360
361


362
363
364
365
366
367
368
369
380
381
382
383
384
385
386



387
388
389
390





391
392
393
394
395

396


397
398

399
400
401
402
403
404
405







-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+
-

-
-
+
+
-







}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjCopy --
 *
 *	Creates a new 'Tcl_Obj' which is a pure copy of a list value. This
 *	provides for the C level a counterpart of the [lrange $list 0 end]
 *	command, while using internals details to be as efficient as possible.
 *	Makes a "pure list" copy of a list value. This provides for the C
 *	level a counterpart of the [lrange $list 0 end] command, while using
 *	internals details to be as efficient as possible.
 *
 * Value
 *
 *	The address of the new 'Tcl_Obj' which shares its internal
 *	representation with 'listPtr', and whose refCount is 0.  If 'listPtr'
 *	is not actually a list, the value is NULL, and an error message is left
 * Results:
 *	Normally returns a pointer to a new Tcl_Obj, that contains the same
 *	list value as *listPtr does. The returned Tcl_Obj has a refCount of
 *	zero. If *listPtr does not hold a list, NULL is returned, and if
 *	interp is non-NULL, an error message is recorded there.
 *	in 'interp' if it is not NULL.
 *
 * Effect
 *
 * Side effects:
 *	None.
 *	'listPtr' is converted to a list if it isn't one already.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjCopy(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
383
384
385
386
387
388
389

















































































390
391
392
393


394
395
396
397
398
399







400
401
402
403
404
405
406






407
408
409
410
411
412
413

414
415


416
417
418
419
420
421
422
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508


509
510

511




512
513
514
515
516
517
518
519






520
521
522
523
524
525
526






527


528
529
530
531
532
533
534
535
536







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+
-

-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
+
-
-
+
+







    DupListInternalRep(listPtr, copyPtr);
    return copyPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjRange --
 *
 *	Makes a slice of a list value.
 *      *listPtr 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.
 *
 * Side effects:
 *	The possible conversion of the object referenced by listPtr
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjRange(
    Tcl_Obj *listPtr,		/* List object to take a range from. */
    int fromIdx,		/* Index of first element to include. */
    int toIdx)			/* Index of last element to include. */
{
    Tcl_Obj **elemPtrs;
    int listLen, i, newLen;
    List *listRepPtr;

    TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);

    if (fromIdx < 0) {
	fromIdx = 0;
    }
    if (toIdx >= listLen) {
	toIdx = listLen-1;
    }
    if (fromIdx > toIdx) {
	return Tcl_NewObj();
    }

    newLen = toIdx - fromIdx + 1;

    if (Tcl_IsShared(listPtr) ||
	    ((ListRepPtr(listPtr)->refCount > 1))) {
	return Tcl_NewListObj(newLen, &elemPtrs[fromIdx]);
    }

    /*
     * In-place is possible.
     */

    /*
     * Even if nothing below cause any changes, we still want the
     * string-canonizing effect of [lrange 0 end].
     */

    TclInvalidateStringRep(listPtr);

    /*
     * Delete elements that should not be included.
     */

    for (i = 0; i < fromIdx; i++) {
	TclDecrRefCount(elemPtrs[i]);
    }
    for (i = toIdx + 1; i < listLen; i++) {
	TclDecrRefCount(elemPtrs[i]);
    }

    if (fromIdx > 0) {
	memmove(elemPtrs, &elemPtrs[fromIdx],
		(size_t) newLen * sizeof(Tcl_Obj*));
    }

    listRepPtr = ListRepPtr(listPtr);
    listRepPtr->elemCount = newLen;

    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjGetElements --
 *
 *	Retreive the elements in a list 'Tcl_Obj'.
 *
 *	This function returns an (objc,objv) array of the elements in a list
 *	object.
 * Value
 *
 *	TCL_OK
 *
 *	    A count of list elements is stored, 'objcPtr', And a pointer to the
 *	    array of elements in the list is stored in 'objvPtr'.
 * Results:
 *	The return value is normally TCL_OK; in this case *objcPtr is set to
 *	the count of list elements and *objvPtr is set to a pointer to an
 *	array of (*objcPtr) pointers to each list element. If listPtr does not
 *	refer to a list object and the object can not be converted to one,
 *	TCL_ERROR is returned and an error message will be left in the
 *	interpreter's result if interp is not NULL.
 *
 *	    The elements accessible via 'objvPtr' should be treated as readonly
 *	    and the refCount for each object is _not_ incremented; the caller
 *	    must do that if it holds on to a reference. Furthermore, the
 *	    pointer and length returned by this function may change as soon as
 *	    any function is called on the list object. Be careful about
 *	    retaining the pointer in a local data structure.
 *	The objects referenced by the returned array should be treated as
 *	readonly and their ref counts are _not_ incremented; the caller must
 *	do that if it holds on to a reference. Furthermore, the pointer and
 *	length returned by this function may change as soon as any function is
 *	called on the list object; be careful about retaining the pointer in a
 *	local data structure.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' is not a valid list. An error message is left in the
 *	    interpreter's result if 'interp' is not NULL.
 *
 * Effect
 * Side effects:
 *
 *	'listPtr' is converted to a list object if it isn't one already.
 *	The possible conversion of the object referenced by listPtr
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjGetElements(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
449
450
451
452
453
454
455
456


457
458

459
460

461
462
463
464

465
466
467

468
469

470
471
472
473
474
475





476
477
478
479
480
481
482
483
563
564
565
566
567
568
569

570
571
572

573


574




575



576
577

578






579
580
581
582
583

584
585
586
587
588
589
590







-
+
+

-
+
-
-
+
-
-
-
-
+
-
-
-
+

-
+
-
-
-
-
-
-
+
+
+
+
+
-







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendList --
 *
 *	Appends the elements of elemListPtr to those of listPtr.
 *	This function appends the elements in the list value referenced by
 *	elemListPtr to the list value referenced by listPtr.
 *
 * Value
 * Results:
 *
 *	TCL_OK
 *	The return value is normally TCL_OK. If listPtr or elemListPtr do not
 *
 *	    Success.
 *
 *	TCL_ERROR
 *	refer to list values, TCL_ERROR is returned and an error message is
 *
 *	    'listPtr' or 'elemListPtr' are not valid lists.  An error
 *	    message is left in the interpreter's result if 'interp' is not NULL.
 *	left in the interpreter's result if interp is not NULL.
 *
 * Effect
 * Side effects:
 *
 *	The reference count of each element of 'elemListPtr' as it is added to
 *	'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType'
 *	if they are not already. Appending the new elements may cause the
 *	array of element pointers in 'listObj' to grow.  If any objects are
 *	appended to 'listPtr'. Any preexisting string representation of
 *	The reference counts of the elements in elemListPtr are incremented
 *	since the list now refers to them. listPtr and elemListPtr are
 *	converted, if necessary, to list objects. Also, appending the new
 *	elements may cause listObj's array of element pointers to grow.
 *	listPtr's old string representation, if any, is invalidated.
 *	'listPtr' is invalidated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjAppendList(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
508
509
510
511
512
513
514
515




516
517

518
519

520
521

522
523
524
525
526
527



528
529

530
531
532
533
534
535





536
537
538
539
540
541
542
615
616
617
618
619
620
621

622
623
624
625
626

627


628


629






630
631
632
633

634






635
636
637
638
639
640
641
642
643
644
645
646







-
+
+
+
+

-
+
-
-
+
-
-
+
-
-
-
-
-
-
+
+
+

-
+
-
-
-
-
-
-
+
+
+
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *
 *	Like 'Tcl_ListObjAppendList', but Appends a single value to a list.
 *	This function is a special purpose version of Tcl_ListObjAppendList:
 *	it appends a single object referenced by objPtr to the list object
 *	referenced by listPtr. If listPtr is not already a list object, an
 *	attempt will be made to convert it to one.
 *
 * Value
 * Results:
 *
 *	TCL_OK
 *	The return value is normally TCL_OK; in this case objPtr is added to
 *
 *	    'objPtr' is appended to the elements of 'listPtr'.
 *	the end of listPtr's list. If listPtr does not refer to a list object
 *
 *	TCL_ERROR
 *
 *	    listPtr does not refer to a list object and the object can not be
 *	    converted to one. An error message will be left in the
 *	    interpreter's result if interp is not NULL.
 *	and the object can not be converted to one, TCL_ERROR is returned and
 *	an error message will be left in the interpreter's result if interp is
 *	not NULL.
 *
 * Effect
 * Side effects:
 *
 *	If 'listPtr' is not already of type 'tclListType', it is converted.
 *	The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'.
 *	Appending the new element may cause the the array of element pointers
 *	in 'listObj' to grow.  Any preexisting string representation of
 *	'listPtr' is invalidated.
 *	The ref count of objPtr is incremented since the list now refers to
 *	it. listPtr will be converted, if necessary, to a list object. Also,
 *	appending the new element may cause listObj's array of element
 *	pointers to grow. listPtr's old string representation, if any, is
 *	invalidated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjAppendElement(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
679
680
681
682
683
684
685
686
687
688
689





690
691

692
693
694
695
696
697





698
699

700
701
702

703
704

705
706

707
708
709
710
711
712
713
783
784
785
786
787
788
789




790
791
792
793
794
795

796






797
798
799
800
801


802



803
804

805


806
807
808
809
810
811
812
813







-
-
-
-
+
+
+
+
+

-
+
-
-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
+

-
+
-
-
+







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *
 * 	Retrieve a pointer to the element of 'listPtr' at 'index'.  The index
 * 	of the first element is 0.
 *
 * Value
 *	This function returns a pointer to the index'th object from the list
 *	referenced by listPtr. The first element has index 0. If index is
 *	negative or greater than or equal to the number of elements in the
 *	list, a NULL is returned. If listPtr is not a list object, an attempt
 *	will be made to convert it to a list.
 *
 * 	TCL_OK
 * Results:
 *
 *	    A pointer to the element at 'index' is stored in 'objPtrPtr'.  If
 *	    'index' is out of range, NULL is stored in 'objPtrPtr'.  This
 *	    object should be treated as readonly and its 'refCount' is _not_
 *	    incremented. The caller must do that if it holds on to the
 *	    reference.
 *	The return value is normally TCL_OK; in this case objPtrPtr is set to
 *	the Tcl_Obj pointer for the index'th list element or NULL if index is
 *	out of range. This object should be treated as readonly and its ref
 *	count is _not_ incremented; the caller must do that if it holds on to
 *	the reference. If listPtr does not refer to a list and can't be
 * 
 * 	TCL_ERROR
 *	converted to one, TCL_ERROR is returned and an error message is left
 *
 * 	    'listPtr' is not a valid list. An an error message is left in the
 * 	    interpreter's result if 'interp' is not NULL.
 *	in the interpreter's result if interp is not NULL.
 *
 *  Effect
 * Side effects:
 *
 * 	If 'listPtr' is not already of type 'tclListType', it is converted.
 *	listPtr will be converted, if necessary, to a list object.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjIndex(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
741
742
743
744
745
746
747
748



749
750

751
752

753
754
755




756
757
758
759
760


761
762
763
764
765
766
767
768
841
842
843
844
845
846
847

848
849
850
851

852


853



854
855
856
857

858



859
860

861
862
863
864
865
866
867







-
+
+
+

-
+
-
-
+
-
-
-
+
+
+
+
-

-
-
-
+
+
-







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjLength --
 *
 * 	Retrieve the number of elements in a list.
 *	This function returns the number of elements in a list object. If the
 *	object is not already a list object, an attempt will be made to
 *	convert it to one.
 *
 * Value
 * Results:
 *
 *	TCL_OK
 *	The return value is normally TCL_OK; in this case *intPtr will be set
 *
 *	    A count of list elements is stored at the address provided by
 *	    'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is
 *	to the integer count of list elements. If listPtr does not refer to a
 *	list object and the object can not be converted to one, TCL_ERROR is
 *	returned and an error message will be left in the interpreter's result
 *	if interp is not NULL.
 *	    converted.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' is not a valid list.  An error message will be left in
 * Side effects:
 *	The possible conversion of the argument object to a list object.
 *	    the interpreter's result if 'interp' is not NULL.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjLength(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
790
791
792
793
794
795
796
797




798
799
800
801



802
803
804



805
806
807
808
809
810
811




812


813

814
815
816


817
818

819
820
821

822
823

824
825
826



827
828
829
830
831
832
833
889
890
891
892
893
894
895

896
897
898
899
900



901
902
903



904
905
906
907






908
909
910
911
912
913
914

915



916
917
918

919



920


921



922
923
924
925
926
927
928
929
930
931







-
+
+
+
+

-
-
-
+
+
+
-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+

+
+
-
+
-
-
-
+
+

-
+
-
-
-
+
-
-
+
-
-
-
+
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjReplace --
 *
 *	Replace values in a list.
 *	This function replaces zero or more elements of the list referenced by
 *	listPtr with the objects from an (objc,objv) array. The objc elements
 *	of the array referenced by objv replace the count elements in listPtr
 *	starting at first.
 *
 *	If 'first' is zero or negative, it refers to the first element. If
 *	'first' outside the range of elements in the list, no elements are
 *	deleted.
 *	If the argument first is zero or negative, it refers to the first
 *	element. If first is greater than or equal to the number of elements
 *	in the list, then no elements are deleted; the new elements are
 *
 *	If 'count' is zero or negative no elements are deleted, and any new
 *	elements are inserted at the beginning of the list.
 *	appended to the list. Count gives the number of elements to replace.
 *	If count is zero or negative then no elements are deleted; the new
 *	elements are simply inserted before first.
 *
 * Value
 *
 *	TCL_OK
 *
 *	    The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr'
 *	    starting at 'first'.  If 'objc' 0, no new elements are added.
 *	The argument objv refers to an array of objc pointers to the new
 *	elements to be added to listPtr in place of those that were deleted.
 *	If objv is NULL, no new elements are added. If listPtr is not a list
 *	object, an attempt will be made to convert it to one.
 *
 * Results:
 *	The return value is normally TCL_OK. If listPtr does not refer to a
 *	TCL_ERROR
 *	list object and can not be converted to one, TCL_ERROR is returned and
 *
 *	    'listPtr' is not a valid list.   An error message is left in the
 *	    interpreter's result if 'interp' is not NULL.
 *	an error message will be left in the interpreter's result if interp is
 *	not NULL.
 *
 * Effect
 * Side effects:
 *
 *	If 'listPtr' is not of type 'tclListType', it is converted if possible.
 *
 *	The ref counts of the objc elements in objv are incremented since the
 *	The 'refCount' of each element appended to the list is incremented.
 *	Similarly, the 'refCount' for each replaced element is decremented.
 *	resulting list now refers to them. Similarly, the ref counts for
 *
 *	If 'listPtr' is modified, any previous string representation is
 *	invalidated.
 *	replaced objects are decremented. listPtr is converted, if necessary,
 *	to a list object. listPtr's old string representation, if any, is
 *	freed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjReplace(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
1077
1078
1079
1080
1081
1082
1083
1084

1085
1086
1087
1088
1089




1090
1091
1092


1093
1094
1095
1096






1097
1098
1099
1100
1101
1102
1103
1175
1176
1177
1178
1179
1180
1181

1182
1183




1184
1185
1186
1187
1188


1189
1190


1191

1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204







-
+

-
-
-
-
+
+
+
+

-
-
+
+
-
-

-
+
+
+
+
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * TclLindexList --
 *
 *	Implements the 'lindex' command when objc==3.
 *	This procedure handles the 'lindex' command when objc==3.
 *
 *	Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures
 *	the argument format into required form while taking care to manage
 *	shimmering so as to tend to keep the most useful intreps
 *	and/or avoid the most expensive conversions.
 * Results:
 *	Returns a pointer to the object extracted, or NULL if an error
 *	occurred. The returned object already includes one reference count for
 *	the pointer returned.
 *
 * Value
 *
 * Side effects:
 *	None.
 *	A pointer to the specified element, with its 'refCount' incremented, or
 *	NULL if an error occurred.
 *
 * Notes
 * Notes:
 *	This procedure is implemented entirely as a wrapper around
 *	TclLindexFlat. All it does is reconfigure the argument format into the
 *	form required by TclLindexFlat, while taking care to manage shimmering
 *	in such a way that we tend to keep the most useful intreps and/or
 *	avoid the most expensive conversions.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLindexList(
    Tcl_Interp *interp,		/* Tcl interpreter. */
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150

1151
1152
1153
1154
1155


1156
1157
1158

1159
1160
1161
1162
1163
1164
1165
1166
1167
1168

1169
1170
1171


1172
1173




1174
1175
1176
1177


1178




1179
1180


1181
1182
1183
1184
1185
1186
1187
1188
1242
1243
1244
1245
1246
1247
1248



1249





1250
1251

1252

1253
1254
1255
1256
1257
1258
1259
1260
1261
1262

1263
1264


1265
1266
1267

1268
1269
1270
1271
1272



1273
1274
1275
1276
1277
1278
1279


1280
1281

1282
1283
1284
1285
1286
1287
1288







-
-
-
+
-
-
-
-
-
+
+
-

-
+









-
+

-
-
+
+

-
+
+
+
+

-
-
-
+
+

+
+
+
+
-
-
+
+
-







	 * argPtr designates something that is neither an index nor a
	 * well-formed list. Report the error via TclLindexFlat.
	 */

	return TclLindexFlat(interp, listPtr, 1, &argPtr);
    }

    if (indexListCopy->typePtr == &tclListType) {
	List *listRepPtr = ListRepPtr(indexListCopy);

    {
	listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
		&listRepPtr->elements);
    } else {
	int indexCount = -1;	/* Size of the array of list indices. */
	Tcl_Obj **indices = NULL;
	int indexCount = -1;		/* Size of the array of list indices. */
	Tcl_Obj **indices = NULL; 	/* Array of list indices. */
				/* Array of list indices. */

	Tcl_ListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
	TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
	listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
    }
    Tcl_DecrRefCount(indexListCopy);
    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 *  TclLindexFlat --
 * TclLindexFlat --
 *
 * 	The core of the 'lindex' command, with all index
 * 	arguments presented as a flat list.
 *	This procedure is the core of the 'lindex' command, with all index
 *	arguments presented as a flat list.
 *
 *  Value
 * Results:
 *	Returns a pointer to the object extracted, or NULL if an error
 *	occurred. The returned object already includes one reference count for
 *	the pointer returned.
 *
 *	A pointer to the object extracted, with its 'refCount' incremented,  or
 *	NULL if an error occurred.  Thus, the calling code will usually do
 *	something like:
 * Side effects:
 *	None.
 *
 * Notes:
 *	The reference count of the returned object includes one reference
 *	corresponding to the pointer returned. Thus, the calling code will
 *	usually do something like:
 * 		Tcl_SetObjResult(interp, result);
 * 		Tcl_DecrRefCount(result);
 *		Tcl_SetObjResult(interp, result);
 *		Tcl_DecrRefCount(result);
 *
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLindexFlat(
    Tcl_Interp *interp,		/* Tcl interpreter. */
1250
1251
1252
1253
1254
1255
1256
1257

1258
1259
1260
1261




1262
1263


1264
1265
1266






1267
1268
1269
1270
1271
1272
1273
1350
1351
1352
1353
1354
1355
1356

1357
1358
1359


1360
1361
1362
1363
1364

1365
1366
1367


1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380







-
+


-
-
+
+
+
+

-
+
+

-
-
+
+
+
+
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetList --
 *
 *	The core of [lset] when objc == 4. Objv[2] may be either a
 *	Core of the 'lset' command when objc == 4. Objv[2] may be either a
 *	scalar index or a list of indices.
 *
 *	Implemented entirely as a wrapper around 'TclLindexFlat', as described
 *	for 'TclLindexList'.
 * Results:
 *	Returns the new value of the list variable, or NULL if there was an
 *	error. The returned object includes one reference count for the
 *	pointer returned.
 *
 * Value
 * Side effects:
 *	None.
 *
 *	The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if
 *	there was an error.
 * Notes:
 *	This procedure is implemented entirely as a wrapper around
 *	TclLsetFlat. All it does is reconfigure the argument format into the
 *	form required by TclLsetFlat, while taking care to manage shimmering
 *	in such a way that we tend to keep the most useful intreps and/or
 *	avoid the most expensive conversions.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLsetList(
    Tcl_Interp *interp,		/* Tcl interpreter. */
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330




1331
1332
1333
1334
1335





1336
1337
1338

1339
1340
1341
1342
1343
1344
1345





1346
1347
1348
1349
1350

1351
1352
1353
1354
1355







1356
1357
1358


1359
1360

1361
1362
1363
1364
1365
1366
1367
1428
1429
1430
1431
1432
1433
1434



1435
1436
1437
1438
1439




1440
1441
1442
1443
1444



1445







1446
1447
1448
1449
1450
1451




1452





1453
1454
1455
1456
1457
1458
1459
1460


1461
1462
1463

1464
1465
1466
1467
1468
1469
1470
1471







-
-
-
+
+
+
+

-
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+

-
+







/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --
 *
 *	Core engine of the 'lset' command.
 *
 * Value
 *
 *	The resulting list
 * Results:
 *	Returns the new value of the list variable, or NULL if an error
 *	occurred. The returned object includes one reference count for the
 *	pointer returned.
 *
 *	    The 'refCount' of 'valuePtr' is incremented.  If 'listPtr' was not
 *	    duplicated, its 'refCount' is incremented.  The reference count of
 *	    an unduplicated object is therefore 2 (one for the returned pointer
 *	    and one for the variable that holds it).  The reference count of a
 * Side effects:
 *	On entry, the reference count of the variable value does not reflect
 *	any references held on the stack. The first action of this function is
 *	to determine whether the object is shared, and to duplicate it if it
 *	is. The reference count of the duplicate is incremented. At this
 *	    duplicate object is 1, reflecting that result is the only active
 *	    reference. The caller is expected to store the result in the
 *	    variable and decrement its reference count. (INST_STORE_* does
 *	point, the reference count will be 1 for either case, so that the
 *	    exactly this.)
 * 
 *	NULL
 *	
 *	    An error occurred.  If 'listPtr' was duplicated, the reference
 *	    count on the duplicate is decremented so that it is 0, causing any
 *	    memory allocated by this function to be freed.
 *	object will appear to be unshared.
 *
 *	If an error occurs, and the object has been duplicated, the reference
 *	count on the duplicate is decremented so that it is now 0: this
 *	dismisses any memory that was allocated by this function.
 *
 *
 * Effect
 *
 *	On entry, the reference count of 'listPtr' does not reflect any
 *	If no error occurs, the reference count of the original object is
 *	references held on the stack. The first action of this function is to
 *	determine whether 'listPtr' is shared and to create a duplicate
 *	unshared copy if it is.  The reference count of the duplicate is
 *	incremented. At this point, the reference count is 1 in either case so
 *	that the object is considered unshared.
 *	incremented if the object has not been duplicated, and nothing is done
 *	to a reference count of the duplicate. Now the reference count of an
 *	unduplicated object is 2 (the returned pointer, plus the one stored in
 *	the variable). The reference count of a duplicate object is 1,
 *	reflecting that the returned pointer is the only active reference. The
 *	caller is expected to store the returned value back in the variable
 *	and decrement its reference count. (INST_STORE_* does exactly this.)
 *
 *	The unshared list is altered directly to produce the result.
 *	'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string
 *	Surgery is performed on the unshared list value to produce the result.
 *	TclLsetFlat maintains a linked list of Tcl_Obj's whose string
 *	representations must be spoilt by threading via 'ptr2' of the
 *	two-pointer internal representation. On entry to 'TclLsetFlat', the
 *	two-pointer internal representation. On entry to TclLsetFlat, the
 *	values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
 *	Tcl_Obj that has been modified is set to NULL.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
1568
1569
1570
1571
1572
1573
1574
1575

1576
1577
1578
1579
1580

1581
1582

1583
1584
1585
1586
1587
1588
1589


1590
1591
1592
1593
1594
1595
1596
1597




1598
1599

1600
1601
1602


1603
1604
1605



1606


1607
1608
1609
1610
1611
1612
1613
1672
1673
1674
1675
1676
1677
1678

1679
1680




1681


1682







1683
1684








1685
1686
1687
1688
1689

1690



1691
1692



1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705







-
+

-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+

-
+
-
-
-
+
+
-
-
-
+
+
+

+
+







}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjSetElement --
 *
 *	Set a single element of a list to a specified value.
 *	Set a single element of a list to a specified value
 *
 *	It is the caller's responsibility to invalidate the string
 *	representation of the 'listPtr'.
 *
 * Value
 * Results:
 *
 * 	TCL_OK
 *	The return value is normally TCL_OK. If listPtr does not refer to a
 *
 *	    Success.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' does not refer to a list object and cannot be converted
 *	    to one.  An error message will be left in the interpreter result if
 *	list object and cannot be converted to one, TCL_ERROR is returned and
 *	an error message will be left in the interpreter result if interp is
 *	    interp is not NULL.
 *
 *	TCL_ERROR
 *
 *	    An index designates an element outside the range [0..listLength-1],
 *	    where 'listLength' is the count of elements in the list object
 *	    designated by 'listPtr'.  An error message is left in the
 *	    interpreter result.
 *	not NULL. Similarly, if index designates an element outside the range
 *	[0..listLength-1], where listLength is the count of elements in the
 *	list object designated by listPtr, TCL_ERROR is returned and an error
 *	message is left in the interpreter result.
 *
 * Effect
 * Side effects:
 *
 *	If 'listPtr' designates a shared object, 'Tcl_Panic' is called.  If
 *	'listPtr' is not already of type 'tclListType', it is converted and the
 *	Tcl_Panic if listPtr designates a shared object. Otherwise, attempts
 *	to convert it to a list with a non-shared internal rep. Decrements the
 *	internal representation is unshared. The 'refCount' of the element at
 *	'index' is decremented and replaced in the list with the 'valuePtr',
 *	whose 'refCount' in turn is incremented.
 *	ref count of the object at the specified index within the list,
 *	replaces with the object designated by valuePtr, and increments the
 *	ref count of the replacement object.
 *
 *	It is the caller's responsibility to invalidate the string
 *	representation of the object.
 *
 *----------------------------------------------------------------------
 */

int
TclListObjSetElement(
    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting
1717
1718
1719
1720
1721
1722
1723
1724
1725


1726
1727


1728

1729
1730
1731



1732
1733
1734
1735
1736
1737
1738
1809
1810
1811
1812
1813
1814
1815


1816
1817
1818

1819
1820
1821
1822



1823
1824
1825
1826
1827
1828
1829
1830
1831
1832







-
-
+
+

-
+
+

+
-
-
-
+
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * FreeListInternalRep --
 *
 *	Deallocate the storage associated with the internal representation of a
 *	a list object.
 *	Deallocate the storage associated with a list object's internal
 *	representation.
 *
 * Effect
 * Results:
 *	None.
 *
 * Side effects:
 *	The storage for the internal 'List' pointer of 'listPtr' is freed, the
 *	'internalRep.twoPtrValue.ptr1' of 'listPtr' is set to NULL, and the 'refCount'
 *	of each element of the list is decremented.
 *	Frees listPtr's List* internal representation and sets listPtr's
 *	internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all
 *	element objects, which may free them.
 *
 *----------------------------------------------------------------------
 */

static void
FreeListInternalRep(
    Tcl_Obj *listPtr)		/* List object with internal rep to free. */
1753
1754
1755
1756
1757
1758
1759
1760

1761
1762
1763


1764

1765

1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785

1786
1787

1788
1789

1790
1791

1792

1793
1794

1795
1796

1797
1798

1799
1800
1801
1802
1803
1804
1805
1847
1848
1849
1850
1851
1852
1853

1854
1855
1856

1857
1858
1859
1860

1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880

1881
1882

1883


1884


1885

1886
1887

1888


1889


1890
1891
1892
1893
1894
1895
1896
1897







-
+


-
+
+

+
-
+



















-
+

-
+
-
-
+
-
-
+
-
+

-
+
-
-
+
-
-
+







}

/*
 *----------------------------------------------------------------------
 *
 * DupListInternalRep --
 *
 *	Initialize the internal representation of a list 'Tcl_Obj' to share the
 *	Initialize the internal representation of a list Tcl_Obj to share the
 *	internal representation of an existing list object.
 *
 * Effect
 * Results:
 *	None.
 *
 * Side effects:
 *	The 'refCount' of the List internal rep is incremented.
 *	The reference count of the List internal rep is incremented.
 *
 *----------------------------------------------------------------------
 */

static void
DupListInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    List *listRepPtr = ListRepPtr(srcPtr);

    ListSetIntRep(copyPtr, listRepPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * SetListFromAny --
 *
 *	Convert any object to a list.
 *	Attempt to generate a list internal form for the Tcl object "objPtr".
 *
 * Value
 * Results:
 *
 *    TCL_OK
 *	The return value is TCL_OK or TCL_ERROR. If an error occurs during
 *
 *	Success.  The internal representation of 'objPtr' is set, and the type
 *	conversion, an error message is left in the interpreter's result
 *	of 'objPtr' is 'tclListType'.
 *	unless "interp" is NULL.
 *
 *    TCL_ERROR
 * Side effects:
 *
 *	An error occured during conversion. An error message is left in the
 *	If no error occurs, a list is stored as "objPtr"s internal
 *	interpreter's result if 'interp' is not NULL.
 *
 *	representation.
 *
 *----------------------------------------------------------------------
 */

static int
SetListFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
1916
1917
1918
1919
1920
1921
1922
1923

1924
1925
1926


1927
1928


1929
1930
1931
1932





1933
1934
1935
1936
1937
1938
1939
1940
1941
1942


1943
1944
1945
1946
1947
1948
1949
2008
2009
2010
2011
2012
2013
2014

2015



2016
2017
2018

2019
2020
2021



2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034


2035
2036
2037
2038
2039
2040
2041
2042
2043







-
+
-
-
-
+
+

-
+
+

-
-
-
+
+
+
+
+








-
-
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfList --
 *
 *	Update the string representation for a list object.
 *	Update the string representation for a list object. Note: This
 *
 *	Any previously-exising string representation is not invalidated, so
 *	storage is lost if this has not been taken care of.
 *	function does not invalidate an existing old string rep so storage
 *	will be lost if this has not already been done.
 *
 * Effect
 * Results:
 *	None.
 *
 *	The string representation of 'listPtr' is set to the resulting string.
 *	This string will be empty if the list has no elements. It is assumed
 *	that the list internal representation is not NULL.
 * Side effects:
 *	The object's string is set to a valid string that results from the
 *	list-to-string conversion. This string will be empty if the list has
 *	no elements. The list internal representation should not be NULL and
 *	we assume it is not NULL.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfList(
    Tcl_Obj *listPtr)		/* List object with string rep to update. */
{
#   define LOCAL_SIZE 20
    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
#   define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    List *listRepPtr = ListRepPtr(listPtr);
    int numElems = listRepPtr->elemCount;
    int i, length, bytesNeeded = 0;
    const char *elem;
    char *dst;
    Tcl_Obj **elemPtrs;

1972
1973
1974
1975
1976
1977
1978
1979

1980
1981
1982
1983
1984
1985
1986
2066
2067
2068
2069
2070
2071
2072

2073
2074
2075
2076
2077
2078
2079
2080







-
+







    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/*
	 * We know numElems <= LIST_MAX, so this is safe.
	 */

	flagPtr = ckalloc(numElems * sizeof(int));
	flagPtr = ckalloc(numElems);
    }
    elemPtrs = &listRepPtr->elements;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {

Changes to generic/tclLiteral.c.

182
183
184
185
186
187
188
189

190
191
192
193
194
195
196
182
183
184
185
186
187
188

189
190
191
192
193
194
195
196







-
+







    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    int globalHash;
    unsigned int globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == (unsigned) -1) {
389
390
391
392
393
394
395

396

397
398
399
400
401
402
403
389
390
391
392
393
394
395
396

397
398
399
400
401
402
403
404







+
-
+







{
    CompileEnv *envPtr = ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;
    unsigned hash;
    unsigned int localHash;
    int localHash, objIndex, new;
    int objIndex, new;
    Namespace *nsPtr;

    if (length < 0) {
	length = (bytes ? strlen(bytes) : 0);
    }
    hash = HashString(bytes, length);

533
534
535
536
537
538
539
540


541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559

560
561
562
563
564
565
566
534
535
536
537
538
539
540

541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560

561
562
563
564
565
566
567
568







-
+
+


















-
+







    register 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;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    int localHash, length;
    unsigned int localHash;
    int length;
    const char *bytes;
    Tcl_Obj *newObjPtr;

    lPtr = &envPtr->literalArrayPtr[index];

    /*
     * To avoid unwanted sharing we need to copy the object and remove it from
     * the local and global literal tables. It still has a slot in the literal
     * array so it can be referred to by byte codes, but it will not be
     * matched by literal searches.
     */

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, lPtr->objPtr);
    lPtr->objPtr = newObjPtr;

    bytes = TclGetStringFromObj(newObjPtr, &length);
    localHash = (HashString(bytes, length) & localTablePtr->mask);
    localHash = HashString(bytes, length) & localTablePtr->mask;
    nextPtrPtr = &localTablePtr->buckets[localHash];

    for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
	if (entryPtr == lPtr) {
	    *nextPtrPtr = lPtr->nextPtr;
	    lPtr->nextPtr = NULL;
	    localTablePtr->numEntries--;
608
609
610
611
612
613
614
615

616
617
618
619
620
621
622
610
611
612
613
614
615
616

617
618
619
620
621
622
623
624







-
+







    }
    objIndex = envPtr->literalArrayNext;
    envPtr->literalArrayNext++;

    lPtr = &envPtr->literalArrayPtr[objIndex];
    lPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    lPtr->refCount = -1;	/* i.e., unused */
    lPtr->refCount = (size_t)-1;	/* i.e., unused */
    lPtr->nextPtr = NULL;

    if (litPtrPtr) {
	*litPtrPtr = lPtr;
    }

    return objIndex;
805
806
807
808
809
810
811
812


813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839

840
841
842
843
844
845
846
807
808
809
810
811
812
813

814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833


834
835
836
837
838
839

840
841
842
843
844
845
846
847







-
+
+


















-
-






-
+







				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    register LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    int length, index;
    int length;
    unsigned int index;

    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = TclGetStringFromObj(objPtr, &length);
    index = (HashString(bytes, length) & globalTablePtr->mask);

    /*
     * Check to see if the object is in the global literal table and remove
     * this reference. The object may not be in the table if it is a hidden
     * local literal.
     */

    for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
	    entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
	if (entryPtr->objPtr == objPtr) {
	    entryPtr->refCount--;

	    /*
	     * If the literal is no longer being used by any ByteCode, delete
	     * the entry then remove the reference corresponding to the global
	     * literal table entry (decrement the ref count of the object).
	     */

	    if (entryPtr->refCount == 0) {
	    if (entryPtr->refCount-- <= 1) {
		if (prevPtr == NULL) {
		    globalTablePtr->buckets[index] = entryPtr->nextPtr;
		} else {
		    prevPtr->nextPtr = entryPtr->nextPtr;
		}
		ckfree(entryPtr);
		globalTablePtr->numEntries--;
950
951
952
953
954
955
956
957
958


959
960
961
962
963
964
965
951
952
953
954
955
956
957


958
959
960
961
962
963
964
965
966







-
-
+
+







				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    register LiteralEntry **oldChainPtr, **newChainPtr;
    register LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;
    unsigned int oldSize;
    int count, index, length;
    unsigned int oldSize, index;
    int count, length;

    oldSize = tablePtr->numBuckets;
    oldBuckets = tablePtr->buckets;

    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.

Changes to generic/tclLoad.c.

466
467
468
469
470
471
472

473
474

475
476
477
478
479
480
481
482



483

484
485
486
487
488
489
490
466
467
468
469
470
471
472
473
474

475
476
477
478
479
480



481
482
483
484
485
486
487
488
489
490
491
492







+

-
+





-
-
-
+
+
+

+








    /*
     * Test for whether the initialization failed. If so, transfer the error
     * from the target interpreter to the originating one.
     */

    if (code != TCL_OK) {
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
	Interp *iPtr = (Interp *) target;
	if (iPtr->legacyResult && !iPtr->legacyFreeProc) {
	if (iPtr->result && *(iPtr->result) && !iPtr->freeProc) {
	    /*
	     * A call to Tcl_InitStubs() determined the caller extension and
	     * this interp are incompatible in their stubs mechanisms, and
	     * recorded the error in the oldest legacy place we have to do so.
	     */
	    Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1));
	    iPtr->legacyResult = NULL;
	    iPtr->legacyFreeProc = (void (*) (void))-1;
	    Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->result, -1));
	    iPtr->result =  &tclEmptyString;
	    iPtr->freeProc = NULL;
	}
#endif /* defined(TCL_NO_DEPRECATED) */
	Tcl_TransferResult(target, code, interp);
	goto done;
    }

    /*
     * Record the fact that the package has been loaded in the target
     * interpreter.

Changes to generic/tclMain.c.

262
263
264
265
266
267
268
269
270
271
272
273

274
275
276
277
278
279
280
281
282
283
284
285
286
287
262
263
264
265
266
267
268


269


270
271
272
273
274
275
276

277
278
279
280
281
282
283







-
-

-
-
+






-







	} else {
	    /*
	     * Test for the existence of the rc file before trying to read it.
	     */

	    c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
	    if (c != NULL) {
		Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1);

		Tcl_Close(NULL, c);
		Tcl_IncrRefCount(fullNameObj);
		if (Tcl_FSEvalFileEx(interp, fullNameObj, NULL) != TCL_OK) {
		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
		    chan = Tcl_GetStdChannel(TCL_STDERR);
		    if (chan) {
			Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
			Tcl_WriteChars(chan, "\n", 1);
		    }
		}
		Tcl_DecrRefCount(fullNameObj);
	    }
	}
	Tcl_DStringFree(&temp);
    }
}
#endif /* !TCL_ASCII_MAIN */


Changes to generic/tclNamesp.c.

28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42







-
+








/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.
 */

typedef struct {
    size_t numNsCreated;	/* Count of the number of namespaces created
    unsigned long numNsCreated;	/* Count of the number of namespaces created
				 * within the thread. This value is used as a
				 * unique id for each namespace. Cannot be
				 * per-interp because the nsId is used to
				 * distinguish objects which can be passed
				 * around between interps in the same thread,
				 * but does not need to be global because
				 * object internal reps are always per-thread
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
85
86
87
88
89
90
91


92
93
94
95
96
97
98







-
-







			    const char *name2, int flags);
static char *		EstablishErrorInfoTraces(ClientData clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);
static int		GetNamespaceFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
static int		InvokeImportedCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		InvokeImportedNRCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceChildrenCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceCodeCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceCurrentCmd(ClientData dummy,
398
399
400
401
402
403
404
405

406
407
408
409
410
411
412
396
397
398
399
400
401
402

403
404
405
406
407
408
409
410







-
+







    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	ckfree(framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
	if (--framePtr->localCachePtr->refCount == 0) {
	if (framePtr->localCachePtr->refCount-- <= 1) {
	    TclFreeLocalCache(interp, framePtr->localCachePtr);
	}
	framePtr->localCachePtr = NULL;
    }

    /*
     * Decrement the namespace's count of active call frames. If the namespace
911
912
913
914
915
916
917





918
919
920
921
922
923
924
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927







+
+
+
+
+







    Interp *iPtr = (Interp *) nsPtr->interp;
    Namespace *globalNsPtr = (Namespace *)
	    TclGetGlobalNamespace((Tcl_Interp *) iPtr);
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Command *cmdPtr;

    /*
     * Ensure that this namespace doesn't get deallocated in the meantime.
     */
    nsPtr->refCount++;

    /*
     * Give anyone interested - notably TclOO - a chance to use this namespace
     * normally despite the fact that the namespace is going to go. Allows the
     * calling of destructors. Will only be called once (unless re-established
     * by the called function). [Bug 2950259]
     *
     * Note that setting this field requires access to the internal definition
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058

1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075

1076
1077
1078
1079
1080
1081
1082
1046
1047
1048
1049
1050
1051
1052









1053

1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077







-
-
-
-
-
-
-
-
-
+
-
















+







	    if (nsPtr->childTablePtr != NULL) {
		Tcl_DeleteHashTable(nsPtr->childTablePtr);
		ckfree(nsPtr->childTablePtr);
	    }
#endif
	    Tcl_DeleteHashTable(&nsPtr->cmdTable);

	    /*
	     * If the reference count is 0, then discard the namespace.
	     * Otherwise, mark it as "dead" so that it can't be used.
	     */

	    if (nsPtr->refCount == 0) {
		NamespaceFree(nsPtr);
	    } else {
		nsPtr->flags |= NS_DEAD;
	    nsPtr ->flags |= NS_DEAD;
	    }
	} else {
	    /*
	     * Restore the ::errorInfo and ::errorCode traces.
	     */

	    EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
	    EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);

	    /*
	     * We didn't really kill it, so remove the KILLED marks, so it can
	     * get killed later, avoiding mem leaks.
	     */

	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
	}
    }
    TclNsDecrRefCount(nsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclTeardownNamespace --
 *
1765
1766
1767
1768
1769
1770
1771
1772

1773
1774
1775
1776
1777
1778
1779
1760
1761
1762
1763
1764
1765
1766

1767
1768
1769
1770
1771
1772
1773
1774







-
+







		    return TCL_ERROR;
		}
	    }
	}

	dataPtr = ckalloc(sizeof(ImportedCmdData));
	importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
		InvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
		TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
		DeleteImportedCmd);
	dataPtr->realCmdPtr = cmdPtr;
	dataPtr->selfPtr = (Command *) importedCmd;
	dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
	Tcl_DStringFree(&ds);

	/*
1986
1987
1988
1989
1990
1991
1992
1993

1994
1995
1996
1997
1998
1999
2000
1981
1982
1983
1984
1985
1986
1987

1988
1989
1990
1991
1992
1993
1994
1995







-
+







    }
    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeImportedCmd --
 * TclInvokeImportedCmd --
 *
 *	Invoked by Tcl whenever the user calls an imported command that was
 *	created by Tcl_Import. Finds the "real" command (in another
 *	namespace), and passes control to it.
 *
 * Results:
 *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
2017
2018
2019
2020
2021
2022
2023
2024
2025


2026
2027
2028
2029
2030
2031
2032
2012
2013
2014
2015
2016
2017
2018


2019
2020
2021
2022
2023
2024
2025
2026
2027







-
-
+
+







    ImportedCmdData *dataPtr = clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;

    TclSkipTailcall(interp);
    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}

static int
InvokeImportedCmd(
int
TclInvokeImportedCmd(
    ClientData 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. */
{
    return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData,
2420
2421
2422
2423
2424
2425
2426





























2427
2428
2429
2430
2431
2432
2433
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    Tcl_DStringFree(&buffer);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclEnsureNamespace --
 *
 *	Provide a namespace that is not deleted.
 *
 * Value
 *
 *	namespacePtr, if it is not scheduled for deletion, or a pointer to a
 *	new namespace with the same name otherwise.
 *
 * Effect
 *	None.
 *
 *----------------------------------------------------------------------
 */
Tcl_Namespace *
TclEnsureNamespace(
    Tcl_Interp *interp,
    Tcl_Namespace *namespacePtr)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;
    if (!(nsPtr->flags & NS_DYING)) {
	    return namespacePtr;
    }
    return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindNamespace --
 *
 *	Searches for a namespace.
 *
 * Results:
 *	Returns a pointer to the namespace if it is found. Otherwise, returns
 *	NULL and leaves an error message in the interpreter's result object if
2634
2635
2636
2637
2638
2639
2640
2641

2642
2643
2644
2645
2646
2647
2648
2658
2659
2660
2661
2662
2663
2664

2665
2666
2667
2668
2669
2670
2671
2672







-
+







		}
	    }
	}
    } else {
	Namespace *nsPtr[2];
	register int search;

	TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
	TclGetNamespaceForQualName(interp, name, cxtNsPtr,
		flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);

	/*
	 * Look for the command in the command table of its namespace. Be sure
	 * to check both possible search paths: from the specified namespace
	 * context and from the global namespace.
	 */

Changes to generic/tclOO.c.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14






+







/*
 * tclOO.c --
 *
 *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
 *
 * Copyright (c) 2005-2012 by Donal K. Fellows
 * Copyright (c) 2017 by Nathan Coulter
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

62
63
64
65
66
67
68
69
70
71
72
73
74



75
76
77
78
79
80
81
82
83


84
85
86
87
88
89
90
91
92
93
94
95
96
97
98




99
100
101
102
103
104
105
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

62

63


64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

86
87
88

89



90



91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106







+










+
















-

-
+
-
-











+
+
+








-
+
+

-

-
-
-

-
-
-





+
+
+
+







} defineCmds[] = {
    {"constructor", TclOODefineConstructorObjCmd, 0},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
    {"destructor", TclOODefineDestructorObjCmd, 0},
    {"export", TclOODefineExportObjCmd, 0},
    {"forward", TclOODefineForwardObjCmd, 0},
    {"method", TclOODefineMethodObjCmd, 0},
    {"private", TclOODefinePrivateObjCmd, 0},
    {"renamemethod", TclOODefineRenameMethodObjCmd, 0},
    {"self", TclOODefineSelfObjCmd, 0},
    {"unexport", TclOODefineUnexportObjCmd, 0},
    {NULL, NULL, 0}
}, objdefCmds[] = {
    {"class", TclOODefineClassObjCmd, 1},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
    {"export", TclOODefineExportObjCmd, 1},
    {"forward", TclOODefineForwardObjCmd, 1},
    {"method", TclOODefineMethodObjCmd, 1},
    {"private", TclOODefinePrivateObjCmd, 1},
    {"renamemethod", TclOODefineRenameMethodObjCmd, 1},
    {"self", TclOODefineObjSelfObjCmd, 0},
    {"unexport", TclOODefineUnexportObjCmd, 1},
    {NULL, NULL, 0}
};

/*
 * What sort of size of things we like to allocate.
 */

#define ALLOC_CHUNK 8

/*
 * Function declarations for things defined in this file.
 */

static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj);
static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
			    const char *nsNameStr);
			    Namespace *nsPtr, const char *nsNameStr);
static void		ClearMixins(Class *clsPtr);
static void		ClearSuperclasses(Class *clsPtr);
static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);
static void		DeletedDefineNamespace(ClientData clientData);
static void		DeletedObjdefNamespace(ClientData clientData);
static void		DeletedHelpersNamespace(ClientData clientData);
static Tcl_NRPostProc	FinalizeAlloc;
static Tcl_NRPostProc	FinalizeNext;
static Tcl_NRPostProc	FinalizeObjectCall;
static inline void	InitClassPath(Tcl_Interp * interp, Class *clsPtr);
static void		InitClassSystemRoots(Tcl_Interp *interp,
			    Foundation *fPtr);
static int		InitFoundation(Tcl_Interp *interp);
static void		KillFoundation(ClientData clientData,
			    Tcl_Interp *interp);
static void		MyDeleted(ClientData clientData);
static void		ObjectNamespaceDeleted(ClientData clientData);
static void		ObjectRenamedTrace(ClientData clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);
static void		ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
static inline void	RemoveClass(Class **list, int num, int idx);
static inline void	RemoveObject(Object **list, int num, int idx);
static inline void	SquelchCachedName(Object *oPtr);
static void		SquelchedNsFirst(ClientData clientData);

static int		PublicObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		PublicNRObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		PrivateObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		PrivateNRObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		MyClassNRObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static void		MyClassDeleted(ClientData clientData);

/*
 * Methods in the oo::object and oo::class classes. First, we define a helper
 * macro that makes building the method type declaration structure a lot
 * easier. No point in making life harder than it has to be!
 *
 * Note that the core methods don't need clone or free proc callbacks.
142
143
144
145
146
147
148
149

150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
143
144
145
146
147
148
149

150
151
152





























153



























154
155
156
157
158
159
160







-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
/* " tcloo.tcl OO_LIBRARY oo::library;"; */

/*
 * The scripted part of the definitions of slots.
 * The scripted part of the definitions of TclOO.
 */

static const char *slotScript =
"::oo::define ::oo::Slot {\n"
"    method Get {} {error unimplemented}\n"
"    method Set list {error unimplemented}\n"
"    method -set args {\n"
"        uplevel 1 [list [namespace which my] Set $args]\n"
"    }\n"
"    method -append args {\n"
"        uplevel 1 [list [namespace which my] Set [list"
"                {*}[uplevel 1 [list [namespace which my] Get]] {*}$args]]\n"
"    }\n"
"    method -clear {} {uplevel 1 [list [namespace which my] Set {}]}\n"
"    forward --default-operation my -append\n"
"    method unknown {args} {\n"
"        set def --default-operation\n"
"        if {[llength $args] == 0} {\n"
"            return [uplevel 1 [list [namespace which my] $def]]\n"
"        } elseif {![string match -* [lindex $args 0]]} {\n"
"            return [uplevel 1 [list [namespace which my] $def {*}$args]]\n"
"        }\n"
"        next {*}$args\n"
"    }\n"
"    export -set -append -clear\n"
"    unexport unknown destroy\n"
"}\n"
"::oo::objdefine ::oo::define::superclass forward --default-operation my -set\n"
"::oo::objdefine ::oo::define::mixin forward --default-operation my -set\n"
"::oo::objdefine ::oo::objdefine::mixin forward --default-operation my -set\n";

#include "tclOOScript.h"
/*
 * The body of the <cloned> method of oo::object.
 */

static const char *clonedBody =
"foreach p [info procs [info object namespace $originObject]::*] {"
"    set args [info args $p];"
"    set idx -1;"
"    foreach a $args {"
"        lset args [incr idx] "
"            [if {[info default $p $a d]} {list $a $d} {list $a}]"
"    };"
"    set b [info body $p];"
"    set p [namespace tail $p];"
"    proc $p $args $b;"
"};"
"foreach v [info vars [info object namespace $originObject]::*] {"
"    upvar 0 $v vOrigin;"
"    namespace upvar [namespace current] [namespace tail $v] vNew;"
"    if {[info exists vOrigin]} {"
"        if {[array exists vOrigin]} {"
"            array set vNew [array get vOrigin];"
"        } else {"
"            set vNew $vOrigin;"
"        }"
"    }"
"}";

/*
 * The actual definition of the variable holding the TclOO stub table.
 */

MODULE_SCOPE const TclOOStubs tclOOStubs;

224
225
226
227
228
229
230
231

232
233
234










































235
236
237
238
239
240
241
170
171
172
173
174
175
176

177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229







-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *
 * The ocPtr parameter (only in these macros) is assumed to work fine with
 * either an oPtr or a classPtr. Note that the roots oo::object and oo::class
 * have _both_ their object and class flags tagged with ROOT_OBJECT and
 * ROOT_CLASS respectively.
 */

#define Deleted(oPtr)		(((Object *)(oPtr))->command == NULL)
#define Deleted(oPtr)		((oPtr)->flags & OBJECT_DELETED)
#define IsRootObject(ocPtr)	((ocPtr)->flags & ROOT_OBJECT)
#define IsRootClass(ocPtr)	((ocPtr)->flags & ROOT_CLASS)
#define IsRoot(ocPtr)		((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))

#define RemoveItem(type, lst, i) \
    do {						\
	Remove ## type ((lst).list, (lst).num, i);	\
	(lst).num--;					\
    } while (0)

/*
 * ----------------------------------------------------------------------
 *
 * RemoveClass, RemoveObject --
 *
 *	Helpers for the RemoveItem macro for deleting a class or object from a
 *	list. Setting the "empty" location to NULL makes debugging a little
 *	easier.
 *
 * ----------------------------------------------------------------------
 */

static inline void
RemoveClass(
    Class **list,
    int num,
    int idx)
{
    for (; idx < num - 1; idx++) {
	list[idx] = list[idx + 1];
    }
    list[idx] = NULL;
}

static inline void
RemoveObject(
    Object **list,
    int num,
    int idx)
{
    for (; idx < num - 1; idx++) {
	list[idx] = list[idx + 1];
    }
    list[idx] = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOInit --
 *
 *	Called to initialise the OO system within an interpreter.
308
309
310
311
312
313
314
315

316
317
318
319
320
321
322
296
297
298
299
300
301
302

303
304
305
306
307
308
309
310







-
+







InitFoundation(
    Tcl_Interp *interp)
{
    static Tcl_ThreadDataKey tsdKey;
    ThreadLocalData *tsdPtr =
	    Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
    Foundation *fPtr = ckalloc(sizeof(Foundation));
    Tcl_Obj *namePtr, *argsPtr, *bodyPtr;
    Tcl_Obj *namePtr;
    Tcl_DString buffer;
    Command *cmdPtr;
    int i;

    /*
     * Initialize the structure that holds the OO system core. This is
     * attached to the interpreter via an assocData entry; not very efficient,
371
372
373
374
375
376
377
378

379
380
381
382
383
384
385

386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
359
360
361
362
363
364
365

366

367
368




369














370
371
372
373
374
375
376
377
378
379
380
381












382
383
384
385
386
387
388







-
+
-


-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
-
-
-
-
-
-
-
-
-
-
-







		objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }

    Tcl_CallWhenDeleted(interp, KillFoundation, NULL);

    /*
     * Create the objects at the core of the object system. These need to be
     * Create the special objects at the core of the object system.
     * spliced manually.
     */

    fPtr->objectCls = AllocClass(interp,
	    AllocObject(interp, "::oo::object", NULL));
    fPtr->classCls = AllocClass(interp,
	    AllocObject(interp, "::oo::class", NULL));
    InitClassSystemRoots(interp, fPtr);
    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
    fPtr->objectCls->flags |= ROOT_OBJECT;
    fPtr->objectCls->superclasses.num = 0;
    ckfree(fPtr->objectCls->superclasses.list);
    fPtr->objectCls->superclasses.list = NULL;
    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
    fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
    fPtr->classCls->flags |= ROOT_CLASS;
    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
    TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
    AddRef(fPtr->objectCls->thisPtr);
    AddRef(fPtr->objectCls);

    /*
     * Basic method declarations for the core classes.
     */

    for (i=0 ; objMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
    }
    for (i=0 ; clsMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
    }

    /*
     * Create the default <cloned> method implementation, used when 'oo::copy'
     * is called to finish the copying of one object to another.
     */

    TclNewLiteralStringObj(argsPtr, "originObject");
    Tcl_IncrRefCount(argsPtr);
    bodyPtr = Tcl_NewStringObj(clonedBody, -1);
    TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
	    bodyPtr, NULL);
    TclDecrRefCount(argsPtr);

    /*
     * Finish setting up the class of classes by marking the 'new' method as
     * private; classes, unlike general objects, must have explicit names. We
     * also need to create the constructor for classes.
     */

    TclNewLiteralStringObj(namePtr, "new");
457
458
459
460
461
462
463





464











































































465
466
467
468
469
470
471
415
416
417
418
419
420
421
422
423
424
425
426

427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508







+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    /*
     * Now make the class of slots.
     */

    if (TclOODefineSlots(fPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Evaluate the remaining definitions, which are a compiled-in Tcl script.
     */

    return Tcl_EvalEx(interp, slotScript, -1, 0);
    return Tcl_EvalEx(interp, tclOOSetupScript, -1, 0);
}

/*
 * ----------------------------------------------------------------------
 *
 * InitClassSystemRoots --
 *
 *	Creates the objects at the core of the object system. These need to be
 *	spliced manually.
 *
 * ----------------------------------------------------------------------
 */

static void
InitClassSystemRoots(
    Tcl_Interp *interp,
    Foundation *fPtr)
{
    Class fakeCls;
    Object fakeObject;

    /* Stand up a phony class for bootstrapping. */
    fPtr->objectCls = &fakeCls;
    /* referenced in TclOOAllocClass to increment the refCount. */
    fakeCls.thisPtr = &fakeObject;

    fPtr->objectCls = TclOOAllocClass(interp,
	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
    /* Corresponding TclOODecrRefCount in KillFoudation */
    AddRef(fPtr->objectCls->thisPtr);

    /* This is why it is unnecessary in this routine to replace the
     * incremented reference count of fPtr->objectCls that was swallowed by
     * fakeObject. */
    fPtr->objectCls->superclasses.num = 0;
    ckfree(fPtr->objectCls->superclasses.list);
    fPtr->objectCls->superclasses.list = NULL;

    /* special initialization for the primordial objects */
    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
    fPtr->objectCls->flags |= ROOT_OBJECT;

    fPtr->classCls = TclOOAllocClass(interp,
	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
    /* Corresponding TclOODecrRefCount in KillFoudation */
    AddRef(fPtr->classCls->thisPtr);

    /*
     * Increment reference counts for each reference because these
     * relationships can be dynamically changed.
     *
     * Corresponding TclOODecrRefCount for all incremented refcounts is in
     * KillFoundation.
     */

    /* Rewire bootstrapped objects. */
    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
    AddRef(fPtr->classCls->thisPtr);
    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);

    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
    AddRef(fPtr->classCls->thisPtr);
    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);

    fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
    fPtr->classCls->flags |= ROOT_CLASS;

    /* Standard initialization for new Objects */
    TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);

    /*
     * THIS IS THE ONLY FUNCTION THAT DOES NON-STANDARD CLASS SPLICING.
     * Everything else is careful to prohibit looping.
     */
}

/*
 * ----------------------------------------------------------------------
 *
 * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace --
 *
518
519
520
521
522
523
524
525
526
527
528
529
530
531



532
533
534
535
536
537
538
539
540
541
542





543
544
545
546
547
548
549
550
551
552
553
554


555
556
557
558
559
560
561
562
563
564
565

566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583

584
585
586
587
588
589
590
591
592
593
594
595
596

597
598
599
600
601
602
603
604
605
606
607
608
609
610
611





612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637

638
639
640
641
642
643
644
645







646

647
648
649
650
651
652
653
654
655
656
657
658
659




660
661
662
663

664
665
666
667
668
669
670
671
672


673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692

693
694
695
696
697
698
699
700
701
702
703
704
705
706
707




708
709
710
711
712
713
714
555
556
557
558
559
560
561


562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578


579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625

626

627
628
629
630
631
632
633
634
635
636
637

638

639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662

663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681

682
683
684
685
686
687
688

689
690
691
692
693
694
695
696

697
698
699
700
701
702
703
704
705
706




707
708
709
710




711








712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729





730















731
732
733
734
735
736
737
738
739
740
741







-
-





+
+
+









-
-
+
+
+
+
+












+
+










-
+

















-
+
-











-
+
-














+
+
+
+
+





-



















-
+






-

+
+
+
+
+
+
+
-
+









-
-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
-

+
+















-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+







    ClientData clientData,	/* Pointer to the OO system foundation
				 * structure. */
    Tcl_Interp *interp)		/* The interpreter containing the OO system
				 * foundation. */
{
    Foundation *fPtr = GetFoundation(interp);

    DelRef(fPtr->objectCls->thisPtr);
    DelRef(fPtr->objectCls);
    TclDecrRefCount(fPtr->unknownMethodNameObj);
    TclDecrRefCount(fPtr->constructorName);
    TclDecrRefCount(fPtr->destructorName);
    TclDecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->defineName);
    TclOODecrRefCount(fPtr->objectCls->thisPtr);
    TclOODecrRefCount(fPtr->classCls->thisPtr);

    ckfree(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --
 *
 *	Allocate an object of basic type. Does not splice the object into its
 *	class's instance list.  The caller must set the classPtr on the object,
 *	either to a class or to NULL.
 *	class's instance list.  The caller must set the classPtr on the object
 *	to either a class or NULL, call TclOOAddToInstances to add the object
 *	to the class's instance list, and if the object itself is a class, use
 *	call TclOOAddToSubclasses() to add it to the right class's list of
 *	subclasses.
 *
 * ----------------------------------------------------------------------
 */

static Object *
AllocObject(
    Tcl_Interp *interp,		/* Interpreter within which to create the
				 * object. */
    const char *nameStr,	/* The name of the object to create, or NULL
				 * if the OO system should pick the object
				 * name itself (equal to the namespace
				 * name). */
    Namespace *nsPtr,		/* The namespace to create the object in, or
				 * NULL if *nameStr is NULL */
    const char *nsNameStr)	/* The name of the namespace to create, or
				 * NULL if the OO system should pick a unique
				 * name itself. If this is non-NULL but names
				 * a namespace that already exists, the effect
				 * will be the same as if this was NULL. */
{
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;
    Command *cmdPtr;
    CommandTrace *tracePtr;
    int creationEpoch, ignored;
    int creationEpoch;

    oPtr = ckalloc(sizeof(Object));
    memset(oPtr, 0, sizeof(Object));

    /*
     * Every object has a namespace; make one. Note that this also normally
     * computes the creation epoch value for the object, a sequence number
     * that is unique to the object (and which allows us to manage method
     * caching without comparing pointers).
     *
     * When creating a namespace, we first check to see if the caller
     * specified the name for the namespace. If not, we generate namespace
     * names using the epoch until such time as a new namespace is actually
     * created.
     */

    if (nsNameStr != NULL) {
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr,
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr, NULL);
		ObjectNamespaceDeleted);
	if (oPtr->namespacePtr != NULL) {
	    creationEpoch = ++fPtr->tsdPtr->nsCount;
	    goto configNamespace;
	}
	Tcl_ResetResult(interp);
    }

    while (1) {
	char objName[10 + TCL_INTEGER_SPACE];

	sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount);
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr,
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL);
		ObjectNamespaceDeleted);
	if (oPtr->namespacePtr != NULL) {
	    creationEpoch = fPtr->tsdPtr->nsCount;
	    break;
	}

	/*
	 * Could not make that namespace, so we make another. But first we
	 * have to get rid of the error message from Tcl_CreateNamespace,
	 * since that's something that should not be exposed to the user.
	 */

	Tcl_ResetResult(interp);
    }


  configNamespace:

    ((Namespace *)oPtr->namespacePtr)->refCount++;

    /*
     * Make the namespace know about the helper commands. This grants access
     * to the [self] and [next] commands.
     */

  configNamespace:
    if (fPtr->helpersNs != NULL) {
	TclSetNsPath((Namespace *) oPtr->namespacePtr, 1, &fPtr->helpersNs);
    }
    TclOOSetupVariableResolver(oPtr->namespacePtr);

    /*
     * Suppress use of compiled versions of the commands in this object's
     * namespace and its children; causes wrong behaviour without expensive
     * recompilation. [Bug 2037727]
     */

    ((Namespace *) oPtr->namespacePtr)->flags |= NS_SUPPRESS_COMPILATION;

    /*
     * Set up a callback to get notification of the deletion of a namespace
     * when enough of the namespace still remains to execute commands and
     * access variables in it. [Bug 2950259]
     */

    ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc = SquelchedNsFirst;
    ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc = ObjectNamespaceDeleted;

    /*
     * Fill in the rest of the non-zero/NULL parts of the structure.
     */

    oPtr->fPtr = fPtr;
    oPtr->selfCls = fPtr->objectCls;
    oPtr->creationEpoch = creationEpoch;

    /*
     * An object starts life with a refCount of 2 to mark the two stages of
     * destruction it occur:  A call to ObjectRenamedTrace(), and a call to
     * ObjectNamespaceDeleted().
     */

    oPtr->refCount = 1;
    oPtr->refCount = 2;
    oPtr->flags = USE_CLASS_CACHE;

    /*
     * Finally, create the object commands and initialize the trace on the
     * public command (so that the object structures are deleted when the
     * command is deleted).
     */

    if (!nameStr) {
	oPtr->command = Tcl_CreateObjCommand(interp,
		oPtr->namespacePtr->fullName, PublicObjectCmd, oPtr, NULL);
    } else if (nameStr[0] == ':' && nameStr[1] == ':') {
	oPtr->command = Tcl_CreateObjCommand(interp, nameStr,
	nameStr = oPtr->namespacePtr->name;
	nsPtr = (Namespace *)oPtr->namespacePtr;
	if (nsPtr->parentPtr != NULL) {
	    nsPtr = nsPtr->parentPtr;
		PublicObjectCmd, oPtr, NULL);
    } else {
	Tcl_DString buffer;

	}
	Tcl_DStringInit(&buffer);
	Tcl_DStringAppend(&buffer,
		Tcl_GetCurrentNamespace(interp)->fullName, -1);
	TclDStringAppendLiteral(&buffer, "::");
	Tcl_DStringAppend(&buffer, nameStr, -1);
	oPtr->command = Tcl_CreateObjCommand(interp,
		Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL);
	Tcl_DStringFree(&buffer);
    }
    oPtr->command = TclCreateObjCommandInNs(interp, nameStr,
	(Tcl_Namespace *)nsPtr, TclOOPublicObjectCmd, oPtr, NULL);

    /*
     * Add the NRE command and trace directly. While this breaks a number of
     * abstractions, it is faster and we're inside Tcl here so we're allowed.
     */

    cmdPtr = (Command *) oPtr->command;
    cmdPtr->nreProc = PublicNRObjectCmd;
    cmdPtr->tracePtr = tracePtr = ckalloc(sizeof(CommandTrace));
    tracePtr->traceProc = ObjectRenamedTrace;
    tracePtr->clientData = oPtr;
    tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
    tracePtr->nextPtr = NULL;
    tracePtr->refCount = 1;

    /*
     * Access the namespace command table directly when creating "my" to avoid
     * a bottleneck in string manipulation. Another abstraction-buster.
     */

    oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr,
    cmdPtr = ckalloc(sizeof(Command));
    memset(cmdPtr, 0, sizeof(Command));
    cmdPtr->nsPtr = (Namespace *) oPtr->namespacePtr;
    cmdPtr->hPtr = Tcl_CreateHashEntry(&cmdPtr->nsPtr->cmdTable, "my",
	    &ignored);
    cmdPtr->refCount = 1;
    cmdPtr->objProc = PrivateObjectCmd;
    cmdPtr->deleteProc = MyDeleted;
    cmdPtr->objClientData = cmdPtr->deleteData = oPtr;
    cmdPtr->proc = TclInvokeObjectCommand;
    cmdPtr->clientData = cmdPtr;
    cmdPtr->nreProc = PrivateNRObjectCmd;
    Tcl_SetHashValue(cmdPtr->hPtr, cmdPtr);
    oPtr->myCommand = (Tcl_Command) cmdPtr;

	    TclOOPrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
    oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass",
	    oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr,
            MyClassDeleted);
    return oPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * SquelchCachedName --
728
729
730
731
732
733
734
735

736
737
738
739




740
741
742
743
744
745
746
747
748
749
750
751
752
753
754

755
756
757
758
759
760
761
762
763
764
765
766
767
768
769

770
771
772
773

774
775
776
777
778
779
780
781
782
783
755
756
757
758
759
760
761

762
763



764
765
766
767

768
769
770
771
772
773
774
775
776
777
778
779
780

781













782

783
784
785
786

787



788
789
790
791
792
793
794







-
+

-
-
-
+
+
+
+
-













-
+
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+



-
+
-
-
-







	oPtr->cachedNameObj = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * MyDeleted --
 * MyDeleted, MyClassDeleted --
 *
 *	This callback is triggered when the object's [my] command is deleted
 *	by any mechanism. It just marks the object as not having a [my]
 *	command, and so prevents cleanup of that when the object itself is
 *	These callbacks are triggered when the object's [my] or [myclass]
 *	commands are deleted by any mechanism. They just mark the object as
 *	not having a [my] command or [myclass] command, and so prevent cleanup
 *	of those commands when the object itself is deleted.
 *	deleted.
 *
 * ----------------------------------------------------------------------
 */

static void
MyDeleted(
    ClientData clientData)	/* Reference to the object whose [my] has been
				 * squelched. */
{
    register Object *oPtr = clientData;

    oPtr->myCommand = NULL;
}


/*
 * ----------------------------------------------------------------------
 *
 * SquelchedNsFirst --
 *
 *	This callback is triggered when the object's namespace is deleted by
 *	any mechanism. It deletes the object's public command if it has not
 *	already been deleted, so ensuring that destructors get run at an
 *	appropriate time. [Bug 2950259]
 *
 * ----------------------------------------------------------------------
 */

static void
SquelchedNsFirst(
MyClassDeleted(
    ClientData clientData)
{
    Object *oPtr = clientData;

    oPtr->myclassCommand = NULL;
    if (oPtr->command) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectRenamedTrace --
 *
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881

882
883
884

885
886
887

888
889
890
891
892
893
894


895
896
897
898
899
900

901
902
903

904
905
906
907
908
909
910
911
912
913






























914




915
916
917
918










919
920
921

922
923
924
925
926






927
928
929
930
931
932









933

934

935
936
937




938
939
940

941
942
943




944
945
946
947
948
949

950
951
952
953
954
955
956
957
958


959
960
961
962
963
964
965


966


967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
805
806
807
808
809
810
811

812
813
814
815
816
817
818
819
820
821
822
823


































































824

825
826
827

828
829
830

831







832
833
834
835
836
837
838

839
840


841
842
843
844
845






846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880




881
882
883
884
885
886
887
888
889
890


891
892





893
894
895
896
897
898






899
900
901
902
903
904
905
906
907
908
909

910



911
912
913
914


915
916



917
918
919
920
921
922
923
924
925

926
927
928
929
930
931
932
933


934
935
936
937
938
939
940


941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957



958
























































































































959
960
961
962
963
964
965







-












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+


-
+


-
+
-
-
-
-
-
-
-
+
+





-
+

-
-
+




-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-

+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

+
-
+
-
-
-
+
+
+
+
-
-

+
-
-
-
+
+
+
+





-
+







-
-
+
+





-
-
+
+

+
+












-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    ClientData clientData,	/* The object being deleted. */
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    const char *oldName,	/* What the object was (last) called. */
    const char *newName,	/* What it's getting renamed to. (unused) */
    int flags)			/* Why was the object deleted? */
{
    Object *oPtr = clientData;
    Foundation *fPtr = oPtr->fPtr;

    /*
     * If this is a rename and not a delete of the object, we just flush the
     * cache of the object name.
     */

    if (flags & TCL_TRACE_RENAME) {
	SquelchCachedName(oPtr);
	return;
    }

    /*
     * Oh dear, the object really is being deleted. Handle this by running the
     * destructors and deleting the object's namespace, which in turn causes
     * the real object structures to be deleted.
     *
     * Note that it is possible for the namespace to be deleted before the
     * command. Because of that case, we must take care here to mark the
     * command as being deleted so that if we return here we don't run into
     * reentrancy problems.
     *
     * We also do not run destructors on the core class objects when the
     * interpreter is being deleted; their incestuous nature causes problems
     * in that case when the destructor is partially deleted before the uses
     * of it have gone. [Bug 2949397]
     */

    AddRef(oPtr);
    AddRef(fPtr->classCls);
    AddRef(fPtr->objectCls);
    AddRef(fPtr->classCls->thisPtr);
    AddRef(fPtr->objectCls->thisPtr);
    oPtr->command = NULL;

    if (!(oPtr->flags & DESTRUCTOR_CALLED) && !Tcl_InterpDeleted(interp)) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
	int result;
	Tcl_InterpState state;

	oPtr->flags |= DESTRUCTOR_CALLED;
	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
		    contextPtr, 0, NULL);
	    if (result != TCL_OK) {
		Tcl_BackgroundException(interp, result);
	    }
	    Tcl_RestoreInterpState(interp, state);
	    TclOODeleteContext(contextPtr);
	}
    }

    /*
     * OK, the destructor's been run. Time to splat the class data (if any)
     * and nuke the namespace (which triggers the final crushing of the object
     * structure itself).
     *
     * The class of objects needs some special care; if it is deleted (and
     * we're not killing the whole interpreter) we force the delete of the
     * class of classes now as well. Due to the incestuous nature of those two
     * classes, if one goes the other must too and yet the tangle can
     * sometimes not go away automatically; we force it here. [Bug 2962664]
     */

    if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr)
	    && !Deleted(fPtr->classCls->thisPtr)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
    }

    if (oPtr->classPtr != NULL) {
	AddRef(oPtr->classPtr);
	ReleaseClassContents(interp, oPtr);
    }

    /*
     * The namespace is only deleted if it hasn't already been deleted. [Bug
     * 2950259]
     * 2950259].
     */

    if (oPtr->namespacePtr && ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
    if (!Deleted(oPtr)) {
	Tcl_DeleteNamespace(oPtr->namespacePtr);
    }
    if (oPtr->classPtr) {
    oPtr->command = NULL;
	DelRef(oPtr->classPtr);
    }
    DelRef(fPtr->classCls->thisPtr);
    DelRef(fPtr->objectCls->thisPtr);
    DelRef(fPtr->classCls);
    DelRef(fPtr->objectCls);
    DelRef(oPtr);
    TclOODecrRefCount(oPtr);
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClearMixins, ClearSuperclasses --
 * TclOODeleteDescendants --
 *
 *	Utility functions for correctly clearing the list of mixins or
 *	superclasses of a class. Will ckfree() the list storage.
 *	Delete all descendants of a particular class.
 *
 * ----------------------------------------------------------------------
 */

static void
ClearMixins(
    Class *clsPtr)
{
    int i;
    Class *mixinPtr;
void
TclOODeleteDescendants(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr;
    Object *instancePtr;

    /*
     * Squelch classes that this class has been mixed into.
     */

    if (clsPtr->mixinSubs.num > 0) {
	while (clsPtr->mixinSubs.num > 0) {
	    mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1];
	    /* This condition also covers the case where mixinSubclassPtr ==
	     * clsPtr
	     */
	    if (!Deleted(mixinSubclassPtr->thisPtr)
		    && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			mixinSubclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
	}
    }
    if (clsPtr->mixinSubs.size > 0) {
	ckfree(clsPtr->mixinSubs.list);
	clsPtr->mixinSubs.size = 0;
    }

    /*
     * Squelch subclasses of this class.
     */

    if (clsPtr->mixins.num == 0) {
	return;
    }

    if (clsPtr->subclasses.num > 0) {
	while (clsPtr->subclasses.num > 0) {
	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
		    && !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			subclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
	}
    FOREACH(mixinPtr, clsPtr->mixins) {
	TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
    }
    if (clsPtr->subclasses.size > 0) {
    ckfree(clsPtr->mixins.list);
    clsPtr->mixins.list = NULL;
    clsPtr->mixins.num = 0;
}

	ckfree(clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.size = 0;
    }

    /*
static void
ClearSuperclasses(
    Class *clsPtr)
{
    int i;
    Class *superPtr;
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (clsPtr->instances.num > 0) {
	while (clsPtr->instances.num > 0) {
	    instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
	    /*
	     * This condition also covers the case where instancePtr == oPtr
	     */

	    if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
    if (clsPtr->superclasses.num == 0) {
		    !(instancePtr->flags & DONT_DELETE)) {
	return;
    }

		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
	    }
	    TclOORemoveFromInstances(instancePtr, clsPtr);
	}
    FOREACH(superPtr, clsPtr->superclasses) {
	TclOORemoveFromSubclasses(clsPtr, superPtr);
    }
    if (clsPtr->instances.size > 0) {
    ckfree(clsPtr->superclasses.list);
    clsPtr->superclasses.list = NULL;
    clsPtr->superclasses.num = 0;
	ckfree(clsPtr->instances.list);
	clsPtr->instances.list = NULL;
	clsPtr->instances.size = 0;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * ReleaseClassContents --
 * TclOOReleaseClassContents --
 *
 *	Tear down the special class data structure, including deleting all
 *	dependent classes and objects.
 *
 * ----------------------------------------------------------------------
 */

static void
ReleaseClassContents(
void
TclOOReleaseClassContents(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    FOREACH_HASH_DECLS;
    int i;
    Class *clsPtr = oPtr->classPtr, *mixinSubclassPtr, *subclassPtr;
    Object *instancePtr;
    Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
    Method *mPtr;
    Foundation *fPtr = oPtr->fPtr;
    Tcl_Obj *variableObj;
    PrivateVariableMapping *privateVariable;

    /*
     * Sanity check!
     */

    if (!Deleted(oPtr)) {
	if (IsRootClass(oPtr)) {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "::oo::class");
	} else if (IsRootObject(oPtr)) {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "::oo::object");
	} else {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "general object");
	}
    }

    /*
     * Lock a number of dependent objects until we've stopped putting our
     * fingers in them.
     */

    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
	if (mixinSubclassPtr != NULL) {
	    AddRef(mixinSubclassPtr);
	    AddRef(mixinSubclassPtr->thisPtr);
	}
    }
    FOREACH(subclassPtr, clsPtr->subclasses) {
	if (subclassPtr != NULL && !IsRoot(subclassPtr)) {
	    AddRef(subclassPtr);
	    AddRef(subclassPtr->thisPtr);
	}
    }
    if (!IsRootClass(oPtr)) {
	FOREACH(instancePtr, clsPtr->instances) {
	    int j;
	    if (instancePtr->selfCls == clsPtr) {
		instancePtr->flags |= CLASS_GONE;
	    }
	    for(j=0 ; j<instancePtr->mixins.num ; j++) {
		Class *mixin = instancePtr->mixins.list[j];
		Class *nextMixin = NULL;
		if (mixin == clsPtr) {
		    if (j < instancePtr->mixins.num - 1) {
			nextMixin = instancePtr->mixins.list[j+1];
		    }
		    if (j == 0) {
			instancePtr->mixins.num = 0;
			instancePtr->mixins.list = NULL;
		    } else {
			instancePtr->mixins.list[j-1] = nextMixin;
		    }
		    instancePtr->mixins.num -= 1;
		}
	    }
	    if (instancePtr != NULL && !IsRoot(instancePtr)) {
		AddRef(instancePtr);
	    }
	}
    }

    /*
     * Squelch classes that this class has been mixed into.
     */

    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
	if (!Deleted(mixinSubclassPtr->thisPtr)) {
	    Tcl_DeleteCommandFromToken(interp,
		    mixinSubclassPtr->thisPtr->command);
	}
	ClearMixins(mixinSubclassPtr);
	DelRef(mixinSubclassPtr->thisPtr);
	DelRef(mixinSubclassPtr);
    }
    if (clsPtr->mixinSubs.list != NULL) {
	ckfree(clsPtr->mixinSubs.list);
	clsPtr->mixinSubs.list = NULL;
	clsPtr->mixinSubs.num = 0;
    }

    /*
     * Squelch subclasses of this class.
     */

    FOREACH(subclassPtr, clsPtr->subclasses) {
	if (IsRoot(subclassPtr)) {
	    continue;
	}
	if (!Deleted(subclassPtr->thisPtr)) {
	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
	}
	ClearSuperclasses(subclassPtr);
	DelRef(subclassPtr->thisPtr);
	DelRef(subclassPtr);
    }
    if (clsPtr->subclasses.list != NULL) {
	ckfree(clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.num = 0;
    }

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (!IsRootClass(oPtr)) {
	FOREACH(instancePtr, clsPtr->instances) {
	    if (instancePtr == NULL || IsRoot(instancePtr)) {
		continue;
	    }
	    if (!Deleted(instancePtr)) {
		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
		/*
		 * Tcl_DeleteCommandFromToken() may have done to whole
		 * job for us.  Roll back and check again.
		 */
		i--;
		continue;
	    }
	    DelRef(instancePtr);
	}
    }
    if (clsPtr->instances.list != NULL) {
	ckfree(clsPtr->instances.list);
	clsPtr->instances.list = NULL;
	clsPtr->instances.num = 0;
    }

    /*
     * Special: We delete these after everything else.
     */

    if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
    }

    /*
     * Squelch method implementation chain caches.
     */

    if (clsPtr->constructorChainPtr) {
1132
1133
1134
1135
1136
1137
1138

1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156














































1157
1158
1159
1160
1161
1162
1163
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066







+


















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    if (clsPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, clsPtr->filters) {
	    TclDecrRefCount(filterObj);
	}
	ckfree(clsPtr->filters.list);
	clsPtr->filters.list = NULL;
	clsPtr->filters.num = 0;
    }

    /*
     * Squelch our metadata.
     */

    if (clsPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(clsPtr->metadataPtr);
	ckfree(clsPtr->metadataPtr);
	clsPtr->metadataPtr = NULL;
    }

    if (clsPtr->mixins.num) {
	FOREACH(tmpClsPtr, clsPtr->mixins) {
	    TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
	    TclOODecrRefCount(tmpClsPtr->thisPtr);
	}
	ckfree(clsPtr->mixins.list);
	clsPtr->mixins.list = NULL;
	clsPtr->mixins.num = 0;
    }

    if (clsPtr->superclasses.num > 0) {
	FOREACH(tmpClsPtr, clsPtr->superclasses) {
	    TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);
	    TclOODecrRefCount(tmpClsPtr->thisPtr);
	}
	ckfree(clsPtr->superclasses.list);
	clsPtr->superclasses.num = 0;
	clsPtr->superclasses.list = NULL;
    }

    FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
	TclOODelMethodRef(mPtr);
    }
    Tcl_DeleteHashTable(&clsPtr->classMethods);
    TclOODelMethodRef(clsPtr->constructorPtr);
    TclOODelMethodRef(clsPtr->destructorPtr);

    FOREACH(variableObj, clsPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	ckfree(clsPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	ckfree(clsPtr->privateVariables.list);
    }

    if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectNamespaceDeleted --
 *
1171
1172
1173
1174
1175
1176
1177

1178
1179

1180
1181



1182






1183



1184










































1185
1186
1187
1188



1189
1190
1191
1192
1193
1194




1195
1196
1197

1198
1199





1200
1201
1202




1203
1204
1205
1206
1207
1208
1209
1210
1211



1212
1213
1214
1215
1216





1217
1218

1219
1220
1221
1222



1223
1224
1225
1226
1227
1228
1229
1074
1075
1076
1077
1078
1079
1080
1081
1082

1083
1084
1085
1086
1087
1088

1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142



1143
1144
1145
1146
1147




1148
1149
1150
1151



1152


1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176





1177
1178
1179
1180
1181

1182
1183
1184



1185
1186
1187
1188
1189
1190
1191
1192
1193
1194







+

-
+


+
+
+
-
+
+
+
+
+
+

+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+


-
-
-
-
+
+
+
+
-
-
-
+
-
-
+
+
+
+
+



+
+
+
+









+
+
+
-
-
-
-
-
+
+
+
+
+
-

+

-
-
-
+
+
+








static void
ObjectNamespaceDeleted(
    ClientData clientData)	/* Pointer to the class whose namespace is
				 * being deleted. */
{
    Object *oPtr = clientData;
    Foundation *fPtr = oPtr->fPtr;
    FOREACH_HASH_DECLS;
    Class *clsPtr = oPtr->classPtr, *mixinPtr;
    Class *mixinPtr;
    Method *mPtr;
    Tcl_Obj *filterObj, *variableObj;
    PrivateVariableMapping *privateVariable;
    Tcl_Interp *interp = oPtr->fPtr->interp;
    int i;
    int deleteAlreadyInProgress = 0, i;

    if (Deleted(oPtr)) {
	/*
	 * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, this
	 * guard could be removed.
	 */

	return;
    }

    /*
     * One rule for the teardown routines is that if an object is in the
     * process of being deleted, nothing else may modify its bookeeping
     * records.  This is the flag that
     */

    oPtr->flags |= OBJECT_DELETED;

    /* Let the dominoes fall */
    if (oPtr->classPtr) {
	TclOODeleteDescendants(interp, oPtr);
    }

    /*
     * We do not run destructors on the core class objects when the
     * interpreter is being deleted; their incestuous nature causes problems
     * in that case when the destructor is partially deleted before the uses
     * of it have gone. [Bug 2949397]
     */

    if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL);
	int result;

	Tcl_InterpState state;
	oPtr->flags |= DESTRUCTOR_CALLED;

	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
		    contextPtr, 0, NULL);
	    if (result != TCL_OK) {
		Tcl_BackgroundException(interp, result);
	    }
	    Tcl_RestoreInterpState(interp, state);
	    TclOODeleteContext(contextPtr);
	}
    }

    /*
     * Instruct everyone to no longer use any allocated fields of the object.
     * Also delete the commands that refer to the object at this point (if
     * they still exist) because otherwise their references to the object
     * point into freed memory, allowing crashes.
     * Also delete the command that refers to the object at this point (if
     * it still exists) because otherwise its pointer to the object
     * points into freed memory.
     */

    if (oPtr->command) {
	if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) {
	    /*
	     * Namespace deletion must have been triggered by a trace on command
    if (((Command *)oPtr->command)->flags && CMD_IS_DELETED) {
	/*
	 * Something has already started the command deletion process. We can
	 * go ahead and clean up the the namespace,
	     * deletion , meaning that ObjectRenamedTrace() is eventually going
	     * to be called .
	     */
	 */
	    deleteAlreadyInProgress = 1;
	}
    } else {
	/*
	 * The namespace must have been deleted directly.  Delete the command
	 * as well.
	 */

	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
    }

    if (oPtr->myclassCommand) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myclassCommand);
    }
    if (oPtr->myCommand) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
    }

    /*
     * Splice the object out of its context. After this, we must *not* call
     * methods on the object.
     */

    /*
     * TODO: Should this be protected with a * !IsRoot() condition?
     */
    if (!IsRootObject(oPtr) && !(oPtr->flags & CLASS_GONE)) {
	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
    }

    FOREACH(mixinPtr, oPtr->mixins) {

    TclOORemoveFromInstances(oPtr, oPtr->selfCls);

    if (oPtr->mixins.num > 0) {
	FOREACH(mixinPtr, oPtr->mixins) {
	if (mixinPtr) {
	    TclOORemoveFromInstances(oPtr, mixinPtr);
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
    }
    if (i) {
	ckfree(oPtr->mixins.list);
	if (oPtr->mixins.list != NULL) {
	    ckfree(oPtr->mixins.list);
	}
    }

    FOREACH(filterObj, oPtr->filters) {
	TclDecrRefCount(filterObj);
    }
    if (i) {
	ckfree(oPtr->filters.list);
1239
1240
1241
1242
1243
1244
1245








1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266

1267
1268

1269
1270

1271
1272

1273
1274
1275
1276
1277
1278
1279
1280
1281

1282
1283
1284
1285
1286
1287
1288
1289

1290
1291
1292
1293



1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309

1310
1311
1312
1313



1314
1315
1316

1317
1318
1319

1320
1321
1322
1323
1324



1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337

































1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351

1352
1353
1354
1355
1356
1357

1358
1359
1360
1361
1362




1363
1364
1365

1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
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
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238

1239


1240


1241


1242









1243








1244




1245
1246
1247
















1248




1249
1250
1251



1252



1253





1254
1255
1256
1257
1258
1259
1260
1261
1262







1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308

1309
1310
1311
1312
1313
1314

1315
1316
1317
1318
1319

1320
1321
1322
1323
1324
1325

1326















1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346



1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400

1401
1402
1403
1404
1405

1406
1407
1408

1409
1410
1411

1412
1413
1414
1415
1416

1417
1418
1419
1420
1421

1422










1423
1424
1425
1426
1427
1428
1429







+
+
+
+
+
+
+
+




















-
+
-
-
+
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
+
-
-
-
+
-
-
-
+
-
-
-
-
-
+
+
+






-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+













-
+





-
+




-
+
+
+
+


-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















-
-
-










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
+




-
+


-
+


-
+




-
+
+
+


-
+
-
-
-
-
-
-
-
-
-
-








    FOREACH(variableObj, oPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	ckfree(oPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, oPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	ckfree(oPtr->privateVariables.list);
    }

    if (oPtr->chainCache) {
	TclOODeleteChainCache(oPtr->chainCache);
    }

    SquelchCachedName(oPtr);

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	ckfree(oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;
    }

    /*
     * If this was a class, there's additional deletion work to do.
     * Because an object can be a class that is an instance of itself, the
     */

     * class object's class structure should only be cleaned after most of
    if (clsPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
     * the cleanup on the object is done.
	ClientData value;

     *
	if (clsPtr->metadataPtr != NULL) {
	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
		metadataTypePtr->deleteProc(value);
	    }
	    Tcl_DeleteHashTable(clsPtr->metadataPtr);
	    ckfree(clsPtr->metadataPtr);
	    clsPtr->metadataPtr = NULL;
	}

     * The class of objects needs some special care; if it is deleted (and
	FOREACH(filterObj, clsPtr->filters) {
	    TclDecrRefCount(filterObj);
	}
	if (i) {
	    ckfree(clsPtr->filters.list);
	    clsPtr->filters.num = 0;
	}

     * we're not killing the whole interpreter) we force the delete of the
	ClearMixins(clsPtr);

	ClearSuperclasses(clsPtr);

     * class of classes now as well. Due to the incestuous nature of those two
     * classes, if one goes the other must too and yet the tangle can
     * sometimes not go away automatically; we force it here. [Bug 2962664]
	if (clsPtr->subclasses.list) {
	    ckfree(clsPtr->subclasses.list);
	    clsPtr->subclasses.list = NULL;
	    clsPtr->subclasses.num = 0;
	}
	if (clsPtr->instances.list) {
	    ckfree(clsPtr->instances.list);
	    clsPtr->instances.list = NULL;
	    clsPtr->instances.num = 0;
	}
	if (clsPtr->mixinSubs.list) {
	    ckfree(clsPtr->mixinSubs.list);
	    clsPtr->mixinSubs.list = NULL;
	    clsPtr->mixinSubs.num = 0;
	}

     */
	FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
	    TclOODelMethodRef(mPtr);
	}
	Tcl_DeleteHashTable(&clsPtr->classMethods);

    if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr)
	    && !Tcl_InterpDeleted(interp)) {
	TclOODelMethodRef(clsPtr->constructorPtr);
	TclOODelMethodRef(clsPtr->destructorPtr);

	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
	FOREACH(variableObj, clsPtr->variables) {
	    TclDecrRefCount(variableObj);
	}
    }
	if (i) {
	    ckfree(clsPtr->variables.list);
	}

	DelRef(clsPtr);

    if (oPtr->classPtr != NULL) {
	TclOOReleaseClassContents(interp, oPtr);
    }

    /*
     * Delete the object structure itself.
     */

    if (deleteAlreadyInProgress) {
	oPtr->classPtr = NULL;
	oPtr->namespacePtr = NULL;
    } else {
	DelRef(oPtr);
    }

    TclNsDecrRefCount((Namespace *)oPtr->namespacePtr);
    oPtr->namespacePtr = NULL;
    TclOODecrRefCount(oPtr->selfCls->thisPtr);
    oPtr->selfCls = NULL;
    TclOODecrRefCount(oPtr);
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODecrRefCount --
 *
 *	Decrement the refcount of an object and deallocate storage then object
 *	is no longer referenced.  Returns 1 if storage was deallocated, and 0
 *	otherwise.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODecrRefCount(
    Object *oPtr)
{
    if (oPtr->refCount-- <= 1) {

	if (oPtr->classPtr != NULL) {
	    ckfree(oPtr->classPtr);
	}
	ckfree(oPtr);
	return 1;
    }
    return 0;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromInstances --
 *
 *	Utility function to remove an object from the list of instances within
 *	a class.
 *
 * ----------------------------------------------------------------------
 */

void
int
TclOORemoveFromInstances(
    Object *oPtr,		/* The instance to remove. */
    Class *clsPtr)		/* The class (possibly) containing the
				 * reference to the instance. */
{
    int i;
    int i, res = 0;
    Object *instPtr;

    FOREACH(instPtr, clsPtr->instances) {
	if (oPtr == instPtr) {
	    goto removeInstance;
	    RemoveItem(Object, clsPtr->instances, i);
	    TclOODecrRefCount(oPtr);
	    res++;
	    break;
	}
    }
    return;
    return res;

  removeInstance:
    if (Deleted(clsPtr->thisPtr)) {
	if (!IsRootClass(clsPtr)) {
	    DelRef(clsPtr->instances.list[i]);
	}
	clsPtr->instances.list[i] = NULL;
    } else {
	clsPtr->instances.num--;
	if (i < clsPtr->instances.num) {
	    clsPtr->instances.list[i] =
		    clsPtr->instances.list[clsPtr->instances.num];
	}
	clsPtr->instances.list[clsPtr->instances.num] = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAddToInstances --
 *
 *	Utility function to add an object to the list of instances within a
 *	class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOAddToInstances(
    Object *oPtr,		/* The instance to add. */
    Class *clsPtr)		/* The class to add the instance to. It is
				 * assumed that the class is not already
				 * present as an instance in the class. */
{
    if (Deleted(clsPtr->thisPtr)) {
	return;
    }
    if (clsPtr->instances.num >= clsPtr->instances.size) {
	clsPtr->instances.size += ALLOC_CHUNK;
	if (clsPtr->instances.size == ALLOC_CHUNK) {
	    clsPtr->instances.list = ckalloc(sizeof(Object *) * ALLOC_CHUNK);
	} else {
	    clsPtr->instances.list = ckrealloc(clsPtr->instances.list,
		    sizeof(Object *) * clsPtr->instances.size);
	}
    }
    clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
    AddRef(oPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromMixins --
 *
 *	Utility function to remove a class from the list of mixins within an
 *	object.
 *
 * ----------------------------------------------------------------------
 */

int
TclOORemoveFromMixins(
    Class *mixinPtr,		/* The mixin to remove. */
    Object *oPtr)		/* The object (possibly) containing the
				 * reference to the mixin. */
{
    int i, res = 0;
    Class *mixPtr;

    FOREACH(mixPtr, oPtr->mixins) {
	if (mixinPtr == mixPtr) {
	    RemoveItem(Class, oPtr->mixins, i);
	    TclOODecrRefCount(mixPtr->thisPtr);
	    res++;
	    break;
	}
    }
    if (oPtr->mixins.num == 0) {
	ckfree(oPtr->mixins.list);
	oPtr->mixins.list = NULL;
    }
    return res;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromSubclasses --
 *
 *	Utility function to remove a class from the list of subclasses within
 *	another class.
 *	another class. Returns the number of removals performed.
 *
 * ----------------------------------------------------------------------
 */

void
int
TclOORemoveFromSubclasses(
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to (possibly) remove the
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    int i;
    int i, res = 0;
    Class *subclsPtr;

    FOREACH(subclsPtr, superPtr->subclasses) {
	if (subPtr == subclsPtr) {
	    goto removeSubclass;
	    RemoveItem(Class, superPtr->subclasses, i);
	    TclOODecrRefCount(subPtr->thisPtr);
	    res++;
	}
    }
    return;
    return res;

  removeSubclass:
    if (!Deleted(superPtr->thisPtr)) {
	superPtr->subclasses.num--;
	if (i < superPtr->subclasses.num) {
	    superPtr->subclasses.list[i] =
		    superPtr->subclasses.list[superPtr->subclasses.num];
	}
	superPtr->subclasses.list[superPtr->subclasses.num] = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAddToSubclasses --
 *
1471
1472
1473
1474
1475
1476
1477
1478

1479
1480
1481
1482
1483
1484

1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498

1499
1500
1501

1502
1503
1504

1505
1506
1507
1508
1509




1510
1511
1512

1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1442
1443
1444
1445
1446
1447
1448

1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469

1470
1471
1472

1473
1474
1475

1476
1477
1478
1479
1480

1481
1482
1483
1484
1485
1486

1487










1488
1489
1490
1491
1492
1493
1494







-
+






+













-
+


-
+


-
+




-
+
+
+
+


-
+
-
-
-
-
-
-
-
-
-
-







{
    if (Deleted(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->subclasses.num >= superPtr->subclasses.size) {
	superPtr->subclasses.size += ALLOC_CHUNK;
	if (superPtr->subclasses.size == ALLOC_CHUNK) {
	    superPtr->subclasses.list = ckalloc(sizeof(Class*) * ALLOC_CHUNK);
	    superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
		    sizeof(Class *) * superPtr->subclasses.size);
	}
    }
    superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromMixinSubs --
 *
 *	Utility function to remove a class from the list of mixinSubs within
 *	another class.
 *
 * ----------------------------------------------------------------------
 */

void
int
TclOORemoveFromMixinSubs(
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to (possibly) remove the
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    int i;
    int i, res = 0;
    Class *subclsPtr;

    FOREACH(subclsPtr, superPtr->mixinSubs) {
	if (subPtr == subclsPtr) {
	    goto removeSubclass;
	    RemoveItem(Class, superPtr->mixinSubs, i);
	    TclOODecrRefCount(subPtr->thisPtr);
	    res++;
	    break;
	}
    }
    return;
    return res;

  removeSubclass:
    if (!Deleted(superPtr->thisPtr)) {
	superPtr->mixinSubs.num--;
	if (i < superPtr->mixinSubs.num) {
	    superPtr->mixinSubs.list[i] =
		    superPtr->mixinSubs.list[superPtr->mixinSubs.num];
	}
	superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAddToMixinSubs --
 *
1549
1550
1551
1552
1553
1554
1555

1556
1557
1558
1559
1560
1561

1562
1563
1564


1565
1566
1567
1568
1569
1570
1571
1572




1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605















1606
1607
1608

1609
1610
1611

1612
1613
1614
1615
1616
1617
1618
1619
1620

1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666

1667
1668
1669
1670
1671
1672
1673
1674

1675
1676
1677

1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711


1712
1713
1714
1715
1716

1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727

1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744


1745
1746
1747
1748
1749



1750

1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526

1527
1528


1529
1530
1531
1532
1533
1534




1535
1536
1537
1538



1539
1540
















1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551

1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567


1568
1569
1570

1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593

1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606

1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622

1623

1624




1625



1626



1627
1628
1629
1630
1631






























1632
1633
1634
1635
1636
1637

1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648

1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659







1660
1661





1662
1663
1664

1665
1666













1667
1668

1669
1670
1671
1672
1673
1674
1675







+





-
+

-
-
+
+




-
-
-
-
+
+
+
+
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+


-
+









+












-













-
















-

-
+
-
-
-
-

-
-
-
+
-
-
-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+




-
+










-
+










-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
+
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-


-







	    superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list,
		    sizeof(Class *) * superPtr->mixinSubs.size);
	}
    }
    superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocClass --
 * TclOOAllocClass --
 *
 *	Allocate a basic class. Does not splice the class object into its
 *	class's instance list.
 *	Allocate a basic class. Does not add class to its class's instance
 *	list.
 *
 * ----------------------------------------------------------------------
 */

static Class *
AllocClass(
    Tcl_Interp *interp,		/* Interpreter within which to allocate the
				 * class. */
static inline void
InitClassPath(
    Tcl_Interp *interp,
    Class *clsPtr)
    Object *useThisObj)		/* Object that is to act as the class
				 * representation, or NULL if a new object
				 * (with automatic name) is to be used. */
{
    Foundation *fPtr = GetFoundation(interp);
    Class *clsPtr = ckalloc(sizeof(Class));

    /*
     * Make an object if we haven't been given one.
     */

    memset(clsPtr, 0, sizeof(Class));
    if (useThisObj == NULL) {
	clsPtr->thisPtr = AllocObject(interp, NULL, NULL);
    } else {
	clsPtr->thisPtr = useThisObj;
    }

    /*
     * Configure the namespace path for the class's object.
     */

    if (fPtr->helpersNs != NULL) {
	Tcl_Namespace *path[2];

	path[0] = fPtr->helpersNs;
	path[1] = fPtr->ooNs;
	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
    } else {
	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1,
		&fPtr->ooNs);
    }

}

Class *
TclOOAllocClass(
    Tcl_Interp *interp,		/* Interpreter within which to allocate the
				 * class. */
    Object *useThisObj)		/* Object that is to act as the class
				 * representation. */
{
    Foundation *fPtr = GetFoundation(interp);
    Class *clsPtr = ckalloc(sizeof(Class));

    memset(clsPtr, 0, sizeof(Class));
    clsPtr->thisPtr = useThisObj;

    /*
     * Class objects inherit from the class of classes unless they inherit
     * from some subclass of it. Enforce this right now.
     * Configure the namespace path for the class's object.
     */

    clsPtr->thisPtr->selfCls = fPtr->classCls;
    InitClassPath(interp, clsPtr);

    /*
     * Classes are subclasses of oo::object, i.e. the objects they create are
     * objects.
     */

    clsPtr->superclasses.num = 1;
    clsPtr->superclasses.list = ckalloc(sizeof(Class *));
    clsPtr->superclasses.list[0] = fPtr->objectCls;
    AddRef(fPtr->objectCls->thisPtr);

    /*
     * Finish connecting the class structure to the object structure.
     */

    clsPtr->thisPtr->classPtr = clsPtr;

    /*
     * That's the complicated bit. Now fill in the rest of the non-zero/NULL
     * fields.
     */

    clsPtr->refCount = 1;
    Tcl_InitObjHashTable(&clsPtr->classMethods);
    return clsPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_NewObjectInstance --
 *
 *	Allocate a new instance of an object.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Object
Tcl_NewObjectInstance(
    Tcl_Interp *interp,		/* Interpreter context. */
    Tcl_Class cls,		/* Class to create an instance of. */
    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. */
    int objc,			/* Number of arguments. Negative value means
				 * do not call constructor. */
    Tcl_Obj *const *objv,	/* Argument list. */
    int skip)			/* Number of arguments to _not_ pass to the
				 * constructor. */
{
    register Class *classPtr = (Class *) cls;
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;

    ClientData clientData[4];
    /*
     * Check if we're going to create an object over an existing command;
     * that's not allowed.
     */

    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
	    TCL_NAMESPACE_ONLY)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
		"can't create object \"%s\": command already exists with"
		" that name", nameStr));
	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
    if (oPtr == NULL) {
	return NULL;
    }

    /*
     * Create the object.
     */

    oPtr = AllocObject(interp, nameStr, nsNameStr);
    oPtr->selfCls = classPtr;
    TclOOAddToInstances(oPtr, classPtr);

    /*
     * Check to see if we're really creating a class. If so, allocate the
     * class structure as well.
     */

    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
	/*
	 * Is a class, so attach a class structure. Note that the AllocClass
	 * function splices the structure into the object, so we don't have
	 * to. Once that's done, we need to repatch the object to have the
	 * right class since AllocClass interferes with that.
	 */

	AllocClass(interp, oPtr);
	oPtr->selfCls = classPtr;
	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
    } else {
	oPtr->classPtr = NULL;
    }

    /*
     * Run constructors, except when objc < 0 (a special flag case used for
     * object cloning only).
     * Run constructors, except when objc < 0, which is a special flag case
     * used for object cloning only.
     */

    if (objc >= 0) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
		TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);

	if (contextPtr != NULL) {
	    int isRoot, result;
	    Tcl_InterpState state;

	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    contextPtr->callPtr->flags |= CONSTRUCTOR;
	    contextPtr->skip = skip;

	    /*
	     * Adjust the ensmble tracking record if necessary. [Bug 3514761]
	     * Adjust the ensemble tracking record if necessary. [Bug 3514761]
	     */

	    isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv);
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
		    objc, objv);

	    if (isRoot) {
		TclResetRewriteEnsemble(interp, 1);
	    }

	    /*
	     * It's an error if the object was whacked in the constructor.
	     * Force this if it isn't already an error (don't want to lose
	     * errors by accident...) [Bug 2903011]
	     */

	    if (result != TCL_ERROR && Deleted(oPtr)) {
	    clientData[0] = contextPtr;
	    clientData[1] = oPtr;
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"object deleted in constructor", -1));
		Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
		result = TCL_ERROR;
	    }
	    clientData[2] = state;
	    clientData[3] = &oPtr;

	    TclOODeleteContext(contextPtr);
	    result = FinalizeAlloc(clientData, interp, result);
	    if (result != TCL_OK) {
		Tcl_DiscardInterpState(state);

		/*
		 * Take care to not delete a deleted object; that would be
		 * bad. [Bug 2903011] Also take care to make sure that we have
		 * the name of the command before we delete it. [Bug
		 * 9dd1bd7a74]
		 */

		if (!Deleted(oPtr)) {
		    (void) TclOOObjectName(interp, oPtr);
		    Tcl_DeleteCommandFromToken(interp, oPtr->command);
		}
		return NULL;
	    }
	    Tcl_RestoreInterpState(interp, state);
	}
    }

    return (Tcl_Object) oPtr;
}

int
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801

1802
1803

1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846

1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857

1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873









































































1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888


1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912






1913
1914
1915
1916
1917






1918
1919
1920
1921
1922
1923
1924
1686
1687
1688
1689
1690
1691
1692

1693
1694
1695
1696





1697


1698




1699
1700
1701


























1702
1703
1704
1705
1706
1707
1708
1709
1710

1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721

1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732

1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823


1824
1825

1826
1827
1828
1829
1830
1831
1832
1833

1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846

1847
1848
1849
1850
1851
1852
1853
1854
1855
1856

1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869







-




-
-
-
-
-
+
-
-
+
-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
+










-
+










-





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+













-
-
+
+
-








-













-
+
+
+
+
+
+




-
+
+
+
+
+
+







    Tcl_Obj *const *objv,	/* Argument list. */
    int skip,			/* Number of arguments to _not_ pass to the
				 * constructor. */
    Tcl_Object *objectPtr)	/* Place to write the object reference upon
				 * successful allocation. */
{
    register Class *classPtr = (Class *) cls;
    Foundation *fPtr = GetFoundation(interp);
    CallContext *contextPtr;
    Tcl_InterpState state;
    Object *oPtr;

    /*
     * Check if we're going to create an object over an existing command;
     * that's not allowed.
     */

    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
	    TCL_NAMESPACE_ONLY)) {
    if (oPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create object \"%s\": command already exists with"
		" that name", nameStr));
	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
	return TCL_ERROR;
    }

    /*
     * Create the object.
     */

    oPtr = AllocObject(interp, nameStr, nsNameStr);
    oPtr->selfCls = classPtr;
    TclOOAddToInstances(oPtr, classPtr);

    /*
     * Check to see if we're really creating a class. If so, allocate the
     * class structure as well.
     */

    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
	/*
	 * Is a class, so attach a class structure. Note that the AllocClass
	 * function splices the structure into the object, so we don't have
	 * to. Once that's done, we need to repatch the object to have the
	 * right class since AllocClass interferes with that.
	 */

	AllocClass(interp, oPtr);
	oPtr->selfCls = classPtr;
	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
    }

    /*
     * Run constructors, except when objc < 0 (a special flag case used for
     * object cloning only). If there aren't any constructors, we do nothing.
     */

    if (objc < 0) {
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }
    contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
    contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
    if (contextPtr == NULL) {
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }

    state = Tcl_SaveInterpState(interp, TCL_OK);
    contextPtr->callPtr->flags |= CONSTRUCTOR;
    contextPtr->skip = skip;

    /*
     * Adjust the ensmble tracking record if necessary. [Bug 3514761]
     * Adjust the ensemble tracking record if necessary. [Bug 3514761]
     */

    if (TclInitRewriteEnsemble(interp, skip, skip, objv)) {
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
    }

    /*
     * Fire off the constructors non-recursively.
     */

    AddRef(oPtr);
    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
	    objectPtr);
    TclPushTailcallPoint(interp);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}


Object *
TclNewObjectInstanceCommon(
    Tcl_Interp *interp,
    Class *classPtr,
    const char *nameStr,
    const char *nsNameStr)
{
    Tcl_HashEntry *hPtr;
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;
    const char *simpleName = NULL;
    Namespace *nsPtr = NULL, *dummy;
    Namespace *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    int isNew;

    if (nameStr) {
	TclGetNamespaceForQualName(interp, nameStr, inNsPtr,
		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName);

	/*
	 * Disallow creation of an object over an existing command.
	 */

	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, simpleName, &isNew);
	if (!isNew) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't create object \"%s\": command already exists with"
		    " that name", nameStr));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
	    return NULL;
	}

	/*
	 * We could make a hash entry! Don't actually want to do that here so
	 * nuke it immediately because we'll create it properly soon.
	 */

	Tcl_DeleteHashEntry(hPtr);
    }

    /*
     * Create the object.
     */

    oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
    oPtr->selfCls = classPtr;
    AddRef(classPtr->thisPtr);
    TclOOAddToInstances(oPtr, classPtr);

    /*
     * Check to see if we're really creating a class. If so, allocate the
     * class structure as well.
     */

    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
	/*
	 * Is a class, so attach a class structure. Note that the
	 * TclOOAllocClass function splices the structure into the object, so
	 * we don't have to. Once that's done, we need to repatch the object
	 * to have the right class since TclOOAllocClass interferes with that.
	 */

	TclOOAllocClass(interp, oPtr);
	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
    } else {
	oPtr->classPtr = NULL;
    }
    return oPtr;
}



static int
FinalizeAlloc(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];
    Object *oPtr = data[1];
    Tcl_InterpState state = data[2];
    Tcl_Object *objectPtr = data[3];

    /*
     * It's an error if the object was whacked in the constructor. Force this
     * if it isn't already an error (don't want to lose errors by accident...)
     * Ensure an error if the object was deleted in the constructor. Don't
     * want to lose errors by accident. [Bug 2903011]
     * [Bug 2903011]
     */

    if (result != TCL_ERROR && Deleted(oPtr)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object deleted in constructor", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
	result = TCL_ERROR;
    }
    TclOODeleteContext(contextPtr);
    if (result != TCL_OK) {
	Tcl_DiscardInterpState(state);

	/*
	 * Take care to not delete a deleted object; that would be bad. [Bug
	 * 2903011] Also take care to make sure that we have the name of the
	 * command before we delete it. [Bug 9dd1bd7a74]
	 */

	if (!Deleted(oPtr)) {
	    (void) TclOOObjectName(interp, oPtr);
	    Tcl_DeleteCommandFromToken(interp, oPtr->command);
	}
	DelRef(oPtr);

	/*
	 * This decrements the refcount of oPtr.
	 */

	TclOODeleteContext(contextPtr);
	return TCL_ERROR;
    }
    Tcl_RestoreInterpState(interp, state);
    *objectPtr = (Tcl_Object) oPtr;
    DelRef(oPtr);

    /*
     * This decrements the refcount of oPtr.
     */

    TclOODeleteContext(contextPtr);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_CopyObjectInstance --
1939
1940
1941
1942
1943
1944
1945

1946
1947
1948
1949
1950
1951
1952
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898







+







{
    Object *oPtr = (Object *) sourceObject, *o2Ptr;
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Class *mixinPtr;
    CallContext *contextPtr;
    Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
    PrivateVariableMapping *privateVariable;
    int i, result;

    /*
     * Sanity check.
     */

    if (IsRootClass(oPtr)) {
1980
1981
1982
1983
1984
1985
1986

1987
1988
1989
1990







1991
1992
1993
1994
1995
1996


1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009

2010
2011
2012
2013
2014
2015







2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
1926
1927
1928
1929
1930
1931
1932
1933




1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960

1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984

1985
1986
1987
1988
1989
1990
1991







+
-
-
-
-
+
+
+
+
+
+
+






+
+












-
+






+
+
+
+
+
+
+










-







	}
    }

    /*
     * Copy the object's mixin references to the new object.
     */

    if (o2Ptr->mixins.num != 0) {
    FOREACH(mixinPtr, o2Ptr->mixins) {
	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
	    TclOORemoveFromInstances(o2Ptr, mixinPtr);
	}
	FOREACH(mixinPtr, o2Ptr->mixins) {
	    if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
		TclOORemoveFromInstances(o2Ptr, mixinPtr);
	    }
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
	ckfree(o2Ptr->mixins.list);
    }
    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
    FOREACH(mixinPtr, o2Ptr->mixins) {
	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
	    TclOOAddToInstances(o2Ptr, mixinPtr);
	}
	/* For the reference just created in DUPLICATE */
	AddRef(mixinPtr->thisPtr);
    }

    /*
     * Copy the object's filter list to the new object.
     */

    DUPLICATE(o2Ptr->filters, oPtr->filters, Tcl_Obj *);
    FOREACH(filterObj, o2Ptr->filters) {
	Tcl_IncrRefCount(filterObj);
    }

    /*
     * Copy the object's variable resolution list to the new object.
     * Copy the object's variable resolution lists to the new object.
     */

    DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
    FOREACH(variableObj, o2Ptr->variables) {
	Tcl_IncrRefCount(variableObj);
    }

    DUPLICATE(o2Ptr->privateVariables, oPtr->privateVariables,
	    PrivateVariableMapping);
    FOREACH_STRUCT(privateVariable, o2Ptr->privateVariables) {
	Tcl_IncrRefCount(privateVariable->variableObj);
	Tcl_IncrRefCount(privateVariable->fullNameObj);
    }

    /*
     * Copy the object's flags to the new object, clearing those that must be
     * kept object-local. The duplicate is never deleted at this point, nor is
     * it the root of the object system or in the midst of processing a filter
     * call.
     */

    o2Ptr->flags = oPtr->flags & ~(
	    OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);

    /*
     * Copy the object's metadata.
     */

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value, duplicate;
2068
2069
2070
2071
2072
2073
2074

2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087





2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100

2101
2102
2103
2104
2105
2106







2107
2108
2109
2110
2111
2112

2113
2114
2115




2116
2117
2118
2119
2120
2121


2122
2123
2124
2125
2126
2127
2128
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063

2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084



2085
2086
2087
2088

2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102







+













+
+
+
+
+












-
+






+
+
+
+
+
+
+






+
-
-
-
+
+
+
+
-





+
+







	/*
	 * Ensure that the new class's superclass structure is the same as the
	 * old class's.
	 */

	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOORemoveFromSubclasses(cls2Ptr, superPtr);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	if (cls2Ptr->superclasses.num) {
	    cls2Ptr->superclasses.list = ckrealloc(cls2Ptr->superclasses.list,
		    sizeof(Class *) * clsPtr->superclasses.num);
	} else {
	    cls2Ptr->superclasses.list =
		    ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
	}
	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
		sizeof(Class *) * clsPtr->superclasses.num);
	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOOAddToSubclasses(cls2Ptr, superPtr);

	    /* For the new item in cls2Ptr->superclasses that memcpy just
	     * created
	     */
	    AddRef(superPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's filters.
	 */

	DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);
	FOREACH(filterObj, cls2Ptr->filters) {
	    Tcl_IncrRefCount(filterObj);
	}

	/*
	 * Copy the source class's variable resolution list.
	 * Copy the source class's variable resolution lists.
	 */

	DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
	FOREACH(variableObj, cls2Ptr->variables) {
	    Tcl_IncrRefCount(variableObj);
	}

	DUPLICATE(cls2Ptr->privateVariables, clsPtr->privateVariables,
		PrivateVariableMapping);
	FOREACH_STRUCT(privateVariable, cls2Ptr->privateVariables) {
	    Tcl_IncrRefCount(privateVariable->variableObj);
	    Tcl_IncrRefCount(privateVariable->fullNameObj);
	}

	/*
	 * Duplicate the source class's mixins (which cannot be circular
	 * references to the duplicate).
	 */

	if (cls2Ptr->mixins.num != 0) {
	FOREACH(mixinPtr, cls2Ptr->mixins) {
	    TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
	}
	    FOREACH(mixinPtr, cls2Ptr->mixins) {
		TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	if (cls2Ptr->mixins.num != 0) {
	    ckfree(clsPtr->mixins.list);
	}
	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
	FOREACH(mixinPtr, cls2Ptr->mixins) {
	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);
	    /* For the copy just created in DUPLICATE */
	    AddRef(mixinPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's methods, constructor and destructor.
	 */

	FOREACH_HASH(keyPtr, mPtr, &clsPtr->classMethods) {
2170
2171
2172
2173
2174
2175
2176
2177


2178
2179
2180
2181
2182
2183
2184
2144
2145
2146
2147
2148
2149
2150

2151
2152
2153
2154
2155
2156
2157
2158
2159







-
+
+







			    duplicate);
		}
	    }
	}
    }

    TclResetRewriteEnsemble(interp, 1);
    contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL);
    contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL,
	    NULL, NULL);
    if (contextPtr) {
	args[0] = TclOOObjectName(interp, o2Ptr);
	args[1] = oPtr->fPtr->clonedName;
	args[2] = TclOOObjectName(interp, oPtr);
	Tcl_IncrRefCount(args[0]);
	Tcl_IncrRefCount(args[1]);
	Tcl_IncrRefCount(args[2]);
2458
2459
2460
2461
2462
2463
2464
2465

2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476


2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497


2498
2499
2500
2501
2502
2503
2504
2433
2434
2435
2436
2437
2438
2439

2440
2441
2442
2443
2444
2445
2446
2447
2448
2449


2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470


2471
2472
2473
2474
2475
2476
2477
2478
2479







-
+









-
-
+
+



















-
-
+
+







    }
    Tcl_SetHashValue(hPtr, metadata);
}

/*
 * ----------------------------------------------------------------------
 *
 * PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject --
 * TclOOPublicObjectCmd, TclOOPrivateObjectCmd, TclOOInvokeObject --
 *
 *	Main entry point for object invocations. The Public* and Private*
 *	wrapper functions (implementations of both object instance commands
 *	and [my]) are just thin wrappers round the main TclOOObjectCmdCore
 *	function. Note that the core is function is NRE-aware.
 *
 * ----------------------------------------------------------------------
 */

static int
PublicObjectCmd(
int
TclOOPublicObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv);
}

static int
PublicNRObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD,
	    NULL);
}

static int
PrivateObjectCmd(
int
TclOOPrivateObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
}
2543
2544
2545
2546
2547
2548
2549





































2550
2551
2552
2553
2554
2555
2556
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		(Class *) startCls);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOMyClassObjCmd, MyClassNRObjCmd --
 *
 *	Special trap door to allow an object to delegate simply to its class.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOMyClassObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, MyClassNRObjCmd, clientData, objc, objv);
}

static int
MyClassNRObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = clientData;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?");
	return TCL_ERROR;
    }
    return TclOOObjectCmdCore(oPtr->selfCls->thisPtr, interp, objc, objv, 0,
	    NULL);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjectCmdCore, FinalizeObjectCall --
 *
 *	Main function for object invocations. Does call chain creation,
 *	management and invocation. The function FinalizeObjectCall exists to
 *	clean up after the non-recursive processing of TclOOObjectCmdCore.
 *
 * ----------------------------------------------------------------------
2567
2568
2569
2570
2571
2572
2573



2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585


















2586
2587
2588
2589
2590
2591
2592
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625







+
+
+












+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    Class *startCls)		/* Where to start in the call chain, or NULL
				 * if we are to start at the front with
				 * filters and the object's methods (which is
				 * the normal case). */
{
    CallContext *contextPtr;
    Tcl_Obj *methodNamePtr;
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Object *callerObjPtr = NULL;
    Class *callerClsPtr = NULL;
    int result;

    /*
     * If we've no method name, throw this directly into the unknown
     * processing.
     */

    if (objc < 2) {
	flags |= FORCE_UNKNOWN;
	methodNamePtr = NULL;
	goto noMapping;
    }

    /*
     * Determine if we're in a context that can see the extra, private methods
     * in this class.
     */

    if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	CallContext *callerContextPtr = framePtr->clientData;
	Method *callerMethodPtr =
		callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr;

	if (callerMethodPtr->declaringObjectPtr) {
	    callerObjPtr = callerMethodPtr->declaringObjectPtr;
	}
	if (callerMethodPtr->declaringClassPtr) {
	    callerClsPtr = callerMethodPtr->declaringClassPtr;
	}
    }

    /*
     * Give plugged in code a chance to remap the method name.
     */

    methodNamePtr = objv[1];
    if (oPtr->mapMethodNameProc != NULL) {
2607
2608
2609
2610
2611
2612
2613
2614


2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631


2632
2633
2634
2635
2636
2637
2638
2640
2641
2642
2643
2644
2645
2646

2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664

2665
2666
2667
2668
2669
2670
2671
2672
2673







-
+
+
















-
+
+








	/*
	 * Get the call chain for the remapped name.
	 */

	Tcl_IncrRefCount(mappedMethodName);
	contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
		flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
		flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
		callerClsPtr, methodNamePtr);
	TclDecrRefCount(mappedMethodName);
	if (contextPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "impossible to invoke method \"%s\": no defined method or"
		    " unknown method", TclGetString(methodNamePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED",
		    TclGetString(methodNamePtr), NULL);
	    return TCL_ERROR;
	}
    } else {
	/*
	 * Get the call chain.
	 */

    noMapping:
	contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
		flags | (oPtr->flags & FILTER_HANDLING), NULL);
		flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
		callerClsPtr, NULL);
	if (contextPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "impossible to invoke method \"%s\": no defined method or"
		    " unknown method", TclGetString(methodNamePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(methodNamePtr), NULL);
	    return TCL_ERROR;
2874
2875
2876
2877
2878
2879
2880
2881

2882
2883

2884
2885
2886
2887
2888
2889
2890
2909
2910
2911
2912
2913
2914
2915

2916
2917

2918
2919
2920
2921
2922
2923
2924
2925







-
+

-
+







				 * exactly the name of its public command. */
{
    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);

    if (cmdPtr == NULL) {
	goto notAnObject;
    }
    if (cmdPtr->objProc != PublicObjectCmd) {
    if (cmdPtr->objProc != TclOOPublicObjectCmd) {
	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
	if (cmdPtr == NULL || cmdPtr->objProc != PublicObjectCmd) {
	if (cmdPtr == NULL || cmdPtr->objProc != TclOOPublicObjectCmd) {
	    goto notAnObject;
	}
    }
    return cmdPtr->objClientData;

  notAnObject:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
3031
3032
3033
3034
3035
3036
3037
3038

3039
3040
3041
3042
3043
3044
3045
3066
3067
3068
3069
3070
3071
3072

3073
3074
3075
3076
3077
3078
3079
3080







-
+







    return (Tcl_Class) ((Object *)object)->classPtr;
}

int
Tcl_ObjectDeleted(
    Tcl_Object object)
{
    return Deleted(object) ? 1 : 0;
    return ((Object *)object)->command == NULL;
}

Tcl_Object
Tcl_GetClassAsObject(
    Tcl_Class clazz)
{
    return (Tcl_Object) ((Class *)clazz)->thisPtr;

Changes to generic/tclOO.decls.

54
55
56
57
58
59
60
61

62
63
64
65
66

67
68
69
70
71
72
73
54
55
56
57
58
59
60

61
62
63
64
65

66
67
68
69
70
71
72
73







-
+




-
+







	    ClientData *clientDataPtr)
}
declare 10 {
    Tcl_Obj *Tcl_MethodName(Tcl_Method method)
}
declare 11 {
    Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    ClientData clientData)
}
declare 12 {
    Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
	    Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    ClientData clientData)
}
declare 13 {
    Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls,
	    const char *nameStr, const char *nsNameStr, int objc,
	    Tcl_Obj *const *objv, int skip)
}
122
123
124
125
126
127
128



129
130
131
132
133
134
135
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138







+
+
+







declare 27 {
    void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz,
	    Tcl_Method method)
}
declare 28 {
    Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
}
declare 29 {
    int Tcl_MethodIsPrivate(Tcl_Method method)
}

######################################################################
# Private API, exposed to support advanced OO systems that plug in on top of
# TclOO; not intended for general use and does not have any commitment to
# long-term support.
#

Changes to generic/tclOO.h.

95
96
97
98
99
100
101









102
103
104
105
106
107
108
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117







+
+
+
+
+
+
+
+
+







/*
 * The correct value for the version field of the Tcl_MethodType structure.
 * This allows new versions of the structure to be introduced without breaking
 * binary compatability.
 */

#define TCL_OO_METHOD_VERSION_CURRENT 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

/*
 * 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).
 */

Changes to generic/tclOOBasic.c.

79
80
81
82
83
84
85
86

87
88
89
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
128
129
130



131
132
133
134








135


136



137
138
139
140
141
142
143
79
80
81
82
83
84
85

86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169







-
+









+
+
+
+
+
+
+
+
+
+
+


















-
+
















+
+
+




+
+
+
+
+
+
+
+

+
+
-
+
+
+







    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    Tcl_Obj **invoke;
    Tcl_Obj **invoke, *nameObj;

    if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?definitionScript?");
	return TCL_ERROR;
    } else if (objc == Tcl_ObjectContextSkippedArgs(context)) {
	return TCL_OK;
    }

    /*
     * 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);
    Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls,
	    TclGetString(nameObj), NULL, -1, NULL, -1);
    Tcl_DecrRefCount(nameObj);

    /*
     * Delegate to [oo::define] to do the work.
     */

    invoke = ckalloc(3 * sizeof(Tcl_Obj *));
    invoke[0] = oPtr->fPtr->defineName;
    invoke[1] = TclOOObjectName(interp, oPtr);
    invoke[2] = objv[objc-1];

    /*
     * Must add references or errors in configuration script will cause
     * trouble.
     */

    Tcl_IncrRefCount(invoke[0]);
    Tcl_IncrRefCount(invoke[1]);
    Tcl_IncrRefCount(invoke[2]);
    TclNRAddCallback(interp, DecrRefsPostClassConstructor,
	    invoke, NULL, NULL, NULL);
	    invoke, oPtr, NULL, NULL);

    /*
     * Tricky point: do not want the extra reported level in the Tcl stack
     * trace, so use TCL_EVAL_NOERR.
     */

    return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
}

static int
DecrRefsPostClassConstructor(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **invoke = data[0];
    Object *oPtr = data[1];
    Tcl_InterpState saved;
    int code;

    TclDecrRefCount(invoke[0]);
    TclDecrRefCount(invoke[1]);
    TclDecrRefCount(invoke[2]);
    invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", -1);
    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);
    TclDecrRefCount(invoke[0]);
    TclDecrRefCount(invoke[1]);
    ckfree(invoke);
    if (code != TCL_OK) {
	Tcl_DiscardInterpState(saved);
    return result;
	return code;
    }
    return Tcl_RestoreInterpState(interp, saved);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Class_Create --
 *
343
344
345
346
347
348
349
350


351
352
353
354
355
356
357
369
370
371
372
373
374
375

376
377
378
379
380
381
382
383
384







-
+
+







    if (objc != Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
	oPtr->flags |= DESTRUCTOR_CALLED;
	contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
	contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL,
		NULL);
	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    TclNRAddCallback(interp, AfterNRDestructor, contextPtr,
		    NULL, NULL, NULL);
	    TclPushTailcallPoint(interp);
	    return TclOOInvokeContext(contextPtr, interp, 0, NULL);
495
496
497
498
499
500
501


502
503
504

505
506
507
508
509
510
511
512
513
514
515
516





















517
518
519
520
521
522

523
524
525
526
527
528
529
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572

573
574
575
576
577
578
579
580







+
+



+












+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+







    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Object *callerObj = NULL;
    Class *callerCls = NULL;
    Object *oPtr = contextPtr->oPtr;
    const char **methodNames;
    int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Tcl_Obj *errorMsg;

    /*
     * If no method name, generate an error asking for a method name. (Only by
     * overriding *this* method can an object handle the absence of a method
     * name without an error).
     */

    if (objc < skip+1) {
	Tcl_WrongNumArgs(interp, skip, objv, "method ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Determine if the calling context should know about extra private
     * methods, and if so, which.
     */

    if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	CallContext *callerContext = framePtr->clientData;
	Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;

	if (mPtr->declaringObjectPtr) {
	    if (oPtr == mPtr->declaringObjectPtr) {
		callerObj = mPtr->declaringObjectPtr;
	    }
	} else {
	    if (TclOOIsReachable(mPtr->declaringClassPtr, oPtr->selfCls)) {
		callerCls = mPtr->declaringClassPtr;
	    }
	}
    }

    /*
     * Get the list of methods that we want to know about.
     */

    numMethodNames = TclOOGetSortedMethodList(oPtr,
    numMethodNames = TclOOGetSortedMethodList(oPtr, callerObj, callerCls,
	    contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames);

    /*
     * Special message when there are no visible methods at all.
     */

    if (numMethodNames == 0) {
680
681
682
683
684
685
686

687
688
689
690
691
692
693
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745







+







				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Var *varPtr, *aryVar;
    Tcl_Obj *varNamePtr, *argPtr;
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    const char *arg;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"varName");
	return TCL_ERROR;
    }
704
705
706
707
708
709
710




















































711
712
713
714
715
716
717
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







     */

    if (arg[0] == ':' && arg[1] == ':') {
	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 = framePtr->clientData;
	    Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;
	    PrivateVariableMapping *pvPtr;
	    int i;

	    if (mPtr->declaringObjectPtr == oPtr) {
		FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
		    if (!strcmp(Tcl_GetString(pvPtr->variableObj),
			    Tcl_GetString(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(Tcl_GetString(pvPtr->variableObj),
				Tcl_GetString(argPtr))) {
			    argPtr = pvPtr->fullNameObj;
			    break;
			}
		    }
		}
	    }
	}

	varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
	Tcl_AppendToObj(varNamePtr, "::", 2);
	Tcl_AppendObjToObj(varNamePtr, argPtr);
    }
    Tcl_IncrRefCount(varNamePtr);
    varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747




748
749
750
751
752
753
754
755
756
757
758
829
830
831
832
833
834
835



836
837
838
839
840
841







842
843
844
845




846
847
848
849
850
851
852







-
-
-






-
-
-
-
-
-
-
+
+
+
+
-
-
-
-







    /*
     * Now that we've pinned down what variable we're really talking about
     * (including traversing variable links), convert back to a name.
     */

    varNamePtr = Tcl_NewObj();
    if (aryVar != NULL) {
	Tcl_HashEntry *hPtr;
	Tcl_HashSearch search;

	Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);

	/*
	 * WARNING! This code pokes inside the implementation of hash tables!
	 */

	hPtr = Tcl_FirstHashEntry((Tcl_HashTable *) aryVar->value.tablePtr,
		&search);
	while (hPtr != NULL) {
	    if (varPtr == Tcl_GetHashValue(hPtr)) {
		Tcl_AppendToObj(varNamePtr, "(", -1);
		Tcl_AppendObjToObj(varNamePtr, hPtr->key.objPtr);
		Tcl_AppendToObj(varNamePtr, ")", -1);
	Tcl_AppendToObj(varNamePtr, "(", -1);
	Tcl_AppendObjToObj(varNamePtr, ((VarInHash *)
		varPtr)->entry.key.objPtr);
	Tcl_AppendToObj(varNamePtr, ")", -1);
		break;
	    }
	    hPtr = Tcl_NextHashEntry(&search);
	}
    } else {
	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
    }
    Tcl_SetObjResult(interp, varNamePtr);
    return TCL_OK;
}

1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1296
1297
1298
1299
1300
1301
1302

1303
1304

1305
1306










1307
1308
1309
1310
1311
1312
1313







-


-


-
-
-
-
-
-
-
-
-
-







     * [oo::define] command.
     */

    if (objc == 2) {
	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL);
    } else {
	const char *name, *namespaceName;
	Tcl_DString buffer;

	name = TclGetString(objv[2]);
	Tcl_DStringInit(&buffer);
	if (name[0] == '\0') {
	    name = NULL;
	} else if (name[0]!=':' || name[1]!=':') {
	    Interp *iPtr = (Interp *) interp;

	    if (iPtr->varFramePtr != NULL) {
		Tcl_DStringAppend(&buffer,
			iPtr->varFramePtr->nsPtr->fullName, -1);
	    }
	    TclDStringAppendLiteral(&buffer, "::");
	    Tcl_DStringAppend(&buffer, name, -1);
	    name = Tcl_DStringValue(&buffer);
	}

	/*
	 * Choose a unique namespace name if the user didn't supply one.
	 */

	namespaceName = NULL;
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1321
1322
1323
1324
1325
1326
1327

1328
1329
1330
1331
1332
1333
1334







-







		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"%s refers to an existing namespace", namespaceName));
		return TCL_ERROR;
	    }
	}

	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName);
	Tcl_DStringFree(&buffer);
    }

    if (o2Ptr == NULL) {
	return TCL_ERROR;
    }

    /*

Changes to generic/tclOOCall.c.

41
42
43
44
45
46
47






















48
49
50
51
52
53
54
55
56
57
58
59
60
61







62








63
64
65
66
67

68
69
70
71
72
73
74
75
76
77
78
79


80
81
82
83
84
85
86
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+














+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+




-
+












+
+







#define BUILDING_MIXINS	   0x400000
#define TRAVERSED_MIXIN	   0x800000
#define OBJECT_MIXIN	   0x1000000
#define MIXIN_CONSISTENT(flags) \
    (((flags) & OBJECT_MIXIN) ||					\
	!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))

/*
 * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
 * Itcl's special type of private.
 */

#define IS_PUBLIC(mPtr)				\
    (((mPtr)->flags & PUBLIC_METHOD) != 0)
#define IS_UNEXPORTED(mPtr)			\
    (((mPtr)->flags & SCOPE_FLAGS) == 0)
#define IS_ITCLPRIVATE(mPtr)				\
    (((mPtr)->flags & PRIVATE_METHOD) != 0)
#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)
#define WANT_ITCLPRIVATE(flags)			\
    (((flags) & PRIVATE_METHOD) != 0)
#define WANT_PRIVATE(flags)			\
    (((flags) & TRUE_PRIVATE_METHOD) != 0)

/*
 * Function declarations for things defined in this file.
 */

static void		AddClassFiltersToCallContext(Object *const oPtr,
			    Class *clsPtr, struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags);
static void		AddClassMethodNames(Class *clsPtr, const int flags,
			    Tcl_HashTable *const namesPtr,
			    Tcl_HashTable *const examinedClassesPtr);
static inline void	AddMethodToCallChain(Method *const mPtr,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters,
			    Class *const filterDecl, int flags);
static inline int	AddInstancePrivateToCallContext(Object *const oPtr,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr, int flags);
static inline void	AddStandardMethodName(int flags, Tcl_Obj *namePtr,
			    Method *mPtr, Tcl_HashTable *namesPtr);
static inline void	AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr,
			    Tcl_HashTable *namesPtr);
static inline void	AddSimpleChainToCallContext(Object *const oPtr,
static inline int	AddSimpleChainToCallContext(Object *const oPtr,
			    Class *const contextCls,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static int		AddPrivatesFromClassChainToCallContext(Class *classPtr,
			    Class *const contextCls,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static void		AddSimpleClassChainToCallContext(Class *classPtr,
static int		AddSimpleClassChainToCallContext(Class *classPtr,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static int		CmpStr(const void *ptr1, const void *ptr2);
static void		DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
static Tcl_NRPostProc	FinalizeMethodRefs;
static void		FreeMethodNameRep(Tcl_Obj *objPtr);
static inline int	IsStillValid(CallChain *callPtr, Object *oPtr,
			    int flags, int reuseMask);
static Tcl_NRPostProc	ResetFilterFlags;
static Tcl_NRPostProc	SetFilterFlags;
static int		SortMethodNames(Tcl_HashTable *namesPtr, int flags,
			    const char ***stringsPtr);
static inline void	StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);

/*
 * Object type used to manage type caches attached to method names.
 */

static const Tcl_ObjType methodNameType = {
106
107
108
109
110
111
112





113

114
115
116
117
118
119
120
144
145
146
147
148
149
150
151
152
153
154
155

156
157
158
159
160
161
162
163







+
+
+
+
+
-
+







    CallContext *contextPtr)
{
    register Object *oPtr = contextPtr->oPtr;

    TclOODeleteChain(contextPtr->callPtr);
    if (oPtr != NULL) {
	TclStackFree(oPtr->fPtr->interp, contextPtr);

	/*
	 * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore
	 */

	DelRef(oPtr);
	TclOODecrRefCount(oPtr);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteChainCache --
357
358
359
360
361
362
363








364
365
366
367
368
369
370
371
372
373
374
375
376

377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397

398
399
400



401
402
403

404
405
406
407
408
409
410
411
412
413
414
415
416
417

418
419
420
421



422
423
424
425
426
427

428
429
430
431
432
433
434
435
436
437












438
439
440
441
442
443
444
445
446
447

448
449
450
451
452
453
454
455
456
457

458
459
460
461

462
463
464
465
466

467
468
469
470
471
472
473
474
475
476
477

478
479
480
481
482

483
484
485
486
487
488
489
490
491
492
493
494

495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512

513
514
515
516
517
518
519
520
521
522
523
524
525


















































526
527
528
529
530
531
532
533
534
535
536
537
538
539










540
541
542
543
544
545
546
547
548
549









550
551
552
553
554





555
556
557
558
559
560
561
562
563









564
565
566
567
568
569
570

571
572
573
574
575
576
577
578
579

580
581
582
583
584
585
586
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426

427
428
429
430


431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447



448
449
450
451
452

453






454
455
456
457
458
459
460

461
462



463
464
465






466










467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487

488
489
490
491


492




493




494





495
496










497





498










499

500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516


517


518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583









584
585
586
587
588
589
590
591
592
593
594









595
596
597
598
599
600
601
602
603
604




605
606
607
608
609
610








611
612
613
614
615
616
617
618
619



620
621
622

623
624
625
626
627
628
629
630
631

632
633
634
635
636
637
638
639







+
+
+
+
+
+
+
+












-
+



-
-
















+
-
-
-
+
+
+


-
+
-
-
-
-
-
-







-
+

-
-
-
+
+
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+









-
+



-
-

-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-

-
+
















-
-
+
-
-











+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-



-
+








-
+







 *
 * ----------------------------------------------------------------------
 */

int
TclOOGetSortedMethodList(
    Object *oPtr,		/* The object to get the method names for. */
    Object *contextObj,		/* From what context object we are inquiring.
				 * NULL when the context shouldn't see
				 * object-level private methods. Note that
				 * flags can override this. */
    Class *contextCls,		/* From what context class we are inquiring.
				 * NULL when the context shouldn't see
				 * class-level private methods. Note that
				 * flags can override this. */
    int flags,			/* Whether we just want the public method
				 * names. */
    const char ***stringsPtr)	/* Where to write a pointer to the array of
				 * strings to. */
{
    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
				 * mapping. */
    Tcl_HashTable examinedClasses;
				/* Used to track what classes have been looked
				 * at. Is set-like in nature and keyed by
				 * pointer to class. */
    FOREACH_HASH_DECLS;
    int i;
    int i, numStrings;
    Class *mixinPtr;
    Tcl_Obj *namePtr;
    Method *mPtr;
    int isWantedIn;
    void *isWanted;

    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) {
	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
	    if (IS_PRIVATE(mPtr)) {
	    int isNew;

	    if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) {
		continue;
	    }
	    if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) {
		continue;
	    }
	    hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
	    AddStandardMethodName(flags, namePtr, mPtr, &names);
	    if (isNew) {
		isWantedIn = ((!(flags & PUBLIC_METHOD)
			|| mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0);
		isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
		Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
	    }
	}
    }

    /*
     * Process method names due to private methods on the object's class.
     */

    if (flags & PRIVATE_METHOD) {
    if (WANT_UNEXPORTED(flags)) {
	FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
	    if (mPtr->flags & PRIVATE_METHOD) {
		int isNew;

	    if (IS_UNEXPORTED(mPtr)) {
		AddStandardMethodName(flags, namePtr, mPtr, &names);
	    }
		hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
		if (isNew) {
		    isWantedIn = IN_LIST;
		    if (mPtr->typePtr == NULL) {
			isWantedIn |= NO_IMPLEMENTATION;
		    }
	}
		    Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
		} else if (mPtr->typePtr != NULL) {
		    isWantedIn = PTR2INT(Tcl_GetHashValue(hPtr));
		    if (isWantedIn & NO_IMPLEMENTATION) {
			isWantedIn &= ~NO_IMPLEMENTATION;
			Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
		    }
		}
	    }
	}
    }

    /*
     * Process method names due to private methods on the context's object or
     * class. Which must be correct if either are not NULL.
     */

    if (contextObj && contextObj->methodsPtr) {
	AddPrivateMethodNames(contextObj->methodsPtr, &names);
    }
    if (contextCls) {
	AddPrivateMethodNames(&contextCls->classMethods, &names);
    }

    /*
     * Process (normal) method names from the class hierarchy and the mixin
     * hierarchy.
     */

    AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
    FOREACH(mixinPtr, oPtr->mixins) {
	AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names,
	AddClassMethodNames(mixinPtr, flags | TRAVERSED_MIXIN, &names,
		&examinedClasses);
    }

    Tcl_DeleteHashTable(&examinedClasses);

    /*
     * See how many (visible) method names there are. If none, we do not (and
     * should not) try to sort the list of them.
     */

     * Tidy up, sort the names and resolve finally whether we really want
    i = 0;
    if (names.numEntries != 0) {
	const char **strings;

     * them (processing export layering).
	/*
	 * We need to build the list of methods to sort. We will be using
	 * qsort() for this, because it is very unlikely that the list will be
	 * heavily sorted when it is long enough to matter.
	 */
     */

	strings = ckalloc(sizeof(char *) * names.numEntries);
	FOREACH_HASH(namePtr, isWanted, &names) {
	    if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
		if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
		    continue;
		}
		strings[i++] = TclGetString(namePtr);
	    }
	}

    Tcl_DeleteHashTable(&examinedClasses);
	/*
	 * Note that 'i' may well be less than names.numEntries when we are
	 * dealing with public method names.
	 */

    numStrings = SortMethodNames(&names, flags, stringsPtr);
	if (i > 0) {
	    if (i > 1) {
		qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
	    }
	    *stringsPtr = strings;
	} else {
	    ckfree(strings);
	}
    }

    Tcl_DeleteHashTable(&names);
    return i;
    return numStrings;
}

int
TclOOGetSortedClassMethodList(
    Class *clsPtr,		/* The class to get the method names for. */
    int flags,			/* Whether we just want the public method
				 * names. */
    const char ***stringsPtr)	/* Where to write a pointer to the array of
				 * strings to. */
{
    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
				 * mapping. */
    Tcl_HashTable examinedClasses;
				/* Used to track what classes have been looked
				 * at. Is set-like in nature and keyed by
				 * pointer to class. */
    FOREACH_HASH_DECLS;
    int i;
    int numStrings;
    Tcl_Obj *namePtr;
    void *isWanted;

    Tcl_InitObjHashTable(&names);
    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);

    /*
     * Process method names from the class hierarchy and the mixin hierarchy.
     */

    AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
    Tcl_DeleteHashTable(&examinedClasses);

    /*
     * Process private method names if we should. [TIP 500]
     */

    if (WANT_PRIVATE(flags)) {
	AddPrivateMethodNames(&clsPtr->classMethods, &names);
	flags &= ~TRUE_PRIVATE_METHOD;
    }

    /*
     * Tidy up, sort the names and resolve finally whether we really want
     * them (processing export layering).
     */

    numStrings = SortMethodNames(&names, flags, stringsPtr);
    Tcl_DeleteHashTable(&names);
    return numStrings;
}

/*
 * ----------------------------------------------------------------------
 *
 * SortMethodNames --
 *
 *	Shared helper for TclOOGetSortedMethodList etc. that knows the method
 *	sorting rules.
 *
 * Returns:
 *	The length of the sorted list.
 *
 * ----------------------------------------------------------------------
 */

static int
SortMethodNames(
    Tcl_HashTable *namesPtr,	/* The table of names; unsorted, but contains
				 * whether the names are wanted and under what
				 * circumstances. */
    int flags,			/* Whether we are looking for unexported
				 * methods. Full private methods are handled
				 * on insertion to the table. */
    const char ***stringsPtr)	/* Where to store the sorted list of strings
				 * that we produce. ckalloced() */
{
    const char **strings;
    FOREACH_HASH_DECLS;
    Tcl_Obj *namePtr;
    void *isWanted;
    int i = 0;

    /*
     * See how many (visible) method names there are. If none, we do not (and
     * should not) try to sort the list of them.
     */

    i = 0;
    if (names.numEntries != 0) {
	const char **strings;

	/*
	 * We need to build the list of methods to sort. We will be using
	 * qsort() for this, because it is very unlikely that the list will be
	 * heavily sorted when it is long enough to matter.
	 */
    if (namesPtr->numEntries == 0) {
	*stringsPtr = NULL;
	return 0;
    }

    /*
     * We need to build the list of methods to sort. We will be using qsort()
     * for this, because it is very unlikely that the list will be heavily
     * sorted when it is long enough to matter.
     */

	strings = ckalloc(sizeof(char *) * names.numEntries);
	FOREACH_HASH(namePtr, isWanted, &names) {
	    if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
		if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
		    continue;
		}
		strings[i++] = TclGetString(namePtr);
	    }
	}
    strings = ckalloc(sizeof(char *) * namesPtr->numEntries);
    FOREACH_HASH(namePtr, isWanted, namesPtr) {
	if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
	    if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
		continue;
	    }
	    strings[i++] = TclGetString(namePtr);
	}
    }

	/*
	 * Note that 'i' may well be less than names.numEntries when we are
	 * dealing with public method names.
	 */
    /*
     * Note that 'i' may well be less than names.numEntries when we are
     * dealing with public method names. We don't sort unless there's at least
     * two method names.
     */

	if (i > 0) {
	    if (i > 1) {
		qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
	    }
	    *stringsPtr = strings;
	} else {
	    ckfree(strings);
	}
    if (i > 0) {
	if (i > 1) {
	    qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
	}
	*stringsPtr = strings;
    } else {
	ckfree(strings);
	*stringsPtr = NULL;
    }
    }

    Tcl_DeleteHashTable(&names);
    return i;
}

/* Comparator for GetSortedMethodList */
/* Comparator for SortMethodNames */
static int
CmpStr(
    const void *ptr1,
    const void *ptr2)
{
    const char **strPtr1 = (const char **) ptr1;
    const char **strPtr2 = (const char **) ptr2;

    return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1)+1);
    return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1);
}

/*
 * ----------------------------------------------------------------------
 *
 * AddClassMethodNames --
 *
605
606
607
608
609
610
611


612
613
614
615
616
617
618
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673







+
+







				 * semantics are handled correctly. */
    Tcl_HashTable *const examinedClassesPtr)
				/* Hash table that tracks what classes have
				 * already been looked at. The keys are the
				 * pointers to the classes, and the values are
				 * immaterial. */
{
    int i;

    /*
     * If we've already started looking at this class, stop working on it now
     * to prevent repeated work.
     */

    if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) {
	return;
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657

658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687



































































































688
689
690
691
692
693

694
695
696
697
698

699
700



701
702
703
704
705
706
707
708
709
710
711
712
713
714



715
716
717

718
719
720
721
722
723
724




725
726
727
728
729
730







731
732
733
734
735
736
737
738

739
740
741
742









743
744
745
746





747
748
749






750
751




752
753
754
755
756
757
758
690
691
692
693
694
695
696

697
698
699
700
701
702
703
704
705
706





707









708
709
710
711
712
713
714
715
716

717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831

832
833
834
835
836

837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855

856
857
858
859
860

861

862
863




864
865
866
867






868
869
870
871
872
873
874
875
876
877
878

879
880
881
882




883
884
885
886
887
888
889
890
891
892
893


894
895
896
897
898
899
900
901
902
903
904
905
906
907


908
909
910
911
912
913
914
915
916
917
918







-










-
-
-
-
-
+
-
-
-
-
-
-
-
-
-









-











+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+




-
+


+
+
+













-
+
+
+


-
+
-


-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+




-



+
-
-
-
-
+
+
+
+
+
+
+
+
+


-
-
+
+
+
+
+



+
+
+
+
+
+
-
-
+
+
+
+







		&isNew);
	if (!isNew) {
	    break;
	}

	if (clsPtr->mixins.num != 0) {
	    Class *mixinPtr;
	    int i;

	    FOREACH(mixinPtr, clsPtr->mixins) {
		if (mixinPtr != clsPtr) {
		    AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN,
			    namesPtr, examinedClassesPtr);
		}
	    }
	}

	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
	    hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
	    if (isNew) {
		int isWanted = (!(flags & PUBLIC_METHOD)
			|| (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;

	    AddStandardMethodName(flags, namePtr, mPtr, namesPtr);
		isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
		Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
	    } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
		    && mPtr->typePtr != NULL) {
		int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));

		isWanted &= ~NO_IMPLEMENTATION;
		Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
	    }
	}

	if (clsPtr->superclasses.num != 1) {
	    break;
	}
	clsPtr = clsPtr->superclasses.list[0];
    }
    if (clsPtr->superclasses.num != 0) {
	Class *superPtr;
	int i;

	FOREACH(superPtr, clsPtr->superclasses) {
	    AddClassMethodNames(superPtr, flags, namesPtr,
		    examinedClassesPtr);
	}
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * AddPrivateMethodNames, AddStandardMethodName --
 *
 *	Factored-out helpers for the sorted name list production functions.
 *
 * ----------------------------------------------------------------------
 */

static inline void
AddPrivateMethodNames(
    Tcl_HashTable *methodsTablePtr,
    Tcl_HashTable *namesPtr)
{
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Tcl_Obj *namePtr;

    FOREACH_HASH(namePtr, mPtr, methodsTablePtr) {
	if (IS_PRIVATE(mPtr)) {
	    int isNew;

	    hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
	    Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST));
	}
    }
}

static inline void
AddStandardMethodName(
    int flags,
    Tcl_Obj *namePtr,
    Method *mPtr,
    Tcl_HashTable *namesPtr)
{
    if (!IS_PRIVATE(mPtr)) {
	int isNew;
	Tcl_HashEntry *hPtr =
		Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);

	if (isNew) {
	    int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
		    ? IN_LIST : 0;

	    isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
	    Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
	} else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
		&& mPtr->typePtr != NULL) {
	    int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));

	    isWanted &= ~NO_IMPLEMENTATION;
	    Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
	}
    }
}

#undef IN_LIST
#undef NO_IMPLEMENTATION

/*
 * ----------------------------------------------------------------------
 *
 * AddInstancePrivateToCallContext --
 *
 *	Add private methods from the instance. Called when the calling Tcl
 *	context is a TclOO method declared by an object that is the same as
 *	the current object. Returns true iff a private method was actually
 *	found and added to the call chain (as this suppresses caching).
 *
 * ----------------------------------------------------------------------
 */

static inline int
AddInstancePrivateToCallContext(
    Object *const oPtr,		/* Object to add call chain entries for. */
    Tcl_Obj *const methodName,	/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    int flags)			/* What sort of call chain are we building. */
{
    Tcl_HashEntry *hPtr;
    Method *mPtr;
    int donePrivate = 0;

    if (oPtr->methodsPtr) {
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName);
	if (hPtr != NULL) {
	    mPtr = Tcl_GetHashValue(hPtr);
	    if (IS_PRIVATE(mPtr)) {
		AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
		donePrivate = 1;
	    }
	}
    }
    return donePrivate;
}

/*
 * ----------------------------------------------------------------------
 *
 * AddSimpleChainToCallContext --
 *
 *	The core of the call-chain construction engine, this handles calling a
 *	particular method on a particular object. Note that filters and
 *	unknown handling are already handled by the logic that uses this
 *	function.
 *	function. Returns true if a private method was one of those found.
 *
 * ----------------------------------------------------------------------
 */

static inline void
static inline int
AddSimpleChainToCallContext(
    Object *const oPtr,		/* Object to add call chain entries for. */
    Class *const contextCls,	/* Context class; the currently considered
				 * class is equal to this, private methods may
				 * also be added. [TIP 500] */
    Tcl_Obj *const methodNameObj,
				/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    int i;
    int i, foundPrivate = 0, blockedUnexported = 0;
    Tcl_HashEntry *hPtr;
    Method *mPtr;

    if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr,
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj);
		(char *) methodNameObj);

	if (hPtr != NULL) {
	    Method *mPtr = Tcl_GetHashValue(hPtr);

	    if (flags & PUBLIC_METHOD) {
		if (!(mPtr->flags & PUBLIC_METHOD)) {
	    mPtr = Tcl_GetHashValue(hPtr);
	    if (!IS_PRIVATE(mPtr)) {
		if (WANT_PUBLIC(flags)) {
		    if (!IS_PUBLIC(mPtr)) {
		    return;
		} else {
		    flags |= DEFINITE_PUBLIC;
		}
	    } else {
		flags |= DEFINITE_PROTECTED;
			blockedUnexported = 1;
		    } else {
			flags |= DEFINITE_PUBLIC;
		    }
		} else {
		    flags |= DEFINITE_PROTECTED;
		}
	    }
	}
    }
    if (!(flags & SPECIAL)) {
	Tcl_HashEntry *hPtr;
	Class *mixinPtr;

	FOREACH(mixinPtr, oPtr->mixins) {
	    if (contextCls) {
	    AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
		    doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
	}
	if (oPtr->methodsPtr) {
		foundPrivate |= AddPrivatesFromClassChainToCallContext(
			mixinPtr, contextCls, methodNameObj, cbPtr,
			doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
	    }
	    foundPrivate |= AddSimpleClassChainToCallContext(mixinPtr,
		    methodNameObj, cbPtr, doneFilters,
		    flags | TRAVERSED_MIXIN, filterDecl);
	}
	if (oPtr->methodsPtr && !blockedUnexported) {
	    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
	    if (hPtr != NULL) {
		AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
			doneFilters, filterDecl, flags);
		mPtr = Tcl_GetHashValue(hPtr);
		if (!IS_PRIVATE(mPtr)) {
		    AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			    flags);
		}
	    }
	}
    }
    if (contextCls) {
	foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls,
		contextCls, methodNameObj, cbPtr, doneFilters, flags,
		filterDecl);
    }
    if (!blockedUnexported) {
    AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr,
	    doneFilters, flags, filterDecl);
	foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls,
		methodNameObj, cbPtr, doneFilters, flags, filterDecl);
    }
    return foundPrivate;
}

/*
 * ----------------------------------------------------------------------
 *
 * AddMethodToCallChain --
 *
807
808
809
810
811
812
813
814
815


816
817
818
819
820
821
822
967
968
969
970
971
972
973


974
975
976
977
978
979
980
981
982







-
-
+
+







     *  3) this is a class method, AND
     *  4) this method was not declared by the class of the current object.
     *
     * This does mean that only classes really handle private methods. This
     * should be sufficient for [incr Tcl] support though.
     */

    if (!(callPtr->flags & PRIVATE_METHOD)
	    && (mPtr->flags & PRIVATE_METHOD)
    if (!WANT_UNEXPORTED(callPtr->flags)
	    && IS_UNEXPORTED(mPtr)
	    && (mPtr->declaringClassPtr != NULL)
	    && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
	return;
    }

    /*
     * First test whether the method is already in the call chain. Skip over
849
850
851
852
853
854
855
856

857
858
859
860
861
862
863
1009
1010
1011
1012
1013
1014
1015

1016
1017
1018
1019
1020
1021
1022
1023







-
+







     * Need to really add the method. This is made a bit more complex by the
     * 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 =
		ckalloc(sizeof(struct MInvoke) * (callPtr->numChain+1));
		ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
	memcpy(callPtr->chain, callPtr->staticChain,
		sizeof(struct MInvoke) * callPtr->numChain);
    } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain = ckrealloc(callPtr->chain,
		sizeof(struct MInvoke) * (callPtr->numChain + 1));
    }
    callPtr->chain[i].mPtr = mPtr;
896
897
898
899
900
901
902

903
904
905
906
907
908
909
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070







+







    callPtr->chain = callPtr->staticChain;
}

/*
 * ----------------------------------------------------------------------
 *
 * IsStillValid --
 *
 *	Calculates whether the given call chain can be used for executing a
 *	method for the given object. The condition on a chain from a cached
 *	location being reusable is:
 *	- Refers to the same object (same creation epoch), and
 *	- Still across the same class structure (same global epoch), and
 *	- Still across the same object strucutre (same local epoch), and
 *	- No public/private/filter magic leakage (same flags, modulo the fact
947
948
949
950
951
952
953






954
955
956
957
958
959
960
961

962
963
964
965
966
967
968
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127

1128
1129
1130
1131
1132
1133
1134
1135







+
+
+
+
+
+







-
+







    Tcl_Obj *methodNameObj,	/* The name of the method to get the context
				 * for. NULL when getting a constructor or
				 * destructor chain. */
    int flags,			/* What sort of context are we looking for.
				 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
				 * PRIVATE_METHOD, DESTRUCTOR and
				 * FILTER_HANDLING are useful. */
    Object *contextObj,		/* Context object; when equal to oPtr, it
				 * means that private methods may also be
				 * added. [TIP 500] */
    Class *contextCls,		/* Context class; the currently considered
				 * class is equal to this, private methods may
				 * also be added. [TIP 500] */
    Tcl_Obj *cacheInThisObj)	/* What object to cache in, or NULL if it is
				 * to be in the same object as the
				 * methodNameObj. */
{
    CallContext *contextPtr;
    CallChain *callPtr;
    struct ChainBuilder cb;
    int i, count, doFilters;
    int i, count, doFilters, donePrivate = 0;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable doneFilters;

    if (cacheInThisObj == NULL) {
	cacheInThisObj = methodNameObj;
    }
    if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) {
994
995
996
997
998
999
1000
1001

1002
1003
1004
1005
1006
1007
1008
1161
1162
1163
1164
1165
1166
1167

1168
1169
1170
1171
1172
1173
1174
1175







-
+







	/*
	 * Check if we can get the chain out of the Tcl_Obj method name or out
	 * of the cache. This is made a bit more complex by the fact that
	 * there are multiple different layers of cache (in the Tcl_Obj, in
	 * the object, and in the class).
	 */

	const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
	const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);

	if (cacheInThisObj->typePtr == &methodNameType) {
	    callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1;
	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
		callPtr->refCount++;
		goto returnContext;
	    }
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056





1057
1058
1059
1060
1061
1062
1063
1213
1214
1215
1216
1217
1218
1219




1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231







-
-
-
-
+
+
+
+
+







    cb.oPtr = oPtr;

    /*
     * If we're working with a forced use of unknown, do that now.
     */

    if (flags & FORCE_UNKNOWN) {
	AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
		&cb, NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
		&cb, NULL, 0, NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
		NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = -1;
	if (callPtr->numChain == 0) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
	goto returnContext;
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088




1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102





1103
1104
1105




1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126





1127
1128
1129
1130
1131
1132
1133

1134
1135
1136
1137
1138
1139
1140
1246
1247
1248
1249
1250
1251
1252




1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275



1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296




1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307

1308
1309
1310
1311
1312
1313
1314
1315







-
-
-
-
+
+
+
+














+
+
+
+
+
-
-
-
+
+
+
+

















-
-
-
-
+
+
+
+
+






-
+







	FOREACH(mixinPtr, oPtr->mixins) {
	    AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
		    TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN);
	    AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
		    OBJECT_MIXIN);
	}
	FOREACH(filterObj, oPtr->filters) {
	    AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters,
		    BUILDING_MIXINS, NULL);
	    AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
		    NULL);
	    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
		    filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL);
	    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
		    filterObj, &cb, &doneFilters, 0, NULL);
	}
	AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
		BUILDING_MIXINS);
	AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
		0);
	Tcl_DeleteHashTable(&doneFilters);
    }
    count = cb.filterLength = callPtr->numChain;

    /*
     * Add the actual method implementations. We have to do this twice to
     * handle class mixins right.
     */

    if (oPtr == contextObj) {
	donePrivate |= AddInstancePrivateToCallContext(oPtr, methodNameObj,
		&cb, flags);
	donePrivate |= (contextObj->flags & HAS_PRIVATE_METHODS);
    }
    AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL,
	    flags|BUILDING_MIXINS, NULL);
    AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
	    methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL);
    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
	    methodNameObj, &cb, NULL, flags, NULL);

    /*
     * Check to see if the method has no implementation. If so, we probably
     * need to add in a call to the unknown method. Otherwise, set up the
     * cacheing of the method implementation (if relevant).
     */

    if (count == callPtr->numChain) {
	/*
	 * Method does not actually exist. If we're dealing with constructors
	 * or destructors, this isn't a problem.
	 */

	if (flags & SPECIAL) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
	AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
		&cb, NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
		&cb, NULL, 0, NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
		NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = -1;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else if (doFilters) {
    } else if (doFilters && !donePrivate) {
	if (hPtr == NULL) {
	    if (oPtr->flags & USE_CLASS_CACHE) {
		if (oPtr->selfCls->classChainCache == NULL) {
		    oPtr->selfCls->classChainCache =
			    ckalloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
1167
1168
1169
1170
1171
1172
1173





1174
1175
1176
1177
1178
1179
1180
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360







+
+
+
+
+







	oPtr->selfCls->destructorChainPtr = callPtr;
	callPtr->refCount++;
    }

  returnContext:
    contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
    contextPtr->oPtr = oPtr;

    /*
     * Corresponding TclOODecrRefCount() in TclOODeleteContext
     */

    AddRef(oPtr);
    contextPtr->callPtr = callPtr;
    contextPtr->skip = 2;
    contextPtr->index = 0;
    return contextPtr;
}

1227
1228
1229
1230
1231
1232
1233
1234

1235
1236
1237
1238
1239
1240
1241
1242
1407
1408
1409
1410
1411
1412
1413

1414

1415
1416
1417
1418
1419
1420
1421







-
+
-







     * in the class).
     */

    if (clsPtr->classChainCache != NULL) {
	hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
		(char *) methodNameObj);
	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
	    const int reuseMask =
	    const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
		    ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);

	    callPtr = Tcl_GetHashValue(hPtr);
	    if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
		callPtr->refCount++;
		return callPtr;
	    }
	    Tcl_SetHashValue(hPtr, NULL);
1272
1273
1274
1275
1276
1277
1278
1279

1280
1281


1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293




1294
1295
1296
1297
1298
1299
1300
1451
1452
1453
1454
1455
1456
1457

1458
1459

1460
1461
1462
1463
1464
1465
1466
1467
1468
1469




1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480







-
+

-
+
+








-
-
-
-
+
+
+
+







    Tcl_DeleteHashTable(&doneFilters);
    count = cb.filterLength = callPtr->numChain;

    /*
     * Add the actual method implementations.
     */

    AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
    AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL,
	    flags|BUILDING_MIXINS, NULL);
    AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
    AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags,
	    NULL);

    /*
     * Check to see if the method has no implementation. If so, we probably
     * need to add in a call to the unknown method. Otherwise, set up the
     * cacheing of the method implementation (if relevant).
     */

    if (count == callPtr->numChain) {
	AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
		NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
		NULL, 0, NULL);
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = -1;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else {
1366
1367
1368
1369
1370
1371
1372
1373

1374
1375

1376
1377
1378
1379
1380
1381
1382
1546
1547
1548
1549
1550
1551
1552

1553
1554

1555
1556
1557
1558
1559
1560
1561
1562







-
+

-
+







    if (MIXIN_CONSISTENT(flags)) {
	FOREACH(filterObj, clsPtr->filters) {
	    int isNew;

	    (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
		    &isNew);
	    if (isNew) {
		AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
		AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
			doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
		AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
		AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
			doneFilters, clearedFlags, clsPtr);
	    }
	}
    }

    /*
     * Now process the recursive case. Notice the tail-call optimization.
1395
1396
1397
1398
1399
1400
1401
1402

1403
1404



1405
1406
1407
1408
1409
1410


1411
1412
1413




1414
1415
1416
1417
1418
1419
1420
1575
1576
1577
1578
1579
1580
1581

1582
1583

1584
1585
1586
1587
1588
1589
1590


1591
1592
1593


1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604







-
+

-
+
+
+




-
-
+
+

-
-
+
+
+
+







	return;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * AddSimpleClassChainToCallContext --
 * AddPrivatesFromClassChainToCallContext --
 *
 *	Construct a call-chain from a class hierarchy.
 *	Helper for AddSimpleChainToCallContext that is used to find private
 *	methds and add them to the call chain. Returns true when a private
 *	method is found and added. [TIP 500]
 *
 * ----------------------------------------------------------------------
 */

static void
AddSimpleClassChainToCallContext(
static int
AddPrivatesFromClassChainToCallContext(
    Class *classPtr,		/* Class to add the call chain entries for. */
    Tcl_Obj *const methodNameObj,
				/* Name of method to add the call chain
    Class *const contextCls,	/* Context class; the currently considered
				 * class is equal to this, private methods may
				 * also be added. */
    Tcl_Obj *const methodName,	/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
1431
1432
1433
1434
1435
1436
1437

















































1438
1439































1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452



1453
1454
1455

1456
1457


1458
1459

1460
1461
1462
1463
1464
1465
1466
1467










1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478


1479
1480
1481

1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501

1502
1503
1504
1505
1506
1507
1508
1509
1510

1511
1512

1513
1514

1515


1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540








1541
1542

1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559

1560
1561
1562
1563
1564
1565
1566
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670


1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706

1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720


1721
1722


1723








1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742


1743
1744
1745
1746

1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766

1767
1768
1769
1770
1771
1772
1773
1774
1775

1776
1777

1778
1779

1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800








1801
1802
1803
1804
1805
1806
1807
1808


1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-







+
+
+



+
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+









-
-
+
+


-
+



















-
+








-
+

-
+

-
+

+
+

















-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+

















+







     *
     * Note that mixins must be processed before the main class hierarchy.
     * [Bug 1998221]
     */

  tailRecurse:
    FOREACH(superPtr, classPtr->mixins) {
	if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
		methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN,
		filterDecl)) {
	    return 1;
	}
    }

    if (classPtr == contextCls) {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
		(char *) methodName);

	if (hPtr != NULL) {
	    register Method *mPtr = Tcl_GetHashValue(hPtr);

	    if (IS_PRIVATE(mPtr)) {
		AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			flags);
		return 1;
	    }
	}
    }

    switch (classPtr->superclasses.num) {
    case 1:
	classPtr = classPtr->superclasses.list[0];
	goto tailRecurse;
    default:
	FOREACH(superPtr, classPtr->superclasses) {
	    if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
		    methodName, cbPtr, doneFilters, flags, filterDecl)) {
		return 1;
	    }
	}
    case 0:
	return 0;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * AddSimpleClassChainToCallContext --
 *
 *	Construct a call-chain from a class hierarchy.
 *
 * ----------------------------------------------------------------------
 */

static int
	AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
		doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
AddSimpleClassChainToCallContext(
    Class *classPtr,		/* Class to add the call chain entries for. */
    Tcl_Obj *const methodNameObj,
				/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    int i, privateDanger = 0;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     *
     * Note that mixins must be processed before the main class hierarchy.
     * [Bug 1998221]
     */

  tailRecurse:
    FOREACH(superPtr, classPtr->mixins) {
	privateDanger |= AddSimpleClassChainToCallContext(superPtr,
		methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN,
		filterDecl);
    }

    if (flags & CONSTRUCTOR) {
	AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
		filterDecl, flags);

    } else if (flags & DESTRUCTOR) {
	AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
		filterDecl, flags);
    } else {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
		(char *) methodNameObj);

	if (classPtr->flags & HAS_PRIVATE_METHODS) {
	    privateDanger |= 1;
	}
	if (hPtr != NULL) {
	    register Method *mPtr = Tcl_GetHashValue(hPtr);

	    if (!IS_PRIVATE(mPtr)) {
	    if (!(flags & KNOWN_STATE)) {
		if (flags & PUBLIC_METHOD) {
		if (!(flags & KNOWN_STATE)) {
		    if (flags & PUBLIC_METHOD) {
		    if (mPtr->flags & PUBLIC_METHOD) {
			flags |= DEFINITE_PUBLIC;
			if (!IS_PUBLIC(mPtr)) {
		    } else {
			return;
		    }
		} else {
		    flags |= DEFINITE_PROTECTED;
		}
	    }
	    AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags);
			    return privateDanger;
			}
			flags |= DEFINITE_PUBLIC;
		    } else {
			flags |= DEFINITE_PROTECTED;
		    }
		}
		AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			flags);
	    }
	}
    }

    switch (classPtr->superclasses.num) {
    case 1:
	classPtr = classPtr->superclasses.list[0];
	goto tailRecurse;
    default:
	FOREACH(superPtr, classPtr->superclasses) {
	    AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
		    doneFilters, flags, filterDecl);
	    privateDanger |= AddSimpleClassChainToCallContext(superPtr,
		    methodNameObj, cbPtr, doneFilters, flags, filterDecl);
	}
    case 0:
	return;
	return privateDanger;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORenderCallChain --
 *
 *	Create a description of a call chain. Used in [info object call],
 *	[info class call], and [self call].
 *
 * ----------------------------------------------------------------------
 */

Tcl_Obj *
TclOORenderCallChain(
    Tcl_Interp *interp,
    CallChain *callPtr)
{
    Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral;
    Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral;
    Tcl_Obj *resultObj, *descObjs[4], **objv;
    Foundation *fPtr = TclOOGetFoundation(interp);
    int i;

    /*
     * Allocate the literals (potentially) used in our description.
     */

    filterLiteral = Tcl_NewStringObj("filter", -1);
    TclNewLiteralStringObj(filterLiteral, "filter");
    Tcl_IncrRefCount(filterLiteral);
    methodLiteral = Tcl_NewStringObj("method", -1);
    TclNewLiteralStringObj(methodLiteral, "method");
    Tcl_IncrRefCount(methodLiteral);
    objectLiteral = Tcl_NewStringObj("object", -1);
    TclNewLiteralStringObj(objectLiteral, "object");
    Tcl_IncrRefCount(objectLiteral);
    TclNewLiteralStringObj(privateLiteral, "private");
    Tcl_IncrRefCount(privateLiteral);

    /*
     * Do the actual construction of the descriptions. They consist of a list
     * of triples that describe the details of how a method is understood. For
     * each triple, the first word is the type of invocation ("method" is
     * normal, "unknown" is special because it adds the method name as an
     * extra argument when handled by some method types, and "filter" is
     * special because it's a filter method). The second word is the name of
     * the method in question (which differs for "unknown" and "filter" types)
     * and the third word is the full name of the class that declares the
     * method (or "object" if it is declared on the instance).
     */

    objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
    for (i=0 ; i<callPtr->numChain ; i++) {
	struct MInvoke *miPtr = &callPtr->chain[i];

	descObjs[0] = miPtr->isFilter
		? filterLiteral
		: callPtr->flags & OO_UNKNOWN_METHOD
			? fPtr->unknownMethodNameObj
			: methodLiteral;
	descObjs[1] = callPtr->flags & CONSTRUCTOR
		? fPtr->constructorName
		: callPtr->flags & DESTRUCTOR
	descObjs[0] =
	    miPtr->isFilter ? filterLiteral :
	    callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
	    IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
		    methodLiteral;
	descObjs[1] =
	    callPtr->flags & CONSTRUCTOR ? fPtr->constructorName :
	    callPtr->flags & DESTRUCTOR ? fPtr->destructorName :
			? fPtr->destructorName
			: miPtr->mPtr->namePtr;
		    miPtr->mPtr->namePtr;
	descObjs[2] = miPtr->mPtr->declaringClassPtr
		? Tcl_GetObjectName(interp,
			(Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
		: objectLiteral;
	descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, -1);

	objv[i] = Tcl_NewListObj(4, descObjs);
    }

    /*
     * Drop the local references to the literals; if they're actually used,
     * they'll live on the description itself.
     */

    Tcl_DecrRefCount(filterLiteral);
    Tcl_DecrRefCount(methodLiteral);
    Tcl_DecrRefCount(objectLiteral);
    Tcl_DecrRefCount(privateLiteral);

    /*
     * Finish building the description and return it.
     */

    resultObj = Tcl_NewListObj(callPtr->numChain, objv);
    TclStackFree(interp, objv);

Changes to generic/tclOODecls.h.

55
56
57
58
59
60
61
62

63
64
65
66

67
68
69
70
71
72
73
55
56
57
58
59
60
61

62
63
64
65

66
67
68
69
70
71
72
73







-
+



-
+







				const Tcl_MethodType *typePtr,
				ClientData *clientDataPtr);
/* 10 */
TCLAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
/* 11 */
TCLAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
				Tcl_Object object, Tcl_Obj *nameObj,
				int isPublic, const Tcl_MethodType *typePtr,
				int flags, const Tcl_MethodType *typePtr,
				ClientData clientData);
/* 12 */
TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
				Tcl_Obj *nameObj, int isPublic,
				Tcl_Obj *nameObj, int flags,
				const Tcl_MethodType *typePtr,
				ClientData clientData);
/* 13 */
TCLAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
				Tcl_Class cls, const char *nameStr,
				const char *nsNameStr, int objc,
				Tcl_Obj *const *objv, int skip);
112
113
114
115
116
117
118


119
120
121
122
123
124
125
126
127
128
129
130
131
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
161
162
163
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
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
161
162
163
164
165
166







+
+




















-
-
+
+
















+







				Tcl_Class clazz, Tcl_Method method);
/* 27 */
TCLAPI void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
				Tcl_Class clazz, Tcl_Method method);
/* 28 */
TCLAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
				Tcl_Object object);
/* 29 */
TCLAPI int		Tcl_MethodIsPrivate(Tcl_Method method);

typedef struct {
    const struct TclOOIntStubs *tclOOIntStubs;
} TclOOStubHooks;

typedef struct TclOOStubs {
    int magic;
    const TclOOStubHooks *hooks;

    Tcl_Object (*tcl_CopyObjectInstance) (Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 0 */
    Tcl_Object (*tcl_GetClassAsObject) (Tcl_Class clazz); /* 1 */
    Tcl_Class (*tcl_GetObjectAsClass) (Tcl_Object object); /* 2 */
    Tcl_Command (*tcl_GetObjectCommand) (Tcl_Object object); /* 3 */
    Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 4 */
    Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */
    Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */
    Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */
    int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
    int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */
    Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
    Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
    Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
    Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
    Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
    Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
    int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
    int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
    Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */
    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
    int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
    ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */
    ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
    void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */
    int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
    Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
    void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
    void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
    void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
    Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
    int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
} TclOOStubs;

extern const TclOOStubs *tclOOStubsPtr;

#ifdef __cplusplus
}
#endif
222
223
224
225
226
227
228


229
230
231
232
233
234
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239







+
+






	(tclOOStubsPtr->tcl_ObjectSetMethodNameMapper) /* 25 */
#define Tcl_ClassSetConstructor \
	(tclOOStubsPtr->tcl_ClassSetConstructor) /* 26 */
#define Tcl_ClassSetDestructor \
	(tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
#define Tcl_GetObjectName \
	(tclOOStubsPtr->tcl_GetObjectName) /* 28 */
#define Tcl_MethodIsPrivate \
	(tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */

#endif /* defined(USE_TCLOO_STUBS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLOODECLS */

Changes to generic/tclOODefineCmds.c.

12
13
14
15
16
17
18






19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

34
35
36

37
38
39
40
41



42
43
44
45
46
47
48
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

43
44
45
46
47

48
49
50
51
52
53
54
55
56
57







+
+
+
+
+
+















+


-
+




-
+
+
+








#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

/*
 * The actual value used to mark private declaration frames.
 */

#define PRIVATE_FRAME (FRAME_IS_OO_DEFINE | FRAME_IS_PRIVATE_DEFINE)

/*
 * The maximum length of fully-qualified object name to use in an errorinfo
 * message. Longer than this will be curtailed.
 */

#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30

/*
 * Some things that make it easier to declare a slot.
 */

struct DeclaredSlot {
    const char *name;
    const Tcl_MethodType getterType;
    const Tcl_MethodType setterType;
    const Tcl_MethodType resolverType;
};

#define SLOT(name,getter,setter)					\
#define SLOT(name,getter,setter,resolver)				\
    {"::oo::" name,							\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
		    getter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
		    setter, NULL, NULL}}
		    setter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \
		    resolver, NULL, NULL}}

/*
 * Forward declarations.
 */

static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
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
128
129
130
131
132
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123








124
125
126
127
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174







+
+
+






-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





+







			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ResolveClass(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);

/*
 * Now define the slots used in declarations.
 */

static const struct DeclaredSlot slots[] = {
    SLOT("define::filter",      ClassFilterGet, ClassFilterSet),
    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet),
    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet),
    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet),
    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet),
    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet),
    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet),
    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
    SLOT("define::filter",      ClassFilterGet, ClassFilterSet, NULL),
    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet, ResolveClass),
    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet, ResolveClass),
    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet, NULL),
    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet, NULL),
    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet, ResolveClass),
    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet, NULL),
    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
};

/*
 * How to build the in-namespace name of a private variable. This is a pattern
 * used with Tcl_ObjPrintf().
 */

#define PRIVATE_VARIABLE_PATTERN "%d : %s"

/*
 * ----------------------------------------------------------------------
 *
 * IsPrivateDefine --
 *
 *	Extracts whether the current context is handling private definitions.
 *
 * ----------------------------------------------------------------------
 */

static inline int
IsPrivateDefine(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    if (!iPtr->varFramePtr) {
	return 0;
    }
    return iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME;
}

/*
 * ----------------------------------------------------------------------
 *
 * BumpGlobalEpoch --
 *
 *	Utility that ensures that call chains that are invalid will get thrown
 *	away at an appropriate time. Note that exactly which epoch gets
 *	advanced will depend on exactly what the class is tangled up in; in
 *	the worst case, the simplest option is to advance the global epoch,
 *	causing *everything* to be thrown away on next usage.
 *
 * ----------------------------------------------------------------------
163
164
165
166
167
168
169

170
171
172
173
174
175
176
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219







+







    TclOOGetFoundation(interp)->epoch++;
}

/*
 * ----------------------------------------------------------------------
 *
 * RecomputeClassCacheFlag --
 *
 *	Determine whether the object is prototypical of its class, and hence
 *	able to use the class's method chain cache.
 *
 * ----------------------------------------------------------------------
 */

static inline void
185
186
187
188
189
190
191

192
193
194
195
196
197
198
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242







+







    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjectSetFilters --
 *
 *	Install a list of filter method names into an object.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOObjectSetFilters(
243
244
245
246
247
248
249

250
251
252
253
254
255
256
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301







+







    oPtr->epoch++;		/* Only this object can be affected. */
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOClassSetFilters --
 *
 *	Install a list of filter method names into a class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOClassSetFilters(
305
306
307
308
309
310
311

312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330

331

332
333
334
335
336
337
338
339
340
341
342

343
344
345
346
347
348
349
350
351
352
353
354


355
356
357
358
359
360
361
362
363
364

365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383

384
385
386
387
388
389
390
391

392
393
394
395
396
397
398
399
400
401


402
403
404
405
406
407
408
409





















































































































410

411
412
413
414
415
416
417
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374


375

376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588







+

















-
-
+
-
+











+












+
+










+



















+








+










+
+








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+







    BumpGlobalEpoch(interp, classPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjectSetMixins --
 *
 *	Install a list of mixin classes into an object.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOObjectSetMixins(
    Object *oPtr,
    int numMixins,
    Class *const *mixins)
{
    Class *mixinPtr;
    int i;

    if (numMixins == 0) {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		if (mixinPtr) {
		    TclOORemoveFromInstances(oPtr, mixinPtr);
		TclOORemoveFromInstances(oPtr, mixinPtr);
		}
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(oPtr->mixins.list);
	    oPtr->mixins.num = 0;
	}
	RecomputeClassCacheFlag(oPtr);
    } else {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		if (mixinPtr && mixinPtr != oPtr->selfCls) {
		    TclOORemoveFromInstances(oPtr, mixinPtr);
		}
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    oPtr->mixins.list = ckrealloc(oPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    oPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
	    oPtr->flags &= ~USE_CLASS_CACHE;
	}
	oPtr->mixins.num = numMixins;
	memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, oPtr->mixins) {
	    if (mixinPtr != oPtr->selfCls) {
		TclOOAddToInstances(oPtr, mixinPtr);
		/* For the new copy created by memcpy */
		AddRef(mixinPtr->thisPtr);
	    }
	}
    }
    oPtr->epoch++;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOClassSetMixins --
 *
 *	Install a list of mixin classes into a class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOClassSetMixins(
    Tcl_Interp *interp,
    Class *classPtr,
    int numMixins,
    Class *const *mixins)
{
    Class *mixinPtr;
    int i;

    if (numMixins == 0) {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(classPtr->mixins.list);
	    classPtr->mixins.num = 0;
	}
    } else {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    classPtr->mixins.list = ckrealloc(classPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
	}
	classPtr->mixins.num = numMixins;
	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, classPtr->mixins) {
	    TclOOAddToMixinSubs(classPtr, mixinPtr);
	    /* For the new copy created by memcpy */
	    AddRef(mixinPtr->thisPtr);
	}
    }
    BumpGlobalEpoch(interp, classPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * InstallStandardVariableMapping, InstallPrivateVariableMapping --
 *
 *	Helpers for installing standard and private variable maps.
 *
 * ----------------------------------------------------------------------
 */
static inline void
InstallStandardVariableMapping(
    VariableNameList *vnlPtr,
    int varc,
    Tcl_Obj *const *varv)
{
    Tcl_Obj *variableObj;
    int i, n, created;
    Tcl_HashTable uniqueTable;

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, *vnlPtr) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(vnlPtr->list);
	} else if (i) {
	    vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
	} else {
	    vnlPtr->list = ckalloc(sizeof(Tcl_Obj *) * varc);
	}
    }
    vnlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		vnlPtr->list[n++] = varv[i];
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	vnlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static inline void
InstallPrivateVariableMapping(
    PrivateVariableList *pvlPtr,
    int varc,
    Tcl_Obj *const *varv,
    int creationEpoch)
{
    PrivateVariableMapping *privatePtr;
    int i, n, created;
    Tcl_HashTable uniqueTable;

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH_STRUCT(privatePtr, *pvlPtr) {
	Tcl_DecrRefCount(privatePtr->variableObj);
	Tcl_DecrRefCount(privatePtr->fullNameObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(pvlPtr->list);
	} else if (i) {
	    pvlPtr->list = ckrealloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * varc);
	} else {
	    pvlPtr->list = ckalloc(sizeof(PrivateVariableMapping) * varc);
	}
    }

    pvlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		privatePtr = &(pvlPtr->list[n++]);
		privatePtr->variableObj = varv[i];
		privatePtr->fullNameObj = Tcl_ObjPrintf(
			PRIVATE_VARIABLE_PATTERN,
			creationEpoch, Tcl_GetString(varv[i]));
		Tcl_IncrRefCount(privatePtr->fullNameObj);
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	pvlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    pvlPtr->list = ckrealloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * RenameDeleteMethod --
 *
 *	Core of the code to rename and delete methods.
 *
 * ----------------------------------------------------------------------
 */

static int
RenameDeleteMethod(
493
494
495
496
497
498
499

500
501
502
503
504
505
506
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678







+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOUnknownDefinition --
 *
 *	Handles what happens when an unknown command is encountered during the
 *	processing of a definition script. Works by finding a command in the
 *	operating definition namespace that the requested command is a unique
 *	prefix of.
 *
 * ----------------------------------------------------------------------
 */
571
572
573
574
575
576
577

578
579
580
581
582
583
584
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757







+







    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
 * FindCommand --
 *
 *	Specialized version of Tcl_FindCommand that handles command prefixes
 *	and disallows namespace magic.
 *
 * ----------------------------------------------------------------------
 */

static Tcl_Command
631
632
633
634
635
636
637

638
639
640
641
642
643
644
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818







+







    return cmd;
}

/*
 * ----------------------------------------------------------------------
 *
 * InitDefineContext --
 *
 *	Does the magic incantations necessary to push the special stack frame
 *	used when processing object definitions. It is up to the caller to
 *	dispose of the frame (with TclPopStackFrame) when finished.
 *
 * ----------------------------------------------------------------------
 */

656
657
658
659
660
661
662

663


664
665
666
667
668
669
670
671
672
673
674
675
676
677

678
679
680
681
682
683
684
685
686
687
688
689
690
691
692


693
694
695
696
697
698
699
830
831
832
833
834
835
836
837

838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868

869
870
871
872
873
874
875
876
877







+
-
+
+














+














-
+
+







	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot process definitions; support namespace deleted",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
    /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
     * framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules.
     */

    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
	    namespacePtr, FRAME_IS_OO_DEFINE);
    framePtr->clientData = oPtr;
    framePtr->objc = objc;
    framePtr->objv = objv;	/* Reference counts do not need to be
				 * incremented here. */
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetDefineCmdContext --
 *
 *	Extracts the magic token from the current stack frame, or returns NULL
 *	(and leaves an error message) otherwise.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Object
TclOOGetDefineCmdContext(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Object object;

    if ((iPtr->varFramePtr == NULL)
	    || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
	    || (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));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return NULL;
    }
    object = iPtr->varFramePtr->clientData;
707
708
709
710
711
712
713

714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732


733
734
735
736
737
738
739
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910

911
912
913
914
915
916
917
918
919







+


















-
+
+







    return object;
}

/*
 * ----------------------------------------------------------------------
 *
 * GetClassInOuterContext --
 *
 *	Wrapper round Tcl_GetObjectFromObj to perform the lookup in the
 *	context that called oo::define (or equivalent). Note that this may
 *	have to go up multiple levels to get the level that we started doing
 *	definitions at.
 *
 * ----------------------------------------------------------------------
 */

static inline Class *
GetClassInOuterContext(
    Tcl_Interp *interp,
    Tcl_Obj *className,
    const char *errMsg)
{
    Interp *iPtr = (Interp *) interp;
    Object *oPtr;
    CallFrame *savedFramePtr = iPtr->varFramePtr;

    while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE) {
    while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE
	    || iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME) {
	if (iPtr->varFramePtr->callerVarPtr == NULL) {
	    Tcl_Panic("getting outer context when already in global context");
	}
	iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, className);
    iPtr->varFramePtr = savedFramePtr;
749
750
751
752
753
754
755

756
757
758
759
760
761
762
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943







+







    return oPtr->classPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * GenerateErrorInfo --
 *
 *	Factored out code to generate part of the error trace messages.
 *
 * ----------------------------------------------------------------------
 */

static inline void
GenerateErrorInfo(
787
788
789
790
791
792
793

794
795
796
797
798
799
800
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982







+







	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 * ----------------------------------------------------------------------
 *
 * MagicDefinitionInvoke --
 *
 *	Part of the implementation of the "oo::define" and "oo::objdefine"
 *	commands that is used to implement the more-than-one-argument case,
 *	applying ensemble-like tricks with dispatch so that error messages are
 *	clearer. Doesn't handle the management of the stack frame.
 *
 * ----------------------------------------------------------------------
 */
850
851
852
853
854
855
856

857
858
859
860
861
862
863
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046







+







    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineObjCmd --
 *
 *	Implementation of the "oo::define" command. Works by effectively doing
 *	the same as 'namespace eval', but with extra magic applied so that the
 *	object to be modified is known to the commands in the target
 *	namespace. Also does ensemble-like tricks with dispatch so that error
 *	messages are clearer.
 *
 * ----------------------------------------------------------------------
910
911
912
913
914
915
916
917

918
919
920
921
922
923
924
925
926
927
928
929
930

931
932
933
934
935
936
937
1093
1094
1095
1096
1097
1098
1099

1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121







-
+













+







	if (result == TCL_ERROR) {
	    GenerateErrorInfo(interp, oPtr, objNameObj, "class");
	}
	TclDecrRefCount(objNameObj);
    } else {
	result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv);
    }
    DelRef(oPtr);
    TclOODecrRefCount(oPtr);

    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjDefObjCmd --
 *
 *	Implementation of the "oo::objdefine" command. Works by effectively
 *	doing the same as 'namespace eval', but with extra magic applied so
 *	that the object to be modified is known to the commands in the target
 *	namespace. Also does ensemble-like tricks with dispatch so that error
 *	messages are clearer.
 *
 * ----------------------------------------------------------------------
977
978
979
980
981
982
983
984

985
986
987
988
989
990
991
992
993
994
995
996
997

998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016

1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027


1028
1029
1030
1031
1032
1033
1034
1035



1036
1037
1038
1039
1040
1041
1042
1043

1044
1045
1046
1047
1048
1049
1050
1051

1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064

1065
1066
1067
1068
1069
1070
1071
1161
1162
1163
1164
1165
1166
1167

1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200

1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232

1233
1234
1235
1236
1237
1238
1239
1240

1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262







-
+













+


















-
+











+
+








+
+
+







-
+







-
+













+







	if (result == TCL_ERROR) {
	    GenerateErrorInfo(interp, oPtr, objNameObj, "object");
	}
	TclDecrRefCount(objNameObj);
    } else {
	result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv);
    }
    DelRef(oPtr);
    TclOODecrRefCount(oPtr);

    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineSelfObjCmd --
 *
 *	Implementation of the "self" subcommand of the "oo::define" command.
 *	Works by effectively doing the same as 'namespace eval', but with
 *	extra magic applied so that the object to be modified is known to the
 *	commands in the target namespace. Also does ensemble-like tricks with
 *	dispatch so that error messages are clearer.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineSelfObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Foundation *fPtr = TclOOGetFoundation(interp);
    Object *oPtr;
    int result;
    int result, private;

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    if (objc < 2) {
	Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
	return TCL_OK;
    }

    private = IsPrivateDefine(interp);

    /*
     * Make the oo::objdefine namespace the current namespace and evaluate the
     * command(s).
     */

    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
	return TCL_ERROR;
    }
    if (private) {
	((Interp *) interp)->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
    }

    AddRef(oPtr);
    if (objc == 2) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[1], 0,
		((Interp *)interp)->cmdFramePtr, 2);
		((Interp *)interp)->cmdFramePtr, 1);
	if (result == TCL_ERROR) {
	    GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
	}
	TclDecrRefCount(objNameObj);
    } else {
	result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv);
    }
    DelRef(oPtr);
    TclOODecrRefCount(oPtr);

    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineObjSelfObjCmd --
 *
 *	Implementation of the "self" subcommand of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
1090
1091
1092
1093
1094
1095
1096









































































1097

1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113

1114
1115
1116
1117
1118
1119
1120
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
















+







    Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefinePrivateObjCmd --
 *
 *	Implementation of the "private" subcommand of the "oo::define"
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefinePrivateObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstancePrivate = (clientData != NULL);
				/* Just so that we can generate the correct
				 * error message depending on the context of
				 * usage of this function. */
    Interp *iPtr = (Interp *) interp;
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int saved;			/* The saved flag. We restore it on exit so
				 * that [private private ...] doesn't make
				 * things go weird. */
    int result;

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(IsPrivateDefine(interp)));
	return TCL_OK;
    }

    /*
     * Change the frame type flag while evaluating the body.
     */

    saved = iPtr->varFramePtr->isProcCallFrame;
    iPtr->varFramePtr->isProcCallFrame = PRIVATE_FRAME;

    /*
     * Evaluate the body; standard pattern.
     */

    AddRef(oPtr);
    if (objc == 2) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
	if (result == TCL_ERROR) {
	    GenerateErrorInfo(interp, oPtr, objNameObj,
		    isInstancePrivate ? "object" : "class");
	}
	TclDecrRefCount(objNameObj);
    } else {
	result = MagicDefinitionInvoke(interp, TclGetCurrentNamespace(interp),
		1, objc, objv);
    }
    TclOODecrRefCount(oPtr);

    /*
     * Restore the frame type flag to what it was previously.
     */

    iPtr->varFramePtr->isProcCallFrame = saved;
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineClassObjCmd --
 *
 *	Implementation of the "class" subcommand of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineClassObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Foundation *fPtr = TclOOGetFoundation(interp);
    int wasClass, willBeClass;

    /*
     * Parse the context to get the object to operate on.
     */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
1142
1143
1144
1145
1146
1147
1148
1149

1150
1151
1152
1153
1154
1155
1156
1157
1158


1159
1160
1161

1162
1163
1164
1165
1166
1167
1168



1169
1170

1171

1172
1173
1174





















1175

1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188

1189
1190
1191
1192
1193
1194
1195
1408
1409
1410
1411
1412
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
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478







-
+
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+







+
+
+


+

+

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+













+







	return TCL_ERROR;
    }
    clsPtr = GetClassInOuterContext(interp, objv[1],
	    "the class of an object must be a class");
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    if (oPtr == clsPtr->thisPtr) {
    /*
     * Apply semantic checks. In particular, classes and non-classes are not
     * interchangable (too complicated to do the conversion!) so we must
     * produce an error if any attempt is made to swap from one to the other.
     */

    if ((oPtr->classPtr==NULL) == TclOOIsReachable(fPtr->classCls, clsPtr)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"may not change a %sclass object into a %sclass object",
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not change classes into an instance of themselves", -1));
		(oPtr->classPtr==NULL ? "non-" : ""),
		(oPtr->classPtr==NULL ? "" : "non-")));
	Tcl_SetErrorCode(interp, "TCL", "OO", "TRANSMUTATION", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * Set the object's class.
     */

    wasClass = (oPtr->classPtr != NULL);
    willBeClass = (TclOOIsReachable(fPtr->classCls, clsPtr));

    if (oPtr->selfCls != clsPtr) {
	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
	TclOODecrRefCount(oPtr->selfCls->thisPtr);
	oPtr->selfCls = clsPtr;
	AddRef(oPtr->selfCls->thisPtr);
	TclOOAddToInstances(oPtr, oPtr->selfCls);
	if (!(clsPtr->thisPtr->flags & OBJECT_DELETED)) {
	    oPtr->flags &= ~CLASS_GONE;

	/*
	 * Create or delete the class guts if necessary.
	 */

	if (wasClass && !willBeClass) {
	    /*
	     * This is the most global of all epochs. Bump it! No cache can be
	     * trusted!
	     */

	    TclOORemoveFromMixins(oPtr->classPtr, oPtr);
	    oPtr->fPtr->epoch++;
	    oPtr->flags |= DONT_DELETE;
	    TclOODeleteDescendants(interp, oPtr);
	    oPtr->flags &= ~DONT_DELETE;
	    TclOOReleaseClassContents(interp, oPtr);
		ckfree(oPtr->classPtr);
		oPtr->classPtr = NULL;
	} else if (!wasClass && willBeClass) {
	    TclOOAllocClass(interp, oPtr);
	}

	if (oPtr->classPtr != NULL) {
	    BumpGlobalEpoch(interp, oPtr->classPtr);
	} else {
	    oPtr->epoch++;
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineConstructorObjCmd --
 *
 *	Implementation of the "constructor" subcommand of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
1250
1251
1252
1253
1254
1255
1256

1257
1258
1259
1260
1261
1262
1263
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547







+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineDeleteMethodObjCmd --
 *
 *	Implementation of the "deletemethod" subcommand of the "oo::define"
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
1306
1307
1308
1309
1310
1311
1312

1313
1314
1315
1316
1317
1318
1319
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604







+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineDestructorObjCmd --
 *
 *	Implementation of the "destructor" subcommand of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
1370
1371
1372
1373
1374
1375
1376

1377
1378
1379
1380
1381
1382
1383
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669







+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineExportObjCmd --
 *
 *	Implementation of the "export" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
1440
1441
1442
1443
1444
1445
1446
1447

1448

1449
1450
1451
1452
1453
1454
1455
1726
1727
1728
1729
1730
1731
1732

1733
1734
1735
1736
1737
1738
1739
1740
1741
1742







-
+

+







	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = Tcl_GetHashValue(hPtr);
	}
	if (isNew || !(mPtr->flags & PUBLIC_METHOD)) {
	if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) {
	    mPtr->flags |= PUBLIC_METHOD;
	    mPtr->flags &= ~TRUE_PRIVATE_METHOD;
	    changed = 1;
	}
    }

    /*
     * Bump the right epoch if we actually changed anything.
     */
1464
1465
1466
1467
1468
1469
1470

1471
1472
1473
1474
1475
1476
1477
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765







+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineForwardObjCmd --
 *
 *	Implementation of the "forward" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
1500
1501
1502
1503
1504
1505
1506



1507
1508
1509
1510
1511
1512
1513
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804







+
+
+







	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
	    ? PUBLIC_METHOD : 0;
    if (IsPrivateDefine(interp)) {
	isPublic = TRUE_PRIVATE_METHOD;
    }

    /*
     * Create the method structure.
     */

    prefixObj = Tcl_NewListObj(objc-2, objv+2);
    if (isInstanceForward) {
1524
1525
1526
1527
1528
1529
1530

1531
1532
1533
1534
1535
1536
1537
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829







+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineMethodObjCmd --
 *
 *	Implementation of the "method" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
1558
1559
1560
1561
1562
1563
1564



1565
1566
1567
1568
1569
1570
1571
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866







+
+
+







	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
	    ? PUBLIC_METHOD : 0;
    if (IsPrivateDefine(interp)) {
	isPublic = TRUE_PRIVATE_METHOD;
    }

    /*
     * Create the method by using the right back-end API.
     */

    if (isInstanceMethod) {
	if (TclOONewProcInstanceMethod(interp, oPtr, isPublic, objv[1],
1580
1581
1582
1583
1584
1585
1586
1587

1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1875
1876
1877
1878
1879
1880
1881

1882


1883




























































1884
1885
1886
1887
1888
1889
1890







-
+
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineMixinObjCmd --
 * TclOODefineRenameMethodObjCmd --
 *	Implementation of the "mixin" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineMixinObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    const int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceMixin = (clientData != NULL);
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Class **mixins;
    int i;

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceMixin && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1));

    for (i=1 ; i<objc ; i++) {
	Class *clsPtr = GetClassInOuterContext(interp, objv[i],
		"may only mix in classes");

	if (clsPtr == NULL) {
	    goto freeAndError;
	}
	if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "may not mix a class into itself", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
	    goto freeAndError;
	}
	mixins[i-1] = clsPtr;
    }

    if (isInstanceMixin) {
	TclOOObjectSetMixins(oPtr, objc-1, mixins);
    } else {
	TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins);
    }

    TclStackFree(interp, mixins);
    return TCL_OK;

  freeAndError:
    TclStackFree(interp, mixins);
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineRenameMethodObjCmd --
 *	Implementation of the "renamemethod" subcommand of the "oo::define"
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
1700
1701
1702
1703
1704
1705
1706

1707
1708
1709
1710
1711
1712
1713
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947







+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineUnexportObjCmd --
 *
 *	Implementation of the "unexport" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
1770
1771
1772
1773
1774
1775
1776
1777
1778


1779
1780
1781
1782
1783
1784
1785
2004
2005
2006
2007
2008
2009
2010


2011
2012
2013
2014
2015
2016
2017
2018
2019







-
-
+
+







	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = Tcl_GetHashValue(hPtr);
	}
	if (isNew || mPtr->flags & PUBLIC_METHOD) {
	    mPtr->flags &= ~PUBLIC_METHOD;
	if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) {
	    mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD);
	    changed = 1;
	}
    }

    /*
     * Bump the right epoch if we actually changed anything.
     */
1794
1795
1796
1797
1798
1799
1800

1801
1802
1803
1804
1805
1806
1807
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042







+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_ClassSetConstructor, Tcl_ClassSetDestructor --
 *
 *	How to install a constructor or destructor into a class; API to call
 *	from C.
 *
 * ----------------------------------------------------------------------
 */

void
1848
1849
1850
1851
1852
1853
1854

1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867

1868
1869
1870
1871
1872
1873
1874
1875
1876

1877
1878
1879

1880
1881
1882
1883
1884
1885
1886
1887




1888
1889
1890

1891
1892
1893
1894
1895
1896
1897

1898
1899
1900
1901
1902
1903
1904
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116

2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148







+













+









+


-
+








+
+
+
+



+







+







    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineSlots --
 *
 *	Create the "::oo::Slot" class and its standard instances. Class
 *	definition is empty at the stage (added by scripting).
 *
 * ----------------------------------------------------------------------
 */

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);
    Class *slotCls;

    slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
	    fPtr->classCls, "::oo::Slot", NULL, -1, NULL, 0))->classPtr;
    if (slotCls == NULL) {
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(getName);
    Tcl_IncrRefCount(setName);
    Tcl_IncrRefCount(resolveName);
    for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
	Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
		(Tcl_Class) slotCls, slotInfoPtr->name, NULL,-1,NULL,0);
		(Tcl_Class) slotCls, slotInfoPtr->name, NULL, -1, NULL, 0);

	if (slotObject == NULL) {
	    continue;
	}
	Tcl_NewInstanceMethod(fPtr->interp, slotObject, getName, 0,
		&slotInfoPtr->getterType, NULL);
	Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0,
		&slotInfoPtr->setterType, NULL);
	if (slotInfoPtr->resolverType.callProc) {
	    Tcl_NewInstanceMethod(fPtr->interp, slotObject, resolveName, 0,
		    &slotInfoPtr->resolverType, NULL);
	}
    }
    Tcl_DecrRefCount(getName);
    Tcl_DecrRefCount(setName);
    Tcl_DecrRefCount(resolveName);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassFilterGet, ClassFilterSet --
 *
 *	Implementation of the "filter" slot accessors of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
1970
1971
1972
1973
1974
1975
1976

1977
1978
1979
1980
1981
1982
1983
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228







+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassMixinGet, ClassMixinSet --
 *
 *	Implementation of the "mixin" slot accessors of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
2051
2052
2053
2054
2055
2056
2057

2058
2059
2060
2061
2062
2063
2064
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310







+








    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);

    for (i=0 ; i<mixinc ; i++) {
	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
		"may only mix in classes");
	if (mixins[i] == NULL) {
	    i--;
	    goto freeAndError;
	}
	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "may not mix a class into itself", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
	    goto freeAndError;
2074
2075
2076
2077
2078
2079
2080

2081
2082
2083
2084
2085
2086
2087
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334







+







    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassSuperGet, ClassSuperSet --
 *
 *	Implementation of the "superclass" slot accessors of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178


2179


2180
2181
2182
2183
2184

2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200



2201
2202
2203







2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216

2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233

2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249

2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266









2267
2268



2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284

2285
2286
2287
2288
2289
2290
2291
2415
2416
2417
2418
2419
2420
2421


2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510

2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537


2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555

2556
2557
2558
2559
2560
2561
2562
2563







-
-


+
+

+
+





+
















+
+
+



+
+
+
+
+
+
+













+

















+















-
+

















+
+
+
+
+
+
+
+
+
-
-
+
+
+















-
+







     *
     * Note that zero classes is special, as it is equivalent to just the
     * class of objects. [Bug 9d61624b3d]
     */

    if (superc == 0) {
	superclasses = ckrealloc(superclasses, sizeof(Class *));
	superclasses[0] = oPtr->fPtr->objectCls;
	superc = 1;
	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
	    superclasses[0] = oPtr->fPtr->classCls;
	} else {
	    superclasses[0] = oPtr->fPtr->objectCls;
	}
	superc = 1;
	AddRef(superclasses[0]->thisPtr);
    } else {
	for (i=0 ; i<superc ; i++) {
	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
		    "only a class can be a superclass");
	    if (superclasses[i] == NULL) {
		i--;
		goto failedAfterAlloc;
	    }
	    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_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
		    goto failedAfterAlloc;
		}
	    }
	    if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"attempt to form circular dependency graph", -1));
		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
	    failedAfterAlloc:
		for (; i > 0; i--) {
		    TclOODecrRefCount(superclasses[i]->thisPtr);
		}
		ckfree(superclasses);
		return TCL_ERROR;
	    }

	    /*
	     * Corresponding TclOODecrRefCount() is near the end of this
	     * function.
	     */

	    AddRef(superclasses[i]->thisPtr);
	}
    }

    /*
     * Install the list of superclasses into the class. Note that this also
     * 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);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	ckfree(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);

    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassVarsGet, ClassVarsSet --
 *
 *	Implementation of the "variable" slot accessors of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ClassVarsGet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *variableObj;
    Tcl_Obj *resultObj;
    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", NULL);
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    if (IsPrivateDefine(interp)) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, oPtr->classPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

    FOREACH(variableObj, oPtr->classPtr->variables) {
	Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	FOREACH(variableObj, oPtr->classPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassVarsSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc;
    Tcl_Obj **varv, *variableObj;
    Tcl_Obj **varv;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344


2345
2346
2347
2348

2349
2350
2351
2352
2353
2354

2355
2356
2357
2358

2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375

2376
2377
2378
2379
2380
2381
2382
2590
2591
2592
2593
2594
2595
2596




















2597
2598




2599






2600




2601









2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-








+







		    "invalid declared variable name \"%s\": must not %s",
		    varName, "refer to an array element"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
    }

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, oPtr->classPtr->variables) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(oPtr->classPtr->variables.list);
	} else if (i) {
	    oPtr->classPtr->variables.list = (Tcl_Obj **)
		    ckrealloc((char *) oPtr->classPtr->variables.list,
		    sizeof(Tcl_Obj *) * varc);
	} else {
	    oPtr->classPtr->variables.list = (Tcl_Obj **)
		    ckalloc(sizeof(Tcl_Obj *) * varc);
	}
    }

    oPtr->classPtr->variables.num = 0;
    if (IsPrivateDefine(interp)) {
	InstallPrivateVariableMapping(&oPtr->classPtr->privateVariables,
    if (varc > 0) {
	int created, n;
	Tcl_HashTable uniqueTable;

		varc, varv, oPtr->classPtr->thisPtr->creationEpoch);
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		oPtr->classPtr->variables.list[n++] = varv[i];
	    } else {
    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	oPtr->classPtr->variables.num = n;
	InstallStandardVariableMapping(&oPtr->classPtr->variables, varc, varv);

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	oPtr->classPtr->variables.list = (Tcl_Obj **)
		ckrealloc((char *) oPtr->classPtr->variables.list,
		sizeof(Tcl_Obj *) * n);
	Tcl_DeleteHashTable(&uniqueTable);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectFilterGet, ObjectFilterSet --
 *
 *	Implementation of the "filter" slot accessors of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
2436
2437
2438
2439
2440
2441
2442

2443
2444
2445
2446
2447
2448
2449
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685







+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectMixinGet, ObjectMixinSet --
 *
 *	Implementation of the "mixin" slot accessors of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
2521
2522
2523
2524
2525
2526
2527

2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543

2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554









2555
2556



2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572

2573
2574
2575
2576
2577
2578
2579
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779

2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800


2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818

2819
2820
2821
2822
2823
2824
2825
2826







+















-
+











+
+
+
+
+
+
+
+
+
-
-
+
+
+















-
+







    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectVarsGet, ObjectVarsSet --
 *
 *	Implementation of the "variable" slot accessors of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ObjVarsGet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *variableObj;
    Tcl_Obj *resultObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    if (IsPrivateDefine(interp)) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

    FOREACH(variableObj, oPtr->variables) {
	Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	FOREACH(variableObj, oPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjVarsSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc, i;
    Tcl_Obj **varv, *variableObj;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"variableList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608


2609
2610
2611
2612

2613
2614

2615
2616
2617
2618
2619
2620


2621
2622
2623
2624
2625
2626
2627



























2628




2629

2630
2631
2632

2633
2634
2635
2636
2637






2638
2639
2640

2641
2642



2643


2644

2645
2646
2647




2648

2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2845
2846
2847
2848
2849
2850
2851




2852
2853




2854


2855






2856
2857







2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889

2890



2891





2892
2893
2894
2895
2896
2897



2898


2899
2900
2901
2902
2903
2904

2905



2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921







-
-
-
-
+
+
-
-
-
-
+
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
+
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
-
-
+
+
+

+
+
-
+
-
-
-
+
+
+
+

+










	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "refer to an array element"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
    }
    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }


    if (IsPrivateDefine(interp)) {
    FOREACH(variableObj, oPtr->variables) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv,
	if (varc == 0) {
	    ckfree(oPtr->variables.list);
		oPtr->creationEpoch);
	} else if (i) {
	    oPtr->variables.list = (Tcl_Obj **)
		    ckrealloc((char *) oPtr->variables.list,
		    sizeof(Tcl_Obj *) * varc);
	} else {
	    oPtr->variables.list = (Tcl_Obj **)
    } else {
	InstallStandardVariableMapping(&oPtr->variables, varc, varv);
		    ckalloc(sizeof(Tcl_Obj *) * varc);
	}
    }
    oPtr->variables.num = 0;
    if (varc > 0) {
	int created, n;
	Tcl_HashTable uniqueTable;
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ResolveClass --
 *
 *	Implementation of the "Resolve" support method for some slots (those
 *	that are slots around a list of classes). This resolves possible class
 *	names to their fully-qualified names if possible.
 *
 * ----------------------------------------------------------------------
 */

static int
ResolveClass(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    int idx = Tcl_ObjectContextSkippedArgs(context);
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Class *clsPtr;

    /*
     * Check if were called wrongly. The definition context isn't used...
     * except that GetClassInOuterContext() assumes that it is there.
     */
	Tcl_InitObjHashTable(&uniqueTable);

	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
    if (oPtr == NULL) {
		oPtr->variables.list[n++] = varv[i];
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	return TCL_ERROR;
    } else if (objc != idx + 1) {
	Tcl_WrongNumArgs(interp, idx, objv, "slotElement");
	return TCL_ERROR;
    }

	oPtr->variables.num = n;

	/*
    /*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */
     * Resolve the class if possible. If not, remove any resolution error and
     * return what we've got anyway as the failure might not be fatal overall.
     */

    clsPtr = GetClassInOuterContext(interp, objv[idx],
	    "USER SHOULD NOT SEE THIS MESSAGE");
	oPtr->variables.list = (Tcl_Obj **)
    if (clsPtr == NULL) {
		ckrealloc((char *) oPtr->variables.list,
		sizeof(Tcl_Obj *) * n);
	Tcl_DeleteHashTable(&uniqueTable);
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, objv[idx]);
    } else {
	Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
    }

    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclOOInfo.c.

18
19
20
21
22
23
24

25
26
27
28
29
30
31
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32







+








static inline Class *	GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc InfoObjectCallCmd;
static Tcl_ObjCmdProc InfoObjectClassCmd;
static Tcl_ObjCmdProc InfoObjectDefnCmd;
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
static Tcl_ObjCmdProc InfoObjectForwardCmd;
static Tcl_ObjCmdProc InfoObjectIdCmd;
static Tcl_ObjCmdProc InfoObjectIsACmd;
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
static Tcl_ObjCmdProc InfoObjectMixinsCmd;
static Tcl_ObjCmdProc InfoObjectNsCmd;
static Tcl_ObjCmdProc InfoObjectVarsCmd;
static Tcl_ObjCmdProc InfoObjectVariablesCmd;
46
47
48
49
50
51
52

53
54
55
56
57
58
59
60
61

62
63
64
65
66
67
68
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62

63
64
65
66
67
68
69
70







+








-
+







/*
 * List of commands that are used to implement the [info object] subcommands.
 */

static const EnsembleImplMap infoObjectCmds[] = {
    {"call",	   InfoObjectCallCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"class",	   InfoObjectClassCmd,	    TclCompileInfoObjectClassCmd, NULL, NULL, 0},
    {"creationid", InfoObjectIdCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"definition", InfoObjectDefnCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"filters",	   InfoObjectFiltersCmd,    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	   InfoObjectForwardCmd,    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"isa",	   InfoObjectIsACmd,	    TclCompileInfoObjectIsACmd, NULL, NULL, 0},
    {"methods",	   InfoObjectMethodsCmd,    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
    {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * List of commands that are used to implement the [info class] subcommands.
 */
76
77
78
79
80
81
82
83

84
85
86
87
88
89
90
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92







-
+







    {"forward",	     InfoClassForwardCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"instances",    InfoClassInstancesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"methods",	     InfoClassMethodsCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype",   InfoClassMethodTypeCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	     InfoClassMixinsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"subclasses",   InfoClassSubsCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"superclasses", InfoClassSupersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"variables",    InfoClassVariablesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"variables",    InfoClassVariablesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * ----------------------------------------------------------------------
 *
 * TclOOInitInfo --
513
514
515
516
517
518
519
520

521
522
523
524
525

526
527
528








529
530
531
532
533
534
535
515
516
517
518
519
520
521

522
523
524
525
526

527
528
529

530
531
532
533
534
535
536
537
538
539
540
541
542
543
544







-
+




-
+


-
+
+
+
+
+
+
+
+







InfoObjectMethodsCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    int flag = PUBLIC_METHOD, recurse = 0;
    int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
    FOREACH_HASH_DECLS;
    Tcl_Obj *namePtr, *resultObj;
    Method *mPtr;
    static const char *const options[] = {
	"-all", "-localprivate", "-private", NULL
	"-all", "-localprivate", "-private", "-scope", NULL
    };
    enum Options {
	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
    };
    static const char *const scopes[] = {
	"private", "public", "unexported"
    };
    enum Scopes {
	SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED,
	SCOPE_LOCALPRIVATE
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-option value ...?");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
549
550
551
552
553
554
555
556







557
558

























559
560
561
562
563
564


565
566
567
568
569
570
571
572
573
574
575

576
577
578
579
580
581
582
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572


573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602

603
604
605
606
607
608
609
610
611
612
613
614

615
616
617
618
619
620
621
622








+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+
+










-
+







		recurse = 1;
		break;
	    case OPT_LOCALPRIVATE:
		flag = PRIVATE_METHOD;
		break;
	    case OPT_PRIVATE:
		flag = 0;
		break;
	    case OPT_SCOPE:
		if (++i >= objc) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "missing option for -scope"));
		    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
			    NULL);
		    return TCL_ERROR;
	    }
	}
		}
		if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
			&scope) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    }
	}
    }
    if (scope != -1) {
	recurse = 0;
	switch (scope) {
	case SCOPE_PRIVATE:
	    flag = TRUE_PRIVATE_METHOD;
	    break;
	case SCOPE_PUBLIC:
	    flag = PUBLIC_METHOD;
	    break;
	case SCOPE_LOCALPRIVATE:
	    flag = PRIVATE_METHOD;
	    break;
	case SCOPE_UNEXPORTED:
	    flag = 0;
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    if (recurse) {
	const char **names;
	int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names);
	int i, numNames = TclOOGetSortedMethodList(oPtr, NULL, NULL, flag,
		&names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    ckfree(names);
	}
    } else if (oPtr->methodsPtr) {
	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
	    if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
	    }
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
680
681
682
683
684
685
686
































687
688
689
690
691
692
693
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectIdCmd --
 *
 *	Implements [info object creationid $objName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectIdCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->creationEpoch));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectNsCmd --
 *
 *	Implements [info object namespace $objName]
 *
 * ----------------------------------------------------------------------
 */

715
716
717
718
719
720
721
722

723
724
725
726
727
728
729
730
731
732
733
734
735
736


737
738
739


740






741
742
743
744
745
746
747









748
749



750
751
752
753
754
755
756
787
788
789
790
791
792
793

794
795
796
797
798
799
800
801
802
803
804
805
806


807
808
809


810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834


835
836
837
838
839
840
841
842
843
844







-
+












-
-
+
+

-
-
+
+

+
+
+
+
+
+







+
+
+
+
+
+
+
+
+
-
-
+
+
+







}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectVariablesCmd --
 *
 *	Implements [info object variables $objName]
 *	Implements [info object variables $objName ?-private?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectVariablesCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_Obj *variableObj, *resultObj;
    int i;
    Tcl_Obj *resultObj;
    int i, private = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
	    return TCL_ERROR;
	}
	private = 1;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    if (private) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

    FOREACH(variableObj, oPtr->variables) {
	Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	FOREACH(variableObj, oPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
1124
1125
1126
1127
1128
1129
1130
1131

1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143

1144
1145
1146
1147
1148

1149
1150
1151







1152
1153
1154
1155
1156
1157
1158
1212
1213
1214
1215
1216
1217
1218

1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230

1231
1232
1233
1234
1235

1236
1237
1238

1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252







-
+











-
+




-
+


-
+
+
+
+
+
+
+







}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassMethodsCmd --
 *
 *	Implements [info class methods $clsName ?-private?]
 *	Implements [info class methods $clsName ?options...?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassMethodsCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int flag = PUBLIC_METHOD, recurse = 0;
    int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
    Tcl_Obj *namePtr, *resultObj;
    Method *mPtr;
    Class *clsPtr;
    static const char *const options[] = {
	"-all", "-localprivate", "-private", NULL
	"-all", "-localprivate", "-private", "-scope", NULL
    };
    enum Options {
	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
    };
    static const char *const scopes[] = {
	"private", "public", "unexported"
    };
    enum Scopes {
	SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-option value ...?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
1172
1173
1174
1175
1176
1177
1178
1179







1180
1181






















1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200

1201
1202
1203
1204
1205
1206
1207
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280


1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320

1321
1322
1323
1324
1325
1326
1327
1328








+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-
+







		recurse = 1;
		break;
	    case OPT_LOCALPRIVATE:
		flag = PRIVATE_METHOD;
		break;
	    case OPT_PRIVATE:
		flag = 0;
		break;
	    case OPT_SCOPE:
		if (++i >= objc) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "missing option for -scope"));
		    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
			    NULL);
		    return TCL_ERROR;
	    }
	}
		}
		if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
			&scope) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    }
	}
    }
    if (scope != -1) {
	recurse = 0;
	switch (scope) {
	case SCOPE_PRIVATE:
	    flag = TRUE_PRIVATE_METHOD;
	    break;
	case SCOPE_PUBLIC:
	    flag = PUBLIC_METHOD;
	    break;
	case SCOPE_UNEXPORTED:
	    flag = 0;
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    if (recurse) {
	const char **names;
	int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    ckfree(names);
	}
    } else {
	FOREACH_HASH_DECLS;

	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
	    if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
	    }
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
1395
1396
1397
1398
1399
1400
1401
1402

1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416


1417
1418
1419


1420






1421
1422
1423
1424
1425
1426
1427









1428
1429



1430
1431
1432
1433
1434
1435
1436
1516
1517
1518
1519
1520
1521
1522

1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535


1536
1537
1538


1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563


1564
1565
1566
1567
1568
1569
1570
1571
1572
1573







-
+












-
-
+
+

-
-
+
+

+
+
+
+
+
+







+
+
+
+
+
+
+
+
+
-
-
+
+
+







}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassVariablesCmd --
 *
 *	Implements [info class variables $clsName]
 *	Implements [info class variables $clsName ?-private?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassVariablesCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr;
    Tcl_Obj *variableObj, *resultObj;
    int i;
    Tcl_Obj *resultObj;
    int i, private = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
	    return TCL_ERROR;
	}
	private = 1;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    if (private) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

    FOREACH(variableObj, clsPtr->variables) {
	Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	FOREACH(variableObj, clsPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
1461
1462
1463
1464
1465
1466
1467
1468


1469
1470
1471
1472
1473
1474
1475
1598
1599
1600
1601
1602
1603
1604

1605
1606
1607
1608
1609
1610
1611
1612
1613







-
+
+







	return TCL_ERROR;
    }

    /*
     * Get the call context and render its call chain.
     */

    contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL);
    contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL,
	    NULL);
    if (contextPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot construct any call chain", -1));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
	    TclOORenderCallChain(interp, contextPtr->callPtr));

Changes to generic/tclOOInt.h.

120
121
122
123
124
125
126












127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143







144
145
146
147
148
149
150
120
121
122
123
124
125
126
127
128
129
130
131
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
161
162
163
164
165
166
167
168
169







+
+
+
+
+
+
+
+
+
+
+
+

















+
+
+
+
+
+
+








typedef struct ForwardMethod {
    Tcl_Obj *prefixObj;		/* The list of values to use to replace the
				 * object and method name with. Will be a
				 * non-empty list. */
} ForwardMethod;

/*
 * Structure used in private variable mappings. Describes the mapping of a
 * single variable from the user's local name to the system's storage name.
 * [TIP #500]
 */

typedef struct {
    Tcl_Obj *variableObj;	/* Name used within methods. This is the part
				 * that is properly under user control. */
    Tcl_Obj *fullNameObj;	/* Name used at the instance namespace level. */
} PrivateVariableMapping;

/*
 * Helper definitions that declare a "list" array. The two varieties are
 * either optimized for simplicity (in the case that the whole array is
 * typically assigned at once) or efficiency (in the case that the array is
 * expected to be expanded over time). These lists are designed to be iterated
 * over with the help of the FOREACH macro (see later in this file).
 *
 * The "num" field always counts the number of listType_t elements used in the
 * "list" field. When a "size" field exists, it describes how many elements
 * are present in the list; when absent, exactly "num" elements are present.
 */

#define LIST_STATIC(listType_t) \
    struct { int num; listType_t *list; }
#define LIST_DYNAMIC(listType_t) \
    struct { int num, size; listType_t *list; }

/*
 * These types are needed in function arguments.
 */

typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;

/*
 * Now, the definition of what an object actually is.
 */

typedef struct Object {
    struct Foundation *fPtr;	/* The basis for the object system. Putting
				 * this here allows the avoidance of quite a
182
183
184
185
186
187
188
189






190
191
192
193
194
195
196
197
198




199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215








216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
201
202
203
204
205
206
207

208
209
210
211
212
213
214
215
216
217
218
219



220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257




258
259
260
261
262
263
264







-
+
+
+
+
+
+






-
-
-
+
+
+
+

















+
+
+
+
+
+
+
+









-
-
-
-







				 * allocated if metadata is attached. */
    Tcl_Obj *cachedNameObj;	/* Cache of the name of the object. */
    Tcl_HashTable *chainCache;	/* Place to keep unused contexts. This table
				 * is indexed by method name as Tcl_Obj. */
    Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
				/* Function to allow remapping of method
				 * names. For itcl-ng. */
    LIST_STATIC(Tcl_Obj *) variables;
    VariableNameList variables;
    PrivateVariableList privateVariables;
				/* Configurations for the variable resolver
				 * used inside methods. */
    Tcl_Command myclassCommand;	/* Reference to this object's class dispatcher
				 * command. */
} Object;

#define OBJECT_DELETED	1	/* Flag to say that an object has been
				 * destroyed. */
#define DESTRUCTOR_CALLED 2	/* Flag to say that the destructor has been
				 * called. */
#define CLASS_GONE	4	/* Indicates that the class of this object has
				 * been deleted, and so the object should not
				 * attempt to remove itself from its class. */
#define CLASS_GONE	4	/* Obsolete. Indicates that the class of this
				 * object has been deleted, and so the object
				 * should not attempt to remove itself from its
				 * class. */
#define 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; 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
				 * 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
				 * 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
				 * unknown method handler at that point. */
#define HAS_PRIVATE_METHODS 0x20000
				/* Object/class has (or had) private methods,
				 * and so shouldn't be cached so
				 * aggressively. */
#define DONT_DELETE 0x40000	/* 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. */

/*
 * And the definition of a class. Note that every class also has an associated
 * object, through which it is manipulated.
 */

typedef struct Class {
    Object *thisPtr;		/* Reference to the object associated with
				 * this class. */
    int refCount;		/* Number of strong references to this class.
				 * Weak references are not counted; the
				 * purpose of this is to avoid Tcl_Preserve as
				 * that is quite slow. */
    int flags;			/* Assorted flags. */
    LIST_STATIC(struct Class *) superclasses;
				/* List of superclasses, used for generation
				 * of method call chains. */
    LIST_DYNAMIC(struct Class *) subclasses;
				/* List of subclasses, used to ensure deletion
				 * of dependent entities happens properly when
267
268
269
270
271
272
273
274




275
276
277
278
279
280
281
296
297
298
299
300
301
302

303
304
305
306
307
308
309
310
311
312
313







-
+
+
+
+







				/* Places where call chains are stored. For
				 * constructors, the class chain is always
				 * used. For destructors and ordinary methods,
				 * the class chain is only used when the
				 * object doesn't override with its own mixins
				 * (and filters and method implementations for
				 * when getting method chains). */
    LIST_STATIC(Tcl_Obj *) variables;
    VariableNameList variables;
    PrivateVariableList privateVariables;
				/* Configurations for the variable resolver
				 * used inside methods. */
} Class;

/*
 * The foundation of the object system within an interpreter contains
 * references to the key classes and namespaces, together with a few other
 * useful bits and pieces. Probably ought to eventually go in the Interp
 * structure itself.
369
370
371
372
373
374
375
376

377
378
379





380
381
382
383
384
385
386
401
402
403
404
405
406
407

408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423







-
+



+
+
+
+
+








/*
 * 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
				 * only) method. */
				 * 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
				 * from other methods defined on this class
				 * or instance. [TIP #500] */
#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)

/*
 * Structure containing definition information about basic class methods.
 */

typedef struct {
    const char *name;		/* Name of the method in question. */
429
430
431
432
433
434
435



436
437
438
439
440
441
442
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482







+
+
+







			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineObjSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefinePrivateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOCopyObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
486
487
488
489
490
491
492


493
494
495
496
497





498
499
500
501


502
503
504

505
506
507
508
509
510
511
512
513
514


515
516
517
518
519
520
521
522
523
524
525
526


527
528



529
530

531
532
533
534
535
536
537
538
539
540
541
542
543
544






545
546

547
548
549
550
551
552
553
554
555



556










557
558
559
560
561
562

563
564
565
566
567
568
569
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563

564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579


580
581
582
583

584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605

606





607
608
609
610
611
612
613

614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637







+
+





+
+
+
+
+




+
+



+









-
+
+












+
+
-
-
+
+
+

-
+














+
+
+
+
+
+

-
+
-
-
-
-
-




+
+
+
-
+
+
+
+
+
+
+
+
+
+






+







 * Private definitions, some of which perhaps ought to be exposed properly or
 * maybe just put in the internal stubs table.
 */

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	TclNRNewObjectInstance(Tcl_Interp *interp,
			    Tcl_Class cls, const char *nameStr,
			    const char *nsNameStr, int objc,
			    Tcl_Obj *const *objv, int skip,
			    Tcl_Object *objectPtr);
MODULE_SCOPE Object *	TclNewObjectInstanceCommon(Tcl_Interp *interp,
			    Class *classPtr,
			    const char *nameStr,
			    const char *nsNameStr);
MODULE_SCOPE int	TclOODecrRefCount(Object *oPtr);
MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE void	TclOODeleteDescendants(Tcl_Interp *interp,
			    Object *oPtr);
MODULE_SCOPE void	TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
			    Tcl_Obj *methodNameObj, int flags,
			    Object *contextObjPtr, Class *contextClsPtr,
			    Tcl_Obj *cacheInThisObj);
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
			    Tcl_Obj *methodNameObj, int flags);
MODULE_SCOPE Foundation	*TclOOGetFoundation(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclOOGetFwdFromMethod(Method *mPtr);
MODULE_SCOPE Proc *	TclOOGetProcFromMethod(Method *mPtr);
MODULE_SCOPE Tcl_Obj *	TclOOGetMethodBody(Method *mPtr);
MODULE_SCOPE int	TclOOGetSortedClassMethodList(Class *clsPtr,
			    int flags, const char ***stringsPtr);
MODULE_SCOPE int	TclOOGetSortedMethodList(Object *oPtr, int flags,
MODULE_SCOPE int	TclOOGetSortedMethodList(Object *oPtr,
			    Object *contextObj, Class *contextCls, int flags,
			    const char ***stringsPtr);
MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE void	TclOOInitInfo(Tcl_Interp *interp);
MODULE_SCOPE int	TclOOInvokeContext(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
			    Tcl_ObjectContext context, int objc,
			    Tcl_Obj *const *objv, int skip);
MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
			    const DeclaredClassMethod *dcm);
MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void	TclOOReleaseClassContents(Tcl_Interp *interp,
			    Object *oPtr);
MODULE_SCOPE void	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void	TclOORemoveFromMixinSubs(Class *subPtr,
MODULE_SCOPE int	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE int	TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr);
MODULE_SCOPE int	TclOORemoveFromMixinSubs(Class *subPtr,
			    Class *mixinPtr);
MODULE_SCOPE void	TclOORemoveFromSubclasses(Class *subPtr,
MODULE_SCOPE int	TclOORemoveFromSubclasses(Class *subPtr,
			    Class *superPtr);
MODULE_SCOPE Tcl_Obj *	TclOORenderCallChain(Tcl_Interp *interp,
			    CallChain *callPtr);
MODULE_SCOPE void	TclOOStashContext(Tcl_Obj *objPtr,
			    CallContext *contextPtr);
MODULE_SCOPE void	TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);

/*
 * Include all the private API, generated from tclOO.decls.
 */

#include "tclOOIntDecls.h"

/*
 * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
 */

#define AddRef(ptr) ((ptr)->refCount++)

/*
 * A convenience macro for iterating through the lists used in the internal
 * memory management of objects. This is a bit gnarly because we want to do
 * memory management of objects.
 * the assignment of the picked-out value only when the body test succeeds,
 * but we cannot rely on the assigned value being useful, forcing us to do
 * some nasty stuff with the comma operator. The compiler's optimizer should
 * be able to sort it all out!
 *
 * REQUIRES DECLARATION: int i;
 */

#define FOREACH(var,ary) \
    for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
	continue; \
    } else if (var = (ary).list[i], 1)
	for(i=0 ; (i<(ary).num?((var=(ary).list[i]),1):0) ; i++)

/*
 * A variation where the array is an array of structs. There's no issue with
 * possible NULLs; every element of the array will be iterated over and the
 * varable set to a pointer to each of those elements in turn.
 * REQUIRES DECLARATION: int i;
 */

#define FOREACH_STRUCT(var,ary) \
    for(i=0 ; var=&((ary).list[i]), i<(ary).num; i++)

/*
 * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
 * sets up the declarations needed for the main macro, FOREACH_HASH, which
 * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
 * only iterates over values.
 * REQUIRES DECLARATION: FOREACH_HASH_DECLS;
 */

#define FOREACH_HASH_DECLS \
    Tcl_HashEntry *hPtr;Tcl_HashSearch search
#define FOREACH_HASH(key,val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
	    ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
650
651
652
653
654
655
656











657
658
659
660
661
662
663
664
665
666
667







-
-
-
-
-
-
-
-
-
-
-











    do { \
	register unsigned len = sizeof(type) * ((target).num=(source).num);\
	if (len != 0) { \
	    memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \
	} else { \
	    (target).list = NULL; \
	} \
    } while(0)

/*
 * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
 */

#define AddRef(ptr) ((ptr)->refCount++)
#define DelRef(ptr) do {			\
	if ((ptr)->refCount-- <= 1) {		\
	    ckfree(ptr);			\
	}					\
    } while(0)

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

Changes to generic/tclOOMethod.c.

182
183
184
185
186
187
188
189





190
191
192
193
194
195
196
182
183
184
185
186
187
188

189
190
191
192
193
194
195
196
197
198
199
200







-
+
+
+
+
+







  populate:
    mPtr->typePtr = typePtr;
    mPtr->clientData = clientData;
    mPtr->flags = 0;
    mPtr->declaringObjectPtr = oPtr;
    mPtr->declaringClassPtr = NULL;
    if (flags) {
	mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
	mPtr->flags |= flags &
		(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
	if (flags & TRUE_PRIVATE_METHOD) {
	    oPtr->flags |= HAS_PRIVATE_METHODS;
	}
    }
    oPtr->epoch++;
    return (Tcl_Method) mPtr;
}

/*
 * ----------------------------------------------------------------------
246
247
248
249
250
251
252
253





254
255
256
257
258
259
260
250
251
252
253
254
255
256

257
258
259
260
261
262
263
264
265
266
267
268







-
+
+
+
+
+







    clsPtr->thisPtr->fPtr->epoch++;
    mPtr->typePtr = typePtr;
    mPtr->clientData = clientData;
    mPtr->flags = 0;
    mPtr->declaringObjectPtr = NULL;
    mPtr->declaringClassPtr = clsPtr;
    if (flags) {
	mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
	mPtr->flags |= flags &
		(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
	if (flags & TRUE_PRIVATE_METHOD) {
	    clsPtr->flags |= HAS_PRIVATE_METHODS;
	}
    }

    return (Tcl_Method) mPtr;
}

/*
 * ----------------------------------------------------------------------
924
925
926
927
928
929
930
931

932
933
934
935
936
937
938
932
933
934
935
936
937
938

939
940
941
942
943
944
945
946







-
+







 *
 * TclOOSetupVariableResolver, etc. --
 *
 *	Variable resolution engine used to connect declared variables to local
 *	variables used in methods. The compiled variable resolver is more
 *	important, but both are needed as it is possible to have a variable
 *	that is only referred to in ways that aren't compilable and we can't
 *	force LVT presence. [TIP #320]
 *	force LVT presence. [TIP #320, #500]
 *
 * ----------------------------------------------------------------------
 */

void
TclOOSetupVariableResolver(
    Tcl_Namespace *nsPtr)
982
983
984
985
986
987
988

989
990
991
992
993
994
995
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004







+







    Tcl_ResolvedVarInfo *rPtr)
{
    OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr;
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    CallContext *contextPtr;
    Tcl_Obj *variableObj;
    PrivateVariableMapping *privateVar;
    Tcl_HashEntry *hPtr;
    int i, isNew, cacheIt, varLen, len;
    const char *match, *varName;

    /*
     * Check that the variable is being requested in a context that is also a
     * method call; if not (i.e. we're evaluating in the object's namespace or
1015
1016
1017
1018
1019
1020
1021









1022
1023
1024
1025
1026
1027
1028
1029
1030








1031
1032
1033
1034
1035
1036
1037
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063







+
+
+
+
+
+
+
+
+









+
+
+
+
+
+
+
+







     * is in the list provided by the user). If not, we mustn't do anything
     * either.
     */

    varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
    if (contextPtr->callPtr->chain[contextPtr->index]
	    .mPtr->declaringClassPtr != NULL) {
	FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
		.mPtr->declaringClassPtr->privateVariables) {
	    match = TclGetStringFromObj(privateVar->variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		variableObj = privateVar->fullNameObj;
		cacheIt = 0;
		goto gotMatch;
	    }
	}
	FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
		.mPtr->declaringClassPtr->variables) {
	    match = TclGetStringFromObj(variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		cacheIt = 0;
		goto gotMatch;
	    }
	}
    } else {
	FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
	    match = TclGetStringFromObj(privateVar->variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		variableObj = privateVar->fullNameObj;
		cacheIt = 1;
		goto gotMatch;
	    }
	}
	FOREACH(variableObj, contextPtr->oPtr->variables) {
	    match = TclGetStringFromObj(variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		cacheIt = 1;
		goto gotMatch;
	    }
	}
1669
1670
1671
1672
1673
1674
1675







1676
1677
1678
1679
1680
1681
1682
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715







+
+
+
+
+
+
+








int
Tcl_MethodIsPublic(
    Tcl_Method method)
{
    return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
}

int
Tcl_MethodIsPrivate(
    Tcl_Method method)
{
    return (((Method *)method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0;
}

/*
 * Extended method construction for itcl-ng.
 */

Tcl_Method
TclOONewProcInstanceMethodEx(

Added generic/tclOOScript.h.








































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * tclOOScript.h --
 *
 *	This file contains support scripts for TclOO. They are defined here so
 *	that the code can be definitely run even in safe interpreters; TclOO's
 *	core setup is safe.
 *
 * Copyright (c) 2012-2018 Donal K. Fellows
 * Copyright (c) 2013 Andreas Kupries
 * Copyright (c) 2017 Gerald Lester
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef TCL_OO_SCRIPT_H
#define TCL_OO_SCRIPT_H

/*
 * The scripted part of the definitions of TclOO.
 *
 * Compiled from generic/tclOOScript.tcl by tools/makeHeader.tcl, which
 * contains the commented version of everything; *this* file is automatically
 * generated.
 */

static const char *tclOOSetupScript =
/* !BEGIN!: Do not edit below this line. */
"::namespace eval ::oo {\n"
"\t::namespace path {}\n"
"\tnamespace eval Helpers {\n"
"\t\t::namespace path {}\n"
"\t\tproc callback {method args} {\n"
"\t\t\tlist [uplevel 1 {::namespace which my}] $method {*}$args\n"
"\t\t}\n"
"\t\tnamespace export callback\n"
"\t\tnamespace eval tmp {namespace import ::oo::Helpers::callback}\n"
"\t\tnamespace export -clear\n"
"\t\trename tmp::callback mymethod\n"
"\t\tnamespace delete tmp\n"
"\t\tproc classvariable {name args} {\n"
"\t\t\tset ns [info object namespace [uplevel 1 {self class}]]\n"
"\t\t\tforeach v [list $name {*}$args] {\n"
"\t\t\t\tif {[string match *(*) $v]} {\n"
"\t\t\t\t\tset reason \"can\'t create a scalar variable that looks like an array element\"\n"
"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \\\n"
"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
"\t\t\t\t}\n"
"\t\t\t\tif {[string match *::* $v]} {\n"
"\t\t\t\t\tset reason \"can\'t create a local variable with a namespace separator in it\"\n"
"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR INVERTED} \\\n"
"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
"\t\t\t\t}\n"
"\t\t\t\tlappend vs $v $v\n"
"\t\t\t}\n"
"\t\t\ttailcall namespace upvar $ns {*}$vs\n"
"\t\t}\n"
"\t\tproc link {args} {\n"
"\t\t\tset ns [uplevel 1 {::namespace current}]\n"
"\t\t\tforeach link $args {\n"
"\t\t\t\tif {[llength $link] == 2} {\n"
"\t\t\t\t\tlassign $link src dst\n"
"\t\t\t\t} elseif {[llength $link] == 1} {\n"
"\t\t\t\t\tlassign $link src\n"
"\t\t\t\t\tset dst $src\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\treturn -code error -errorcode {TCLOO CMDLINK FORMAT} \\\n"
"\t\t\t\t\t\t\"bad link description; must only have one or two elements\"\n"
"\t\t\t\t}\n"
"\t\t\t\tif {![string match ::* $src]} {\n"
"\t\t\t\t\tset src [string cat $ns :: $src]\n"
"\t\t\t\t}\n"
"\t\t\t\tinterp alias {} $src {} ${ns}::my $dst\n"
"\t\t\t\ttrace add command ${ns}::my delete [list \\\n"
"\t\t\t\t\t::oo::UnlinkLinkedCommand $src]\n"
"\t\t\t}\n"
"\t\t\treturn\n"
"\t\t}\n"
"\t}\n"
"\tproc UnlinkLinkedCommand {cmd args} {\n"
"\t\tif {[namespace which $cmd] ne {}} {\n"
"\t\t\trename $cmd {}\n"
"\t\t}\n"
"\t}\n"
"\tproc DelegateName {class} {\n"
"\t\tstring cat [info object namespace $class] {:: oo ::delegate}\n"
"\t}\n"
"\tproc MixinClassDelegates {class} {\n"
"\t\tif {![info object isa class $class]} {\n"
"\t\t\treturn\n"
"\t\t}\n"
"\t\tset delegate [DelegateName $class]\n"
"\t\tif {![info object isa class $delegate]} {\n"
"\t\t\treturn\n"
"\t\t}\n"
"\t\tforeach c [info class superclass $class] {\n"
"\t\t\tset d [DelegateName $c]\n"
"\t\t\tif {![info object isa class $d]} {\n"
"\t\t\t\tcontinue\n"
"\t\t\t}\n"
"\t\t\tdefine $delegate superclass -append $d\n"
"\t\t}\n"
"\t\tobjdefine $class mixin -append $delegate\n"
"\t}\n"
"\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
"\t\tset originDelegate [DelegateName $originObject]\n"
"\t\tset targetDelegate [DelegateName $targetObject]\n"
"\t\tif {\n"
"\t\t\t[info object isa class $originDelegate]\n"
"\t\t\t&& ![info object isa class $targetDelegate]\n"
"\t\t} then {\n"
"\t\t\tcopy $originDelegate $targetDelegate\n"
"\t\t\tobjdefine $targetObject mixin -set \\\n"
"\t\t\t\t{*}[lmap c [info object mixin $targetObject] {\n"
"\t\t\t\t\tif {$c eq $originDelegate} {set targetDelegate} {set c}\n"
"\t\t\t\t}]\n"
"\t\t}\n"
"\t}\n"
"\tproc define::classmethod {name {args {}} {body {}}} {\n"
"\t\t::set argc [::llength [::info level 0]]\n"
"\t\t::if {$argc == 3} {\n"
"\t\t\t::return -code error -errorcode {TCL WRONGARGS} [::format \\\n"
"\t\t\t\t{wrong # args: should be \"%s name \?args body\?\"} \\\n"
"\t\t\t\t[::lindex [::info level 0] 0]]\n"
"\t\t}\n"
"\t\t::set cls [::uplevel 1 self]\n"
"\t\t::if {$argc == 4} {\n"
"\t\t\t::oo::define [::oo::DelegateName $cls] method $name $args $body\n"
"\t\t}\n"
"\t\t::tailcall forward $name myclass $name\n"
"\t}\n"
"\tproc define::initialise {body} {\n"
"\t\t::set clsns [::info object namespace [::uplevel 1 self]]\n"
"\t\t::tailcall apply [::list {} $body $clsns]\n"
"\t}\n"
"\tnamespace eval define {\n"
"\t\t::namespace export initialise\n"
"\t\t::namespace eval tmp {::namespace import ::oo::define::initialise}\n"
"\t\t::namespace export -clear\n"
"\t\t::rename tmp::initialise initialize\n"
"\t\t::namespace delete tmp\n"
"\t}\n"
"\tdefine Slot {\n"
"\t\tmethod Get {} {\n"
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
"\t\t}\n"
"\t\tmethod Set list {\n"
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
"\t\t}\n"
"\t\tmethod Resolve list {\n"
"\t\t\treturn $list\n"
"\t\t}\n"
"\t\tmethod -set args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\ttailcall my Set $args\n"
"\t\t}\n"
"\t\tmethod -append args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
"\t\t}\n"
"\t\tmethod -clear {} {tailcall my Set {}}\n"
"\t\tmethod -prepend args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
"\t\t}\n"
"\t\tmethod -remove args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [lmap val $current {\n"
"\t\t\t\tif {$val in $args} continue else {set val}\n"
"\t\t\t}]\n"
"\t\t}\n"
"\t\tforward --default-operation my -append\n"
"\t\tmethod unknown {args} {\n"
"\t\t\tset def --default-operation\n"
"\t\t\tif {[llength $args] == 0} {\n"
"\t\t\t\ttailcall my $def\n"
"\t\t\t} elseif {![string match -* [lindex $args 0]]} {\n"
"\t\t\t\ttailcall my $def {*}$args\n"
"\t\t\t}\n"
"\t\t\tnext {*}$args\n"
"\t\t}\n"
"\t\texport -set -append -clear -prepend -remove\n"
"\t\tunexport unknown destroy\n"
"\t}\n"
"\tobjdefine define::superclass forward --default-operation my -set\n"
"\tobjdefine define::mixin forward --default-operation my -set\n"
"\tobjdefine objdefine::mixin forward --default-operation my -set\n"
"\tdefine object method <cloned> {originObject} {\n"
"\t\tforeach p [info procs [info object namespace $originObject]::*] {\n"
"\t\t\tset args [info args $p]\n"
"\t\t\tset idx -1\n"
"\t\t\tforeach a $args {\n"
"\t\t\t\tif {[info default $p $a d]} {\n"
"\t\t\t\t\tlset args [incr idx] [list $a $d]\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\tlset args [incr idx] [list $a]\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\tset b [info body $p]\n"
"\t\t\tset p [namespace tail $p]\n"
"\t\t\tproc $p $args $b\n"
"\t\t}\n"
"\t\tforeach v [info vars [info object namespace $originObject]::*] {\n"
"\t\t\tupvar 0 $v vOrigin\n"
"\t\t\tnamespace upvar [namespace current] [namespace tail $v] vNew\n"
"\t\t\tif {[info exists vOrigin]} {\n"
"\t\t\t\tif {[array exists vOrigin]} {\n"
"\t\t\t\t\tarray set vNew [array get vOrigin]\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\tset vNew $vOrigin\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t}\n"
"\t}\n"
"\tdefine class method <cloned> {originObject} {\n"
"\t\tnext $originObject\n"
"\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
"\t}\n"
"\tclass create singleton {\n"
"\t\tsuperclass class\n"
"\t\tvariable object\n"
"\t\tunexport create createWithNamespace\n"
"\t\tmethod new args {\n"
"\t\t\tif {![info exists object] || ![info object isa object $object]} {\n"
"\t\t\t\tset object [next {*}$args]\n"
"\t\t\t\t::oo::objdefine $object {\n"
"\t\t\t\t\tmethod destroy {} {\n"
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
"\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t\tmethod <cloned> {originObject} {\n"
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
"\t\t\t\t\t\t\t\"may not clone a singleton object\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\treturn $object\n"
"\t\t}\n"
"\t}\n"
"\tclass create abstract {\n"
"\t\tsuperclass class\n"
"\t\tunexport create createWithNamespace new\n"
"\t}\n"
"}\n"
/* !END!: Do not edit above this line. */
;

#endif /* TCL_OO_SCRIPT_H */

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

Added generic/tclOOScript.tcl.









































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# tclOOScript.h --
#
# 	This file contains support scripts for TclOO. They are defined here so
# 	that the code can be definitely run even in safe interpreters; TclOO's
# 	core setup is safe.
#
# Copyright (c) 2012-2018 Donal K. Fellows
# Copyright (c) 2013 Andreas Kupries
# Copyright (c) 2017 Gerald Lester
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

::namespace eval ::oo {
    ::namespace path {}

    #
    # Commands that are made available to objects by default.
    #
    namespace eval Helpers {
	::namespace path {}

	# ------------------------------------------------------------------
	#
	# callback, mymethod --
	#
	#	Create a script prefix that calls a method on the current
	#	object. Same operation, two names.
	#
	# ------------------------------------------------------------------

	proc callback {method args} {
	    list [uplevel 1 {::namespace which my}] $method {*}$args
	}

	# Make the [callback] command appear as [mymethod] too.
	namespace export callback
	namespace eval tmp {namespace import ::oo::Helpers::callback}
	namespace export -clear
	rename tmp::callback mymethod
	namespace delete tmp

	# ------------------------------------------------------------------
	#
	# classvariable --
	#
	#	Link to a variable in the class of the current object.
	#
	# ------------------------------------------------------------------

	proc classvariable {name args} {
	    # Get a reference to the class's namespace
	    set ns [info object namespace [uplevel 1 {self class}]]
	    # Double up the list of variable names
	    foreach v [list $name {*}$args] {
		if {[string match *(*) $v]} {
		    set reason "can't create a scalar variable that looks like an array element"
		    return -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \
			[format {bad variable name "%s": %s} $v $reason]
		}
		if {[string match *::* $v]} {
		    set reason "can't create a local variable with a namespace separator in it"
		    return -code error -errorcode {TCL UPVAR INVERTED} \
			[format {bad variable name "%s": %s} $v $reason]
		}
		lappend vs $v $v
	    }
	    # Lastly, link the caller's local variables to the class's variables
	    tailcall namespace upvar $ns {*}$vs
	}

	# ------------------------------------------------------------------
	#
	# link --
	#
	#	Make a command that invokes a method on the current object.
	#	The name of the command and the name of the method match by
	#	default.
	#
	# ------------------------------------------------------------------

	proc link {args} {
	    set ns [uplevel 1 {::namespace current}]
	    foreach link $args {
		if {[llength $link] == 2} {
		    lassign $link src dst
		} elseif {[llength $link] == 1} {
		    lassign $link src
		    set dst $src
		} else {
		    return -code error -errorcode {TCLOO CMDLINK FORMAT} \
			"bad link description; must only have one or two elements"
		}
		if {![string match ::* $src]} {
		    set src [string cat $ns :: $src]
		}
		interp alias {} $src {} ${ns}::my $dst
		trace add command ${ns}::my delete [list \
		    ::oo::UnlinkLinkedCommand $src]
	    }
	    return
	}
    }

    # ----------------------------------------------------------------------
    #
    # UnlinkLinkedCommand --
    #
    #	Callback used to remove linked command when the underlying mechanism
    #	that supports it is deleted.
    #
    # ----------------------------------------------------------------------

    proc UnlinkLinkedCommand {cmd args} {
	if {[namespace which $cmd] ne {}} {
	    rename $cmd {}
	}
    }

    # ----------------------------------------------------------------------
    #
    # DelegateName --
    #
    #	Utility that gets the name of the class delegate for a class. It's
    #	trivial, but makes working with them much easier as delegate names are
    #	intentionally hard to create by accident.
    #
    # ----------------------------------------------------------------------

    proc DelegateName {class} {
	string cat [info object namespace $class] {:: oo ::delegate}
    }

    # ----------------------------------------------------------------------
    #
    # MixinClassDelegates --
    #
    #	Support code called *after* [oo::define] inside the constructor of a
    #	class that patches in the appropriate class delegates.
    #
    # ----------------------------------------------------------------------

    proc MixinClassDelegates {class} {
	if {![info object isa class $class]} {
	    return
	}
	set delegate [DelegateName $class]
	if {![info object isa class $delegate]} {
	    return
	}
	foreach c [info class superclass $class] {
	    set d [DelegateName $c]
	    if {![info object isa class $d]} {
		continue
	    }
	    define $delegate superclass -append $d
	}
	objdefine $class mixin -append $delegate
    }

    # ----------------------------------------------------------------------
    #
    # UpdateClassDelegatesAfterClone --
    #
    #	Support code that is like [MixinClassDelegates] except for when a
    #	class is cloned.
    #
    # ----------------------------------------------------------------------

    proc UpdateClassDelegatesAfterClone {originObject targetObject} {
	# Rebuild the class inheritance delegation class
	set originDelegate [DelegateName $originObject]
	set targetDelegate [DelegateName $targetObject]
	if {
	    [info object isa class $originDelegate]
	    && ![info object isa class $targetDelegate]
	} then {
	    copy $originDelegate $targetDelegate
	    objdefine $targetObject mixin -set \
		{*}[lmap c [info object mixin $targetObject] {
		    if {$c eq $originDelegate} {set targetDelegate} {set c}
		}]
	}
    }

    # ----------------------------------------------------------------------
    #
    # oo::define::classmethod --
    #
    #	Defines a class method. See define(n) for details.
    #
    # Note that the ::oo::define namespace is semi-public and a bit weird
    # anyway, so we don't regard the namespace path as being under control:
    # fully qualified names are used for everything.
    #
    # ----------------------------------------------------------------------

    proc define::classmethod {name {args {}} {body {}}} {
        # Create the method on the class if the caller gave arguments and body
        ::set argc [::llength [::info level 0]]
        ::if {$argc == 3} {
            ::return -code error -errorcode {TCL WRONGARGS} [::format \
		{wrong # args: should be "%s name ?args body?"} \
                [::lindex [::info level 0] 0]]
        }
        ::set cls [::uplevel 1 self]
        ::if {$argc == 4} {
            ::oo::define [::oo::DelegateName $cls] method $name $args $body
        }
        # Make the connection by forwarding
        ::tailcall forward $name myclass $name
    }

    # ----------------------------------------------------------------------
    #
    # oo::define::initialise, oo::define::initialize --
    #
    #	Do specific initialisation for a class. See define(n) for details.
    #
    # Note that the ::oo::define namespace is semi-public and a bit weird
    # anyway, so we don't regard the namespace path as being under control:
    # fully qualified names are used for everything.
    #
    # ----------------------------------------------------------------------

    proc define::initialise {body} {
        ::set clsns [::info object namespace [::uplevel 1 self]]
        ::tailcall apply [::list {} $body $clsns]
    }

    # Make the [initialise] definition appear as [initialize] too
    namespace eval define {
	::namespace export initialise
	::namespace eval tmp {::namespace import ::oo::define::initialise}
	::namespace export -clear
	::rename tmp::initialise initialize
	::namespace delete tmp
    }

    # ----------------------------------------------------------------------
    #
    # Slot --
    #
    #	The class of slot operations, which are basically lists at the low
    #	level of TclOO; this provides a more consistent interface to them.
    #
    # ----------------------------------------------------------------------

    define Slot {
	# ------------------------------------------------------------------
	#
	# Slot Get --
	#
	#	Basic slot getter. Retrieves the contents of the slot.
	#	Particular slots must provide concrete non-erroring
	#	implementation.
	#
	# ------------------------------------------------------------------

	method Get {} {
	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
	}

	# ------------------------------------------------------------------
	#
	# Slot Set --
	#
	#	Basic slot setter. Sets the contents of the slot.  Particular
	#	slots must provide concrete non-erroring implementation.
	#
	# ------------------------------------------------------------------

	method Set list {
	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
	}

	# ------------------------------------------------------------------
	#
	# Slot Resolve --
	#
	#	Helper that lets a slot convert a list of arguments of a
	#	particular type to their canonical forms. Defaults to doing
	#	nothing (suitable for simple strings).
	#
	# ------------------------------------------------------------------

	method Resolve list {
	    return $list
	}

	# ------------------------------------------------------------------
	#
	# Slot -set, -append, -clear, --default-operation --
	#
	#	Standard public slot operations. If a slot can't figure out
	#	what method to call directly, it uses --default-operation.
	#
	# ------------------------------------------------------------------

	method -set args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    tailcall my Set $args
	}
	method -append args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [list {*}$current {*}$args]
	}
	method -clear {} {tailcall my Set {}}
	method -prepend args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [list {*}$args {*}$current]
	}
	method -remove args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [lmap val $current {
		if {$val in $args} continue else {set val}
	    }]
	}

	# Default handling
	forward --default-operation my -append
	method unknown {args} {
	    set def --default-operation
	    if {[llength $args] == 0} {
		tailcall my $def
	    } elseif {![string match -* [lindex $args 0]]} {
		tailcall my $def {*}$args
	    }
	    next {*}$args
	}

	# Set up what is exported and what isn't
	export -set -append -clear -prepend -remove
	unexport unknown destroy
    }

    # Set the default operation differently for these slots
    objdefine define::superclass forward --default-operation my -set
    objdefine define::mixin forward --default-operation my -set
    objdefine objdefine::mixin forward --default-operation my -set

    # ----------------------------------------------------------------------
    #
    # oo::object <cloned> --
    #
    #	Handler for cloning objects that clones basic bits (only!) of the
    #	object's namespace. Non-procedures, traces, sub-namespaces, etc. need
    #	more complex (and class-specific) handling.
    #
    # ----------------------------------------------------------------------

    define object method <cloned> {originObject} {
	# Copy over the procedures from the original namespace
	foreach p [info procs [info object namespace $originObject]::*] {
	    set args [info args $p]
	    set idx -1
	    foreach a $args {
		if {[info default $p $a d]} {
		    lset args [incr idx] [list $a $d]
		} else {
		    lset args [incr idx] [list $a]
		}
	    }
	    set b [info body $p]
	    set p [namespace tail $p]
	    proc $p $args $b
	}
	# Copy over the variables from the original namespace
	foreach v [info vars [info object namespace $originObject]::*] {
	    upvar 0 $v vOrigin
	    namespace upvar [namespace current] [namespace tail $v] vNew
	    if {[info exists vOrigin]} {
		if {[array exists vOrigin]} {
		    array set vNew [array get vOrigin]
		} else {
		    set vNew $vOrigin
		}
	    }
	}
	# General commands, sub-namespaces and advancd variable config (traces,
	# etc) are *not* copied over. Classes that want that should do it
	# themselves.
    }

    # ----------------------------------------------------------------------
    #
    # oo::class <cloned> --
    #
    #	Handler for cloning classes, which fixes up the delegates.
    #
    # ----------------------------------------------------------------------

    define class method <cloned> {originObject} {
	next $originObject
	# Rebuild the class inheritance delegation class
	::oo::UpdateClassDelegatesAfterClone $originObject [self]
    }

    # ----------------------------------------------------------------------
    #
    # oo::singleton --
    #
    #	A metaclass that is used to make classes that only permit one instance
    #	of them to exist. See singleton(n).
    #
    # ----------------------------------------------------------------------

    class create singleton {
	superclass class
	variable object
	unexport create createWithNamespace
	method new args {
	    if {![info exists object] || ![info object isa object $object]} {
		set object [next {*}$args]
		::oo::objdefine $object {
		    method destroy {} {
			::return -code error -errorcode {TCLOO SINGLETON} \
			    "may not destroy a singleton object"
		    }
		    method <cloned> {originObject} {
			::return -code error -errorcode {TCLOO SINGLETON} \
			    "may not clone a singleton object"
		    }
		}
	    }
	    return $object
	}
    }

    # ----------------------------------------------------------------------
    #
    # oo::abstract --
    #
    #	A metaclass that is used to make classes that can't be directly
    #	instantiated. See abstract(n).
    #
    # ----------------------------------------------------------------------

    class create abstract {
	superclass class
	unexport create createWithNamespace new
    }
}

# Local Variables:
# mode: tcl
# c-basic-offset: 4
# fill-column: 78
# End:

Changes to generic/tclOOStubInit.c.

69
70
71
72
73
74
75

76
77
78
69
70
71
72
73
74
75
76
77
78
79







+



    Tcl_ObjectSetMetadata, /* 22 */
    Tcl_ObjectContextInvokeNext, /* 23 */
    Tcl_ObjectGetMethodNameMapper, /* 24 */
    Tcl_ObjectSetMethodNameMapper, /* 25 */
    Tcl_ClassSetConstructor, /* 26 */
    Tcl_ClassSetDestructor, /* 27 */
    Tcl_GetObjectName, /* 28 */
    Tcl_MethodIsPrivate, /* 29 */
};

/* !END!: Do not edit above this line. */

Changes to generic/tclObj.c.

33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
48
49
50
51
52
53

54
55
56
57
58
59
60
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
48
49
50
51
52

53
54
55
56
57
58
59
60







-
+












-
+







Tcl_Obj *tclFreeObjList = NULL;

/*
 * The object allocator is single threaded. This mutex is referenced by the
 * TclNewObj macro, however, so must be visible.
 */

#ifdef TCL_THREADS
#if TCL_THREADS
MODULE_SCOPE Tcl_Mutex tclObjMutex;
Tcl_Mutex tclObjMutex;
#endif

/*
 * Pointer to a heap-allocated string of length zero that the Tcl core uses as
 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */

char tclEmptyString = '\0';

#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
/*
 * Structure for tracking the source file and line number where a given
 * Tcl_Obj was allocated.  We also track the pointer to the Tcl_Obj itself,
 * for sanity checking purposes.
 */

typedef struct ObjData {
83
84
85
86
87
88
89
90

91
92
93
94
95
96
97
83
84
85
86
87
88
89

90
91
92
93
94
95
96
97







-
+







                                 * 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 defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
#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. */
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;
152
153
154
155
156
157
158
159

160
161
162
163
164
165
166
152
153
154
155
156
157
158

159
160
161
162
163
164
165
166







-
+







#define PopObjToDelete(contextPtr,objPtrVar) \
    (objPtrVar) = (contextPtr)->deletionStack;                          \
    (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes

/*
 * Macro to set up the local reference to the deletion context.
 */
#ifndef TCL_THREADS
#if !TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
#elif HAVE_FAST_TSD
static __thread PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
206
207
208
209
210
211
212
213
214


215
216
217
218
219
220
221
222
206
207
208
209
210
211
212


213
214

215
216
217
218
219
220
221







-
-
+
+
-







 */

static int		ParseBoolean(Tcl_Obj *objPtr);
static int		SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfDouble(Tcl_Obj *objPtr);
static void		UpdateStringOfInt(Tcl_Obj *objPtr);
#ifndef TCL_WIDE_INT_IS_LONG
static void		UpdateStringOfWideInt(Tcl_Obj *objPtr);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static void		UpdateStringOfOldInt(Tcl_Obj *objPtr);
static int		SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
#endif
static void		FreeBignum(Tcl_Obj *objPtr);
static void		DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void		UpdateStringOfBignum(Tcl_Obj *objPtr);
static int		GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int copy, mp_int *bignumValue);

238
239
240
241
242
243
244

245
246
247
248
249
250
251

252
253
254
255
256
257
258
259
260
261
262
263
264
265
266

267



268
269
270
271
272
273
274
275



276
277
278
279


280
281
282
283
284
285
286
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277



278
279
280
281
282


283
284
285
286
287
288
289
290
291







+







+















+

+
+
+





-
-
-
+
+
+


-
-
+
+







/*
 * The structures below defines the Tcl object types defined in this file by
 * means of functions that can be invoked by generic object code. See also
 * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
 * implementations.
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
static const Tcl_ObjType oldBooleanType = {
    "boolean",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    TclSetBooleanFromAny		/* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBooleanType = {
    "booleanString",		/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    TclSetBooleanFromAny		/* setFromAnyProc */
};
const Tcl_ObjType tclDoubleType = {
    "double",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfDouble,	/* updateStringProc */
    SetDoubleFromAny		/* setFromAnyProc */
};
const Tcl_ObjType tclIntType = {
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG)
    "int",			/* name */
#else
    "wideInt",		/* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/
#endif
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInt,		/* updateStringProc */
    SetIntFromAny		/* setFromAnyProc */
};
#ifndef TCL_WIDE_INT_IS_LONG
const Tcl_ObjType tclWideIntType = {
    "wideInt",			/* name */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static const Tcl_ObjType oldIntType = {
    "int",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfWideInt,	/* updateStringProc */
    SetWideIntFromAny		/* setFromAnyProc */
    UpdateStringOfOldInt,		/* updateStringProc */
    SetIntFromAny		/* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBignumType = {
    "bignum",			/* name */
    FreeBignum,			/* freeIntRepProc */
    DupBignum,			/* dupIntRepProc */
    UpdateStringOfBignum,	/* updateStringProc */
340
341
342
343
344
345
346
347

348
349
350
351
352

353
354
355
356
357

358
359
360
361
362
363
364
345
346
347
348
349
350
351

352
353
354
355
356

357
358
359
360
361

362
363
364
365
366
367
368
369







-
+




-
+




-
+








typedef struct ResolvedCmdName {
    Command *cmdPtr;		/* A cached Command pointer. */
    Namespace *refNsPtr;	/* Points to the namespace containing the
				 * reference (not the namespace that contains
				 * the referenced command). NULL if the name
				 * is fully qualified.*/
    size_t refNsId;		/* refNsPtr's unique namespace id. Used to
    unsigned long refNsId;		/* refNsPtr's unique namespace id. Used to
				 * verify that refNsPtr is still valid (e.g.,
				 * it's possible that the cmd's containing
				 * namespace was deleted and a new one created
				 * at the same address). */
    size_t refNsCmdEpoch;	/* Value of the referencing namespace's
    unsigned int refNsCmdEpoch;	/* Value of the referencing namespace's
				 * cmdRefEpoch when the pointer was cached.
				 * Before using the cached pointer, we check
				 * if the namespace's epoch was incremented;
				 * if so, this cached pointer is invalid. */
    size_t cmdEpoch;		/* Value of the command's cmdEpoch when this
    unsigned int cmdEpoch; /* Value of the command's cmdEpoch when this
				 * pointer was cached. Before using the cached
				 * pointer, we check if the cmd's epoch was
				 * incremented; if so, the cmd was renamed,
				 * deleted, hidden, or exposed, and so the
				 * pointer is invalid. */
    size_t refCount;		/* Reference count: 1 for each cmdName object
				 * that has a pointer to this ResolvedCmdName
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408

409
410
411





412
413
414
415
416
417
418
396
397
398
399
400
401
402


403
404
405
406
407
408
409
410
411
412



413
414
415
416
417
418
419
420
421
422
423
424







-
-









+
-
-
-
+
+
+
+
+







    Tcl_MutexLock(&tableMutex);
    typeTableInitialized = 1;
    Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
    Tcl_MutexUnlock(&tableMutex);

    Tcl_RegisterObjType(&tclByteArrayType);
    Tcl_RegisterObjType(&tclDoubleType);
    Tcl_RegisterObjType(&tclEndOffsetType);
    Tcl_RegisterObjType(&tclIntType);
    Tcl_RegisterObjType(&tclStringType);
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclCmdNameType);
    Tcl_RegisterObjType(&tclRegexpType);
    Tcl_RegisterObjType(&tclProcBodyType);

    /* For backward compatibility only ... */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Tcl_RegisterObjType(&oldBooleanType);
#ifndef TCL_WIDE_INT_IS_LONG
    Tcl_RegisterObjType(&tclWideIntType);
    Tcl_RegisterObjType(&tclIntType);
#if !defined(TCL_WIDE_INT_IS_LONG)
    Tcl_RegisterObjType(&oldIntType);
#endif
    Tcl_RegisterObjType(&oldBooleanType);
#endif

#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    tclObjsAlloced = 0;
    tclObjsFreed = 0;
    {
442
443
444
445
446
447
448
449

450
451
452
453
454
455
456
448
449
450
451
452
453
454

455
456
457
458
459
460
461
462







-
+







 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadObjects(void)
{
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
999
1000
1001
1002
1003
1004
1005
1006

1007
1008
1009
1010
1011
1012
1013
1005
1006
1007
1008
1009
1010
1011

1012
1013
1014
1015
1016
1017
1018
1019







-
+







 *--------------------------------------------------------------
 */

void
TclDbDumpActiveObjects(
    FILE *outFile)
{
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
    Tcl_HashSearch hSearch;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tablePtr = tsdPtr->objThreadMap;

1059
1060
1061
1062
1063
1064
1065
1066

1067
1068
1069
1070
1071
1072
1073
1065
1066
1067
1068
1069
1070
1071

1072
1073
1074
1075
1076
1077
1078
1079







-
+







				 * debugging. */
{
    objPtr->refCount = 0;
    objPtr->bytes = &tclEmptyString;
    objPtr->length = 0;
    objPtr->typePtr = NULL;

#ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * Add entry to a thread local map used to check if a Tcl_Obj was
     * allocated by the currently executing thread.
     */

    if (!TclInExit()) {
	Tcl_HashEntry *hPtr;
1295
1296
1297
1298
1299
1300
1301
1302

1303
1304
1305
1306
1307
1308
1309
1301
1302
1303
1304
1305
1306
1307

1308
1309
1310
1311
1312
1313
1314
1315







-
+








    /*
     * This macro declares a variable, so must come here...
     */

    ObjInitDeletionContext(context);

# ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
1622
1623
1624
1625
1626
1627
1628
1629

1630
1631
1632
1633
1634
1635
1636
1637
1638






1639
1640
1641
1642
1643
1644
1645






1646
1647
1648
1649
1650
1651
1652
1653
1654










1655
1656
1657
1658
1659
1660
1661
1628
1629
1630
1631
1632
1633
1634

1635









1636
1637
1638
1639
1640
1641
1642






1643
1644
1645
1646
1647
1648









1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665







-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+







 */

char *
Tcl_GetString(
    register Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
				 * be returned. */
{
    if (objPtr->bytes != NULL) {
    if (objPtr->bytes == NULL) {
	return objPtr->bytes;
    }

    /*
     * Note we do not check for objPtr->typePtr == NULL.  An invariant of
     * a properly maintained Tcl_Obj is that at least  one of objPtr->bytes
     * and objPtr->typePtr must not be NULL.  If broken extensions fail to
     * maintain that invariant, we can crash here.
     */
	/*
	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
	 * of a properly maintained Tcl_Obj is that at least  one of
	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
	 * extensions fail to maintain that invariant, we can crash here.
	 */

    if (objPtr->typePtr->updateStringProc == NULL) {
	/*
	 * Those Tcl_ObjTypes which choose not to define an updateStringProc
	 * must be written in such a way that (objPtr->bytes) never becomes
	 * NULL.  This panic was added in Tcl 8.1.
	 */
	if (objPtr->typePtr->updateStringProc == NULL) {
	    /*
	     * Those Tcl_ObjTypes which choose not to define an
	     * updateStringProc must be written in such a way that
	     * (objPtr->bytes) never becomes NULL.
	     */

	Tcl_Panic("UpdateStringProc should not be invoked for type %s",
		objPtr->typePtr->name);
    }
    objPtr->typePtr->updateStringProc(objPtr);
    if (objPtr->bytes == NULL || objPtr->length < 0
	    || objPtr->bytes[objPtr->length] != '\0') {
	Tcl_Panic("UpdateStringProc for type '%s' "
		"failed to create a valid string rep", objPtr->typePtr->name);
	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
		    objPtr->typePtr->name);
	}
	objPtr->typePtr->updateStringProc(objPtr);
	if (objPtr->bytes == NULL || objPtr->length < 0
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    return objPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
1683
1684
1685
1686
1687
1688
1689







1690
1691


















1692
1693
1694
1695
1696
1697
1698
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700


1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725







+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







Tcl_GetStringFromObj(
    register Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
				 * be returned. */
    register int *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) {
	/*
	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
	 * of a properly maintained Tcl_Obj is that at least  one of
	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
	 * extensions fail to maintain that invariant, we can crash here.
	 */
    (void) TclGetString(objPtr);


	if (objPtr->typePtr->updateStringProc == NULL) {
	    /*
	     * Those Tcl_ObjTypes which choose not to define an
	     * updateStringProc must be written in such a way that
	     * (objPtr->bytes) never becomes NULL.
	     */
	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
		    objPtr->typePtr->name);
	}
	objPtr->typePtr->updateStringProc(objPtr);
	if (objPtr->bytes == NULL || objPtr->length < 0
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    if (lengthPtr != NULL) {
	*lengthPtr = objPtr->length;
    }
    return objPtr->bytes;
}

/*
1758
1759
1760
1761
1762
1763
1764
1765

1766
1767
1768
1769
1770
1771
1772
1785
1786
1787
1788
1789
1790
1791

1792
1793
1794
1795
1796
1797
1798
1799







-
+








Tcl_Obj *
Tcl_NewBooleanObj(
    register int boolValue)	/* Boolean used to initialize new object. */
{
    register Tcl_Obj *objPtr;

    TclNewLongObj(objPtr, boolValue!=0);
    TclNewIntObj(objPtr, boolValue!=0);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
1806
1807
1808
1809
1810
1811
1812
1813

1814
1815
1816
1817
1818
1819
1820
1833
1834
1835
1836
1837
1838
1839

1840
1841
1842
1843
1844
1845
1846
1847







-
+







				 * debugging. */
{
    register Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    objPtr->bytes = NULL;

    objPtr->internalRep.longValue = (boolValue != 0);
    objPtr->internalRep.wideValue = (boolValue != 0);
    objPtr->typePtr = &tclIntType;
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
1853
1854
1855
1856
1857
1858
1859
1860

1861
1862
1863
1864
1865
1866
1867
1880
1881
1882
1883
1884
1885
1886

1887
1888
1889
1890
1891
1892
1893
1894







-
+







    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    register int boolValue)	/* Boolean used to set object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
    }

    TclSetLongObj(objPtr, boolValue!=0);
    TclSetIntObj(objPtr, boolValue!=0);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetBooleanFromObj --
1884
1885
1886
1887
1888
1889
1890
1891

1892
1893
1894
1895

1896
1897
1898
1899
1900
1901
1902
1911
1912
1913
1914
1915
1916
1917

1918
1919
1920
1921

1922
1923
1924
1925
1926
1927
1928
1929







-
+



-
+







Tcl_GetBooleanFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get boolean. */
    register int *boolPtr)	/* Place to store resulting boolean. */
{
    do {
	if (objPtr->typePtr == &tclIntType) {
	    *boolPtr = (objPtr->internalRep.longValue != 0);
	    *boolPtr = (objPtr->internalRep.wideValue != 0);
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBooleanType) {
	    *boolPtr = (int) objPtr->internalRep.longValue;
	    *boolPtr = objPtr->internalRep.longValue != 0;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    /*
	     * Caution: Don't be tempted to check directly for the "double"
	     * Tcl_ObjType and then compare the intrep to 0.0. This isn't
	     * reliable because a "double" Tcl_ObjType can hold the NaN value.
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945






1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963

1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1939
1940
1941
1942
1943
1944
1945






1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965

1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988

1989

1990
1991
1992
1993
1994
1995
1996
1997
1998






1999
2000
2001
2002
2003
2004
2005







-
-
-
-
-
-




















-
+
+
+
+
+
+

















-
+
-









-
-
-
-
-
-







	    *boolPtr = (d != 0.0);
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    *boolPtr = 1;
	    return TCL_OK;
	}
#ifndef TCL_WIDE_INT_IS_LONG
	if (objPtr->typePtr == &tclWideIntType) {
	    *boolPtr = (objPtr->internalRep.wideValue != 0);
	    return TCL_OK;
	}
#endif
    } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
	    TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetBooleanFromAny --
 *
 *	Attempt to generate a boolean internal form for the Tcl object
 *	"objPtr".
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
 *	representation and the type of "objPtr" is set to boolean.
 *	representation and the type of "objPtr" is set to boolean or int/wideInt.
 *
 *  Warning: If the returned type is "wideInt" (32-bit platforms) and your
 *  platform is bigendian, you cannot use internalRep.longValue to distinguish
 *  between false and true. On Windows and most other platforms this still will
 *  work fine, but basically it is non-portable.
 *
 *----------------------------------------------------------------------
 */

int
TclSetBooleanFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    register 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.
     */

    if (objPtr->bytes == NULL) {
	if (objPtr->typePtr == &tclIntType) {
	    switch (objPtr->internalRep.longValue) {
	    if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
	    case 0L: case 1L:
		return TCL_OK;
	    }
	    goto badBoolean;
	}

	if (objPtr->typePtr == &tclBignumType) {
	    goto badBoolean;
	}

#ifndef TCL_WIDE_INT_IS_LONG
	if (objPtr->typePtr == &tclWideIntType) {
	    goto badBoolean;
	}
#endif

	if (objPtr->typePtr == &tclDoubleType) {
	    goto badBoolean;
	}
    }

    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
2109
2110
2111
2112
2113
2114
2115
2116

2117
2118
2119
2120
2121
2122
2123
2128
2129
2130
2131
2132
2133
2134

2135
2136
2137
2138
2139
2140
2141
2142







-
+







    TclFreeIntRep(objPtr);
    objPtr->internalRep.longValue = newBool;
    objPtr->typePtr = &tclBooleanType;
    return TCL_OK;

  numericBoolean:
    TclFreeIntRep(objPtr);
    objPtr->internalRep.longValue = newBool;
    objPtr->internalRep.wideValue = newBool;
    objPtr->typePtr = &tclIntType;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2290
2291
2292
2293
2294
2295
2296
2297

2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2309
2310
2311
2312
2313
2314
2315

2316
2317
2318
2319
2320
2321
2322
2323
2324
2325






2326
2327
2328
2329
2330
2331
2332







-
+









-
-
-
-
-
-







		}
		return TCL_ERROR;
	    }
	    *dblPtr = (double) objPtr->internalRep.doubleValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    *dblPtr = objPtr->internalRep.longValue;
	    *dblPtr = (double) objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    mp_int big;

	    UNPACK_BIGNUM(objPtr, big);
	    *dblPtr = TclBignumToDouble(&big);
	    return TCL_OK;
	}
#ifndef TCL_WIDE_INT_IS_LONG
	if (objPtr->typePtr == &tclWideIntType) {
	    *dblPtr = (double) objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#endif
    } while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
2423
2424
2425
2426
2427
2428
2429
2430

2431
2432
2433
2434
2435
2436
2437
2436
2437
2438
2439
2440
2441
2442

2443
2444
2445
2446
2447
2448
2449
2450







-
+








Tcl_Obj *
Tcl_NewIntObj(
    register int intValue)	/* Int used to initialize the new object. */
{
    register Tcl_Obj *objPtr;

    TclNewLongObj(objPtr, intValue);
    TclNewIntObj(objPtr, intValue);
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
2456
2457
2458
2459
2460
2461
2462
2463

2464
2465
2466
2467
2468
2469
2470
2471


2472


2473
2474


2475
2476
2477
2478

2479
2480
2481


2482
2483
2484


2485
2486

2487
2488
2489
2490


2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509

2510
2511
2512
2513
2514
2515
2516
2469
2470
2471
2472
2473
2474
2475

2476
2477
2478
2479
2480
2481
2482
2483

2484
2485
2486
2487
2488


2489
2490

2491


2492



2493
2494



2495
2496
2497

2498




2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518

2519
2520
2521
2522
2523
2524
2525
2526







-
+







-
+
+

+
+
-
-
+
+
-

-
-
+
-
-
-
+
+
-
-
-
+
+

-
+
-
-
-
-
+
+


















-
+







    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    register int intValue)	/* Integer used to set object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
    }

    TclSetLongObj(objPtr, intValue);
    TclSetIntObj(objPtr, intValue);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntFromObj --
 *
 *	Retrieve the integer value of 'objPtr'.
 *	Attempt to return an int from the Tcl object "objPtr". If the object
 *	is not already an int, an attempt will be made to convert it to one.
 *
 *	Integer and long integer objects share the same "integer" type
 *	implementation. We store all integers as longs and Tcl_GetIntFromObj
 * Value
 *
 *	checks whether the current value of the long can be represented by an
 *	int.
 *	TCL_OK
 *
 *	    Success.
 *
 * Results:
 *	TCL_ERROR
 *	
 *	    An error occurred during conversion or the integral value can not
 *	The return value is a standard Tcl object result. If an error occurs
 *	during conversion or if the long integer held by the object can not be
 *	    be represented as an integer (it might be too large). An error
 *	    message is left in the interpreter's result if 'interp' is not
 *	    NULL.
 *	represented by an int, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Effect
 * Side effects:
 *
 *	'objPtr' is converted to an integer if necessary if it is not one
 *	already.  The conversion frees any previously-existing internal
 *	representation.
 *	If the object is not already an int, the conversion will free any old
 *	internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get a int. */
    register int *intPtr)	/* Place to store resulting int. */
{
#if (LONG_MAX == INT_MAX)
    return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
#else
    long l;

    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < INT_MIN))) {
	if (interp != NULL) {
	    const char *s =
		    "integer value too large to represent as non-long integer";
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	}
	return TCL_ERROR;
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546


2547
2548
2549
2550
2551
2552
2553
2547
2548
2549
2550
2551
2552
2553



2554
2555
2556
2557
2558
2559
2560
2561
2562







-
-
-
+
+







 */

static int
SetIntFromAny(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
{
    long l;

    return TclGetLongFromObj(interp, objPtr, &l);
    Tcl_WideInt w;
    return Tcl_GetWideIntFromObj(interp, objPtr, &w);
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfInt --
 *
2567
2568
2569
2570
2571
2572
2573















2574
2575
2576
2577
2578
2579
2580

2581
2582
2583
2584
2585
2586
2587
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







+








static void
UpdateStringOfInt(
    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    char buffer[TCL_INTEGER_SPACE];
    register int len;

    len = TclFormatInt(buffer, objPtr->internalRep.wideValue);

    objPtr->bytes = ckalloc(len + 1);
    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
    objPtr->length = len;
}

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static void
UpdateStringOfOldInt(
    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    char buffer[TCL_INTEGER_SPACE];
    register int len;

    len = TclFormatInt(buffer, objPtr->internalRep.longValue);

    objPtr->bytes = ckalloc(len + 1);
    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
    objPtr->length = len;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewLongObj --
 *
 *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
2605
2606
2607
2608
2609
2610
2611
2612
2613

2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632

2633
2634
2635
2636
2637
2638
2639
2630
2631
2632
2633
2634
2635
2636

2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656

2657
2658
2659
2660
2661
2662
2663
2664







-

+


















-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewLongObj
#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_NewLongObj(
    register long longValue)	/* Long integer used to initialize the
				 * new object. */
{
    return Tcl_DbNewLongObj(longValue, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewLongObj(
    register long longValue)	/* Long integer used to initialize the
				 * new object. */
{
    register Tcl_Obj *objPtr;

    TclNewLongObj(objPtr, longValue);
    TclNewIntObj(objPtr, longValue);
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
2662
2663
2664
2665
2666
2667
2668

2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685

2686
2687
2688
2689
2690
2691
2692
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710

2711
2712
2713
2714
2715
2716
2717
2718







+
















-
+







 *
 * Side effects:
 *	Allocates memory.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_DbNewLongObj
#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewLongObj(
    register long longValue,	/* Long 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. */
{
    register Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    objPtr->bytes = NULL;

    objPtr->internalRep.longValue = longValue;
    objPtr->internalRep.wideValue = longValue;
    objPtr->typePtr = &tclIntType;
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
2716
2717
2718
2719
2720
2721
2722

2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733

2734
2735
2736
2737
2738
2739
2740
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759

2760
2761
2762
2763
2764
2765
2766
2767







+










-
+







 * Side effects:
 *	The object's old string rep, if any, is freed. Also, any old internal
 *	rep is freed.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_SetLongObj
void
Tcl_SetLongObj(
    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    register long longValue)	/* Long integer used to initialize the
				 * object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
    }

    TclSetLongObj(objPtr, longValue);
    TclSetIntObj(objPtr, longValue);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetLongFromObj --
 *
2757
2758
2759
2760
2761
2762
2763

2764
2765

2766
2767
2768
2769


2770
2771

2772
2773
2774
2775
2776
2777
2778
2779
2780

2781
2782

2783
2784
2785
2786
2787
2788
2789
2784
2785
2786
2787
2788
2789
2790
2791
2792

2793
2794
2795


2796
2797
2798

2799
2800
2801
2802
2803
2804
2805
2806
2807

2808
2809

2810
2811
2812
2813
2814
2815
2816
2817







+

-
+


-
-
+
+

-
+








-
+

-
+







int
Tcl_GetLongFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get a long. */
    register long *longPtr)	/* Place to store resulting long. */
{
    do {
#ifdef TCL_WIDE_INT_IS_LONG
	if (objPtr->typePtr == &tclIntType) {
	    *longPtr = objPtr->internalRep.longValue;
	    *longPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#ifndef TCL_WIDE_INT_IS_LONG
	if (objPtr->typePtr == &tclWideIntType) {
#else
	if (objPtr->typePtr == &tclIntType) {
	    /*
	     * We return any integer in the range -ULONG_MAX to ULONG_MAX
	     * We return any integer in the range LONG_MIN to ULONG_MAX
	     * converted to a long, ignoring overflow. The rule preserves
	     * existing semantics for conversion of integers on input, but
	     * avoids inadvertent demotion of wide integers to 32-bit ones in
	     * the internal rep.
	     */

	    Tcl_WideInt w = objPtr->internalRep.wideValue;

	    if (w >= -(Tcl_WideInt)(ULONG_MAX)
	    if (w >= (Tcl_WideInt)(LONG_MIN)
		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
		*longPtr = Tcl_WideAsLong(w);
		*longPtr = (long) w;
		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
2801
2802
2803
2804
2805
2806
2807
2808

2809
2810

2811
2812
2813
2814
2815
2816
2817
2818

2819



2820

2821

2822
2823



2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2829
2830
2831
2832
2833
2834
2835

2836
2837

2838

2839
2840
2841
2842
2843
2844
2845
2846

2847
2848
2849
2850
2851

2852


2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873











































2874
2875
2876
2877
2878
2879
2880







-
+

-
+
-







+
-
+
+
+

+
-
+
-
-
+
+
+


















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	     * long range get auto-narrowed to tclIntType, while all the
	     * values in the unsigned long range will fit in a long.
	     */

	    mp_int big;

	    UNPACK_BIGNUM(objPtr, big);
	    if ((size_t) big.used <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
	    if ((size_t) big.used <= (CHAR_BIT * sizeof(unsigned long) + DIGIT_BIT - 1)
		    / DIGIT_BIT) {
		unsigned long value = 0, numBytes = sizeof(long);
		unsigned long scratch, value = 0, numBytes = sizeof(unsigned long);
		long scratch;
		unsigned char *bytes = (unsigned char *) &scratch;

		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		    while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		    }
		    if (big.sign) {
			if (value <= 1 + (unsigned long)LONG_MAX) {
			*longPtr = - (long) value;
			    *longPtr = - (long) value;
			    return TCL_OK;
			}
		    } else {
			if (value <= (unsigned long)ULONG_MAX) {
			*longPtr = (long) value;
			    *longPtr = (long) value;
		    }
		    return TCL_OK;
			    return TCL_OK;
			}
		    }
		}
	    }
#ifndef TCL_WIDE_INT_IS_LONG
	tooLarge:
#endif
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);

		Tcl_SetObjResult(interp, msg);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}
#ifndef TCL_WIDE_INT_IS_LONG

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfWideInt --
 *
 *	Update the string representation for a wide integer object. Note: this
 *	function does not free an existing old string rep so storage will be
 *	lost if this has not already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from the
 *	wideInt-to-string conversion.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfWideInt(
    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    char buffer[TCL_INTEGER_SPACE+2];
    register unsigned len;
    register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;

    /*
     * Note that sprintf will generate a compiler warning under Mingw claiming
     * %I64 is an unknown format specifier. Just ignore this warning. We can't
     * use %L as the format specifier since that gets printed as a 32 bit
     * value.
     */

    sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
    len = strlen(buffer);
    objPtr->bytes = ckalloc(len + 1);
    memcpy(objPtr->bytes, buffer, len + 1);
    objPtr->length = len;
}
#endif /* !TCL_WIDE_INT_IS_LONG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewWideIntObj --
 *
 *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
2927
2928
2929
2930
2931
2932
2933
2934

2935
2936
2937
2938
2939
2940
2941
2916
2917
2918
2919
2920
2921
2922

2923
2924
2925
2926
2927
2928
2929
2930







-
+







    register Tcl_WideInt wideValue)
				/* Wide integer used to initialize the new
				 * object. */
{
    register Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    Tcl_SetWideIntObj(objPtr, wideValue);
    TclSetIntObj(objPtr, wideValue);
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
2979
2980
2981
2982
2983
2984
2985
2986

2987
2988
2989
2990
2991
2992
2993
2968
2969
2970
2971
2972
2973
2974

2975
2976
2977
2978
2979
2980
2981
2982







-
+







				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    register Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    Tcl_SetWideIntObj(objPtr, wideValue);
    TclSetIntObj(objPtr, wideValue);
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewWideIntObj(
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040

3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3017
3018
3019
3020
3021
3022
3023






3024







3025
3026
3027
3028
3029
3030
3031







-
-
-
-
-
-
+
-
-
-
-
-
-
-







				/* Wide integer used to initialize the
				 * object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
    }

    if ((wideValue >= (Tcl_WideInt) LONG_MIN)
	    && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
	TclSetLongObj(objPtr, (long) wideValue);
    } else {
#ifndef TCL_WIDE_INT_IS_LONG
	TclSetWideIntObj(objPtr, wideValue);
    TclSetIntObj(objPtr, wideValue);
#else
	mp_int big;

	TclInitBignumFromWideInt(&big, wideValue);
	Tcl_SetBignumObj(objPtr, &big);
#endif
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetWideIntFromObj --
 *
3072
3073
3074
3075
3076
3077
3078
3079
3080

3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3049
3050
3051
3052
3053
3054
3055


3056
3057





3058
3059
3060
3061
3062
3063
3064







-
-
+

-
-
-
-
-







Tcl_GetWideIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
    register Tcl_WideInt *wideIntPtr)
				/* Place to store resulting long. */
{
    do {
#ifndef TCL_WIDE_INT_IS_LONG
	if (objPtr->typePtr == &tclWideIntType) {
	if (objPtr->typePtr == &tclIntType) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#endif
	if (objPtr->typePtr == &tclIntType) {
	    *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
3112
3113
3114
3115
3116
3117
3118

3119



3120

3121

3122
3123



3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144

3145
3146
3147




3148
3149
3150

3151
3152
3153




3154
3155
3156
3157
3158
3159
3160





3161

















3162
3163
3164
3165


















3166
3167
3168
3169
3170
3171
3172
3083
3084
3085
3086
3087
3088
3089
3090

3091
3092
3093
3094
3095

3096


3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114

3115
3116
3117
3118

3119
3120


3121
3122
3123
3124
3125
3126

3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137




3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160




3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185







+
-
+
+
+

+
-
+
-
-
+
+
+















-




-
+

-
-
+
+
+
+


-
+



+
+
+
+



-
-
-
-
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		unsigned char *bytes = (unsigned char *) &scratch;

		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		    while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		    }
		    if (big.sign) {
			if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
			*wideIntPtr = - (Tcl_WideInt) value;
			    *wideIntPtr = - (Tcl_WideInt) value;
			    return TCL_OK;
			}
		    } else {
			if (value <= (Tcl_WideUInt)WIDE_MAX) {
			*wideIntPtr = (Tcl_WideInt) value;
			    *wideIntPtr = (Tcl_WideInt) value;
		    }
		    return TCL_OK;
			    return TCL_OK;
			}
		    }
		}
	    }
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);

		Tcl_SetObjResult(interp, msg);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}
#ifndef TCL_WIDE_INT_IS_LONG

/*
 *----------------------------------------------------------------------
 *
 * SetWideIntFromAny --
 * TclGetWideBitsFromObj --
 *
 *	Attempts to force the internal representation for a Tcl object to
 *	tclWideIntType, specifically.
 *	Attempt to return a wide integer from the Tcl object "objPtr". If the
 *	object is not already a int, double or bignum, an attempt will be made
 *	to convert it to one of these. Out-of-range values don't result in an
 *	error, but only the least significant 64 bits will be returned.
 *
 * Results:
 *	The return value is a standard object Tcl result. If an error occurs
 *	The return value is a standard Tcl object result. If an error occurs
 *	during conversion, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	If the object is not already an int, double or bignum object, the
 *	conversion will free any old internal representation.
 *
 *----------------------------------------------------------------------
 */

static int
SetWideIntFromAny(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
int
TclGetWideBitsFromObj(
    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 (objPtr->typePtr == &tclIntType) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
	    }
	    return TCL_ERROR;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    mp_int big;

    Tcl_WideInt w;
    return Tcl_GetWideIntFromObj(interp, objPtr, &w);
}
#endif /* !TCL_WIDE_INT_IS_LONG */
	    Tcl_WideUInt value = 0, scratch;
	    unsigned long numBytes = sizeof(Tcl_WideInt);
	    unsigned char *bytes = (unsigned char *) &scratch;

	    Tcl_GetBignumFromObj(NULL, objPtr, &big);
	    mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big);
	    mp_to_unsigned_bin_n(&big, bytes, &numBytes);
	    while (numBytes-- > 0) {
		value = (value << CHAR_BIT) | *bytes++;
	    }
	    *wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value;
	    mp_clear(&big);
	    return TCL_OK;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeBignum --
 *
 *	This function frees the internal rep of a bignum.
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3414
3415
3416
3417
3418
3419
3420





3421
3422
3423
3424

3425
3426
3427
3428
3429
3430
3431







-
-
-
-
-




-







		if (objPtr->bytes == NULL) {
		    TclInitStringRep(objPtr, &tclEmptyString, 0);
		}
	    }
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    TclInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
	    return TCL_OK;
	}
#ifndef TCL_WIDE_INT_IS_LONG
	if (objPtr->typePtr == &tclWideIntType) {
	    TclInitBignumFromWideInt(bignumValue,
		    objPtr->internalRep.wideValue);
	    return TCL_OK;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
	    }
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552

3553
3554
3555
3556



3557
3558
3559
3560
3561
3562
3563
3564

3565
3566
3567
3568

3569
3570

3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3527
3528
3529
3530
3531
3532
3533


























3534
3535



3536
3537
3538
3539
3540
3541
3542
3543
3544
3545

3546
3547
3548
3549

3550
3551

3552
3553
3554
3555
3556
3557

3558
3559
3560
3561
3562
3563
3564







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
-
+
+
+







-
+



-
+

-
+





-







    Tcl_Obj *objPtr,		/* Object to set */
    mp_int *bignumValue)	/* Value to store */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
    }
    if ((size_t) bignumValue->used
	    <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) {
	unsigned long value = 0, numBytes = sizeof(long);
	long scratch;
	unsigned char *bytes = (unsigned char *) &scratch;

	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
	    goto tooLargeForLong;
	}
	while (numBytes-- > 0) {
	    value = (value << CHAR_BIT) | *bytes++;
	}
	if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) {
	    goto tooLargeForLong;
	}
	if (bignumValue->sign) {
	    TclSetLongObj(objPtr, -(long)value);
	} else {
	    TclSetLongObj(objPtr, (long)value);
	}
	mp_clear(bignumValue);
	return;
    }
  tooLargeForLong:
#ifndef TCL_WIDE_INT_IS_LONG
    if ((size_t) bignumValue->used
	    <= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
	    <= (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
	Tcl_WideUInt value = 0;
	unsigned long numBytes = sizeof(Tcl_WideInt);
	Tcl_WideInt scratch;
	unsigned char *bytes = (unsigned char *)&scratch;
	unsigned long numBytes = sizeof(Tcl_WideUInt);
	Tcl_WideUInt scratch;
	unsigned char *bytes = (unsigned char *) &scratch;

	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
	    goto tooLargeForWide;
	}
	while (numBytes-- > 0) {
	    value = (value << CHAR_BIT) | *bytes++;
	}
	if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) {
	if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
	    goto tooLargeForWide;
	}
	if (bignumValue->sign) {
	    TclSetWideIntObj(objPtr, -(Tcl_WideInt)value);
	    TclSetIntObj(objPtr, -(Tcl_WideInt)value);
	} else {
	    TclSetWideIntObj(objPtr, (Tcl_WideInt)value);
	    TclSetIntObj(objPtr, (Tcl_WideInt)value);
	}
	mp_clear(bignumValue);
	return;
    }
  tooLargeForWide:
#endif
    TclInvalidateStringRep(objPtr);
    TclFreeIntRep(objPtr);
    TclSetBignumIntRep(objPtr, bignumValue);
}

/*
 *----------------------------------------------------------------------
3651
3652
3653
3654
3655
3656
3657
3658

3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3632
3633
3634
3635
3636
3637
3638

3639






3640
3641
3642

3643
3644
3645
3646
3647
3648
3649







-
+
-
-
-
-
-
-



-







	    } else {
		*typePtr = TCL_NUMBER_DOUBLE;
	    }
	    *clientDataPtr = &objPtr->internalRep.doubleValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    *typePtr = TCL_NUMBER_LONG;
	    *typePtr = TCL_NUMBER_INT;
	    *clientDataPtr = &objPtr->internalRep.longValue;
	    return TCL_OK;
	}
#ifndef TCL_WIDE_INT_IS_LONG
	if (objPtr->typePtr == &tclWideIntType) {
	    *typePtr = TCL_NUMBER_WIDE;
	    *clientDataPtr = &objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#endif
	if (objPtr->typePtr == &tclBignumType) {
	    static Tcl_ThreadDataKey bignumKey;
	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
		    (int) sizeof(mp_int));

	    UNPACK_BIGNUM(objPtr, *bigPtr);
	    *typePtr = TCL_NUMBER_BIG;
3714
3715
3716
3717
3718
3719
3720
3721

3722
3723
3724
3725
3726
3727
3728
3688
3689
3690
3691
3692
3693
3694

3695
3696
3697
3698
3699
3700
3701
3702







-
+







#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("incrementing refCount of previously disposed object");
    }

# ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
3777
3778
3779
3780
3781
3782
3783
3784

3785
3786
3787
3788
3789
3790
3791
3751
3752
3753
3754
3755
3756
3757

3758
3759
3760
3761
3762
3763
3764
3765







-
+







#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("decrementing refCount of previously disposed object");
    }

# ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
3842
3843
3844
3845
3846
3847
3848
3849

3850
3851
3852
3853
3854
3855
3856
3816
3817
3818
3819
3820
3821
3822

3823
3824
3825
3826
3827
3828
3829
3830







-
+







#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("checking whether previously disposed object is shared");
    }

# ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {

Changes to generic/tclPanic.c.

19
20
21
22
23
24
25
26
27


28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

48
49
50
51
52
53
54
19
20
21
22
23
24
25


26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55







-
-
+
+




















+







#endif

/*
 * The panicProc variable contains a pointer to an application specific panic
 * procedure.
 */

#if defined(__CYGWIN__)
static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic;
#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8))
static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetPanicProc --
 *
 *	Replace the default panic behavior with the specified function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the panicProc variable.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_SetPanicProc
void
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
{
#if defined(_WIN32)
    /* tclWinDebugPanic only installs if there is no panicProc yet. */
    if ((proc != tclWinDebugPanic) || (panicProc == NULL))

Changes to generic/tclParse.c.

975
976
977
978
979
980
981
982






983
984
985
986
987
988
989
975
976
977
978
979
980
981

982
983
984
985
986
987
988
989
990
991
992
993
994







-
+
+
+
+
+
+







	break;
    }

  done:
    if (readPtr != NULL) {
	*readPtr = count;
    }
    return Tcl_UniCharToUtf(result, dst);
    count = Tcl_UniCharToUtf(result, dst);
    if (!count) {
	/* Special case for handling upper surrogates. */
	count = Tcl_UniCharToUtf(-1, dst);
    }
    return count;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseComment --
 *

Changes to generic/tclPathObj.c.

1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1805
1806
1807
1808
1809
1810
1811

1812
1813
1814
1815
1816
1817
1818







-







	Tcl_IncrRefCount(copy);

	/*
	 * We now own a reference on both 'dir' and 'copy'
	 */

	(void) TclGetStringFromObj(dir, &cwdLen);
	cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');

	/* Normalize the combined string. */

	if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) {
	    /*
	     * If the "tail" part has components (like /../) that cause the
	     * combined path to need more complete normalizing, call on the
1827
1828
1829
1830
1831
1832
1833
1834

1835
1836
1837
1838
1839

1840
1841
1842
1843
1844
1845
1846
1826
1827
1828
1829
1830
1831
1832

1833
1834
1835
1836
1837

1838
1839
1840
1841
1842
1843
1844
1845







-
+




-
+







	    copy = newCopy;
	} else {
	    /*
	     * ... but in most cases where we join a trouble free tail to a
	     * normalized head, we can more efficiently normalize the combined
	     * path by passing over only the unnormalized tail portion. When
	     * this is sufficient, prior developers claim this should be much
	     * faster. We use 'cwdLen-1' so that we are already pointing at
	     * faster. We use 'cwdLen' so that we are already pointing at
	     * the dir-separator that we know about. The normalization code
	     * will actually start off directly after that separator.
	     */

	    TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
	    TclFSNormalizeToUniquePath(interp, copy, cwdLen);
	}

	/* Now we need to construct the new path object. */

	if (pathType == TCL_PATH_RELATIVE) {
	    Tcl_Obj *origDir = fsPathPtr->cwdPtr;

Changes to generic/tclPipe.c.

217
218
219
220
221
222
223
224

225
226
227
228
229
230



231
232
233
234
235
236
237
217
218
219
220
221
222
223

224

225
226
227


228
229
230
231
232
233
234
235
236
237







-
+
-



-
-
+
+
+







 */

void
Tcl_ReapDetachedProcs(void)
{
    register Detached *detPtr;
    Detached *nextPtr, *prevPtr;
    int status;
    int status, code;
    Tcl_Pid pid;

    Tcl_MutexLock(&pipeMutex);
    for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
	pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
	if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
	status = TclProcessWait(detPtr->pid, WNOHANG, &code, NULL, NULL);
	if (status == TCL_PROCESS_UNCHANGED || (status == TCL_PROCESS_ERROR
		&& code != ECHILD)) {
	    prevPtr = detPtr;
	    detPtr = detPtr->nextPtr;
	    continue;
	}
	nextPtr = detPtr->nextPtr;
	if (prevPtr == NULL) {
	    detList = detPtr->nextPtr;
273
274
275
276
277
278
279
280
281
282



283
284
285
286
287
288
289
290
291
292

293
294

295
296
297
298
299
300
301
302
303
304
305

306
307
308
309

310
311


312
313
314
315
316
317
318
319
320
321
322
323
324

325
326
327

328
329
330

331
332
333
334
335
336
337
338
339
340
341
342
343
344

345
346

347
348
349
350
351
352
353

354


355
356
357
358
359
360
361
273
274
275
276
277
278
279



280
281
282

283
284
285






286


287

288
289








290




291

292
293
294
295
296
297
298
299
300
301
302
303
304



305
306


307
308


309
310
311
312











313


314







315

316
317
318
319
320
321
322
323
324







-
-
-
+
+
+
-



-
-
-
-
-
-
+
-
-
+
-


-
-
-
-
-
-
-
-
+
-
-
-
-
+
-

+
+










-
-
-
+

-
-
+

-
-
+



-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
+
-
+
+







    Tcl_Pid *pidPtr,		/* Array of process ids of children. */
    Tcl_Channel errorChan)	/* Channel for file containing stderr output
				 * from pipeline. NULL means there isn't any
				 * stderr output. */
{
    int result = TCL_OK;
    int i, abnormalExit, anyErrorInfo;
    Tcl_Pid pid;
    int waitStatus;
    const char *msg;
    TclProcessWaitStatus waitStatus;
    int code;
    Tcl_Obj *msg, *error;
    unsigned long resolvedPid;

    abnormalExit = 0;
    for (i = 0; i < numPids; i++) {
	/*
	 * We need to get the resolved pid before we wait on it as the windows
	 * implementation of Tcl_WaitPid deletes the information such that any
	 * following calls to TclpGetPid fail.
	 */

	waitStatus = TclProcessWait(pidPtr[i], 0, &code, &msg, &error);
	resolvedPid = TclpGetPid(pidPtr[i]);
	pid = Tcl_WaitPid(pidPtr[i], &waitStatus, 0);
	if (waitStatus == TCL_PROCESS_ERROR) {
	if (pid == (Tcl_Pid) -1) {
	    result = TCL_ERROR;
	    if (interp != NULL) {
		msg = Tcl_PosixError(interp);
		if (errno == ECHILD) {
		    /*
		     * This changeup in message suggested by Mark Diekhans to
		     * remind people that ECHILD errors can occur on some
		     * systems if SIGCHLD isn't in its default state.
		     */

		Tcl_SetObjErrorCode(interp, error);
		    msg =
			"child process lost (is SIGCHLD ignored or trapped?)";
		}
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		Tcl_SetObjResult(interp, msg);
			"error waiting for process to exit: %s", msg));
	    }
	    Tcl_DecrRefCount(error);
	    Tcl_DecrRefCount(msg);
	    continue;
	}

	/*
	 * Create error messages for unusual process exits. An extra newline
	 * gets appended to each error message, but it gets removed below (in
	 * the same fashion that an extra newline in the command's output is
	 * removed).
	 */

	if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
	    char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];

	if (waitStatus != TCL_PROCESS_EXITED || code != 0) {
	    result = TCL_ERROR;
	    sprintf(msg1, "%lu", resolvedPid);
	    if (WIFEXITED(waitStatus)) {
	    if (waitStatus == TCL_PROCESS_EXITED) {
		if (interp != NULL) {
		    sprintf(msg2, "%u", WEXITSTATUS(waitStatus));
		    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
		    Tcl_SetObjErrorCode(interp, error);
		}
		abnormalExit = 1;
	    } else if (interp != NULL) {
		const char *p;

		if (WIFSIGNALED(waitStatus)) {
		    p = Tcl_SignalMsg(WTERMSIG(waitStatus));
		    Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
			    Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL);
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "child killed: %s\n", p));
		} else if (WIFSTOPPED(waitStatus)) {
		    p = Tcl_SignalMsg(WSTOPSIG(waitStatus));
		    Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
		Tcl_SetObjErrorCode(interp, error);
			    Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL);
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		Tcl_SetObjResult(interp, msg);
			    "child suspended: %s\n", p));
		} else {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "child wait status didn't make sense\n", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
			    "ODDWAITRESULT", msg1, NULL);
		}
	    }
	    }
	    Tcl_DecrRefCount(error);
	    Tcl_DecrRefCount(msg);
	}
    }

    /*
     * Read the standard error file. If there's anything there, then return an
     * error and add the file's contents to the result string.
     */
932
933
934
935
936
937
938

939
940
941
942
943
944
945
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909







+







	if (result != TCL_OK) {
	    goto error;
	}
	Tcl_DStringFree(&execBuffer);

	pidPtr[numPids] = pid;
	numPids++;
	TclProcessCreated(pid);

	/*
	 * Close off our copies of file descriptors that were set up for this
	 * child, then set up the input for the next child.
	 */

	if ((curInFile != NULL) && (curInFile != inputFile)) {

Changes to generic/tclPkg.c.

61
62
63
64
65
66
67












68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90









91
92
93
94
95
96
97
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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







+
+
+
+
+
+
+
+
+
+
+
+




















-
-
-
+
+
+
+
+
+
+
+
+







				 * (malloc'ed). NULL means the package doesn't
				 * exist in this interpreter yet. */
    PkgAvail *availPtr;		/* First in list of all available versions of
				 * this package. */
    const void *clientData;	/* Client data. */
} Package;

typedef struct Require {
    void * clientDataPtr;
    const char *name;
    Package *pkgPtr;
    char *versionToProvide;
} Require;

typedef struct RequireProcArgs {
    const char *name;
    void *clientDataPtr;
} RequireProcArgs;

/*
 * Prototypes for functions defined in this file:
 */

static int		CheckVersionAndConvert(Tcl_Interp *interp,
			    const char *string, char **internal, int *stable);
static int		CompareVersions(char *v1i, char *v2i,
			    int *isMajorPtr);
static int		CheckRequirement(Tcl_Interp *interp,
			    const char *string);
static int		CheckAllRequirements(Tcl_Interp *interp, int reqc,
			    Tcl_Obj *const reqv[]);
static int		RequirementSatisfied(char *havei, const char *req);
static int		SomeRequirementSatisfied(char *havei, int reqc,
			    Tcl_Obj *const reqv[]);
static void		AddRequirementsToResult(Tcl_Interp *interp, int reqc,
			    Tcl_Obj *const reqv[]);
static void		AddRequirementsToDString(Tcl_DString *dstring,
			    int reqc, Tcl_Obj *const reqv[]);
static Package *	FindPackage(Tcl_Interp *interp, const char *name);
static const char *	PkgRequireCore(Tcl_Interp *interp, const char *name,
			    int reqc, Tcl_Obj *const reqv[],
			    void *clientDataPtr);
static int		PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result);
static int		TclNRPkgRequireProc(ClientData clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]);
static int		SelectPackage(ClientData data[], Tcl_Interp *interp, int result);
static int		SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result);
static int		TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result);

/*
 * Helper macros.
 */

#define DupBlock(v,s,len) \
    ((v) = ckalloc(len), memcpy((v),(s),(len)))
361
362
363
364
365
366
367
368




369
370
371
372
373
374
375
376
377
378
379
380
381
382






383
384
385
386
387
388
389
390
391
392
393
394
395
396

397
398
399




400
401
402
403









404
405
406
407
408


409
410
411
412



413
414
415
416
417
418




















419
420
421
422

423
424
425
426

427
428
429
430

431
432
433
434
435
436
437

438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489

490
491
492
493
494
495

496
497
498
499
500
501

502
503
504
505

506
507
508

509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561

562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583

584
585
586
587
588
589
590
591
592
593

594
595
596
597
598
599
600
601

602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675




676


677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696













































697
698
699
700
701

702
703
704
705
706

707
708
709
710

711
712
713
714
715
716
717
718

719
720
721
722

723
724
725
726
727
728































729








730





































































































































































































731















































732
733
734
735
736
737
738
379
380
381
382
383
384
385

386
387
388
389
390
391
392
393
394
395
396
397
398
399




400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420



421
422
423
424




425
426
427
428
429
430
431
432
433
434
435
436


437
438




439
440
441






442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461




462


463

464




465







466




















































467






468






469
470



471



472


















473




























474





475






















476










477








478










































































479
480
481
482
483
484
485




















486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534

535
536
537
538


539
540
541
542

543
544
545
546
547
548
549
550

551
552
553
554

555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592

593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798

799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852







-
+
+
+
+










-
-
-
-
+
+
+
+
+
+














+
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+



-
-
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-

-
+
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
+

-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+

+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+



-
-
+



-
+







-
+



-
+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    }

    /*
     * Translate between old and new API, and defer to the new function.
     */

    if (version == NULL) {
	result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr);
	if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
	    result = Tcl_GetStringResult(interp);
	    Tcl_ResetResult(interp);
	}
    } else {
	if (exact && TCL_OK
		!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
	    return NULL;
	}
	ov = Tcl_NewStringObj(version, -1);
	if (exact) {
	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
	}
	Tcl_IncrRefCount(ov);
	result = PkgRequireCore(interp, name, 1, &ov, clientDataPtr);
	TclDecrRefCount(ov);
    }

	if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
	    result = Tcl_GetStringResult(interp);
	    Tcl_ResetResult(interp);
	}
	TclDecrRefCount(ov);
    }
    return result;
}

int
Tcl_PkgRequireProc(
    Tcl_Interp *interp,		/* Interpreter in which package is now
				 * available. */
    const char *name,		/* Name of desired package. */
    int reqc,			/* Requirements constraining the desired
				 * version. */
    Tcl_Obj *const reqv[],	/* 0 means to use the latest version
				 * available. */
    void *clientDataPtr)
{
    RequireProcArgs args;
    const char *result =
	    PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);

    args.name = name;
    args.clientDataPtr = clientDataPtr;
    return Tcl_NRCallObjProc(interp, TclNRPkgRequireProc, (void *)&args, reqc, reqv);
}
    if (result == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));

static int
TclNRPkgRequireProc(
    ClientData clientData,
    Tcl_Interp *interp,
    int reqc,
    Tcl_Obj *const reqv[]) {
    RequireProcArgs *args = clientData;
    Tcl_NRAddCallback(interp, PkgRequireCore, (void *)args->name, INT2PTR(reqc), (void *)reqv, args->clientDataPtr);
    return TCL_OK;
}

static const char *
PkgRequireCore(
static int
PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result)
    Tcl_Interp *interp,		/* Interpreter in which package is now
				 * available. */
    const char *name,		/* Name of desired package. */
    int reqc,			/* Requirements constraining the desired
{
    const char *name = data[0];
    int reqc = PTR2INT(data[1]);
				 * version. */
    Tcl_Obj *const reqv[],	/* 0 means to use the latest version
				 * available. */
    void *clientDataPtr)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *const *reqv = data[2];
    int code = CheckAllRequirements(interp, reqc, reqv);
    Require *reqPtr;
    if (code != TCL_OK) {
	return code;
    }
    reqPtr = ckalloc(sizeof(Require));
    Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL);
    reqPtr->clientDataPtr = data[3];
    reqPtr->name = name;
    reqPtr->pkgPtr = FindPackage(interp, name);
    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreStep1);
    } else {
	Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
    }
    return TCL_OK;
}

static int
    Package *pkgPtr;
    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
    char *availVersion, *bestVersion;
				/* Internal rep. of versions */
PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result) {
    int availStable, code, satisfies, pass;
    char *script, *pkgVersionI;
    Tcl_DString command;

    char *script;
    if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) {
	return NULL;
    }

    Require *reqPtr = data[0];
    /*
     * It can take up to three passes to find the package: one pass to run the
     * "package unknown" script, one to run the "package ifneeded" script for
     * a specific version, and a final pass to lookup the package loaded by
     * the "package ifneeded" script.
     */

    int reqc = PTR2INT(data[1]);
    for (pass=1 ;; pass++) {
	pkgPtr = FindPackage(interp, name);
	if (pkgPtr->version != NULL) {
	    break;
	}

	/*
	 * Check whether we're already attempting to load some version of this
	 * package (circular dependency detection).
	 */

	if (pkgPtr->clientData != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "circular package dependency:"
		    " attempt to provide %s %s requires %s",
		    name, (char *) pkgPtr->clientData, name));
	    AddRequirementsToResult(interp, reqc, reqv);
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
	    return NULL;
	}

	/*
	 * The package isn't yet present. Search the list of available
	 * versions and invoke the script for the best available version. We
	 * are actually locating the best, and the best stable version. One of
	 * them is then chosen based on the selection mode.
	 */

	bestPtr = NULL;
	bestStablePtr = NULL;
	bestVersion = NULL;

	for (availPtr = pkgPtr->availPtr; availPtr != NULL;
		availPtr = availPtr->nextPtr) {
	    if (CheckVersionAndConvert(interp, availPtr->version,
		    &availVersion, &availStable) != TCL_OK) {
		/*
		 * The provided version number has invalid syntax. This
		 * should not happen. This should have been caught by the
		 * 'package ifneeded' registering the package.
		 */

		continue;
	    }

	    if (bestPtr != NULL) {
		int res = CompareVersions(availVersion, bestVersion, NULL);

		/*
		 * Note: Use internal reps!
		 */

    Tcl_Obj **const reqv = data[2];
		if (res <= 0) {
		    /*
		     * The version of the package sought is not as good as the
		     * currently selected version. Ignore it.
		     */

    const char *name = reqPtr->name /* Name of desired package. */;
		    ckfree(availVersion);
		    availVersion = NULL;
		    continue;
		}
	    }

    if (reqPtr->pkgPtr->version == NULL) {
	    /*
	     * We have found a version which is better than our max.
	     */

	     * The package is not in the database. If there is a "package unknown"
	    if (reqc > 0) {
		/* Check satisfaction of requirements. */

	     * command, invoke it.
		satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
		if (!satisfies) {
		    ckfree(availVersion);
		    availVersion = NULL;
		    continue;
		}
	    }

	    bestPtr = availPtr;

	    if (bestVersion != NULL) {
		ckfree(bestVersion);
	    }
	    bestVersion = availVersion;

	    /*
	     * If this new best version is stable then it also has to be
	     * better than the max stable version found so far.
	     */

	    if (availStable) {
		bestStablePtr = availPtr;
	    }
	}

	if (bestVersion != NULL) {
	    ckfree(bestVersion);
	}

	/*
	 * Now choose a version among the two best. For 'latest' we simply
	 * take (actually keep) the best. For 'stable' we take the best
	 * stable, if there is any, or the best if there is nothing stable.
	 */

	if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
		&& (bestStablePtr != NULL)) {
	    bestPtr = bestStablePtr;
	}

	if (bestPtr != NULL) {
	    /*
	     * We found an ifneeded script for the package. Be careful while
	     * executing it: this could cause reentrancy, so (a) protect the
	     * script itself from deletion and (b) don't assume that bestPtr
	     * will still exist when the script completes.
	     */

	    char *versionToProvide = bestPtr->version;
	    PkgFiles *pkgFiles;
	    PkgName *pkgName;
	    script = bestPtr->script;

	    script = ((Interp *) interp)->packageUnknown;
	    pkgPtr->clientData = versionToProvide;
	    Tcl_Preserve(versionToProvide);
	    Tcl_Preserve(script);
	    pkgFiles = TclInitPkgFiles(interp);
	    /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */
	    pkgName = ckalloc(sizeof(PkgName) + strlen(name));
	    pkgName->nextPtr = pkgFiles->names;
	    strcpy(pkgName->name, name);
	    pkgFiles->names = pkgName;
	    if (bestPtr->pkgIndex) {
		TclPkgFileSeen(interp, bestPtr->pkgIndex);
	    }
	    code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
	    /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
	    pkgFiles->names = pkgName->nextPtr;
	    ckfree(pkgName);
	    Tcl_Release(script);

	    pkgPtr = FindPackage(interp, name);
	    if (code == TCL_OK) {
		Tcl_ResetResult(interp);
		if (pkgPtr->version == NULL) {
	    if (script == NULL) {
		    code = TCL_ERROR;
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "attempt to provide package %s %s failed:"
			    " no version of package %s provided",
			    name, versionToProvide, name));
		    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
			    NULL);
		} else {
		    char *pvi, *vi;

		Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
		    if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
			    NULL) != TCL_OK) {
			code = TCL_ERROR;
		    } else if (CheckVersionAndConvert(interp,
			    versionToProvide, &vi, NULL) != TCL_OK) {
			ckfree(pvi);
			code = TCL_ERROR;
		    } else {
	    } else {
			int res = CompareVersions(pvi, vi, NULL);

			ckfree(pvi);
			ckfree(vi);
			if (res != 0) {
			    code = TCL_ERROR;
			    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
				    "attempt to provide package %s %s failed:"
				    " package %s %s provided instead",
				    name, versionToProvide,
				    name, pkgPtr->version));
			    Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
				    "WRONGPROVIDE", NULL);
			}
		    }
		}
	    } else if (code != TCL_ERROR) {
		Tcl_Obj *codePtr = Tcl_NewIntObj(code);

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"attempt to provide package %s %s failed:"
			" bad return code: %s",
			name, versionToProvide, TclGetString(codePtr)));
		Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
		TclDecrRefCount(codePtr);
		code = TCL_ERROR;
	    }

	    if (code == TCL_ERROR) {
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (\"package ifneeded %s %s\" script)",
			name, versionToProvide));
	    }
	    Tcl_Release(versionToProvide);

	    if (code != TCL_OK) {
		/*
		 * Take a non-TCL_OK code from the script as an indication the
		 * package wasn't loaded properly, so the package system
		 * should not remember an improper load.
		 *
		 * This is consistent with our returning NULL. If we're not
		 * willing to tell our caller we got a particular version, we
		 * shouldn't store that version for telling future callers
		 * either.
		 */

		if (pkgPtr->version != NULL) {
		    ckfree(pkgPtr->version);
		    pkgPtr->version = NULL;
		}
		pkgPtr->clientData = NULL;
		return NULL;
	    }

	    break;
	}

	/*
	 * The package is not in the database. If there is a "package unknown"
	 * command, invoke it (but only on the first pass; after that, we
	 * should not get here in the first place).
	 */

	if (pass > 1) {
	    break;
	}

	script = ((Interp *) interp)->packageUnknown;
	if (script != NULL) {
	    Tcl_DStringInit(&command);
	    Tcl_DStringAppend(&command, script, -1);
	    Tcl_DStringAppendElement(&command, name);
	    AddRequirementsToDString(&command, reqc, reqv);
		Tcl_DStringInit(&command);
		Tcl_DStringAppend(&command, script, -1);
		Tcl_DStringAppendElement(&command, name);
		AddRequirementsToDString(&command, reqc, reqv);

		Tcl_NRAddCallback(interp, PkgRequireCoreStep2, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
		Tcl_NREvalObj(interp,
	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
		    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
	    Tcl_DStringFree(&command);

	    if ((code != TCL_OK) && (code != TCL_ERROR)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad return code: %d", code));
		Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
		code = TCL_ERROR;
	    }
	    if (code == TCL_ERROR) {
		Tcl_AddErrorInfo(interp,
			"\n    (\"package unknown\" script)");
		return NULL;
	    }
	    Tcl_ResetResult(interp);
	}
    }

    if (pkgPtr->version == NULL) {
		    Tcl_NewStringObj(Tcl_DStringValue(&command), Tcl_DStringLength(&command)),
		    TCL_EVAL_GLOBAL
		);
		Tcl_DStringFree(&command);
	    }
	    return TCL_OK;
    } else {
	Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
    }
    return TCL_OK;
}

static int
PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result) {
    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    const char *name = reqPtr->name /* Name of desired package. */;
    if ((result != TCL_OK) && (result != TCL_ERROR)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad return code: %d", result));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
	result = TCL_ERROR;
    }
    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp,
		"\n    (\"package unknown\" script)");
	return result;
    }
    Tcl_ResetResult(interp);
    /* pkgPtr may now be invalid, so refresh it. */
    reqPtr->pkgPtr = FindPackage(interp, name);
    Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreFinal);
    return TCL_OK;
}

static int
PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) {
    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]), satisfies;
    Tcl_Obj **const reqv = data[2];
    char *pkgVersionI;
    void *clientDataPtr = reqPtr->clientDataPtr;
    const char *name = reqPtr->name /* Name of desired package. */;
    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't find package %s", name));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
	AddRequirementsToResult(interp, reqc, reqv);
	return NULL;
	return TCL_ERROR;
    }

    /*
     * At this point we know that the package is present. Make sure that the
     * provided version meets the current requirements.
     * Ensure that the provided version meets the current requirements.
     */

    if (reqc != 0) {
	CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
	CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pkgVersionI, NULL);
	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);

	ckfree(pkgVersionI);

	if (!satisfies) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "version conflict for package \"%s\": have %s, need",
		    name, pkgPtr->version));
		    name, reqPtr->pkgPtr->version));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
		    NULL);
	    AddRequirementsToResult(interp, reqc, reqv);
	    return NULL;
	    return TCL_ERROR;
	}
    }

    if (clientDataPtr) {
	const void **ptr = (const void **) clientDataPtr;

	*ptr = reqPtr->pkgPtr->clientData;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(reqPtr->pkgPtr->version, -1));
    return TCL_OK;
}

static int
PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) {
    ckfree(data[0]);
    return result;
}


static int
SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
    char *availVersion, *bestVersion, *bestStableVersion;
				/* Internal rep. of versions */
    int availStable, satisfies;
    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    const char *name = reqPtr->name;
    Package *pkgPtr = reqPtr->pkgPtr;
    Interp *iPtr = (Interp *) interp;

    /*
     * Check whether we're already attempting to load some version of this
     * package (circular dependency detection).
     */

	*ptr = pkgPtr->clientData;
    if (pkgPtr->clientData != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"circular package dependency:"
		" attempt to provide %s %s requires %s",
		name, (char *) pkgPtr->clientData, name));
	AddRequirementsToResult(interp, reqc, reqv);
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
	return TCL_ERROR;
    }

    /*
     * The package isn't yet present. Search the list of available
     * versions and invoke the script for the best available version. We
     * are actually locating the best, and the best stable version. One of
     * them is then chosen based on the selection mode.
     */

    bestPtr = NULL;
    bestStablePtr = NULL;
    bestVersion = NULL;
    bestStableVersion = NULL;

    for (availPtr = pkgPtr->availPtr; availPtr != NULL;
	    availPtr = availPtr->nextPtr) {
	if (CheckVersionAndConvert(interp, availPtr->version,
		&availVersion, &availStable) != TCL_OK) {
	    /*
	     * The provided version number has invalid syntax. This
	     * should not happen. This should have been caught by the
	     * 'package ifneeded' registering the package.
	     */

	    continue;
	}

	/* Check satisfaction of requirements before considering the current version further. */
	if (reqc > 0) {
	    satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
	    if (!satisfies) {
		ckfree(availVersion);
		availVersion = NULL;
		continue;
	    }
	}

	if (bestPtr != NULL) {
	    int res = CompareVersions(availVersion, bestVersion, NULL);

	    /*
	     * Note: Used internal reps in the comparison!
	     */

	    if (res > 0) {
		/*
		 * The version of the package sought is better than the
		 * currently selected version.
		 */
		ckfree(bestVersion);
		bestVersion = NULL;
		goto newbest;
	    }
	} else {
	newbest:
	    /* We have found a version which is better than our max. */

	    bestPtr = availPtr;
	    CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
	}

	if (!availStable) {
	    ckfree(availVersion);
	    availVersion = NULL;
	    continue;
	}

	if (bestStablePtr != NULL) {
	    int res = CompareVersions(availVersion, bestStableVersion, NULL);

	    /*
	     * Note: Used internal reps in the comparison!
	     */

	    if (res > 0) {
		/*
		 * This stable version of the package sought is better
		 * than the currently selected stable version.
		 */
		ckfree(bestStableVersion);
		bestStableVersion = NULL;
		goto newstable;
	    }
	} else {
	newstable:
	    /* We have found a stable version which is better than our max stable. */
	    bestStablePtr = availPtr;
	    CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL);
	}

	ckfree(availVersion);
	availVersion = NULL;
    } /* end for */

    /*
     * Clean up memorized internal reps, if any.
     */

    if (bestVersion != NULL) {
	ckfree(bestVersion);
	bestVersion = NULL;
    }

    if (bestStableVersion != NULL) {
	ckfree(bestStableVersion);
	bestStableVersion = NULL;
    }

    /*
     * Now choose a version among the two best. For 'latest' we simply
     * take (actually keep) the best. For 'stable' we take the best
     * stable, if there is any, or the best if there is nothing stable.
     */

    if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
	    && (bestStablePtr != NULL)) {
	bestPtr = bestStablePtr;
    }

    if (bestPtr == NULL) {
	Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
    } else {
	/*
	 * We found an ifneeded script for the package. Be careful while
	 * executing it: this could cause reentrancy, so (a) protect the
	 * script itself from deletion and (b) don't assume that bestPtr
	 * will still exist when the script completes.
	 */

	char *versionToProvide = bestPtr->version;
	PkgFiles *pkgFiles;
	PkgName *pkgName;

	Tcl_Preserve(versionToProvide);
	pkgPtr->clientData = versionToProvide;

	pkgFiles = TclInitPkgFiles(interp);
	/* Push "ifneeded" package name in "tclPkgFiles" assocdata. */
	pkgName = ckalloc(sizeof(PkgName) + strlen(name));
	pkgName->nextPtr = pkgFiles->names;
	strcpy(pkgName->name, name);
	pkgFiles->names = pkgName;
	if (bestPtr->pkgIndex) {
	    TclPkgFileSeen(interp, bestPtr->pkgIndex);
	}
	reqPtr->versionToProvide = versionToProvide;
	Tcl_NRAddCallback(interp, SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv, data[3]);
	Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1), TCL_EVAL_GLOBAL);
    }
    return TCL_OK;
}

static int
SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) {
    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    const char *name = reqPtr->name;
    char *versionToProvide = reqPtr->versionToProvide;

    /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
    PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    PkgName *pkgName = pkgFiles->names;
    pkgFiles->names = pkgName->nextPtr;
    ckfree(pkgName);

    reqPtr->pkgPtr = FindPackage(interp, name);
    if (result == TCL_OK) {
	Tcl_ResetResult(interp);
	if (reqPtr->pkgPtr->version == NULL) {
	    result = TCL_ERROR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to provide package %s %s failed:"
		    " no version of package %s provided",
		    name, versionToProvide, name));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
		    NULL);
	} else {
	    char *pvi, *vi;

	    if (CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pvi,
		    NULL) != TCL_OK) {
		result = TCL_ERROR;
	    } else if (CheckVersionAndConvert(interp,
		    versionToProvide, &vi, NULL) != TCL_OK) {
		ckfree(pvi);
		result = TCL_ERROR;
	    } else {
		int res = CompareVersions(pvi, vi, NULL);

		ckfree(pvi);
		ckfree(vi);
		if (res != 0) {
		    result = TCL_ERROR;
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "attempt to provide package %s %s failed:"
			    " package %s %s provided instead",
			    name, versionToProvide,
    return pkgPtr->version;
			    name, reqPtr->pkgPtr->version));
		    Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
			    "WRONGPROVIDE", NULL);
		}
	    }
	}
    } else if (result != TCL_ERROR) {
	Tcl_Obj *codePtr = Tcl_NewIntObj(result);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"attempt to provide package %s %s failed:"
		" bad return code: %s",
		name, versionToProvide, TclGetString(codePtr)));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
	TclDecrRefCount(codePtr);
	result = TCL_ERROR;
    }

    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"package ifneeded %s %s\" script)",
		name, versionToProvide));
    }
    Tcl_Release(versionToProvide);

    if (result != TCL_OK) {
	/*
	 * Take a non-TCL_OK code from the script as an indication the
	 * package wasn't loaded properly, so the package system
	 * should not remember an improper load.
	 *
	 * This is consistent with our returning NULL. If we're not
	 * willing to tell our caller we got a particular version, we
	 * shouldn't store that version for telling future callers
	 * either.
	 */

	if (reqPtr->pkgPtr->version != NULL) {
	    ckfree(reqPtr->pkgPtr->version);
	    reqPtr->pkgPtr->version = NULL;
	}
	reqPtr->pkgPtr->clientData = NULL;
	return result;
    }

    Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgPresent / Tcl_PkgPresentEx --
 *
830
831
832
833
834
835
836









837
838
839
840

841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857

858
859
860
861
862
863
864
865

866
867
868
869
870
871
872
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962

963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979

980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996







+
+
+
+
+
+
+
+
+



-
+
















-
+








+







 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_PackageObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, NULL, objc, objv);
}

	/* ARGSUSED */
int
Tcl_PackageObjCmd(
TclNRPackageObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const pkgOptions[] = {
	"files",  "forget",  "ifneeded", "names",   "prefer",
	"present", "provide", "require",  "unknown", "vcompare",
	"versions", "vsatisfies", NULL
    };
    enum pkgOptions {
	PKG_FILES,  PKG_FORGET,  PKG_IFNEEDED, PKG_NAMES,   PKG_PREFER,
	PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE,  PKG_UNKNOWN, PKG_VCOMPARE,
	PKG_VERSIONS, PKG_VSATISFIES
    };
    Interp *iPtr = (Interp *) interp;
    int optionIndex, exact, i, satisfies;
    int optionIndex, exact, i, newobjc, satisfies;
    PkgAvail *availPtr, *prevPtr;
    Package *pkgPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable *tablePtr;
    const char *version;
    const char *argv2, *argv3, *argv4;
    char *iva = NULL, *ivb = NULL;
    Tcl_Obj *objvListPtr, **newObjvPtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0,
917
918
919
920
921
922
923

924
925
926
927
928
929
930
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055







+







	    while (pkgPtr->availPtr != NULL) {
		availPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr->nextPtr;
		Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		ckfree(availPtr);
	    }
	    ckfree(pkgPtr);
	}
	break;
    }
970
971
972
973
974
975
976

977
978
979
980
981
982
983
984
985
986
987
988

989
990
991
992
993
994
995
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113

1114
1115
1116
1117
1118
1119
1120
1121







+











-
+







		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj(availPtr->script, -1));
		    return TCL_OK;
		}
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		break;
	    }
	}
	ckfree(argv3i);

	if (objc == 4) {
	    return TCL_OK;
	}
	if (availPtr == NULL) {
	    availPtr = ckalloc(sizeof(PkgAvail));
	    availPtr->pkgIndex = 0;
	    availPtr->pkgIndex = NULL;
	    DupBlock(availPtr->version, argv3, (unsigned) length + 1);

	    if (prevPtr == NULL) {
		availPtr->nextPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr;
	    } else {
		availPtr->nextPtr = prevPtr->nextPtr;
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128

1129

1130
1131
1132
1133







1134


1135
1136
1137




1138




1139







1140
1141
1142
1143
1144
1145
1146
1228
1229
1230
1231
1232
1233
1234

1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256




1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278

1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292







-



















+

+
-
-
-
-
+
+
+
+
+
+
+

+
+



+
+
+
+

+
+
+
+
-
+
+
+
+
+
+
+







	}

	version = NULL;

	argv2 = TclGetString(objv[2]);
	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
	    Tcl_Obj *ov;
	    int res;

	    if (objc != 5) {
		goto requireSyntax;
	    }

	    version = TclGetString(objv[4]);
	    if (CheckVersionAndConvert(interp, version, NULL,
		    NULL) != TCL_OK) {
		return TCL_ERROR;
	    }

	    /*
	     * Create a new-style requirement for the exact version.
	     */

	    ov = Tcl_NewStringObj(version, -1);
	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
	    version = NULL;
	    argv3 = TclGetString(objv[3]);
	    Tcl_IncrRefCount(objv[3]);

	    objvListPtr = Tcl_NewListObj(0, NULL);
	    Tcl_IncrRefCount(ov);
	    res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL);
	    TclDecrRefCount(ov);
	    return res;
	    Tcl_IncrRefCount(objvListPtr);
	    Tcl_ListObjAppendElement(interp, objvListPtr, ov);
	    Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);

	    Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL, NULL);
	    Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv3, INT2PTR(newobjc), newObjvPtr, NULL);
	    return TCL_OK;
	} else {
	    int i, newobjc = objc-3;
	    Tcl_Obj *const *newobjv = objv + 3;
	    if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
		return TCL_ERROR;
	    }
	    objvListPtr = Tcl_NewListObj(0, NULL);
	    Tcl_IncrRefCount(objvListPtr);
	    Tcl_IncrRefCount(objv[2]);
	    for (i = 0; i < newobjc; i++) {

		/*
		 * Tcl_Obj structures may have come from another interpreter,
		 * so duplicate them.
		 */
	    return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL);

		Tcl_ListObjAppendElement(interp, objvListPtr, Tcl_DuplicateObj(newobjv[i]));
	    }
	    Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
	    Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL, NULL);
	    Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv2, INT2PTR(newobjc), newObjvPtr, NULL);
	    return TCL_OK;
	}
	break;
    case PKG_UNKNOWN: {
	int length;

	if (objc == 2) {
	    if (iPtr->packageUnknown != NULL) {
1272
1273
1274
1275
1276
1277
1278







1279
1280
1281
1282
1283
1284
1285
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438







+
+
+
+
+
+
+







	break;
    }
    default:
	Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
    }
    return TCL_OK;
}

static int
TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result) {
    TclDecrRefCount((Tcl_Obj *)data[0]);
    TclDecrRefCount((Tcl_Obj *)data[1]);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * FindPackage --
 *
 *	This function finds the Package record for a particular package in a
1353
1354
1355
1356
1357
1358
1359

1360
1361
1362
1363
1364
1365
1366
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520







+







	while (pkgPtr->availPtr != NULL) {
	    availPtr = pkgPtr->availPtr;
	    pkgPtr->availPtr = availPtr->nextPtr;
	    Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
	    Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
	    if (availPtr->pkgIndex) {
		Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		availPtr->pkgIndex = NULL;
	    }
	    ckfree(availPtr);
	}
	ckfree(pkgPtr);
    }
    Tcl_DeleteHashTable(&iPtr->packageTable);
    if (iPtr->packageUnknown != NULL) {

Changes to generic/tclPkgConfig.c.

36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50







-
+







#include "tclInt.h"

/*
 * Use C preprocessor statements to define the various values for the embedded
 * configuration information.
 */

#ifdef TCL_THREADS
#if TCL_THREADS
#  define  CFG_THREADED		"1"
#else
#  define  CFG_THREADED		"0"
#endif

#ifdef TCL_MEM_DEBUG
#  define CFG_MEMDEBUG		"1"
101
102
103
104
105
106
107


108
109
110
111
112
113
114
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116







+
+







    /* Runtime paths to various stuff */

    {"libdir,runtime",		CFG_RUNTIME_LIBDIR},
    {"bindir,runtime",		CFG_RUNTIME_BINDIR},
    {"scriptdir,runtime",	CFG_RUNTIME_SCRDIR},
    {"includedir,runtime",	CFG_RUNTIME_INCDIR},
    {"docdir,runtime",		CFG_RUNTIME_DOCDIR},
    {"dllfile,runtime",		CFG_RUNTIME_DLLFILE},
    {"zipfile,runtime",		CFG_RUNTIME_ZIPFILE},

    /* Installation paths to various stuff */

    {"libdir,install",		CFG_INSTALL_LIBDIR},
    {"bindir,install",		CFG_INSTALL_BINDIR},
    {"scriptdir,install",	CFG_INSTALL_SCRDIR},
    {"includedir,install",	CFG_INSTALL_INCDIR},

Changes to generic/tclPort.h.

20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
35

36
37
38
39
40
41

42
43
20
21
22
23
24
25
26

27








28






29
30
31







-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+


#if defined(_WIN32)
#   include "tclWinPort.h"
#else
#   include "tclUnixPort.h"
#endif
#include "tcl.h"

#if !defined(LLONG_MIN)
#define UWIDE_MAX ((Tcl_WideUInt)-1)
#   ifdef TCL_WIDE_INT_IS_LONG
#      define LLONG_MIN LONG_MIN
#   else
#      ifdef LLONG_BIT
#         define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1)))
#      else
/* Assume we're on a system with a 64-bit 'long long' type */
#         define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63))
#define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1))
#      endif
#   endif
/* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */
#   define LLONG_MAX (~LLONG_MIN)
#endif

#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1))

#endif /* _TCLPORT */

Changes to generic/tclProc.c.

120
121
122
123
124
125
126
127
128


129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175

176
177
178

179
180
181
182
183
184
185
186
187
188
189

190
191
192
193
194
195
196
197
198

199
200
201
202
203
204
205
206
120
121
122
123
124
125
126


127
128
129
130

131
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
161
162
163
164
165

166
167
168

169
170
171
172
173







174









175

176
177
178
179
180
181
182







-
-
+
+


-












-
-
-
+
+
+




-
+



-
+


-
+
-
-
-
-
-
-
-
-








-
+


-
+




-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    register Interp *iPtr = (Interp *) interp;
    Proc *procPtr;
    const char *fullName;
    const char *procName, *procArgs, *procBody;
    const char *procName;
    const char *simpleName, *procArgs, *procBody;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
    Tcl_Command cmd;
    Tcl_DString ds;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "name args body");
	return TCL_ERROR;
    }

    /*
     * Determine the namespace where the procedure should reside. Unless the
     * command name includes namespace qualifiers, this will be the current
     * namespace.
     */

    fullName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
    procName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, procName, NULL, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\": unknown namespace",
		fullName));
		procName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
	return TCL_ERROR;
    }
    if (procName == NULL) {
    if (simpleName == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\": bad procedure name",
		fullName));
		procName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
	return TCL_ERROR;
    }
    if ((nsPtr != iPtr->globalNsPtr)
	    && (procName != NULL) && (procName[0] == ':')) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\" in non-global namespace with"
		" name starting with \":\"", procName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
	return TCL_ERROR;
    }

    /*
     * Create the data structure to represent the procedure.
     */

    if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
    if (TclCreateProc(interp, nsPtr, simpleName, objv[2], objv[3],
	    &procPtr) != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (creating proc \"");
	Tcl_AddErrorInfo(interp, procName);
	Tcl_AddErrorInfo(interp, simpleName);
	Tcl_AddErrorInfo(interp, "\")");
	return TCL_ERROR;
    }

    /*
     * Now create a command for the procedure. This will initially be in the
     * current namespace unless the procedure's name included namespace
     * qualifiers. To create the new command in the right namespace, we
     * generate a fully qualified name for it.
     */

    cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
    Tcl_DStringInit(&ds);
    if (nsPtr != iPtr->globalNsPtr) {
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	TclDStringAppendLiteral(&ds, "::");
    }
    Tcl_DStringAppend(&ds, procName, -1);

    cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
	    TclNRInterpProc, procPtr, TclProcDeleteProc);
	TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc);
    Tcl_DStringFree(&ds);

    /*
     * Now initialize the new procedure's cmdPtr field. This will be used
     * later when the procedure is called to determine what namespace the
     * procedure will run in. This will be different than the current
     * namespace if the proc was renamed into a different namespace.
     */
525
526
527
528
529
530
531

532

533
534
535


536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
501
502
503
504
505
506
507
508

509
510


511
512
513
514
515
516
517
518
519
520

521
522
523
524
525
526
527







+
-
+

-
-
+
+








-







	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
	nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length);
	nameLength = Tcl_NumUtfChars(argname, plen);
	if (fieldCount == 2) {
	    valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]),
		fieldValues[1]->length);
	    const char * value = TclGetString(fieldValues[1]);
	    valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length);
	} else {
	    valueLength = 0;
	}

	/*
	 * Check that the formal parameter name is a scalar.
	 */

	argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
	argnamei = argname;
	argnamelast = argname[plen-1];
	while (plen--) {
	    if (argnamei[0] == '(') {
		if (argnamelast == ')') {	/* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "formal parameter \"%s\" is an array element",
631
632
633
634
635
636
637
638

639
640
641
642
643
644
645
607
608
609
610
611
612
613

614
615
616
617
618
619
620
621







-
+







	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
	    localPtr->nextPtr = NULL;
	    localPtr->nameLength = Tcl_NumUtfChars(argname, fieldValues[0]->length);
	    localPtr->nameLength = nameLength;
	    localPtr->frameIndex = i;
	    localPtr->flags = VAR_ARGUMENT;
	    localPtr->resolveInfo = NULL;

	    if (fieldCount == 2) {
		localPtr->defValuePtr = fieldValues[1];
		Tcl_IncrRefCount(localPtr->defValuePtr);
708
709
710
711
712
713
714
715
716

717
718

719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738

739
740
741
742

743
744

745
746
747
748
749

750
751
752

753
754

755
756
757
758
759
760
761
762
763
764
765
766
684
685
686
687
688
689
690


691


692



693
















694




695


696





697



698


699





700
701
702
703
704
705
706







-
-
+
-
-
+
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
+
-
-
-
-
-
+
-
-
-
+
-
-
+
-
-
-
-
-







int
TclGetFrame(
    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
    const char *name,		/* String describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
    register Interp *iPtr = (Interp *) interp;
    int curLevel, level, result;
	int result;
    CallFrame *framePtr;

	Tcl_Obj obj;
    /*
     * Parse string to figure out which level number to go to.
     */

    result = 1;
    curLevel = iPtr->varFramePtr->level;
    if (*name== '#') {
	if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
	    goto levelError;
	}
    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
	if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
	    goto levelError;
	}
	level = curLevel - level;
    } else {
	level = curLevel - 1;
	result = 0;
    }

	obj.bytes = (char *) name;
    /*
     * Figure out which frame to use, and return it to the caller.
     */

	obj.length = strlen(name);
    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
	    framePtr = framePtr->callerVarPtr) {
	obj.typePtr = NULL;
	if (framePtr->level == level) {
	    break;
	}
    }
    if (framePtr == NULL) {
	result = TclObjGetFrame(interp, &obj, framePtrPtr);
	goto levelError;
    }

	TclFreeIntRep(&obj);
    *framePtrPtr = framePtr;
    return result;
	return result;

  levelError:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjGetFrame --
 *
790
791
792
793
794
795
796

797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815








816
817

818
819
820
821
822
823
824
825
826









827
828
829
830

831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853


854
855
856



857
858
859
860
861
862
863
864
865
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752




753
754
755
756
757
758
759
760
761

762
763
764
765
766





767
768
769
770
771
772
773
774
775
776
777
778

779
780
781
782
783
784
785
786
787
788
789

790
791
792
793
794
795
796
797
798
799
800
801
802
803



804
805
806


807
808
809
810
811
812
813







+















-
-
-
-
+
+
+
+
+
+
+
+

-
+




-
-
-
-
-
+
+
+
+
+
+
+
+
+



-
+










-












+
+
-
-
-
+
+
+
-
-







    Tcl_Obj *objPtr,		/* Object describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
    register Interp *iPtr = (Interp *) interp;
    int curLevel, level, result;
    const char *name = NULL;
    Tcl_WideInt w;

    /*
     * Parse object to figure out which level number to go to.
     */

    result = 0;
    curLevel = iPtr->varFramePtr->level;

    /*
     * Check for integer first, since that has potential to spare us
     * a generation of a stringrep.
     */

    if (objPtr == NULL) {
	/* Do nothing */
    } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
	    && (level >= 0)) {
	level = curLevel - level;
	result = 1;
    } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
	Tcl_GetWideIntFromObj(NULL, objPtr, &w);
	if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
	    result = -1;
	} else {
	    level = curLevel - level;
	    result = 1;
	}
    } else if (objPtr->typePtr == &levelReferenceType) {
	level = (int) objPtr->internalRep.longValue;
	level = (int) objPtr->internalRep.wideValue;
	result = 1;
    } else {
	name = TclGetString(objPtr);
	if (name[0] == '#') {
	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
		TclFreeIntRep(objPtr);
		objPtr->typePtr = &levelReferenceType;
		objPtr->internalRep.longValue = level;
		result = 1;
	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
		if (level < 0 || (level > 0 && name[1] == '-')) {
		    result = -1;
		} else {
		    TclFreeIntRep(objPtr);
		    objPtr->typePtr = &levelReferenceType;
		    objPtr->internalRep.wideValue = level;
		    result = 1;
		}
	    } else {
		result = -1;
	    }
	} else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
	} else if (TclGetWideBitsFromObj(interp, objPtr, &w) == TCL_OK) {
	    /*
	     * If this were an integer, we'd have succeeded already.
	     * Docs say we have to treat this as a 'bad level'  error.
	     */
	    result = -1;
	}
    }

    if (result == 0) {
	level = curLevel - 1;
	name = "1";
    }
    if (result != -1) {
	if (level >= 0) {
	    CallFrame *framePtr;
	    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
		    framePtr = framePtr->callerVarPtr) {
		if (framePtr->level == level) {
		    *framePtrPtr = framePtr;
		    return result;
		}
	    }
	}
    }

	if (name == NULL) {
	    name = TclGetString(objPtr);
	}
    if (name == NULL) {
	name = TclGetString(objPtr);
    }
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
    return -1;
}

/*
 *----------------------------------------------------------------------
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1003
1004
1005
1006
1007
1008
1009

1010
1011
1012
1013
1014
1015
1016







-







static int
ProcWrongNumArgs(
    Tcl_Interp *interp,
    int skip)
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    register Proc *procPtr = framePtr->procPtr;
    register Var *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, i;
    Tcl_Obj **desiredObjs;
    const char *final = NULL;

    /*
     * Build up desired argument list for Tcl_WrongNumArgs
     */
1079
1080
1081
1082
1083
1084
1085

1086
1087
1088
1089





1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102













1103
1104
1105
1106
1107
1108
1109
1026
1027
1028
1029
1030
1031
1032
1033




1034
1035
1036
1037
1038
1039












1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059







+
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







	desiredObjs[0] = framePtr->objv[skip-1];
#else
	desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
#endif /* AVOID_HACKS_FOR_ITCL */
    }
    Tcl_IncrRefCount(desiredObjs[0]);

    if (localCt > 0) {
    defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
    for (i=1 ; i<=numArgs ; i++, defPtr++) {
	Tcl_Obj *argObj;
	Tcl_Obj *namePtr = localName(framePtr, i-1);
	register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);

	for (i=1 ; i<=numArgs ; i++, defPtr++) {
	    Tcl_Obj *argObj;
	    Tcl_Obj *namePtr = localName(framePtr, i-1);

	if (defPtr->value.objPtr != NULL) {
	    TclNewObj(argObj);
	    Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
	} else if (defPtr->flags & VAR_IS_ARGS) {
	    numArgs--;
	    final = "?arg ...?";
	    break;
	} else {
	    argObj = namePtr;
	    Tcl_IncrRefCount(namePtr);
	}
	desiredObjs[i] = argObj;
	    if (defPtr->value.objPtr != NULL) {
		TclNewObj(argObj);
		Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
	    } else if (defPtr->flags & VAR_IS_ARGS) {
		numArgs--;
		final = "?arg ...?";
		break;
	    } else {
		argObj = namePtr;
		Tcl_IncrRefCount(namePtr);
	    }
	    desiredObjs[i] = argObj;
	}
    }

    Tcl_ResetResult(interp);
    Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final);

    for (i=0 ; i<=numArgs ; i++) {
	Tcl_DecrRefCount(desiredObjs[i]);
2400
2401
2402
2403
2404
2405
2406
2407

2408
2409
2410
2411
2412
2413
2414
2350
2351
2352
2353
2354
2355
2356

2357
2358
2359
2360
2361
2362
2363
2364







-
+







FreeLambdaInternalRep(
    register Tcl_Obj *objPtr)	/* CmdName object with internal representation
				 * to free. */
{
    Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
    Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;

    if (procPtr->refCount-- == 1) {
    if (procPtr->refCount-- <= 1) {
	TclProcCleanupProc(procPtr);
    }
    TclDecrRefCount(nsObjPtr);
    objPtr->typePtr = NULL;
}

static int

Added generic/tclProcess.c.






























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * tclProcess.c --
 *
 *	This file implements the "tcl::process" ensemble for subprocess
 *	management as defined by TIP #462.
 *
 * Copyright (c) 2017 Frederic Bonnet.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * Autopurge flag. Process-global because of the way Tcl manages child
 * processes (see tclPipe.c).
 */

static int autopurge = 1;	/* Autopurge flag. */

/*
 * Hash tables that keeps track of all child process statuses. Keys are the
 * child process ids and resolved pids, values are (ProcessInfo *).
 */

typedef struct ProcessInfo {
    Tcl_Pid pid;		/* Process id. */
    int resolvedPid;		/* Resolved process id. */
    int purge;			/* Purge eventualy. */
    TclProcessWaitStatus status;/* Process status. */
    int code;			/* Error code, exit status or signal
				   number. */
    Tcl_Obj *msg;		/* Error message. */
    Tcl_Obj *error;		/* Error code. */
} ProcessInfo;
static Tcl_HashTable infoTablePerPid;
static Tcl_HashTable infoTablePerResolvedPid;
static int infoTablesInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(infoTablesMutex)

 /*
 * Prototypes for functions defined later in this file:
 */

static void		InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
			    int resolvedPid);
static void		FreeProcessInfo(ProcessInfo *info);
static int		RefreshProcessInfo(ProcessInfo *info, int options);
static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid,
			    int options, int *codePtr, Tcl_Obj **msgPtr,
			    Tcl_Obj **errorObjPtr);
static Tcl_Obj *	BuildProcessStatusObj(ProcessInfo *info);
static int		ProcessListObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ProcessStatusObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ProcessPurgeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ProcessAutopurgeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/*
 *----------------------------------------------------------------------
 *
 * InitProcessInfo --
 *
 *	Initializes the ProcessInfo structure.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory written.
 *
 *----------------------------------------------------------------------
 */

void
InitProcessInfo(
    ProcessInfo *info,		/* Structure to initialize. */
    Tcl_Pid pid,		/* Process id. */
    int resolvedPid)		/* Resolved process id. */
{
    info->pid = pid;
    info->resolvedPid = resolvedPid;
    info->purge = 0;
    info->status = TCL_PROCESS_UNCHANGED;
    info->code = 0;
    info->msg = NULL;
    info->error = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeProcessInfo --
 *
 *	Free the ProcessInfo structure.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory deallocated, Tcl_Obj refcount decreased.
 *
 *----------------------------------------------------------------------
 */

void
FreeProcessInfo(
    ProcessInfo *info)		/* Structure to free. */
{
    /*
     * Free stored Tcl_Objs.
     */

    if (info->msg) {
	Tcl_DecrRefCount(info->msg);
    }
    if (info->error) {
	Tcl_DecrRefCount(info->error);
    }

    /*
     * Free allocated structure.
     */

    ckfree(info);
}

/*
 *----------------------------------------------------------------------
 *
 * RefreshProcessInfo --
 *
 *	Refresh process info.
 *
 * Results:
 *	Nonzero if state changed, else zero.
 *
 * Side effects:
 *	May call WaitProcessStatus, which can block if WNOHANG option is set.
 *
 *----------------------------------------------------------------------
 */

int
RefreshProcessInfo(
    ProcessInfo *info,		/* Structure to refresh. */
    int options			/* Options passed to WaitProcessStatus. */
)
{
    if (info->status == TCL_PROCESS_UNCHANGED) {
	/*
	 * Refresh & store status.
	 */

	info->status = WaitProcessStatus(info->pid, info->resolvedPid,
		options, &info->code, &info->msg, &info->error);
	if (info->msg) Tcl_IncrRefCount(info->msg);
	if (info->error) Tcl_IncrRefCount(info->error);
	return (info->status != TCL_PROCESS_UNCHANGED);
    } else {
	/*
	 * No change.
	 */

	return 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * WaitProcessStatus --
 *
 *	Wait for process status to change.
 *
 * Results:
 *	TclProcessWaitStatus enum value.
 *
 * Side effects:
 *	May call WaitProcessStatus, which can block if WNOHANG option is set.
 *
 *----------------------------------------------------------------------
 */

TclProcessWaitStatus
WaitProcessStatus(
    Tcl_Pid pid,		/* Process id. */
    int resolvedPid,		/* Resolved process id. */
    int options,		/* Options passed to Tcl_WaitPid. */
    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_Obj **msgObjPtr,	/* If non-NULL, will receive error message. */
    Tcl_Obj **errorObjPtr)	/* If non-NULL, will receive error code. */
{
    int waitStatus;
    Tcl_Obj *errorStrings[5];
    const char *msg;

    pid = Tcl_WaitPid(pid, &waitStatus, options);
    if (pid == 0) {
	/*
	 * No change.
	 */

	return TCL_PROCESS_UNCHANGED;
    }

    /*
     * Get process status.
     */

    if (pid == (Tcl_Pid) -1) {
	/*
	 * POSIX errName msg
	 */

	msg = Tcl_ErrnoMsg(errno);
	if (errno == ECHILD) {
	    /*
	     * This changeup in message suggested by Mark Diekhans to
	     * remind people that ECHILD errors can occur on some
	     * systems if SIGCHLD isn't in its default state.
	     */

	    msg = "child process lost (is SIGCHLD ignored or trapped?)";
	}
	if (codePtr) *codePtr = errno;
	if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
		"error waiting for process to exit: %s", msg);
	if (errorObjPtr) {
	    errorStrings[0] = Tcl_NewStringObj("POSIX", -1);
	    errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
	    errorStrings[2] = Tcl_NewStringObj(msg, -1);
	    *errorObjPtr = Tcl_NewListObj(3, errorStrings);
	}
	return TCL_PROCESS_ERROR;
    } else if (WIFEXITED(waitStatus)) {
	if (codePtr) *codePtr = WEXITSTATUS(waitStatus);
	if (!WEXITSTATUS(waitStatus)) {
	    /*
	     * Normal exit.
	     */

	    if (msgObjPtr) *msgObjPtr = NULL;
	    if (errorObjPtr) *errorObjPtr = NULL;
	} else {
	    /*
	     * CHILDSTATUS pid code
	     *
	     * Child exited with a non-zero exit status.
	     */

	    if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
		    "child process exited abnormally", -1);
	    if (errorObjPtr) {
		errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1);
		errorStrings[1] = Tcl_NewIntObj(resolvedPid);
		errorStrings[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus));
		*errorObjPtr = Tcl_NewListObj(3, errorStrings);
	    }
	}
	return TCL_PROCESS_EXITED;
    } else if (WIFSIGNALED(waitStatus)) {
	/*
	 * CHILDKILLED pid sigName msg
	 *
	 * Child killed because of a signal.
	 */

	msg = Tcl_SignalMsg(WTERMSIG(waitStatus));
	if (codePtr) *codePtr = WTERMSIG(waitStatus);
	if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
		"child killed: %s", msg);
	if (errorObjPtr) {
	    errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1);
	    errorStrings[1] = Tcl_NewIntObj(resolvedPid);
	    errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1);
	    errorStrings[3] = Tcl_NewStringObj(msg, -1);
	    *errorObjPtr = Tcl_NewListObj(4, errorStrings);
	}
	return TCL_PROCESS_SIGNALED;
    } else if (WIFSTOPPED(waitStatus)) {
	/*
	 * CHILDSUSP pid sigName msg
	 *
	 * Child suspended because of a signal.
	 */

	msg = Tcl_SignalMsg(WSTOPSIG(waitStatus));
	if (codePtr) *codePtr = WSTOPSIG(waitStatus);
	if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
		"child suspended: %s", msg);
	if (errorObjPtr) {
	    errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1);
	    errorStrings[1] = Tcl_NewIntObj(resolvedPid);
	    errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1);
	    errorStrings[3] = Tcl_NewStringObj(msg, -1);
	    *errorObjPtr = Tcl_NewListObj(4, errorStrings);
	}
	return TCL_PROCESS_STOPPED;
    } else {
	/*
	 * TCL OPERATION EXEC ODDWAITRESULT
	 *
	 * Child wait status didn't make sense.
	 */

	if (codePtr) *codePtr = waitStatus;
	if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
		"child wait status didn't make sense\n", -1);
	if (errorObjPtr) {
	    errorStrings[0] = Tcl_NewStringObj("TCL", -1);
	    errorStrings[1] = Tcl_NewStringObj("OPERATION", -1);
	    errorStrings[2] = Tcl_NewStringObj("EXEC", -1);
	    errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1);
	    errorStrings[4] = Tcl_NewIntObj(resolvedPid);
	    *errorObjPtr = Tcl_NewListObj(5, errorStrings);
	}
	return TCL_PROCESS_UNKNOWN_STATUS;
    }
}


/*
 *----------------------------------------------------------------------
 *
 * BuildProcessStatusObj --
 *
 *	Build a list object with process status. The first element is always
 *	a standard Tcl return value, which can be either TCL_OK or TCL_ERROR.
 *	In the latter case, the second element is the error message and the
 *	third element is a Tcl error code (see tclvars).
 *
 * Results:
 *	A list object.
 *
 * Side effects:
 *	Tcl_Objs are created.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
BuildProcessStatusObj(
    ProcessInfo *info)
{
    Tcl_Obj *resultObjs[3];

    if (info->status == TCL_PROCESS_UNCHANGED) {
	/*
	 * Process still running, return empty obj.
	 */

	return Tcl_NewObj();
    }
    if (info->status == TCL_PROCESS_EXITED && info->code == 0) {
	/*
	 * Normal exit, return TCL_OK.
	 */

	return Tcl_NewIntObj(TCL_OK);
    }

    /*
     * Abnormal exit, return {TCL_ERROR msg error}
     */

    resultObjs[0] = Tcl_NewIntObj(TCL_ERROR);
    resultObjs[1] = info->msg;
    resultObjs[2] = info->error;
    return Tcl_NewListObj(3, resultObjs);
}

/*----------------------------------------------------------------------
 *
 * ProcessListObjCmd --
 *
 *	This function implements the 'tcl::process list' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Access to the internal structures is protected by infoTablesMutex.
 *
 *----------------------------------------------------------------------
 */

static int
ProcessListObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *list;
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    /*
     * Return the list of all chid process ids.
     */

    list = Tcl_NewListObj(0, NULL);
    Tcl_MutexLock(&infoTablesMutex);
    for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	info = (ProcessInfo *) Tcl_GetHashValue(entry);
	Tcl_ListObjAppendElement(interp, list,
		Tcl_NewIntObj(info->resolvedPid));
    }
    Tcl_MutexUnlock(&infoTablesMutex);
    Tcl_SetObjResult(interp, list);
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ProcessStatusObjCmd --
 *
 *	This function implements the 'tcl::process status' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Access to the internal structures is protected by infoTablesMutex.
 *	Calls RefreshProcessInfo, which can block if -wait switch is given.
 *
 *----------------------------------------------------------------------
 */

static int
ProcessStatusObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *dict;
    int index, options = WNOHANG;
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;
    int numPids;
    Tcl_Obj **pidObjs;
    int result;
    int i;
    int pid;
    Tcl_Obj *const *savedobjv = objv;
    static const char *const switches[] = {
	"-wait", "--", NULL
    };
    enum switches {
	STATUS_WAIT, STATUS_LAST
    };

    while (objc > 1) {
	if (TclGetString(objv[1])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[1], switches, "switches", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	++objv; --objc;
	if (STATUS_WAIT == (enum switches) index) {
	    options = 0;
	} else {
	    break;
	}
    }

    if (objc != 1 && objc != 2) {
	Tcl_WrongNumArgs(interp, 1, savedobjv, "?switches? ?pids?");
	return TCL_ERROR;
    }

    if (objc == 1) {
	/*
	* 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)) {
	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
	    RefreshProcessInfo(info, options);

	    if (info->purge && autopurge) {
		/*
		 * Purge entry.
		 */

		Tcl_DeleteHashEntry(entry);
		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
		Tcl_DeleteHashEntry(entry);
		FreeProcessInfo(info);
	    } else {
		/*
		 * Add to result.
		 */

		Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
			BuildProcessStatusObj(info));
	    }
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    } else {
	/*
	 * Only return statuses of provided processes.
	 */

	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	dict = Tcl_NewDictObj();
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		Tcl_DecrRefCount(dict);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
	    if (!entry) {
		/*
		 * Skip unknown process.
		 */

		continue;
	    }

	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
	    RefreshProcessInfo(info, options);

	    if (info->purge && autopurge) {
		/*
		 * Purge entry.
		 */

		Tcl_DeleteHashEntry(entry);
		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
		Tcl_DeleteHashEntry(entry);
		FreeProcessInfo(info);
	    } else {
		/*
		 * Add to result.
		 */

		Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
			BuildProcessStatusObj(info));
	    }
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    }
    Tcl_SetObjResult(interp, dict);
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ProcessPurgeObjCmd --
 *
 *	This function implements the 'tcl::process purge' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Frees all ProcessInfo structures with their purge flag set.
 *
 *----------------------------------------------------------------------
 */

static int
ProcessPurgeObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;
    int numPids;
    Tcl_Obj **pidObjs;
    int result;
    int i;
    int pid;

    if (objc != 1 && objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pids?");
	return TCL_ERROR;
    }

    /*
     * First reap detached procs so that their purge flag is up-to-date.
     */

    Tcl_ReapDetachedProcs();

    if (objc == 1) {
	/*
	 * Purge all terminated processes.
	 */

	Tcl_MutexLock(&infoTablesMutex);
	for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
		entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
	    if (info->purge) {
		Tcl_DeleteHashEntry(entry);
		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
		Tcl_DeleteHashEntry(entry);
		FreeProcessInfo(info);
	    }
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    } else {
	/*
	 * Purge only provided processes.
	 */

	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
	    if (!entry) {
		/*
		 * Skip unknown process.
		 */

		continue;
	    }

	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
	    if (info->purge) {
		Tcl_DeleteHashEntry(entry);
		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
		Tcl_DeleteHashEntry(entry);
		FreeProcessInfo(info);
	    }
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    }

    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ProcessAutopurgeObjCmd --
 *
 *	This function implements the 'tcl::process autopurge' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Alters detached process handling by Tcl_ReapDetachedProcs().
 *
 *----------------------------------------------------------------------
 */

static int
ProcessAutopurgeObjCmd(
    ClientData clientData,	/* Not used. */
    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;
    }

    if (objc == 2) {
	/*
	 * Set given value.
	 */

	int flag;
	int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag);
	if (result != TCL_OK) {
	    return result;
	}

	autopurge = !!flag;
    }

    /*
     * Return current value.
     */

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(autopurge));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitProcessCmd --
 *
 *	This procedure creates the "tcl::process" Tcl command. See the user
 *	documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitProcessCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap processImplMap[] = {
	{"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
	{"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    Tcl_Command processCmd;

    if (infoTablesInitialized == 0) {
	Tcl_MutexLock(&infoTablesMutex);
	if (infoTablesInitialized == 0) {
	    Tcl_InitHashTable(&infoTablePerPid, TCL_ONE_WORD_KEYS);
	    Tcl_InitHashTable(&infoTablePerResolvedPid, TCL_ONE_WORD_KEYS);
	    infoTablesInitialized = 1;
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    }

    processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap);
    Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
	    "process", 0);
    return processCmd;
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcessCreated --
 *
 *	Called when a child process has been created by Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Internal structures are updated with a new ProcessInfo.
 *
 *----------------------------------------------------------------------
 */

void
TclProcessCreated(
    Tcl_Pid pid)		/* Process id. */
{
    int resolvedPid;
    Tcl_HashEntry *entry, *entry2;
    int isNew;
    ProcessInfo *info;

    /*
     * Get resolved pid first.
     */

    resolvedPid = TclpGetPid(pid);

    Tcl_MutexLock(&infoTablesMutex);

    /*
     * Create entry in pid table.
     */

    entry = Tcl_CreateHashEntry(&infoTablePerPid, pid, &isNew);
    if (!isNew) {
	/*
	 * Pid was reused, free old info and reuse structure.
	 */

	info = (ProcessInfo *) Tcl_GetHashValue(entry);
	entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid,
		INT2PTR(resolvedPid));
	if (entry2) Tcl_DeleteHashEntry(entry2);
	FreeProcessInfo(info);
    }

    /*
     * Allocate and initialize info structure.
     */

    info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo));
    InitProcessInfo(info, pid, resolvedPid);

    /*
     * Add entry to tables.
     */

    Tcl_SetHashValue(entry, info);
    entry = Tcl_CreateHashEntry(&infoTablePerResolvedPid, INT2PTR(resolvedPid),
	    &isNew);
    Tcl_SetHashValue(entry, info);

    Tcl_MutexUnlock(&infoTablesMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcessWait --
 *
 *	Wait for process status to change.
 *
 * Results:
 *	TclProcessWaitStatus enum value.
 *
 * Side effects:
 *	Completed process info structures are purged immediately (autopurge on)
 *	or eventually (autopurge off).
 *
 *----------------------------------------------------------------------
 */

TclProcessWaitStatus
TclProcessWait(
    Tcl_Pid pid,		/* Process id. */
    int options,		/* Options passed to WaitProcessStatus. */
    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_Obj **msgObjPtr,	/* If non-NULL, will receive error message. */
    Tcl_Obj **errorObjPtr)	/* If non-NULL, will receive error code. */
{
    Tcl_HashEntry *entry;
    ProcessInfo *info;
    TclProcessWaitStatus result;

    /*
     * First search for pid in table.
     */

    Tcl_MutexLock(&infoTablesMutex);
    entry = Tcl_FindHashEntry(&infoTablePerPid, pid);
    if (!entry) {
	/*
	 * Unknown process, just call WaitProcessStatus and return.
	 */

	result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr,
		msgObjPtr, errorObjPtr);
	if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
	if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
    Tcl_MutexUnlock(&infoTablesMutex);
	return result;
    }

    info = (ProcessInfo *) Tcl_GetHashValue(entry);
    if (info->purge) {
	/*
	 * Process has completed but TclProcessWait has already been called,
	 * so report no change.
	 */
    Tcl_MutexUnlock(&infoTablesMutex);

	return TCL_PROCESS_UNCHANGED;
    }

    RefreshProcessInfo(info, options);
    if (info->status == TCL_PROCESS_UNCHANGED) {
	/*
	 * No change, stop there.
	 */
    Tcl_MutexUnlock(&infoTablesMutex);

	return TCL_PROCESS_UNCHANGED;
    }

    /*
     * Set return values.
     */

    result = info->status;
    if (codePtr) *codePtr = info->code;
    if (msgObjPtr) *msgObjPtr = info->msg;
    if (errorObjPtr) *errorObjPtr = info->error;
    if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
    if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);

    if (autopurge) {
	/*
	 * Purge now.
	 */

	Tcl_DeleteHashEntry(entry);
	entry = Tcl_FindHashEntry(&infoTablePerResolvedPid,
		INT2PTR(info->resolvedPid));
	Tcl_DeleteHashEntry(entry);
	FreeProcessInfo(info);
    } else {
	/*
	 * Eventually purge. Subsequent calls will return
	 * TCL_PROCESS_UNCHANGED.
	 */

	info->purge = 1;
    }
    Tcl_MutexUnlock(&infoTablesMutex);
    return result;
}

Changes to generic/tclResult.c.

23
24
25
26
27
28
29



30
31
32
33
34
35
36
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39







+
+
+







/*
 * Function prototypes for local functions in this file:
 */

static Tcl_Obj **	GetKeys(void);
static void		ReleaseKeys(ClientData clientData);
static void		ResetObjResult(Interp *iPtr);
#ifndef TCL_NO_DEPRECATED
static void		SetupAppendBuffer(Interp *iPtr, int newSpace);
#endif /* !TCL_NO_DEPRECATED */

/*
 * This structure is used to take a snapshot of the interpreter state in
 * Tcl_SaveInterpState. You can snapshot the state, execute a command, and
 * then back up to the result or the error that was previously in progress.
 */

240
241
242
243
244
245
246
247

248
249






































250
251
252
253
254
255
256
243
244
245
246
247
248
249

250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297







-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    /*
     * Move the result object into the save state. Note that we don't need to
     * change its refcount because we're moving it, not adding a new
     * reference. Put an empty object into the interpreter.
     */

    *statePtr = iPtr->objResultPtr;
    statePtr->objResultPtr = iPtr->objResultPtr;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);

    /*
     * Save the string result.
     */

    statePtr->freeProc = iPtr->freeProc;
    if (iPtr->result == iPtr->resultSpace) {
	/*
	 * Copy the static string data out of the interp buffer.
	 */

	statePtr->result = statePtr->resultSpace;
	strcpy(statePtr->result, iPtr->result);
	statePtr->appendResult = NULL;
    } else if (iPtr->result == iPtr->appendResult) {
	/*
	 * Move the append buffer out of the interp.
	 */

	statePtr->appendResult = iPtr->appendResult;
	statePtr->appendAvl = iPtr->appendAvl;
	statePtr->appendUsed = iPtr->appendUsed;
	statePtr->result = statePtr->appendResult;
	iPtr->appendResult = NULL;
	iPtr->appendAvl = 0;
	iPtr->appendUsed = 0;
    } else {
	/*
	 * Move the dynamic or static string out of the interpreter.
	 */

	statePtr->result = iPtr->result;
	statePtr->appendResult = NULL;
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
    iPtr->freeProc = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RestoreResult --
 *
272
273
274
275
276
277
278

































279
280
281
282
283
284
285

286
287
288
289
290
291
292
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358

359
360
361
362
363
364
365
366







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+







Tcl_RestoreResult(
    Tcl_Interp *interp,		/* Interpreter being restored. */
    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
{
    Interp *iPtr = (Interp *) interp;

    Tcl_ResetResult(interp);

    /*
     * Restore the string result.
     */

    iPtr->freeProc = statePtr->freeProc;
    if (statePtr->result == statePtr->resultSpace) {
	/*
	 * Copy the static string data into the interp buffer.
	 */

	iPtr->result = iPtr->resultSpace;
	strcpy(iPtr->result, statePtr->result);
    } else if (statePtr->result == statePtr->appendResult) {
	/*
	 * Move the append buffer back into the interp.
	 */

	if (iPtr->appendResult != NULL) {
	    ckfree(iPtr->appendResult);
	}

	iPtr->appendResult = statePtr->appendResult;
	iPtr->appendAvl = statePtr->appendAvl;
	iPtr->appendUsed = statePtr->appendUsed;
	iPtr->result = iPtr->appendResult;
    } else {
	/*
	 * Move the dynamic or static string back into the interpreter.
	 */

	iPtr->result = statePtr->result;
    }

    /*
     * Restore the object result.
     */

    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = *statePtr;
    iPtr->objResultPtr = statePtr->objResultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DiscardResult --
 *
304
305
306
307
308
309
310
311









312
313
314
315
316
317
318
378
379
380
381
382
383
384

385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400







-
+
+
+
+
+
+
+
+
+







 */

#undef Tcl_DiscardResult
void
Tcl_DiscardResult(
    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
{
    Tcl_DecrRefCount(*statePtr);
    TclDecrRefCount(statePtr->objResultPtr);

    if (statePtr->result == statePtr->appendResult) {
	ckfree(statePtr->appendResult);
    } else if (statePtr->freeProc == TCL_DYNAMIC) {
        ckfree(statePtr->result);
    } else if (statePtr->freeProc) {
        statePtr->freeProc(statePtr->result);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetResult --
 *
334
335
336
337
338
339
340



341
342
343
344
345
346
347
348
349








































350
351
352
353
354
355
356
416
417
418
419
420
421
422
423
424
425









426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472







+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







				 * return value. */
    register char *result,	/* Value to be returned. If NULL, the result
				 * is set to an empty string. */
    Tcl_FreeProc *freeProc)	/* Gives information about the string:
				 * TCL_STATIC, TCL_VOLATILE, or the address of
				 * a Tcl_FreeProc such as free. */
{
    Interp *iPtr = (Interp *) interp;
    register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
    char *oldResult = iPtr->result;
    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
    if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) {
	return;
    }
    if (freeProc == TCL_DYNAMIC) {
	ckfree(result);
    } else {
	(*freeProc)(result);
    }

    if (result == NULL) {
	iPtr->resultSpace[0] = 0;
	iPtr->result = iPtr->resultSpace;
	iPtr->freeProc = 0;
    } else if (freeProc == TCL_VOLATILE) {
	int length = strlen(result);

	if (length > TCL_RESULT_SIZE) {
	    iPtr->result = ckalloc(length + 1);
	    iPtr->freeProc = TCL_DYNAMIC;
	} else {
	    iPtr->result = iPtr->resultSpace;
	    iPtr->freeProc = 0;
	}
	memcpy(iPtr->result, result, (unsigned) length+1);
    } else {
	iPtr->result = (char *) result;
	iPtr->freeProc = freeProc;
    }

    /*
     * If the old result was dynamically-allocated, free it up. Do it here,
     * rather than at the beginning, in case the new result value was part of
     * the old result value.
     */

    if (oldFreeProc != 0) {
	if (oldFreeProc == TCL_DYNAMIC) {
	    ckfree(oldResult);
	} else {
	    oldFreeProc(oldResult);
	}
    }

    /*
     * Reset the object result since we just set the string result.
     */

    ResetObjResult(iPtr);
}
#endif /* !TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringResult --
368
369
370
371
372
373
374
375

376












377
378
379
380
381
382
383
484
485
486
487
488
489
490

491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511







-
+

+
+
+
+
+
+
+
+
+
+
+
+







 */

const char *
Tcl_GetStringResult(
    register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
    Interp *iPtr = (Interp *) interp;

#ifdef TCL_NO_DEPRECATED
    return Tcl_GetString(iPtr->objResultPtr);
#else
    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */

    if (*(iPtr->result) == 0) {
	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
		TCL_VOLATILE);
    }
    return iPtr->result;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --
 *
410
411
412
413
414
415
416

















417
418
419
420
421
422
423
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    /*
     * We wait until the end to release the old object result, in case we are
     * setting the result to itself.
     */

    TclDecrRefCount(oldObjResult);

#ifndef TCL_NO_DEPRECATED
    /*
     * Reset the string result since we just set the result object.
     */

    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    iPtr->freeProc(iPtr->result);
	}
	iPtr->freeProc = 0;
    }
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetObjResult --
 *
438
439
440
441
442
443
444



445
























446
447
448
449
450
451
452
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624







+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 */

Tcl_Obj *
Tcl_GetObjResult(
    Tcl_Interp *interp)		/* Interpreter whose result to return. */
{
    register Interp *iPtr = (Interp *) interp;
#ifndef TCL_NO_DEPRECATED
    Tcl_Obj *objResultPtr;
    int length;

    /*
     * If the string result is non-empty, move the string result to the object
     * result, then reset the string result.
     */

    if (iPtr->result[0] != 0) {
	ResetObjResult(iPtr);

	objResultPtr = iPtr->objResultPtr;
	length = strlen(iPtr->result);
	TclInitStringRep(objResultPtr, iPtr->result, length);

	if (iPtr->freeProc != NULL) {
	    if (iPtr->freeProc == TCL_DYNAMIC) {
		ckfree(iPtr->result);
	    } else {
		iPtr->freeProc(iPtr->result);
	    }
	    iPtr->freeProc = 0;
	}
	iPtr->result = iPtr->resultSpace;
	iPtr->result[0] = 0;
    }
#endif /* !TCL_NO_DEPRECATED */
    return iPtr->objResultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendResultVA --
540
541
542
543
544
545
546

547
548
549
550
551
552
553
554
555
556
557
558
559




560




























































































































561
562
563
564
565
566
567
568
569
570



571
572
573
574
575
576
577
578




579
580
581
582
583
584
585
586
587
588











589
590
591
592
593
594
595
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736

737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867



868
869
870
871
872
873
874
875



876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907







+













+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
+
+
+





-
-
-
+
+
+
+










+
+
+
+
+
+
+
+
+
+
+







Tcl_AppendElement(
    Tcl_Interp *interp,		/* Interpreter whose result is to be
				 * extended. */
    const char *element)	/* String to convert to list element and add
				 * to result. */
{
    Interp *iPtr = (Interp *) interp;
#ifdef TCL_NO_DEPRECATED
    Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
    Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
    const char *bytes;

    if (Tcl_IsShared(iPtr->objResultPtr)) {
	Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
    }
    bytes = TclGetString(iPtr->objResultPtr);
    if (TclNeedSpace(bytes, bytes+iPtr->objResultPtr->length)) {
	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
    }
    Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
    Tcl_DecrRefCount(listPtr);
#else
    char *dst;
    int size;
    int flags;
}

    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */

    (void) Tcl_GetStringResult(interp);

    /*
     * See how much space is needed, and grow the append buffer if needed to
     * accommodate the list element.
     */

    size = Tcl_ScanElement(element, &flags) + 1;
    if ((iPtr->result != iPtr->appendResult)
	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
	    || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
	SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
    }

    /*
     * Convert the string into a list element and copy it to the buffer that's
     * forming, with a space separator if needed.
     */

    dst = iPtr->appendResult + iPtr->appendUsed;
    if (TclNeedSpace(iPtr->appendResult, dst)) {
	iPtr->appendUsed++;
	*dst = ' ';
	dst++;

	/*
	 * If we need a space to separate this element from preceding stuff,
	 * then this element will not lead a list, and need not have it's
	 * leading '#' quoted.
	 */

	flags |= TCL_DONT_QUOTE_HASH;
    }
    iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
#endif /* !TCL_NO_DEPRECATED */
}

/*
 *----------------------------------------------------------------------
 *
 * SetupAppendBuffer --
 *
 *	This function makes sure that there is an append buffer properly
 *	initialized, if necessary, from the interpreter's result, and that it
 *	has at least enough room to accommodate newSpace new bytes of
 *	information.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
static void
SetupAppendBuffer(
    Interp *iPtr,		/* Interpreter whose result is being set up. */
    int newSpace)		/* Make sure that at least this many bytes of
				 * new information may be added. */
{
    int totalSpace;

    /*
     * Make the append buffer larger, if that's necessary, then copy the
     * result into the append buffer and make the append buffer the official
     * Tcl result.
     */

    if (iPtr->result != iPtr->appendResult) {
	/*
	 * If an oversized buffer was used recently, then free it up so we go
	 * back to a smaller buffer. This avoids tying up memory forever after
	 * a large operation.
	 */

	if (iPtr->appendAvl > 500) {
	    ckfree(iPtr->appendResult);
	    iPtr->appendResult = NULL;
	    iPtr->appendAvl = 0;
	}
	iPtr->appendUsed = strlen(iPtr->result);
    } else if (iPtr->result[iPtr->appendUsed] != 0) {
	/*
	 * Most likely someone has modified a result created by
	 * Tcl_AppendResult et al. so that it has a different size. Just
	 * recompute the size.
	 */

	iPtr->appendUsed = strlen(iPtr->result);
    }

    totalSpace = newSpace + iPtr->appendUsed;
    if (totalSpace >= iPtr->appendAvl) {
	char *new;

	if (totalSpace < 100) {
	    totalSpace = 200;
	} else {
	    totalSpace *= 2;
	}
	new = ckalloc(totalSpace);
	strcpy(new, iPtr->result);
	if (iPtr->appendResult != NULL) {
	    ckfree(iPtr->appendResult);
	}
	iPtr->appendResult = new;
	iPtr->appendAvl = totalSpace;
    } else if (iPtr->result != iPtr->appendResult) {
	strcpy(iPtr->appendResult, iPtr->result);
    }

    Tcl_FreeResult((Tcl_Interp *) iPtr);
    iPtr->result = iPtr->appendResult;
}
#endif /* !TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FreeResult --
 *
 *	This function frees up the memory associated with an interpreter's
 *	result, resetting the interpreter's result object.  Tcl_FreeResult is
 *	most commonly used when a function is about to replace one result
 *	value with another.
 *	string result. It also resets the interpreter's result object.
 *	Tcl_FreeResult is most commonly used when a function is about to
 *	replace one result value with another.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees the memory associated with interp's result but does not change
 *	any part of the error dictionary (i.e., the errorinfo and errorcode
 *	remain the same).
 *	Frees the memory associated with interp's string result and sets
 *	interp->freeProc to zero, but does not change interp->result or clear
 *	error state. Resets interp's result object to an unshared empty
 *	object.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FreeResult(
    register Tcl_Interp *interp)/* Interpreter for which to free result. */
{
    register Interp *iPtr = (Interp *) interp;

#ifndef TCL_NO_DEPRECATED
    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    iPtr->freeProc(iPtr->result);
	}
	iPtr->freeProc = 0;
    }

#endif /* !TCL_NO_DEPRECATED */
    ResetObjResult(iPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ResetResult --
611
612
613
614
615
616
617












618
619
620
621
622
623
624
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948







+
+
+
+
+
+
+
+
+
+
+
+







void
Tcl_ResetResult(
    register Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
    register Interp *iPtr = (Interp *) interp;

    ResetObjResult(iPtr);
#ifndef TCL_NO_DEPRECATED
    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    iPtr->freeProc(iPtr->result);
	}
	iPtr->freeProc = 0;
    }
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
#endif /* !TCL_NO_DEPRECATED */
    if (iPtr->errorCode) {
	/* Legacy support */
	if (iPtr->flags & ERR_LEGACY_COPY) {
	    Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
		    iPtr->errorCode, TCL_GLOBAL_ONLY);
	}
	Tcl_DecrRefCount(iPtr->errorCode);

Changes to generic/tclScan.c.

1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20












+







/*
 * tclScan.c --
 *
 *	This file contains the implementation of the "scan" command.
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath.h"

/*
 * Flag values used by Tcl_ScanObjCmd.
 */

#define SCAN_NOSKIP	0x1		/* Don't skip blanks. */
#define SCAN_SUPPRESS	0x2		/* Suppress assignment. */
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
412
413
414
415
416
417
418

419






420
421
422
423
424
425
426







-

-
-
-
-
-
-







	case 'g':
	case 'G':
	case 'i':
	case 'o':
	case 'x':
	case 'X':
	case 'b':
	    break;
	case 'u':
	    if (flags & SCAN_BIG) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"unsigned bignum scans are invalid", -1));
		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
		goto error;
	    }
	    break;
	    /*
	     * Bracket terms need special checking
	     */
	case '[':
	    if (flags & (SCAN_LONGER|SCAN_BIG)) {
		goto invalidFieldSize;
885
886
887
888
889
890
891
892

893
894
895
896
897
898
899
879
880
881
882
883
884
885

886
887
888
889
890
891
892
893







-
+







	     * Scan a single Unicode character.
	     */

	    offset = TclUtfToUniChar(string, &sch);
	    i = (int)sch;
#if TCL_UTF_MAX == 4
	    if (!offset) {
		offset = Tcl_UtfToUniChar(string, &sch);
		offset = TclUtfToUniChar(string, &sch);
		i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF);
	    }
#endif
	    string += offset;
	    if (!(flags & SCAN_SUPPRESS)) {
		objPtr = Tcl_NewIntObj(i);
		Tcl_IncrRefCount(objPtr);
928
929
930
931
932
933
934
935

936
937

938
939
940
941

942
943
944
945

946
947

























948
949
950
951
952
953
954
955
956
957
958
959

960
961
962
963
964
965
966
922
923
924
925
926
927
928

929
930

931
932
933
934

935

936
937

938
939

940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975

976
977
978
979
980
981
982
983







-
+

-
+



-
+
-


-
+

-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+







	    string = end;
	    if (flags & SCAN_SUPPRESS) {
		Tcl_DecrRefCount(objPtr);
		break;
	    }
	    if (flags & SCAN_LONGER) {
		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
		    wideValue = ~(Tcl_WideUInt)0 >> 1;	/* WIDE_MAX */
		    wideValue = WIDE_MAX;
		    if (TclGetString(objPtr)[0] == '-') {
			wideValue++;	/* WIDE_MAX + 1 = WIDE_MIN */
			wideValue = WIDE_MIN;
		    }
		}
		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
		    sprintf(buf, "%" TCL_LL_MODIFIER "u", wideValue);
			    (Tcl_WideUInt)wideValue);
		    Tcl_SetStringObj(objPtr, buf, -1);
		} else {
		    Tcl_SetWideIntObj(objPtr, wideValue);
		    TclSetIntObj(objPtr, wideValue);
		}
	    } else if (!(flags & SCAN_BIG)) {
	    } else if (flags & SCAN_BIG) {
		if (flags & SCAN_UNSIGNED) {
		    mp_int big;
		    int code = Tcl_GetBignumFromObj(interp, objPtr, &big);

		    if (code == TCL_OK) {
			if (mp_isneg(&big)) {
			    code = TCL_ERROR;
			}
			mp_clear(&big);
		    }

		    if (code == TCL_ERROR) {
			if (objs != NULL) {
			    ckfree(objs);
			}
			Tcl_DecrRefCount(objPtr);
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"unsigned bignum scans are invalid", -1));
			Tcl_SetErrorCode(interp, "TCL", "FORMAT",
				"BADUNSIGNED",NULL);
			return TCL_ERROR;
		    }
		}
	    } else {
		if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
		    if (TclGetString(objPtr)[0] == '-') {
			value = LONG_MIN;
		    } else {
			value = LONG_MAX;
		    }
		}
		if ((flags & SCAN_UNSIGNED) && (value < 0)) {
		    sprintf(buf, "%lu", value);	/* INTL: ISO digit */
		    Tcl_SetStringObj(objPtr, buf, -1);
		} else {
		    Tcl_SetLongObj(objPtr, value);
		    TclSetIntObj(objPtr, value);
		}
	    }
	    objs[objIndex++] = objPtr;
	    break;

	case 'f':
	    /*

Changes to generic/tclStrToD.c.

479
480
481
482
483
484
485
486

487
488
489
490
491
492
493
479
480
481
482
483
484
485

486
487
488
489
490
491
492
493







-
+







    const char **endPtrPtr,	/* Place to store pointer to the character
				 * that terminated the scan. */
    int flags)			/* Flags governing the parse. */
{
    enum State {
	INITIAL, SIGNUM, ZERO, ZERO_X,
	ZERO_O, ZERO_B, ZERO_D, BINARY,
	HEXADECIMAL, OCTAL, DECIMAL,
	HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
	LEADING_RADIX_POINT, FRACTION,
	EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
	sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY
#ifdef IEEE_FLOATING_POINT
	, sN, sNA, sNAN, sNANPAREN, sNANHEX, sNANFINISH
#endif
    } state = INITIAL;
524
525
526
527
528
529
530

531
532
533
534
535
536
537
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538







+







				 * an acceptable number. */
    size_t acceptLen;		/* Number of characters following that
				 * point. */
    int status = TCL_OK;	/* Status to return to caller. */
    char d = 0;			/* Last hexadecimal digit scanned; initialized
				 * to avoid a compiler warning. */
    int shift = 0;		/* Amount to shift when accumulating binary */
    int explicitOctal = 0;

#define ALL_BITS	(~(Tcl_WideUInt)0)
#define MOST_BITS	(ALL_BITS >> 1)

    /*
     * Initialize bytes to start of the object's string rep if the caller
     * didn't pass anything else.
655
656
657
658
659
660
661

662
663
664
665
666
667
668

669


670
671
672
673
674
675
676
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681







+







+

+
+







		state = ZERO_B;
		break;
	    }
	    if (flags & TCL_PARSE_BINARY_ONLY) {
		goto zerob;
	    }
	    if (c == 'o' || c == 'O') {
		explicitOctal = 1;
		state = ZERO_O;
		break;
	    }
	    if (c == 'd' || c == 'D') {
		state = ZERO_D;
		break;
	    }
#ifdef TCL_NO_DEPRECATED
	    goto decimal;
#endif
	    /* FALLTHROUGH */

	case OCTAL:
	    /*
	     * Scanned an optional + or -, followed by a string of octal
	     * digits. Acceptable inputs are more digits, period, or E. If 8
	     * or 9 is encountered, commit to floating point.
	     */
725
726
727
728
729
730
731




















































732
733
734
735
736
737
738
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		} else {
		    numSigDigs = 1;
		}
		numTrailZeros = 0;
		state = OCTAL;
		break;
	    }
	    /* FALLTHROUGH */

	case BAD_OCTAL:
	    if (explicitOctal) {
		/*
		 * No forgiveness for bad digits in explicitly octal numbers.
		 */

		goto endgame;
	    }
	    if (flags & TCL_PARSE_INTEGER_ONLY) {
		/*
		 * No seeking floating point when parsing only integer.
		 */

		goto endgame;
	    }
#ifndef TCL_NO_DEPRECATED

	    /*
	     * Scanned a number with a leading zero that contains an 8, 9,
	     * radix point or E. This is an invalid octal number, but might
	     * still be floating point.
	     */

	    if (c == '0') {
		numTrailZeros++;
		state = BAD_OCTAL;
		break;
	    } else if (isdigit(UCHAR(c))) {
		if (objPtr != NULL) {
		    significandOverflow = AccumulateDecimalDigit(
			    (unsigned)(c-'0'), numTrailZeros,
			    &significandWide, &significandBig,
			    significandOverflow);
		}
		if (numSigDigs != 0) {
		    numSigDigs += (numTrailZeros + 1);
		} else {
		    numSigDigs = 1;
		}
		numTrailZeros = 0;
		state = BAD_OCTAL;
		break;
	    } else if (c == '.') {
		state = FRACTION;
		break;
	    } else if (c == 'E' || c == 'e') {
		state = EXPONENT_START;
		break;
	    }
#endif
	    goto endgame;

	    /*
	     * Scanned 0x. If state is HEXADECIMAL, scanned at least one
	     * character following the 0x. The only acceptable inputs are
	     * hexadecimal digits.
	     */
839
840
841
842
843
844
845

846

847
848
849
850
851
852
853
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912







+

+








	case DECIMAL:
	    /*
	     * Scanned an optional + or - followed by a string of decimal
	     * digits.
	     */

#ifdef TCL_NO_DEPRECATED
	decimal:
#endif
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == '0') {
		numTrailZeros++;
		state = DECIMAL;
		break;
1123
1124
1125
1126
1127
1128
1129

1130
1131
1132
1133
1134
1135
1136
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196







+







     * Generate and store the appropriate internal rep.
     */

    if (status == TCL_OK && objPtr != NULL) {
	TclFreeIntRep(objPtr);
	switch (acceptState) {
	case SIGNUM:
	case BAD_OCTAL:
	case ZERO_X:
	case ZERO_O:
	case ZERO_B:
	case ZERO_D:
	case LEADING_RADIX_POINT:
	case EXPONENT_START:
	case EXPONENT_SIGNUM:
1204
1205
1206
1207
1208
1209
1210
1211

1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233


1234
1235
1236


1237
1238
1239
1240
1241
1242
1243
1264
1265
1266
1267
1268
1269
1270

1271














1272
1273
1274
1275
1276
1277


1278
1279
1280


1281
1282
1283
1284
1285
1286
1287
1288
1289







-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
+
+

-
-
+
+







		    octalSignificandWide <<= shift;
		} else {
		    mp_mul_2d(&octalSignificandBig, shift,
			    &octalSignificandBig);
		}
	    }
	    if (!octalSignificandOverflow) {
		if (octalSignificandWide >
		if (octalSignificandWide > (MOST_BITS + signum)) {
			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
#ifndef TCL_WIDE_INT_IS_LONG
		    if (octalSignificandWide <= (MOST_BITS + signum)) {
			objPtr->typePtr = &tclWideIntType;
			if (signum) {
			    objPtr->internalRep.wideValue =
				    - (Tcl_WideInt) octalSignificandWide;
			} else {
			    objPtr->internalRep.wideValue =
				    (Tcl_WideInt) octalSignificandWide;
			}
			break;
		    }
#endif
		    TclInitBignumFromWideUInt(&octalSignificandBig,
			    octalSignificandWide);
		    octalSignificandOverflow = 1;
		} else {
		    objPtr->typePtr = &tclIntType;
		    if (signum) {
			objPtr->internalRep.longValue =
				- (long) octalSignificandWide;
			objPtr->internalRep.wideValue =
				- (Tcl_WideInt) octalSignificandWide;
		    } else {
			objPtr->internalRep.longValue =
				(long) octalSignificandWide;
			objPtr->internalRep.wideValue =
				(Tcl_WideInt) octalSignificandWide;
		    }
		}
	    }
	    if (octalSignificandOverflow) {
		if (signum) {
		    mp_neg(&octalSignificandBig, &octalSignificandBig);
		}
1251
1252
1253
1254
1255
1256
1257
1258

1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280


1281
1282
1283


1284
1285
1286
1287
1288
1289
1290
1297
1298
1299
1300
1301
1302
1303

1304














1305
1306
1307
1308
1309
1310


1311
1312
1313


1314
1315
1316
1317
1318
1319
1320
1321
1322







-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
+
+

-
-
+
+







		    &significandWide, &significandBig, significandOverflow);
	    if (!significandOverflow && (significandWide > MOST_BITS+signum)){
		significandOverflow = 1;
		TclInitBignumFromWideUInt(&significandBig, significandWide);
	    }
	returnInteger:
	    if (!significandOverflow) {
		if (significandWide >
		if (significandWide > MOST_BITS+signum) {
			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
#ifndef TCL_WIDE_INT_IS_LONG
		    if (significandWide <= MOST_BITS+signum) {
			objPtr->typePtr = &tclWideIntType;
			if (signum) {
			    objPtr->internalRep.wideValue =
				    - (Tcl_WideInt) significandWide;
			} else {
			    objPtr->internalRep.wideValue =
				    (Tcl_WideInt) significandWide;
			}
			break;
		    }
#endif
		    TclInitBignumFromWideUInt(&significandBig,
			    significandWide);
		    significandOverflow = 1;
		} else {
		    objPtr->typePtr = &tclIntType;
		    if (signum) {
			objPtr->internalRep.longValue =
				- (long) significandWide;
			objPtr->internalRep.wideValue =
				- (Tcl_WideInt) significandWide;
		    } else {
			objPtr->internalRep.longValue =
				(long) significandWide;
			objPtr->internalRep.wideValue =
				(Tcl_WideInt) significandWide;
		    }
		}
	    }
	    if (significandOverflow) {
		if (signum) {
		    mp_neg(&significandBig, &significandBig);
		}
1348
1349
1350
1351
1352
1353
1354



1355
1356
1357
1358
1359
1360
1361
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396







+
+
+







    if (status != TCL_OK) {
	if (interp != NULL) {
	    Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
		    expected);

	    Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
	    Tcl_AppendToObj(msg, "\"", -1);
	    if (state == BAD_OCTAL) {
		Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1);
	    }
	    Tcl_SetObjResult(interp, msg);
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
	}
    }

    /*
     * Free memory.
4504
4505
4506
4507
4508
4509
4510
4511

4512
4513
4514
4515
4516
4517
4518
4539
4540
4541
4542
4543
4544
4545

4546
4547
4548
4549
4550
4551
4552
4553







-
+








	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	}
	return TCL_ERROR;
    }

    fract = frexp(d,&expt);
    fract = frexp(d, &expt);
    if (expt <= 0) {
	mp_init(b);
	mp_zero(b);
    } else {
	Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits);
	int shift = expt - mantBits;

4658
4659
4660
4661
4662
4663
4664
4665

4666
4667
4668
4669
4670
4671
4672
4693
4694
4695
4696
4697
4698
4699

4700
4701
4702
4703
4704
4705
4706
4707







-
+







TclCeil(
    const mp_int *a)			/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;

    mp_init(&b);
    if (mp_cmp_d(a, 0) == MP_LT) {
    if (mp_isneg(a)) {
	mp_neg(a, &b);
	r = -TclFloor(&b);
    } else {
	int bits = mp_count_bits(a);

	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
	    r = HUGE_VAL;
4715
4716
4717
4718
4719
4720
4721
4722

4723
4724
4725
4726
4727
4728
4729
4750
4751
4752
4753
4754
4755
4756

4757
4758
4759
4760
4761
4762
4763
4764







-
+







TclFloor(
    const mp_int *a)			/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;

    mp_init(&b);
    if (mp_cmp_d(a, 0) == MP_LT) {
    if (mp_isneg(a)) {
	mp_neg(a, &b);
	r = -TclCeil(&b);
    } else {
	int bits = mp_count_bits(a);

	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
	    r = DBL_MAX;
4844
4845
4846
4847
4848
4849
4850
4851

4852
4853
4854
4855
4856
4857
4858
4879
4880
4881
4882
4883
4884
4885

4886
4887
4888
4889
4890
4891
4892
4893







-
+







    double retval = fraction;

    if (exponent > 0) {
	/*
	 * Multiply by 10**exponent.
	 */

	retval = frexp(retval * pow10vals[exponent&0xf], &j);
	retval = frexp(retval * pow10vals[exponent & 0xf], &j);
	expt += j;
	for (i=4; i<9; ++i) {
	    if (exponent & (1<<i)) {
		retval = frexp(retval * pow_10_2_n[i], &j);
		expt += j;
	    }
	}

Changes to generic/tclStringObj.c.

34
35
36
37
38
39
40

41
42
43
44
45
46
47
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48







+







 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath.h"
#include "tclStringRep.h"

#include "assert.h"
/*
 * Prototypes for functions defined later in this file:
 */

static void		AppendPrintfToObjVA(Tcl_Obj *objPtr,
			    const char *format, va_list argList);
static void		AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr,
136
137
138
139
140
141
142

143

144
145
146
147
148
149
150
151
137
138
139
140
141
142
143
144

145

146
147
148
149
150
151
152







+
-
+
-







    char *ptr = NULL;
    int attempt;

    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }
    if (flag == 0 || stringPtr->allocated > 0) {
	if (needed <= INT_MAX / 2) {
	attempt = 2 * needed;
	    attempt = 2 * needed;
	if (attempt >= 0) {
	    ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
	}
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */
186
187
188
189
190
191
192

193

194
195
196
197
198
199
200
201
187
188
189
190
191
192
193
194

195

196
197
198
199
200
201
202







+
-
+
-







    int attempt;

    if (stringPtr->maxChars > 0) {
	/*
	 * Subsequent appends - apply the growth algorithm.
	 */

	if (needed <= STRING_MAXCHARS / 2) {
	attempt = 2 * needed;
	    attempt = 2 * needed;
	if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
	    ptr = stringAttemptRealloc(stringPtr, attempt);
	}
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */
414
415
416
417
418
419
420
421
422
423








424
425
426
427
428
429
430
415
416
417
418
419
420
421



422
423
424
425
426
427
428
429
430
431
432
433
434
435
436







-
-
-
+
+
+
+
+
+
+
+








    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */
	return objPtr->length;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * without string representation; we don't need to convert to a string to
     * perform the get-length operation.
     * Optimize the case where we're really dealing with a bytearray object;
     * we don't need to convert to a string to perform the get-length operation.
     *
     * Starting in Tcl 8.7, we check for a "pure" bytearray, because the
     * machinery behind that test is using a proper bytearray ObjType.  We
     * could also compute length of an improper bytearray without shimmering
     * but there's no value in that. We *want* to shimmer an improper bytearray
     * because improper bytearrays have worthless internal reps.
     */

    if (TclIsPureByteArray(objPtr)) {
	int length;

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	return length;
448
449
450
451
452
453
454










































455
456
457
458



459
460
461
462
463
464
465
466
467
468
469

470
471
472
473
474
475





476
477
478
479
480

481
482
483
484
485
486






487
488
489
490
491
492
493
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504


505
506
507
508
509
510
511
512
513
514
515
516
517

518
519
520
521
522
523
524
525
526
527
528
529
530
531
532


533
534
535
536



537
538
539
540
541
542
543
544
545
546
547
548
549







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+
+










-
+






+
+
+
+
+



-
-
+



-
-
-
+
+
+
+
+
+







    }
    return numChars;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckEmptyString --
 *
 *	Determine whether the string value of an object is or would be the
 *	empty string, without generating a string representation.
 *
 * Results:
 *	Returns 1 if empty, 0 if not, and -1 if unknown.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int
TclCheckEmptyString(
    Tcl_Obj *objPtr)
{
    int length = -1;

    if (objPtr->bytes == &tclEmptyString) {
	return TCL_EMPTYSTRING_YES;
    }

    if (TclListObjIsCanonical(objPtr)) {
	Tcl_ListObjLength(NULL, objPtr, &length);
	return length == 0;
    }

    if (TclIsPureDict(objPtr)) {
	Tcl_DictObjSize(NULL, objPtr, &length);
	return length == 0;
    }

    if (objPtr->bytes == NULL) {
	return TCL_EMPTYSTRING_UNKNOWN;
    }
    return objPtr->length == 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUniChar --
 *
 *	Get the index'th Unicode character from the String object. The index
 *	is assumed to be in the appropriate range.
 *	Get the index'th Unicode character from the String object. If index
 *	is out of range or it references a low surrogate preceded by a high
 *	surrogate, the result = -1;
 *
 * Results:
 *	Returns the index'th Unicode character in the Object.
 *
 * Side effects:
 *	Fills unichar with the index'th Unicode character.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar
int
Tcl_GetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    int index)			/* Get the index'th Unicode character. */
{
    String *stringPtr;
    int ch, length;

    if (index < 0) {
	return -1;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * without string representation; we don't need to convert to a string to
     * perform the indexing operation.
     * we don't need to convert to a string to perform the indexing operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);

	return (Tcl_UniChar) bytes[index];
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return (int) bytes[index];
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
503
504
505
506
507
508
509




510


















511
512
513
514
515
516
517
518
519
520

521
522
523
524
525
526
527
528
529
530
531


532
533
534
535
536
537
538

539
540
541
542
543
544
545
559
560
561
562
563
564
565
566
567
568
569

570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596

597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625







+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
+











+
+







+







	}
	if (stringPtr->numChars == objPtr->length) {
	    return (Tcl_UniChar) objPtr->bytes[index];
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }

    if (index >= stringPtr->numChars) {
	return -1;
    }
    return stringPtr->unicode[index];
    ch = stringPtr->unicode[index];
#if TCL_UTF_MAX <= 4
    /* See: bug [11ae2be95dac9417] */
    if ((ch & 0xF800) == 0xD800) {
	if (ch & 0x400) {
	    if ((index > 0)
		    && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
		ch = -1; /* low surrogate preceded by high surrogate */
	    }
	} else if ((++index < stringPtr->numChars)
		&& ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
	    /* high surrogate followed by low surrogate */
	    ch = (((ch & 0x3FF) << 10) |
			(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
	}
    }
#endif
    return ch;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicode --
 *
 *	Get the Unicode form of the String object. If the object is not
 *	already a String object, it will be converted to one. If the String
 *	object does not have a Unicode rep, then one is create from the UTF
 *	object does not have a Unicode rep, then one is created from the UTF
 *	string format.
 *
 * Results:
 *	Returns a pointer to the object's internal Unicode string.
 *
 * Side effects:
 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_GetUnicode
Tcl_UniChar *
Tcl_GetUnicode(
    Tcl_Obj *objPtr)		/* The object to find the unicode string
				 * for. */
{
    return Tcl_GetUnicodeFromObj(objPtr, NULL);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicodeFromObj --
 *
 *	Get the Unicode form of the String object with length. If the object
603
604
605
606
607
608
609





610
611
612
613
614

615
616
617
618

619






620

621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638






639
640
641
642
643
644
645
646
647
648
649
650
651
652


653
654

















655
656
657
658
659
660
661
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697


698
699
700
701

702
703
704
705
706
707
708
709

710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750


751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774







+
+
+
+
+



-
-
+



-
+

+
+
+
+
+
+
-
+


















+
+
+
+
+
+














+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







Tcl_GetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    int first,			/* First index of the range. */
    int last)			/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    String *stringPtr;
    int length;

    if (first < 0) {
	first = 0;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * without string representation; we don't need to convert to a string to
     * perform the substring operation.
     * we don't need to convert to a string to perform the substring operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);

	if (last >= length) {
	    last = length - 1;
	}
	if (last < first) {
	    return Tcl_NewObj();
	}
	return Tcl_NewByteArrayObj(bytes+first, last-first+1);
	return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == -1) {
	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    if (last >= stringPtr->numChars) {
		last = stringPtr->numChars - 1;
	    }
	    if (last < first) {
		return Tcl_NewObj();
	    }
	    newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);

	    /*
	     * Since we know the char length of the result, store it.
	     */

	    SetStringFromAny(NULL, newObjPtr);
	    stringPtr = GET_STRING(newObjPtr);
	    stringPtr->numChars = newObjPtr->length;
	    return newObjPtr;
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }
    if (last > stringPtr->numChars) {
	last = stringPtr->numChars;

    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
    }
    if (last < first) {
	return Tcl_NewObj();
    }
#if TCL_UTF_MAX <= 4
    /* See: bug [11ae2be95dac9417] */
    if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
	++first;
    }
    if ((last + 1 < stringPtr->numChars)
	    && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
	++last;
    }
#endif
    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetStringObj --
 *
1204
1205
1206
1207
1208
1209
1210
1211
1212



1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233











1234
1235
1236
1237
1238
1239
1240
1241

1242



1243
1244

1245



1246
1247
1248
1249
1250


1251
1252
1253
1254
1255
1256
1257
1317
1318
1319
1320
1321
1322
1323


1324
1325
1326

1327
1328
1329
1330

1331
1332
1333
1334
1335
1336









1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349

1350
1351
1352
1353
1354
1355

1356
1357
1358
1359
1360
1361

1362
1363
1364
1365
1366
1367


1368
1369
1370
1371
1372
1373
1374
1375
1376







-
-
+
+
+
-




-






-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+


-





+
-
+
+
+


+
-
+
+
+



-
-
+
+








    if (appendObjPtr->bytes == &tclEmptyString) {
	return;
    }

    /*
     * Handle append of one bytearray object to another as a special case.
     * Note that we only do this when the objects don't have string reps; if
     * it did, then appending the byte arrays together could well lose
     * Note that we only do this when the objects are pure so that the
     * bytearray faithfully represent the true value; Otherwise appending the
     * byte arrays together could lose information;
     * information; this is a special-case optimization only.
     */

    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
	    && TclIsPureByteArray(appendObjPtr)) {

	/*
	 * You might expect the code here to be
	 *
	 *  bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
	 *  TclAppendBytesToByteArray(objPtr, bytes, length);
	 *
	 * and essentially all of the time that would be fine.  However,
	 * it would run into trouble in the case where objPtr and
	 * appendObjPtr point to the same thing.  That may never be a
	 * good idea.  It seems to violate Copy On Write, and we don't
	 * have any tests for the situation, since making any Tcl commands
	 * that call Tcl_AppendObjToObj() do that appears impossible
	 * (They honor Copy On Write!).  For the sake of extensions that
	 * go off into that realm, though, here's a more complex approach
	 * that can handle all the cases.
	 * and essentially all of the time that would be fine. However, it
	 * would run into trouble in the case where objPtr and appendObjPtr
	 * point to the same thing. That may never be a good idea. It seems to
	 * violate Copy On Write, and we don't have any tests for the
	 * situation, since making any Tcl commands that call
	 * Tcl_AppendObjToObj() do that appears impossible (They honor Copy On
	 * Write!). For the sake of extensions that go off into that realm,
	 * though, here's a more complex approach that can handle all the
	 * cases.
	 *
	 * First, get the lengths.
	 */

	/* Get lengths */
	int lengthSrc;

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);

	/*
	/* Grow buffer enough for the append */
	 * Grow buffer enough for the append.
	 */

	TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);

	/*
	/* Reset objPtr back to the original value */
	 * Reset objPtr back to the original value.
	 */

	Tcl_SetByteArrayLength(objPtr, length);

	/*
	 * Now do the append knowing that buffer growth cannot cause
	 * any trouble.
	 * Now do the append knowing that buffer growth cannot cause any
	 * trouble.
	 */

	TclAppendBytesToByteArray(objPtr,
		Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
	return;
    }

1291
1292
1293
1294
1295
1296
1297

1298
1299
1300
1301
1302
1303
1304
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424







+







     */

    bytes = TclGetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars;
    if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);

	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if (numChars >= 0 && appendNumChars >= 0) {
	stringPtr->numChars = numChars + appendNumChars;
1780
1781
1782
1783
1784
1785
1786





1787
1788
1789
1790
1791
1792
1793
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918







+
+
+
+
+







	/*
	 * Step 3. Minimum field width.
	 */

	width = 0;
	if (isdigit(UCHAR(ch))) {
	    width = strtoul(format, &end, 10);
	    if (width < 0) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    format = end;
	    step = TclUtfToUniChar(format, &ch);
	} else if (ch == '*') {
	    if (objIndex >= objc - 1) {
		msg = badIndex[gotXpg];
		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
		goto errorMsg;
1865
1866
1867
1868
1869
1870
1871
1872

1873
1874
1875
1876
1877
1878

1879
1880
1881

1882
1883

1884
1885
1886
1887
1888
1889
1890
1891

1892
1893

1894
1895

1896
1897
1898
1899
1900
1901
1902
1903
1990
1991
1992
1993
1994
1995
1996

1997
1998
1999
2000
2001
2002

2003
2004
2005

2006
2007

2008








2009
2010

2011


2012

2013
2014
2015
2016
2017
2018
2019







-
+





-
+


-
+

-
+
-
-
-
-
-
-
-
-
+

-
+
-
-
+
-







	    } else {
		useWide = 1;
#endif
	    }
	} else if (ch == 'I') {
	    if ((format[1] == '6') && (format[2] == '4')) {
		format += (step + 2);
		step = Tcl_UtfToUniChar(format, &ch);
		step = TclUtfToUniChar(format, &ch);
#ifndef TCL_WIDE_INT_IS_LONG
		useWide = 1;
#endif
	    } else if ((format[1] == '3') && (format[2] == '2')) {
		format += (step + 2);
		step = Tcl_UtfToUniChar(format, &ch);
		step = TclUtfToUniChar(format, &ch);
	    } else {
		format += step;
		step = Tcl_UtfToUniChar(format, &ch);
		step = TclUtfToUniChar(format, &ch);
	    }
	} else if ((ch == 't') || (ch == 'z')) {
	} else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j')
	    format += step;
	    step = Tcl_UtfToUniChar(format, &ch);
#ifndef TCL_WIDE_INT_IS_LONG
	    if (sizeof(size_t) > sizeof(int)) {
		useWide = 1;
	    }
#endif
	} else if ((ch == 'q') ||(ch == 'j')) {
		|| (ch == 'L')) {
	    format += step;
	    step = Tcl_UtfToUniChar(format, &ch);
	    step = TclUtfToUniChar(format, &ch);
#ifndef TCL_WIDE_INT_IS_LONG
	    useWide = 1;
	    useBig = 1;
#endif
	}

	format += step;
	span = format;

	/*
	 * Step 6. The actual conversion character.
1921
1922
1923
1924
1925
1926
1927
1928

1929
1930
1931
1932
1933
1934




1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965

1966
1967
1968
1969













1970
1971
1972

1973
1974
1975
1976
1977


1978
1979
1980
1981
1982
1983
1984

1985
1986
1987

1988
1989
1990
1991

1992
1993
1994
1995
1996
1997
1998
1999

2000
2001
2002
2003

2004
2005

2006
2007
2008
2009

2010
2011

2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028

2029
2030
2031
2032
2033
2034
2035
2036
2037

2038
2039
2040
2041
2042
2043
2044

2045

2046
2047



2048

2049
2050
2051
2052
2053
2054
2055
2037
2038
2039
2040
2041
2042
2043

2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061





2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084

2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099

2100





2101
2102






2103
2104
2105
2106

2107




2108






2109

2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142

2143





2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158


2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170







-
+






+
+
+
+







-
-
-
-
-



















+



-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+
-
-
-
-
-
+
+
-
-
-
-
-
-

+


-
+
-
-
-
-
+
-
-
-
-
-
-

-
+




+


+




+


+
















-
+
-
-
-
-
-




+







+

+
-
-
+
+
+

+







		    numChars = precision;
		    Tcl_IncrRefCount(segment);
		    allocSegment = 1;
		}
	    }
	    break;
	case 'c': {
	    char buf[TCL_UTF_MAX];
	    char buf[4];
	    int code, length;

	    if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
		goto error;
	    }
	    length = Tcl_UniCharToUtf(code, buf);
	    if (!length) {
		/* Special case for handling upper surrogates. */
		length = Tcl_UniCharToUtf(-1, buf);
	    }
	    segment = Tcl_NewStringObj(buf, length);
	    Tcl_IncrRefCount(segment);
	    allocSegment = 1;
	    break;
	}

	case 'u':
	    if (useBig) {
		msg = "unsigned bignum format is invalid";
		errCode = "BADUNSIGNED";
		goto errorMsg;
	    }
	case 'd':
	case 'o':
	case 'p':
	case 'x':
	case 'X':
	case 'b': {
	    short s = 0;	/* Silence compiler warning; only defined and
				 * used when useShort is true. */
	    long l;
	    Tcl_WideInt w;
	    mp_int big;
	    int toAppend, isNegative = 0;

#ifndef TCL_WIDE_INT_IS_LONG
	    if (ch == 'p') {
		useWide = 1;
	    }
#endif
	    if (useBig) {
		int cmpResult;
		if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
		    goto error;
		}
		isNegative = (mp_cmp_d(&big, 0) == MP_LT);
		cmpResult = mp_cmp_d(&big, 0);
		isNegative = (cmpResult == MP_LT);
		if (cmpResult == MP_EQ) gotHash = 0;
		if (ch == 'u') {
		    if (isNegative) {
			mp_clear(&big);
			msg = "unsigned bignum format is invalid";
			errCode = "BADUNSIGNED";
			goto errorMsg;
		    } else {
			ch = 'd';
		    }
		}
#ifndef TCL_WIDE_INT_IS_LONG
	    } else if (useWide) {
		if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
		if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) {
		    Tcl_Obj *objPtr;

		    if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
			goto error;
		    }
		    goto error;
		}
		    mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
		    objPtr = Tcl_NewBignumObj(&big);
		    Tcl_IncrRefCount(objPtr);
		    Tcl_GetWideIntFromObj(NULL, objPtr, &w);
		    Tcl_DecrRefCount(objPtr);
		}
		isNegative = (w < (Tcl_WideInt) 0);
		if (w == (Tcl_WideInt) 0) gotHash = 0;
#endif
	    } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
		if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
		if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) {
		    Tcl_Obj *objPtr;

		    if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
			goto error;
		    goto error;
		    }
		    mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
		    objPtr = Tcl_NewBignumObj(&big);
		    Tcl_IncrRefCount(objPtr);
		    TclGetLongFromObj(NULL, objPtr, &l);
		    Tcl_DecrRefCount(objPtr);
		} else {
		    l = Tcl_WideAsLong(w);
		    l = (long) w;
		}
		if (useShort) {
		    s = (short) l;
		    isNegative = (s < (short) 0);
		    if (s == (short) 0) gotHash = 0;
		} else {
		    isNegative = (l < (long) 0);
		    if (l == (long) 0) gotHash = 0;
		}
	    } else if (useShort) {
		s = (short) l;
		isNegative = (s < (short) 0);
		if (s == (short) 0) gotHash = 0;
	    } else {
		isNegative = (l < (long) 0);
		if (l == (long) 0) gotHash = 0;
	    }

	    segment = Tcl_NewObj();
	    allocSegment = 1;
	    segmentLimit = INT_MAX;
	    Tcl_IncrRefCount(segment);

	    if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) {
		Tcl_AppendToObj(segment,
			(isNegative ? "-" : gotPlus ? "+" : " "), 1);
		segmentLimit -= 1;
	    }

	    if (gotHash || (ch == 'p')) {
		switch (ch) {
		case 'o':
		    Tcl_AppendToObj(segment, "0", 1);
		    Tcl_AppendToObj(segment, "0o", 2);
		    segmentLimit -= 1;
		    precision--;
		    break;
		case 'X':
		    Tcl_AppendToObj(segment, "0X", 2);
		    segmentLimit -= 2;
		    break;
		case 'p':
		case 'x':
		case 'X':
		    Tcl_AppendToObj(segment, "0x", 2);
		    segmentLimit -= 2;
		    break;
		case 'b':
		    Tcl_AppendToObj(segment, "0b", 2);
		    segmentLimit -= 2;
		    break;
#if TCL_MAJOR_VERSION < 9
		case 'd':
		    if (gotZero) {
		    Tcl_AppendToObj(segment, "0d", 2);
		    segmentLimit -= 2;
			Tcl_AppendToObj(segment, "0d", 2);
			segmentLimit -= 2;
		    }
		    break;
#endif
		}
	    }

	    switch (ch) {
	    case 'd': {
		int length;
		Tcl_Obj *pure;
2179
2180
2181
2182
2183
2184
2185
2186

2187
2188
2189
2190
2191
2192
2193
2294
2295
2296
2297
2298
2299
2300

2301
2302
2303
2304
2305
2306
2307
2308







-
+







		    }
		}

		/*
		 * Need to be sure zero becomes "0", not "".
		 */

		if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
		if (numDigits == 0) {
		    numDigits = 1;
		}
		pure = Tcl_NewObj();
		Tcl_SetObjLength(pure, (int) numDigits);
		bytes = TclGetString(pure);
		toAppend = length = (int) numDigits;
		while (numDigits--) {
2246
2247
2248
2249
2250
2251
2252


2253
2254
2255
2256
2257
2258
2259
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376







+
+







		break;
	    }

	    }
	    break;
	}

	case 'a':
	case 'A':
	case 'e':
	case 'E':
	case 'f':
	case 'g':
	case 'G': {
#define MAX_FLOAT_SIZE 320
	    char spec[2*TCL_INTEGER_SPACE + 9], *p = spec;
2313
2314
2315
2316
2317
2318
2319






2320
2321
2322
2323
2324
2325
2326
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449







+
+
+
+
+
+







		goto errorMsg;
	    }
	    bytes = TclGetString(segment);
	    if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    if (ch == 'A') {
		char *p = TclGetString(segment) + 1;
		*p = 'x';
		p = strchr(p, 'P');
		if (p) *p = 'p';
	    }
	    break;
	}
	default:
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
2390
2391
2392
2393
2394
2395
2396
2397

2398
2399
2400
2401
2402
2403
2404
2513
2514
2515
2516
2517
2518
2519

2520
2521
2522
2523
2524
2525
2526
2527







-
+







    Tcl_SetObjLength(appendObj, originalLength);
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_Format--
 * Tcl_Format --
 *
 * Results:
 *	A refcount zero Tcl_Obj.
 *
 * Side effects:
 *	None.
 *
2519
2520
2521
2522
2523
2524
2525




2526
2527


2528
2529
2530
2531
2532

2533



2534


2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666

2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687

2688
2689
2690
2691
2692
2693
2694







+
+
+
+


+
+





+

+
+
+
-
+
+



















-







		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
			    va_arg(argList, long)));
		    break;
		case 2:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
			    va_arg(argList, Tcl_WideInt)));
		    break;
		case 3:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewBignumObj(
			    va_arg(argList, mp_int *)));
		    break;
		}
		break;
	    case 'a':
	    case 'A':
	    case 'e':
	    case 'E':
	    case 'f':
	    case 'g':
	    case 'G':
		if (size > 0) {
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
			(double)va_arg(argList, long double)));
		} else {
			Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
			va_arg(argList, double)));
				va_arg(argList, double)));
		}
		seekingConversion = 0;
		break;
	    case '*':
		lastNum = (int) va_arg(argList, int);
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
		p++;
		break;
	    case '0': case '1': case '2': case '3': case '4':
	    case '5': case '6': case '7': case '8': case '9': {
		char *end;

		lastNum = (int) strtoul(p, &end, 10);
		p = end;
		break;
	    }
	    case '.':
		gotPrecision = 1;
		p++;
		break;
	    /* TODO: support for bignum arguments */
	    case 'l':
		++size;
		p++;
		break;
	    case 't':
	    case 'z':
		if (sizeof(size_t) == sizeof(Tcl_WideInt)) {
2574
2575
2576
2577
2578
2579
2580




2581
2582
2583
2584
2585
2586
2587
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724







+
+
+
+







		    size = 2;
		} else if (p[1]=='3' && p[2]=='2') {
		    p += 2;
		} else if (sizeof(size_t) == sizeof(Tcl_WideInt)) {
		    size = 2;
		}
		p++;
		break;
	    case 'L':
		size = 3;
		p++;
		break;
	    case 'h':
		size = -1;
	    default:
		p++;
	    }
	} while (seekingConversion);
2688
2689
2690
2691
2692
2693
2694

2695

2696
2697
2698
2699

2700
2701
2702
2703
2704

2705
2706
2707
2708
2709

2710
2711

2712
2713
2714
2715
2716
2717
2718
2825
2826
2827
2828
2829
2830
2831
2832

2833
2834
2835


2836
2837
2838
2839
2840

2841
2842
2843
2844
2845

2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856







+
-
+


-
-
+




-
+




-
+


+







 *---------------------------------------------------------------------------
 *
 * TclStringRepeat --
 *
 *	Performs the [string repeat] function.
 *
 * Results:
 * 	A (Tcl_Obj *) pointing to the result value, or NULL in case of an
 * 	A standard Tcl result.
 * 	error.
 *
 * Side effects:
 * 	Writes to *objPtrPtr the address of Tcl_Obj that is concatenation
 * 	of count copies of the value in objPtr.
 * 	On error, when interp is not NULL, error information is left in it.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_Obj *
TclStringRepeat(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    int count,
    Tcl_Obj **objPtrPtr)
    int flags)
{
    Tcl_Obj *objResultPtr;
    int inPlace = flags & TCL_STRING_IN_PLACE;
    int length = 0, unichar = 0, done = 1;
    int binary = TclIsPureByteArray(objPtr);

    /* assert (count >= 2) */

    /*
     * Analyze to determine what representation result should be.
2739
2740
2741
2742
2743
2744
2745
2746
2747

2748
2749
2750
2751
2752
2753
2754
2755
2756

2757
2758
2759
2760
2761
2762


2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773

2774
2775




2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787


2788
2789
2790

2791
2792
2793
2794
2795
2796
2797
2798
2799

2800
2801




2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814

2815
2816
2817
2818
2819
2820
2821
2822
2823
2824

2825
2826
2827
2828
2829
2830
2831

2832
2833
2834
2835

2836

2837
2838
2839
2840

2841
2842
2843
2844
2845
2846


2847
2848
2849
2850
2851

2852
2853
2854
2855
2856
2857

2858
2859
2860
2861
2862
2863

2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879


2880

2881
2882
2883
2884
2885


2886

2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904







2905
2906
2907
2908
2909
2910

2911
2912






2913
2914
2915

2916
2917




2918

2919

2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931

2932
2933





2934
2935
2936
2937
2938
2939
2940
2877
2878
2879
2880
2881
2882
2883


2884
2885
2886
2887
2888
2889
2890
2891
2892

2893
2894
2895
2896
2897


2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911


2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925


2926
2927
2928
2929

2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940


2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956

2957
2958
2959
2960
2961
2962
2963
2964
2965
2966

2967

2968
2969
2970
2971
2972

2973
2974
2975
2976
2977
2978

2979
2980
2981


2982
2983
2984
2985
2986


2987
2988
2989

2990
2991

2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004

3005

3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022

3023
3024
3025
3026


3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038










3039
3040
3041
3042
3043
3044
3045

3046
3047
3048
3049
3050
3051


3052
3053
3054
3055
3056
3057
3058
3059
3060
3061


3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082


3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094







-
-
+








-
+




-
-
+
+











+
-
-
+
+
+
+










-
-
+
+


-
+









+
-
-
+
+
+
+












-
+









-
+
-





-
+




+
-
+


-
-
+




-
-
+
+

-


-
+






+





-
+
-















+
+
-
+



-
-
+
+

+








-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-





+
-
-
+
+
+
+
+
+



+
-
-
+
+
+
+

+

+












+
-
-
+
+
+
+
+







    } else {
	/* Result will be concat of string reps. Pre-size it. */
	Tcl_GetStringFromObj(objPtr, &length);
    }

    if (length == 0) {
	/* Any repeats of empty is empty. */
	*objPtrPtr = objPtr;
	return TCL_OK;
	return objPtr;
    }

    if (count > INT_MAX/length) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	}
	return TCL_ERROR;
	return NULL;
    }

    if (binary) {
	/* Efficiently produce a pure byte array result */
	objResultPtr = Tcl_IsShared(objPtr) ? Tcl_DuplicateObj(objPtr)
		: objPtr;
	objResultPtr = (!inPlace || Tcl_IsShared(objPtr)) ?
		Tcl_DuplicateObj(objPtr) : objPtr;

	Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */
	Tcl_SetByteArrayLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	TclAppendBytesToByteArray(objResultPtr,
		Tcl_GetByteArrayFromObj(objResultPtr, NULL),
		(count - done) * length);
    } else if (unichar) {
	/*
	/* Efficiently produce a pure Tcl_UniChar array result */
	if (Tcl_IsShared(objPtr)) {
	 * Efficiently produce a pure Tcl_UniChar array result.
	 */

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
	} else {
	    TclInvalidateStringRep(objPtr);
	    objResultPtr = objPtr;
	}

        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %"
			TCL_LL_MODIFIER "d bytes",
			(Tcl_WideUInt)STRING_SIZE(count*length)));
			TCL_Z_MODIFIER "u bytes",
			STRING_SIZE(count*length)));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return TCL_ERROR;
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
		(count - done) * length);
    } else {
	/*
	/* Efficiently concatenate string reps */
	if (Tcl_IsShared(objPtr)) {
	 * Efficiently concatenate string reps.
	 */

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length);
	} else {
	    TclFreeIntRep(objPtr);
	    objResultPtr = objPtr;
	}
        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %u bytes",
			count*length));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return TCL_ERROR;
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr),
		(count - done) * length);
    }
    *objPtrPtr = objResultPtr;
    return objResultPtr;
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringCatObjv --
 * TclStringCat --
 *
 *	Performs the [string cat] function.
 *
 * Results:
 * 	A (Tcl_Obj *) pointing to the result value, or NULL in case of an
 * 	A standard Tcl result.
 * 	error.
 *
 * Side effects:
 * 	Writes to *objPtrPtr the address of Tcl_Obj that is concatenation
 * 	of all objc values in objv.
 * 	On error, when interp is not NULL, error information is left in it.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringCatObjv(
Tcl_Obj *
TclStringCat(
    Tcl_Interp *interp,
    int inPlace,
    int objc,
    Tcl_Obj * const objv[],
    Tcl_Obj **objPtrPtr)
    int flags)
{
    Tcl_Obj *objResultPtr, * const *ov;
    int oc, length = 0, binary = 1;
    int allowUniChar = 1, requestUniChar = 0;
    int first = objc - 1;	/* Index of first value possibly not empty */
    int last = 0;		/* Index of last value possibly not empty */
    int inPlace = flags & TCL_STRING_IN_PLACE;

    /* assert ( objc >= 0 ) */

    if (objc <= 1) {
	/* Only one or no objects; return first or empty */
	*objPtrPtr = objc ? objv[0] : Tcl_NewObj();
	return objc ? objv[0] : Tcl_NewObj();
	return TCL_OK;
    }

    /* assert ( objc >= 2 ) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.
     * 		Produce pure bytearray when possible.
     * 		Error on overflow.
     */

    ov = objv, oc = objc;
    do {
	Tcl_Obj *objPtr = *ov++;

	if (TclIsPureByteArray(objPtr)) {
	    allowUniChar = 0;
	if (objPtr->bytes) {
	} else if (objPtr->bytes) {
	    /* Value has a string rep. */
	    if (objPtr->length) {
		/*
		 * Non-empty string rep. Not a pure bytearray, so we
		 * won't create a pure bytearray
		 * Non-empty string rep. Not a pure bytearray, so we won't
		 * create a pure bytearray.
		 */

	 	binary = 0;
		if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
		    /* Prevent shimmer of non-string types. */
		    allowUniChar = 0;
		}
	    }
	} else {
	    /* assert (objPtr->typePtr != NULL) -- stork! */
	    if (TclIsPureByteArray(objPtr)) {
		allowUniChar = 0;
	    } else {
		binary = 0;
		if (objPtr->typePtr == &tclStringType) {
		    /* Have a pure Unicode value; ask to preserve it */
		    requestUniChar = 1;
		} else {
		    /* Have another type; prevent shimmer */
		    allowUniChar = 0;
	    binary = 0;
	    if (objPtr->typePtr == &tclStringType) {
		/* Have a pure Unicode value; ask to preserve it */
		requestUniChar = 1;
	    } else {
		/* Have another type; prevent shimmer */
		allowUniChar = 0;
		}
	    }
	}
    } while (--oc && (binary || allowUniChar));

    if (binary) {
	/*
	/* Result will be pure byte array. Pre-size it */
	ov = objv; oc = objc;
	 * Result will be pure byte array. Pre-size it
	 */

	int numBytes;
	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    /*
	    if (objPtr->bytes == NULL) {
		int numBytes;
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to count bytes for the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */

		if (numBytes) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    } else if (numBytes > INT_MAX - length) {
			goto overflow;
		    }
		    length += numBytes;
		}
	    }
	} while (--oc);
    } else if (allowUniChar && requestUniChar) {
	/*
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	ov = objv; oc = objc;
	 * Result will be pure Tcl_UniChar array. Pre-size it.
	 */

	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int numChars;

		Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980



2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994



2995
2996
2997
2998
2999
3000
3001
3002
3125
3126
3127
3128
3129
3130
3131



3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145



3146
3147
3148

3149
3150
3151
3152
3153
3154
3155







-
-
-
+
+
+











-
-
-
+
+
+
-







		    pendingPtr = objPtr;
		} else {
		    Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */
		}
	    } while (--oc && (length == 0) && (pendingPtr == NULL));

	    /*
 	     * Either we found a possibly non-empty value, and we
 	     * remember this index as the first and last such value so
 	     * far seen, or (oc == 0) and all values are known empty,
 	     * Either we found a possibly non-empty value, and we remember
 	     * this index as the first and last such value so far seen,
	     * or (oc == 0) and all values are known empty,
 	     * so first = last = objc - 1 signals the right quick return.
 	     */

	    first = last = objc - oc - 1;

	    if (oc && (length == 0)) {
		int numBytes;

		/* assert ( pendingPtr != NULL ) */

		/*
		 * There's a pending value followed by more values.
		 * Loop over remaining values generating strings until
		 * a non-empty value is found, or the pending value gets
		 * There's a pending value followed by more values.  Loop over
		 * remaining values generating strings until a non-empty value
		 * is found, or the pending value gets its string generated.
		 * its string generated.
		 */

		do {
		    Tcl_Obj *objPtr = *ov++;
		    Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */
		} while (--oc && numBytes == 0 && pendingPtr->bytes == NULL);

3034
3035
3036
3037
3038
3039
3040
3041

3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053


3054
3055

3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068





3069


3070
3071
3072
3073
3074
3075
3076
3187
3188
3189
3190
3191
3192
3193

3194

3195
3196
3197
3198
3199
3200
3201
3202
3203


3204
3205

3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225

3226
3227
3228
3229
3230
3231
3232
3233
3234







-
+
-









-
-
+
+
-

+













+
+
+
+
+
-
+
+







	    --oc;
	}
    }

    if (last <= first /*|| length == 0 */) {
	/* Only one non-empty value or zero length; return first */
	/* NOTE: (length == 0) implies (last <= first) */
	*objPtrPtr = objv[first];
	return objv[first];
	return TCL_OK;
    }

    objv += first; objc = (last - first + 1);

    if (binary) {
	/* Efficiently produce a pure byte array result */
	unsigned char *dst;

	/*
	 * Broken interface! Byte array value routines offer no way
	 * to handle failure to allocate enough space. Following
	 * Broken interface! Byte array value routines offer no way to handle
	 * failure to allocate enough space. Following stanza may panic.
	 * stanza may panic.
	 */

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;
	    Tcl_GetByteArrayFromObj(objResultPtr, &start);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
	} else {
	    objResultPtr = Tcl_NewByteArrayObj(NULL, length);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to copy bytes from the empty strings.
	     */
	    if (objPtr->bytes == NULL) {

	    if (TclIsPureByteArray(objPtr)) {
		int more;
		unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, (size_t) more);
		dst += more;
	    }
	}
    } else if (allowUniChar && requestUniChar) {
3085
3086
3087
3088
3089
3090
3091
3092
3093


3094
3095
3096

3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110


3111
3112
3113

3114
3115
3116
3117
3118
3119
3120
3243
3244
3245
3246
3247
3248
3249


3250
3251
3252
3253

3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266


3267
3268
3269
3270

3271
3272
3273
3274
3275
3276
3277
3278







-
-
+
+


-
+












-
-
+
+


-
+







	    /* Ugly interface! Force resize of the unicode array. */
	    Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %"
			TCL_LL_MODIFIER "d bytes",
			(Tcl_WideUInt)STRING_SIZE(length)));
			TCL_Z_MODIFIER "u bytes",
			STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
		return NULL;
	    }
	    dst = Tcl_GetUnicode(objResultPtr) + start;
	} else {
	    Tcl_UniChar ch = 0;

	    /* Ugly interface! No scheme to init array size. */
	    objResultPtr = Tcl_NewUnicodeObj(&ch, 0);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		Tcl_DecrRefCount(objResultPtr);
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %"
			TCL_LL_MODIFIER "d bytes",
			(Tcl_WideUInt)STRING_SIZE(length)));
			TCL_Z_MODIFIER "u bytes",
			STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
		return NULL;
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
3137
3138
3139
3140
3141
3142
3143
3144

3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160

3161
3162
3163
3164
3165
3166
3167
3168
3169

3170
3171
3172
3173


3174
3175

3176
3177
3178
3179
3180
3181
3182
3183
3184






















































































































































































3185
3186
3187
3188
3189
3190

3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206

3207
3208
3209
3210
3211
3212



3213
3214
3215

3216
3217
3218


3219
3220
3221
3222
3223
3224
3225
3226

3227
3228
3229
3230
3231





3232

3233
3234

3235
3236

3237

3238
3239

3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252







3253
3254

3255
3256
3257
3258


3259
3260
3261

3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3295
3296
3297
3298
3299
3300
3301

3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317

3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335

3336

3337
3338
3339
3340
3341
3342
3343

3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530

3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546

3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557


3558



3559
3560

3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578

3579

3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595







3596
3597
3598
3599
3600
3601
3602


3603




3604
3605
3606


3607










3608
3609
3610
3611
3612
3613
3614







-
+















-
+









+




+
+

-
+
-







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+















-
+






+
+
+

-
-
+
-
-
-
+
+
-







+





+
+
+
+
+
-
+
-

+


+

+


+






-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
-
+
+

-
-
+
-
-
-
-
-
-
-
-
-
-







	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
		return NULL;
	    }
	    dst = Tcl_GetString(objResultPtr) + start;

	    /* assert ( length > start ) */
	    TclFreeIntRep(objResultPtr);
	} else {
	    objResultPtr = Tcl_NewObj();	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		Tcl_DecrRefCount(objResultPtr);
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
		return NULL;
	    }
	    dst = Tcl_GetString(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int more;
		char *src = Tcl_GetStringFromObj(objPtr, &more);

		memcpy(dst, src, (size_t) more);
		dst += more;
	    }
	}
	/* Must NUL-terminate! */
	*dst = '\0';
    }
    *objPtrPtr = objResultPtr;
    return objResultPtr;
    return TCL_OK;

  overflow:
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return TCL_ERROR;
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringCmp --
 *	Compare two Tcl_Obj values as strings.
 *
 * Results:
 *	Like memcmp, return -1, 0, or 1.
 *
 * Side effects:
 *	String representations may be generated.  Internal representation may
 *	be changed.
 *
 *---------------------------------------------------------------------------
 */

int TclStringCmp(
    Tcl_Obj *value1Ptr,
    Tcl_Obj *value2Ptr,
    int checkEq,		/* comparison is only for equality */
    int nocase,			/* comparison is not case sensitive */
    int reqlength)		/* requested length */
{
    char *s1, *s2;
    int empty, length, match, s1len, s2len;
    memCmpFn_t memCmpFn;

    if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 */
	match = 0;
    } else {

	if (!nocase && TclIsPureByteArray(value1Ptr)
		&& TclIsPureByteArray(value2Ptr)) {
	    /*
	     * Use binary versions of comparisons since that won't cause undue
	     * type conversions and it is much faster. Only do this if we're
	     * case-sensitive (which is all that really makes sense with byte
	     * arrays anyway, and we have no memcasecmp() for some reason... :^)
	     */

	    s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
	    memCmpFn = memcmp;
	} else if ((value1Ptr->typePtr == &tclStringType)
		&& (value2Ptr->typePtr == &tclStringType)) {
	    /*
	     * Do a unicode-specific comparison if both of the args are of
	     * String type. If the char length == byte length, we can do a
	     * memcmp. In benchmark testing this proved the most efficient
	     * check between the unicode and string comparison operations.
	     */

	    if (nocase) {
		s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
		s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
		memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp;
	    } else {
		s1len = Tcl_GetCharLength(value1Ptr);
		s2len = Tcl_GetCharLength(value2Ptr);
		if ((s1len == value1Ptr->length)
			&& (value1Ptr->bytes != NULL)
			&& (s2len == value2Ptr->length)
			&& (value2Ptr->bytes != NULL)) {
		    s1 = value1Ptr->bytes;
		    s2 = value2Ptr->bytes;
		    memCmpFn = memcmp;
		} else {
		    s1 = (char *) Tcl_GetUnicode(value1Ptr);
		    s2 = (char *) Tcl_GetUnicode(value2Ptr);
		    if (
#ifdef WORDS_BIGENDIAN
			1
#else
			checkEq
#endif
			) {
			memCmpFn = memcmp;
			s1len *= sizeof(Tcl_UniChar);
			s2len *= sizeof(Tcl_UniChar);
		    } else {
			memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
		    }
		}
	    }
	} else {
	    if ((empty = TclCheckEmptyString(value1Ptr)) > 0) {
		switch (TclCheckEmptyString(value2Ptr)) {
		case -1:
		    s1 = 0;
		    s1len = 0;
		    s2 = TclGetStringFromObj(value2Ptr, &s2len);
		    break;
		case 0:
		    match = -1;
		    goto matchdone;
		case 1:
		default: /* avoid warn: `s2` may be used uninitialized */
		    match = 0;
		    goto matchdone;
		}
	    } else if (TclCheckEmptyString(value2Ptr) > 0) {
		switch (empty) {
		case -1:
		    s2 = 0;
		    s2len = 0;
		    s1 = TclGetStringFromObj(value1Ptr, &s1len);
		    break;
		case 0:
		    match = 1;
		    goto matchdone;
		case 1:
		default: /* avoid warn: `s1` may be used uninitialized */
		    match = 0;
		    goto matchdone;
		}
	    } else {
		s1 = TclGetStringFromObj(value1Ptr, &s1len);
		s2 = TclGetStringFromObj(value2Ptr, &s2len);
	    }
	    if (!nocase && checkEq) {
		/*
		 * When we have equal-length we can check only for
		 * (in)equality. We can use memcmp in all (n)eq cases because
		 * we don't need to worry about lexical LE/BE variance.
		 */

		memCmpFn = memcmp;
	    } else {
		/*
		 * As a catch-all we will work with UTF-8. We cannot use
		 * memcmp() as that is unsafe with any string containing NUL
		 * (\xC0\x80 in Tcl's utf rep). We can use the more efficient
		 * TclpUtfNcmp2 if we are case-sensitive and no specific
		 * length was requested.
		 */

		if ((reqlength < 0) && !nocase) {
		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
		} else {
		    s1len = Tcl_NumUtfChars(s1, s1len);
		    s2len = Tcl_NumUtfChars(s2, s2len);
		    memCmpFn = (memCmpFn_t)
			    (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
		}
	    }
	}

	length = (s1len < s2len) ? s1len : s2len;
	if (reqlength > 0 && reqlength < length) {
	    length = reqlength;
	} else if (reqlength < 0) {
	    /*
	     * The requested length is negative, so we ignore it by setting it
	     * to length + 1 so we correct the match var.
	     */

	    reqlength = length + 1;
	}

	if (checkEq && (s1len != s2len)) {
	    match = 1;		/* This will be reversed below. */
	} else {
	    /*
	     * The comparison function should compare up to the minimum byte
	     * length only.
	     */

	    match = memCmpFn(s1, s2, (size_t) length);
	}
	if ((match == 0) && (reqlength > length)) {
	    match = s1len - s2len;
	}
	match = (match > 0) ? 1 : (match < 0) ? -1 : 0;
    }
  matchdone:
    return match;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringFind --
 * TclStringFirst --
 *
 *	Implements the [string first] operation.
 *
 * Results:
 *	If needle is found as a substring of haystack, the index of the
 *	first instance of such a find is returned.  If needle is not present
 *	as a substring of haystack, -1 is returned.
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringFind(
TclStringFirst(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int start)
{
    int lh, ln = Tcl_GetCharLength(needle);

    if (start < 0) {
	start = 0;
    }
    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	/* We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return 0"
	 * Whenever this routine is turned into a proper substring
	 * finder, change to `return start` after limits imposed. */
	 */
	return -1;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *end, *try, *bh;
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	/* Find bytes in bytes */
	bh = Tcl_GetByteArrayFromObj(haystack, &lh);
	end = bh + lh;

	try = bh + start;
	while (try + ln <= end) {
	    /*
	     * Look for the leading byte of the needle in the haystack
	     * starting at try and stopping when there's not enough room
	     * for the needle left.
	     */
	    try = memchr(try, bn[0], end - try);
	    try = memchr(try, bn[0], (end + 1 - ln) - try);

	    if (try == NULL) {
		/* Leading byte not found -> needle cannot be found. */
		return -1;
	    }
	    /* Leading byte found, check rest of needle. */
	    if (0 == memcmp(try+1, bn+1, ln-1)) {
		/* Checks! Return the successful index. */
		return (try - bh);
	    }
	    /* Rest of needle match failed; Iterate to continue search. */
	    try++;
	}
	return -1;
    }

    /*
     * Check if we have two strings of single-byte characters. If we have, we
     * can use strstr() to do the search. Note that we can sometimes have
     * multibyte characters when the string could be minimally represented
     * using single byte characters; we can't assume that a mismatch here
     * means no match.
     */

     * TODO: It might be nice to support some cases where it is not
     * necessary to shimmer to &tclStringType to compute the result,
     * and instead operate just on the objPtr->bytes values directly.
     * However, we also do not want the answer to change based on the
     * code pathway, or if it does we want that to be for some values
     * we explicitly decline to support.  Getting there will involve
     * locking down in practice more firmly just what encodings produce
    lh = Tcl_GetCharLength(haystack);
    if (haystack->bytes && (lh == haystack->length) && needle->bytes
     * what supported results for the objPtr->bytes values.  For now,
		&& (ln == needle->length)) {
	/*
	 * Both haystack and needle are all single-byte chars.
	 */
     * do only the well-defined Tcl_UniChar array search.
     */

	char *found = strstr(haystack->bytes + start, needle->bytes);

    {
	if (found) {
	    return (found - haystack->bytes);
	} else {
	    return -1;
	}
    } else {
	/*
	 * Do the search on the unicode representation for simplicity.
	 */

	Tcl_UniChar *try, *end, *uh;
	Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);

	uh = Tcl_GetUnicodeFromObj(haystack, &lh);
	end = uh + lh;

	for (try = uh + start; try + ln <= end; try++) {
3312
3313
3314
3315
3316
3317
3318
3319

3320
3321
3322
3323




3324


3325
3326
3327
3328
3329

3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354

3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375

3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395

3396
3397
3398
3399
3400
3401
3402



3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414

3415
3416
3417

3418
3419
3420
3421

3422
3423
3424
3425

3426
3427
3428
3429
3430
3431
3432
3433
3434



3435
3436
3437

3438
3439
3440
3441
3442
3443

3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457

3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471

3472



3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486

3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497


3498
3499
3500

3501
3502
3503
3504
3505
3506
3507
3508



3509

3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
















































































































































3529
3530
3531
3532
3533
3534
3535
3648
3649
3650
3651
3652
3653
3654

3655
3656
3657
3658
3659
3660
3661
3662
3663

3664
3665
3666
3667
3668
3669

3670
3671
3672





3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683







3684





















3685
3686
3687


3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702

3703
3704
3705
3706
3707



3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721

3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734

3735
3736
3737
3738
3739
3740
3741
3742


3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754

3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768

3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784

3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800

3801
3802
3803
3804
3805
3806
3807
3808
3809
3810


3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821



3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996







-
+




+
+
+
+
-
+
+




-
+


-
-
-
-
-











-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+


-
-















-
+




-
-
-
+
+
+











-
+



+




+



-
+







-
-
+
+
+



+





-
+













-
+














+
-
+
+
+













-
+









-
-
+
+



+





-
-
-
+
+
+

+



















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    int lh, ln = Tcl_GetCharLength(needle);

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return 0"
	 * 	finder, change this to "return last", after limitation.
	 */
	return -1;
    }

    lh = Tcl_GetCharLength(haystack);
    if (last >= lh) {
	last = lh - 1;
    }
    if (ln > last + 1) {

    if (last < ln - 1) {
	return -1;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *try, *bh;
	unsigned char *try, *bh = Tcl_GetByteArrayFromObj(haystack, &lh);
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	bh = Tcl_GetByteArrayFromObj(haystack, &lh);

	if (last + 1 > lh) {
	    last = lh - 1;
	}
	try = bh + last + 1 - ln;
	while (try >= bh) {
	    if ((*try == bn[0])
		    && (0 == memcmp(try+1, bn+1, ln-1))) {
		return (try - bh);
	    }
	    try--;
	}
	return -1;
    }

    lh = Tcl_GetCharLength(haystack);
    if (last + 1 > lh) {
	last = lh - 1;
    }
    if (haystack->bytes && (lh == haystack->length)) {
	/* haystack is all single-byte chars */

    {
	if (needle->bytes && (ln == needle->length)) {
	    /* needle is also all single-byte chars */

	    char *try = haystack->bytes + last + 1 - ln;
	    while (try >= haystack->bytes) {
		if ((*try == needle->bytes[0])
			&& (0 == memcmp(try+1, needle->bytes + 1, ln - 1))) {
		    return (try - haystack->bytes);
		}
		try--;
	    }
	    return -1;
	} else {
	    /*
	     * Cannot find substring with a multi-byte char inside
	     * a string with no multi-byte chars.
	     */
	    return -1;
	}
    } else {
	Tcl_UniChar *try, *uh;
	Tcl_UniChar *try, *uh = Tcl_GetUnicodeFromObj(haystack, &lh);
	Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);

	uh = Tcl_GetUnicodeFromObj(haystack, &lh);

	try = uh + last + 1 - ln;
	while (try >= uh) {
	    if ((*try == un[0])
		    && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
		return (try - uh);
	    }
	    try--;
	}
	return -1;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringObjReverse --
 * TclStringReverse --
 *
 *	Implements the [string reverse] operation.
 *
 * Results:
 *	An unshared Tcl value which is the [string reverse] of the argument
 *	supplied. When sharing rules permit, the returned value might be the
 *	argument with modifications done in place.
 *	A Tcl value which is the [string reverse] of the argument supplied.
 *	When sharing rules permit and the caller requests, the returned value
 *	might be the argument with modifications done in place.
 *
 * Side effects:
 *	May allocate a new Tcl_Obj.
 *
 *---------------------------------------------------------------------------
 */

static void
ReverseBytes(
    unsigned char *to,		/* Copy bytes into here... */
    unsigned char *from,	/* ...from here... */
    int count)		/* Until this many are copied, */
    int count)			/* Until this many are copied, */
				/* reversing as you go. */
{
    unsigned char *src = from + count;

    if (to == from) {
	/* Reversing in place */
	while (--src > to) {
	    unsigned char c = *src;

	    *src = *to;
	    *to++ = c;
	}
    }  else {
    } else {
	while (--src >= from) {
	    *to++ = *src;
	}
    }
}

Tcl_Obj *
TclStringObjReverse(
    Tcl_Obj *objPtr)
TclStringReverse(
    Tcl_Obj *objPtr,
    int flags)
{
    String *stringPtr;
    Tcl_UniChar ch = 0;
    int inPlace = flags & TCL_STRING_IN_PLACE;

    if (TclIsPureByteArray(objPtr)) {
	int numBytes;
	unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (Tcl_IsShared(objPtr)) {
	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
	return objPtr;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode) {
	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
	Tcl_UniChar *src = from + stringPtr->numChars;

	if (Tcl_IsShared(objPtr)) {
	if (!inPlace || Tcl_IsShared(objPtr)) {
	    Tcl_UniChar *to;

	    /*
	     * Create a non-empty, pure unicode value, so we can coax
	     * Tcl_SetObjLength into growing the unicode rep buffer.
	     */

	    objPtr = Tcl_NewUnicodeObj(&ch, 1);
	    Tcl_SetObjLength(objPtr, stringPtr->numChars);
	    to = Tcl_GetUnicode(objPtr);
	    while (--src >= from) {
		*to++ = *src;
	    }
	} else {
	    /*
	    /* Reversing in place */
	     * Reversing in place.
	     */

	    while (--src > from) {
		ch = *src;
		*src = *from;
		*from++ = ch;
	    }
	}
    }

    if (objPtr->bytes) {
	int numChars = stringPtr->numChars;
	int numBytes = objPtr->length;
	char *to, *from = objPtr->bytes;

	if (Tcl_IsShared(objPtr)) {
	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewObj();
	    Tcl_SetObjLength(objPtr, numBytes);
	}
	to = objPtr->bytes;

	if (numChars < numBytes) {
	    /*
	     * Either numChars == -1 and we don't know how many chars are
	     * represented by objPtr->bytes and we need Pass 1 just in case,
	     * or numChars >= 0 and we know we have fewer chars than bytes,
	     * so we know there's a multibyte character needing Pass 1.
	     * or numChars >= 0 and we know we have fewer chars than bytes, so
	     * we know there's a multibyte character needing Pass 1.
	     *
	     * Pass 1. Reverse the bytes of each multi-byte character.
	     */

	    int charCount = 0;
	    int bytesLeft = numBytes;

	    while (bytesLeft) {
		/*
		 * NOTE: We know that the from buffer is NUL-terminated.
		 * It's part of the contract for objPtr->bytes values.
		 * Thus, we can skip calling Tcl_UtfCharComplete() here.
		 * NOTE: We know that the from buffer is NUL-terminated. It's
		 * part of the contract for objPtr->bytes values. Thus, we can
		 * skip calling Tcl_UtfCharComplete() here.
		 */

		int bytesInChar = TclUtfToUniChar(from, &ch);

		ReverseBytes((unsigned char *)to, (unsigned char *)from,
			bytesInChar);
		to += bytesInChar;
		from += bytesInChar;
		bytesLeft -= bytesInChar;
		charCount++;
	    }

	    from = to = objPtr->bytes;
	    stringPtr->numChars = charCount;
	}
	/* Pass 2. Reverse all the bytes. */
	ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
    }

    return objPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringReplace --
 *
 *	Implements the inner engine of the [string replace] command.
 *
 *	The result is a concatenation of a prefix from objPtr, characters
 *	0 through first-1, the insertPtr string value, and a suffix from
 *	objPtr, characters from first + count to the end. The effect is as if
 *	the inner substring of characters first through first+count-1 are
 *	removed and replaced with insertPtr. If insertPtr is NULL, it is
 *	treated as an empty string. When passed the flag TCL_STRING_IN_PLACE,
 *	this routine will try to do the work within objPtr, so long as no
 *	sharing forbids it. Without that request, or as needed, a new Tcl
 *	value will be allocated to be the result.
 *
 * Results:
 *	A Tcl value that is the result of the substring replacement. May
 *	return NULL in case of an error. When NULL is returned and interp is
 *	non-NULL, error information is left in interp
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringReplace(
    Tcl_Interp *interp,		/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,		/* String to act upon */
    int first,			/* First index to replace */
    int count,			/* How many chars to replace */
    Tcl_Obj *insertPtr,		/* Replacement string, may be NULL */
    int flags)			/* TCL_STRING_IN_PLACE => attempt in-place */
{
    int inPlace = flags & TCL_STRING_IN_PLACE;
    Tcl_Obj *result;

    /* Caller is expected to pass sensible arguments */
    assert ( count >= 0 ) ;
    assert ( first >= 0 ) ;

    /* Replace nothing with nothing */
    if ((insertPtr == NULL) && (count == 0)) {
	if (inPlace) {
	    return objPtr;
	} else {
	    return Tcl_DuplicateObj(objPtr);
	}
    }

    /*
     * The caller very likely had to call Tcl_GetCharLength() or similar
     * to be able to process index values.  This means it is like that
     * objPtr is either a proper "bytearray" or a "string" or else it has
     * a known and short string rep.
     */

    if (TclIsPureByteArray(objPtr)) {
	int numBytes;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (insertPtr == NULL) {
	    /* Replace something with nothing. */

	    assert ( first <= numBytes ) ;
	    assert ( count <= numBytes ) ;
	    assert ( first + count <= numBytes ) ;

	    result = Tcl_NewByteArrayObj(NULL, numBytes - count);/* PANIC? */
	    TclAppendBytesToByteArray(result, bytes, first);
	    TclAppendBytesToByteArray(result, bytes + first + count,
		    numBytes - count - first);
	    return result;
	}

	/* Replace everything */
	if ((first == 0) && (count == numBytes)) {
	    return insertPtr;
	}

	if (TclIsPureByteArray(insertPtr)) {
	    int newBytes;
	    unsigned char *iBytes
		    = Tcl_GetByteArrayFromObj(insertPtr, &newBytes);

	    if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) {
		/*
		 * Removal count and replacement count are equal.
		 * Other conditions permit. Do in-place splice.
		 */

		memcpy(bytes + first, iBytes, count);
		Tcl_InvalidateStringRep(objPtr);
		return objPtr;
	    }

	    if (newBytes > INT_MAX - (numBytes - count)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "max size for a Tcl value (%d bytes) exceeded",
			    INT_MAX));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes);
								/* PANIC? */
	    Tcl_SetByteArrayLength(result, 0);
	    TclAppendBytesToByteArray(result, bytes, first);
	    TclAppendBytesToByteArray(result, iBytes, newBytes);
	    TclAppendBytesToByteArray(result, bytes + first + count,
		    numBytes - count - first);
	    return result;
	}

	/* Flow through to try other approaches below */
    }

    /*
     * TODO: Figure out how not to generate a Tcl_UniChar array rep
     * when it can be determined objPtr->bytes points to a string of
     * all single-byte characters so we can index it directly.
     */

    /* The traditional implementation... */
    {
	int numChars;
	Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars);

	/* TODO: Is there an in-place option worth pursuing here? */

	result = Tcl_NewUnicodeObj(ustring, first);
	if (insertPtr) {
	    Tcl_AppendObjToObj(result, insertPtr);
	}
	if (first + count < numChars) {
	    Tcl_AppendUnicodeToObj(result, ustring + first + count,
		    numChars - first - count);
	}

	return result;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * FillUnicodeRep --
 *
 *	Populate the Unicode internal rep with the Unicode form of its string

Changes to generic/tclStringRep.h.

82
83
84
85
86
87
88

89
90
91
92
93
94
95
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96







+







#define stringRealloc(ptr, numChars) \
    (String *) ckrealloc((ptr), STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
    (String *) attemptckrealloc((ptr), STRING_SIZE(numChars))
#define GET_STRING(objPtr) \
    ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
    ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL),			\
    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78

Changes to generic/tclStubInit.c.

1
2
3
4
5
6
7
8
9
10
11
12
13




14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

34
35

36
37
38
39
40
41

42
43
44

45
46
47
48
49
50
51
52

53
54
55
56
57
58
59
60
61
62

63
64
65
66

67
68
69
70
71




72
73
74







75
76
77
78
79
80
81
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101













+
+
+
+




















+


+






+



+







-
+









-
+




+





+
+
+
+



+
+
+
+
+
+
+







/*
 * tclStubInit.c --
 *
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath.h"

#ifdef __CYGWIN__
#   include <wchar.h>
#endif

#ifdef __GNUC__
#pragma GCC dependency "tcl.decls"
#pragma GCC dependency "tclInt.decls"
#pragma GCC dependency "tclTomMath.decls"
#endif

/*
 * Remove macros that will interfere with the definitions below.
 */

#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc
#undef Tcl_NewBooleanObj
#undef Tcl_NewByteArrayObj
#undef Tcl_NewDoubleObj
#undef Tcl_NewIntObj
#undef Tcl_NewListObj
#undef Tcl_NewLongObj
#undef Tcl_DbNewLongObj
#undef Tcl_NewObj
#undef Tcl_NewStringObj
#undef Tcl_GetUnicode
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry
#undef Tcl_Panic
#undef Tcl_FindExecutable
#undef Tcl_SetPanicProc
#undef TclpGetPid
#undef TclSockMinimumBuffers
#undef Tcl_SetIntObj
#undef Tcl_SetLongObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt
#undef TclWinSetSockOpt
#undef TclWinNToHS

/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#if defined(_WIN64) || defined(TCL_NO_DEPRECATED)
#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
#   define TclSockMinimumBuffersOld 0
#else
#define TclSockMinimumBuffersOld sockMinimumBuffersOld
static int TclSockMinimumBuffersOld(int sock, int size)
{
    return TclSockMinimumBuffers(INT2PTR(sock), size);
}
#endif

#if defined(TCL_NO_DEPRECATED)
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
#   define TclSetStartupScriptPath 0
#   define TclGetStartupScriptPath 0
#   define TclSetStartupScriptFileName 0
#   define TclGetStartupScriptFileName 0
#   define TclPrecTraceProc 0
#   define TclpInetNtoa 0
#   define TclWinGetServByName 0
#   define TclWinGetSockOpt 0
#   define TclWinSetSockOpt 0
#   define TclWinNToHS 0
#   define TclWinGetPlatformId 0
#   define TclWinResetInterfaces 0
#   define TclWinSetInterfaces 0
#   define TclWinGetPlatformId 0
#   define TclBNInitBignumFromWideUInt 0
#   define TclBNInitBignumFromWideInt 0
#   define TclBNInitBignumFromLong 0
#   define Tcl_Backslash 0
#   define Tcl_GetDefaultEncodingDir 0
#   define Tcl_SetDefaultEncodingDir 0
#   define Tcl_EvalTokens 0
#   define Tcl_CreateMathFunc 0
#   define Tcl_GetMathFuncInfo 0
#   define Tcl_ListMathFuncs 0
#else
#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
{
    Tcl_SetStartupScript(path, NULL);
}
#define TclGetStartupScriptPath getStartupScriptPath
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
128
129
130
131
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
114
115
116
117
118
119
120

121
122
123
124
125
126
127
128
129
130
131
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
161
162
163
164
165



166
167
168
169
170
171
172









173
174
175
176

177
178
179
180

181
182
183
184
185
186
187
188







-


+
+
+
+
+
+
+
+




+
+
+
+
+
+
+
+














+
+
-
+
+
+
+
+


-
-
-







-
-
-
-
-
-
-
-
-




-
+



-
+







{
    Tcl_Obj *path = Tcl_GetStartupScript(NULL);
    if (path == NULL) {
	return NULL;
    }
    return Tcl_GetString(path);
}

#if defined(_WIN32) || defined(__CYGWIN__)
#undef TclWinNToHS
#undef TclWinGetPlatformId
#undef TclWinResetInterfaces
#undef TclWinSetInterfaces
static void
doNothing(void)
{
    /* dummy implementation, no need to do anything */
}
#define TclWinNToHS winNToHS
static unsigned short TclWinNToHS(unsigned short ns) {
	return ntohs(ns);
}
#define TclWinGetPlatformId winGetPlatformId
static int
TclWinGetPlatformId(void)
{
    return 2; /* VER_PLATFORM_WIN32_NT */;
}
#define TclWinResetInterfaces doNothing
#define TclWinSetInterfaces (void (*) (int)) doNothing
#endif
#   define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt
#   define TclBNInitBignumFromWideInt TclInitBignumFromWideInt
#   define TclBNInitBignumFromLong TclInitBignumFromLong
#endif /* TCL_NO_DEPRECATED */

#ifdef _WIN32
#   define TclUnixWaitForFile 0
#   define TclUnixCopyFile 0
#   define TclUnixOpenTemporaryFile 0
#   define TclpReaddir 0
#   define TclpIsAtty 0
#elif defined(__CYGWIN__)
#   define TclpIsAtty TclPlatIsAtty
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
static void
#   define TclWinSetInterfaces (void (*) (int)) doNothing
doNothing(void)
{
    /* dummy implementation, no need to do anything */
}
#endif
#   define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
#   define TclWinFlushDirtyChannels doNothing
#   define TclWinResetInterfaces doNothing

static Tcl_Encoding winTCharEncoding;

static int
TclpIsAtty(int fd)
{
    return isatty(fd);
}

#define TclWinGetPlatformId winGetPlatformId
static int
TclWinGetPlatformId()
{
    /* Don't bother to determine the real platform on cygwin,
     * because VER_PLATFORM_WIN32_NT is the only supported platform */
    return 2; /* VER_PLATFORM_WIN32_NT */;
}

void *TclWinGetTclInstance()
{
    void *hInstance = NULL;
    GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
	    (const char *)&winTCharEncoding, &hInstance);
	    (const char *)&TclpIsAtty, &hInstance);
    return hInstance;
}

#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TclWinSetSockOpt winSetSockOpt
static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
	    const char *optval, int optlen)
{
    return setsockopt((int) s, level, optname, optval, optlen);
}
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208

209

210

211
212
213

214
215
216
217
218
219
220
221

222

223

224
225
226






227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261

262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277

278
279
280
281
282
283
284
219
220
221
222
223
224
225






226
227
228
229
230
231
232

233

234
235


236
237
238
239
240
241
242
243
244
245

246

247
248


249
250
251
252
253
254
255
256
257
258
259
260
261
262






















263
264
265
266

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282

283
284
285
286
287
288
289
290







-
-
-
-
-
-






+
-
+
-
+

-
-
+








+
-
+
-
+

-
-
+
+
+
+
+
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+















-
+








int
TclpGetPid(Tcl_Pid pid)
{
    return (int) (size_t) pid;
}

static void
doNothing(void)
{
    /* dummy implementation, no need to do anything */
}

char *
Tcl_WinUtfToTChar(
    const char *string,
    int len,
    Tcl_DString *dsPtr)
{
    Tcl_DStringInit(dsPtr);
    if (!winTCharEncoding) {
    if (!string) {
	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
	return NULL;
    }
    return Tcl_UtfToExternalDString(winTCharEncoding,
	    string, len, dsPtr);
    return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr);
}

char *
Tcl_WinTCharToUtf(
    const char *string,
    int len,
    Tcl_DString *dsPtr)
{
    Tcl_DStringInit(dsPtr);
    if (!winTCharEncoding) {
    if (!string) {
	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
	return NULL;
    }
    return Tcl_ExternalToUtfDString(winTCharEncoding,
	    string, len, dsPtr);
    if (len < 0) {
	len = wcslen((wchar_t *)string);
    } else {
	len /= 2;
    }
    return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr);
}

#if defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
 * we have to make sure that all stub entries on Cygwin64 follow the Win64
 * signature. Tcl 9 must find a better solution, but that cannot be done
 * without introducing a binary incompatibility.
 */
#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))dbNewLongObj)
static Tcl_Obj *dbNewLongObj(
    int intValue,
    const char *file,
    int line
) {
#ifdef TCL_MEM_DEBUG
    register Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    objPtr->bytes = NULL;

    objPtr->internalRep.longValue = (long) intValue;
    objPtr->typePtr = &tclIntType;
    return objPtr;
#else
    return Tcl_NewIntObj(intValue);
#endif
}
#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj
#define Tcl_NewLongObj (Tcl_Obj*(*)(long))Tcl_NewIntObj
#define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))Tcl_SetIntObj
static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
    long longValue;
    int result = Tcl_ExprLong(interp, expr, &longValue);
    if (result == TCL_OK) {
	    if ((longValue >= -(long)(UINT_MAX))
	    if ((longValue >= (long)(INT_MIN))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}
    }
    return result;
}
#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt
static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
    long longValue;
    int result = Tcl_ExprLongObj(interp, expr, &longValue);
    if (result == TCL_OK) {
	    if ((longValue >= -(long)(UINT_MAX))
	    if ((longValue >= (long)(INT_MIN))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314

315
316
317
318
319
320
321
304
305
306
307
308
309
310




311
312
313
314
315

316
317
318
319
320
321
322
323







-
-
-
-





-
+







   return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n);
}
#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp
static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
   return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
}
#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
static int formatInt(char *buffer, int n){
   return TclFormatInt(buffer, (long)n);
}
#define TclFormatInt (int(*)(char *, long))formatInt

#endif /* TCL_WIDE_INT_IS_LONG */

#endif /* __CYGWIN__ */

#ifdef TCL_NO_DEPRECATED
#if defined(TCL_NO_DEPRECATED)
#   define Tcl_SeekOld 0
#   define Tcl_TellOld 0
#   undef Tcl_SetBooleanObj
#   define Tcl_SetBooleanObj 0
#   undef Tcl_PkgPresent
#   define Tcl_PkgPresent 0
#   undef Tcl_PkgProvide
362
363
364
365
366
367
368




















369
370
371
372
373
374
375
376

377
378
379
380














381
382
383
384
385
386
387
388
389
390
391
392
393

394
395
396
397
398
399
400
401

402
403
404
405
406
407
408
409
410
411
412
413
414









415
416
417
418
419
420
421
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426




427

428
429
430
431
432
433

434


435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








+




+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
-
-
-
+
-






-
+
-
-











+
+
+
+
+
+
+
+
+







#   undef Tcl_EvalObj
#   define Tcl_EvalObj 0
#   undef Tcl_GlobalEvalObj
#   define Tcl_GlobalEvalObj 0
#   define TclBackgroundException 0
#   undef TclpReaddir
#   define TclpReaddir 0
#   define TclSetStartupScript 0
#   define TclGetStartupScript 0
#   define TclCreateNamespace 0
#   define TclDeleteNamespace 0
#   define TclAppendExportList 0
#   define TclExport 0
#   define TclImport 0
#   define TclForgetImport 0
#   define TclGetCurrentNamespace_ 0
#   define TclGetGlobalNamespace_ 0
#   define TclFindNamespace 0
#   define TclFindCommand 0
#   define TclGetCommandFromObj 0
#   define TclGetCommandFullName 0
#   define TclCopyChannelOld 0
#   define Tcl_AppendResultVA 0
#   define Tcl_AppendStringsToObjVA 0
#   define Tcl_SetErrorCodeVA 0
#   define Tcl_PanicVA 0
#   define Tcl_VarEvalVA 0
#   undef TclpGetDate
#   define TclpGetDate 0
#   undef TclpLocaltime
#   define TclpLocaltime 0
#   undef TclpGmtime
#   define TclpGmtime 0
#   define TclpLocaltime_unix 0
#   define TclpGmtime_unix 0
#   define Tcl_GetUnicode 0
#else /* TCL_NO_DEPRECATED */
#   define Tcl_SeekOld seekOld
#   define Tcl_TellOld tellOld
#   define TclBackgroundException Tcl_BackgroundException
#   define TclSetStartupScript Tcl_SetStartupScript
#   define TclGetStartupScript Tcl_GetStartupScript
#   define TclCreateNamespace Tcl_CreateNamespace
#   define TclDeleteNamespace Tcl_DeleteNamespace
#   define TclAppendExportList Tcl_AppendExportList
#   define TclExport Tcl_Export
#   define TclImport Tcl_Import
#   define TclForgetImport Tcl_ForgetImport
#   define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace
#   define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace
#   define TclFindNamespace Tcl_FindNamespace
#   define TclFindCommand Tcl_FindCommand
#   define TclGetCommandFromObj Tcl_GetCommandFromObj
#   define TclGetCommandFullName Tcl_GetCommandFullName
#   define TclpLocaltime_unix TclpLocaltime
#   define TclpGmtime_unix TclpGmtime

static int
seekOld(
    Tcl_Channel chan,		/* The channel on which to seek. */
    int offset,			/* Offset to seek to. */
    int mode)			/* Relative to which location to seek? */
{
    Tcl_WideInt wOffset, wResult;

    wOffset = Tcl_LongAsWide((long) offset);
    wResult = Tcl_Seek(chan, wOffset, mode);
    return Tcl_Seek(chan, offset, mode);
    return (int) Tcl_WideAsLong(wResult);
}

static int
tellOld(
    Tcl_Channel chan)		/* The channel to return pos for. */
{
    Tcl_WideInt wResult = Tcl_Tell(chan);
    return Tcl_Tell(chan);

    return (int) Tcl_WideAsLong(wResult);
}
#endif /* !TCL_NO_DEPRECATED */

/*
 * WARNING: The contents of this file is automatically generated by the
 * tools/genStubs.tcl script. Any modifications to the function declarations
 * below should be made in the generic/tcl.decls script.
 */

MODULE_SCOPE const TclStubs tclStubs;
MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;

#ifdef __GNUC__
/*
 * The rest of this file shouldn't warn about deprecated functions; they're
 * there because we intend them to be so and know that this file is OK to
 * touch those fields.
 */
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
#endif

/* !BEGIN!: Do not edit below this line. */

static const TclIntStubs tclIntStubs = {
    TCL_STUB_MAGIC,
    0,
    0, /* 0 */
526
527
528
529
530
531
532
533
534
535
536
537
538






539
540
541
542
543
544
545
546





547
548

549
550
551
552
553
554
555
566
567
568
569
570
571
572






573
574
575
576
577
578
579
580
581





582
583
584
585
586
587

588
589
590
591
592
593
594
595







-
-
-
-
-
-
+
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+

-
+







    0, /* 105 */
    0, /* 106 */
    0, /* 107 */
    TclTeardownNamespace, /* 108 */
    TclUpdateReturnInfo, /* 109 */
    TclSockMinimumBuffers, /* 110 */
    Tcl_AddInterpResolvers, /* 111 */
    Tcl_AppendExportList, /* 112 */
    Tcl_CreateNamespace, /* 113 */
    Tcl_DeleteNamespace, /* 114 */
    Tcl_Export, /* 115 */
    Tcl_FindCommand, /* 116 */
    Tcl_FindNamespace, /* 117 */
    TclAppendExportList, /* 112 */
    TclCreateNamespace, /* 113 */
    TclDeleteNamespace, /* 114 */
    TclExport, /* 115 */
    TclFindCommand, /* 116 */
    TclFindNamespace, /* 117 */
    Tcl_GetInterpResolvers, /* 118 */
    Tcl_GetNamespaceResolvers, /* 119 */
    Tcl_FindNamespaceVar, /* 120 */
    Tcl_ForgetImport, /* 121 */
    Tcl_GetCommandFromObj, /* 122 */
    Tcl_GetCommandFullName, /* 123 */
    Tcl_GetCurrentNamespace, /* 124 */
    Tcl_GetGlobalNamespace, /* 125 */
    TclForgetImport, /* 121 */
    TclGetCommandFromObj, /* 122 */
    TclGetCommandFullName, /* 123 */
    TclGetCurrentNamespace_, /* 124 */
    TclGetGlobalNamespace_, /* 125 */
    Tcl_GetVariableFullName, /* 126 */
    Tcl_Import, /* 127 */
    TclImport, /* 127 */
    Tcl_PopCallFrame, /* 128 */
    Tcl_PushCallFrame, /* 129 */
    Tcl_RemoveInterpResolvers, /* 130 */
    Tcl_SetNamespaceResolvers, /* 131 */
    TclpHasSockets, /* 132 */
    TclpGetDate, /* 133 */
    0, /* 134 */
592
593
594
595
596
597
598
599
600


601
602
603
604
605
606
607
632
633
634
635
636
637
638


639
640
641
642
643
644
645
646
647







-
-
+
+







    TclCheckExecutionTraces, /* 171 */
    TclInThreadExit, /* 172 */
    TclUniCharMatch, /* 173 */
    0, /* 174 */
    TclCallVarTraces, /* 175 */
    TclCleanupVar, /* 176 */
    TclVarErrMsg, /* 177 */
    Tcl_SetStartupScript, /* 178 */
    Tcl_GetStartupScript, /* 179 */
    TclSetStartupScript, /* 178 */
    TclGetStartupScript, /* 179 */
    0, /* 180 */
    0, /* 181 */
    TclpLocaltime, /* 182 */
    TclpGmtime, /* 183 */
    0, /* 184 */
    0, /* 185 */
    0, /* 186 */
865
866
867
868
869
870
871

872
873
874
875
876
877
878
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919







+







    TclBNInitBignumFromWideInt, /* 65 */
    TclBNInitBignumFromWideUInt, /* 66 */
    TclBN_mp_expt_d_ex, /* 67 */
    TclBN_mp_set_long_long, /* 68 */
    TclBN_mp_get_long_long, /* 69 */
    TclBN_mp_set_long, /* 70 */
    TclBN_mp_get_long, /* 71 */
    TclBN_mp_get_int, /* 72 */
};

static const TclStubHooks tclStubHooks = {
    &tclPlatStubs,
    &tclIntStubs,
    &tclIntPlatStubs
};
1532
1533
1534
1535
1536
1537
1538




1539
1540
1541
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586







+
+
+
+



    Tcl_NRExprObj, /* 625 */
    Tcl_NRSubstObj, /* 626 */
    Tcl_LoadFile, /* 627 */
    Tcl_FindSymbol, /* 628 */
    Tcl_FSUnloadFile, /* 629 */
    Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
    Tcl_OpenTcpServerEx, /* 631 */
    TclZipfs_Mount, /* 632 */
    TclZipfs_Unmount, /* 633 */
    TclZipfs_TclLibrary, /* 634 */
    TclZipfs_MountBuffer, /* 635 */
};

/* !END!: Do not edit above this line. */

Changes to generic/tclStubLib.c.

62
63
64
65
66
67
68
69
70


71
72
73
74
75
76
77
62
63
64
65
66
67
68


69
70
71
72
73
74
75
76
77







-
-
+
+







    /*
     * We can't optimize this check by caching tclStubsPtr because that
     * prevents apps from being able to load/unload Tcl dynamically multiple
     * times. [Bug 615304]
     */

    if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) {
	iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
	iPtr->legacyFreeProc = 0; /* TCL_STATIC */
	iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism";
	iPtr->freeProc = 0;
	return NULL;
    }

    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
    if (actualVersion == NULL) {
	return NULL;
    }

Changes to generic/tclTest.c.

157
158
159
160
161
162
163
164

165
166
167
168
169
170
171
157
158
159
160
161
162
163

164
165
166
167
168
169
170
171







-
+








/*
 * Forward declarations for procedures defined later in this file:
 */

static int		AsyncHandlerProc(ClientData clientData,
			    Tcl_Interp *interp, int code);
#ifdef TCL_THREADS
#if TCL_THREADS
static Tcl_ThreadCreateType AsyncThreadProc(ClientData);
#endif
static void		CleanupTestSetassocdataTests(
			    ClientData clientData, Tcl_Interp *interp);
static void		CmdDelProc1(ClientData clientData);
static void		CmdDelProc2(ClientData clientData);
static int		CmdProc1(ClientData clientData,
288
289
290
291
292
293
294


295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309








310
311
312
313
314
315
316







+
+













-
-
-
-
-
-
-
-







static int		TestfilelinkCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int		TestfeventCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetassocdataCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetintCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestlongsizeCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetplatformCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestgetvarfullnameCmd(
			    ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestinterpdeleteCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestlinkCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestlocaleCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#ifndef TCL_NO_DEPRECATED
static int		TestMathFunc(ClientData clientData,
			    Tcl_Interp *interp, Tcl_Value *args,
			    Tcl_Value *resultPtr);
static int		TestMathFunc2(ClientData clientData,
			    Tcl_Interp *interp, Tcl_Value *args,
			    Tcl_Value *resultPtr);
#endif /* TCL_NO_DEPRECATED */
static int		TestmainthreadCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestsetmainloopCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestexitmainloopCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestpanicCmd(ClientData dummy,
419
420
421
422
423
424
425






426
427
428
429
430
431
432
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432







+
+
+
+
+
+







static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel;
static Tcl_FSListVolumesProc SimpleListVolumes;
static Tcl_FSPathInFilesystemProc SimplePathInFilesystem;
static Tcl_Obj *	SimpleRedirect(Tcl_Obj *pathPtr);
static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
static int		TestNumUtfCharsCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestFindFirstCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestFindLastCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestHashSystemHashCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

static Tcl_NRPostProc	NREUnwind_callback;
static int		TestNREUnwind(ClientData clientData,
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
545
546
547
548
549
550
551




552
553
554
555
556
557
558







-
-
-
-







 *----------------------------------------------------------------------
 */

int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
#ifndef TCL_NO_DEPRECATED
    Tcl_ValueType t3ArgTypes[2];
#endif /* TCL_NO_DEPRECATED */

    Tcl_Obj *listPtr;
    Tcl_Obj **objv;
    int objc, index;
    static const char *const specialOptions[] = {
	"-appinitprocerror", "-appinitprocdeleteinterp",
	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };
646
647
648
649
650
651
652


653
654
655
656
657
658
659
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657







+
+







    Tcl_CreateObjCommand(interp, "testfile", TestfileCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testhashsystemhash",
	    TestHashSystemHashCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testlongsize", TestlongsizeCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetvarfullname",
	    TestgetvarfullnameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
	    NULL, NULL);
688
689
690
691
692
693
694




695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738

739
740
741
742
743
744
745
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705




706
707
708
709
710
711
712
713
714
715







716
717
718
719
720
721
722
723
724
725
726
727
728

729
730
731
732
733
734
735
736







+
+
+
+









-
-
-
-










-
-
-
-
-
-
-













-
+







	    (ClientData) TCL_LEAVE_ERR_MSG, NULL);
    Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsetobjerrorcode",
	    TestsetobjerrorcodeCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testnumutfchars",
	    TestNumUtfCharsCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfindfirst",
	    TestFindFirstCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfindlast",
	    TestFindLastCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testtranslatefilename",
	    TesttranslatefilenameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
#ifndef TCL_NO_DEPRECATED
    Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123);
    Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345);
#endif /* TCL_NO_DEPRECATED */
    Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
	    NULL);
    Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
	    NULL, NULL);
#if defined(HAVE_CPUID) || defined(_WIN32)
    Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
	    (ClientData) 0, NULL);
#endif
#ifndef TCL_NO_DEPRECATED
    t3ArgTypes[0] = TCL_EITHER;
    t3ArgTypes[1] = TCL_EITHER;
    Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
	    NULL);
#endif /* TCL_NO_DEPRECATED */

    Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
	    NULL, NULL);

    if (TclObjTest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#ifdef TCL_THREADS
#if TCL_THREADS
    if (TclThread_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#endif

    /*
     * Check for special options used in ../tests/main.test
911
912
913
914
915
916
917
918

919
920
921
922
923
924
925
902
903
904
905
906
907
908

909
910
911
912
913
914
915
916







-
+







		Tcl_AsyncMark(asyncPtr->handler);
		break;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
	Tcl_MutexUnlock(&asyncTestMutex);
	return code;
#ifdef TCL_THREADS
#if TCL_THREADS
    } else if (strcmp(argv[1], "marklater") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
	    return TCL_ERROR;
	}
1008
1009
1010
1011
1012
1013
1014
1015

1016
1017
1018
1019
1020
1021
1022
999
1000
1001
1002
1003
1004
1005

1006
1007
1008
1009
1010
1011
1012
1013







-
+







 *
 * Side effects:
 *	Invokes Tcl_AsyncMark on the handler
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_THREADS
#if TCL_THREADS
static Tcl_ThreadCreateType
AsyncThreadProc(
    ClientData clientData)	/* Parameter is the id of a
				 * TestAsyncHandler, defined above. */
{
    TestAsyncHandler *asyncPtr;
    int id = PTR2INT(clientData);
2399
2400
2401
2402
2403
2404
2405
2406

2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420

2421
2422
2423
2424
2425
2426
2427
2390
2391
2392
2393
2394
2395
2396

2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410

2411
2412
2413
2414
2415
2416
2417
2418







-
+













-
+







static void
ExitProcOdd(
    ClientData clientData)	/* Integer value to print. */
{
    char buf[16 + TCL_INTEGER_SPACE];
    size_t len;

    sprintf(buf, "odd %d\n", PTR2INT(clientData));
    sprintf(buf, "odd %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData));
    len = strlen(buf);
    if (len != (size_t) write(1, buf, len)) {
	Tcl_Panic("ExitProcOdd: unable to write to stdout");
    }
}

static void
ExitProcEven(
    ClientData clientData)	/* Integer value to print. */
{
    char buf[16 + TCL_INTEGER_SPACE];
    size_t len;

    sprintf(buf, "even %d\n", PTR2INT(clientData));
    sprintf(buf, "even %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData));
    len = strlen(buf);
    if (len != (size_t) write(1, buf, len)) {
	Tcl_Panic("ExitProcEven: unable to write to stdout");
    }
}

/*
2837
2838
2839
2840
2841
2842
2843
2844

2845
2846
2847
2848
2849
2850
2851
2852
2853
2854

2855
2856
2857
2858
2859
2860
2861
2828
2829
2830
2831
2832
2833
2834

2835
2836
2837
2838
2839
2840
2841
2842
2843
2844

2845
2846
2847
2848
2849
2850
2851
2852







-
+









-
+







    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    static int intVar = 43;
    static int boolVar = 4;
    static double realVar = 1.23;
    static Tcl_WideInt wideVar = Tcl_LongAsWide(79);
    static Tcl_WideInt wideVar = 79;
    static char *stringVar = NULL;
    static char charVar = '@';
    static unsigned char ucharVar = 130;
    static short shortVar = 3000;
    static unsigned short ushortVar = 60000;
    static unsigned int uintVar = 0xbeeffeed;
    static long longVar = 123456789L;
    static unsigned long ulongVar = 3456789012UL;
    static float floatVar = 4.5;
    static Tcl_WideUInt uwideVar = (Tcl_WideUInt) Tcl_LongAsWide(123);
    static Tcl_WideUInt uwideVar = 123;
    static int created = 0;
    char buffer[2*TCL_DOUBLE_SPACE];
    int writable, flag;
    Tcl_Obj *tmp;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3331
3332
3333
3334
3335
3336
3337












































































































































3338
3339
3340
3341
3342
3343
3344







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    locale = setlocale(lcTypes[index], locale);
    if (locale) {
	Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestMathFunc --
 *
 *	This is a user-defined math procedure to test out math procedures
 *	with no arguments.
 *
 * Results:
 *	A normal Tcl completion code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
#ifndef TCL_NO_DEPRECATED
static int
TestMathFunc(
    ClientData clientData,	/* Integer value to return. */
    Tcl_Interp *interp,		/* Not used. */
    Tcl_Value *args,		/* Not used. */
    Tcl_Value *resultPtr)	/* Where to store result. */
{
    resultPtr->type = TCL_INT;
    resultPtr->intValue = PTR2INT(clientData);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestMathFunc2 --
 *
 *	This is a user-defined math procedure to test out math procedures
 *	that do have arguments, in this case 2.
 *
 * Results:
 *	A normal Tcl completion code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestMathFunc2(
    ClientData clientData,	/* Integer value to return. */
    Tcl_Interp *interp,		/* Used to report errors. */
    Tcl_Value *args,		/* Points to an array of two Tcl_Value structs
				 * for the two arguments. */
    Tcl_Value *resultPtr)	/* Where to store the result. */
{
    int result = TCL_OK;

    /*
     * Return the maximum of the two arguments with the correct type.
     */

    if (args[0].type == TCL_INT) {
	int i0 = args[0].intValue;

	if (args[1].type == TCL_INT) {
	    int i1 = args[1].intValue;

	    resultPtr->type = TCL_INT;
	    resultPtr->intValue = ((i0 > i1)? i0 : i1);
	} else if (args[1].type == TCL_DOUBLE) {
	    double d0 = i0;
	    double d1 = args[1].doubleValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_WIDE_INT) {
	    Tcl_WideInt w0 = Tcl_LongAsWide(i0);
	    Tcl_WideInt w1 = args[1].wideValue;

	    resultPtr->type = TCL_WIDE_INT;
	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
	} else {
	    Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL);
	    result = TCL_ERROR;
	}
    } else if (args[0].type == TCL_DOUBLE) {
	double d0 = args[0].doubleValue;

	if (args[1].type == TCL_INT) {
	    double d1 = args[1].intValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_DOUBLE) {
	    double d1 = args[1].doubleValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_WIDE_INT) {
	    double d1 = Tcl_WideAsDouble(args[1].wideValue);

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else {
	    Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL);
	    result = TCL_ERROR;
	}
    } else if (args[0].type == TCL_WIDE_INT) {
	Tcl_WideInt w0 = args[0].wideValue;

	if (args[1].type == TCL_INT) {
	    Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue);

	    resultPtr->type = TCL_WIDE_INT;
	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
	} else if (args[1].type == TCL_DOUBLE) {
	    double d0 = Tcl_WideAsDouble(w0);
	    double d1 = args[1].doubleValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_WIDE_INT) {
	    Tcl_WideInt w1 = args[1].wideValue;

	    resultPtr->type = TCL_WIDE_INT;
	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
	} else {
	    Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL);
	    result = TCL_ERROR;
	}
    } else {
	Tcl_AppendResult(interp, "T3: wrong type for arg 1", NULL);
	result = TCL_ERROR;
    }
    return result;
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * CleanupTestSetassocdataTests --
 *
 *	This function is called when an interpreter is deleted to clean
 *	up any data left over from running the testsetassocdata command.
5224
5225
5226
5227
5228
5229
5230

5231
5232
5233
5234
5235
5236
5237
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089







+







static int
TestsaveresultCmd(
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Interp* iPtr = (Interp*) interp;
    int discard, result, index;
    Tcl_SavedResult state;
    Tcl_Obj *objPtr;
    static const char *const optionStrings[] = {
	"append", "dynamic", "free", "object", "small", NULL
    };
    enum options {
5291
5292
5293
5294
5295
5296
5297
5298
5299




5300

5301
5302
5303
5304
5305
5306
5307
5143
5144
5145
5146
5147
5148
5149


5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162







-
-
+
+
+
+

+







	Tcl_DiscardResult(&state);
    } else {
	Tcl_RestoreResult(interp, &state);
	result = TCL_OK;
    }

    switch ((enum options) index) {
    case RESULT_DYNAMIC:
	Tcl_AppendElement(interp, freeCount ? "freed" : "leak");
    case RESULT_DYNAMIC: {
	int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount;

	Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak");
	break;
    }
    case RESULT_OBJECT:
	Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
		? "same" : "different");
	break;
    default:
	break;
    }
5352
5353
5354
5355
5356
5357
5358
5359

5360
5361
5362
5363
5364
5365
5366
5207
5208
5209
5210
5211
5212
5213

5214
5215
5216
5217
5218
5219
5220
5221







-
+







TestmainthreadCmd(
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    if (argc == 1) {
	Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
	Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());

	Tcl_SetObjResult(interp, idObj);
	return TCL_OK;
    } else {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
5749
5750
5751
5752
5753
5754
5755

5756

5757
5758
5759
5760
5761
5762
5763
5764
5604
5605
5606
5607
5608
5609
5610
5611

5612

5613
5614
5615
5616
5617
5618
5619







+
-
+
-








    if ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "channel name required", NULL);
	    return TCL_ERROR;
	}

	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
	TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan));
		(Tcl_WideInt) (size_t) Tcl_GetChannelThread(chan)));
	Tcl_AppendResult(interp, buf, NULL);
	return TCL_OK;
    }

    if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "channel name required", NULL);
	    return TCL_ERROR;
6876
6877
6878
6879
6880
6881
6882












































6883
6884
6885
6886
6887
6888
6889
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
6788







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len);
	Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindFirst
 */

static int
TestFindFirstCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindLast
 */

static int
TestFindLastCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
    }
    return TCL_OK;
}

#if defined(HAVE_CPUID) || defined(_WIN32)
/*
 *----------------------------------------------------------------------
 *
 * TestcpuidCmd --
 *
7036
7037
7038
7039
7040
7041
7042


















7043
7044
7045
7046
7047
7048
7049
6935
6936
6937
6938
6939
6940
6941
6942
6943
6944
6945
6946
6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
6964
6965
6966







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    }
	    total += val;
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
	return TCL_OK;
    }
}

/*
 * Used for determining sizeof(long) at script level.
 */
static int
TestlongsizeCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int argc,
    const char **argv)
{
    if (argc != 1) {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long)));
    return TCL_OK;
}

static int
NREUnwind_callback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{

Changes to generic/tclTestObj.c.

1084
1085
1086
1087
1088
1089
1090



1091
1092
1093
1094
1095
1096
1097
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100







+
+
+







	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (objv[2]->typePtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
	} else {
	    typeName = objv[2]->typePtr->name;
#ifndef TCL_WIDE_INT_IS_LONG
	    if (!strcmp(typeName, "wideInt")) typeName = "int";
#endif
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
	}
    } else if (strcmp(subCmd, "refcount") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
1111
1112
1113
1114
1115
1116
1117





1118
1119
1120
1121
1122
1123
1124
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132







+
+
+
+
+







	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}
	if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
#ifndef TCL_WIDE_INT_IS_LONG
	} else if (!strcmp(varPtr[varIndex]->typePtr->name, "wideInt")) {
	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
		    "int", -1);
#endif
	} else {
	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
		    varPtr[varIndex]->typePtr->name, -1);
	}
    } else if (strcmp(subCmd, "types") == 0) {
	if (objc != 2) {
	    goto wrongNumArgs;

Changes to generic/tclThread.c.

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
36
37
38
39
40
41
42















43
44
45
46
47
48
49







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * Prototypes of functions used only in this file.
 */

static void		ForgetSyncObject(void *objPtr, SyncObjRecord *recPtr);
static void		RememberSyncObject(void *objPtr,
			    SyncObjRecord *recPtr);

/*
 * Several functions are #defined to nothing in tcl.h if TCL_THREADS is not
 * specified. Here we undo that so the functions are defined in the stubs
 * table.
 */

#ifndef TCL_THREADS
#undef Tcl_MutexLock
#undef Tcl_MutexUnlock
#undef Tcl_MutexFinalize
#undef Tcl_ConditionNotify
#undef Tcl_ConditionWait
#undef Tcl_ConditionFinalize
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetThreadData --
 *
 *	This function allocates and initializes a chunk of thread local
 *	storage.
75
76
77
78
79
80
81
82

83
84
85
86
87
88
89
60
61
62
63
64
65
66

67
68
69
70
71
72
73
74







-
+








void *
Tcl_GetThreadData(
    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk */
    int size)			/* Size of storage block */
{
    void *result;
#ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * Initialize the key for this thread.
     */

    result = TclThreadStorageKeyGet(keyPtr);

    if (result == NULL) {
122
123
124
125
126
127
128
129

130
131
132
133
134
135
136
107
108
109
110
111
112
113

114
115
116
117
118
119
120
121







-
+







 */

void *
TclThreadDataKeyGet(
    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk. */

{
#ifdef TCL_THREADS
#if TCL_THREADS
    return TclThreadStorageKeyGet(keyPtr);
#else /* TCL_THREADS */
    return *keyPtr;
#endif /* TCL_THREADS */
}

/*
265
266
267
268
269
270
271

272
273
274
275
276

277
278
279
280
281
282
283
250
251
252
253
254
255
256
257
258
259
260
261

262
263
264
265
266
267
268
269







+




-
+







 *
 * Side effects:
 *	Remove the mutex from the list.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_MutexFinalize
void
Tcl_MutexFinalize(
    Tcl_Mutex *mutexPtr)
{
#ifdef TCL_THREADS
#if TCL_THREADS
    TclpFinalizeMutex(mutexPtr);
#endif
    TclpMasterLock();
    ForgetSyncObject(mutexPtr, &mutexRecord);
    TclpMasterUnlock();
}

318
319
320
321
322
323
324

325
326
327
328
329

330
331
332
333
334
335
336
304
305
306
307
308
309
310
311
312
313
314
315

316
317
318
319
320
321
322
323







+




-
+







 *
 * Side effects:
 *	Remove the condition variable from the list.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_ConditionFinalize
void
Tcl_ConditionFinalize(
    Tcl_Condition *condPtr)
{
#ifdef TCL_THREADS
#if TCL_THREADS
    TclpFinalizeCondition(condPtr);
#endif
    TclpMasterLock();
    ForgetSyncObject(condPtr, &condRecord);
    TclpMasterUnlock();
}

352
353
354
355
356
357
358
359

360
361
362
363
364
365
366
339
340
341
342
343
344
345

346
347
348
349
350
351
352
353







-
+







 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadData(int quick)
{
    TclFinalizeThreadDataThread();
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    if (!quick) {
	/*
	 * Quick exit principle makes it useless to terminate allocators
	 */
	TclFinalizeThreadAllocThread();
    }
#endif
385
386
387
388
389
390
391
392

393
394
395
396
397
398
399
372
373
374
375
376
377
378

379
380
381
382
383
384
385
386







-
+








void
TclFinalizeSynchronization(void)
{
    int i;
    void *blockPtr;
    Tcl_ThreadDataKey *keyPtr;
#ifdef TCL_THREADS
#if TCL_THREADS
    Tcl_Mutex *mutexPtr;
    Tcl_Condition *condPtr;

    TclpMasterLock();
#endif

    /*
409
410
411
412
413
414
415
416

417
418
419
420
421
422
423
396
397
398
399
400
401
402

403
404
405
406
407
408
409
410







-
+







	}
	ckfree(keyRecord.list);
	keyRecord.list = NULL;
    }
    keyRecord.max = 0;
    keyRecord.num = 0;

#ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * Call thread storage master cleanup.
     */

    TclFinalizeThreadStorage();

    for (i=0 ; i<mutexRecord.num ; i++) {
469
470
471
472
473
474
475
476
477
478
479
480
481

482
483
484
485
486
487
488
456
457
458
459
460
461
462

463

464
465

466
467
468
469
470
471
472
473







-

-


-
+







 */

void
Tcl_ExitThread(
    int status)
{
    Tcl_FinalizeThread();
#ifdef TCL_THREADS
    TclpThreadExit(status);
#endif
}

#ifndef TCL_THREADS
#if !TCL_THREADS

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionWait, et al. --
 *
 *	These noop functions are provided so the stub table does not have to

Changes to generic/tclThreadAlloc.c.

9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23







-
+







 * Portions created by AOL are Copyright (C) 1999 America Online, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
#if TCL_THREADS && defined(USE_THREAD_ALLOC)

/*
 * If range checking is enabled, an additional byte will be allocated to store
 * the magic number at the end of the requested memory.
 */

#ifndef RCHECK

Changes to generic/tclThreadStorage.c.

9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23







-
+







 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifdef TCL_THREADS
#if TCL_THREADS
#include <signal.h>

/*
 * IMPLEMENTATION NOTES:
 *
 * The primary idea is that we create one platform-specific TSD slot, and use
 * it for storing a table pointer. Each Tcl_ThreadDataKey has an offset into

Changes to generic/tclThreadTest.c.

14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28







-
+







 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

#ifdef TCL_THREADS
#if TCL_THREADS
/*
 * Each thread has an single instance of the following structure. There is one
 * instance of this structure per thread even if that thread contains multiple
 * interpreters. The interpreter identified by this structure is the main
 * interpreter for the thread.
 *
 * The main interpreter is the one that will process any messages received by
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
170
171
172
173
174
175
176

177
178
179
180
181
182
183







-







	mainThreadId = Tcl_GetCurrentThread();
    }
    Tcl_MutexUnlock(&threadMutex);

    Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * ThreadObjCmd --
 *
 *	This procedure is invoked to process the "testthread" Tcl command. See
244
245
246
247
248
249
250
251

252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267

268
269
270
271
272
273
274
243
244
245
246
247
248
249

250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265

266
267
268
269
270
271
272
273







-
+















-
+







	ListUpdateInner(tsdPtr);
	Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
	Tcl_MutexUnlock(&threadMutex);
    }

    switch ((enum options)option) {
    case THREAD_CANCEL: {
	long id;
	Tcl_WideInt id;
	const char *result;
	int flags, arg;

	if ((objc < 3) || (objc > 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? id ?result?");
	    return TCL_ERROR;
	}
	flags = 0;
	arg = 2;
	if ((objc == 4) || (objc == 5)) {
	    if (strcmp("-unwind", Tcl_GetString(objv[arg])) == 0) {
		flags = TCL_CANCEL_UNWIND;
		arg++;
	    }
	}
	if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
	if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
	    return TCL_ERROR;
	}
	arg++;
	if (arg < objc) {
	    result = Tcl_GetString(objv[arg]);
	} else {
	    result = NULL;
1153
1154
1155
1156
1157
1158
1159








1160
1161
1162
1163
1164
1165
1166
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173







+
+
+
+
+
+
+
+







    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->interp != NULL) {
	ListRemove(tsdPtr);
    }

    Tcl_MutexLock(&threadMutex);

    if (self == errorThreadId) {
	if (errorProcString) {	/* Extra safety */
	    ckfree(errorProcString);
	    errorProcString = NULL;
	}
	errorThreadId = 0;
    }

    if (threadEvalScript) {
	ckfree(threadEvalScript);
	threadEvalScript = NULL;
    }
    Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);

Changes to generic/tclTimer.c.

815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
815
816
817
818
819
820
821



822
823
824
825
826
827
828







-
-
-







    }

    /*
     * First lets see if the command was passed a number as the first argument.
     */

    if (objv[1]->typePtr == &tclIntType
#ifndef TCL_WIDE_INT_IS_LONG
	    || objv[1]->typePtr == &tclWideIntType
#endif
	    || objv[1]->typePtr == &tclBignumType
	    || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
		    &index) != TCL_OK)) {
	index = -1;
	if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
            const char *arg = Tcl_GetString(objv[1]);

1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058



1059
1060
1061
1062
1063




1064
1065
1066


1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078

1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092

1093
1094
1095
1096
1097
1098
1099
1038
1039
1040
1041
1042
1043
1044





1045
1046
1047



1048
1049
1050
1051




1052
1053
1054
1055
1056


1057
1058
1059
1060





1061
1062
1063
1064

1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078

1079
1080
1081
1082
1083
1084
1085
1086







-
-
-
-
-



-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+


-
-
-
-
-




-
+













-
+







	    if (Tcl_LimitCheck(interp) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	if (iPtr->limit.timeEvent == NULL
		|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
	    diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
#ifndef TCL_WIDE_INT_IS_LONG
	    if (diff > LONG_MAX) {
		diff = LONG_MAX;
	    }
#endif
	    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((long) diff);
                if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
                    break;
                }
		Tcl_Sleep((int) diff);
		if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
		    break;
		}
	    } else {
                break;
            }
		break;
	    }
	} else {
	    diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
#ifndef TCL_WIDE_INT_IS_LONG
	    if (diff > LONG_MAX) {
		diff = LONG_MAX;
	    }
#endif
	    if (diff > TCL_TIME_MAXIMUM_SLICE) {
		diff = TCL_TIME_MAXIMUM_SLICE;
	    }
	    if (diff > 0) {
		Tcl_Sleep((long) diff);
		Tcl_Sleep((int) diff);
	    }
	    if (Tcl_AsyncReady()) {
		if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
		return TCL_ERROR;
	    }
	    if (Tcl_LimitCheck(interp) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
        Tcl_GetTime(&now);
	Tcl_GetTime(&now);
    } while (TCL_TIME_BEFORE(now, endTime));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclTomMath.decls.

246
247
248
249
250
251
252



253
254
255
256
246
247
248
249
250
251
252
253
254
255
256
257
258
259







+
+
+




}
declare 70 {
    int TclBN_mp_set_long(mp_int *a, unsigned long i)
}
declare 71 {
    unsigned long TclBN_mp_get_long(const mp_int *a)
}
declare 72 {
    unsigned long TclBN_mp_get_int(const mp_int *a)
}

# Local Variables:
# mode: tcl
# End:

Changes to generic/tclTomMath.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28





29
30

31


32





33
34
35
36
37
38
39
40
41
42
43
44
45
46

47
48
49
50

51
52
53
54
55
56
57
58
59

60
61
62
63

64
65
66
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

55
56
57
58

59
60
61
62
63
64
65
66
67

68
69
70
71

72
73
74
75
76
77
78
79
80
81

82
83
84






85









86
87
88
89
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











-
-















+
+
+
+
+

-
+

+
+
-
+
+
+
+
+













-
+



-
+








-
+



-
+









-
+


-
-
-
-
-
-

-
-
-
-
-
-
-
-
-






-
+



-
+
















-
+




-
-
-
-
-
-
-
-
-
-
-
-







/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://math.libtomcrypt.com
 */
#ifndef BN_H_
#define BN_H_

#include "tclTomMathDecls.h"
#ifndef MODULE_SCOPE
#define MODULE_SCOPE extern
#endif



#ifdef __cplusplus
extern "C" {
#endif

/* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */
#if defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)
#   define MP_32BIT
#endif

/* detect 64-bit mode if possible */
#if defined(NEVER)  /* 128-bit ints fail in too many places */
#if defined(NEVER)
#   if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
#      if defined(__GNUC__)
/* we support 128bit integers only via: __attribute__((mode(TI))) */
#      define MP_64BIT
#         define MP_64BIT
#      else
/* otherwise we fall back to MP_32BIT even on 64bit platforms */
#         define MP_32BIT
#      endif
#   endif
#endif

/* some default configurations.
 *
 * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits
 * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits
 *
 * At the very least a mp_digit must be able to hold 7 bits
 * [any size beyond that is ok provided it doesn't overflow the data type]
 */
#ifdef MP_8BIT
#ifndef MP_DIGIT_DECLARED
typedef uint8_t              mp_digit;
typedef unsigned char        mp_digit;
#define MP_DIGIT_DECLARED
#endif
#ifndef MP_WORD_DECLARED
typedef uint16_t             mp_word;
typedef unsigned short       mp_word;
#define MP_WORD_DECLARED
#endif
#   define MP_SIZEOF_MP_DIGIT 1
#   ifdef DIGIT_BIT
#      error You must not define DIGIT_BIT when using MP_8BIT
#   endif
#elif defined(MP_16BIT)
#ifndef MP_DIGIT_DECLARED
typedef uint16_t             mp_digit;
typedef unsigned short       mp_digit;
#define MP_DIGIT_DECLARED
#endif
#ifndef MP_WORD_DECLARED
typedef uint32_t             mp_word;
typedef unsigned int         mp_word;
#define MP_WORD_DECLARED
#endif
#   define MP_SIZEOF_MP_DIGIT 2
#   ifdef DIGIT_BIT
#      error You must not define DIGIT_BIT when using MP_16BIT
#   endif
#elif defined(MP_64BIT)
/* for GCC only on supported platforms */
#ifndef MP_DIGIT_DECLARED
typedef uint64_t mp_digit;
typedef unsigned long long   mp_digit;
#define MP_DIGIT_DECLARED
#endif
#   if defined(_WIN32)
#ifndef MP_WORD_DECLARED
typedef unsigned __int128    mp_word;
#define MP_WORD_DECLARED
#endif
#   elif defined(__GNUC__)
typedef unsigned long        mp_word __attribute__((mode(TI)));
#   else
/* it seems you have a problem
 * but we assume you can somewhere define your own uint128_t */
#ifndef MP_WORD_DECLARED
typedef uint128_t            mp_word;
#define MP_WORD_DECLARED
#endif
#   endif

#   define DIGIT_BIT 60
#else
/* this is the default case, 28-bit digits */

/* this is to make porting into LibTomCrypt easier :-) */
#ifndef MP_DIGIT_DECLARED
typedef uint32_t             mp_digit;
typedef unsigned int         mp_digit;
#define MP_DIGIT_DECLARED
#endif
#ifndef MP_WORD_DECLARED
typedef uint64_t             mp_word;
typedef unsigned long long   mp_word;
#define MP_WORD_DECLARED
#endif

#   ifdef MP_31BIT
/* this is an extension that uses 31-bit digits */
#      define DIGIT_BIT 31
#   else
/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
#      define DIGIT_BIT 28
#      define MP_28BIT
#   endif
#endif

/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
#ifndef DIGIT_BIT
#   define DIGIT_BIT (((CHAR_BIT * MP_SIZEOF_MP_DIGIT) - 1))  /* bits per digit */
typedef uint_least32_t mp_min_u32;
typedef unsigned long mp_min_u32;
#else
typedef mp_digit mp_min_u32;
#endif

/* use arc4random on platforms that support it */
#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__)
#   define MP_GEN_RANDOM()    arc4random()
#   define MP_GEN_RANDOM_MAX  0xffffffff
#endif

/* use rand() as fall-back if there's no better rand function */
#ifndef MP_GEN_RANDOM
#   define MP_GEN_RANDOM()    rand()
#   define MP_GEN_RANDOM_MAX  RAND_MAX
#endif

#define MP_DIGIT_BIT     DIGIT_BIT
#define MP_MASK          ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
#define MP_DIGIT_MAX     MP_MASK

/* equalities */
#define MP_LT        -1   /* less than */
#define MP_EQ         0   /* equal to */
177
178
179
180
181
182
183
184

185
186
187
188
189
190
191
159
160
161
162
163
164
165

166
167
168
169
170
171
172
173







-
+







#      define MP_PREC 32        /* default digits of precision */
#   else
#      define MP_PREC 8         /* default digits of precision */
#   endif
#endif

/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
#define MP_WARRAY               (1 << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1))
#define MP_WARRAY               (1u << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1))

/* the infamous mp_int structure */
#ifndef MP_INT_DECLARED
#define MP_INT_DECLARED
typedef struct mp_int mp_int;
#endif
struct mp_int {
375
376
377
378
379
380
381








382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398




















399





400
401
402
403
404
405
406
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421







+
+
+
+
+
+
+
+

















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+








/* I Love Earth! */

/* makes a pseudo-random int of a given size */
/*
int mp_rand(mp_int *a, int digits);
*/

#ifdef MP_PRNG_ENABLE_LTM_RNG
/* as last resort we will fall back to libtomcrypt's rng_get_bytes()
 * in case you don't use libtomcrypt or use it w/o rng_get_bytes()
 * you have to implement it somewhere else, as it's required */
extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
extern void (*ltm_rng_callback)(void);
#endif

/* ---> binary operations <--- */
/* c = a XOR b  */
/*
int mp_xor(const mp_int *a, const mp_int *b, mp_int *c);
*/

/* c = a OR b */
/*
int mp_or(const mp_int *a, const mp_int *b, mp_int *c);
*/

/* c = a AND b */
/*
int mp_and(const mp_int *a, const mp_int *b, mp_int *c);
*/

/* c = a XOR b (two complement) */
/*
int mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c);
*/

/* c = a OR b (two complement) */
/*
int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c);
*/

/* c = a AND b (two complement) */
/*
int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c);
*/

/* right shift (two complement) */
/*
int mp_tc_div_2d(const mp_int *a, int b, mp_int *c);
*/

/* ---> Basic arithmetic <--- */

/* b = ~a */
/*
int mp_complement(const mp_int *a, mp_int *b);
*/

/* b = -a */
/*
int mp_neg(const mp_int *a, mp_int *b);
*/

/* b = |a| */
549
550
551
552
553
554
555
556

557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577


578
579
580

581
582
583
584
585

586
587
588
589
590
591
592
593
594
595
596
597

598
599
600
601
602
603
604
605
606
607
608
609
610

611
612

613
614
615
616
617
618
619
564
565
566
567
568
569
570

571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590


591
592
593
594

595
596
597
598
599

600
601
602
603
604
605
606
607
608
609
610
611

612
613
614
615
616
617
618
619
620
621
622
623
624

625
626

627
628
629
630
631
632
633
634







-
+



















-
-
+
+


-
+




-
+











-
+












-
+

-
+







/* special sqrt algo */
/*
int mp_sqrt(const mp_int *arg, mp_int *ret);
*/

/* special sqrt (mod prime) */
/*
int mp_sqrtmod_prime(const mp_int *arg, const mp_int *prime, mp_int *ret);
int mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret);
*/

/* is number a square? */
/*
int mp_is_square(const mp_int *arg, int *ret);
*/

/* computes the jacobi c = (a | n) (or Legendre if b is prime)  */
/*
int mp_jacobi(const mp_int *a, const mp_int *n, int *c);
*/

/* used to setup the Barrett reduction for a given modulus b */
/*
int mp_reduce_setup(mp_int *a, const mp_int *b);
*/

/* Barrett Reduction, computes a (mod b) with a precomputed value c
 *
 * Assumes that 0 < a <= b*b, note if 0 > a > -(b*b) then you can merely
 * compute the reduction as -1 * mp_reduce(mp_abs(a)) [pseudo code].
 * Assumes that 0 < x <= m*m, note if 0 > x > -(m*m) then you can merely
 * compute the reduction as -1 * mp_reduce(mp_abs(x)) [pseudo code].
 */
/*
int mp_reduce(mp_int *a, const mp_int *b, const mp_int *c);
int mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu);
*/

/* setups the montgomery reduction */
/*
int mp_montgomery_setup(const mp_int *a, mp_digit *mp);
int mp_montgomery_setup(const mp_int *n, mp_digit *rho);
*/

/* computes a = B**n mod b without division or multiplication useful for
 * normalizing numbers in a Montgomery system.
 */
/*
int mp_montgomery_calc_normalization(mp_int *a, const mp_int *b);
*/

/* computes x/R == x (mod N) via Montgomery Reduction */
/*
int mp_montgomery_reduce(mp_int *a, const mp_int *m, mp_digit mp);
int mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho);
*/

/* returns 1 if a is a valid DR modulus */
/*
int mp_dr_is_modulus(const mp_int *a);
*/

/* sets the value of "d" required for mp_dr_reduce */
/*
void mp_dr_setup(const mp_int *a, mp_digit *d);
*/

/* reduces a modulo b using the Diminished Radix method */
/* reduces a modulo n using the Diminished Radix method */
/*
int mp_dr_reduce(mp_int *a, const mp_int *b, mp_digit mp);
int mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k);
*/

/* returns true if a can be reduced with mp_reduce_2k */
/*
int mp_reduce_is_2k(const mp_int *a);
*/

638
639
640
641
642
643
644
645

646
647

648
649
650
651
652
653
654
653
654
655
656
657
658
659

660
661

662
663
664
665
666
667
668
669







-
+

-
+







*/

/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
/*
int mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d);
*/

/* d = a**b (mod c) */
/* Y = G**X (mod P) */
/*
int mp_exptmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);
int mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y);
*/

/* ---> Primes <--- */

/* number of primes */
#ifdef MP_8BIT
#  define PRIME_SIZE 31

Changes to generic/tclTomMathDecls.h.

94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
94
95
96
97
98
99
100

101
102
103
104
105
106
107







-







#define mp_mul_2d TclBN_mp_mul_2d
#define mp_mul_d TclBN_mp_mul_d
#define mp_neg TclBN_mp_neg
#define mp_or TclBN_mp_or
#define mp_radix_size TclBN_mp_radix_size
#define mp_read_radix TclBN_mp_read_radix
#define mp_rshd TclBN_mp_rshd
#define mp_s_rmap TclBNMpSRmap
#define mp_set TclBN_mp_set
#define mp_set_int TclBN_mp_set_int
#define mp_set_long TclBN_mp_set_long
#define mp_set_long_long TclBN_mp_set_long_long
#define mp_shrink TclBN_mp_shrink
#define mp_sqr TclBN_mp_sqr
#define mp_sqrt TclBN_mp_sqrt
320
321
322
323
324
325
326


327
328
329
330
331
332
333
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334







+
+







EXTERN int		TclBN_mp_set_long_long(mp_int *a, Tcl_WideUInt i);
/* 69 */
EXTERN Tcl_WideUInt	TclBN_mp_get_long_long(const mp_int *a);
/* 70 */
EXTERN int		TclBN_mp_set_long(mp_int *a, unsigned long i);
/* 71 */
EXTERN unsigned long	TclBN_mp_get_long(const mp_int *a);
/* 72 */
EXTERN unsigned long	TclBN_mp_get_int(const mp_int *a);

typedef struct TclTomMathStubs {
    int magic;
    void *hooks;

    int (*tclBN_epoch) (void); /* 0 */
    int (*tclBN_revision) (void); /* 1 */
397
398
399
400
401
402
403

404
405
406
407
408
409
410
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412







+







    TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */
    TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */
    int (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */
    int (*tclBN_mp_set_long_long) (mp_int *a, Tcl_WideUInt i); /* 68 */
    Tcl_WideUInt (*tclBN_mp_get_long_long) (const mp_int *a); /* 69 */
    int (*tclBN_mp_set_long) (mp_int *a, unsigned long i); /* 70 */
    unsigned long (*tclBN_mp_get_long) (const mp_int *a); /* 71 */
    unsigned long (*tclBN_mp_get_int) (const mp_int *a); /* 72 */
} TclTomMathStubs;

extern const TclTomMathStubs *tclTomMathStubsPtr;

#ifdef __cplusplus
}
#endif
555
556
557
558
559
560
561


562
563
564
565
566
567
568
569
570
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574







+
+









	(tclTomMathStubsPtr->tclBN_mp_set_long_long) /* 68 */
#define TclBN_mp_get_long_long \
	(tclTomMathStubsPtr->tclBN_mp_get_long_long) /* 69 */
#define TclBN_mp_set_long \
	(tclTomMathStubsPtr->tclBN_mp_set_long) /* 70 */
#define TclBN_mp_get_long \
	(tclTomMathStubsPtr->tclBN_mp_get_long) /* 71 */
#define TclBN_mp_get_int \
	(tclTomMathStubsPtr->tclBN_mp_get_int) /* 72 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLINTDECLS */

Changes to generic/tclTrace.c.

187
188
189
190
191
192
193

194
195

196
197
198
199
200
201
202
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204







+


+







Tcl_TraceObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int optionIndex;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    const char *name;
    const char *flagOps, *p;
#endif
    /* Main sub commands to 'trace' */
    static const char *const traceOptions[] = {
	"add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	"variable", "vdelete", "vinfo",
#endif
	NULL
361
362
363
364
365
366
367

368
369
370
371
372
373

374
375
376
377
378
379
380
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384







+






+







	Tcl_SetObjResult(interp, resultListPtr);
	break;
    }
#endif /* TCL_REMOVE_OBSOLETE_TRACES */
    }
    return TCL_OK;

#ifndef TCL_REMOVE_OBSOLETE_TRACES
  badVarOps:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad operations \"%s\": should be one or more of rwua",
	    flagOps));
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
    return TCL_ERROR;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TraceExecutionObjCmd --
 *
908
909
910
911
912
913
914

915
916
917

918
919
920
921
922
923
924
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930







+



+







	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = ckalloc(
		    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;
	    }
#endif
	    ctvarPtr->traceCmdInfo.length = length;
	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
	    memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
	    ctvarPtr->traceInfo.traceProc = TraceVarProc;
	    ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo;
	    ctvarPtr->traceInfo.flags = flags;
	    name = Tcl_GetString(objv[3]);
935
936
937
938
939
940
941
942





943
944
945
946
947
948
949
941
942
943
944
945
946
947

948
949
950
951
952
953
954
955
956
957
958
959







-
+
+
+
+
+







	     */

	    name = Tcl_GetString(objv[3]);
	    FOREACH_VAR_TRACE(interp, name, clientData) {
		TraceVarInfo *tvarPtr = clientData;

		if ((tvarPtr->length == length)
			&& ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
			&& ((tvarPtr->flags
#ifndef TCL_REMOVE_OBSOLETE_TRACES
& ~TCL_TRACE_OLD_STYLE
#endif
						)==flags)
			&& (strncmp(command, tvarPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceVar2(interp, name, NULL,
			    flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
			    TraceVarProc, clientData);
		    break;
		}
2460
2461
2462
2463
2464
2465
2466









































2467
2468
2469
2470
2471
2472
2473
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    if (TclIsVarUndefined(varPtr)) {
	TclCleanupVar(varPtr, arrayPtr);
	return NULL;
    }

    return varPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckArrayTraces --
 *
 *	This function is invoked to when we operate on an array variable,
 *	to allow any array traces to fire.
 *
 * Results:
 *	Returns TCL_OK to indicate normal operation. Returns TCL_ERROR if
 *	invocation of a trace function indicated an error. When TCL_ERROR is
 *	returned, then error information is left in interp.
 *
 * Side effects:
 *	Almost anything can happen, depending on trace; this function itself
 *	doesn't have any side effects.
 *
 *----------------------------------------------------------------------
 */

int
TclCheckArrayTraces(
    Tcl_Interp *interp,
    Var *varPtr,
    Var *arrayPtr,
    Tcl_Obj *name,
    int index)
{
    int code = TCL_OK;

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	Interp *iPtr = (Interp *)interp;

	code = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, name, NULL,
		(TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| TCL_TRACE_ARRAY),
		/* leaveErrMsg */ 1, index);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCallVarTraces --
 *
 *	This function is invoked to find and invoke relevant trace functions

Changes to generic/tclUniData.c.

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55











56
57
58
59
60


61
62
63
64
65
66
67
38
39
40
41
42
43
44











45
46
47
48
49
50
51
52
53
54
55
56
57
58


59
60
61
62
63
64
65
66
67







-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+



-
-
+
+







    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3872, 1344, 3904, 3936,
    3968, 1344, 4000, 1344, 4032, 4064, 4096, 4128, 4128, 4160, 4192, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 4224, 4256, 1344, 1344, 4288, 4320, 4352,
    4384, 4416, 1344, 4448, 4480, 4512, 4544, 1344, 4576, 4608, 4640, 4672,
    1344, 4704, 4736, 4768, 4800, 4832, 1344, 4864, 4896, 4928, 4960, 1344,
    4992, 5024, 5056, 5088, 1824, 1824, 5120, 5152, 5184, 5216, 5248, 5280,
    1344, 5312, 1344, 5344, 5376, 5408, 5440, 1824, 5472, 5504, 5536, 5568,
    5600, 5632, 5664, 5600, 704, 5696, 224, 224, 224, 224, 5728, 224, 224,
    224, 5760, 5792, 5824, 5856, 5888, 5920, 5952, 5984, 6016, 6048, 6080,
    6112, 6144, 6176, 6208, 6240, 6272, 6304, 6336, 6368, 6400, 6432, 6464,
    6496, 6528, 6528, 6528, 6528, 6528, 6528, 6528, 6528, 6560, 6592, 4928,
    6624, 6656, 6688, 6720, 6752, 4928, 6784, 6816, 6848, 6880, 6912, 6944,
    6976, 4928, 4928, 4928, 4928, 4928, 7008, 7040, 7072, 4928, 4928, 4928,
    7104, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 7136, 7168, 4928, 7200,
    7232, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 6528, 6528, 6528,
    6528, 7264, 6528, 7296, 7328, 6528, 6528, 6528, 6528, 6528, 6528, 6528,
    6528, 4928, 7360, 7392, 7424, 7456, 7488, 7520, 7552, 7584, 7616, 7648,
    1344, 5312, 1344, 5344, 5376, 5408, 5440, 5472, 5504, 5536, 5568, 5600,
    5632, 5664, 5696, 5632, 704, 5728, 224, 224, 224, 224, 5760, 224, 224,
    224, 5792, 5824, 5856, 5888, 5920, 5952, 5984, 6016, 6048, 6080, 6112,
    6144, 6176, 6208, 6240, 6272, 6304, 6336, 6368, 6400, 6432, 6464, 6496,
    6528, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6592, 6624, 4928,
    6656, 6688, 6720, 6752, 6784, 4928, 6816, 6848, 6880, 6912, 6944, 6976,
    7008, 4928, 4928, 4928, 4928, 4928, 7040, 7072, 7104, 4928, 4928, 4928,
    7136, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 7168, 7200, 4928, 7232,
    7264, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 6560, 6560, 6560,
    6560, 7296, 6560, 7328, 7360, 6560, 6560, 6560, 6560, 6560, 6560, 6560,
    6560, 4928, 7392, 7424, 7456, 7488, 4928, 7520, 7552, 7584, 7616, 7648,
    7680, 224, 224, 224, 7712, 7744, 7776, 1344, 7808, 7840, 7872, 7872,
    704, 7904, 7936, 7968, 1824, 8000, 4928, 4928, 8032, 4928, 4928, 4928,
    4928, 4928, 4928, 8064, 8096, 8128, 8160, 3232, 1344, 8192, 4192, 1344,
    8224, 8256, 8288, 1344, 1344, 8320, 8352, 4928, 8384, 8416, 8448, 8480,
    4928, 8448, 8512, 4928, 8416, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
    8224, 8256, 8288, 1344, 1344, 8320, 8352, 4928, 8384, 7552, 8416, 8448,
    4928, 8416, 8480, 4928, 7552, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
    4928, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
126
127
128
129
130
131
132
133

134
135
136
137
138
139
140
126
127
128
129
130
131
132

133
134
135
136
137
138
139
140







-
+







    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1792, 8544, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    8512, 8544, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 8576, 4928, 8608, 5408, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 8640, 8672, 224, 8704, 8736, 1344, 1344, 8768, 8800, 8832, 224,
    8864, 8896, 8928, 1824, 8960, 8992, 9024, 1344, 9056, 9088, 9120, 9152,
    9184, 1632, 9216, 9248, 9280, 1952, 9312, 9344, 9376, 1344, 9408, 9440,
    9472, 1344, 9504, 9536, 9568, 9600, 9632, 9664, 9696, 9728, 9728, 1344,
199
200
201
202
203
204
205
206

207
208
209
210
211
212
213
214
215
216
217
218
219
220














































































































221
222
223
224


225
226
227
228
229
230
231
232

233
234
235
236
237

238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304









305
306
307

308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359


360
361
362
363
364
365
366






367
368
369
370
371




372
373
374











































































































































375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512

513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541


542
543
544
545
546
547
548
199
200
201
202
203
204
205

206
207













208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319


320
321


322
323
324
325
326

327





328












329
330
331
332
333
334
335
336
337
338
339


































340









341
342
343
344
345
346
347
348
349
350
351

352























353
354
355
356
357
























358
359
360






361
362
363
364
365
366
367




368
369
370
371
372
373

374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531























































































































532




















533
534
535
536
537
538
539


540
541
542
543
544
545
546
547
548







-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+
-
-





-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+


-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
+
+







    ,10688, 10720, 10752, 1824, 1344, 1344, 1344, 8352, 10784, 10816, 10848,
    10880, 10912, 10944, 10976, 11008, 1824, 1824, 1824, 1824, 9280, 1344,
    11040, 11072, 1344, 11104, 11136, 11168, 11200, 1344, 11232, 1824,
    11264, 11296, 11328, 1344, 11360, 11392, 11424, 11456, 1344, 11488,
    1344, 11520, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 7840, 4704, 10272, 1824, 1824, 1824, 1824,
    11552, 11584, 11616, 11648, 4736, 11680, 1824, 11712, 11744, 11776,
    1824, 1824, 1344, 11808, 11840, 6848, 11872, 11904, 11936, 11968, 12000,
    1824, 1824, 1344, 11808, 11840, 6880, 11872, 11904, 11936, 11968, 12000,
    1824, 12032, 12064, 1344, 12096, 12128, 12160, 12192, 12224, 1824,
    1824, 1344, 1344, 12256, 1824, 12288, 12320, 12352, 12384, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 12416, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 12448,
    12480, 12512, 12544, 5248, 12576, 12608, 12640, 12672, 12704, 12736,
    12768, 5248, 12800, 12832, 12864, 12896, 12928, 1824, 1824, 12960,
    12992, 13024, 13056, 13088, 2368, 13120, 13152, 1824, 1824, 1824, 1824,
    1344, 13184, 13216, 1824, 1344, 13248, 13280, 1824, 1824, 1824, 1824,
    1824, 1344, 13312, 13344, 1824, 1344, 13376, 13408, 13440, 1344, 13472,
    13504, 1824, 13536, 13568, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 13600, 13632, 13664, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 13696, 13728, 13760, 1344, 13792, 13824, 1344,
    13856, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 13888, 13920,
    13952, 13984, 14016, 14048, 1824, 1824, 14080, 14112, 14144, 1824,
    1824, 1344, 1344, 12256, 1824, 12288, 12320, 12352, 12384, 1344, 12416,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 12448, 1824,
    1824, 1824, 1824, 12000, 12480, 12512, 1824, 1824, 1824, 1824, 1824,
    12544, 12576, 12608, 12640, 5248, 12672, 12704, 12736, 12768, 12800,
    12832, 12864, 5248, 12896, 12928, 12960, 12992, 13024, 1824, 1824,
    13056, 13088, 13120, 13152, 13184, 13216, 13248, 13280, 1824, 1824,
    1824, 1824, 1344, 13312, 13344, 1824, 1344, 13376, 13408, 1824, 1824,
    1824, 1824, 1824, 1344, 13440, 13472, 1824, 1344, 13504, 13536, 13568,
    1344, 13600, 13632, 1824, 4032, 13664, 1824, 1824, 1824, 1824, 1824,
    1824, 1344, 13696, 1824, 1824, 1824, 13728, 13760, 13792, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 13824, 13856, 13888, 1344, 13920,
    13952, 1344, 4608, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    13984, 14016, 14048, 14080, 14112, 14144, 1824, 1824, 14176, 14208,
    14240, 14272, 14304, 13632, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 14336, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 9984, 1824, 1824, 1824, 10848, 10848, 10848,
    14368, 1344, 1344, 1344, 1344, 1344, 1344, 14400, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 14432, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14464, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4608, 4736, 14496,
    1824, 1824, 10208, 14528, 1344, 14560, 14592, 14624, 8512, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 13728, 13760, 14656, 1824,
    1824, 1824, 1344, 1344, 14688, 14720, 14752, 1824, 1824, 14784, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14816,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14848,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 4736, 1824, 1824, 10208, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 9856, 1824, 1824, 1824,
    9984, 1824, 1824, 1824, 10848, 10848, 10848, 14176, 1344, 1344, 1344,
    1344, 1344, 1344, 14208, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344,
    1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 14240, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    14880, 14912, 14944, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 14272, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 13856, 4736, 14304, 1824, 1824, 10208,
    14336, 1344, 14368, 14400, 14432, 14464, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344,
    14496, 14528, 14560, 1824, 1824, 14592, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 14624, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 14656, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 8064, 4928, 14976,
    4928, 15008, 15040, 15072, 4928, 15104, 4928, 4928, 15136, 1824, 1824,
    1824, 1824, 15168, 4928, 4928, 15200, 15232, 1824, 1824, 1824, 1824,
    15264, 15296, 15328, 15360, 15392, 15424, 15456, 15488, 15520, 15552,
    15584, 15616, 15648, 15264, 15296, 15680, 15360, 15712, 15744, 15776,
    15488, 15808, 15840, 15872, 15904, 15936, 15968, 16000, 16032, 16064,
    16096, 16128, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
    4928, 4928, 4928, 4928, 4928, 4928, 4928, 704, 16160, 704, 16192, 16224,
    16256, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 16288, 16320, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 4736, 1824, 1824, 10208, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 9856, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 14688, 14720,
    14752, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    4928, 4928, 4928, 4928, 4928, 4928, 4928, 8064, 4928, 14784, 4928,
    14816, 14848, 14880, 4928, 14912, 4928, 4928, 14944, 1824, 1824, 1824,
    1824, 1824, 4928, 4928, 14976, 15008, 1824, 1824, 1824, 1824, 15040,
    15072, 15104, 15136, 15168, 15200, 15232, 15264, 15296, 15328, 15360,
    15392, 15424, 15040, 15072, 15456, 15136, 15488, 15520, 15552, 15264,
    15584, 15616, 15648, 15680, 15712, 15744, 15776, 15808, 15840, 15872,
    15904, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
    4928, 4928, 4928, 4928, 4928, 4928, 704, 15936, 704, 15968, 16000,
    16032, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 16064, 16096, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1344, 1344, 1344, 1344, 1344, 1344, 16128, 1824, 16160, 16192,
    16224, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1344, 1344, 1344, 1344, 1344, 1344, 16352, 1824, 16384, 16416,
    16448, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 16256, 16288, 16320, 16352, 16384, 16416, 1824, 16448,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 4928, 16480, 4928,
    4928, 8032, 16512, 16544, 8064, 16576, 16608, 4928, 16480, 4928, 16640,
    1824, 16672, 16704, 16736, 16768, 16800, 1824, 1824, 1824, 1824, 4928,
    4928, 4928, 4928, 4928, 4928, 4928, 16832, 4928, 4928, 4928, 4928,
    1824, 1824, 16480, 6880, 16512, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 16544, 16576, 16608, 16640, 16672, 16704, 1824,
    16736, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 4928, 16768,
    4928, 4928, 8032, 16800, 16832, 8064, 16864, 4928, 4928, 16768, 4928,
    16896, 1824, 16928, 16960, 16992, 17024, 17056, 1824, 1824, 1824, 1824,
    4928, 4928, 4928, 4928, 4928, 4928, 4928, 17088, 4928, 4928, 4928,
    4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
    4928, 4928, 4928, 4928, 4928, 4928, 16864, 16896, 4928, 4928, 4928,
    8032, 4928, 4928, 16864, 1824, 16480, 4928, 16928, 4928, 16960, 16992,
    1824, 1824, 16480, 8416, 17024, 17056, 17088, 1824, 17120, 6784, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    4928, 4928, 4928, 4928, 4928, 4928, 4928, 17120, 17152, 4928, 4928,
    4928, 8032, 4928, 4928, 17184, 1824, 16768, 4928, 17216, 4928, 17248,
    17280, 1824, 1824, 16768, 7552, 4928, 17312, 4928, 17344, 16960, 4928,
    1824, 1824, 1824, 17280, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 7840, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 17376, 1344, 1344, 1344, 1344, 1344, 1344, 11360, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 17408,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 7840, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    17152, 1344, 1344, 1344, 1344, 1344, 1344, 11360, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 17184, 1344,
    1344, 1344, 1344, 1344, 1344, 17440, 1824, 1824, 1824, 1824, 1824,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 17216, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11360
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11360
#endif /* TCL_UTF_MAX > 3 */
};

/*
 * The groupMap is indexed by combining the alternate page number with
 * the page offset and returns a group number that identifies a unique
 * set of character attributes.
612
613
614
615
616
617
618
619

620
621
622

623
624
625
626
627
628
629
630






631
632
633
634
635




636
637
638
639
640




641
642
643


644
645
646
647
648
649
650
651
652
653
654
655












656
657
658
659
660
661




662
663

664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685



























686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701







702
703
704
705
706


707
708
709
710
711
712

713
714
715
716
717
718
719
612
613
614
615
616
617
618

619
620
621

622
623
624






625
626
627
628
629
630
631




632
633
634
635
636




637
638
639
640
641


642
643
644











645
646
647
648
649
650
651
652
653
654
655
656
657





658
659
660
661
662

663
664
665




















666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694














695
696
697
698
699
700
701
702
703
704


705
706
707
708
709
710
711

712
713
714
715
716
717
718
719







-
+


-
+


-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+

-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+



-
-
+
+





-
+







    119, 119, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 120, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 121, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    23, 24, 23, 24, 0, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
    122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
    122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
    0, 0, 91, 3, 3, 3, 3, 3, 3, 0, 123, 123, 123, 123, 123, 123, 123, 123,
    0, 0, 91, 3, 3, 3, 3, 3, 3, 21, 123, 123, 123, 123, 123, 123, 123,
    123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
    123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
    123, 123, 21, 0, 3, 8, 0, 0, 14, 14, 4, 0, 92, 92, 92, 92, 92, 92,
    123, 123, 123, 21, 21, 3, 8, 0, 0, 14, 14, 4, 0, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 8, 92, 3, 92, 92, 3, 92, 92, 3, 92, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
    15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17,
    17, 17, 7, 7, 7, 3, 3, 4, 3, 3, 14, 14, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 3, 17, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 92, 92, 92, 92, 92, 8, 92, 3, 92, 92, 3, 92, 92, 3, 92, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
    15, 15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17,
    17, 17, 17, 7, 7, 7, 3, 3, 4, 3, 3, 14, 14, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 3, 17, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 15, 92,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 15,
    92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 3, 15, 92, 92, 92, 92, 92, 92, 92, 17, 14, 92, 92, 92, 92, 92,
    92, 91, 91, 92, 92, 14, 92, 92, 92, 92, 15, 15, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 15, 15, 15, 14, 14, 15, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    3, 3, 0, 17, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 3, 15, 92, 92, 92, 92, 92, 92, 92, 17, 14, 92, 92, 92, 92,
    92, 92, 91, 91, 92, 92, 14, 92, 92, 92, 92, 15, 15, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 15, 15, 15, 14, 14, 15, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    3, 3, 3, 3, 0, 17, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 15, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 91, 91, 14, 3, 3, 3, 91, 0, 0, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 92, 92, 92, 92, 91, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 91, 92, 92, 92, 91, 92, 92, 92, 92, 92, 0, 0, 3, 3, 3, 3, 3,
    3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92,
    92, 92, 0, 0, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 15,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 91, 91, 14, 3, 3, 3, 91, 0, 0,
    92, 4, 4, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 91, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 91, 92, 92, 92, 91, 92, 92, 92, 92, 92, 0, 0, 3, 3,
    3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 92, 92, 92, 0, 0, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 17, 92, 92, 92,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 17,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 124, 15, 15, 15, 15,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 124, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92,
    124, 92, 15, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124,
    124, 124, 92, 124, 124, 15, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 92, 92, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 3, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 0, 0,
    15, 15, 15, 15, 0, 0, 92, 15, 124, 124, 124, 92, 92, 92, 92, 0, 0,
    124, 124, 0, 0, 124, 124, 92, 15, 0, 0, 0, 0, 0, 0, 0, 0, 124, 0, 0,
    0, 0, 15, 15, 0, 15, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14, 4, 15, 3, 0, 0, 0,
    92, 92, 124, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15,
    0, 15, 15, 0, 0, 92, 0, 124, 124, 124, 92, 92, 0, 0, 0, 0, 92, 92,
    0, 0, 92, 92, 92, 0, 0, 0, 92, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 92, 92, 15,
    15, 15, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 124, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 92, 124, 92, 15, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92,
    92, 124, 124, 124, 124, 92, 124, 124, 15, 92, 92, 92, 92, 92, 92, 92,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 3, 3, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 3, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 92, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0,
    15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15,
    0, 0, 0, 15, 15, 15, 15, 0, 0, 92, 15, 124, 124, 124, 92, 92, 92, 92,
    0, 0, 124, 124, 0, 0, 124, 124, 92, 15, 0, 0, 0, 0, 0, 0, 0, 0, 124,
    0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14, 4, 15, 3, 92,
    0, 0, 92, 92, 124, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0,
    15, 15, 0, 15, 15, 0, 0, 92, 0, 124, 124, 124, 92, 92, 0, 0, 0, 0,
    92, 92, 0, 0, 92, 92, 92, 0, 0, 0, 92, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 92,
    92, 15, 15, 15, 92, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 124, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15,
    0, 0, 92, 15, 124, 124, 124, 92, 92, 92, 92, 92, 0, 92, 92, 124, 0,
    124, 124, 92, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    15, 15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4, 0, 0, 0,
    0, 0, 0, 0, 15, 92, 92, 92, 92, 92, 92, 0, 92, 124, 124, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0,
    92, 15, 124, 124, 124, 92, 92, 92, 92, 92, 0, 92, 92, 124, 0, 124,
    124, 92, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4, 0, 0, 0, 0, 0,
    0, 0, 15, 92, 92, 92, 92, 92, 92, 0, 92, 124, 124, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
    15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 92, 15,
    124, 92, 124, 92, 92, 92, 92, 0, 0, 124, 124, 0, 0, 124, 124, 92, 0,
    0, 0, 0, 0, 0, 0, 0, 92, 124, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 92,
    92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, 15, 18, 18, 18, 18, 18,
    18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 0, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 0, 15, 15, 0, 15, 0,
    15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 124, 124, 92, 124,
    92, 15, 124, 92, 124, 92, 92, 92, 92, 0, 0, 124, 124, 0, 0, 124, 124,
    92, 0, 0, 0, 0, 0, 0, 0, 0, 92, 124, 0, 0, 0, 0, 15, 15, 0, 15, 15,
    15, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, 15, 18, 18, 18,
    18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 0, 15, 15, 15, 15,
    15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 0, 15, 15, 0,
    15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 124, 124, 92, 124,
    124, 0, 0, 0, 124, 124, 124, 0, 124, 124, 124, 92, 0, 0, 15, 0, 0,
    0, 0, 0, 0, 124, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14, 14, 4, 14, 0,
    0, 0, 0, 0, 92, 124, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 92, 124, 124, 124, 92, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 92, 92, 92, 124,
    124, 124, 124, 0, 92, 92, 92, 0, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0,
    0, 92, 92, 0, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 92, 92, 0, 0, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18,
    18, 18, 14, 15, 92, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    18, 18, 14, 15, 92, 124, 124, 3, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 92, 15, 124, 92, 124,
    124, 124, 124, 124, 0, 92, 124, 124, 0, 124, 124, 92, 92, 0, 0, 0,
    0, 0, 0, 0, 124, 124, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 92, 92, 0,
    0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 92, 92, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15,
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784

785
786


















787
788


789
790
791
792
793
794
795
796
797
798



































799
800
801
802
803
804
805
806












807
808
809


810
811
812
813





814
815
816
817
818
819
820






821
822

823
824
825



826
827
828


829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845

846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863




864
865

866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916

















































917
918

919
920

921
922
923
924
925
926
927









928
929
930
931

932
933
934
935
936



937
938

939
940
941

942



943

944
945
946
947
948
949







950
951

952
953
954
955
956

957
958
959
960
961
962
963
964
965
966
967
968











969
970

971
972


973
974
975


976
977
978
979
980
981

982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002


















1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013











1014
1015
1016
1017



1018
1019

1020
1021
1022
1023
1024
1025





1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037












1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050












1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064













1065
1066
1067
1068
1069
1070
1071
1072
1073
1074









1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094



















1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105










1106
1107
1108
1109
1110
1111
1112
1113






1114
1115
1116
1117
1118
1119
1120
760
761
762
763
764
765
766


















767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787


788
789
790









791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826







827
828
829
830
831
832
833
834
835
836
837
838



839
840
841
842


843
844
845
846
847
848






849
850
851
852
853
854


855
856


857
858
859



860
861

















862


















863
864
865
866
867

868
869
870
871
















































872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921

922
923

924
925






926
927
928
929
930
931
932
933
934
935
936


937
938




939
940
941


942
943
944

945
946
947
948
949

950






951
952
953
954
955
956
957
958

959





960
961











962
963
964
965
966
967
968
969
970
971
972
973

974
975

976
977
978


979
980



981
982

983
984
985
986


















987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005










1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016




1017
1018
1019
1020

1021
1022





1023
1024
1025
1026
1027












1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040












1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053













1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067









1068
1069
1070
1071
1072
1073
1074
1075
1076
1077



















1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097










1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109






1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+


-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
+

-
-
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+

-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


-
-
+

-
-
-
-
+
+
+
-
-
+


-
+

+
+
+
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+
-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+
+

-
-
+
+
-
-
-


-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
+
+
+
+
+
+







    124, 124, 124, 15, 15, 124, 124, 124, 124, 124, 124, 124, 15, 15, 15,
    92, 92, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 124, 124, 92, 92, 124, 124, 124, 124, 124, 124, 92, 15, 124, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 124, 124, 124, 92, 14, 14, 125, 125, 125,
    125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
    125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
    125, 125, 125, 125, 125, 125, 125, 0, 125, 0, 0, 0, 0, 0, 125, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 91, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 92, 92, 92, 3, 3, 3, 3, 3, 3,
    3, 3, 3, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
    0, 0, 0, 0, 0, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
    126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
    126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
    126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
    126, 3, 91, 126, 126, 126, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15,
    15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15,
    15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15,
    15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 92, 92, 92, 3, 3, 3, 3, 3, 3, 3, 3, 3, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 127, 127, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
    126, 126, 126, 126, 126, 126, 126, 126, 126, 104, 104, 104, 104, 104,
    104, 0, 0, 110, 110, 110, 110, 110, 110, 0, 0, 8, 15, 15, 15, 15, 15,
    127, 127, 127, 104, 104, 104, 104, 104, 104, 0, 0, 110, 110, 110, 110,
    110, 110, 0, 0, 8, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 2, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 5,
    6, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 127,
    127, 127, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
    92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 3, 3, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 2,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 5, 6, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 128, 128, 128, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 92, 92, 92, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 92, 92, 92, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 92, 92, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 124, 92, 92, 92, 92, 92, 92,
    92, 124, 124, 124, 124, 124, 124, 124, 124, 92, 124, 124, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 3, 3, 3, 91, 3, 3, 3, 4, 15, 92, 0,
    0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 8, 3, 3,
    3, 3, 92, 92, 92, 17, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0,
    0, 0, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 92, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    92, 92, 92, 124, 124, 124, 124, 92, 92, 124, 124, 124, 0, 0, 0, 0,
    124, 124, 92, 124, 124, 124, 124, 124, 124, 92, 92, 92, 0, 0, 0, 0,
    14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
    0, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92,
    124, 92, 92, 92, 92, 92, 92, 92, 124, 124, 124, 124, 124, 124, 124,
    124, 92, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 3,
    3, 91, 3, 3, 3, 4, 15, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
    15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
    0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 92, 124, 124, 92, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 92, 124, 92, 92,
    92, 92, 92, 92, 92, 0, 92, 124, 92, 124, 124, 92, 92, 92, 92, 92, 92,
    92, 92, 124, 124, 124, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 0, 0, 92, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 91,
    0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0,
    0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 92, 92, 92, 17, 0, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 91, 15, 15, 15, 15,
    3, 3, 3, 3, 3, 3, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 119, 0, 92, 92, 92, 92, 124, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 92, 92, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 92, 124, 92, 92, 92, 92, 92, 124, 92, 124,
    124, 124, 124, 124, 92, 124, 124, 15, 15, 15, 15, 15, 15, 15, 0, 0,
    0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 92, 92, 92, 92, 92, 92, 92, 92, 92, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 92, 92, 124, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 92, 92, 92, 124, 124, 124, 124, 92,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 92, 92, 92, 92, 124, 124,
    92, 92, 124, 92, 92, 92, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92, 92, 124, 124,
    124, 92, 124, 92, 92, 92, 124, 124, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3,
    3, 15, 15, 15, 15, 124, 124, 124, 124, 124, 124, 124, 124, 92, 92,
    92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 0, 0, 0, 3, 3, 3, 3, 3, 9,
    92, 124, 124, 124, 0, 0, 0, 0, 124, 124, 92, 124, 124, 124, 124, 124,
    124, 92, 92, 92, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 91,
    91, 91, 91, 91, 3, 3, 129, 130, 131, 132, 132, 133, 134, 135, 136,
    0, 0, 0, 0, 0, 0, 0, 137, 137, 137, 137, 137, 137, 137, 137, 137, 137,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 0, 0, 0,
    137, 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, 137,
    137, 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, 137,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 92, 92, 124, 124, 92, 0, 0, 3, 3, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 124, 92, 124, 92, 92, 92, 92, 92, 92, 92, 0, 92, 124, 92, 124,
    124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 124, 124, 124, 124,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 92, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0,
    0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 91, 3, 3, 3, 3, 3, 3, 0, 0, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 119, 0, 92, 92, 92, 92,
    124, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92,
    92, 92, 92, 92, 124, 92, 124, 124, 124, 124, 124, 92, 124, 124, 15,
    15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3,
    3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 92, 92, 92,
    137, 137, 137, 137, 137, 0, 0, 137, 137, 137, 3, 3, 3, 3, 3, 3, 3,
    92, 92, 92, 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
    92, 92, 124, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124,
    92, 92, 92, 92, 124, 124, 92, 92, 124, 92, 92, 92, 15, 15, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 124, 92, 92, 124, 124, 124, 92, 124, 92, 92, 92, 124, 124, 0, 0,
    0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 124, 124, 124, 124, 124,
    124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 0,
    0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 15, 15,
    15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 91, 91, 91, 91, 91, 91, 3, 3, 128, 129, 130, 131, 131,
    132, 133, 134, 135, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0,
    92, 92, 92, 3, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    124, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15, 15, 92, 15, 15, 15, 15,
    124, 124, 92, 15, 15, 124, 92, 92, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    3, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 3, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15,
    15, 92, 15, 15, 15, 15, 124, 124, 92, 15, 15, 124, 92, 92, 0, 0, 0,
    0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 91, 91, 91, 91, 91,
    91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
    91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
    91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
    91, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 91, 136, 21,
    21, 21, 137, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 91, 91,
    91, 91, 91, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 92, 92, 92, 92,
    92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 138, 21, 21, 139, 21, 140,
    140, 140, 140, 140, 140, 140, 140, 141, 141, 141, 141, 141, 141, 141,
    141, 140, 140, 140, 140, 140, 140, 0, 0, 141, 141, 141, 141, 141, 141,
    0, 0, 140, 140, 140, 140, 140, 140, 140, 140, 141, 141, 141, 141, 141,
    141, 141, 141, 140, 140, 140, 140, 140, 140, 140, 140, 141, 141, 141,
    141, 141, 141, 141, 141, 140, 140, 140, 140, 140, 140, 0, 0, 141, 141,
    141, 141, 141, 141, 0, 0, 21, 140, 21, 140, 21, 140, 21, 140, 0, 141,
    0, 141, 0, 141, 0, 141, 140, 140, 140, 140, 140, 140, 140, 140, 141,
    141, 141, 141, 141, 141, 141, 141, 142, 142, 143, 143, 143, 143, 144,
    144, 145, 145, 146, 146, 147, 147, 0, 0, 140, 140, 140, 140, 140, 140,
    140, 140, 148, 148, 148, 148, 148, 148, 148, 148, 140, 140, 140, 140,
    140, 140, 140, 140, 148, 148, 148, 148, 148, 148, 148, 148, 140, 140,
    140, 140, 140, 140, 140, 140, 148, 148, 148, 148, 148, 148, 148, 148,
    140, 140, 21, 149, 21, 0, 21, 21, 141, 141, 150, 150, 151, 11, 152,
    11, 11, 11, 21, 149, 21, 0, 21, 21, 153, 153, 153, 153, 151, 11, 11,
    11, 140, 140, 21, 21, 0, 0, 21, 21, 141, 141, 154, 154, 0, 11, 11,
    11, 140, 140, 21, 21, 21, 113, 21, 21, 141, 141, 155, 155, 117, 11,
    11, 11, 0, 0, 21, 149, 21, 0, 21, 21, 156, 156, 157, 157, 151, 11,
    11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17, 8, 8, 8,
    8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3, 3, 3, 3,
    158, 159, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 16, 20,
    3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17, 17, 17, 0,
    17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 91, 0, 0, 18, 18, 18, 18,
    18, 18, 7, 7, 7, 5, 6, 91, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    7, 7, 7, 5, 6, 0, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
    0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
    4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    119, 119, 119, 119, 92, 119, 119, 119, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
    14, 107, 14, 14, 14, 14, 107, 14, 14, 21, 107, 107, 107, 21, 21, 107,
    107, 107, 21, 14, 107, 14, 14, 7, 107, 107, 107, 107, 107, 14, 14,
    14, 14, 14, 14, 107, 14, 160, 14, 107, 14, 161, 162, 107, 107, 14,
    21, 107, 107, 163, 107, 21, 15, 15, 15, 15, 21, 14, 14, 21, 21, 107,
    107, 7, 7, 7, 7, 7, 107, 21, 21, 21, 21, 14, 7, 14, 14, 164, 14, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 165, 165,
    165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
    166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166, 166,
    166, 166, 127, 127, 127, 23, 24, 127, 127, 127, 127, 18, 14, 14, 0,
    0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 7,
    14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14,
    91, 91, 91, 91, 91, 91, 91, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 91, 138, 21, 21, 21, 139, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 91, 91, 91, 91, 91, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 0, 92, 92, 92, 92, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21,
    140, 21, 21, 141, 21, 142, 142, 142, 142, 142, 142, 142, 142, 143,
    143, 143, 143, 143, 143, 143, 143, 142, 142, 142, 142, 142, 142, 0,
    0, 143, 143, 143, 143, 143, 143, 0, 0, 142, 142, 142, 142, 142, 142,
    142, 142, 143, 143, 143, 143, 143, 143, 143, 143, 142, 142, 142, 142,
    142, 142, 142, 142, 143, 143, 143, 143, 143, 143, 143, 143, 142, 142,
    142, 142, 142, 142, 0, 0, 143, 143, 143, 143, 143, 143, 0, 0, 21, 142,
    21, 142, 21, 142, 21, 142, 0, 143, 0, 143, 0, 143, 0, 143, 142, 142,
    142, 142, 142, 142, 142, 142, 143, 143, 143, 143, 143, 143, 143, 143,
    144, 144, 145, 145, 145, 145, 146, 146, 147, 147, 148, 148, 149, 149,
    0, 0, 142, 142, 142, 142, 142, 142, 142, 142, 150, 150, 150, 150, 150,
    150, 150, 150, 142, 142, 142, 142, 142, 142, 142, 142, 150, 150, 150,
    150, 150, 150, 150, 150, 142, 142, 142, 142, 142, 142, 142, 142, 150,
    150, 150, 150, 150, 150, 150, 150, 142, 142, 21, 151, 21, 0, 21, 21,
    143, 143, 152, 152, 153, 11, 154, 11, 11, 11, 21, 151, 21, 0, 21, 21,
    155, 155, 155, 155, 153, 11, 11, 11, 142, 142, 21, 21, 0, 0, 21, 21,
    143, 143, 156, 156, 0, 11, 11, 11, 142, 142, 21, 21, 21, 113, 21, 21,
    143, 143, 157, 157, 117, 11, 11, 11, 0, 0, 21, 151, 21, 0, 21, 21,
    158, 158, 159, 159, 153, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
    17, 17, 17, 17, 17, 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20,
    5, 16, 3, 3, 3, 3, 3, 3, 3, 3, 160, 161, 17, 17, 17, 17, 17, 2, 3,
    3, 3, 3, 3, 3, 3, 3, 3, 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5,
    6, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3,
    3, 3, 3, 2, 17, 17, 17, 17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17,
    17, 17, 18, 91, 0, 0, 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 91, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 0, 91, 91, 91, 91,
    91, 91, 91, 91, 91, 91, 91, 91, 91, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4,
    4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
    4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 119, 119, 119, 119, 92, 119, 119,
    119, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 107, 14, 14, 14, 14, 107, 14,
    14, 21, 107, 107, 107, 21, 21, 107, 107, 107, 21, 14, 107, 14, 14,
    7, 107, 107, 107, 107, 107, 14, 14, 14, 14, 14, 14, 107, 14, 162, 14,
    107, 14, 163, 164, 107, 107, 14, 21, 107, 107, 165, 107, 21, 15, 15,
    15, 15, 21, 14, 14, 21, 21, 107, 107, 7, 7, 7, 7, 7, 107, 21, 21, 21,
    21, 14, 7, 14, 14, 166, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 167, 167, 167, 167, 167, 167, 167, 167, 167,
    167, 167, 167, 167, 167, 167, 167, 168, 168, 168, 168, 168, 168, 168,
    168, 168, 168, 168, 168, 168, 168, 168, 168, 128, 128, 128, 23, 24,
    128, 128, 128, 128, 18, 14, 14, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14,
    14, 14, 14, 7, 7, 14, 14, 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14,
    14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7, 14, 7, 14,
    14, 14, 14, 7, 7, 14, 14, 7, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7,
    14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14,
    14, 14, 14, 5, 6, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 14, 14, 14,
    5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7,
    7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 7, 7, 14, 14, 14, 14, 14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18,
    14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14,
    18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169,
    169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 170, 170,
    170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170,
    14, 14, 14, 14, 14, 14, 14, 167, 167, 167, 167, 167, 167, 167, 167,
    170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 18, 18, 18, 18, 18,
    167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167, 167,
    167, 167, 167, 167, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168,
    168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, 168,
    168, 168, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 5, 6, 5, 6,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18,
    5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5,
    6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14,
    18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7,
    7, 7, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5,
    6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 7, 7, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 7, 7, 7, 7,
    7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14,
    14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 122, 122, 122, 122, 122, 122,
    14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
    122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
    122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122,
    122, 122, 122, 122, 122, 122, 122, 122, 122, 0, 123, 123, 123, 123,
    122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 122, 0,
    123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
    123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
    123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
    123, 0, 23, 24, 169, 170, 171, 172, 173, 23, 24, 23, 24, 23, 24, 174,
    175, 176, 177, 21, 23, 24, 21, 23, 24, 21, 21, 21, 21, 21, 91, 91,
    178, 178, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14, 23, 24, 23, 24,
    92, 92, 92, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18, 3, 3, 179, 179,
    179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179,
    179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179,
    179, 179, 179, 179, 179, 179, 179, 179, 0, 179, 0, 0, 0, 0, 0, 179,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 91, 3, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20, 3, 3, 3, 3, 3,
    3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5, 6, 5, 6, 5, 6,
    5, 6, 3, 3, 3, 3, 3, 91, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 8, 3, 3,
    3, 3, 8, 3, 5, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    123, 123, 123, 123, 123, 0, 23, 24, 171, 172, 173, 174, 175, 23, 24,
    23, 24, 23, 24, 176, 177, 178, 179, 21, 23, 24, 21, 23, 24, 21, 21,
    21, 21, 21, 91, 91, 180, 180, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14,
    14, 23, 24, 23, 24, 92, 92, 92, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3,
    18, 3, 3, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181,
    181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181,
    181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 0, 181,
    0, 0, 0, 0, 0, 181, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
    0, 0, 91, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 15, 15, 15, 15, 15, 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20,
    3, 16, 20, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3,
    16, 20, 5, 6, 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 91, 3, 3, 3, 3, 3, 3,
    3, 3, 3, 3, 8, 8, 3, 3, 3, 3, 8, 3, 5, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 0, 0, 0, 0, 2, 3, 3, 3, 14, 91, 15, 127, 5, 6, 5, 6, 5,
    6, 5, 6, 5, 6, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 92, 92, 92, 92, 124, 124, 8,
    91, 91, 91, 91, 91, 14, 14, 127, 127, 127, 91, 15, 3, 14, 14, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 2, 3, 3, 3, 14, 91,
    15, 128, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 14, 14, 5, 6, 5, 6, 5, 6, 5,
    6, 8, 5, 6, 6, 14, 128, 128, 128, 128, 128, 128, 128, 128, 128, 92,
    92, 92, 92, 124, 124, 8, 91, 91, 91, 91, 91, 14, 14, 128, 128, 128,
    91, 15, 3, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 92, 92, 11, 11, 91,
    15, 15, 15, 15, 0, 0, 92, 92, 11, 11, 91, 91, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 3, 91, 91, 91, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 91, 91, 91, 15,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 14, 14, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 14, 14,
    14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 14, 14, 18, 18, 18, 18,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18,
    18, 18, 18, 18, 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 14,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 91, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 15, 92, 119, 119, 119,
    3, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 91, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    23, 24, 23, 24, 23, 24, 91, 91, 92, 92, 15, 15, 15, 15, 15, 15, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 127, 92, 92, 3, 3, 3, 3, 3,
    3, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
    11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 91, 91, 91, 91,
    91, 91, 91, 91, 91, 11, 11, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    23, 24, 23, 24, 21, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91, 3, 3, 3, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 15,
    92, 119, 119, 119, 3, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 91,
    23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 91, 91, 92, 92, 15, 15,
    15, 15, 15, 15, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 92,
    92, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11, 11, 11, 11,
    11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
    91, 91, 91, 91, 91, 91, 91, 91, 91, 11, 11, 23, 24, 23, 24, 23, 24,
    23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    23, 24, 91, 21, 21, 21, 21, 21, 21, 21, 21, 23, 24, 23, 24, 180, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 91, 11, 11, 23, 24, 181, 21, 15,
    23, 24, 23, 24, 21, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 182, 183, 184, 185, 182, 0, 186,
    187, 188, 189, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 91, 91,
    21, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15, 92, 15, 15, 15, 15,
    92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 124, 124, 92, 92, 124, 14, 14, 14, 14,
    0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 14, 14, 4, 14, 0, 0, 0, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 124, 124, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    23, 24, 23, 24, 23, 24, 91, 21, 21, 21, 21, 21, 21, 21, 21, 23, 24,
    23, 24, 182, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 91, 11, 11, 23,
    24, 183, 21, 15, 23, 24, 23, 24, 21, 21, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 184, 185, 186,
    187, 184, 21, 188, 189, 190, 191, 23, 24, 23, 24, 23, 24, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 15, 91, 91, 21, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15,
    92, 15, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 92, 92, 124,
    14, 14, 14, 14, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 14, 14, 4, 14,
    0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 124,
    124, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124,
    124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 92,
    92, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0,
    0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 15, 15, 15, 15, 15, 15, 3, 3, 3, 15, 3, 15, 0,
    0, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 3, 3, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 124,
    124, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
    124, 124, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 15, 15, 15, 15, 15, 15, 3, 3, 3, 15,
    3, 15, 15, 92, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92,
    92, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 124, 124, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 92, 92, 92, 92, 124,
    124, 92, 124, 124, 124, 124, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    0, 91, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15,
    15, 15, 92, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 124, 124, 92, 92, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15,
    15, 92, 124, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 3, 3, 3, 3,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 91,
    15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 124, 92, 124, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 92,
    92, 92, 15, 15, 92, 92, 15, 15, 15, 15, 15, 92, 92, 15, 92, 15, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    15, 15, 91, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124,
    92, 92, 124, 124, 3, 3, 15, 91, 91, 124, 92, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15,
    15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 21, 21, 21, 21, 21, 21, 21,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 92, 92,
    92, 92, 124, 124, 92, 124, 124, 124, 124, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    3, 3, 3, 3, 0, 91, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3,
    15, 15, 15, 15, 15, 92, 91, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 124, 124,
    92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 92, 15, 15, 15, 15,
    15, 15, 15, 15, 92, 124, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
    3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 91, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 124, 92, 124, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 15, 92, 92, 92, 15, 15, 92, 92, 15, 15, 15, 15, 15, 92, 92, 15,
    92, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 91, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 124, 92, 92, 124, 124, 3, 3, 15, 91, 91, 124, 92, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15,
    0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 190, 21, 21, 21, 21, 21,
    21, 21, 11, 91, 91, 91, 91, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191,
    191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191,
    191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191, 191,
    191, 191, 191, 191, 191, 191, 191, 191, 191, 15, 15, 15, 124, 124,
    92, 124, 124, 92, 124, 124, 3, 124, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 192, 21, 21, 21,
    21, 21, 21, 21, 11, 91, 91, 91, 91, 21, 21, 21, 21, 21, 21, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193,
    193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193,
    193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193,
    193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 15, 15, 15, 124,
    124, 92, 124, 124, 92, 124, 124, 3, 124, 92, 0, 0, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 192, 192, 192,
    192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192,
    192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192, 192,
    192, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193,
    193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193, 193,
    193, 193, 193, 193, 193, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 194, 194, 194,
    194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194,
    194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194,
    194, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195,
    195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195,
    195, 195, 195, 195, 195, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 21,
    21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21,
    21, 21, 21, 0, 0, 0, 0, 0, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 7, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15,
    15, 15, 15, 15, 0, 15, 0, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15,
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166




1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180


1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192








1193
1194
1195
1196
1197
1198
1199
1200
1201







1202
1203
1204
1205
1206
1207
1208
1158
1159
1160
1161
1162
1163
1164




1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180


1181
1182
1183
1184
1185
1186








1187
1188
1189
1190
1191
1192
1193
1194
1195
1196







1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210







-
-
-
-
+
+
+
+












-
-
+
+




-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+







    15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 18,
    14, 14, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
    128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
    128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
    128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 18,
    18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 18, 18, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 92, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 18, 18, 18, 18,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 127, 15, 15, 15, 15, 15, 15,
    15, 15, 127, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 128, 15, 15, 15, 15, 15, 15,
    15, 15, 128, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    3, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 127,
    127, 127, 127, 127, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 194, 194, 194, 194,
    194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194,
    194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194,
    194, 194, 194, 194, 194, 194, 194, 194, 195, 195, 195, 195, 195, 195,
    195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195,
    195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195,
    195, 195, 195, 195, 195, 195, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    3, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 128,
    128, 128, 128, 128, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 196, 196, 196, 196,
    196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196,
    196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196,
    196, 196, 196, 196, 196, 196, 196, 196, 197, 197, 197, 197, 197, 197,
    197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197,
    197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197,
    197, 197, 197, 197, 197, 197, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 194,
    194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194,
    194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194, 194,
    194, 194, 194, 194, 194, 194, 194, 0, 0, 0, 0, 195, 195, 195, 195,
    195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195,
    195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, 195,
    195, 195, 195, 195, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 196,
    196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196,
    196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196,
    196, 196, 196, 196, 196, 196, 196, 0, 0, 0, 0, 197, 197, 197, 197,
    197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197,
    197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197,
    197, 197, 197, 197, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
    0, 0, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227



1228
1229

1230
1231

1232
1233
1234


1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245










1246
1247
1248


1249
1250
1251
1252



1253
1254
1255





1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267










1268
1269
1270
1271



1272
1273
1274
1275
1276
1277
1278
1279
1280









1281
1282
1283
1284
1285




1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315































1316
1317
1318
1319
1320
1321
1322
1323







1324
1325
1326
1327
1328
1329
1330






1331
1332
1333

1334
1335
1336
1337
1338
1339
1340
1341
1342
1343










1344
1345

1346
1347
1348


1349
1350

1351
1352
1353


1354
1355
1356
1357
1358
1359
1360
1361
1362

















1363
1364
1365



1366
1367
1368
1369
1370



1371
1372
1373
1374
1375
1376
1377
1378
1379
1380









1381
1382
1383
1384



1385
1386

1387
1388
1389
1390





1391
1392
1393
1394



1395
1396
1397


1398
1399
1400
1401
1402
1403
1404
1405
1406
1407









1408
1409
1410
1411
1412




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
1444



1445
1446
1447
1448



1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462






















1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481













1482
1483
1484
1485
1486
1487





1488
1489
1490
1491
1492
1493
1494




1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507














1508
1509
1510
1511



1512
1513
1514


1515
1516
1517
1518
1519
1520
1521





1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537

1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566










1567
1568
1569
1570
1571
1572
1573
1220
1221
1222
1223
1224
1225
1226



1227
1228
1229
1230

1231
1232

1233
1234


1235
1236
1237










1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248


1249
1250
1251
1252
1253

1254
1255
1256
1257


1258
1259
1260
1261
1262
1263
1264










1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275



1276
1277
1278
1279








1280
1281
1282
1283
1284
1285
1286
1287
1288





1289
1290
1291
1292
1293
1294




























1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325








1326
1327
1328
1329
1330
1331
1332
1333






1334
1335
1336
1337
1338
1339



1340
1341









1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352

1353



1354
1355


1356



1357
1358









1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375



1376
1377
1378
1379
1380



1381
1382
1383
1384









1385
1386
1387
1388
1389
1390
1391
1392
1393
1394



1395
1396
1397
1398

1399
1400



1401
1402
1403
1404
1405
1406



1407
1408
1409
1410


1411
1412
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
1444
1445


1446
1447








1448
1449
1450
1451
1452
1453
1454
1455
1456



1457
1458
1459
1460



1461
1462
1463
1464













1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486



















1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500





1501
1502
1503
1504
1505
1506






1507
1508
1509
1510
1511












1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526



1527
1528
1529



1530
1531







1532
1533
1534
1535
1536

1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571










1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588







-
-
-
+
+
+

-
+

-
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
+
+



-
+
+
+

-
-
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
+
+
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+


-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
+

-
-
-
+
+
+
+
+

-
-
-
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
-















+



















-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+







    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 3, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 18, 18, 15, 15, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 92, 92, 92, 0, 92, 92,
    0, 0, 0, 0, 0, 92, 92, 92, 92, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 92, 92, 92, 0, 0, 0,
    0, 92, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3,
    3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 92, 92, 92, 0, 0,
    0, 0, 92, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0,
    3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 18, 18, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 18, 18, 3, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 14, 15, 15,
    15, 15, 15, 15, 15, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 14,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 0, 0, 18, 18, 18,
    18, 18, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 0, 0, 18,
    18, 18, 18, 18, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 18, 18,
    18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18,
    18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 97,
    97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97,
    15, 15, 15, 15, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    0, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18,
    18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97,
    97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97,
    97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 102, 102, 102, 102, 102, 102, 102,
    97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, 97,
    97, 97, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 102, 102, 102, 102,
    102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
    102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
    102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
    102, 102, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    102, 102, 102, 102, 102, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18,
    15, 15, 15, 15, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 124, 92, 124, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    18, 18, 18, 18, 18, 18, 0, 18, 18, 18, 18, 18, 18, 18, 15, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 18, 18, 18, 18, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 124, 92,
    124, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 3, 3,
    3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92,
    92, 124, 124, 92, 92, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 92, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124,
    92, 92, 92, 92, 124, 124, 92, 92, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 17, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 92,
    92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 92, 92, 92, 0, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 92, 92, 92, 92, 92, 124, 92, 92, 92, 92, 92, 92, 92,
    92, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 124, 124, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 92, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 15, 15, 15, 15, 3, 3,
    3, 3, 3, 92, 92, 92, 3, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 3,
    15, 3, 3, 3, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 92, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 15,
    15, 15, 15, 3, 3, 3, 3, 92, 92, 92, 92, 3, 0, 0, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 15, 3, 15, 3, 3, 3, 0, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124,
    15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 124, 124,
    92, 124, 92, 92, 3, 3, 3, 3, 3, 3, 92, 0, 15, 15, 15, 15, 15, 15, 15,
    0, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 92, 92, 124, 124, 92, 124, 92, 92, 3, 3, 3, 3, 3, 3, 92, 0, 15,
    15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 3, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 92, 92, 124, 124, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 124, 124, 124, 0, 0, 124,
    124, 0, 0, 124, 124, 124, 0, 0, 15, 0, 0, 0, 0, 0, 0, 124, 0, 0, 0,
    0, 0, 15, 15, 15, 15, 15, 124, 124, 0, 0, 92, 92, 92, 92, 92, 92, 92,
    0, 0, 0, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 124, 124, 92,
    92, 92, 124, 92, 15, 15, 15, 15, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 0, 3, 0, 3, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 92, 92, 92, 124,
    92, 124, 124, 124, 124, 92, 92, 124, 92, 92, 15, 15, 3, 15, 0, 0, 0,
    0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124,
    92, 92, 92, 92, 0, 0, 124, 124, 124, 124, 92, 92, 124, 92, 92, 3, 3,
    3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 15,
    15, 15, 15, 92, 92, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92,
    124, 124, 92, 124, 92, 92, 3, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3,
    3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 124, 92,
    124, 124, 92, 92, 92, 92, 92, 92, 124, 92, 0, 0, 0, 0, 0, 0, 0, 0,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    0, 0, 92, 92, 92, 124, 124, 92, 92, 92, 92, 124, 92, 92, 92, 92, 92,
    15, 15, 15, 15, 15, 15, 92, 124, 124, 124, 92, 92, 92, 92, 92, 92,
    92, 92, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0,
    0, 92, 92, 124, 124, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0,
    15, 15, 15, 15, 15, 0, 92, 92, 15, 124, 124, 92, 124, 124, 124, 124,
    0, 0, 124, 124, 0, 0, 124, 124, 124, 0, 0, 15, 0, 0, 0, 0, 0, 0, 124,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 124, 124, 0, 0, 92, 92, 92, 92,
    92, 92, 92, 0, 0, 0, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92,
    124, 124, 92, 92, 92, 124, 92, 15, 15, 15, 15, 3, 3, 3, 3, 3, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 0, 3, 0, 3, 92, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92,
    92, 92, 92, 124, 92, 124, 124, 124, 124, 92, 92, 124, 92, 92, 15, 15,
    3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 124, 124, 124, 92, 92, 92, 92, 0, 0, 124, 124, 124, 124, 92, 92,
    124, 92, 92, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    3, 3, 3, 3, 3, 15, 15, 15, 15, 92, 92, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 124, 124, 92, 92, 92,
    92, 92, 92, 92, 92, 124, 124, 92, 124, 92, 92, 3, 3, 3, 15, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0,
    0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 92, 124, 92, 124, 124, 92, 92, 92, 92, 92, 92, 124, 92, 0, 0, 0,
    0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 124, 124, 92, 92, 92, 92,
    124, 92, 92, 92, 92, 92, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    18, 18, 3, 3, 3, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    124, 124, 124, 92, 92, 92, 92, 92, 92, 92, 92, 92, 124, 92, 92, 3,
    0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 3, 3, 3, 14, 10,
    10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
    10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 13, 13, 13,
    13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
    13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
    10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
    10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
    13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 124, 15, 92, 92, 92, 92, 3,
    3, 3, 3, 3, 3, 3, 3, 92, 0, 0, 0, 0, 0, 0, 0, 0, 15, 92, 92, 92, 92,
    92, 92, 124, 124, 92, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0,
    15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    124, 92, 92, 3, 3, 3, 0, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 124, 15, 92,
    92, 92, 92, 3, 3, 3, 3, 3, 3, 3, 3, 92, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    92, 92, 92, 92, 92, 92, 124, 124, 92, 92, 92, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 0, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 124, 92, 92, 3, 3, 3, 15, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 124, 92, 92, 92, 92, 92, 92, 92, 0, 92,
    92, 92, 92, 92, 92, 124, 92, 15, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 3, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 0, 124, 92, 92, 92, 92, 92, 92, 92, 124, 92, 92, 124, 92, 92, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 124, 92, 92, 92,
    92, 92, 92, 92, 0, 92, 92, 92, 92, 92, 92, 124, 92, 15, 3, 3, 3, 3,
    3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 0, 124, 92, 92, 92, 92, 92, 92, 92, 124,
    92, 92, 124, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 0, 0, 0,
    15, 15, 15, 92, 92, 92, 92, 92, 92, 0, 0, 0, 92, 0, 92, 92, 0, 92,
    92, 92, 92, 92, 92, 92, 15, 92, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 127, 127, 127, 127, 127, 127, 127,
    92, 0, 92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 15, 92, 0, 0, 0, 0, 0,
    0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    127, 127, 127, 127, 127, 127, 127, 127, 0, 3, 3, 3, 3, 3, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 124, 124, 124, 124, 124, 0, 92, 92, 0, 124, 124, 92,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 92, 92, 92, 92, 92, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 92, 92, 92, 92, 92, 92, 3, 3, 3, 3, 3, 14, 14, 14, 14, 91, 91,
    91, 91, 3, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 0, 18, 18, 18, 18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
    124, 92, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 124, 124, 3, 3, 0,
    0, 0, 0, 0, 0, 0, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
    128, 128, 128, 128, 128, 0, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    0, 92, 92, 92, 92, 92, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92,
    92, 92, 92, 3, 3, 3, 3, 3, 14, 14, 14, 14, 91, 91, 91, 91, 3, 14, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 18, 18,
    18, 18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 124, 124, 124, 124,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 3, 3, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 124, 124, 124, 124, 124, 124,
    124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
    124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
    124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 91,
    91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 0, 0, 0, 0,
    124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 91, 91, 91,
    91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 14, 92, 92, 3, 17,
    17, 17, 17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 14, 92, 92, 3, 17, 17, 17,
    17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 124, 124, 92, 92, 92, 14, 14, 14,
    124, 124, 124, 124, 124, 124, 17, 17, 17, 17, 17, 17, 17, 17, 92, 92,
    92, 92, 92, 92, 92, 92, 14, 14, 92, 92, 92, 92, 92, 92, 92, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 124, 124, 92, 92, 92, 14, 14, 14, 124,
    124, 124, 124, 124, 124, 17, 17, 17, 17, 17, 17, 17, 17, 92, 92, 92,
    92, 92, 92, 92, 92, 14, 14, 92, 92, 92, 92, 92, 92, 92, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 92, 92, 92, 92, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 92, 92, 92, 92, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 92, 92, 92, 14, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
    14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 92, 92, 92, 14, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 107, 107, 107, 107, 107, 107, 107, 107,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0,
    0, 0, 0, 0, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107,
    107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21,
    21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 0, 107, 107, 0, 0, 107,
    0, 0, 107, 107, 0, 0, 107, 107, 107, 107, 0, 107, 107, 107, 107, 107,
    107, 107, 107, 21, 21, 21, 21, 0, 21, 0, 21, 21, 21, 21, 21, 21, 21,
    0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 107, 0, 107, 107, 0, 0, 107, 0, 0, 107, 107,
    0, 0, 107, 107, 107, 107, 0, 107, 107, 107, 107, 107, 107, 107, 107,
    21, 21, 21, 21, 0, 21, 0, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 107, 107, 0, 107, 107, 107, 107, 0, 0, 107, 107, 107, 107,
    107, 107, 107, 107, 0, 107, 107, 107, 107, 107, 107, 107, 0, 21, 21,
    107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107,
    0, 107, 107, 107, 107, 0, 0, 107, 107, 107, 107, 107, 107, 107, 107,
    0, 107, 107, 107, 107, 107, 107, 107, 0, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 107, 107, 0, 107, 107, 107, 107, 0, 107,
    107, 107, 107, 107, 0, 107, 0, 0, 0, 107, 107, 107, 107, 107, 107,
    107, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107,
    21, 21, 107, 107, 0, 107, 107, 107, 107, 0, 107, 107, 107, 107, 107,
    0, 107, 0, 0, 0, 107, 107, 107, 107, 107, 107, 107, 0, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107,
    107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 0, 0, 107, 107, 107,
    107, 107, 107, 107, 107, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    21, 21, 21, 21, 21, 21, 0, 0, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    107, 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21,
    21, 21, 7, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21,
    21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 107,
    21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 7,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 7, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 7, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21,
    21, 21, 21, 21, 21, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
    107, 107, 107, 107, 107, 107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7,
    21, 21, 21, 21, 21, 21, 107, 21, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    107, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21,
    107, 21, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 14, 14, 14, 14, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 14, 14, 14, 14, 14, 14, 14, 14, 92, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 92, 14, 14, 3,
    3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92,
    92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92,
    92, 92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 0, 0, 92, 92, 92, 92, 92, 92, 92, 0, 92, 92, 0, 92,
    92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 196, 196,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 14, 14, 14, 14,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 14, 14, 14, 14, 14, 14, 14, 14, 92, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 92, 14, 14, 3, 3, 3, 3, 3, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 0, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92, 92, 92, 92, 92, 0, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 92, 92,
    92, 92, 92, 92, 92, 0, 92, 92, 0, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 92, 92, 92, 92, 92, 92, 92,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 198, 198, 198, 198, 198, 198, 198, 198,
    198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198,
    198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 198, 199, 199,
    199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
    199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
    199, 199, 199, 199, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14,
    18, 18, 18, 4, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196,
    196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196, 196,
    196, 196, 196, 196, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197,
    197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 197,
    197, 197, 197, 197, 197, 197, 197, 197, 197, 197, 92, 92, 92, 92, 92,
    92, 92, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3,
    3, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15,
    15, 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15,
    0, 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0,
    15, 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15,
    15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15,
    15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14,
    15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
    0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15,
    15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15, 0,
    15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0, 15,
    0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15,
    15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15,
    0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
    0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14,
    14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 11, 11, 11, 11, 11,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0,
    0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
    0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0,
    14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14,
    14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 11, 11, 11,
    11, 11, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0,
    0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0,
    14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 0, 0, 0, 14, 0, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    0
#endif /* TCL_UTF_MAX > 3 */
};

/*
 * Each group represents a unique set of character attributes.  The attributes
 * are encoded into a 32-bit value as follows:
 *
 * Bits 0-4	Character category: see the constants listed below.
 *
 * Bits 5-7	Case delta type: 000 = identity
 *				 010 = add delta for lower
 *				 011 = add delta for lower, add 1 for title
 *				 100 = subtract delta for title/upper
 *				 101 = sub delta for upper, sub 1 for title
 *				 110 = sub delta for upper, add delta for lower
 *				 111 = subtract delta for upper
 *
 * Bits 8-31	Case delta: delta for case conversions.  This should be the
 *			    highest field so we can easily sign extend.
 */

static const int groups[] = {
    0, 15, 12, 25, 27, 21, 22, 26, 20, 9, 8257, 28, 19, 8322, 29,
    5, 23, 16, 11, -190078, 24, 2, -30846, 321, 386, -50879, 59522,
    -30911, 76930, -49790, 53825, 52801, 52545, 20289, 51777, 52033,
    53057, -24702, 54081, 53569, -41598, 54593, -33150, 54849, 55873,
    55617, 56129, -14206, 609, 451, 674, 20354, -24767, -14271, -33215,
    2763585, -41663, 2762817, -2768510, -49855, 17729, 18241, -2760318,
    -2759550, -2760062, 53890, 52866, 52610, 51842, 52098, -10833534,
    -10832510, 53122, -10823550, -10830718, 53634, 54146, -2750078,
    -10829950, -2751614, 54658, 54914, -2745982, 55938, -10824062,
    17794, 55682, 18306, 56194, -10818686, -10817918, 4, 6, -21370,
    29761, 9793, 9537, 16449, 16193, 9858, 9602, 8066, 16514, 16258,
    2113, 16002, 14722, 1, 12162, 13954, 2178, 22146, 20610, -1662,
    29826, -15295, 24706, -1727, 20545, 7, 3905, 3970, 12353, 12418,
    8, 1859649, 9949249, 10, 1601154, 1600898, 1598594, 1598082, 1598338,
    1596546, 1582466, -9027966, -9044862, -976254, 15234, -1949375,
    -1918, -1983, -18814, -21886, -25470, -32638, -28542, -32126,
    -1981, -2174, -18879, -2237, 1844610, -21951, -25535, -28607,
    -32703, -32191, 13, 14, -1924287, -2145983, -2115007, 7233, 7298,
    4170, 4234, 6749, 6813, -2750143, -976319, -2746047, 2763650,
    2762882, -2759615, -2751679, -2760383, -2760127, -2768575, 1859714,
    -9044927, -10823615, -10830783, -10833599, -10832575, -10830015,
    -10817983, -10824127, -10818751, 237633, 237698, 9949314, 18,
    17, 10305, 10370, 8769, 8834
    8, 1859649, -769822, 9949249, 10, 1601154, 1600898, 1598594, 1598082,
    1598338, 1596546, 1582466, -9027966, -769983, -9044862, -976254,
    15234, -1949375, -1918, -1983, -18814, -21886, -25470, -32638,
    -28542, -32126, -1981, -2174, -18879, -2237, 1844610, -21951,
    -25535, -28607, -32703, -32191, 13, 14, -1924287, -2145983, -2115007,
    7233, 7298, 4170, 4234, 6749, 6813, -2750143, -976319, -2746047,
    2763650, 2762882, -2759615, -2751679, -2760383, -2760127, -2768575,
    1859714, -9044927, -10823615, -10830783, -10833599, -10832575,
    -10830015, -10817983, -10824127, -10818751, 237633, 237698, 9949314,
    18, 17, 10305, 10370, 8769, 8834
};

#if TCL_UTF_MAX > 3
#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1fffff) >= 0x2fa20)
#else
#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1f0000) != 0)
#endif

Changes to generic/tclUtf.c.

64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
64
65
66
67
68
69
70

71



72
73
74
75
76
77
78







-

-
-
-







    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
#if TCL_UTF_MAX > 3
    4,4,4,4,4,4,4,4,
#else
    1,1,1,1,1,1,1,1,
#endif
    1,1,1,1,1,1,1,1
};

/*
 *---------------------------------------------------------------------------
 *
 * TclUtfCount --
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
86
87
88
89
90
91
92

93
94
95
96
97
98
99
100

101
102
103

104
105
106
107
108
109
110







-
+







-



-







 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TclUtfCount(
    int ch)			/* The Tcl_UniChar whose size is returned. */
    int ch)			/* The Unicode character whose size is returned. */
{
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	return 1;
    }
    if (ch <= 0x7FF) {
	return 2;
    }
#if TCL_UTF_MAX > 3
    if (((unsigned)(ch - 0x10000) <= 0xFFFFF)) {
	return 4;
    }
#endif
    return 3;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharToUtf --
131
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


161
162
163



164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179







180
181
182
183
184
185
186
125
126
127
128
129
130
131

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



161
162
163
164
165
166

167
168


169
170
171
172
173
174
175

176
177
178
179
180
181
182
183
184
185
186
187
188
189







-
+












-



+
+
+
-
-
-
+
+
+
+
+



+
+
-
-
-
+
+
+



-


-
-







-
+
+
+
+
+
+
+







int
Tcl_UniCharToUtf(
    int ch,			/* The Tcl_UniChar to be stored in the
				 * buffer. */
    char *buf)			/* Buffer in which the UTF-8 representation of
				 * the Tcl_UniChar is stored. Buffer must be
				 * large enough to hold the UTF-8 character
				 * (at most TCL_UTF_MAX bytes). */
				 * (at most 4 bytes). */
{
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	buf[0] = (char) ch;
	return 1;
    }
    if (ch >= 0) {
	if (ch <= 0x7FF) {
	    buf[1] = (char) ((ch | 0x80) & 0xBF);
	    buf[0] = (char) ((ch >> 6) | 0xC0);
	    return 2;
	}
	if (ch <= 0xFFFF) {
#if TCL_UTF_MAX == 4
	    if ((ch & 0xF800) == 0xD800) {
		if (ch & 0x0400) {
		    /* Low surrogate */
		    if (((buf[0] & 0xF8) == 0xF0) && ((buf[1] & 0xC0) == 0x80)
			    && ((buf[2] & 0xCF) == 0)) {
			/* Previous Tcl_UniChar was a High surrogate, so combine */
		    buf[3] = (char) ((ch | 0x80) & 0xBF);
		    buf[2] |= (char) (((ch >> 6) | 0x80) & 0x8F);
		    return 4;
			buf[3] = (char) ((ch & 0x3F) | 0x80);
			buf[2] |= (char) (((ch >> 6) & 0x0F) | 0x80);
			return 4;
		    }
		    /* Previous Tcl_UniChar was not a High surrogate, so just output */
		} else {
		    /* High surrogate */
		    ch += 0x40;
		    /* Fill buffer with specific 3-byte (invalid) byte combination,
		       so following Low surrogate can recognize it and combine */
		    buf[2] = (char) (((ch << 4) | 0x80) & 0xB0);
		    buf[1] = (char) (((ch >> 2) | 0x80) & 0xBF);
		    buf[0] = (char) (((ch >> 8) | 0xF0) & 0xF7);
		    buf[2] = (char) ((ch << 4) & 0x30);
		    buf[1] = (char) (((ch >> 2) & 0x3F) | 0x80);
		    buf[0] = (char) (((ch >> 8) & 0x07) | 0xF0);
		    return 0;
		}
	    }
#endif
	    goto three;
	}

#if TCL_UTF_MAX > 3
	if (ch <= 0x10FFFF) {
	    buf[3] = (char) ((ch | 0x80) & 0xBF);
	    buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
	    buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
	    buf[0] = (char) ((ch >> 18) | 0xF0);
	    return 4;
	}
#endif
    } else if (ch == -1) {
	if (((buf[0] & 0xF8) == 0xF0) && ((buf[1] & 0xC0) == 0x80)
		&& ((buf[2] & 0xCF) == 0)) {
	    ch = 0xD7C0 + ((buf[0] & 0x07) << 8) + ((buf[1] & 0x3F) << 2)
		    + ((buf[2] & 0x30) >> 4);
	    goto three;
	}
    }

    ch = 0xFFFD;
three:
    buf[2] = (char) ((ch | 0x80) & 0xBF);
    buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
    buf[0] = (char) ((ch >> 12) | 0xE0);
211
212
213
214
215
216
217
218

219
220
221

222
223
224
225
226

227
228
229
230
231


232




233
234




235
236
237
238
239
240
241
214
215
216
217
218
219
220

221
222
223

224

225
226
227

228
229
230
231
232
233
234
235

236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252







-
+


-
+
-



-
+





+
+
-
+
+
+
+


+
+
+
+







    int uniLength,		/* Length of Unicode string in Tcl_UniChars
				 * (must be >= 0). */
    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const Tcl_UniChar *w, *wEnd;
    char *p, *string;
    int oldLength;
    int oldLength, len = 1;

    /*
     * UTF-8 string length in bytes will be <= Unicode string length *
     * UTF-8 string length in bytes will be <= Unicode string length * 4.
     * TCL_UTF_MAX.
     */

    oldLength = Tcl_DStringLength(dsPtr);
    Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * TCL_UTF_MAX);
    Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 4);
    string = Tcl_DStringValue(dsPtr) + oldLength;

    p = string;
    wEnd = uniStr + uniLength;
    for (w = uniStr; w < wEnd; ) {
	if (!len && ((*w & 0xFC00) != 0xDC00)) {
	    /* Special case for handling upper surrogates. */
	p += Tcl_UniCharToUtf(*w, p);
	    p += Tcl_UniCharToUtf(-1, p);
	}
	len = Tcl_UniCharToUtf(*w, p);
	p += len;
	w++;
    }
    if (!len) {
	/* Special case for handling upper surrogates. */
	p += Tcl_UniCharToUtf(-1, p);
    }
    Tcl_DStringSetLength(dsPtr, oldLength + (p - string));

    return string;
}

/*
 *---------------------------------------------------------------------------
267
268
269
270
271
272
273







274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291



292
293
294



295


296
297
298
299
300
301
302
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308

309
310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
325
326







+
+
+
+
+
+
+

















-
+
+
+



+
+
+
-
+
+







 *	number of bytes from the UTF-8 string that were consumed.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static const unsigned short cp1252[32] = {
  0x20ac,   0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021,
  0x02C6, 0x2030, 0x0160, 0x2039, 0x0152,   0x8D, 0x017D,   0x8F,
    0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014,
   0x2DC, 0x2122, 0x0161, 0x203A, 0x0153,   0x9D, 0x017E, 0x0178
};

int
Tcl_UtfToUniChar(
    register const char *src,	/* The UTF-8 string. */
    register Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by
				 * the UTF-8 string. */
{
    register int byte;

    /*
     * Unroll 1 to 3 (or 4) byte UTF-8 sequences.
     */

    byte = *((unsigned char *) src);
    if (byte < 0xC0) {
	/*
	 * Handles properly formed UTF-8 characters between 0x01 and 0x7F.
	 * Also treats \0 and naked trail bytes 0x80 to 0xBF as valid
	 * Treats naked trail bytes 0x80 to 0x9F as valid characters from
	 * the cp1252 table. See: <https://en.wikipedia.org/wiki/UTF-8>
	 * Also treats \0 and other naked trail bytes 0xA0 to 0xBF as valid
	 * characters representing themselves.
	 */

	if ((unsigned)(byte-0x80) < (unsigned) 0x20) {
	    *chPtr = (Tcl_UniChar) cp1252[byte-0x80];
	} else {
	*chPtr = (Tcl_UniChar) byte;
	    *chPtr = (Tcl_UniChar) byte;
	}
	return 1;
    } else if (byte < 0xE0) {
	if ((src[1] & 0xC0) == 0x80) {
	    /*
	     * Two-byte-character lead-byte followed by a trail-byte.
	     */

324
325
326
327
328
329
330
331
332
333
334
335
336
337

338
339
340
341
342
343
344
348
349
350
351
352
353
354

355
356
357
358
359

360
361
362
363
364
365
366
367







-





-
+







	}

	/*
	 * A three-byte-character lead-byte not followed by two trail-bytes
	 * represents itself.
	 */
    }
#if TCL_UTF_MAX > 3
    else if (byte < 0xF8) {
	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
	    /*
	     * Four-byte-character lead byte followed by three trail bytes.
	     */
#if TCL_UTF_MAX == 4
#if TCL_UTF_MAX <= 4
	    Tcl_UniChar surrogate;

	    byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
		    | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)) - 0x10000;
	    surrogate = (Tcl_UniChar) (0xD800 + (byte >> 10));
	    if (byte & 0x100000) {
		/* out of range, < 0x10000 or > 0x10ffff */
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
384
385
386
387
388
389
390

391
392
393
394
395
396
397







-







	}

	/*
	 * A four-byte-character lead-byte not followed by two trail-bytes
	 * represents itself.
	 */
    }
#endif

    *chPtr = (Tcl_UniChar) byte;
    return 1;
}

/*
 *---------------------------------------------------------------------------
394
395
396
397
398
399
400
401

402
403
404
405
406
407
408
409
410
411
412
413
414
415

416
417

418
419
420

421
422


423











424
425
426
427
428

429
430
431
432
433
434
435
416
417
418
419
420
421
422

423
424
425
426
427
428
429
430
431
432
433
434
435
436

437
438

439
440
441
442
443


444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461

462
463
464
465
466
467
468
469







-
+













-
+

-
+



+
-
-
+
+

+
+
+
+
+
+
+
+
+
+
+




-
+







    const char *src,		/* UTF-8 string to convert to Unicode. */
    int length,			/* Length of UTF-8 string in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
    Tcl_UniChar ch, *w, *wString;
    Tcl_UniChar ch = 0, *w, *wString;
    const char *p, *end;
    int oldLength;

    if (length < 0) {
	length = strlen(src);
    }

    /*
     * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in
     * bytes.
     */

    oldLength = Tcl_DStringLength(dsPtr);
/* TODO: fix overreach! */

    Tcl_DStringSetLength(dsPtr,
	    (int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
	    oldLength + (int) ((length + 1) * sizeof(Tcl_UniChar)));
    wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);

    w = wString;
    p = src;
    end = src + length;
    for (p = src; p < end; ) {
    end = src + length - 4;
    while (p < end) {
	p += TclUtfToUniChar(p, &ch);
	*w++ = ch;
    }
    end += 4;
    while (p < end) {
	if (Tcl_UtfCharComplete(p, end-p)) {
	    p += TclUtfToUniChar(p, &ch);
	} else if ((unsigned)((UCHAR(*p)-0x80)) < (unsigned) 0x20) {
	    ch = (Tcl_UniChar) cp1252[UCHAR(*p++)-0x80];
	} else {
	    ch = UCHAR(*p++);
	}
	*w++ = ch;
    }
    *w = '\0';
    Tcl_DStringSetLength(dsPtr,
	    (oldLength + ((char *) w - (char *) wString)));
	    oldLength + ((char *) w - (char *) wString));

    return wString;
}

/*
 *---------------------------------------------------------------------------
 *
495
496
497
498
499
500
501
502

503
504
505
506
507
508

509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526


527
528
529
530
531


532
533
534
535
536
537
538
539
540
541
542

543
544

545
546
547
548







549

550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565


566
567
568
569

570
571
572
573
574
575
576
577
578
579
580
581

582
583

584
585
586
587
588
589







590

591
592
593
594
595
596
597
529
530
531
532
533
534
535

536
537
538
539
540
541

542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558


559
560
561
562
563


564
565
566
567
568
569
570
571
572
573
574
575

576
577

578
579
580
581
582
583
584
585
586
587
588
589

590
591
592
593
594
595
596
597
598
599
600
601
602
603
604


605
606
607
608
609

610
611
612
613
614
615
616
617
618
619
620
621

622
623

624
625
626
627
628
629
630
631
632
633
634
635
636
637

638
639
640
641
642
643
644
645







-
+





-
+
















-
-
+
+



-
-
+
+










-
+

-
+




+
+
+
+
+
+
+
-
+














-
-
+
+



-
+











-
+

-
+






+
+
+
+
+
+
+
-
+







    if (length < 0) {
	while (*src != '\0') {
	    src += TclUtfToUniChar(src, &ch);
	    i++;
	}
	if (i < 0) i = INT_MAX; /* Bug [2738427] */
    } else {
	register const char *endPtr = src + length - TCL_UTF_MAX;
	register const char *endPtr = src + length - 4;

	while (src < endPtr) {
	    src += TclUtfToUniChar(src, &ch);
	    i++;
	}
	endPtr += TCL_UTF_MAX;
	endPtr += 4;
	while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) {
	    src += TclUtfToUniChar(src, &ch);
	    i++;
	}
	if (src < endPtr) {
	    i += endPtr - src;
	}
    }
    return i;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfFindFirst --
 *
 *	Returns a pointer to the first occurance of the given Tcl_UniChar in
 *	the NULL-terminated UTF-8 string. The NULL terminator is considered
 *	Returns a pointer to the first occurance of the given Unicode character
 *	in the NULL-terminated UTF-8 string. The NULL terminator is considered
 *	part of the UTF-8 string. Equivalent to Plan 9 utfrune().
 *
 * Results:
 *	As above. If the Tcl_UniChar does not exist in the given string, the
 *	return value is NULL.
 *	As above. If the Unicode character does not exist in the given string,
 *	the return value is NULL.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfFindFirst(
    const char *src,		/* The UTF-8 string to be searched. */
    int ch)			/* The Tcl_UniChar to search for. */
    int ch)			/* The Unicode character to search for. */
{
    int len;
    int len, fullchar;
    Tcl_UniChar find = 0;

    while (1) {
	len = TclUtfToUniChar(src, &find);
	fullchar = find;
#if TCL_UTF_MAX <= 4
	if (!len) {
	    len += TclUtfToUniChar(src, &find);
	    fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
	}
#endif
	if (find == ch) {
	if (fullchar == ch) {
	    return src;
	}
	if (*src == '\0') {
	    return NULL;
	}
	src += len;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfFindLast --
 *
 *	Returns a pointer to the last occurance of the given Tcl_UniChar in
 *	the NULL-terminated UTF-8 string. The NULL terminator is considered
 *	Returns a pointer to the last occurance of the given Unicode character
 *	in the NULL-terminated UTF-8 string. The NULL terminator is considered
 *	part of the UTF-8 string. Equivalent to Plan 9 utfrrune().
 *
 * Results:
 *	As above. If the Tcl_UniChar does not exist in the given string, the
 *	As above. If the Unicode character does not exist in the given string, the
 *	return value is NULL.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfFindLast(
    const char *src,		/* The UTF-8 string to be searched. */
    int ch)			/* The Tcl_UniChar to search for. */
    int ch)			/* The Unicode character to search for. */
{
    int len;
    int len, fullchar;
    Tcl_UniChar find = 0;
    const char *last;

    last = NULL;
    while (1) {
	len = TclUtfToUniChar(src, &find);
	fullchar = find;
#if TCL_UTF_MAX <= 4
	if (!len) {
	    len += TclUtfToUniChar(src, &find);
	    fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
	}
#endif
	if (find == ch) {
	if (fullchar == ch) {
	    last = src;
	}
	if (*src == '\0') {
	    break;
	}
	src += len;
    }
620
621
622
623
624
625
626
627

628
629
630
631
632
633
634
668
669
670
671
672
673
674

675
676
677
678
679
680
681
682







-
+







const char *
Tcl_UtfNext(
    const char *src)		/* The current location in the string. */
{
    Tcl_UniChar ch = 0;
    int len = TclUtfToUniChar(src, &ch);

#if TCL_UTF_MAX == 4
#if TCL_UTF_MAX <= 4
    if (len == 0) {
      len = TclUtfToUniChar(src, &ch);
    }
#endif
    return src + len;
}

659
660
661
662
663
664
665
666

667
668
669
670
671
672
673
707
708
709
710
711
712
713

714
715
716
717
718
719
720
721







-
+







    const char *start)		/* Pointer to the beginning of the string, to
				 * avoid going backwards too far. */
{
    const char *look;
    int i, byte;

    look = --src;
    for (i = 0; i < TCL_UTF_MAX; i++) {
    for (i = 0; i < 4; i++) {
	if (look < start) {
	    if (src < start) {
		src = start;
	    }
	    break;
	}
	byte = *((unsigned char *) look);
683
684
685
686
687
688
689
690

691
692
693
694
695
696
697
698
699
700
701
702

703
704
705
706
707




708
709
710




711

712








713

714
715
716
717
718
719
720
721
722



723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738

739
740
741







742
743

744
745
746
747
748
749
750
731
732
733
734
735
736
737

738
739
740
741
742
743
744
745
746
747
748
749

750
751
752
753
754
755
756
757
758
759
760


761
762
763
764
765
766
767
768
769
770
771
772
773
774
775

776
777
778
779
780
781
782
783
784

785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805


806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822







-
+











-
+





+
+
+
+

-
-
+
+
+
+

+

+
+
+
+
+
+
+
+
-
+








-
+
+
+
















+

-
-
+
+
+
+
+
+
+


+







}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharAtIndex --
 *
 *	Returns the Unicode character represented at the specified character
 *	Returns the Tcl_UniChar represented at the specified character
 *	(not byte) position in the UTF-8 string.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_UniChar
int
Tcl_UniCharAtIndex(
    register const char *src,	/* The UTF-8 string to dereference. */
    register int index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    int fullchar = 0;
#if TCL_UTF_MAX <= 4
	int len = 1;
#endif

    while (index >= 0) {
	index--;
    while (index-- >= 0) {
#if TCL_UTF_MAX <= 4
	src += (len = TclUtfToUniChar(src, &ch));
#else
	src += TclUtfToUniChar(src, &ch);
#endif
    }
    fullchar = ch;
#if TCL_UTF_MAX <= 4
     if (!len) {
	/* If last Tcl_UniChar was an upper surrogate, combine with lower surrogate */
	(void)TclUtfToUniChar(src, &ch);
	fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
    }
#endif
    return ch;
    return fullchar;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfAtIndex --
 *
 *	Returns a pointer to the specified character (not byte) position in
 *	the UTF-8 string.
 *	the UTF-8 string. If TCL_UTF_MAX <= 4, characters > U+FFFF count as
 *	2 positions, but then the pointer should never be placed between
 *	the two positions.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfAtIndex(
    register const char *src,	/* The UTF-8 string. */
    register int index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    int len = 1;

    while (index > 0) {
	index--;
    while (index-- > 0) {
	len = TclUtfToUniChar(src, &ch);
	src += len;
    }
#if TCL_UTF_MAX <= 4
     if (!len) {
	/* Index points at character following High Surrogate */
	src += TclUtfToUniChar(src, &ch);
    }
#endif
    return src;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfBackslash --
815
816
817
818
819
820
821
822


823
824
825
826
827
828
829
830
831
832









833

834
835
836
837
838
839
840
841

842
843
844
845
846
847
848
887
888
889
890
891
892
893

894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914

915
916
917
918
919
920
921
922

923
924
925
926
927
928
929
930







-
+
+










+
+
+
+
+
+
+
+
+
-
+







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_UtfToUpper(
    char *str)			/* String to convert in place. */
{
    Tcl_UniChar ch = 0, upChar;
    Tcl_UniChar ch = 0;
    int upChar;
    char *src, *dst;
    int bytes;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {
	bytes = TclUtfToUniChar(src, &ch);
	upChar = ch;
#if TCL_UTF_MAX <= 4
	if (!bytes) {
	    /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */
	    bytes = TclUtfToUniChar(src, &ch);
	    /* Combine surrogates */
	    upChar = (((upChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
	}
#endif
	upChar = Tcl_UniCharToUpper(ch);
	upChar = Tcl_UniCharToUpper(upChar);

	/*
	 * To keep badly formed Utf strings from getting inflated by the
	 * conversion (thereby causing a segfault), only copy the upper case
	 * char to dst if its size is <= the original char.
	 */

	if (bytes < TclUtfCount(upChar)) {
	if ((bytes < TclUtfCount(upChar)) || ((upChar & 0xF800) == 0xD800)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(upChar, dst);
	}
	src += bytes;
    }
868
869
870
871
872
873
874
875


876
877
878
879
880
881
882
883
884
885









886

887
888
889
890
891
892
893
894

895
896
897
898
899
900
901
950
951
952
953
954
955
956

957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977

978
979
980
981
982
983
984
985

986
987
988
989
990
991
992
993







-
+
+










+
+
+
+
+
+
+
+
+
-
+







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_UtfToLower(
    char *str)			/* String to convert in place. */
{
    Tcl_UniChar ch = 0, lowChar;
    Tcl_UniChar ch = 0;
    int lowChar;
    char *src, *dst;
    int bytes;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {
	bytes = TclUtfToUniChar(src, &ch);
	lowChar = ch;
#if TCL_UTF_MAX <= 4
	if (!bytes) {
	    /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */
	    bytes = TclUtfToUniChar(src, &ch);
	    /* Combine surrogates */
	    lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
	}
#endif
	lowChar = Tcl_UniCharToLower(ch);
	lowChar = Tcl_UniCharToLower(lowChar);

	/*
	 * To keep badly formed Utf strings from getting inflated by the
	 * conversion (thereby causing a segfault), only copy the lower case
	 * char to dst if its size is <= the original char.
	 */

	if (bytes < TclUtfCount(lowChar)) {
	if ((bytes < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(lowChar, dst);
	}
	src += bytes;
    }
922
923
924
925
926
927
928
929


930
931
932
933
934
935
936
937
938
939
940
941









942

943
944

945
946
947
948
949
950
951
952
953











954
955
956




957
958
959
960
961
962
963
1014
1015
1016
1017
1018
1019
1020

1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043

1044
1045

1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066



1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077







-
+
+












+
+
+
+
+
+
+
+
+
-
+

-
+









+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+







 *----------------------------------------------------------------------
 */

int
Tcl_UtfToTitle(
    char *str)			/* String to convert in place. */
{
    Tcl_UniChar ch = 0, titleChar, lowChar;
    Tcl_UniChar ch = 0;
    int titleChar, lowChar;
    char *src, *dst;
    int bytes;

    /*
     * Capitalize the first character and then lowercase the rest of the
     * characters until we get to a null.
     */

    src = dst = str;

    if (*src) {
	bytes = TclUtfToUniChar(src, &ch);
	titleChar = ch;
#if TCL_UTF_MAX <= 4
	if (!bytes) {
	    /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */
	    bytes = TclUtfToUniChar(src, &ch);
	    /* Combine surrogates */
	    titleChar = (((titleChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
	}
#endif
	titleChar = Tcl_UniCharToTitle(ch);
	titleChar = Tcl_UniCharToTitle(titleChar);

	if (bytes < TclUtfCount(titleChar)) {
	if ((bytes < TclUtfCount(titleChar)) || ((titleChar & 0xF800) == 0xD800)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(titleChar, dst);
	}
	src += bytes;
    }
    while (*src) {
	bytes = TclUtfToUniChar(src, &ch);
	lowChar = ch;
#if TCL_UTF_MAX <= 4
	if (!bytes) {
	    /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */
	    bytes = TclUtfToUniChar(src, &ch);
	    /* Combine surrogates */
	    lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
	}
#endif
	/* Special exception for Georgian Asomtavruli chars, no titlecase. */
	if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
	lowChar = Tcl_UniCharToLower(ch);

	if (bytes < TclUtfCount(lowChar)) {
	    lowChar = Tcl_UniCharToLower(lowChar);
	}

	if ((bytes < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(lowChar, dst);
	}
	src += bytes;
    }
1049
1050
1051
1052
1053
1054
1055










1056
1057
1058
1059
1060
1061
1062
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186







+
+
+
+
+
+
+
+
+
+







	 * only when both strings are of at least n chars long (no need for \0
	 * check)
	 */

	cs += TclUtfToUniChar(cs, &ch1);
	ct += TclUtfToUniChar(ct, &ch2);
	if (ch1 != ch2) {
#if TCL_UTF_MAX <= 4
	    /* Surrogates always report higher than non-surrogates */
	    if (((ch1 & 0xFC00) == 0xD800)) {
	    if ((ch2 & 0xFC00) != 0xD800) {
		return ch1;
	    }
	    } else if ((ch2 & 0xFC00) == 0xD800) {
		return -ch2;
	    }
#endif
	    return (ch1 - ch2);
	}
    }
    return 0;
}

/*
1080
1081
1082
1083
1084
1085
1086

1087
1088
1089
1090
1091
1092
1093
1094
1095










1096
1097
1098
1099
1100
1101
1102
1103
1104
1105

1106
1107
1108
1109















































1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130

1131

1132
1133
1134










1135
1136
1137
1138
1139
1140
1141
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239

1240
1241
1242
1243

1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309


1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332







+









+
+
+
+
+
+
+
+
+
+









-
+



-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



















-
-
+

+



+
+
+
+
+
+
+
+
+
+







int
Tcl_UtfNcasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    unsigned long numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes.
	 * This should be called only when both strings are of
	 * at least n chars long (no need for \0 check)
	 */
	cs += TclUtfToUniChar(cs, &ch1);
	ct += TclUtfToUniChar(ct, &ch2);
	if (ch1 != ch2) {
#if TCL_UTF_MAX <= 4
	    /* Surrogates always report higher than non-surrogates */
	    if (((ch1 & 0xFC00) == 0xD800)) {
	    if ((ch2 & 0xFC00) != 0xD800) {
		return ch1;
	    }
	    } else if ((ch2 & 0xFC00) == 0xD800) {
		return -ch2;
	    }
#endif
	    ch1 = Tcl_UniCharToLower(ch1);
	    ch2 = Tcl_UniCharToLower(ch2);
	    if (ch1 != ch2) {
		return (ch1 - ch2);
	    }
	}
    }
    return 0;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_UtfNcasecmp --
 * Tcl_UtfCmp --
 *
 *	Compare UTF chars of string cs to string ct case sensitively.
 *	Replacement for strcmp in Tcl core, in places where UTF-8 should
 *	be handled.
 *
 * Results:
 *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUtfCmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct)		/* UTF string cs is compared to. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    while (*cs && *ct) {
	cs += TclUtfToUniChar(cs, &ch1);
	ct += TclUtfToUniChar(ct, &ch2);
	if (ch1 != ch2) {
#if TCL_UTF_MAX <= 4
	    /* Surrogates always report higher than non-surrogates */
	    if (((ch1 & 0xFC00) == 0xD800)) {
	    if ((ch2 & 0xFC00) != 0xD800) {
		return ch1;
	    }
	    } else if ((ch2 & 0xFC00) == 0xD800) {
		return -ch2;
	    }
#endif
	    return ch1 - ch2;
	}
    }
    return UCHAR(*cs) - UCHAR(*ct);
}


/*
 *----------------------------------------------------------------------
 *
 * TclUtfCasecmp --
 *
 *	Compare UTF chars of string cs to string ct case insensitively.
 *	Replacement for strcasecmp in Tcl core, in places where UTF-8 should
 *	be handled.
 *
 * Results:
 *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUtfCasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct)		/* UTF string cs is compared to. */
{
    while (*cs && *ct) {
	Tcl_UniChar ch1, ch2;
    Tcl_UniChar ch1 = 0, ch2 = 0;

    while (*cs && *ct) {
	cs += TclUtfToUniChar(cs, &ch1);
	ct += TclUtfToUniChar(ct, &ch2);
	if (ch1 != ch2) {
#if TCL_UTF_MAX <= 4
	    /* Surrogates always report higher than non-surrogates */
	    if (((ch1 & 0xFC00) == 0xD800)) {
	    if ((ch2 & 0xFC00) != 0xD800) {
		return ch1;
	    }
	    } else if ((ch2 & 0xFC00) == 0xD800) {
		return -ch2;
	    }
#endif
	    ch1 = Tcl_UniCharToLower(ch1);
	    ch2 = Tcl_UniCharToLower(ch2);
	    if (ch1 != ch2) {
		return ch1 - ch2;
	    }
	}
    }
1155
1156
1157
1158
1159
1160
1161
1162

1163
1164
1165

1166

1167
1168
1169
1170
1171





1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190

1191
1192
1193

1194


1195
1196
1197
1198
1199





1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218

1219
1220
1221

1222
1223


1224
1225
1226
1227
1228




1229

1230
1231
1232
1233
1234







1235
1236
1237
1238
1239
1240
1241
1346
1347
1348
1349
1350
1351
1352

1353
1354
1355
1356
1357

1358
1359




1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382

1383
1384
1385
1386
1387

1388
1389
1390




1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
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







-
+



+
-
+

-
-
-
-
+
+
+
+
+


















-
+



+
-
+
+

-
-
-
-
+
+
+
+
+


















-
+



+
-
-
+
+

-
-
-
-
+
+
+
+

+
-
-
-
-
-
+
+
+
+
+
+
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar
int
Tcl_UniCharToUpper(
    int ch)			/* Unicode character to convert. */
{
    if (!UNICODE_OUT_OF_RANGE(ch)) {
    int info = GetUniCharInfo(ch);
	int info = GetUniCharInfo(ch);

    if (GetCaseType(info) & 0x04) {
	ch -= GetDelta(info);
    }
    return (Tcl_UniChar) ch;
	if (GetCaseType(info) & 0x04) {
	    ch -= GetDelta(info);
	}
    }
    return ch & 0x1FFFFF;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharToLower --
 *
 *	Compute the lowercase equivalent of the given Unicode character.
 *
 * Results:
 *	Returns the lowercase Unicode character.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar
int
Tcl_UniCharToLower(
    int ch)			/* Unicode character to convert. */
{
    if (!UNICODE_OUT_OF_RANGE(ch)) {
    int info = GetUniCharInfo(ch);
	int info = GetUniCharInfo(ch);
	int mode = GetCaseType(info);

    if (GetCaseType(info) & 0x02) {
	ch += GetDelta(info);
    }
    return (Tcl_UniChar) ch;
	if ((mode & 0x02) && (mode != 0x7)) {
	    ch += GetDelta(info);
	}
    }
    return ch & 0x1FFFFF;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharToTitle --
 *
 *	Compute the titlecase equivalent of the given Unicode character.
 *
 * Results:
 *	Returns the titlecase Unicode character.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar
int
Tcl_UniCharToTitle(
    int ch)			/* Unicode character to convert. */
{
    if (!UNICODE_OUT_OF_RANGE(ch)) {
    int info = GetUniCharInfo(ch);
    int mode = GetCaseType(info);
	int info = GetUniCharInfo(ch);
	int mode = GetCaseType(info);

    if (mode & 0x1) {
	/*
	 * Subtract or add one depending on the original case.
	 */
	if (mode & 0x1) {
	    /*
	     * Subtract or add one depending on the original case.
	     */

	    if (mode != 0x7) {
	ch += ((mode & 0x4) ? -1 : 1);
    } else if (mode == 0x4) {
	ch -= GetDelta(info);
    }
    return (Tcl_UniChar) ch;
		ch += ((mode & 0x4) ? -1 : 1);
	    }
	} else if (mode == 0x4) {
	    ch -= GetDelta(info);
	}
    }
    return ch & 0x1FFFFF;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharLen --
 *
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1561
1562
1563
1564
1565
1566
1567

1568
1569
1570

1571
1572
1573
1574
1575
1576
1577







-



-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsAlnum(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsAlpha --
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1587
1588
1589
1590
1591
1592
1593

1594
1595
1596

1597
1598
1599
1600
1601
1602
1603







-



-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsAlpha(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return ((ALPHA_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsControl --
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
1613
1614
1615
1616
1617
1618
1619

1620
1621
1622
1623
1624
1625
1626
1627
1628
1629

1630
1631
1632
1633
1634
1635
1636







-










-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsControl(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	ch &= 0x1FFFFF;
	if ((ch == 0xE0001) || ((ch >= 0xE0020) && (ch <= 0xE007f))) {
	    return 1;
	}
	if ((ch >= 0xF0000) && ((ch & 0xFFFF) <= 0xFFFD)) {
	    return 1;
	}
	return 0;
    }
#endif
    return ((CONTROL_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsDigit --
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1646
1647
1648
1649
1650
1651
1652

1653
1654
1655

1656
1657
1658
1659
1660
1661
1662







-



-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsDigit(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsGraph --
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1672
1673
1674
1675
1676
1677
1678

1679
1680
1681
1682

1683
1684
1685
1686
1687
1688
1689







-




-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsGraph(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	ch &= 0x1FFFFF;
	return (ch >= 0xE0100) && (ch <= 0xE01EF);
    }
#endif
    return ((GRAPH_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsLower --
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1699
1700
1701
1702
1703
1704
1705

1706
1707
1708

1709
1710
1711
1712
1713
1714
1715







-



-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsLower(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return (GetCategory(ch) == LOWERCASE_LETTER);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsPrint --
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1725
1726
1727
1728
1729
1730
1731

1732
1733
1734
1735

1736
1737
1738
1739
1740
1741
1742







-




-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsPrint(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	ch &= 0x1FFFFF;
	return (ch >= 0xE0100) && (ch <= 0xE01EF);
    }
#endif
    return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsPunct --
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1752
1753
1754
1755
1756
1757
1758

1759
1760
1761

1762
1763
1764
1765
1766
1767
1768







-



-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsPunct(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return ((PUNCT_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsSpace --
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1778
1779
1780
1781
1782
1783
1784

1785
1786




1787
1788
1789
1790
1791
1792
1793
1794

1795
1796

1797
1798
1799
1800
1801
1802
1803







-


-
-
-
-








-


-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsSpace(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    /* Ignore upper 11 bits. */
    ch &= 0x1FFFFF;
#else
    /* Ignore upper 16 bits. */
    ch &= 0xFFFF;
#endif

    /*
     * If the character is within the first 127 characters, just use the
     * standard C function, otherwise consult the Unicode table.
     */

    if (ch < 0x80) {
	return TclIsSpaceProc((char) ch);
#if TCL_UTF_MAX > 3
    } else if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
#endif
    } else if (ch == 0x0085 || ch == 0x180E || ch == 0x200B
	    || ch == 0x202F || ch == 0x2060 || ch == 0xFEFF) {
	return 1;
    } else {
	return ((SPACE_BITS >> GetCategory(ch)) & 1);
    }
}
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1818
1819
1820
1821
1822
1823
1824

1825
1826
1827

1828
1829
1830
1831
1832
1833
1834







-



-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsUpper(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return (GetCategory(ch) == UPPERCASE_LETTER);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsWordChar --
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1844
1845
1846
1847
1848
1849
1850

1851
1852
1853

1854
1855
1856
1857
1858
1859
1860







-



-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsWordChar(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return ((WORD_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharCaseMatch --

Changes to generic/tclUtil.c.

11
12
13
14
15
16
17

18
19
20
21
22
23
24
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25







+







 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclParse.h"
#include "tclStringTrim.h"
#include "tommath.h"
#include <math.h>

/*
 * The absolute pathname of the executable in which this Tcl library is
 * running.
 */

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
128
129
130
131


132
133
134
135
136
137
138
104
105
106
107
108
109
110
111
112
113


114
115

116
117
118
119
120
121
122
123


124
125
126
127
128
129
130
131

132
133
134
135


136
137
138
139
140
141
142
143
144







+
+

-
-
+
+
-








-
-
+
+
+
+
+
+


-
+



-
-
+
+







/*
 * Prototypes for functions defined later in this file.
 */

static void		ClearHash(Tcl_HashTable *tablePtr);
static void		FreeProcessGlobalValue(ClientData clientData);
static void		FreeThreadHash(ClientData clientData);
static int		GetEndOffsetFromObj(Tcl_Obj *objPtr,
			    Tcl_WideInt endValue, Tcl_WideInt *indexPtr);
static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int		SetEndOffsetFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static int		GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Tcl_WideInt endValue, Tcl_WideInt *widePtr);
static void		UpdateStringOfEndOffset(Tcl_Obj *objPtr);
static int		FindElement(Tcl_Interp *interp, const char *string,
			    int stringLength, const char *typeStr,
			    const char *typeCode, const char **elementPtr,
			    const char **nextPtr, int *sizePtr,
			    int *literalPtr);
/*
 * The following is the Tcl object type definition for an object that
 * represents a list index in the form, "end-offset". It is used as a
 * performance optimization in TclGetIntForIndex. The internal rep is an
 * integer, so no memory management is required for it.
 * performance optimization in TclGetIntForIndex. The internal rep is
 * stored directly in the wideValue, so no memory management is required
 * for it. This is a caching intrep, keeping the result of a parse
 * around. This type is only created from a pre-existing string, so an
 * updateStringProc will never be called and need not exist. The type
 * is unregistered, so has no need of a setFromAnyProc either.
 */

const Tcl_ObjType tclEndOffsetType = {
static const Tcl_ObjType endOffsetType = {
    "end-offset",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    UpdateStringOfEndOffset,		/* updateStringProc */
    SetEndOffsetFromAny
    NULL,				/* updateStringProc */
    NULL				/* setFromAnyProc */
};

/*
 *	*	STRING REPRESENTATION OF LISTS	*	*	*
 *
 * The next several routines implement the conversions of strings to and from
 * Tcl lists. To understand their operation, the rules of parsing and
970
971
972
973
974
975
976
977

978
979
980
981
982
983
984
976
977
978
979
980
981
982

983
984
985
986
987
988
989
990







-
+







int
Tcl_ScanCountedElement(
    const char *src,		/* String to convert to Tcl list element. */
    int length,			/* Number of bytes in src, or -1. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    int flags = CONVERT_ANY;
    char flags = CONVERT_ANY;
    int numBytes = TclScanElement(src, length, &flags);

    *flagPtr = flags;
    return numBytes;
}

/*
1011
1012
1013
1014
1015
1016
1017
1018

1019
1020
1021
1022
1023
1024
1025
1017
1018
1019
1020
1021
1022
1023

1024
1025
1026
1027
1028
1029
1030
1031







-
+







 *----------------------------------------------------------------------
 */

int
TclScanElement(
    const char *src,		/* String to convert to Tcl list element. */
    int length,			/* Number of bytes in src, or -1. */
    int *flagPtr)		/* Where to store information to guide
    char *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    const char *p = src;
    int nestingLevel = 0;	/* Brace nesting count */
    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
				 * needs protection or escape. */
    int requireEscape = 0;	/* Force use of CONVERT_ESCAPE mode.  For some
1543
1544
1545
1546
1547
1548
1549
1550
1551


1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588

1589
1590
1591
1592
1593
1594
1595
1549
1550
1551
1552
1553
1554
1555


1556
1557
1558
1559

1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577














1578

1579
1580
1581
1582
1583
1584
1585
1586







-
-
+
+


-


















-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+







 */

char *
Tcl_Merge(
    int argc,			/* How many strings to merge. */
    const char *const *argv)	/* Array of string values. */
{
#define LOCAL_SIZE 20
    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    int i, bytesNeeded = 0;
    char *result, *dst;
    const int maxFlags = UINT_MAX / sizeof(int);

    /*
     * Handle empty list case first, so logic of the general case can be
     * simpler.
     */

    if (argc == 0) {
	result = ckalloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (argc <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else if (argc > maxFlags) {
	/*
	 * We cannot allocate a large enough flag array to format this list in
	 * one pass.  We could imagine converting this routine to a multi-pass
	 * implementation, but for sizeof(int) == 4, the limit is a max of
	 * 2^30 list elements and since each element is at least one byte
	 * formatted, and requires one byte space between it and the next one,
	 * that a minimum space requirement of 2^31 bytes, which is already
	 * INT_MAX. If we tried to format a list of > maxFlags elements, we're
	 * just going to overflow the size limits on the formatted string
	 * anyway, so just issue that same panic early.
	 */

	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    } else {
	flagPtr = ckalloc(argc * sizeof(int));
	flagPtr = ckalloc(argc);
    }
    for (i = 0; i < argc; i++) {
	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
1615
1616
1617
1618
1619
1620
1621

1622
1623
1624
1625
1626
1627
1628
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620







+








    if (flagPtr != localFlags) {
	ckfree(flagPtr);
    }
    return result;
}

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Backslash --
 *
 *	Figure out how to handle a backslash sequence.
 *
1648
1649
1650
1651
1652
1653
1654

1655
1656
1657
1658













1659
1660
1661

























1662
1663


1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675


1676
1677
1678
1679
1680
1681
1682
1683

1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664



1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689


1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701


1702
1703
1704
1705
1706
1707
1708
1709
1710

1711











1712
1713
1714
1715
1716
1717

1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728

1729
1730
1731
1732
1733
1734
1735







+




+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+










-
-
+
+







-
+
-
-
-
-
-
-
-
-
-
-
-






-











-







    char buf[TCL_UTF_MAX];
    Tcl_UniChar ch = 0;

    Tcl_UtfBackslash(src, readPtr, buf);
    TclUtfToUniChar(buf, &ch);
    return (char) ch;
}
#endif /* !TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * UtfWellFormedEnd --
 *	Checks the end of utf string is malformed, if yes - wraps bytes
 *	to the given buffer (as well-formed NTS string).  The buffer
 *	argument should be initialized by the caller and ready to use.
 *
 * Results:
 *	The bytes with well-formed end of the string.
 *
 * Side effects:
 *	Buffer (DString) may be allocated, so must be released.
 *
 *----------------------------------------------------------------------
 */
 * TclTrimRight --
 *
 *	Takes two counted strings in the Tcl encoding which must both be null

static inline const char*
UtfWellFormedEnd(
    Tcl_DString *buffer,	/* Buffer used to hold well-formed string. */
    const char *bytes,		/* Pointer to the beginning of the string. */
    int length)			/* Length of the string. */
{
    const char *l = bytes + length;
    const char *p = Tcl_UtfPrev(l, bytes);

    if (Tcl_UtfCharComplete(p, l - p)) {
	return bytes;
    }
    /*
     * Malformed utf-8 end, be sure we've NTS to safe compare of end-character,
     * avoid segfault by access violation out of range.
     */
    Tcl_DStringAppend(buffer, bytes, length);
    return Tcl_DStringValue(buffer);
}
/*
 *----------------------------------------------------------------------
 *
 * TclTrimRight --
 *	Takes two counted strings in the Tcl encoding.  Conceptually
 *	terminated. Conceptually trims from the right side of the first string
 *	all characters found in the second string.
 *	finds the sub string (offset) to trim from the right side of the
 *	first string all characters found in the second string.
 *
 * Results:
 *	The number of bytes to be removed from the end of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclTrimRight(
static inline int
TrimRight(
    const char *bytes,		/* String to be trimmed... */
    int numBytes,		/* ...and its length in bytes */
    const char *trim,		/* String of trim characters... */
    int numTrim)		/* ...and its length in bytes */
{
    const char *p = bytes + numBytes;
    int pInc;

    Tcl_UniChar ch1 = 0, ch2 = 0;
    if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
	Tcl_Panic("TclTrimRight works only on null-terminated strings");
    }

    /*
     * Empty strings -> nothing to do.
     */

    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    /*
     * Outer loop: iterate over string to be trimmed.
     */

    do {
	Tcl_UniChar ch1;
	const char *q = trim;
	int bytesLeft = numTrim;

	p = Tcl_UtfPrev(p, bytes);
 	pInc = TclUtfToUniChar(p, &ch1);

	/*
	 * Inner loop: scan trim string for match to current character.
	 */

	do {
	    Tcl_UniChar ch2;
	    int qInc = TclUtfToUniChar(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
1729
1730
1731
1732
1733
1734
1735































1736
1737
1738
1739
1740
1741
1742
1743
1744



1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756


1757
1758
1759
1760
1761
1762
1763

1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812

1813
1814
1815

























































































1816
1817
1818
1819
1820
1821
1822
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787



1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800


1801
1802
1803
1804
1805
1806
1807
1808

1809











1810
1811
1812
1813
1814
1815

1816
1817
1818
1819
1820
1821
1822
1823
1824

1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844

1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
+
+
+










-
-
+
+






-
+
-
-
-
-
-
-
-
-
-
-
-






-









-




















-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    p += pInc;
	    break;
	}
    } while (p > bytes);

    return numBytes - (p - bytes);
}

int
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    int numTrim)	/* ...and its length in bytes */
{
    int res;
    Tcl_DString bytesBuf, trimBuf;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    Tcl_DStringInit(&bytesBuf);
    Tcl_DStringInit(&trimBuf);
    bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
    trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);

    res = TrimRight(bytes, numBytes, trim, numTrim);
    if (res > numBytes) {
	res = numBytes;
    }

    Tcl_DStringFree(&bytesBuf);
    Tcl_DStringFree(&trimBuf);

    return res;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTrimLeft --
 *
 *	Takes two counted strings in the Tcl encoding which must both be null
 *	terminated. Conceptually trims from the left side of the first string
 *	all characters found in the second string.
 *	Takes two counted strings in the Tcl encoding.  Conceptually
 *	finds the sub string (offset) to trim from the left side of the
 *	first string all characters found in the second string.
 *
 * Results:
 *	The number of bytes to be removed from the start of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclTrimLeft(
static inline int
TrimLeft(
    const char *bytes,		/* String to be trimmed... */
    int numBytes,		/* ...and its length in bytes */
    const char *trim,		/* String of trim characters... */
    int numTrim)		/* ...and its length in bytes */
{
    const char *p = bytes;

	Tcl_UniChar ch1 = 0, ch2 = 0;
    if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
	Tcl_Panic("TclTrimLeft works only on null-terminated strings");
    }

    /*
     * Empty strings -> nothing to do.
     */

    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    /*
     * Outer loop: iterate over string to be trimmed.
     */

    do {
	Tcl_UniChar ch1;
	int pInc = TclUtfToUniChar(p, &ch1);
	const char *q = trim;
	int bytesLeft = numTrim;

	/*
	 * Inner loop: scan trim string for match to current character.
	 */

	do {
	    Tcl_UniChar ch2;
	    int qInc = TclUtfToUniChar(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;
	} while (bytesLeft);

	if (bytesLeft == 0) {
	    /*
	     * No match; trim task done; *p is first non-trimmed char.
	     */

	    break;
	}

	p += pInc;
	numBytes -= pInc;
    } while (numBytes);
    } while (numBytes > 0);

    return p - bytes;
}

int
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    int numTrim)	/* ...and its length in bytes */
{
    int res;
    Tcl_DString bytesBuf, trimBuf;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    Tcl_DStringInit(&bytesBuf);
    Tcl_DStringInit(&trimBuf);
    bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
    trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);

    res = TrimLeft(bytes, numBytes, trim, numTrim);
    if (res > numBytes) {
	res = numBytes;
    }

    Tcl_DStringFree(&bytesBuf);
    Tcl_DStringFree(&trimBuf);

    return res;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTrim --
 *	Finds the sub string (offset) to trim from both sides of the
 *	first string all characters found in the second string.
 *
 * Results:
 *	The number of bytes to be removed from the start of the string
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclTrim(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    int numTrim,	/* ...and its length in bytes */
    int *trimRight)		/* Offset from the end of the string. */
{
    int trimLeft;
    Tcl_DString bytesBuf, trimBuf;

    *trimRight = 0;
    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    Tcl_DStringInit(&bytesBuf);
    Tcl_DStringInit(&trimBuf);
    bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
    trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);

    trimLeft = TrimLeft(bytes, numBytes, trim, numTrim);
    if (trimLeft > numBytes) {
	trimLeft = numBytes;
    }
    numBytes -= trimLeft;
    /* have to trim yet (first char was already verified within TrimLeft) */
    if (numBytes > 1) {
	bytes += trimLeft;
	*trimRight = TrimRight(bytes, numBytes, trim, numTrim);
	if (*trimRight > numBytes) {
	    *trimRight = numBytes;
	}
    }

    Tcl_DStringFree(&bytesBuf);
    Tcl_DStringFree(&trimBuf);

    return trimLeft;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Concat --
 *
 *	Concatenate a set of strings into a single large string.
1876
1877
1878
1879
1880
1881
1882
1883

1884
1885
1886
1887
1888
1889
1890

1891
1892
1893
1894
1895
1896




1897
1898
1899
1900

1901
1902
1903
1904
1905

1906
1907
1908
1909
1910
1911
1912
1913
1998
1999
2000
2001
2002
2003
2004

2005
2006
2007
2008
2009
2010


2011






2012
2013
2014
2015
2016



2017





2018

2019
2020
2021
2022
2023
2024
2025







-
+





-
-
+
-
-
-
-
-
-
+
+
+
+

-
-
-
+
-
-
-
-
-
+
-







    /*
     * All element bytes + (argc - 1) spaces + 1 terminating NULL.
     */

    result = ckalloc((unsigned) (bytesNeeded + argc));

    for (p = result, i = 0;  i < argc;  i++) {
	int trim, elemLength;
	int triml, trimr, elemLength;
	const char *element;

	element = argv[i];
	elemLength = strlen(argv[i]);

	/*
	 * Trim away the leading whitespace.
	/* Trim away the leading/trailing whitespace. */
	 */

	trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE);
	element += trim;
	elemLength -= trim;
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;
	elemLength -= triml + trimr;

	/*
	 * Trim away the trailing whitespace. Do not permit trimming to expose
	 * a final backslash character.
	/* Do not permit trimming to expose a final backslash character. */
	 */

	trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE);
	trim -= trim && (element[elemLength - trim - 1] == '\\');
	elemLength += trimr && (element[elemLength - 1] == '\\');
	elemLength -= trim;

	/*
	 * If we're left with empty element after trimming, do nothing.
	 */

	if (elemLength == 0) {
	    continue;
2019
2020
2021
2022
2023
2024
2025
2026

2027
2028
2029
2030
2031

2032
2033
2034
2035
2036
2037




2038
2039
2040
2041

2042
2043
2044
2045
2046

2047
2048
2049
2050
2051
2052
2053
2054
2131
2132
2133
2134
2135
2136
2137

2138
2139
2140
2141


2142






2143
2144
2145
2146
2147



2148





2149

2150
2151
2152
2153
2154
2155
2156







-
+



-
-
+
-
-
-
-
-
-
+
+
+
+

-
-
-
+
-
-
-
-
-
+
-







     */

    TclNewObj(resPtr);
    (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
    Tcl_SetObjLength(resPtr, 0);

    for (i = 0;  i < objc;  i++) {
	int trim;
	int triml, trimr;

	element = TclGetStringFromObj(objv[i], &elemLength);

	/*
	 * Trim away the leading whitespace.
	/* Trim away the leading/trailing whitespace. */
	 */

	trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE);
	element += trim;
	elemLength -= trim;
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;
	elemLength -= triml + trimr;

	/*
	 * Trim away the trailing whitespace. Do not permit trimming to expose
	 * a final backslash character.
	/* Do not permit trimming to expose a final backslash character. */
	 */

	trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE);
	trim -= trim && (element[elemLength - trim - 1] == '\\');
	elemLength += trimr && (element[elemLength - 1] == '\\');
	elemLength -= trim;

	/*
	 * If we're left with empty element after trimming, do nothing.
	 */

	if (elemLength == 0) {
	    continue;
2118
2119
2120
2121
2122
2123
2124
2125

2126
2127
2128
2129
2130
2131
2132
2220
2221
2222
2223
2224
2225
2226

2227
2228
2229
2230
2231
2232
2233
2234







-
+







    const char *str,		/* String. */
    const char *pattern,	/* Pattern, which may contain special
				 * characters. */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    int p, charLen;
    const char *pstart = pattern;
    Tcl_UniChar ch1, ch2;
    Tcl_UniChar ch1 = 0, ch2 = 0;

    while (1) {
	p = *pattern;

	/*
	 * See if we're at the end of both the pattern and the string. If so,
	 * we succeeded. If we're at the end of the pattern but not at the end
2228
2229
2230
2231
2232
2233
2234
2235

2236
2237
2238
2239
2240
2241
2242
2330
2331
2332
2333
2334
2335
2336

2337
2338
2339
2340
2341
2342
2343
2344







-
+







	/*
	 * Check for a "[" as the next pattern character. It is followed by a
	 * list of characters that are acceptable, or by a range (two
	 * characters separated by "-").
	 */

	if (p == '[') {
	    Tcl_UniChar startChar, endChar;
	    Tcl_UniChar startChar = 0, endChar = 0;

	    pattern++;
	    if (UCHAR(*str) < 0x80) {
		ch1 = (Tcl_UniChar)
			(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
		str++;
	    } else {
2541
2542
2543
2544
2545
2546
2547
2548


2549
2550
2551
2552
2553
2554
2555
2643
2644
2645
2646
2647
2648
2649

2650
2651
2652
2653
2654
2655
2656
2657
2658







-
+
+








    if ((strObj->typePtr == &tclStringType) || (strObj->typePtr == NULL)) {
	Tcl_UniChar *udata, *uptn;

	udata = Tcl_GetUnicodeFromObj(strObj, &length);
	uptn  = Tcl_GetUnicodeFromObj(ptnObj, &plen);
	match = TclUniCharMatch(udata, length, uptn, plen, flags);
    } else if (TclIsPureByteArray(strObj) && !flags) {
    } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
		&& !flags) {
	unsigned char *data, *ptn;

	data = Tcl_GetByteArrayFromObj(strObj, &length);
	ptn  = Tcl_GetByteArrayFromObj(ptnObj, &plen);
	match = TclByteArrayMatch(data, length, ptn, plen, 0);
    } else {
	match = Tcl_StringCaseMatch(TclGetString(strObj),
2713
2714
2715
2716
2717
2718
2719
2720

2721
2722
2723
2724
2725
2726
2727
2816
2817
2818
2819
2820
2821
2822

2823
2824
2825
2826
2827
2828
2829
2830







-
+







Tcl_DStringAppendElement(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *element)	/* String to append. Must be
				 * null-terminated. */
{
    char *dst = dsPtr->string + dsPtr->length;
    int needSpace = TclNeedSpace(dsPtr->string, dst);
    int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
    char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
    int newSize = dsPtr->length + needSpace
	    + TclScanElement(element, -1, &flags);

    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again. SPECIAL NOTE: must use
2919
2920
2921
2922
2923
2924
2925

2926
2927


2928
2929
2930

2931









































































2932
2933
2934
2935
2936
2937
2938
3022
3023
3024
3025
3026
3027
3028
3029


3030
3031
3032
3033

3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115







+
-
-
+
+


-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
#ifdef TCL_NO_DEPRECATED
    int length;
    char *bytes = TclGetStringFromObj(Tcl_GetObjResult(interp), &length);
    Tcl_Obj *obj = Tcl_GetObjResult(interp);
    const char *bytes = TclGetString(obj);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, length);
    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);
#else
    Interp *iPtr = (Interp *) interp;

    if (dsPtr->string != dsPtr->staticSpace) {
	ckfree(dsPtr->string);
    }

    /*
     * Do more efficient transfer when we know the result is a Tcl_Obj. When
     * there's no string result, we only have to deal with two cases:
     *
     *  1. When the string rep is the empty string, when we don't copy but
     *     instead use the staticSpace in the DString to hold an empty string.

     *  2. When the string rep is not there or there's a real string rep, when
     *     we use Tcl_GetString to fetch (or generate) the string rep - which
     *     we know to have been allocated with ckalloc() - and use it to
     *     populate the DString space. Then, we free the internal rep. and set
     *     the object's string representation back to the canonical empty
     *     string.
     */

    if (!iPtr->result[0] && iPtr->objResultPtr
	    && !Tcl_IsShared(iPtr->objResultPtr)) {
	if (iPtr->objResultPtr->bytes == &tclEmptyString) {
	    dsPtr->string = dsPtr->staticSpace;
	    dsPtr->string[0] = 0;
	    dsPtr->length = 0;
	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
	} else {
	    dsPtr->string = TclGetString(iPtr->objResultPtr);
	    dsPtr->length = iPtr->objResultPtr->length;
	    dsPtr->spaceAvl = dsPtr->length + 1;
	    TclFreeIntRep(iPtr->objResultPtr);
	    iPtr->objResultPtr->bytes = &tclEmptyString;
	    iPtr->objResultPtr->length = 0;
	}
	return;
    }

    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */

    (void) Tcl_GetStringResult(interp);

    dsPtr->length = strlen(iPtr->result);
    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    dsPtr->string = iPtr->result;
	    dsPtr->spaceAvl = dsPtr->length+1;
	} else {
	    dsPtr->string = ckalloc(dsPtr->length+1);
	    memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
	    iPtr->freeProc(iPtr->result);
	}
	dsPtr->spaceAvl = dsPtr->length+1;
	iPtr->freeProc = NULL;
    } else {
	if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
	    dsPtr->string = dsPtr->staticSpace;
	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
	} else {
	    dsPtr->string = ckalloc(dsPtr->length+1);
	    dsPtr->spaceAvl = dsPtr->length + 1;
	}
	memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
#endif /* !TCL_NO_DEPRECATED */
}

/*
 *----------------------------------------------------------------------
 *
 * TclDStringToObj --
 *
3237
3238
3239
3240
3241
3242
3243

3244
3245
3246
3247
3248
3249
3250
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428







+







 *	If the new value doesn't make sense then this function undoes the
 *	effect of the variable modification. Otherwise it modifies the format
 *	string that's used by Tcl_PrintDouble.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	/* ARGSUSED */
char *
TclPrecTraceProc(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
3294
3295
3296
3297
3298
3299
3300

3301
3302
3303
3304
3305
3306
3307
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486







+







	    || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK
	    || prec < 0 || prec > TCL_MAX_PREC) {
	return (char *) "improper value for precision";
    }
    *precisionPtr = prec;
    return NULL;
}
#endif /* !TCL_NO_DEPRECATED)*/

/*
 *----------------------------------------------------------------------
 *
 * TclNeedSpace --
 *
 *	This function checks to see whether it is appropriate to add a space
3411
3412
3413
3414
3415
3416
3417
3418

3419
3420

3421
3422
3423
3424
3425
3426
3427
3590
3591
3592
3593
3594
3595
3596

3597
3598

3599
3600
3601
3602
3603
3604
3605
3606







-
+

-
+







 *----------------------------------------------------------------------
 */

int
TclFormatInt(
    char *buffer,		/* Points to the storage into which the
				 * formatted characters are written. */
    long n)			/* The integer to format. */
    Tcl_WideInt n)			/* The integer to format. */
{
    long intVal;
	Tcl_WideInt intVal;
    int i;
    int numFormatted, j;
    const char *digits = "0123456789";

    /*
     * Check first whether "n" is zero.
     */
3436
3437
3438
3439
3440
3441
3442
3443

3444
3445
3446
3447
3448
3449
3450
3615
3616
3617
3618
3619
3620
3621

3622
3623
3624
3625
3626
3627
3628
3629







-
+







     * Check whether "n" is the maximum negative value. This is -2^(m-1) for
     * an m-bit word, and has no positive equivalent; negating it produces the
     * same value.
     */

    intVal = -n;			/* [Bug 3390638] Workaround for*/
    if (n == -n || intVal == n) {	/* broken compiler optimizers. */
	return sprintf(buffer, "%ld", n);
	return sprintf(buffer, "%" TCL_LL_MODIFIER "d", n);
    }

    /*
     * Generate the characters of the result backwards in the buffer.
     */

    intVal = (n < 0? -n : n);
3473
3474
3475
3476
3477
3478
3479








































































































































































































3480
3481
3482
3483
3484



3485
3486
3487


3488
3489
3490


3491
3492
3493
3494
3495



3496
3497
3498


3499
3500
3501
3502



3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521

3522
3523
3524
3525


3526
3527
3528
3529
3530
3531
3532
3533

3534
3535

3536
3537
3538

3539
3540
3541
3542

3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576








3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635

3636
3637
3638


3639
3640
3641

3642
3643
3644

3645
3646
3647
3648
3649
3650
3651

3652
3653





3654
3655
3656
3657





3658








3659
3660
3661
3662
3663
3664
3665
3666
3667
3668



















































































3669
3670














3671
3672
3673















3674
3675
3676
3677
3678
3679



3680
3681
3682



3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693











































3694
3695
3696
3697
3698

3699
3700
3701


3702
3703
3704
3705
3706
3707
3708
3709
3710
























































3711
3712
3713
3714
3715





















3716

















3717

3718
3719
3720


3721
3722
3723
3724
3725
3726













3727
3728
3729
3730
3731
3732
3733
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860



3861
3862
3863
3864


3865
3866



3867
3868





3869
3870
3871



3872
3873




3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891




3892




3893
3894








3895
3896

3897



3898




3899


































3900
3901
3902
3903
3904
3905
3906
3907



















3908
3909






































3910
3911


3912
3913
3914
3915

3916
3917
3918

3919

3920
3921
3922
3923
3924

3925


3926
3927
3928
3929
3930
3931



3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945










3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028


4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042



4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057






4058
4059
4060



4061
4062
4063











4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106





4107



4108
4109









4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165





4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204

4205



4206
4207
4208





4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
+
+
+

-
-
+
+
-
-
-
+
+
-
-
-
-
-
+
+
+
-
-
-
+
+
-
-
-
-
+
+
+















-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+

-
+
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
+
+


-
+


-
+
-





-
+
-
-
+
+
+
+
+

-
-
-
+
+
+
+
+

+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
-
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







    }
    return numFormatted;
}

/*
 *----------------------------------------------------------------------
 *
 * GetWideForIndex --
 *
 *	This function produces a wide integer value corresponding to the
 *	index value held in *objPtr. The parsing supports all values
 *	recognized as any size of integer, and the syntaxes end[-+]$integer
 *	and $integer[-+]$integer. The argument endValue is used to give
 *	the meaning of the literal index value "end". Index arithmetic
 *	on arguments outside the wide integer range are only accepted
 *	when interp is a working interpreter, not NULL.
 *
 * Results:
 *	When parsing of *objPtr successfully recognizes an index value,
 *	TCL_OK is returned, and the wide integer value corresponding to
 *	the recognized index value is written to *widePtr. When parsing
 *	fails, TCL_ERROR is returned and error information is written to
 *	interp, if non-NULL.
 *
 * Side effects:
 *	The type of *objPtr may change.
 *
 *----------------------------------------------------------------------
 */

static int
GetWideForIndex(
    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
                                 * objPtr holds "end".
				 * NOTE: this value may be negative. */
    Tcl_WideInt *widePtr)       /* Location filled in with a wide integer
                                 * representing an index. */
{
    ClientData cd;
    const char *opPtr;
    int numType, length, t1 = 0, t2 = 0;
    int code = TclGetNumberFromObj(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)(*(Tcl_WideInt *)cd);
	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */
	    if (mp_isneg((mp_int *)cd)) {
		*widePtr = WIDE_MIN;
	    } else {
		*widePtr = WIDE_MAX;
	    }
	    return TCL_OK;
	}
	/* Must be a double -> not a valid index */
	goto parseError;
    }

    /* objPtr does not hold a number, check the end+/- format... */
    if (GetEndOffsetFromObj(objPtr, endValue, widePtr) == TCL_OK) {
	return TCL_OK;
    }

    /* If we reach here, the string rep of objPtr exists. */

    /*
     * The valid index syntax does not include any value that is
     * a list of more than one element. This is necessary so that
     * lists of index values can be reliably distinguished from any
     * single index value.
     */

    /*
     * Quick scan to see if multi-value list is even possible.
     * This relies on TclGetString() returning a NUL-terminated string.
     */
    if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1)

	    /* If it's possible, do the full list parse. */
            && (TCL_OK == Tcl_ListObjLength(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, -1, &opPtr,
            TCL_PARSE_INTEGER_ONLY)) {
	Tcl_WideInt w1=0, w2=0;

	/* value starts with valid integer... */

        if ((*opPtr == '-') || (*opPtr == '+')) {
	    /* ... value continues with [-+] ... */

	    /* Save first integer as wide if possible */
	    TclGetNumberFromObj(NULL, objPtr, &cd, &t1);
	    if (t1 == TCL_NUMBER_INT) {
		w1 = (*(Tcl_WideInt *)cd);
	    }

	    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1,
		    -1, NULL, TCL_PARSE_INTEGER_ONLY)) {
		/* ... value concludes with second valid integer */

		/* Save second integer as wide if possible */
		TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
		if (t2 == TCL_NUMBER_INT) {
		    w2 = (*(Tcl_WideInt *)cd);
		}
	    }
        }
	/* Clear invalid intreps left by TclParseNumber */
	TclFreeIntRep(objPtr);

	if (t1 && t2) {
	    /* We have both integer values */
	    if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) {
		/* Both are wide, do wide-integer math */
		if (*opPtr == '-') {
		    if ((w2 == WIDE_MIN) && (interp != NULL)) {
			goto extreme;
		    }
		    w2 = -w2;
		}

		if ((w1 ^ w2) < 0) {
		    /* Different signs, sum cannot overflow */
		    *widePtr = w1 + w2;
		} else if (w1 >= 0) {
		    if (w1 < WIDE_MAX - w2) {
			*widePtr = w1 + w2;
		    } else {
			*widePtr = WIDE_MAX;
		    }
		} else {
		    if (w1 > WIDE_MIN - w2) {
			*widePtr = w1 + w2;
		    } else {
			*widePtr = WIDE_MIN;
		    }
		}
	    } else if (interp == NULL) {
		/*
		 * We use an interp to do bignum index calculations.
		 * If we don't get one, call all indices with bignums errors,
		 * and rely on callers to handle it.
		 */
		return TCL_ERROR;
	    } else {
		/*
		 * At least one is big, do bignum math. Little reason to
		 * value performance here. Re-use code.  Parse has verified
		 * objPtr is an expression. Compute it.
		 */

		Tcl_Obj *sum;

	    extreme:
		Tcl_ExprObj(interp, objPtr, &sum);
		TclGetNumberFromObj(NULL, sum, &cd, &numType);

		if (numType == TCL_NUMBER_INT) {
		    /* sum holds an integer in the signed wide range */
		    *widePtr = (Tcl_WideInt)(*(Tcl_WideInt *)cd);
		} else {
		    /* sum holds an integer outside the signed wide range */
		    /* Truncate to the signed wide range. */
		    if (mp_isneg((mp_int *)cd)) {
			*widePtr = WIDE_MIN;
		    } else {
			*widePtr = WIDE_MAX;
		    }
		}
		Tcl_DecrRefCount(sum);
	    }
	    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;
        }
        TclCheckBadOctal(interp, bytes);
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetIntForIndex --
 *
 *	Provides an integer corresponding to the list index held in a Tcl
 *	object. The string value 'objPtr' is expected have the format
 *	integer([+-]integer)? or end([+-]integer)?.
 *	This function returns an integer corresponding to the list index held
 *	in a Tcl object. The Tcl object's value is expected to be in the
 *	format integer([+-]integer)? or the format end([+-]integer)?.
 *
 * Value
 * 	TCL_OK
 * Results:
 *	The return value is normally TCL_OK, which means that the index was
 *      
 * 	    The index is stored at the address given by by 'indexPtr'. If
 * 	    'objPtr' has the value "end", the value stored is 'endValue'.
 *	successfully stored into the location referenced by "indexPtr". If the
 *	Tcl object referenced by "objPtr" has the value "end", the value
 * 
 * 	TCL_ERROR
 *      
 * 	    The value of 'objPtr' does not have one of the expected formats. If
 * 	    'interp' is non-NULL, an error message is left in the interpreter's
 *	stored is "endValue". If "objPtr"s values is not of one of the
 *	expected formats, TCL_ERROR is returned and, if "interp" is non-NULL,
 *	an error message is left in the interpreter's result object.
 * 	    result object.
 * 
 * Effect
 *
 * Side effects:
 * 
 * 	The object referenced by 'objPtr' is converted, as needed, to an
 * 	integer, wide integer, or end-based-index object.
 * 
 *	The object referenced by "objPtr" might be converted to an integer,
 *	wide integer, or end-based-index object.
 *
 *----------------------------------------------------------------------
 */

int
TclGetIntForIndex(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
				 * or an integer. */
    int endValue,		/* The value to be stored at "indexPtr" if
				 * "objPtr" holds "end". */
    int *indexPtr)		/* Location filled in with an integer
				 * representing an index. */
{
    size_t length;
    char *opPtr;
    const char *bytes;

    Tcl_WideInt wide;
    if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
	return TCL_OK;
    }


    if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
    if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
	/*
	 * If the object is already an offset from the end of the list, or can
	 * be converted to one, use it.
	 */

	*indexPtr = endValue + objPtr->internalRep.longValue;
	return TCL_OK;
	return TCL_ERROR;
    }

    if (wide < INT_MIN) {
    bytes = TclGetString(objPtr);
    length = objPtr->length;

	*indexPtr = INT_MIN;
    /*
     * Leading whitespace is acceptable in an index.
     */

    } else if (wide > INT_MAX) {
    while (length && TclIsSpaceProc(*bytes)) {
	bytes++;
	length--;
    }

    if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr,
	    TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
	int code, first, second;
	char savedOp = *opPtr;

	if ((savedOp != '+') && (savedOp != '-')) {
	    goto parseError;
	}
	if (TclIsSpaceProc(opPtr[1])) {
	    goto parseError;
	}
	*opPtr = '\0';
	code = Tcl_GetInt(interp, bytes, &first);
	*opPtr = savedOp;
	if (code == TCL_ERROR) {
	    goto parseError;
	}
	if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) {
	    goto parseError;
	}
	if (savedOp == '+') {
	    *indexPtr = first + second;
	} else {
	    *indexPtr = first - second;
	}
	return TCL_OK;
    }

    /*
	*indexPtr = INT_MAX;
    } else {
	*indexPtr = (int) wide;
    }
    return TCL_OK;
}

/*
     * Report a parse error.
     */

  parseError:
    if (interp != NULL) {
	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", NULL);
    }

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfEndOffset --
 *
 *	Update the string rep of a Tcl object holding an "end-offset"
 *	expression.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores a valid string in the object's string rep.
 *
 * This function does NOT free any earlier string rep. If it is called on an
 * object that already has a valid string rep, it will leak memory.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfEndOffset(
    register Tcl_Obj *objPtr)
{
    char buffer[TCL_INTEGER_SPACE + 5];
    register int len = 3;

    memcpy(buffer, "end", 4);
    if (objPtr->internalRep.longValue != 0) {
	buffer[len++] = '-';
	len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
    }
    objPtr->bytes = ckalloc((unsigned) len+1);
    memcpy(objPtr->bytes, buffer, (unsigned) len+1);
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------
 *
 * SetEndOffsetFromAny --
 * GetEndOffsetFromObj --
 *
 *	Look for a string of the form "end[+-]offset" and convert it to an
 *	internal representation holding the offset.
 *      Look for a string of the form "end[+-]offset" and convert it to an
 *      internal representation holding the offset.
 *
 * Results:
 *	Returns TCL_OK if ok, TCL_ERROR if the string was badly formed.
 *      Tcl return code.
 *
 * Side effects:
 *	If interp is not NULL, stores an error message in the interpreter
 *      May store a Tcl_ObjType.
 *	result.
 *
 *----------------------------------------------------------------------
 */

static int
SetEndOffsetFromAny(
GetEndOffsetFromObj(
    Tcl_Interp *interp,		/* Tcl interpreter or NULL */
    Tcl_Obj *objPtr)		/* Pointer to the object to parse */
    Tcl_Obj *objPtr,            /* Pointer to the object to parse */
    Tcl_WideInt endValue,       /* The value to be stored at "indexPtr" if
                                 * "objPtr" holds "end". */
    Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                 * representing an index. */
{
    int offset;			/* Offset in the "end-offset" expression */
    register const char *bytes;	/* String rep of the object */
    int length;			/* Length of the object's string rep */
    Tcl_WideInt offset = 0;	/* Offset in the "end-offset" expression */

    if (objPtr->typePtr != &endOffsetType) {
	int length;
	const char *bytes = TclGetStringFromObj(objPtr, &length);

	if ((length < 3) || (length == 4)) {
	    /* Too short to be "end" or to be "end-$integer" */
	    return TCL_ERROR;
	}
	if ((*bytes != 'e') || (strncmp(bytes, "end", 3) != 0)) {
	    /* Value doesn't start with "end" */
	    return TCL_ERROR;
	}
    /*
     * If it's already the right type, we're fine.
     */

    if (objPtr->typePtr == &tclEndOffsetType) {
	return TCL_OK;
    }

    /*
     * Check for a string rep of the right form.

	if (length > 4) {
	    ClientData cd;
	    int t;

	    /* Parse for the "end-..." or "end+..." formats */

	    if ((bytes[3] != '-') && (bytes[3] != '+')) {
		/* No operator where we need one */
		return TCL_ERROR;
	    }
	    if (TclIsSpaceProc(bytes[4])) {
		/* Space after + or - not permitted. */
		return TCL_ERROR;
	    }

	    /* Parse the integer offset */
	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL,
			bytes+4, length-4, NULL, TCL_PARSE_INTEGER_ONLY)) {
		/* Not a recognized integer format */
		return TCL_ERROR;
	    }

	    /* Got an integer offset; pull it from where parser left it. */
	    TclGetNumberFromObj(NULL, objPtr, &cd, &t);

	    if (t == TCL_NUMBER_BIG) {
		/* Truncate to the signed wide range. */
		if (mp_isneg((mp_int *)cd)) {
		    offset = (bytes[3] == '-') ? WIDE_MAX : WIDE_MIN;
		} else {
		    offset = (bytes[3] == '-') ? WIDE_MIN : WIDE_MAX;
		}
	    } else {
		/* assert (t == TCL_NUMBER_INT); */
		offset = (*(Tcl_WideInt *)cd);
		if (bytes[3] == '-') {
		    offset = (offset == WIDE_MIN) ? WIDE_MAX : -offset;
		}
	    }
	}

	/* Success. Free the old internal rep and set the new one. */
	TclFreeIntRep(objPtr);
	objPtr->internalRep.wideValue = offset;
	objPtr->typePtr = &endOffsetType;
    }

    offset = objPtr->internalRep.wideValue;

    if ((endValue ^ offset) < 0) {
        /* Different signs, sum cannot overflow */
        *widePtr = endValue + offset;
    } else if (endValue >= 0) {
        if (endValue < WIDE_MAX - offset) {
            *widePtr = endValue + offset;
        } else {
            *widePtr = WIDE_MAX;
        }
    } else {
        if (endValue > WIDE_MIN - offset) {
            *widePtr = endValue + offset;
        } else {
            *widePtr = WIDE_MIN;
        }
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIndexEncode --
 *
 *      Parse objPtr to determine if it is an index value. Two cases
 *	are possible.  The value objPtr might be parsed as an absolute
 *	index value in the C signed int range.  Note that this includes
 *	index values that are integers as presented and it includes index
 *      arithmetic expressions. The absolute index values that can be
 *	directly meaningful as an index into either a list or a string are
 *	those integer values >= TCL_INDEX_START (0)
 *	and < TCL_INDEX_AFTER (INT_MAX).
 *      The largest string supported in Tcl 8 has bytelength INT_MAX.
     */

 *      This means the largest supported character length is also INT_MAX,
 *      and the index of the last character in a string of length INT_MAX
 *      is INT_MAX-1.
 *
 *      Any absolute index value parsed outside that range is encoded
 *      using the before and after values passed in by the
 *      caller as the encoding to use for indices that are either
 *      less than or greater than the usable index range. TCL_INDEX_AFTER
 *      is available as a good choice for most callers to use for
 *      after. Likewise, the value TCL_INDEX_BEFORE is good for
 *      most callers to use for before.  Other values are possible
 *      when the caller knows it is helpful in producing its own behavior
 *      for indices before and after the indexed item.
 *
    bytes = TclGetStringFromObj(objPtr, &length);
    if ((*bytes != 'e') || (strncmp(bytes, "end",
	    (size_t)((length > 3) ? 3 : length)) != 0)) {
 *      A token can also be parsed as an end-relative index expression.
 *      All end-relative expressions that indicate an index larger
 *      than end (end+2, end--5) point beyond the end of the indexed
 *      collection, and can be encoded as after.  The end-relative
 *      expressions that indicate an index less than or equal to end
 *      are encoded relative to the value TCL_INDEX_END (-2).  The
 *      index "end" is encoded as -2, down to the index "end-0x7ffffffe"
 *      which is encoded as INT_MIN. Since the largest index into a
 *      string possible in Tcl 8 is 0x7ffffffe, the interpretation of
 *      "end-0x7ffffffe" for that largest string would be 0.  Thus,
 *      if the tokens "end-0x7fffffff" or "end+-0x80000000" are parsed,
 *      they can be encoded with the before value.
 *
 *      These details will require re-examination whenever string and
 *      list length limits are increased, but that will likely also
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad index \"%s\": must be end?[+-]integer?", bytes));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
	}
	return TCL_ERROR;
 *      mean a revised routine capable of returning Tcl_WideInt values.
 *
 * Returns:
    }

    /*
 *      TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
 *
 * Side effects:
     * Convert the string rep.
     */

    if (length <= 3) {
	offset = 0;
    } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
	/*
	 * This is our limited string expression evaluator. Pass everything
	 * after "end-" to Tcl_GetInt, then reverse for offset.
	 */

 *      When TCL_OK is returned, the encoded index value is written
 *      to *indexPtr.
 *
 *----------------------------------------------------------------------
 */

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 */
{
    ClientData cd;
    Tcl_WideInt wide;
    int idx, numType, code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);

    if ((code == TCL_OK) && (numType == TCL_NUMBER_INT)) {
        /* We parsed a value in the range WIDE_MIN...WIDE_MAX */
	wide = (*(Tcl_WideInt *)cd);
    integerEncode:
        if (wide < TCL_INDEX_START) {
            /* All negative absolute indices are "before the beginning" */
            idx = before;
        } else if (wide >= INT_MAX) {
            /* This index value is always "after the end" */
            idx = after;
        } else {
	    idx = (int) wide;
	}
        /* usual case, the absolute index value encodes itself */
    } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &wide)) {
        /*
         * We parsed an end+offset index value.
         * wide holds the offset value in the range WIDE_MIN...WIDE_MAX.
         */
        if (wide > 0) {
            /*
             * All end+postive or end-negative expressions
             * always indicate "after the end".
             */
            idx = after;
	if (TclIsSpaceProc(bytes[4])) {
	    goto badIndexFormat;
	}
	if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
	    return TCL_ERROR;
        } else if (wide < INT_MIN - TCL_INDEX_END) {
	}
	if (bytes[3] == '-') {
	    offset = -offset;
            /* These indices always indicate "before the beginning */
            idx = before;
	}
    } else {
	/*
	 * Conversion failed. Report the error.
	 */

    badIndexFormat:
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
        } else {
            /* Encoded end-positive (or end+negative) are offset */
            idx = (int)wide + TCL_INDEX_END;
        }

    /* TODO: Consider flag to suppress repeated end-offset parse. */
    } else if (TCL_OK == GetWideForIndex(interp, objPtr, 0, &wide)) {
        /*
         * Only reach this case when the index value is a
         * constant index arithmetic expression, and wide
         * holds the result. Treat it the same as if it were
         * parsed as an absolute integer value.
         */
        goto integerEncode;
    } else {
	return TCL_ERROR;
    }
    *indexPtr = idx;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIndexDecode --
 *
 *	Decodes a value previously encoded by TclIndexEncode.  The argument
 *	endValue indicates what value of "end" should be used in the
 *	decoding.
 *
 * Results:
 *	The decoded index value.
 *
 *----------------------------------------------------------------------
 */

int
TclIndexDecode(
    int encoded,	/* Value to decode */
    int endValue)	/* Meaning of "end" to use, > TCL_INDEX_END */
{
    if (encoded <= TCL_INDEX_END) {
	return (encoded - TCL_INDEX_END) + endValue;
    }
    return encoded;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckBadOctal --
 *
 *	This function checks for a bad octal value and appends a meaningful
 *	error to the interp's result.
 *
 * Results:
		    "bad index \"%s\": must be end?[+-]integer?", bytes));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
	}
	return TCL_ERROR;
    }
 *	1 if the argument was a bad octal, else 0.
 *
 * Side effects:
 *	The interpreter's result is modified.
 *
 *----------------------------------------------------------------------
 */

int
TclCheckBadOctal(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    const char *value)		/* String to check. */
{
    register const char *p = value;

    /*
     * A frequent mistake is invalid octal values due to an unwanted leading
     * zero. Try to generate a meaningful error message.
     */

    while (TclIsSpaceProc(*p)) {
	p++;
    }
    if (*p == '+' || *p == '-') {
	p++;
    }
    if (*p == '0') {
	if ((p[1] == 'o') || p[1] == 'O') {
	    p += 2;
	}
	while (isdigit(UCHAR(*p))) {	/* INTL: digit. */
	    p++;
	}
	while (TclIsSpaceProc(*p)) {
	    p++;
	}
	if (*p == '\0') {
    /*
	    /*
     * The conversion succeeded. Free the old internal rep and set the new
     * one.
     */
	     * Reached end of string.
	     */

    TclFreeIntRep(objPtr);
    objPtr->internalRep.longValue = offset;
    objPtr->typePtr = &tclEndOffsetType;

    return TCL_OK;
	    if (interp != NULL) {
		/*
		 * Don't reset the result here because we want this result to
		 * be added to an existing error message as extra info.
		 */

		Tcl_AppendToObj(Tcl_GetObjResult(interp),
			" (looks like invalid octal number)", -1);
	    }
	    return 1;
	}
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ClearHash --
 *
3886
3887
3888
3889
3890
3891
3892
3893

3894
3895
3896
3897
3898
3899
3900
4381
4382
4383
4384
4385
4386
4387

4388
4389
4390
4391
4392
4393
4394
4395







-
+







     * loss of the intrep. Increment newValue refCount early to handle case
     * where we set a PGV to itself.
     */

    Tcl_IncrRefCount(newValue);
    cacheMap = GetThreadHash(&pgvPtr->key);
    ClearHash(cacheMap);
    hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(pgvPtr->epoch), &dummy);
    hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(size_t)(pgvPtr->epoch), &dummy);
    Tcl_SetHashValue(hPtr, newValue);
    Tcl_MutexUnlock(&pgvPtr->mutex);
}

/*
 *----------------------------------------------------------------------
 *
3912
3913
3914
3915
3916
3917
3918
3919

3920
3921
3922
3923
3924
3925
3926
4407
4408
4409
4410
4411
4412
4413

4414
4415
4416
4417
4418
4419
4420
4421







-
+







Tcl_Obj *
TclGetProcessGlobalValue(
    ProcessGlobalValue *pgvPtr)
{
    Tcl_Obj *value = NULL;
    Tcl_HashTable *cacheMap;
    Tcl_HashEntry *hPtr;
    size_t epoch = pgvPtr->epoch;
    unsigned int epoch = pgvPtr->epoch;

    if (pgvPtr->encoding) {
	Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);

	if (pgvPtr->encoding != current) {
	    /*
	     * The system encoding has changed since the master string value
3936
3937
3938
3939
3940
3941
3942
3943

3944
3945
3946
3947
3948
3949
3950
3951
3952
3953

3954
3955
3956
3957
3958
3959
3960
4431
4432
4433
4434
4435
4436
4437

4438
4439
4440
4441
4442
4443
4444
4445
4446
4447

4448
4449
4450
4451
4452
4453
4454
4455







-
+









-
+







		    pgvPtr->numBytes, &native);
	    Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native),
	    Tcl_DStringLength(&native), &newValue);
	    Tcl_DStringFree(&native);
	    ckfree(pgvPtr->value);
	    pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
		    (size_t) Tcl_DStringLength(&newValue) + 1);
		    Tcl_DStringLength(&newValue) + 1);
	    Tcl_DStringFree(&newValue);
	    Tcl_FreeEncoding(pgvPtr->encoding);
	    pgvPtr->encoding = current;
	    Tcl_MutexUnlock(&pgvPtr->mutex);
	} else {
	    Tcl_FreeEncoding(current);
	}
    }
    cacheMap = GetThreadHash(&pgvPtr->key);
    hPtr = Tcl_FindHashEntry(cacheMap, (void *) (epoch));
    hPtr = Tcl_FindHashEntry(cacheMap, (void *)(size_t)epoch);
    if (NULL == hPtr) {
	int dummy;

	/*
	 * No cache for the current epoch - must be a new one.
	 *
	 * First, clear the cacheMap, as anything in it must refer to some
3979
3980
3981
3982
3983
3984
3985
3986

3987
3988
3989
3990
3991
3992
3993
4474
4475
4476
4477
4478
4479
4480

4481
4482
4483
4484
4485
4486
4487
4488







-
+








	/*
	 * Store a copy of the shared value in our epoch-indexed cache.
	 */

	value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
	hPtr = Tcl_CreateHashEntry(cacheMap,
		(void *)(pgvPtr->epoch), &dummy);
		(void *)(size_t)(pgvPtr->epoch), &dummy);
	Tcl_MutexUnlock(&pgvPtr->mutex);
	Tcl_SetHashValue(hPtr, value);
	Tcl_IncrRefCount(value);
    }
    return Tcl_GetHashValue(hPtr);
}


Changes to generic/tclVar.c.

56
57
58
59
60
61
62
63

64
65
66

67
68
69
70

71
72
73
74
75
76
77
56
57
58
59
60
61
62

63

64

65


66
67
68
69
70
71
72
73
74
75







-
+
-

-
+
-
-


+








static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,
    int *newPtr)
{
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table, key, newPtr);
	    key, newPtr);

    if (hPtr) {
    if (!hPtr) {
	return VarHashGetValue(hPtr);
    } else {
	return NULL;
    }
    return VarHashGetValue(hPtr);
}

#define VarHashFindVar(tablePtr, key) \
    VarHashCreateVar((tablePtr), (key), NULL)

#define VarHashInvalidateEntry(varPtr) \
    ((varPtr)->flags |= VAR_DEAD_HASH)
88
89
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
86
87
88
89
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







-
+
-
-


+








-
+
-
-


+







static inline Var *
VarHashFirstVar(
    TclVarHashTable *tablePtr,
    Tcl_HashSearch *searchPtr)
{
    Tcl_HashEntry *hPtr = VarHashFirstEntry(tablePtr, searchPtr);

    if (hPtr) {
    if (!hPtr) {
	return VarHashGetValue(hPtr);
    } else {
	return NULL;
    }
    return VarHashGetValue(hPtr);
}

static inline Var *
VarHashNextVar(
    Tcl_HashSearch *searchPtr)
{
    Tcl_HashEntry *hPtr = VarHashNextEntry(searchPtr);

    if (hPtr) {
    if (!hPtr) {
	return VarHashGetValue(hPtr);
    } else {
	return NULL;
    }
    return VarHashGetValue(hPtr);
}

#define VarHashGetKey(varPtr) \
    (((VarInHash *)(varPtr))->entry.key.objPtr)

#define VarHashDeleteTable(tablePtr) \
    Tcl_DeleteHashTable(&(tablePtr)->table)
164
165
166
167
168
169
170












171
172
173
174
175
176








177
178
179



180
181
182
183
184
185
186
187
188
189
190
191






192




193
194
195
196
197
198
199
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216

217
218
219
220
221
222
223
224
225
226
227







+
+
+
+
+
+
+
+
+
+
+
+






+
+
+
+
+
+
+
+



+
+
+












+
+
+
+
+
+
-
+
+
+
+







				 * Tcl_NextHashEntry to get value to
				 * return. */
    struct ArraySearch *nextPtr;/* Next in list of all active searches for
				 * this variable, or NULL if this is the last
				 * one. */
} ArraySearch;

/*
 * TIP #508: [array default]
 *
 * The following structure extends the regular TclVarHashTable used by array
 * variables to store their optional default value.
 */

typedef struct ArrayVarHashTable {
    TclVarHashTable table;
    Tcl_Obj *defaultObj;
} ArrayVarHashTable;

/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks);
static void		ArrayPopulateSearch(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Var *varPtr,
			    ArraySearch *searchPtr);
static void		ArrayDoneSearch(Interp *iPtr, Var *varPtr,
			    ArraySearch *searchPtr);
static Tcl_NRPostProc   ArrayForLoopCallback;
static int		ArrayForNRCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
			    Var *varPtr, int flags, int index);
static int		LocateArray(Tcl_Interp *interp, Tcl_Obj *name,
			    Var **varPtrPtr, int *isArrayPtr);
static int		NotArrayError(Tcl_Interp *interp, Tcl_Obj *name);
static Tcl_Var		ObjFindNamespaceVar(Tcl_Interp *interp,
			    Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
			    int flags);
static int		ObjMakeUpvar(Tcl_Interp *interp,
			    CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
			    const char *otherP2, const int otherFlags,
			    Tcl_Obj *myNamePtr, int myFlags, int index);
static ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
			    Interp *iPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int flags, int index);

/*
 * TIP #508: [array default]
 */

static int		ArrayDefaultCmd(ClientData clientData,
static Var *		VerifyArray(Tcl_Interp *interp, Tcl_Obj *varNameObj);
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		DeleteArrayVar(Var *arrayPtr);
static void		SetArrayDefault(Var *arrayPtr, Tcl_Obj *defaultObj);

/*
 * Functions defined in this file that may be exported in the future for use
 * by the bytecode compiler and engine or to the public interface.
 */

MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250




































251
252
253
254
255
256
257
254
255
256
257
258
259
260

261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320







-

















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    FreeLocalVarName, DupLocalVarName, NULL, NULL
};

static const Tcl_ObjType tclParsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL
};


Var *
TclVarHashCreateVar(
    TclVarHashTable *tablePtr,
    const char *key,
    int *newPtr)
{
    Tcl_Obj *keyPtr;
    Var *varPtr;

    keyPtr = Tcl_NewStringObj(key, -1);
    Tcl_IncrRefCount(keyPtr);
    varPtr = VarHashCreateVar(tablePtr, keyPtr, newPtr);
    Tcl_DecrRefCount(keyPtr);

    return varPtr;
}

static int
LocateArray(
    Tcl_Interp *interp,
    Tcl_Obj *name,
    Var **varPtrPtr,
    int *isArrayPtr)
{
    Var *arrayPtr, *varPtr = TclObjLookupVarEx(interp, name, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    if (TclCheckArrayTraces(interp, varPtr, arrayPtr, name, -1) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (varPtrPtr) {
	*varPtrPtr = varPtr;
    }
    if (isArrayPtr) {
	*isArrayPtr = varPtr && !TclIsVarUndefined(varPtr)
		&& TclIsVarArray(varPtr);
    }
    return TCL_OK;
}

static int
NotArrayError(
    Tcl_Interp *interp,
    Tcl_Obj *name)
{
    const char *nameStr = Tcl_GetString(name);

    Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("\"%s\" isn't an array", nameStr));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCleanupVar --
 *
 *	This function is called when it looks like it may be OK to free up a
276
277
278
279
280
281
282
283


284
285
286
287
288
289
290
291
292


293
294
295
296
297
298
299
339
340
341
342
343
344
345

346
347
348
349
350
351
352
353
354
355

356
357
358
359
360
361
362
363
364







-
+
+








-
+
+







    Var *varPtr,		/* Pointer to variable that may be a candidate
				 * for being expunged. */
    Var *arrayPtr)		/* Array that contains the variable, or NULL
				 * if this variable isn't an array element. */
{
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
	    && (VarHashRefCount(varPtr) == (unsigned)
		    !TclIsVarDeadHash(varPtr))) {
	if (VarHashRefCount(varPtr) == 0) {
	    ckfree(varPtr);
	} else {
	    VarHashDeleteEntry(varPtr);
	}
    }
    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
	    (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
	    (VarHashRefCount(arrayPtr) == (unsigned)
		    !TclIsVarDeadHash(arrayPtr))) {
	if (VarHashRefCount(arrayPtr) == 0) {
	    ckfree(arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }
}
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576

577
578

579
580
581


582
583
584
585
586
587
588
589
590
591
592
593
594



595
596

597
598
599
600
601
602





603
604
605


606
607
608
609
610
611
612
626
627
628
629
630
631
632

633
634
635
636
637
638
639

640


641
642


643
644
645
646
647
648
649
650
651
652
653
654
655


656
657
658
659

660
661





662
663
664
665
666
667


668
669
670
671
672
673
674
675
676







-







-
+
-
-
+

-
-
+
+











-
-
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+







		goto localVarNameTypeHandling;
	    }
	}
	parsed = 1;
    }

    if (!parsed) {

	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	int len;
	const char *part1 = TclGetStringFromObj(part1Ptr, &len);

	if (len > 1 && (part1[len - 1] == ')')) {
	if ((len > 1) && (part1[len - 1] == ')')) {

	  const char *part2 = strchr(part1, '(');
	    const char *part2 = strchr(part1, '(');

	  if (part2) {
	    Tcl_Obj *arrayPtr;
	    if (part2) {
		Tcl_Obj *arrayPtr;

		if (part2Ptr != NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
				needArray, -1);
			Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
				NULL);
		    }
		    return NULL;
		}

	    arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));
	    part2Ptr = Tcl_NewStringObj(part2 + 1, len - (part2 - part1) - 2);
		arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));
		part2Ptr = Tcl_NewStringObj(part2 + 1,
			len - (part2 - part1) - 2);

	    TclFreeIntRep(part1Ptr);
		TclFreeIntRep(part1Ptr);

	    Tcl_IncrRefCount(arrayPtr);
	    part1Ptr->internalRep.twoPtrValue.ptr1 = arrayPtr;
	    Tcl_IncrRefCount(part2Ptr);
	    part1Ptr->internalRep.twoPtrValue.ptr2 = part2Ptr;
	    part1Ptr->typePtr = &tclParsedVarNameType;
		Tcl_IncrRefCount(arrayPtr);
		part1Ptr->internalRep.twoPtrValue.ptr1 = arrayPtr;
		Tcl_IncrRefCount(part2Ptr);
		part1Ptr->internalRep.twoPtrValue.ptr2 = part2Ptr;
		part1Ptr->typePtr = &tclParsedVarNameType;

	    part1Ptr = arrayPtr;
	  }
		part1Ptr = arrayPtr;
	    }
	}
    }

  doneParsing:
    /*
     * part1Ptr is not an array element; look it up, and convert it to one of
     * the cached types if possible.
628
629
630
631
632
633
634

635
636
637
638
639
640
641
642
643

644
645
646
647
648
649
650
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707

708
709
710
711
712
713
714
715







+








-
+







     */

    TclFreeIntRep(part1Ptr);
    if (index >= 0) {
	/*
	 * An indexed local variable.
	 */

	Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);

	part1Ptr->typePtr = &localVarNameType;
	if (part1Ptr != cachedNamePtr) {
	    part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;
	    Tcl_IncrRefCount(cachedNamePtr);
	    if (cachedNamePtr->typePtr != &localVarNameType
		    || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
	        TclFreeIntRep(cachedNamePtr);
		TclFreeIntRep(cachedNamePtr);
	    }
	} else {
	    part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
	}
	part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index);
    } else {
	/*
812
813
814
815
816
817
818

819
820





821
822
823
824
825
826
827
828
829
830
831
832
833






834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849


















850
851
852
853
854
855
856






857
858
859
860
861




862
863
864
865
866
867
868
869
870






871
872
873


874
875
876


877
878

879
880
881



882
883
884
885
886
887
888
877
878
879
880
881
882
883
884


885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
















909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926







927
928
929
930
931
932
933




934
935
936
937




938
939



940
941
942
943
944
945
946


947
948
949


950
951
952

953
954


955
956
957
958
959
960
961
962
963
964







+
-
-
+
+
+
+
+













+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+
-
-
-
-


-
-
-
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
+

-
-
+
+
+







		|| (cxtNsPtr == iPtr->globalNsPtr)
		|| ((*varName == ':') && (*(varName+1) == ':'));

	if (lookGlobal) {
	    *indexPtr = -1;
	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
	} else {
	    if (flags & TCL_AVOID_RESOLVERS) {
	    flags = (flags | TCL_NAMESPACE_ONLY);
	    *indexPtr = -2;
		flags = (flags | TCL_NAMESPACE_ONLY);
	    }
	    if (flags & TCL_NAMESPACE_ONLY) {
		*indexPtr = -2;
	    }
	}

	/*
	 * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, or
	 * otherwise generate our own error!
	 */

	varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
		(Tcl_Namespace *) cxtNsPtr,
		(flags | TCL_AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
	if (varPtr == NULL) {
	    Tcl_Obj *tailPtr;

	    if (!create) {	/* Var wasn't found and not to create it. */
		*errMsgPtr = noSuchVar;
		return NULL;
	    }

	    /*
	    if (create) {	/* Var wasn't found so create it. */
		TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
		if (varNsPtr == NULL) {
		    *errMsgPtr = badNamespace;
		    return NULL;
		} else if (tail == NULL) {
		    *errMsgPtr = missingName;
		    return NULL;
		}
		if (tail != varName) {
		    tailPtr = Tcl_NewStringObj(tail, -1);
		} else {
		    tailPtr = varNamePtr;
		}
		varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr,
	     * Var wasn't found so create it.
	     */

	    TclGetNamespaceForQualName(interp, varName, cxtNsPtr, flags,
		    &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
	    if (varNsPtr == NULL) {
		*errMsgPtr = badNamespace;
		return NULL;
	    } else if (tail == NULL) {
		*errMsgPtr = missingName;
		return NULL;
	    }
	    if (tail != varName) {
		tailPtr = Tcl_NewStringObj(tail, -1);
	    } else {
		tailPtr = varNamePtr;
	    }
	    varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr, &isNew);
			&isNew);
		if (lookGlobal) {
		    /*
		     * The variable was created starting from the global
		     * namespace: a global reference is returned even if it
		     * wasn't explicitly requested.
		     */
	    if (lookGlobal) {
		/*
		 * The variable was created starting from the global
		 * namespace: a global reference is returned even if it wasn't
		 * explicitly requested.
		 */

		    *indexPtr = -1;
		} else {
		    *indexPtr = -2;
		}
		*indexPtr = -1;
	    } else {
		*indexPtr = -2;
	    }
	    } else {		/* Var wasn't found and not to create it. */
		*errMsgPtr = noSuchVar;
		return NULL;
	    }
	}
    } else {			/* Local var: look in frame varFramePtr. */
	int localLen, localCt = varFramePtr->numCompiledLocals;
	Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	const char *localNameStr;
	int localCt = varFramePtr->numCompiledLocals;

	if (localCt > 0) {
	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	    const char *localNameStr;
	    int localLen;

	for (i=0 ; i<localCt ; i++, objPtrPtr++) {
	    register Tcl_Obj *objPtr = *objPtrPtr;
	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
		register Tcl_Obj *objPtr = *objPtrPtr;

	    if (objPtr) {
		localNameStr = TclGetStringFromObj(objPtr, &localLen);
		if (objPtr) {
		    localNameStr = TclGetStringFromObj(objPtr, &localLen);

		if ((varLen == localLen) && (varName[0] == localNameStr[0])
		    if ((varLen == localLen) && (varName[0] == localNameStr[0])
			&& !memcmp(varName, localNameStr, varLen)) {
		    *indexPtr = i;
		    return (Var *) &varFramePtr->compiledLocals[i];
			*indexPtr = i;
			return (Var *) &varFramePtr->compiledLocals[i];
		    }
		}
	    }
	}
	tablePtr = varFramePtr->varTablePtr;
	if (create) {
	    if (tablePtr == NULL) {
		tablePtr = ckalloc(sizeof(TclVarHashTable));
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
1036
1037
1038
1039
1040
1041
1042


1043
1044
1045
1046
1047
1048
1049







-
-







				 * 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. */
{
    int isNew;
    Var *varPtr;
    TclVarHashTable *tablePtr;
    Namespace *nsPtr;

    /*
     * We're dealing with an array element. Make sure the variable is an array
     * and look up the element (create the element if desired).
     */

    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
994
995
996
997
998
999
1000
1001

1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1068
1069
1070
1071
1072
1073
1074

1075









1076
1077
1078
1079
1080
1081
1082







-
+
-
-
-
-
-
-
-
-
-







			danglingVar, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	    }
	    return NULL;
	}

	TclSetVarArray(arrayPtr);
	TclInitArrayVar(arrayPtr);
	tablePtr = ckalloc(sizeof(TclVarHashTable));
	arrayPtr->value.tablePtr = tablePtr;

	if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
	    nsPtr = TclGetVarNsPtr(arrayPtr);
	} else {
	    nsPtr = NULL;
	}
	TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
    } else if (!TclIsVarArray(arrayPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
		    index);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	}
1352
1353
1354
1355
1356
1357
1358






















1359
1360
1361
1362
1363
1364
1365
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
1444
1445
1446
1447
1448
1449
1450
1451
1452







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    /*
     * Return the element if it's an existing scalar variable.
     */

    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
	return varPtr->value.objPtr;
    }

    /*
     * Return the array default value if any.
     */

    if (arrayPtr && TclIsVarArray(arrayPtr) && TclGetArrayDefault(arrayPtr)) {
	return TclGetArrayDefault(arrayPtr);
    }
    if (TclIsVarArrayElement(varPtr) && !arrayPtr) {
	/*
	 * UGLY! Peek inside the implementation of things. This lets us get
	 * the default of an array even when we've been [upvar]ed to just an
	 * element of the array.
	 */

	ArrayVarHashTable *avhtPtr = (ArrayVarHashTable *)
		((VarInHash *) varPtr)->entry.tablePtr;

	if (avhtPtr->defaultObj) {
	    return avhtPtr->defaultObj;
	}
    }

    if (flags & TCL_LEAVE_ERR_MSG) {
	if (TclIsVarUndefined(varPtr) && arrayPtr
		&& !TclIsVarUndefined(arrayPtr)) {
	    msg = noSuchElement;
	} else if (TclIsVarArray(varPtr)) {
	    msg = isArray;
1713
1714
1715
1716
1717
1718
1719




























































































































1720
1721
1722
1723
1724
1725
1726
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    return TclPtrSetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, newValuePtr, flags, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * ListAppendInVar, StringAppendInVar --
 *
 *	Support functions for TclPtrSetVarIdx that implement various types of
 *	appending operations.
 *
 * Results:
 *	ListAppendInVar returns a Tcl result code (from the core list append
 *	operation). StringAppendInVar has no return value.
 *
 * Side effects:
 *	The variable or element of the array is updated. This may make the
 *	variable/element exist. Reference counts of values may be updated.
 *
 *----------------------------------------------------------------------
 */

static inline int
ListAppendInVar(
    Tcl_Interp *interp,
    Var *varPtr,
    Var *arrayPtr,
    Tcl_Obj *oldValuePtr,
    Tcl_Obj *newValuePtr)
{
    if (oldValuePtr == NULL) {
	/*
	 * No previous value. Check for defaults if there's an array we can
	 * ask this of.
	 */

	if (arrayPtr) {
	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);

	    if (defValuePtr) {
		oldValuePtr = Tcl_DuplicateObj(defValuePtr);
	    }
	}

	if (oldValuePtr == NULL) {
	    /*
	     * No default. [lappend] semantics say this is like being an empty
	     * string.
	     */

	    TclNewObj(oldValuePtr);
	}
	varPtr->value.objPtr = oldValuePtr;
	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
    } else if (Tcl_IsShared(oldValuePtr)) {
	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
	TclDecrRefCount(oldValuePtr);
	oldValuePtr = varPtr->value.objPtr;
	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
    }

    return Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr);
}

static inline void
StringAppendInVar(
    Var *varPtr,
    Var *arrayPtr,
    Tcl_Obj *oldValuePtr,
    Tcl_Obj *newValuePtr)
{
    /*
     * If there was no previous value, either we use the array's default (if
     * this is an array with a default at all) or we treat this as a simple
     * set.
     */

    if (oldValuePtr == NULL) {
	if (arrayPtr) {
	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);

	    if (defValuePtr) {
		/*
		 * This is *almost* the same as the shared path below, except
		 * that the original value reference in defValuePtr is not
		 * decremented.
		 */

		Tcl_Obj *valuePtr = Tcl_DuplicateObj(defValuePtr);

		varPtr->value.objPtr = valuePtr;
		TclContinuationsCopy(valuePtr, defValuePtr);
		Tcl_IncrRefCount(valuePtr);
		Tcl_AppendObjToObj(valuePtr, newValuePtr);
		if (newValuePtr->refCount == 0) {
		    Tcl_DecrRefCount(newValuePtr);
		}
		return;
	    }
	}
	varPtr->value.objPtr = newValuePtr;
	Tcl_IncrRefCount(newValuePtr);
	return;
    }

    /*
     * We append newValuePtr's bytes but don't change its ref count. Unless
     * the reference is shared, when we have to duplicate in order to be safe
     * to modify at all.
     */

    if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);

	TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);

	TclDecrRefCount(oldValuePtr);
	oldValuePtr = varPtr->value.objPtr;
	Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
    }

    Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
    if (newValuePtr->refCount == 0) {
	Tcl_DecrRefCount(newValuePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrSetVarIdx --
 *
 *	This function is the same as Tcl_SetVar2Ex above, except that it
 *	requires pointers to the variable's Var structs in addition to the
 *	variable names.
 *
 * Results:
1825
1826
1827
1828
1829
1830
1831
1832
1833

1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865

1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
2036
2037
2038
2039
2040
2041
2042


2043









2044
2045
2046
2047
2048


















2049




2050
2051
2052
2053
2054
2055
2056







-
-
+
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-








    oldValuePtr = varPtr->value.objPtr;
    if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
	varPtr->value.objPtr = NULL;
    }
    if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
	    if (oldValuePtr == NULL) {
		TclNewObj(oldValuePtr);
	    result = ListAppendInVar(interp, varPtr, arrayPtr, oldValuePtr,
		varPtr->value.objPtr = oldValuePtr;
		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
	    } else if (Tcl_IsShared(oldValuePtr)) {
		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
		TclDecrRefCount(oldValuePtr);
		oldValuePtr = varPtr->value.objPtr;
		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
	    }
	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
		    newValuePtr);
	    if (result != TCL_OK) {
		goto earlyError;
	    }
	} else {				/* Append string. */
	    /*
	     * We append newValuePtr's bytes but don't change its ref count.
	     */

	    if (oldValuePtr == NULL) {
		varPtr->value.objPtr = newValuePtr;
		Tcl_IncrRefCount(newValuePtr);
	    } else {
		if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);

		    TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);

		    TclDecrRefCount(oldValuePtr);
		    oldValuePtr = varPtr->value.objPtr;
		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
		}
		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
	    StringAppendInVar(varPtr, arrayPtr, oldValuePtr, newValuePtr);
		if (newValuePtr->refCount == 0) {
		    Tcl_DecrRefCount(newValuePtr);
		}
	    }
	}
    } else if (newValuePtr != oldValuePtr) {
	/*
	 * In this case we are replacing the value, so we don't need to do
	 * more than swap the objects.
	 */

2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2297
2298
2299
2300
2301
2302
2303

2304
2305
2306
2307
2308
2309
2310







-







	} else {
	    Tcl_DecrRefCount(varValuePtr);
	    return NULL;
	}
    } else {
	/* Unshared - can Incr in place */
	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {

	    /*
	     * This seems dumb to write the incremeted value into the var
	     * after we just adjusted the value in place, but the spec for
	     * [incr] requires that write traces fire, and making this call
	     * is the way to make that happen.
	     */

2859
2860
2861
2862
2863
2864
2865
2866

2867
2868
2869
2870




2871
2872
2873

2874

2875
2876




2877




2878
2879
2880
2881
2882
2883





























































2884

2885
2886
2887











2888


2889
2890
2891
2892










































































































2893
2894

2895
2896
2897


2898
2899
2900

2901
2902

2903
2904
2905
2906
2907
2908
2909

2910
2911
2912
2913

2914
2915
2916
2917
2918

2919
2920
2921
2922

2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976



















2977
2978
2979



2980
2981
2982
2983


2984
2985
2986
2987
2988
2989

2990
2991

2992
2993
2994
2995
2996






2997
2998
2999
3000











3001
3002
3003
3004
3005
3006
3007
3008


3009
3010

3011
3012

3013
3014

3015
3016
3017
3018
3019
3020
3021














3022
3023
3024









3025
3026
3027
3028
3029







3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108

3109
3110
3111
3112
3113
3114
3115
3116

3117
3118
3119




3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133































3134
3135

3136
3137
3138


3139
3140
3141
3142
3143













3144
3145
3146
3147
3148
3149
3150
3038
3039
3040
3041
3042
3043
3044

3045
3046



3047
3048
3049
3050
3051


3052
3053
3054


3055
3056
3057
3058

3059
3060
3061
3062
3063
3064
3065
3066


3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129



3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143




3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249


3250
3251


3252
3253



3254


3255

3256
3257




3258




3259





3260




3261















































3262






3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282


3283
3284
3285




3286
3287
3288





3289


3290





3291
3292
3293
3294
3295
3296




3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307




3308



3309
3310


3311


3312


3313







3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327



3328
3329
3330
3331
3332
3333
3334
3335
3336
3337




3338
3339
3340
3341
3342
3343
3344
3345

3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365














































3366
3367
3368
3369
3370
3371
3372

3373


3374
3375
3376
3377
3378
3379
3380
3381

3382

3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394








3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426

3427



3428
3429





3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449







-
+

-
-
-
+
+
+
+

-
-
+

+
-
-
+
+
+
+
-
+
+
+
+




-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+

-
-
+
+
-
-
-
+
-
-
+
-


-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+
+
-
-
-
-
+
+

-
-
-
-
-
+
-
-
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-

-
-
-
+
+
-
-
+
-
-
+
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+

-




















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-

-
-
+







-
+
-


+
+
+
+






-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







    Tcl_SetObjResult(interp, newValuePtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArraySet --
 * ArrayForObjCmd, ArrayForNRCmd, ArrayForLoopCallback, ArrayObjNext --
 *
 *	Set the elements of an array. If there are no elements to set, create
 *	an empty array. This routine is used by the Tcl_ArrayObjCmd and by the
 *	TclSetupEnv routine.
 *	These functions implement the "array for" Tcl command.
 *	    array for {k v} a {}
 *	The array for command iterates over the array, setting the the
 *	specified loop variables, and executing the body each iteration.
 *
 * Results:
 *	A standard Tcl result object.
 *	ArrayForObjCmd() is the standard wrapper around ArrayForNRCmd().
 *
 *	ArrayForNRCmd() sets up the ArraySearch structure, sets arrayNamePtr
 * Side effects:
 *	A variable will be created if one does not already exist.
 *	inside the structure and calls VarHashFirstEntry to start the hash
 *	iteration.
 *
 *	ArrayForNRCmd() does not execute the body or set the loop variables,
 *	Callers must Incr arrayNameObj if they pland to Decr it.
 *	it only initializes the iterator.
 *
 *	ArrayForLoopCallback() iterates over the entire array, executing the
 *	body each time.
 *
 *----------------------------------------------------------------------
 */

int
TclArraySet(
static int
ArrayObjNext(
    Tcl_Interp *interp,
    Tcl_Obj *arrayNameObj,	/* array */
    Var *varPtr,		/* array */
    ArraySearch *searchPtr,
    Tcl_Obj **keyPtrPtr,	/* Pointer to a variable to have the key
				 * written into, or NULL. */
    Tcl_Obj **valuePtrPtr)	/* Pointer to a variable to have the
				 * value written into, or NULL.*/
{
    Tcl_Obj *keyObj;
    Tcl_Obj *valueObj = NULL;
    int gotValue;
    int donerc;

    donerc = TCL_BREAK;

    if ((varPtr->flags & VAR_SEARCH_ACTIVE) != VAR_SEARCH_ACTIVE) {
	donerc = TCL_ERROR;
	return donerc;
    }

    gotValue = 0;
    while (1) {
	Tcl_HashEntry *hPtr = searchPtr->nextEntry;

	if (hPtr != NULL) {
	    searchPtr->nextEntry = NULL;
	} else {
	    hPtr = Tcl_NextHashEntry(&searchPtr->search);
	    if (hPtr == NULL) {
		gotValue = 0;
		break;
	    }
	}
	varPtr = VarHashGetValue(hPtr);
	if (!TclIsVarUndefined(varPtr)) {
	    gotValue = 1;
	    break;
	}
    }

    if (!gotValue) {
	return donerc;
    }

    donerc = TCL_CONTINUE;

    keyObj = VarHashGetKey(varPtr);
    *keyPtrPtr = keyObj;
    valueObj = Tcl_ObjGetVar2(interp, arrayNameObj, keyObj,
	    TCL_LEAVE_ERR_MSG);
    *valuePtrPtr = valueObj;

    return donerc;
}

static int
ArrayForObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *arrayNameObj,	/* The array name. */
    Tcl_Obj *arrayElemObj)	/* The array elements list or dict. If this is
				 * NULL, create an empty array. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, ArrayForNRCmd, dummy, objc, objv);
}

static int
ArrayForNRCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *varListObj, *arrayNameObj, *scriptObj;
    ArraySearch *searchPtr = NULL;
    Var *varPtr, *arrayPtr;
    int result, i;

    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
    Var *varPtr;
    int isArray, numVars;

    /*
     * array for {k v} a body
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "{key value} arrayName script");
	return TCL_ERROR;
    }

    /*
     * Parse arguments.
     */

    if (Tcl_ListObjLength(interp, objv[1], &numVars) != TCL_OK) {
	return TCL_ERROR;
    }

    if (numVars != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have two variable names", -1));
	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL);
	return TCL_ERROR;
    }

    arrayNameObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, arrayNameObj);
    }

    /*
     * Make a new array search, put it on the stack.
     */

    searchPtr = ckalloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */

    varListObj = TclListObjCopy(NULL, objv[1]);
    scriptObj = objv[3];
    Tcl_IncrRefCount(scriptObj);

    /*
     * Run the script.
     */

    TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj,
	    arrayNameObj, scriptObj);
    return TCL_OK;
}

static int
ArrayForLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    ArraySearch *searchPtr = data[0];
    Tcl_Obj *varListObj = data[1];
    Tcl_Obj *arrayNameObj = data[2];
    Tcl_Obj *scriptObj = data[3];
    Tcl_Obj **varv;
    Tcl_Obj *keyObj, *valueObj;
    Var *varPtr;
    Var *arrayPtr;
    int done, varc;

    /*
     * Process the result from the previous execution of the script body.
     */

    done = TCL_ERROR;

    if (result == TCL_CONTINUE) {
	result = TCL_OK;
    } else if (result != TCL_OK) {
	if (result == TCL_BREAK) {
	    Tcl_ResetResult(interp);
	    result = TCL_OK;
	} else if (result == TCL_ERROR) {
	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		    "\n    (\"array for\" body line %d)",
		    Tcl_GetErrorLine(interp)));
	}
	goto arrayfordone;
    }

    /*
     * Get the next mapping from the array.
     */

    keyObj = NULL;
    valueObj = NULL;
    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
	    /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
	    /*createPart2*/ 1, &arrayPtr);
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
    if (varPtr == NULL) {
	return TCL_ERROR;
    }
	done = TCL_ERROR;
    } else {
    if (arrayPtr) {
	CleanupVar(varPtr, arrayPtr);
	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
	done = ArrayObjNext(interp, arrayNameObj, varPtr, searchPtr, &keyObj,
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		TclGetString(arrayNameObj), NULL);
		&valueObj);
	return TCL_ERROR;
    }

    if (arrayElemObj == NULL) {
	goto ensureArray;
    }

    result = TCL_OK;
    /*
     * Install the contents of the dictionary or list into the array.
     */

    if (done != TCL_CONTINUE) {
    if (arrayElemObj->typePtr == &tclDictType) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;

	Tcl_ResetResult(interp);
	if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (done == 0) {
	if (done == TCL_ERROR) {
	    /*
	     * Empty, so we'll just force the array to be properly existing
	     * instead.
	     */

	    goto ensureArray;
	}

	/*
	 * Don't need to look at result of Tcl_DictObjFirst as we've just
	 * successfully used a dictionary operation on the same object.
	 */

	for (Tcl_DictObjFirst(interp, arrayElemObj, &search,
		&keyPtr, &valuePtr, &done) ; !done ;
		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
	    /*
	     * At this point, it would be nice if the key was directly usable
	     * by the array. This isn't the case though.
	     */

	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
		    keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else {
	/*
	 * Not a dictionary, so assume (and convert to, for backward-
	 * -compatibility reasons) a list.
	 */

	int elemLen;
	Tcl_Obj **elemPtrs, *copyListObj;

	result = TclListObjGetElements(interp, arrayElemObj,
		&elemLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (elemLen & 1) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list must have an even number of elements", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
	    return TCL_ERROR;
	}
	if (elemLen == 0) {
	    goto ensureArray;
		    "array changed during iteration", -1));
	    Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", NULL);
	    varPtr->flags |= TCL_LEAVE_ERR_MSG;
	    result = done;
	}
	goto arrayfordone;
    }

    Tcl_ListObjGetElements(NULL, varListObj, &varc, &varv);
    if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	result = TCL_ERROR;
	goto arrayfordone;
    }
    if (valueObj != NULL) {
	if (Tcl_ObjSetVar2(interp, varv[1], NULL, valueObj,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	    goto arrayfordone;
	}

	/*
    }

    /*
	 * We needn't worry about traces invalidating arrayPtr: should that be
	 * the case, TclPtrSetVarIdx will return NULL so that we break out of
	 * the loop and return an error.
	 */
     * Run the script.
     */

	copyListObj = TclListObjCopy(NULL, arrayElemObj);
	for (i=0 ; i<elemLen ; i+=2) {
	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);

    TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj,
	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
	    arrayNameObj, scriptObj);
		    elemPtrs[i],elemPtrs[i+1],TCL_LEAVE_ERR_MSG,-1) == NULL)){
		result = TCL_ERROR;
		break;
	    }
	}
    return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);

    /*
     * For unwinding everything once the iterating is done.
     */

	Tcl_DecrRefCount(copyListObj);
	return result;
    }

  arrayfordone:
    if (done != TCL_ERROR) {
	/*
	 * If the search was terminated by an array change, the
	 * VAR_SEARCH_ACTIVE flag will no longer be set.
	 */

	ArrayDoneSearch(iPtr, varPtr, searchPtr);
	Tcl_DecrRefCount(searchPtr->name);
	ckfree(searchPtr);
    }
    /*
     * The list is empty make sure we have an array, or create one if
     * necessary.
     */

  ensureArray:
    if (varPtr != NULL) {
	if (TclIsVarArray(varPtr)) {
    TclDecrRefCount(varListObj);
    TclDecrRefCount(scriptObj);
	    /*
	     * Already an array, done.
    return result;
	     */

}
	    return TCL_OK;
	}

	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
	    /*
	     * Either an array element, or a scalar: lose!
	     */

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
		    needArray, -1);
/*
 * ArrayPopulateSearch
 */

static void
ArrayPopulateSearch(
    Tcl_Interp *interp,
    Tcl_Obj *arrayNameObj,
    Var *varPtr,
    ArraySearch *searchPtr)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    int isNew;
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}

    hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
    if (isNew) {
	searchPtr->id = 1;
	varPtr->flags |= VAR_SEARCH_ACTIVE;
	searchPtr->nextPtr = NULL;
    } else {
	searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
	searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
    }
    TclSetVarArray(varPtr);
    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
    return TCL_OK;
    searchPtr->varPtr = varPtr;
    searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
	    &searchPtr->search);
    Tcl_SetHashValue(hPtr, searchPtr);
    searchPtr->name = Tcl_ObjPrintf("s-%d-%s", searchPtr->id,
	    TclGetString(arrayNameObj));
    Tcl_IncrRefCount(searchPtr->name);
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayStartSearchCmd --
 *
 *	This object-based function is invoked to process the "array
 *	startsearch" Tcl command. See the user documentation for details on
 *	what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */

static Var *
VerifyArray(
    Tcl_Interp *interp,
    Tcl_Obj *varNameObj)
{
    Interp *iPtr = (Interp *) interp;
    const char *varName = TclGetString(varNameObj);
    Var *arrayPtr;

    /*
     * Locate the array variable.
     */

    Var *varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
	    return NULL;
	}
    }

    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces.
     */

    if ((varPtr == NULL) || !TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't an array", varName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
	return NULL;
    }

    return varPtr;
}

static int
ArrayStartSearchCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_HashEntry *hPtr;
    int isNew;
    int isArray;
    ArraySearch *searchPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }

    varPtr = VerifyArray(interp, objv[1]);
    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
    if (varPtr == NULL) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, objv[1]);
    }

    /*
     * Make a new array search with a free name.
     */

    searchPtr = ckalloc(sizeof(ArraySearch));
    hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
    if (isNew) {
	searchPtr->id = 1;
	varPtr->flags |= VAR_SEARCH_ACTIVE;
	searchPtr->nextPtr = NULL;
    } else {
	searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
	searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
    ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr);
    Tcl_SetObjResult(interp, searchPtr->name);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayDoneSearch --
 *
 *	Removes the search from the hash of active searches.
 *
 *----------------------------------------------------------------------
 */
static void
ArrayDoneSearch(
    Interp *iPtr,
    Var *varPtr,
    ArraySearch *searchPtr)
{
    Tcl_HashEntry *hPtr;
    ArraySearch *prevPtr;

    /*
     * Unhook the search from the list of searches associated with the
     * variable.
     */

    hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
    if (hPtr == NULL) {
	return;
    }
    searchPtr->varPtr = varPtr;
    if (searchPtr == Tcl_GetHashValue(hPtr)) {
    searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
	    &searchPtr->search);
    Tcl_SetHashValue(hPtr, searchPtr);
	if (searchPtr->nextPtr) {
	    Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
    searchPtr->name = Tcl_ObjPrintf("s-%d-%s", searchPtr->id, TclGetString(objv[1]));
    Tcl_IncrRefCount(searchPtr->name);
    Tcl_SetObjResult(interp, searchPtr->name);
    return TCL_OK;
}
	} else {
	    varPtr->flags &= ~VAR_SEARCH_ACTIVE;
	    Tcl_DeleteHashEntry(hPtr);
	}
    } else {
	for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
	    if (prevPtr->nextPtr == searchPtr) {
		prevPtr->nextPtr = searchPtr->nextPtr;
		break;
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayAnyMoreCmd --
 *
 *	This object-based function is invoked to process the "array anymore"
3166
3167
3168
3169
3170
3171
3172
3173

3174
3175
3176
3177
3178
3179
3180
3181
3182
3183

3184
3185
3186




3187
3188
3189
3190
3191
3192
3193
3465
3466
3467
3468
3469
3470
3471

3472
3473
3474
3475
3476
3477
3478
3479
3480
3481

3482

3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495







-
+









-
+
-


+
+
+
+







    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    int gotValue;
    int gotValue, isArray;
    ArraySearch *searchPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    varPtr = VerifyArray(interp, varNameObj);
    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    if (varPtr == NULL) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
3242
3243
3244
3245
3246
3247
3248

3249
3250
3251
3252
3253
3254
3255
3256
3257

3258
3259
3260




3261
3262
3263
3264
3265
3266
3267
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559

3560

3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573







+








-
+
-


+
+
+
+







    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    ArraySearch *searchPtr;
    int isArray;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    varPtr = VerifyArray(interp, varNameObj);
    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    if (varPtr == NULL) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327


3328
3329
3330
3331
3332
3333
3334
3335
3336

3337
3338
3339




3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354

3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3624
3625
3626
3627
3628
3629
3630

3631

3632
3633
3634
3635
3636
3637
3638
3639
3640
3641

3642

3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658





3659
















3660
3661
3662
3663
3664
3665
3666







-

-
+
+








-
+
-


+
+
+
+










-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *varNameObj, *searchObj;
    ArraySearch *searchPtr, *prevPtr;
    ArraySearch *searchPtr;
    int isArray;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    varPtr = VerifyArray(interp, varNameObj);
    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    if (varPtr == NULL) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Unhook the search from the list of searches associated with the
     * variable.
     */

    ArrayDoneSearch(iPtr, varPtr, searchPtr);
    hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
    if (searchPtr == Tcl_GetHashValue(hPtr)) {
	if (searchPtr->nextPtr) {
	    Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
	} else {
	    varPtr->flags &= ~VAR_SEARCH_ACTIVE;
	    Tcl_DeleteHashEntry(hPtr);
	}
    } else {
	for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
	    if (prevPtr->nextPtr == searchPtr) {
		prevPtr->nextPtr = searchPtr->nextPtr;
		break;
	    }
	}
    }
    Tcl_DecrRefCount(searchPtr->name);
    ckfree(searchPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
3394
3395
3396
3397
3398
3399
3400
3401

3402
3403
3404

3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415

3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431



3432
3433
3434
3435
3436
3437
3438
3439

3440
3441
3442
3443
3444
3445
3446
3683
3684
3685
3686
3687
3688
3689

3690



3691
3692
3693
3694
3695
3696

3697




3698
















3699
3700
3701








3702
3703
3704
3705
3706
3707
3708
3709







-
+
-
-
-
+





-

-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+







static int
ArrayExistsCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Interp *iPtr = (Interp *)interp;
    Var *varPtr, *arrayPtr;
    Tcl_Obj *arrayNameObj;
    int notArray;
    int isArray;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }
    arrayNameObj = objv[1];

    /*
     * Locate the array variable.
     */

    if (TCL_ERROR == LocateArray(interp, objv[1], NULL, &isArray)) {
    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, arrayNameObj, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }
	return TCL_ERROR;
    }


    /*
     * Check whether we've actually got an array variable.
     */

    notArray = ((varPtr == NULL) || !TclIsVarArray(varPtr)
	    || TclIsVarUndefined(varPtr));
    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[!notArray]);
    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[isArray]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayGetCmd --
3461
3462
3463
3464
3465
3466
3467
3468
3469

3470
3471
3472
3473
3474

3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493

3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509



3510
3511
3512
3513
3514

3515
3516

3517
3518
3519
3520
3521
3522
3523
3524
3525
3724
3725
3726
3727
3728
3729
3730


3731
3732
3733
3734
3735

3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751




3752
















3753
3754
3755





3756


3757


3758
3759
3760
3761
3762
3763
3764







-
-
+




-
+















-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
+
-
-
+
-
-







static int
ArrayGetCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr, *varPtr2;
    Var *varPtr, *varPtr2;
    Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj;
    Tcl_Obj **nameObjPtr, *patternObj;
    Tcl_HashSearch search;
    const char *pattern;
    int i, count, result;
    int i, count, result, isArray;

    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;
    case 3:
	varNameObj = objv[1];
	patternObj = objv[2];
	break;
    default:
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?");
	return TCL_ERROR;
    }

    /*
     * Locate the array variable.
     */

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }
	return TCL_ERROR;
    }


    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces. If not an array, it's an empty result.
    /* If not an array, it's an empty result. */
     */

    if (!isArray) {
    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
	    || TclIsVarUndefined(varPtr)) {
	return TCL_OK;
    }

    pattern = (patternObj ? TclGetString(patternObj) : NULL);

    /*
     * Store the array names in a new object.
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658


3659
3660
3661

3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673

3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687

3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703

3704
3705
3706

3707
3708
3709
3710
3711
3712
3713
3714
3888
3889
3890
3891
3892
3893
3894



3895
3896
3897
3898

3899
3900
3901
3902
3903
3904

3905
3906




3907














3908

3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919




3920

3921

3922

3923
3924
3925
3926
3927
3928
3929







-
-
-
+
+


-
+





-


-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-











-
-
-
-
+
-

-
+
-







    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const options[] = {
	"-exact", "-glob", "-regexp", NULL
    };
    enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr, *varPtr2;
    Tcl_Obj *varNameObj, *nameObj, *resultObj, *patternObj;
    Var *varPtr, *varPtr2;
    Tcl_Obj *nameObj, *resultObj, *patternObj;
    Tcl_HashSearch search;
    const char *pattern = NULL;
    int mode = OPT_GLOB;
    int isArray, mode = OPT_GLOB;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    patternObj = (objc > 2 ? objv[objc-1] : NULL);

    /*
     * Locate the array variable.
     */

    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
	    return TCL_ERROR;
	return TCL_ERROR;
	}
    }

    /*
     * Finish parsing the arguments.
     */

    if ((objc == 4) && Tcl_GetIndexFromObj(interp, objv[2], options, "option",
	    0, &mode) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces. If not an array, the result is empty.
    /* If not an array, the result is empty. */
     */

    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
    if (!isArray) {
	    || TclIsVarUndefined(varPtr)) {
	return TCL_OK;
    }

    /*
     * Check for the trivial cases where we can use a direct lookup.
     */

3837
3838
3839
3840
3841
3842
3843
3844


3845

3846
3847
3848
3849
3850
3851



















3852


3853
3854















3855


3856
3857






























3858


















3859
3860
3861


























3862
3863

3864
3865
3866
3867
3868
















3869
3870
3871
3872
3873


3874
3875
3876
3877
3878
3879
3880
4052
4053
4054
4055
4056
4057
4058

4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090


4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108


4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157



4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186





4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205


4206
4207
4208
4209
4210
4211
4212
4213
4214







-
+
+

+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
+
+







static int
ArraySetCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *arrayNameObj;
    Tcl_Obj *arrayElemObj;
    Var *varPtr, *arrayPtr;
    int result, i;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName list");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, objv[1], NULL, NULL)) {
	return TCL_ERROR;
    }

    arrayNameObj = objv[1];
    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
	    /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
	    /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
	return TCL_ERROR;
    }
    if (arrayPtr) {
	CleanupVar(varPtr, arrayPtr);
	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		TclGetString(arrayNameObj), NULL);
	return TCL_ERROR;
    }

    /*
     * Install the contents of the dictionary or list into the array.
     */
     * Locate the array variable.
     */

    arrayElemObj = objv[2];
    if (arrayElemObj->typePtr == &tclDictType && arrayElemObj->bytes == NULL) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;

	if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (done == 0) {
	    /*
	     * Empty, so we'll just force the array to be properly existing
	     * instead.
	     */

	    goto ensureArray;
	}
    varPtr = TclObjLookupVarEx(interp, objv[1], NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

	/*
	 * Don't need to look at result of Tcl_DictObjFirst as we've just
	 * successfully used a dictionary operation on the same object.
	 */

	for (Tcl_DictObjFirst(interp, arrayElemObj, &search,
		&keyPtr, &valuePtr, &done) ; !done ;
		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
	    /*
	     * At this point, it would be nice if the key was directly usable
	     * by the array. This isn't the case though.
	     */

	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
		    keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else {
	/*
	 * Not a dictionary, so assume (and convert to, for backward-
	 * -compatibility reasons) a list.
	 */

	int elemLen;
	Tcl_Obj **elemPtrs, *copyListObj;

	result = TclListObjGetElements(interp, arrayElemObj,
		&elemLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (elemLen & 1) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list must have an even number of elements", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
	    return TCL_ERROR;
	}
	if (elemLen == 0) {
	    goto ensureArray;
	}

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
	/*
	 * We needn't worry about traces invalidating arrayPtr: should that be
	 * the case, TclPtrSetVarIdx will return NULL so that we break out of
	 * the loop and return an error.
	 */

	copyListObj = TclListObjCopy(NULL, arrayElemObj);
	for (i=0 ; i<elemLen ; i+=2) {
	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
			    elemPtrs[i], elemPtrs[i+1], TCL_LEAVE_ERR_MSG,
			    -1) == NULL)) {
		result = TCL_ERROR;
		break;
	    }
	}
	Tcl_DecrRefCount(copyListObj);
	return result;
    }

    /*
     * The list is empty make sure we have an array, or create one if
     * necessary.
     */

  ensureArray:
    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, objv[1], NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
    if (varPtr != NULL) {
	if (TclIsVarArray(varPtr)) {
	    /*
	     * Already an array, done.
	     */

	    return TCL_OK;
	}
	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
	    /*
	     * Either an array element, or a scalar: lose!
	     */

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
		    needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}
    }

    return TclArraySet(interp, objv[1], objv[2]);
    TclInitArrayVar(varPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArraySizeCmd --
 *
3894
3895
3896
3897
3898
3899
3900
3901
3902

3903
3904
3905
3906

3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917

3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933



3934
3935
3936
3937
3938

3939
3940
3941

3942
3943
3944
3945
3946
3947
3948
4228
4229
4230
4231
4232
4233
4234


4235

4236
4237

4238
4239
4240
4241
4242
4243

4244




4245
















4246
4247
4248





4249

4250

4251
4252
4253
4254
4255
4256
4257
4258







-
-
+
-


-
+





-

-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
+
-

-
+







static int
ArraySizeCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
    Var *varPtr;
    Tcl_Obj *varNameObj;
    Tcl_HashSearch search;
    Var *varPtr2;
    int size = 0;
    int isArray, size = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }
    varNameObj = objv[1];

    /*
     * Locate the array variable.
     */

    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }
	return TCL_ERROR;
    }


    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces. We can only iterate over the array if it exists...
    /* We can only iterate over the array if it exists... */
     */

    if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
    if (isArray) {
	/*
	 * Must iterate in order to get chance to check for present but
	 * "undefined" entries.
	 */

	for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
		varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
3978
3979
3980
3981
3982
3983
3984
3985
3986

3987
3988

3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999

4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016




4017
4018
4019
4020
4021
4022

4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4288
4289
4290
4291
4292
4293
4294


4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305




4306

















4307
4308
4309
4310






4311







4312
4313
4314
4315
4316
4317
4318







-
-
+


+







-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-







static int
ArrayStatsCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
    Var *varPtr;
    Tcl_Obj *varNameObj;
    char *stats;
    int isArray;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }
    varNameObj = objv[1];

    /*
     * Locate the array variable.
     */

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }

	return TCL_ERROR;
    }

    if (!isArray) {
    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces.
     */

	return NotArrayError(interp, varNameObj);
    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
	    || TclIsVarUndefined(varPtr)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't an array", TclGetString(varNameObj)));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
		TclGetString(varNameObj), NULL);
	return TCL_ERROR;
    }

    stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
    if (stats == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"error reading array statistics", -1));
	return TCL_ERROR;
4061
4062
4063
4064
4065
4066
4067
4068
4069

4070
4071
4072
4073

4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092

4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109




4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4343
4344
4345
4346
4347
4348
4349


4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370




4371

















4372
4373
4374
4375








4376
4377
4378
4379
4380
4381
4382







-
-
+




+















-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-







static int
ArrayUnsetCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr, *varPtr2, *protectedVarPtr;
    Var *varPtr, *varPtr2, *protectedVarPtr;
    Tcl_Obj *varNameObj, *patternObj, *nameObj;
    Tcl_HashSearch search;
    const char *pattern;
    const int unsetFlags = 0;	/* Should this be TCL_LEAVE_ERR_MSG? */
    int isArray;

    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;
    case 3:
	varNameObj = objv[1];
	patternObj = objv[2];
	break;
    default:
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?");
	return TCL_ERROR;
    }

    /*
     * Locate the array variable
     */

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }

	return TCL_ERROR;
    }

    if (!isArray) {
    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces.
     */

    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
	    || TclIsVarUndefined(varPtr)) {
	return TCL_OK;
    }

    if (!patternObj) {
	/*
	 * When no pattern is given, just unset the whole array.
	 */
4221
4222
4223
4224
4225
4226
4227

4228
4229

4230
4231
4232
4233
4234
4235
4236
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496







+


+







	/* ARGSUSED */
Tcl_Command
TclInitArrayCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap arrayImplMap[] = {
	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"default",	ArrayDefaultCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
	{"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},
	{"size",	ArraySizeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"startsearch",	ArrayStartSearchCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"statistics",	ArrayStatsCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5615
5616
5617
5618
5619
5620
5621



5622
5623
5624
5625
5626
5627
5628







-
-
-







    Tcl_HashSearch search;
    Tcl_HashEntry *tPtr;
    register Var *elPtr;
    ActiveVarTrace *activePtr;
    Tcl_Obj *objPtr;
    VarTrace *tracePtr;

    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
	DeleteSearches(iPtr, varPtr);
    }
    for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search);
	    elPtr != NULL; elPtr = VarHashNextVar(&search)) {
	if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
	    objPtr = elPtr->value.objPtr;
	    TclDecrRefCount(objPtr);
	    elPtr->value.objPtr = NULL;
	}
5413
5414
5415
5416
5417
5418
5419
5420
5421

5422
5423
5424
5425
5426
5427
5428
5670
5671
5672
5673
5674
5675
5676


5677
5678
5679
5680
5681
5682
5683
5684







-
-
+







	 * variables, some combinations of [upvar] and [variable] may create
	 * such beasts - see [Bug 604239]. This is necessary to avoid leaking
	 * the corresponding Var struct, and is otherwise harmless.
	 */

	TclClearVarNamespaceVar(elPtr);
    }
    VarHashDeleteTable(varPtr->value.tablePtr);
    ckfree(varPtr->value.tablePtr);
    DeleteArrayVar(varPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjVarErrMsg --
 *
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5957
5958
5959
5960
5961
5962
5963




5964
5965
5966
5967
5968
5969
5970







-
-
-
-







	}
    }

    /*
     * Find the namespace(s) that contain the variable.
     */

    if (!(flags & TCL_GLOBAL_ONLY)) {
	flags |= TCL_NAMESPACE_ONLY;
    }

    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
	    flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);

    /*
     * Look for the variable in the variable table of its namespace. Be sure
     * to check both possible search paths: from the specified namespace
     * context and from the global namespace.
5901
5902
5903
5904
5905
5906
5907
5908

5909
5910
5911
5912
5913
5914
5915
6153
6154
6155
6156
6157
6158
6159

6160
6161
6162
6163
6164
6165
6166
6167







-
+







	     * pattern only specifies variable names), then add in all global
	     * :: variables that match the simple pattern. Of course, add in
	     * only those variables that aren't hidden by a variable in the
	     * effective namespace.
	     */

	    if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
		varPtr = VarHashFirstVar(&globalNsPtr->varTable,&search);
		varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
		while (varPtr) {
		    if (!TclIsVarUndefined(varPtr)
			    || TclIsVarNamespaceVar(varPtr)) {
			varNamePtr = VarHashGetKey(varPtr);
			varName = TclGetString(varNamePtr);
			if ((simplePattern == NULL)
				|| Tcl_StringMatch(varName, simplePattern)) {
6107
6108
6109
6110
6111
6112
6113
6114

6115
6116
6117
6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128



6129
6130
6131
6132




6133
6134

6135
6136
6137
6138
6139
6140
6141
6142
6143
6144










6145
6146
6147
6148
6149
6150
6151
6359
6360
6361
6362
6363
6364
6365

6366
6367
6368
6369
6370
6371
6372
6373
6374
6375

6376
6377
6378
6379
6380
6381
6382




6383
6384
6385
6386
6387

6388
6389









6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406







-
+









-




+
+
+
-
-
-
-
+
+
+
+

-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+







    Tcl_Obj *listPtr,		/* List object to append names to. */
    Tcl_Obj *patternPtr,	/* Pattern to match against. */
    int includeLinks)		/* 1 if upvars should be included, else 0. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    int i, localVarCt, added;
    Tcl_Obj **varNamePtr, *objNamePtr;
    Tcl_Obj *objNamePtr;
    const char *varName;
    TclVarHashTable *localVarTablePtr;
    Tcl_HashSearch search;
    Tcl_HashTable addedTable;
    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;

    localVarCt = iPtr->varFramePtr->numCompiledLocals;
    varPtr = iPtr->varFramePtr->compiledLocals;
    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
    varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
    if (includeLinks) {
	Tcl_InitObjHashTable(&addedTable);
    }

    if (localVarCt > 0) {
	Tcl_Obj **varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;

    for (i = 0; i < localVarCt; i++, varNamePtr++) {
	/*
	 * Skip nameless (temporary) variables and undefined variables.
	 */
	for (i = 0; i < localVarCt; i++, varNamePtr++) {
	    /*
	     * Skip nameless (temporary) variables and undefined variables.
	     */

	if (*varNamePtr && !TclIsVarUndefined(varPtr)
	    if (*varNamePtr && !TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
	    varName = TclGetString(*varNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
		}
	    }
	}
	varPtr++;
		varName = TclGetString(*varNamePtr);
		if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		    Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
		    if (includeLinks) {
			Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
		    }
		}
	    }
	    varPtr++;
	}
    }

    /*
     * Do nothing if no local variables.
     */

    if (localVarTablePtr == NULL) {
6194
6195
6196
6197
6198
6199
6200

6201

6202

6203
6204


6205





















6206
6207
6208
6209
6210
6211
6212
6213
6214



6215
6216
6217




6218
6219
6220
6221
6222
6223
6224
6449
6450
6451
6452
6453
6454
6455
6456

6457

6458
6459
6460
6461
6462

6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489



6490
6491
6492
6493


6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504







+
-
+
-
+


+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
+
+
+

-
-
+
+
+
+








  objectVars:
    if (!includeLinks) {
	return;
    }

    if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
	Method *mPtr = (Method *)
	CallContext *contextPtr = iPtr->varFramePtr->clientData;
		Tcl_ObjectContextMethod(iPtr->varFramePtr->clientData);
	Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
	PrivateVariableMapping *privatePtr;

	if (mPtr->declaringObjectPtr) {
	    Object *oPtr = mPtr->declaringObjectPtr;

	    FOREACH(objNamePtr, mPtr->declaringObjectPtr->variables) {
	    FOREACH(objNamePtr, oPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
	    }
	    FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
		Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
			&added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(privatePtr->variableObj),
				pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
			    privatePtr->variableObj);
		}
	    }
	} else {
	    Class *clsPtr = mPtr->declaringClassPtr;

	    FOREACH(objNamePtr, clsPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
	    }
	} else {
	    FOREACH(objNamePtr, mPtr->declaringClassPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
	    FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
		Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
			&added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
			Tcl_StringMatch(TclGetString(privatePtr->variableObj),
				pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
			    privatePtr->variableObj);
		}
	    }
	}
    }
    Tcl_DeleteHashTable(&addedTable);
}

6285
6286
6287
6288
6289
6290
6291
6292
6293
6294



6295
6296
6297
6298
6299
6300
6301
6302
6303
6304
6305
6306
6307
6308
6309
6310
6311


































































































































































































































































6312
6313
6314
6315
6316
6317
6318
6319
6565
6566
6567
6568
6569
6570
6571



6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661
6662
6663
6664
6665
6666
6667
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690
6691
6692
6693
6694
6695
6696
6697
6698
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800
6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
6856
6857







-
-
-
+
+
+

















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
    register const char *p1, *p2;
    register int l1, l2;

    /*
     * 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.
     */

    p1 = TclGetString(objPtr1);
    l1 = objPtr1->length;
    p2 = TclGetString(objPtr2);
    l2 = objPtr2->length;

    /*
     * Only compare string representations of the same length.
     */

    return ((l1 == l2) && !memcmp(p1, p2, l1));
}

/*----------------------------------------------------------------------
 *
 * ArrayDefaultCmd --
 *
 *	This function implements the 'array default' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ArrayDefaultCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {
	"get", "set", "exists", "unset", NULL
    };
    enum options { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET };
    Tcl_Obj *arrayNameObj, *defaultValueObj;
    Var *varPtr, *arrayPtr;
    int isArray, option;

    /*
     * Parse arguments.
     */

    if (objc != 3 && objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?value?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
	    0, &option) != TCL_OK) {
	return TCL_ERROR;
    }

    arrayNameObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    switch (option) {
    case OPT_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}
	if (!varPtr || TclIsVarUndefined(varPtr) || !isArray) {
	    return NotArrayError(interp, arrayNameObj);
	}

	defaultValueObj = TclGetArrayDefault(varPtr);
	if (!defaultValueObj) {
	    /* Array default must exist. */
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "array has no default value", -1));
	    Tcl_SetErrorCode(interp, "TCL", "READ", "ARRAY", "DEFAULT", NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, defaultValueObj);
	return TCL_OK;

    case OPT_SET:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName value");
	    return TCL_ERROR;
	}

	/*
	 * Attempt to create array if needed.
	 */
	varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
		/*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "array default set",
		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	    return TCL_ERROR;
	}
	if (arrayPtr) {
	    /*
	     * Not a valid array name.
	     */

	    CleanupVar(varPtr, arrayPtr);
	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
		    needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(arrayNameObj), NULL);
	    return TCL_ERROR;
	}
	if (!TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	    /*
	     * Not an array.
	     */

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
		    needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}

	if (!TclIsVarArray(varPtr)) {
	    TclInitArrayVar(varPtr);
	}
	defaultValueObj = objv[3];
	SetArrayDefault(varPtr, defaultValueObj);
	return TCL_OK;

    case OPT_EXISTS:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}

	/*
	 * Undefined variables (whether or not they have storage allocated) do
	 * not have defaults, and this is not an error case.
	 */

	if (!varPtr || TclIsVarUndefined(varPtr)) {
	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
	} else if (!isArray) {
	    return NotArrayError(interp, arrayNameObj);
	} else {
	    defaultValueObj = TclGetArrayDefault(varPtr);
	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!!defaultValueObj));
	}
	return TCL_OK;

    case OPT_UNSET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}

	if (varPtr && !TclIsVarUndefined(varPtr)) {
	    if (!isArray) {
		return NotArrayError(interp, arrayNameObj);
	    }
	    SetArrayDefault(varPtr, NULL);
	}
	return TCL_OK;
    }

    /* Unreached */
    return TCL_ERROR;
}

/*
 * Initialize array variable.
 */

void
TclInitArrayVar(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = ckalloc(sizeof(ArrayVarHashTable));

    /*
     * Mark the variable as an array.
     */

    TclSetVarArray(arrayPtr);

    /*
     * Regular TclVarHashTable initialization.
     */

    arrayPtr->value.tablePtr = (TclVarHashTable *) tablePtr;
    TclInitVarHashTable(arrayPtr->value.tablePtr, TclGetVarNsPtr(arrayPtr));

    /*
     * Default value initialization.
     */

    tablePtr->defaultObj = NULL;
}

/*
 * Cleanup array variable.
 */

static void
DeleteArrayVar(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    arrayPtr->value.tablePtr;

    /*
     * Default value cleanup.
     */

    SetArrayDefault(arrayPtr, NULL);

    /*
     * Regular TclVarHashTable cleanup.
     */

    VarHashDeleteTable(arrayPtr->value.tablePtr);
    ckfree(tablePtr);
}

/*
 * Get array default value if any.
 */

Tcl_Obj *
TclGetArrayDefault(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    arrayPtr->value.tablePtr;

    return tablePtr->defaultObj;
}

/*
 * Set/replace/unset array default value.
 */

static void
SetArrayDefault(
    Var *arrayPtr,
    Tcl_Obj *defaultObj)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    arrayPtr->value.tablePtr;

    /*
     * Increment/decrement refcount twice to ensure that the object is shared,
     * so that it doesn't get modified accidentally by the folling code:
     *
     *      array default set v 1
     *      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);
    }
    tablePtr->defaultObj = defaultObj;
    if (tablePtr->defaultObj) {
        Tcl_IncrRefCount(tablePtr->defaultObj);
        Tcl_IncrRefCount(tablePtr->defaultObj);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Added generic/tclZipfs.c.




















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
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
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * tclZipfs.c --
 *
 *	Implementation of the ZIP filesystem used in TIP 430
 *	Adapted from the implentation for AndroWish.
 *
 * Copyright (c) 2016-2017 Sean Woods <[email protected]>
 * Copyright (c) 2013-2015 Christian Werner <[email protected]>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This file is distributed in two ways:
 *   generic/tclZipfs.c file in the TIP430-enabled Tcl cores.
 *   compat/tclZipfs.c file in the tclconfig (TEA) file system, for pre-tip430
 *	projects.
 */

#include "tclInt.h"
#include "tclFileSystem.h"

#ifndef _WIN32
#include <sys/mman.h>
#endif /* _WIN32*/

#ifndef MAP_FILE
#define MAP_FILE 0
#endif /* !MAP_FILE */

#ifdef HAVE_ZLIB
#include "zlib.h"
#include "crypt.h"

#ifdef CFG_RUNTIME_DLLFILE

/*
** We are compiling as part of the core.
** TIP430 style zipfs prefix
*/

#define ZIPFS_VOLUME	  "//zipfs:/"
#define ZIPFS_VOLUME_LEN  9
#define ZIPFS_APP_MOUNT	  "//zipfs:/app"
#define ZIPFS_ZIP_MOUNT	  "//zipfs:/lib/tcl"

#else /* !CFG_RUNTIME_DLLFILE */

/*
** We are compiling from the /compat folder of tclconfig
** Pre TIP430 style zipfs prefix
** //zipfs:/ doesn't work straight out of the box on either windows or Unix
** without other changes made to tip 430
*/

#define ZIPFS_VOLUME	  "zipfs:/"
#define ZIPFS_VOLUME_LEN  7
#define ZIPFS_APP_MOUNT	  "zipfs:/app"
#define ZIPFS_ZIP_MOUNT	  "zipfs:/lib/tcl"

#endif /* CFG_RUNTIME_DLLFILE */

/*
 * Various constants and offsets found in ZIP archive files
 */

#define ZIP_SIG_LEN			4

/*
 * Local header of ZIP archive member (at very beginning of each member).
 */

#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

/*
 * Central header of ZIP archive member at end of ZIP file.
 */

#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

/*
 * Central end signature at very end of ZIP file.
 */

#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

#define ZIP_MIN_VERSION			20
#define ZIP_COMPMETH_STORED		0
#define ZIP_COMPMETH_DEFLATED		8

#define ZIP_PASSWORD_END_SIG		0x5a5a4b50

#define DEFAULT_WRITE_MAX_SIZE		(2 * 1024 * 1024)

/*
 * Macros to report errors only if an interp is present.
 */

#define ZIPFS_ERROR(interp,errstr) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1));	\
	}								\
    } while (0)
#define ZIPFS_POSIX_ERROR(interp,errstr) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(			\
		    "%s: %s", errstr, Tcl_PosixError(interp)));		\
	}								\
    } while (0)

/*
 * Macros to read and write 16 and 32 bit integers from/to ZIP archives.
 */

#define ZipReadInt(p) \
    ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24))
#define ZipReadShort(p) \
    ((p)[0] | ((p)[1] << 8))

#define ZipWriteInt(p, v) \
    do {			     \
	(p)[0] = (v) & 0xff;	     \
	(p)[1] = ((v) >> 8) & 0xff;  \
	(p)[2] = ((v) >> 16) & 0xff; \
	(p)[3] = ((v) >> 24) & 0xff; \
    } while (0)
#define ZipWriteShort(p, v) \
    do {			    \
	(p)[0] = (v) & 0xff;	    \
	(p)[1] = ((v) >> 8) & 0xff; \
    } while (0)

/*
 * Windows drive letters.
 */

#ifdef _WIN32
static const char drvletters[] =
    "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
#endif /* _WIN32 */

/*
 * Mutex to protect localtime(3) when no reentrant version available.
 */

#if !defined(_WIN32) && !defined(HAVE_LOCALTIME_R) && TCL_THREADS
TCL_DECLARE_MUTEX(localtimeMutex)
#endif /* !_WIN32 && !HAVE_LOCALTIME_R && TCL_THREADS */

/*
 * In-core description of mounted ZIP archive file.
 */

typedef struct ZipFile {
    char *name;			/* Archive name */
    size_t nameLength;		/* Length of archive name */
    char isMemBuffer;		/* When true, not a file but a memory buffer */
    Tcl_Channel chan;		/* Channel handle or NULL */
    unsigned char *data;	/* Memory mapped or malloc'ed file */
    size_t length;		/* Length of memory mapped file */
    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 */
    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 */
    size_t mountPointLen;	/* Length of mount point name */
#ifdef _WIN32
    HANDLE mountHandle;		/* Handle used for direct file access. */
#endif /* _WIN32 */
} ZipFile;

/*
 * In-core description of file contained in mounted ZIP archive.
 */

typedef struct ZipEntry {
    char *name;			/* The full pathname of the virtual file */
    ZipFile *zipFilePtr;	/* The ZIP file holding this virtual file */
    Tcl_WideInt offset;		/* Data offset into memory mapped ZIP file */
    int numBytes;		/* Uncompressed size of the virtual file */
    int numCompressedBytes;	/* Compressed size of the virtual file */
    int compressMethod;		/* Compress method */
    int isDirectory;		/* Set to 1 if directory, or -1 if root */
    int depth;			/* Number of slashes in path. */
    int crc32;			/* CRC-32 */
    int timestamp;		/* Modification time */
    int isEncrypted;		/* True if data is encrypted */
    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;

/*
 * File channel for file contained in mounted ZIP archive.
 */

typedef struct ZipChannel {
    ZipFile *zipFilePtr;	/* The ZIP file holding this channel */
    ZipEntry *zipEntryPtr;	/* Pointer back to virtual file */
    size_t maxWrite;		/* Maximum size for write */
    size_t numBytes;		/* Number of bytes of uncompressed data */
    size_t numRead;		/* Position of next byte to be read from the
				 * channel */
    unsigned char *ubuf;	/* Pointer to the uncompressed data */
    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 isWriting;		/* True if open for writing */
    unsigned long keys[3];	/* Key for decryption */
} ZipChannel;

/*
 * Global variables.
 *
 * Most are kept in single ZipFS struct. When build with threading support
 * this struct is protected by the ZipFSMutex (see below).
 *
 * The "fileHash" component is the process wide global table of all known ZIP
 * archive members in all mounted ZIP archives.
 *
 * The "zipHash" components is the process wide global table of all mounted
 * ZIP archive files.
 */

static struct {
    int initialized;		/* True when initialized */
    int lock;			/* RW lock, see below */
    int waiters;		/* RW lock, see below */
    int wrmax;			/* Maximum write size of a file */
    int idCount;		/* Counter for channel names */
    Tcl_HashTable fileHash;	/* File name to ZipEntry mapping */
    Tcl_HashTable zipHash;	/* Mount to ZipFile mapping */
} ZipFS = {
    0, 0, 0, DEFAULT_WRITE_MAX_SIZE, 0,
};

/*
 * For password rotation.
 */

static const char pwrot[16] = {
    0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0,
    0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0
};

/*
 * Table to compute CRC32.
 */

static const z_crc_t crc32tab[256] = {
    0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419,
    0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4,
    0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07,
    0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de,
    0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856,
    0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9,
    0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4,
    0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b,
    0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3,
    0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a,
    0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599,
    0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924,
    0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190,
    0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f,
    0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e,
    0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01,
    0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed,
    0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950,
    0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3,
    0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2,
    0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a,
    0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5,
    0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010,
    0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f,
    0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17,
    0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6,
    0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615,
    0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8,
    0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344,
    0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb,
    0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a,
    0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5,
    0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1,
    0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c,
    0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef,
    0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236,
    0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe,
    0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31,
    0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c,
    0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713,
    0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b,
    0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242,
    0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1,
    0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c,
    0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278,
    0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7,
    0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66,
    0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9,
    0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605,
    0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8,
    0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b,
    0x2d02ef8d,
};

static const char *zipfs_literal_tcl_library = NULL;

/* Function prototypes */

static inline int	DescribeMounted(Tcl_Interp *interp,
			    const char *mountPoint);
static inline int	ListMountPoints(Tcl_Interp *interp);
static int		ZipfsAppHookFindTclInit(const char *archive);
static int		ZipFSPathInFilesystemProc(Tcl_Obj *pathPtr,
			    ClientData *clientDataPtr);
static Tcl_Obj *	ZipFSFilesystemPathTypeProc(Tcl_Obj *pathPtr);
static Tcl_Obj *	ZipFSFilesystemSeparatorProc(Tcl_Obj *pathPtr);
static int		ZipFSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
static int		ZipFSAccessProc(Tcl_Obj *pathPtr, int mode);
static Tcl_Channel	ZipFSOpenFileChannelProc(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int mode, int permissions);
static int		ZipFSMatchInDirectoryProc(Tcl_Interp *interp,
			    Tcl_Obj *result, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
static Tcl_Obj *	ZipFSListVolumesProc(void);
static const char *const *ZipFSFileAttrStringsProc(Tcl_Obj *pathPtr,
			    Tcl_Obj **objPtrRef);
static int		ZipFSFileAttrsGetProc(Tcl_Interp *interp, int index,
			    Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
static int		ZipFSFileAttrsSetProc(Tcl_Interp *interp, int index,
			    Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
static int		ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
static void		ZipfsSetup(void);
static int		ZipChannelClose(ClientData instanceData,
			    Tcl_Interp *interp);
static int		ZipChannelGetFile(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		ZipChannelRead(ClientData instanceData, char *buf,
			    int toRead, int *errloc);
static int		ZipChannelSeek(ClientData instanceData, long offset,
			    int mode, int *errloc);
static void		ZipChannelWatchChannel(ClientData instanceData,
			    int mask);
static int		ZipChannelWrite(ClientData instanceData,
			    const char *buf, int toWrite, int *errloc);

/*
 * Define the ZIP filesystem dispatch table.
 */

MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem;

const Tcl_Filesystem zipfsFilesystem = {
    "zipfs",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    ZipFSPathInFilesystemProc,
    NULL, /* dupInternalRepProc */
    NULL, /* freeInternalRepProc */
    NULL, /* internalToNormalizedProc */
    NULL, /* createInternalRepProc */
    NULL, /* normalizePathProc */
    ZipFSFilesystemPathTypeProc,
    ZipFSFilesystemSeparatorProc,
    ZipFSStatProc,
    ZipFSAccessProc,
    ZipFSOpenFileChannelProc,
    ZipFSMatchInDirectoryProc,
    NULL, /* utimeProc */
    NULL, /* linkProc */
    ZipFSListVolumesProc,
    ZipFSFileAttrStringsProc,
    ZipFSFileAttrsGetProc,
    ZipFSFileAttrsSetProc,
    NULL, /* createDirectoryProc */
    NULL, /* removeDirectoryProc */
    NULL, /* deleteFileProc */
    NULL, /* copyFileProc */
    NULL, /* renameFileProc */
    NULL, /* copyDirectoryProc */
    NULL, /* lstatProc */
    (Tcl_FSLoadFileProc *) ZipFSLoadFile,
    NULL, /* getCwdProc */
    NULL, /* chdirProc */
};

/*
 * The channel type/driver definition used for ZIP archive members.
 */

static Tcl_ChannelType ZipChannelType = {
    "zip",		    /* Type name. */
    TCL_CHANNEL_VERSION_5,
    ZipChannelClose,	    /* Close channel, clean instance data */
    ZipChannelRead,	    /* Handle read request */
    ZipChannelWrite,	    /* Handle write request */
    ZipChannelSeek,	    /* Move location of access point, NULL'able */
    NULL,		    /* Set options, NULL'able */
    NULL,		    /* Get options, NULL'able */
    ZipChannelWatchChannel, /* Initialize notifier */
    ZipChannelGetFile,	    /* Get OS handle from the channel */
    NULL,		    /* 2nd version of close channel, NULL'able */
    NULL,		    /* Set blocking mode for raw channel, NULL'able */
    NULL,		    /* Function to flush channel, NULL'able */
    NULL,		    /* Function to handle event, NULL'able */
    NULL,		    /* Wide seek function, NULL'able */
    NULL,		    /* Thread action function, NULL'able */
    NULL,		    /* Truncate function, NULL'able */
};

/*
 * Miscellaneous constants.
 */

#define ERROR_LENGTH	((size_t) -1)

/*
 *-------------------------------------------------------------------------
 *
 * ReadLock, WriteLock, Unlock --
 *
 *	POSIX like rwlock functions to support multiple readers and single
 *	writer on internal structs.
 *
 *	Limitations:
 *	 - a read lock cannot be promoted to a write lock
 *	 - a write lock may not be nested
 *
 *-------------------------------------------------------------------------
 */

TCL_DECLARE_MUTEX(ZipFSMutex)

#if TCL_THREADS

static Tcl_Condition ZipFSCond;

static void
ReadLock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    while (ZipFS.lock < 0) {
	ZipFS.waiters++;
	Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
	ZipFS.waiters--;
    }
    ZipFS.lock++;
    Tcl_MutexUnlock(&ZipFSMutex);
}

static void
WriteLock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    while (ZipFS.lock != 0) {
	ZipFS.waiters++;
	Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
	ZipFS.waiters--;
    }
    ZipFS.lock = -1;
    Tcl_MutexUnlock(&ZipFSMutex);
}

static void
Unlock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    if (ZipFS.lock > 0) {
	--ZipFS.lock;
    } else if (ZipFS.lock < 0) {
	ZipFS.lock = 0;
    }
    if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) {
	Tcl_ConditionNotify(&ZipFSCond);
    }
    Tcl_MutexUnlock(&ZipFSMutex);
}

#else /* !TCL_THREADS */
#define ReadLock()	do {} while (0)
#define WriteLock()	do {} while (0)
#define Unlock()	do {} while (0)
#endif /* TCL_THREADS */

/*
 *-------------------------------------------------------------------------
 *
 * DosTimeDate, ToDosTime, ToDosDate --
 *
 *	Functions to perform conversions between DOS time stamps and POSIX
 *	time_t.
 *
 *-------------------------------------------------------------------------
 */

static time_t
DosTimeDate(
    int dosDate,
    int dosTime)
{
    struct tm tm;
    time_t ret;

    memset(&tm, 0, sizeof(struct tm));
    tm.tm_year = ((dosDate & 0xfe00) >> 9) + 80;
    tm.tm_mon = ((dosDate & 0x1e0) >> 5) - 1;
    tm.tm_mday = dosDate & 0x1f;
    tm.tm_hour = (dosTime & 0xf800) >> 11;
    tm.tm_min = (dosTime & 0x7e) >> 5;
    tm.tm_sec = (dosTime & 0x1f) << 1;
    ret = mktime(&tm);
    if (ret == (time_t) -1) {
	/* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */
	ret = (time_t) 315532800;
    }
    return ret;
}

static int
ToDosTime(
    time_t when)
{
    struct tm *tmp, tm;

#if !TCL_THREADS || defined(_WIN32)
    /* Not threaded, or on Win32 which uses thread local storage */
    tmp = localtime(&when);
    tm = *tmp;
#elif defined(HAVE_LOCALTIME_R)
    /* Threaded, have reentrant API */
    tmp = &tm;
    localtime_r(&when, tmp);
#else /* TCL_THREADS && !_WIN32 && !HAVE_LOCALTIME_R */
    /* Only using a mutex is safe. */
    Tcl_MutexLock(&localtimeMutex);
    tmp = localtime(&when);
    tm = *tmp;
    Tcl_MutexUnlock(&localtimeMutex);
#endif
    return (tm.tm_hour << 11) | (tm.tm_min << 5) | (tm.tm_sec >> 1);
}

static int
ToDosDate(
    time_t when)
{
    struct tm *tmp, tm;

#if !TCL_THREADS || defined(_WIN32)
    /* Not threaded, or on Win32 which uses thread local storage */
    tmp = localtime(&when);
    tm = *tmp;
#elif /* TCL_THREADS && !_WIN32 && */ defined(HAVE_LOCALTIME_R)
    /* Threaded, have reentrant API */
    tmp = &tm;
    localtime_r(&when, tmp);
#else /* TCL_THREADS && !_WIN32 && !HAVE_LOCALTIME_R */
    /* Only using a mutex is safe. */
    Tcl_MutexLock(&localtimeMutex);
    tmp = localtime(&when);
    tm = *tmp;
    Tcl_MutexUnlock(&localtimeMutex);
#endif
    return ((tm.tm_year - 80) << 9) | ((tm.tm_mon + 1) << 5) | tm.tm_mday;
}

/*
 *-------------------------------------------------------------------------
 *
 * CountSlashes --
 *
 *	This function counts the number of slashes in a pathname string.
 *
 * Results:
 *	Number of slashes found in string.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
CountSlashes(
    const char *string)
{
    int count = 0;
    const char *p = string;

    while (*p != '\0') {
	if (*p == '/') {
	    count++;
	}
	p++;
    }
    return count;
}

/*
 *-------------------------------------------------------------------------
 *
 * CanonicalPath --
 *
 *	This function computes the canonical path from a directory and file
 *	name components into the specified Tcl_DString.
 *
 * Results:
 *	Returns the pointer to the canonical path contained in the specified
 *	Tcl_DString.
 *
 * Side effects:
 *	Modifies the specified Tcl_DString.
 *
 *-------------------------------------------------------------------------
 */

static char *
CanonicalPath(
    const char *root,
    const char *tail,
    Tcl_DString *dsPtr,
    int inZipfs)
{
    char *path;
    int i, j, c, isUNC = 0, isVfs = 0, n = 0;
    int haveZipfsPath = 1;

#ifdef _WIN32
    if (tail[0] != '\0' && strchr(drvletters, tail[0]) && tail[1] == ':') {
	tail += 2;
	haveZipfsPath = 0;
    }
    /* UNC style path */
    if (tail[0] == '\\') {
	root = "";
	++tail;
	haveZipfsPath = 0;
    }
    if (tail[0] == '\\') {
	root = "/";
	++tail;
	haveZipfsPath = 0;
    }
#endif /* _WIN32 */

    if (haveZipfsPath) {
	/* UNC style path */
	if (root && strncmp(root, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) == 0) {
	    isVfs = 1;
	} else if (tail &&
		strncmp(tail, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) == 0) {
	    isVfs = 2;
	}
	if (isVfs != 1 && (root[0] == '/') && (root[1] == '/')) {
	    isUNC = 1;
	}
    }

    if (isVfs != 2) {
	if (tail[0] == '/') {
	    if (isVfs != 1) {
		root = "";
	    }
	    ++tail;
	    isUNC = 0;
	}
	if (tail[0] == '/') {
	    if (isVfs != 1) {
		root = "/";
	    }
	    ++tail;
	    isUNC = 1;
	}
    }
    i = strlen(root);
    j = strlen(tail);

    switch (isVfs) {
    case 1:
	if (i > ZIPFS_VOLUME_LEN) {
	    Tcl_DStringSetLength(dsPtr, i + j + 1);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    path[i++] = '/';
	    memcpy(path + i, tail, j);
	} else {
	    Tcl_DStringSetLength(dsPtr, i + j);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    memcpy(path + i, tail, j);
	}
	break;
    case 2:
	Tcl_DStringSetLength(dsPtr, j);
	path = Tcl_DStringValue(dsPtr);
	memcpy(path, tail, j);
	break;
    default:
	if (inZipfs) {
	    Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN);
	    memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j);
	} else {
	    Tcl_DStringSetLength(dsPtr, i + j + 1);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    path[i++] = '/';
	    memcpy(path + i, tail, j);
	}
	break;
    }

#ifdef _WIN32
    for (i = 0; path[i] != '\0'; i++) {
	if (path[i] == '\\') {
	    path[i] = '/';
	}
    }
#endif /* _WIN32 */

    if (inZipfs) {
	n = ZIPFS_VOLUME_LEN;
    } else {
	n = 0;
    }

    for (i = j = n; (c = path[i]) != '\0'; i++) {
	if (c == '/') {
	    int c2 = path[i + 1];

	    if (c2 == '\0' || c2 == '/') {
		continue;
	    }
	    if (c2 == '.') {
		int c3 = path[i + 2];

		if ((c3 == '/') || (c3 == '\0')) {
		    i++;
		    continue;
		}
		if ((c3 == '.')
			&& ((path[i + 3] == '/') || (path[i + 3] == '\0'))) {
		    i += 2;
		    while ((j > 0) && (path[j - 1] != '/')) {
			j--;
		    }
		    if (j > isUNC) {
			--j;
			while ((j > 1 + isUNC) && (path[j - 2] == '/')) {
			    j--;
			}
		    }
		    continue;
		}
	    }
	}
	path[j++] = c;
    }
    if (j == 0) {
	path[j++] = '/';
    }
    path[j] = 0;
    Tcl_DStringSetLength(dsPtr, j);
    return Tcl_DStringValue(dsPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookup --
 *
 *	This function returns the ZIP entry struct corresponding to the ZIP
 *	archive member of the given file name. Caller must hold the right
 *	lock.
 *
 * Results:
 *	Returns the pointer to ZIP entry struct or NULL if the the given file
 *	name could not be found in the global list of ZIP archive members.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static ZipEntry *
ZipFSLookup(
    char *filename)
{
    Tcl_HashEntry *hPtr;
    ZipEntry *z = NULL;

    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename);
    if (hPtr) {
	z = Tcl_GetHashValue(hPtr);
    }
    return z;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookupMount --
 *
 *	This function returns an indication if the given file name corresponds
 *	to a mounted ZIP archive file.
 *
 * Results:
 *	Returns true, if the given file name is a mounted ZIP archive file.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#ifdef NEVER_USED
static int
ZipFSLookupMount(
    char *filename)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	   hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = Tcl_GetHashValue(hPtr);

	if (strcmp(zf->mountPoint, filename) == 0) {
	    return 1;
	}
    }
    return 0;
}
#endif /* NEVER_USED */

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSCloseArchive --
 *
 *	This function closes a mounted ZIP archive file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A memory mapped ZIP archive is unmapped, allocated memory is released.
 *	The ZipFile pointer is *NOT* deallocated by this function.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipFSCloseArchive(
    Tcl_Interp *interp,		/* Current interpreter. */
    ZipFile *zf)
{
    if (zf->nameLength) {
	ckfree(zf->name);
    }
    if (zf->isMemBuffer) {
	/* Pointer to memory */
	if (zf->ptrToFree) {
	    ckfree(zf->ptrToFree);
	    zf->ptrToFree = NULL;
	}
	zf->data = NULL;
	return;
    }

#ifdef _WIN32
    if (zf->data && !zf->ptrToFree) {
	UnmapViewOfFile(zf->data);
	zf->data = NULL;
    }
    if (zf->mountHandle != INVALID_HANDLE_VALUE) {
	CloseHandle(zf->mountHandle);
    }
#else /* !_WIN32 */
    if ((zf->data != MAP_FAILED) && !zf->ptrToFree) {
	munmap(zf->data, zf->length);
	zf->data = MAP_FAILED;
    }
#endif /* _WIN32 */

    if (zf->ptrToFree) {
	ckfree(zf->ptrToFree);
	zf->ptrToFree = NULL;
    }
    if (zf->chan) {
	Tcl_Close(interp, zf->chan);
	zf->chan = NULL;
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFindTOC --
 *
 *	This function takes a memory mapped zip file and indexes the contents.
 *	When "needZip" is zero an embedded ZIP archive in an executable file
 *	is accepted.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	The given ZipFile struct is filled with information about the ZIP
 *	archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSFindTOC(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    int needZip,
    ZipFile *zf)
{
    size_t i;
    unsigned char *p, *q;

    p = zf->data + zf->length - ZIP_CENTRAL_END_LEN;
    while (p >= zf->data) {
	if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) {
	    if (ZipReadInt(p) == ZIP_CENTRAL_END_SIG) {
		break;
	    }
	    p -= ZIP_SIG_LEN;
	} else {
	    --p;
	}
    }
    if (p < zf->data) {
	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "wrong end signature");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "END_SIG", NULL);
	}
	goto error;
    }
    zf->numFiles = ZipReadShort(p + ZIP_CENTRAL_ENTS_OFFS);
    if (zf->numFiles == 0) {
	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "empty archive");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
	}
	goto error;
    }
    q = zf->data + ZipReadInt(p + ZIP_CENTRAL_DIRSTART_OFFS);
    p -= ZipReadInt(p + ZIP_CENTRAL_DIRSIZE_OFFS);
    if ((p < zf->data) || (p > zf->data + zf->length)
	    || (q < zf->data) || (q > zf->data + zf->length)) {
	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "archive directory not found");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_DIR", NULL);
	}
	goto error;
    }
    zf->baseOffset = zf->passOffset = p - q;
    zf->directoryOffset = p - zf->data;
    q = p;
    for (i = 0; i < zf->numFiles; i++) {
	int pathlen, comlen, extra;

	if (q + ZIP_CENTRAL_HEADER_LEN > zf->data + zf->length) {
	    ZIPFS_ERROR(interp, "wrong header length");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_LEN", NULL);
	    }
	    goto error;
	}
	if (ZipReadInt(q) != ZIP_CENTRAL_HEADER_SIG) {
	    ZIPFS_ERROR(interp, "wrong header signature");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_SIG", NULL);
	    }
	    goto error;
	}
	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
    }
    q = zf->data + zf->baseOffset;
    if ((zf->baseOffset >= 6) && (ZipReadInt(q - 4) == ZIP_PASSWORD_END_SIG)) {
	i = q[-5];
	if (q - 5 - i > zf->data) {
	    zf->passBuf[0] = i;
	    memcpy(zf->passBuf + 1, q - 5 - i, i);
	    zf->passOffset -= i ? (5 + i) : 0;
	}
    }
    return TCL_OK;

  error:
    ZipFSCloseArchive(interp, zf);
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSOpenArchive --
 *
 *	This function opens a ZIP archive file for reading. An attempt is made
 *	to memory map that file. Otherwise it is read into an allocated memory
 *	buffer. The ZIP archive header is verified and must be valid for the
 *	function to succeed. When "needZip" is zero an embedded ZIP archive in
 *	an executable file is accepted.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	ZIP archive is memory mapped or read into allocated memory, the given
 *	ZipFile struct is filled with information about the ZIP archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSOpenArchive(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *zipname,	/* Path to ZIP file to open. */
    int needZip,
    ZipFile *zf)
{
    size_t i;
    ClientData handle;

    zf->nameLength = 0;
    zf->isMemBuffer = 0;
#ifdef _WIN32
    zf->data = NULL;
    zf->mountHandle = INVALID_HANDLE_VALUE;
#else /* !_WIN32 */
    zf->data = MAP_FAILED;
#endif /* _WIN32 */
    zf->length = 0;
    zf->numFiles = 0;
    zf->baseOffset = zf->passOffset = 0;
    zf->ptrToFree = NULL;
    zf->passBuf[0] = 0;
    zf->chan = Tcl_OpenFileChannel(interp, zipname, "rb", 0);
    if (!zf->chan) {
	return TCL_ERROR;
    }
    if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) {
	zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
	if (zf->length == ERROR_LENGTH) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	if ((zf->length - ZIP_CENTRAL_END_LEN)
		> (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
	    ZIPFS_ERROR(interp, "illegal file size");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    goto error;
	}
	if (Tcl_Seek(zf->chan, 0, SEEK_SET) == -1) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	zf->ptrToFree = zf->data = attemptckalloc(zf->length);
	if (!zf->ptrToFree) {
	    ZIPFS_ERROR(interp, "out of memory");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    goto error;
	}
	i = Tcl_Read(zf->chan, (char *) zf->data, zf->length);
	if (i != zf->length) {
	    ZIPFS_POSIX_ERROR(interp, "file read error");
	    goto error;
	}
	Tcl_Close(interp, zf->chan);
	zf->chan = NULL;
    } else {
#ifdef _WIN32
	int readSuccessful;
#   ifdef _WIN64
	i = GetFileSizeEx((HANDLE) handle, (PLARGE_INTEGER) &zf->length);
	readSuccessful = (i != 0);
#   else /* !_WIN64 */
	zf->length = GetFileSize((HANDLE) handle, 0);
	readSuccessful = (zf->length != (size_t) INVALID_FILE_SIZE);
#   endif /* _WIN64 */
	if (!readSuccessful || (zf->length < ZIP_CENTRAL_END_LEN)) {
	    ZIPFS_POSIX_ERROR(interp, "invalid file size");
	    goto error;
	}
	zf->mountHandle = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY,
		0, zf->length, 0);
	if (zf->mountHandle == INVALID_HANDLE_VALUE) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
	zf->data = MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0,
		zf->length);
	if (!zf->data) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
#else /* !_WIN32 */
	zf->length = lseek(PTR2INT(handle), 0, SEEK_END);
	if (zf->length == ERROR_LENGTH || zf->length < ZIP_CENTRAL_END_LEN) {
	    ZIPFS_POSIX_ERROR(interp, "invalid file size");
	    goto error;
	}
	lseek(PTR2INT(handle), 0, SEEK_SET);
	zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ,
		MAP_FILE | MAP_PRIVATE, PTR2INT(handle), 0);
	if (zf->data == MAP_FAILED) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
#endif /* _WIN32 */
    }
    return ZipFSFindTOC(interp, needZip, zf);

  error:
    ZipFSCloseArchive(interp, zf);
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSRootNode --
 *
 *	This function generates the root node for a ZIPFS filesystem.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	...
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSCatalogFilesystem(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    ZipFile *zf0,
    const char *mountPoint,	/* Mount point path. */
    const char *passwd,		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
    const char *zipname)	/* Path to ZIP file to build a catalog of. */
{
    int pwlen, isNew;
    size_t i;
    ZipFile *zf;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_DString ds, dsm, fpBuf;
    unsigned char *q;

    /*
     * Basic verification of the password for sanity.
     */

    pwlen = 0;
    if (passwd) {
	pwlen = strlen(passwd);
	if ((pwlen > 255) || strchr(passwd, 0xff)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    return TCL_ERROR;
	}
    }

    WriteLock();

    /*
     * Mount point sometimes is a relative or otherwise denormalized path.
     * But an absolute name is needed as mount point here.
     */

    Tcl_DStringInit(&ds);
    Tcl_DStringInit(&dsm);
    if (strcmp(mountPoint, "/") == 0) {
	mountPoint = "";
    } else {
	mountPoint = CanonicalPath("", mountPoint, &dsm, 1);
    }
    hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mountPoint, &isNew);
    if (!isNew) {
	if (interp) {
	    zf = Tcl_GetHashValue(hPtr);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s is already mounted on %s", zf->name, mountPoint));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "MOUNTED", NULL);
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    Unlock();

    *zf = *zf0;
    zf->mountPoint = Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
    zf->mountPointLen = strlen(zf->mountPoint);
    zf->nameLength = strlen(zipname);
    zf->name = ckalloc(zf->nameLength + 1);
    memcpy(zf->name, zipname, zf->nameLength + 1);
    zf->entries = NULL;
    zf->topEnts = NULL;
    zf->numOpen = 0;
    Tcl_SetHashValue(hPtr, zf);
    if ((zf->passBuf[0] == 0) && pwlen) {
	int k = 0;

	zf->passBuf[k++] = pwlen;
	for (i = pwlen; i-- > 0 ;) {
	    zf->passBuf[k++] = (passwd[i] & 0x0f)
		    | pwrot[(passwd[i] >> 4) & 0x0f];
	}
	zf->passBuf[k] = '\0';
    }
    if (mountPoint[0] != '\0') {
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mountPoint, &isNew);
	if (isNew) {
	    z = ckalloc(sizeof(ZipEntry));
	    Tcl_SetHashValue(hPtr, z);

	    z->tnext = NULL;
	    z->depth = CountSlashes(mountPoint);
	    z->zipFilePtr = zf;
	    z->isDirectory = (zf->baseOffset == 0) ? 1 : -1; /* root marker */
	    z->isEncrypted = 0;
	    z->offset = zf->baseOffset;
	    z->crc32 = 0;
	    z->timestamp = 0;
	    z->numBytes = z->numCompressedBytes = 0;
	    z->compressMethod = ZIP_COMPMETH_STORED;
	    z->data = NULL;
	    z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	}
    }
    q = zf->data + zf->directoryOffset;
    Tcl_DStringInit(&fpBuf);
    for (i = 0; i < zf->numFiles; i++) {
	int extra, isdir = 0, dosTime, dosDate, nbcompr;
	size_t offs, pathlen, comlen;
	unsigned char *lq, *gq = NULL;
	char *fullpath, *path;

	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	Tcl_DStringSetLength(&ds, 0);
	Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
	path = Tcl_DStringValue(&ds);
	if ((pathlen > 0) && (path[pathlen - 1] == '/')) {
	    Tcl_DStringSetLength(&ds, pathlen - 1);
	    path = Tcl_DStringValue(&ds);
	    isdir = 1;
	}
	if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) {
	    goto nextent;
	}
	lq = zf->data + zf->baseOffset
		+ ZipReadInt(q + ZIP_CENTRAL_LOCALHDR_OFFS);
	if ((lq < zf->data) || (lq > zf->data + zf->length)) {
	    goto nextent;
	}
	nbcompr = ZipReadInt(lq + ZIP_LOCAL_COMPLEN_OFFS);
	if (!isdir && (nbcompr == 0)
		&& (ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0)
		&& (ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
	    gq = q;
	    nbcompr = ZipReadInt(gq + ZIP_CENTRAL_COMPLEN_OFFS);
	}
	offs = (lq - zf->data)
		+ ZIP_LOCAL_HEADER_LEN
		+ ZipReadShort(lq + ZIP_LOCAL_PATHLEN_OFFS)
		+ ZipReadShort(lq + ZIP_LOCAL_EXTRALEN_OFFS);
	if (offs + nbcompr > zf->length) {
	    goto nextent;
	}
	if (!isdir && (mountPoint[0] == '\0') && !CountSlashes(path)) {
#ifdef ANDROID
	    /*
	     * When mounting the ZIP archive on the root directory try to
	     * remap top level regular files of the archive to
	     * /assets/.root/... since this directory should not be in a valid
	     * APK due to the leading dot in the file name component. This
	     * trick should make the files AndroidManifest.xml,
	     * resources.arsc, and classes.dex visible to Tcl.
	     */
	    Tcl_DString ds2;

	    Tcl_DStringInit(&ds2);
	    Tcl_DStringAppend(&ds2, "assets/.root/", -1);
	    Tcl_DStringAppend(&ds2, path, -1);
	    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2));
	    if (hPtr) {
		/* should not happen but skip it anyway */
		Tcl_DStringFree(&ds2);
		goto nextent;
	    }
	    Tcl_DStringSetLength(&ds, 0);
	    Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2),
		    Tcl_DStringLength(&ds2));
	    path = Tcl_DStringValue(&ds);
	    Tcl_DStringFree(&ds2);
#else /* !ANDROID */
	    /*
	     * Regular files skipped when mounting on root.
	     */
	    goto nextent;
#endif /* ANDROID */
	}
	Tcl_DStringSetLength(&fpBuf, 0);
	fullpath = CanonicalPath(mountPoint, path, &fpBuf, 1);
	z = ckalloc(sizeof(ZipEntry));
	z->name = NULL;
	z->tnext = NULL;
	z->depth = CountSlashes(fullpath);
	z->zipFilePtr = zf;
	z->isDirectory = isdir;
	z->isEncrypted = (ZipReadShort(lq + ZIP_LOCAL_FLAGS_OFFS) & 1)
		&& (nbcompr > 12);
	z->offset = offs;
	if (gq) {
	    z->crc32 = ZipReadInt(gq + ZIP_CENTRAL_CRC32_OFFS);
	    dosDate = ZipReadShort(gq + ZIP_CENTRAL_MDATE_OFFS);
	    dosTime = ZipReadShort(gq + ZIP_CENTRAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->numBytes = ZipReadInt(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(gq + ZIP_CENTRAL_COMPMETH_OFFS);
	} else {
	    z->crc32 = ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS);
	    dosDate = ZipReadShort(lq + ZIP_LOCAL_MDATE_OFFS);
	    dosTime = ZipReadShort(lq + ZIP_LOCAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->numBytes = ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(lq + ZIP_LOCAL_COMPMETH_OFFS);
	}
	z->numCompressedBytes = nbcompr;
	z->data = NULL;
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew);
	if (!isNew) {
	    /* should not happen but skip it anyway */
	    ckfree(z);
	} else {
	    Tcl_SetHashValue(hPtr, z);
	    z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	    if (isdir && (mountPoint[0] == '\0') && (z->depth == 1)) {
		z->tnext = zf->topEnts;
		zf->topEnts = z;
	    }
	    if (!z->isDirectory && (z->depth > 1)) {
		char *dir, *end;
		ZipEntry *zd;

		Tcl_DStringSetLength(&ds, strlen(z->name) + 8);
		Tcl_DStringSetLength(&ds, 0);
		Tcl_DStringAppend(&ds, z->name, -1);
		dir = Tcl_DStringValue(&ds);
		for (end = strrchr(dir, '/'); end && (end != dir);
			end = strrchr(dir, '/')) {
		    Tcl_DStringSetLength(&ds, end - dir);
		    hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
		    if (!isNew) {
			break;
		    }
		    zd = ckalloc(sizeof(ZipEntry));
		    zd->name = NULL;
		    zd->tnext = NULL;
		    zd->depth = CountSlashes(dir);
		    zd->zipFilePtr = zf;
		    zd->isDirectory = 1;
		    zd->isEncrypted = 0;
		    zd->offset = z->offset;
		    zd->crc32 = 0;
		    zd->timestamp = z->timestamp;
		    zd->numBytes = zd->numCompressedBytes = 0;
		    zd->compressMethod = ZIP_COMPMETH_STORED;
		    zd->data = NULL;
		    Tcl_SetHashValue(hPtr, zd);
		    zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
		    zd->next = zf->entries;
		    zf->entries = zd;
		    if ((mountPoint[0] == '\0') && (zd->depth == 1)) {
			zd->tnext = zf->topEnts;
			zf->topEnts = zd;
		    }
		}
	    }
	}
    nextent:
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
    }
    Tcl_DStringFree(&fpBuf);
    Tcl_DStringFree(&ds);
    Tcl_FSMountsChanged(NULL);
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipfsSetup --
 *
 *	Common initialisation code. ZipFS.initialized must *not* be set prior
 *	to the call.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipfsSetup(void)
{
#if TCL_THREADS
    static const Tcl_Time t = { 0, 0 };

    /*
     * Inflate condition variable.
     */

    Tcl_MutexLock(&ZipFSMutex);
    Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t);
    Tcl_MutexUnlock(&ZipFSMutex);
#endif /* TCL_THREADS */

    Tcl_FSRegister(NULL, &zipfsFilesystem);
    Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS);
    Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
    ZipFS.idCount = 1;
    ZipFS.wrmax = DEFAULT_WRITE_MAX_SIZE;
    ZipFS.initialized = 1;
}

/*
 *-------------------------------------------------------------------------
 *
 * ListMountPoints --
 *
 *	This procedure lists the mount points and what's mounted there, or
 *	reports whether there are any mounts (if there's no interpreter). The
 *	read lock must be held by the caller.
 *
 * Results:
 *	A standard Tcl result. TCL_OK (or TCL_BREAK if no mounts and no
 *	interpreter).
 *
 * Side effects:
 *	Interpreter result may be updated.
 *
 *-------------------------------------------------------------------------
 */

static inline int
ListMountPoints(
    Tcl_Interp *interp)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    ZipFile *zf;

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	if (!interp) {
	    return TCL_OK;
	}
	zf = Tcl_GetHashValue(hPtr);
	Tcl_AppendElement(interp, zf->mountPoint);
	Tcl_AppendElement(interp, zf->name);
    }
    return (interp ? TCL_OK : TCL_BREAK);
}

/*
 *-------------------------------------------------------------------------
 *
 * DescribeMounted --
 *
 *	This procedure describes what is mounted at the given the mount point.
 *	The interpreter result is not updated if there is nothing mounted at
 *	the given point. The read lock must be held by the caller.
 *
 * Results:
 *	A standard Tcl result. TCL_OK (or TCL_BREAK if nothing mounted there
 *	and no interpreter).
 *
 * Side effects:
 *	Interpreter result may be updated.
 *
 *-------------------------------------------------------------------------
 */

static inline int
DescribeMounted(
    Tcl_Interp *interp,
    const char *mountPoint)
{
    Tcl_HashEntry *hPtr;
    ZipFile *zf;

    if (interp) {
	hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
	if (hPtr) {
	    zf = Tcl_GetHashValue(hPtr);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1));
	    return TCL_OK;
	}
    }
    return (interp ? TCL_OK : TCL_BREAK);
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Mount --
 *
 *	This procedure is invoked to mount a given ZIP archive file on a given
 *	mountpoint with optional ZIP password.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is read, analyzed and mounted, resources are
 *	allocated.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Mount(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint,	/* Mount point path. */
    const char *zipname,	/* Path to ZIP file to mount. */
    const char *passwd)		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
{
    ZipFile *zf;

    ReadLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }

    /*
     * No mount point, so list all mount points and what is mounted there.
     */

    if (!mountPoint) {
	int ret = ListMountPoints(interp);
	Unlock();
	return ret;
    }

    /*
     * Mount point but no file, so describe what is mounted at that mount
     * point.
     */

    if (!zipname) {
	DescribeMounted(interp, mountPoint);
	Unlock();
	return TCL_OK;
    }
    Unlock();

    /*
     * Have both a mount point and a file (name) to mount there.
     */

    if (passwd) {
	if ((strlen(passwd) > 255) || strchr(passwd, 0xff)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    return TCL_ERROR;
	}
    }
    zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	return TCL_ERROR;
    }
    if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) {
	return TCL_ERROR;
    }
    return ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname);
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_MountBuffer --
 *
 *	This procedure is invoked to mount a given ZIP archive file on a given
 *	mountpoint with optional ZIP password.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is read, analyzed and mounted, resources are
 *	allocated.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_MountBuffer(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint,	/* Mount point path. */
    unsigned char *data,
    size_t datalen,
    int copy)
{
    ZipFile *zf;

    ReadLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }

    /*
     * No mount point, so list all mount points and what is mounted there.
     */

    if (!mountPoint) {
	int ret = ListMountPoints(interp);
	Unlock();
	return ret;
    }

    /*
     * Mount point but no data, so describe what is mounted at that mount
     * point.
     */

    if (!data) {
	DescribeMounted(interp, mountPoint);
	Unlock();
	return TCL_OK;
    }
    Unlock();

    /*
     * Have both a mount point and data to mount there.
     */

    zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	return TCL_ERROR;
    }
    zf->isMemBuffer = 1;
    zf->length = datalen;
    if (copy) {
	zf->data = attemptckalloc(datalen);
	if (!zf->data) {
	    if (interp) {
		Tcl_AppendResult(interp, "out of memory", (char *) NULL);
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    return TCL_ERROR;
	}
	memcpy(zf->data, data, datalen);
	zf->ptrToFree = zf->data;
    } else {
	zf->data = data;
	zf->ptrToFree = NULL;
    }
    if (ZipFSFindTOC(interp, 0, zf) != TCL_OK) {
	return TCL_ERROR;
    }
    return ZipFSCatalogFilesystem(interp, zf, mountPoint, NULL,
	    "Memory Buffer");
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Unmount --
 *
 *	This procedure is invoked to unmount a given ZIP archive.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A mounted ZIP archive file is unmounted, resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Unmount(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint)	/* Mount point path. */
{
    ZipFile *zf;
    ZipEntry *z, *znext;
    Tcl_HashEntry *hPtr;
    Tcl_DString dsm;
    int ret = TCL_OK, unmounted = 0;

    WriteLock();
    if (!ZipFS.initialized) {
	goto done;
    }

    /*
     * Mount point sometimes is a relative or otherwise denormalized path.
     * But an absolute name is needed as mount point here.
     */

    Tcl_DStringInit(&dsm);
    mountPoint = CanonicalPath("", mountPoint, &dsm, 1);

    hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
    /* don't report no-such-mount as an error */
    if (!hPtr) {
	goto done;
    }

    zf = Tcl_GetHashValue(hPtr);
    if (zf->numOpen > 0) {
	ZIPFS_ERROR(interp, "filesystem is busy");
	ret = TCL_ERROR;
	goto done;
    }
    Tcl_DeleteHashEntry(hPtr);
    for (z = zf->entries; z; z = znext) {
	znext = z->next;
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name);
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
	if (z->data) {
	    ckfree(z->data);
	}
	ckfree(z);
    }
    ZipFSCloseArchive(interp, zf);
    ckfree(zf);
    unmounted = 1;
  done:
    Unlock();
    if (unmounted) {
	Tcl_FSMountsChanged(NULL);
    }
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMountObjCmd --
 *
 *	This procedure is invoked to process the [zipfs mount] command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is mounted, resources are allocated.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMountObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		 "?mountpoint? ?zipfile? ?password?");
	return TCL_ERROR;
    }

    return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL,
	    (objc > 2) ? Tcl_GetString(objv[2]) : NULL,
	    (objc > 3) ? Tcl_GetString(objv[3]) : NULL);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMountBufferObjCmd --
 *
 *	This procedure is invoked to process the [zipfs mount_data] command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is mounted, resources are allocated.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMountBufferObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *mountPoint;	/* Mount point path. */
    unsigned char *data;
    int length;

    if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?");
	return TCL_ERROR;
    }
    if (objc < 2) {
	int ret;

	ReadLock();
	ret = ListMountPoints(interp);
	Unlock();
	return ret;
    }

    mountPoint = Tcl_GetString(objv[1]);
    if (objc < 3) {
	ReadLock();
	DescribeMounted(interp, mountPoint);
	Unlock();
	return TCL_OK;
    }

    data = Tcl_GetByteArrayFromObj(objv[2], &length);
    return TclZipfs_MountBuffer(interp, mountPoint, data, length, 1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSRootObjCmd --
 *
 *	This procedure is invoked to process the [zipfs root] command. It
 *	returns the root that all zipfs file systems are mounted under.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSRootObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, -1));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSUnmountObjCmd --
 *
 *	This procedure is invoked to process the [zipfs unmount] command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A mounted ZIP archive file is unmounted, resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSUnmountObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "zipfile");
	return TCL_ERROR;
    }
    return TclZipfs_Unmount(interp, Tcl_GetString(objv[1]));
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkKeyObjCmd --
 *
 *	This procedure is invoked to process the [zipfs mkkey] command.  It
 *	produces a rotated password to be embedded into an image file.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkKeyObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int len, i = 0;
    char *pw, passBuf[264];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = Tcl_GetString(objv[1]);
    len = strlen(pw);
    if (len == 0) {
	return TCL_OK;
    }
    if ((len > 255) || strchr(pw, 0xff)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1));
	return TCL_ERROR;
    }
    while (len > 0) {
	int ch = pw[len - 1];

	passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	i++;
	len--;
    }
    passBuf[i] = i;
    ++i;
    passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;
    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
    passBuf[i] = '\0';
    Tcl_AppendResult(interp, passBuf, (char *) NULL);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipAddFile --
 *
 *	This procedure is used by ZipFSMkZipOrImgCmd() to add a single file to
 *	the output ZIP archive file being written. A ZipEntry struct about the
 *	input file is added to the given fileHash table for later creation of
 *	the central ZIP directory.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Input file is read and (compressed and) written to the output ZIP
 *	archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipAddFile(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *path,
    const char *name,
    Tcl_Channel out,
    const char *passwd,		/* Password for encoding the file, or NULL if
				 * the file is to be unprotected. */
    char *buf,
    int bufsize,
    Tcl_HashTable *fileHash)
{
    Tcl_Channel in;
    Tcl_HashEntry *hPtr;
    ZipEntry *z;
    z_stream stream;
    const char *zpath;
    int crc, flush, zpathlen;
    size_t nbyte, nbytecompr, len, olen, align = 0;
    Tcl_WideInt pos[3];
    int mtime = 0, isNew, compMeth;
    unsigned long keys[3], keys0[3];
    char obuf[4096];

    /*
     * Trim leading '/' characters. If this results in an empty string, we've
     * nothing to do.
     */

    zpath = name;
    while (zpath && zpath[0] == '/') {
	zpath++;
    }
    if (!zpath || (zpath[0] == '\0')) {
	return TCL_OK;
    }

    zpathlen = strlen(zpath);
    if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"path too long for \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "PATH_LEN", NULL);
	return TCL_ERROR;
    }
    in = Tcl_OpenFileChannel(interp, path, "rb", 0);
    if (!in) {
#ifdef _WIN32
	/* hopefully a directory */
	if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
	    Tcl_Close(interp, in);
	    return TCL_OK;
	}
#endif /* _WIN32 */
	Tcl_Close(interp, in);
	return TCL_ERROR;
    } else {
	Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1);
	Tcl_StatBuf statBuf;

	Tcl_IncrRefCount(pathObj);
	if (Tcl_FSStat(pathObj, &statBuf) != -1) {
	    mtime = statBuf.st_mtime;
	}
	Tcl_DecrRefCount(pathObj);
    }
    Tcl_ResetResult(interp);
    crc = 0;
    nbyte = nbytecompr = 0;
    while (1) {
	len = Tcl_Read(in, buf, bufsize);
	if (len == ERROR_LENGTH) {
	    if (nbyte == 0 && errno == EISDIR) {
		Tcl_Close(interp, in);
		return TCL_OK;
	    }
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",
		    path, Tcl_PosixError(interp)));
	    Tcl_Close(interp, in);
	    return TCL_ERROR;
	}
	if (len == 0) {
	    break;
	}
	crc = crc32(crc, (unsigned char *) buf, len);
	nbyte += len;
    }
    if (Tcl_Seek(in, 0, SEEK_SET) == -1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s",
		path, Tcl_PosixError(interp)));
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }
    pos[0] = Tcl_Tell(out);
    memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
    memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen);
    len = zpathlen + ZIP_LOCAL_HEADER_LEN;
    if ((size_t) Tcl_Write(out, buf, len) != len) {
    wrerr:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error on %s: %s", path, Tcl_PosixError(interp)));
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }
    if ((len + pos[0]) & 3) {
	unsigned char abuf[8];

	/*
	 * Align payload to next 4-byte boundary using a dummy extra entry
	 * similar to the zipalign tool from Android's SDK.
	 */

	align = 4 + ((len + pos[0]) & 3);
	ZipWriteShort(abuf, 0xffff);
	ZipWriteShort(abuf + 2, align - 4);
	ZipWriteInt(abuf + 4, 0x03020100);
	if ((size_t) Tcl_Write(out, (const char *) abuf, align) != align) {
	    goto wrerr;
	}
    }
    if (passwd) {
	int i, ch, tmp;
	unsigned char kvbuf[24];
	Tcl_Obj *ret;

	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < 12 - 2; i++) {
	    double r;

	    if (Tcl_EvalEx(interp, "::tcl::mathfunc::rand", -1, 0) != TCL_OK) {
		Tcl_Obj *eiPtr = Tcl_ObjPrintf(
			"\n    (evaluating PRNG step %d for password encoding)",
			i);

		Tcl_AppendObjToErrorInfo(interp, eiPtr);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    ret = Tcl_GetObjResult(interp);
	    if (Tcl_GetDoubleFromObj(interp, ret, &r) != TCL_OK) {
		Tcl_Obj *eiPtr = Tcl_ObjPrintf(
			"\n    (evaluating PRNG step %d for password encoding)",
			i);

		Tcl_AppendObjToErrorInfo(interp, eiPtr);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    ch = (int) (r * 256);
	    kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp);
	}
	Tcl_ResetResult(interp);
	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < 12 - 2; i++) {
	    kvbuf[i] = (unsigned char)
		    zencode(keys, crc32tab, kvbuf[i + 12], tmp);
	}
	kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp);
	kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp);
	len = Tcl_Write(out, (char *) kvbuf, 12);
	memset(kvbuf, 0, 24);
	if (len != 12) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error on %s: %s", path, Tcl_PosixError(interp)));
	    Tcl_Close(interp, in);
	    return TCL_ERROR;
	}
	memcpy(keys0, keys, sizeof(keys0));
	nbytecompr += 12;
    }
    Tcl_Flush(out);
    pos[2] = Tcl_Tell(out);
    compMeth = ZIP_COMPMETH_DEFLATED;
    memset(&stream, 0, sizeof(z_stream));
    stream.zalloc = Z_NULL;
    stream.zfree = Z_NULL;
    stream.opaque = Z_NULL;
    if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8,
	    Z_DEFAULT_STRATEGY) != Z_OK) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"compression init error on \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE_INIT", NULL);
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }
    do {
	len = Tcl_Read(in, buf, bufsize);
	if (len == ERROR_LENGTH) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "read error on %s: %s", path, Tcl_PosixError(interp)));
	    deflateEnd(&stream);
	    Tcl_Close(interp, in);
	    return TCL_ERROR;
	}
	stream.avail_in = len;
	stream.next_in = (unsigned char *) buf;
	flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH;
	do {
	    stream.avail_out = sizeof(obuf);
	    stream.next_out = (unsigned char *) obuf;
	    len = deflate(&stream, flush);
	    if (len == (size_t) Z_STREAM_ERROR) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"deflate error on %s", path));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE", NULL);
		deflateEnd(&stream);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    olen = sizeof(obuf) - stream.avail_out;
	    if (passwd) {
		size_t i;
		int tmp;

		for (i = 0; i < olen; i++) {
		    obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp);
		}
	    }
	    if (olen && ((size_t) Tcl_Write(out, obuf, olen) != olen)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		deflateEnd(&stream);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    nbytecompr += olen;
	} while (stream.avail_out == 0);
    } while (flush != Z_FINISH);
    deflateEnd(&stream);
    Tcl_Flush(out);
    pos[1] = Tcl_Tell(out);
    if (nbyte - nbytecompr <= 0) {
	/*
	 * Compressed file larger than input, write it again uncompressed.
	 */
	if (Tcl_Seek(in, 0, SEEK_SET) != 0) {
	    goto seekErr;
	}
	if (Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) {
	seekErr:
	    Tcl_Close(interp, in);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "seek error: %s", Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	nbytecompr = (passwd ? 12 : 0);
	while (1) {
	    len = Tcl_Read(in, buf, bufsize);
	    if (len == ERROR_LENGTH) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"read error on \"%s\": %s",
			path, Tcl_PosixError(interp)));
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    } else if (len == 0) {
		break;
	    }
	    if (passwd) {
		size_t i;
		int tmp;

		for (i = 0; i < len; i++) {
		    buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp);
		}
	    }
	    if ((size_t) Tcl_Write(out, buf, len) != len) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    nbytecompr += len;
	}
	compMeth = ZIP_COMPMETH_STORED;
	Tcl_Flush(out);
	pos[1] = Tcl_Tell(out);
	Tcl_TruncateChannel(out, pos[1]);
    }
    Tcl_Close(interp, in);

    hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"non-unique path name \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DUPLICATE_PATH", NULL);
	return TCL_ERROR;
    }

    z = ckalloc(sizeof(ZipEntry));
    Tcl_SetHashValue(hPtr, z);
    z->name = NULL;
    z->tnext = NULL;
    z->depth = 0;
    z->zipFilePtr = NULL;
    z->isDirectory = 0;
    z->isEncrypted = (passwd ? 1 : 0);
    z->offset = pos[0];
    z->crc32 = crc;
    z->timestamp = mtime;
    z->numBytes = nbyte;
    z->numCompressedBytes = nbytecompr;
    z->compressMethod = compMeth;
    z->data = NULL;
    z->name = Tcl_GetHashKey(fileHash, hPtr);
    z->next = NULL;

    /*
     * Write final local header information.
     */
    ZipWriteInt(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG);
    ZipWriteShort(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION);
    ZipWriteShort(buf + ZIP_LOCAL_FLAGS_OFFS, z->isEncrypted);
    ZipWriteShort(buf + ZIP_LOCAL_COMPMETH_OFFS, z->compressMethod);
    ZipWriteShort(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp));
    ZipWriteShort(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp));
    ZipWriteInt(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32);
    ZipWriteInt(buf + ZIP_LOCAL_COMPLEN_OFFS, z->numCompressedBytes);
    ZipWriteInt(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->numBytes);
    ZipWriteShort(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen);
    ZipWriteShort(buf + ZIP_LOCAL_EXTRALEN_OFFS, align);
    if (Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) {
	Tcl_DeleteHashEntry(hPtr);
	ckfree(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"seek error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) {
	Tcl_DeleteHashEntry(hPtr);
	ckfree(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_Flush(out);
    if (Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) {
	Tcl_DeleteHashEntry(hPtr);
	ckfree(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"seek error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipOrImgObjCmd --
 *
 *	This procedure is creates a new ZIP archive file or image file given
 *	output filename, input directory of files to be archived, optional
 *	password, and optional image to be prepended to the output ZIP archive
 *	file.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A new ZIP archive file or image file is written.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkZipOrImgObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int isImg,
    int isList,
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel out;
    int pwlen = 0, count, ret = TCL_ERROR, lobjc;
    size_t len, slen = 0, i = 0;
    Tcl_WideInt pos[3];
    Tcl_Obj **lobjv, *list = NULL;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable fileHash;
    char *strip = NULL, *pw = NULL, passBuf[264], buf[4096];

    /*
     * Caller has verified that the number of arguments is correct.
     */

    passBuf[0] = 0;
    if (objc > (isList ? 3 : 4)) {
	pw = Tcl_GetString(objv[isList ? 3 : 4]);
	pwlen = strlen(pw);
	if ((pwlen > 255) || strchr(pw, 0xff)) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("illegal password", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    return TCL_ERROR;
	}
    }
    if (isList) {
	list = objv[2];
	Tcl_IncrRefCount(list);
    } else {
	Tcl_Obj *cmd[3];

	cmd[1] = Tcl_NewStringObj("::tcl::zipfs::find", -1);
	cmd[2] = objv[2];
	cmd[0] = Tcl_NewListObj(2, cmd + 1);
	Tcl_IncrRefCount(cmd[0]);
	if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) {
	    Tcl_DecrRefCount(cmd[0]);
	    return TCL_ERROR;
	}
	Tcl_DecrRefCount(cmd[0]);
	list = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(list);
    }
    if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (isList && (lobjc % 2)) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("need even number of elements", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "LIST_LENGTH", NULL);
	return TCL_ERROR;
    }
    if (lobjc == 0) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
	return TCL_ERROR;
    }
    out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "wb", 0755);
    if (out == NULL) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (pwlen <= 0) {
	pw = NULL;
	pwlen = 0;
    }
    if (isImg) {
	ZipFile *zf, zf0;
	int isMounted = 0;
	const char *imgName;

	if (isList) {
	    imgName = (objc > 4) ? Tcl_GetString(objv[4]) :
		    Tcl_GetNameOfExecutable();
	} else {
	    imgName = (objc > 5) ? Tcl_GetString(objv[5]) :
		    Tcl_GetNameOfExecutable();
	}
	if (pwlen) {
	    i = 0;
	    for (len = pwlen; len-- > 0;) {
		int ch = pw[len];

		passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
		i++;
	    }
	    passBuf[i] = i;
	    ++i;
	    passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;
	    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
	    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
	    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
	    passBuf[i] = '\0';
	}

	/*
	 * Check for mounted image.
	 */

	WriteLock();
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    zf = Tcl_GetHashValue(hPtr);
	    if (strcmp(zf->name, imgName) == 0) {
		isMounted = 1;
		zf->numOpen++;
		break;
	    }
	}
	Unlock();
	if (!isMounted) {
	    zf = &zf0;
	}
	if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) {
	    if ((size_t) Tcl_Write(out, (char *) zf->data,
		    zf->passOffset) != zf->passOffset) {
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_Close(interp, out);
		if (zf == &zf0) {
		    ZipFSCloseArchive(interp, zf);
		} else {
		    WriteLock();
		    zf->numOpen--;
		    Unlock();
		}
		return TCL_ERROR;
	    }
	    if (zf == &zf0) {
		ZipFSCloseArchive(interp, zf);
	    } else {
		WriteLock();
		zf->numOpen--;
		Unlock();
	    }
	} else {
	    size_t k;
	    int m, n;
	    Tcl_Channel in;
	    const char *errMsg = "seek error";

	    /*
	     * Fall back to read it as plain file which hopefully is a static
	     * tclsh or wish binary with proper zipfs infrastructure built in.
	     */

	    Tcl_ResetResult(interp);
	    in = Tcl_OpenFileChannel(interp, imgName, "rb", 0644);
	    if (!in) {
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_Close(interp, out);
		return TCL_ERROR;
	    }
	    i = Tcl_Seek(in, 0, SEEK_END);
	    if (i == ERROR_LENGTH) {
	    cperr:
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"%s: %s", errMsg, Tcl_PosixError(interp)));
		Tcl_Close(interp, out);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    Tcl_Seek(in, 0, SEEK_SET);
	    for (k = 0; k < i; k += m) {
		m = i - k;
		if (m > (int) sizeof(buf)) {
		    m = (int) sizeof(buf);
		}
		n = Tcl_Read(in, buf, m);
		if (n == -1) {
		    errMsg = "read error";
		    goto cperr;
		} else if (n == 0) {
		    break;
		}
		m = Tcl_Write(out, buf, n);
		if (m != n) {
		    errMsg = "write error";
		    goto cperr;
		}
	    }
	    Tcl_Close(interp, in);
	}
	len = strlen(passBuf);
	if (len > 0) {
	    i = Tcl_Write(out, passBuf, len);
	    if (i != len) {
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_Close(interp, out);
		return TCL_ERROR;
	    }
	}
	memset(passBuf, 0, sizeof(passBuf));
	Tcl_Flush(out);
    }
    Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
    pos[0] = Tcl_Tell(out);
    if (!isList && (objc > 3)) {
	strip = Tcl_GetString(objv[3]);
	slen = strlen(strip);
    }
    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = Tcl_GetString(lobjv[i]);
	if (isList) {
	    name = Tcl_GetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
		name += slen;
	    }
	}
	while (name[0] == '/') {
	    ++name;
	}
	if (name[0] == '\0') {
	    continue;
	}
	if (ZipAddFile(interp, path, name, out, pw, buf, sizeof(buf),
		&fileHash) != TCL_OK) {
	    goto done;
	}
    }
    pos[1] = Tcl_Tell(out);
    count = 0;
    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = Tcl_GetString(lobjv[i]);
	if (isList) {
	    name = Tcl_GetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
		name += slen;
	    }
	}
	while (name[0] == '/') {
	    ++name;
	}
	if (name[0] == '\0') {
	    continue;
	}
	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (!hPtr) {
	    continue;
	}
	z = Tcl_GetHashValue(hPtr);
	len = strlen(z->name);
	ZipWriteInt(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isEncrypted);
	ZipWriteShort(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->compressMethod);
	ZipWriteShort(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp));
	ZipWriteShort(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp));
	ZipWriteInt(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32);
	ZipWriteInt(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->numCompressedBytes);
	ZipWriteInt(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->numBytes);
	ZipWriteShort(buf + ZIP_CENTRAL_PATHLEN_OFFS, len);
	ZipWriteShort(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_IATTR_OFFS, 0);
	ZipWriteInt(buf + ZIP_CENTRAL_EATTR_OFFS, 0);
	ZipWriteInt(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]);
	if ((Tcl_Write(out, buf,
		    ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN)
		|| ((size_t) Tcl_Write(out, z->name, len) != len)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error: %s", Tcl_PosixError(interp)));
	    goto done;
	}
	count++;
    }
    Tcl_Flush(out);
    pos[2] = Tcl_Tell(out);
    ZipWriteInt(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG);
    ZipWriteShort(buf + ZIP_CENTRAL_DISKNO_OFFS, 0);
    ZipWriteShort(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0);
    ZipWriteShort(buf + ZIP_CENTRAL_ENTS_OFFS, count);
    ZipWriteShort(buf + ZIP_CENTRAL_TOTALENTS_OFFS, count);
    ZipWriteInt(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]);
    ZipWriteInt(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]);
    ZipWriteShort(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);
    if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error: %s", Tcl_PosixError(interp)));
	goto done;
    }
    Tcl_Flush(out);
    ret = TCL_OK;

  done:
    if (ret == TCL_OK) {
	ret = Tcl_Close(interp, out);
    } else {
	Tcl_Close(interp, out);
    }
    Tcl_DecrRefCount(list);
    for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	z = Tcl_GetHashValue(hPtr);
	ckfree(z);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&fileHash);
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipObjCmd, ZipFSLMkZipObjCmd --
 *
 *	These procedures are invoked to process the [zipfs mkzip] and [zipfs
 *	lmkzip] commands.  See description of ZipFSMkZipOrImgCmd().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkZipObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile indir ?strip? ?password?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 0, 0, objc, objv);
}

static int
ZipFSLMkZipObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 0, 1, objc, objv);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkImgObjCmd, ZipFSLMkImgObjCmd --
 *
 *	These procedures are invoked to process the [zipfs mkimg] and [zipfs
 *	lmkimg] commands.  See description of ZipFSMkZipOrImgCmd().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkImgObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 6) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"outfile indir ?strip? ?password? ?infile?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 1, 0, objc, objv);
}

static int
ZipFSLMkImgObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password infile?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 1, 1, objc, objv);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSCanonicalObjCmd --
 *
 *	This procedure is invoked to process the [zipfs canonical] command.
 *	It returns the canonical name for a file within zipfs
 *
 * Results:
 *	Always TCL_OK provided the right number of arguments are supplied.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSCanonicalObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *mntpoint = NULL;
    char *filename = NULL;
    char *result;
    Tcl_DString dPath;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? filename ?inZipfs?");
	return TCL_ERROR;
    }
    Tcl_DStringInit(&dPath);
    if (objc == 2) {
	filename = Tcl_GetString(objv[1]);
	result = CanonicalPath("", filename, &dPath, 1);
    } else if (objc == 3) {
	mntpoint = Tcl_GetString(objv[1]);
	filename = Tcl_GetString(objv[2]);
	result = CanonicalPath(mntpoint, filename, &dPath, 1);
    } else {
	int zipfs = 0;

	if (Tcl_GetBooleanFromObj(interp, objv[3], &zipfs)) {
	    return TCL_ERROR;
	}
	mntpoint = Tcl_GetString(objv[1]);
	filename = Tcl_GetString(objv[2]);
	result = CanonicalPath(mntpoint, filename, &dPath, zipfs);
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSExistsObjCmd --
 *
 *	This procedure is invoked to process the [zipfs exists] command.  It
 *	tests for the existence of a file in the ZIP filesystem and places a
 *	boolean into the interp's result.
 *
 * Results:
 *	Always TCL_OK provided the right number of arguments are supplied.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSExistsObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *filename;
    int exists;
    Tcl_DString ds;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }

    /*
     * Prepend ZIPFS_VOLUME to filename, eliding the final /
     */

    filename = Tcl_GetString(objv[1]);
    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN - 1);
    Tcl_DStringAppend(&ds, filename, -1);
    filename = Tcl_DStringValue(&ds);

    ReadLock();
    exists = ZipFSLookup(filename) != NULL;
    Unlock();

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSInfoObjCmd --
 *
 *	This procedure is invoked to process the [zipfs info] command.	 On
 *	success, it returns a Tcl list made up of name of ZIP archive file,
 *	size uncompressed, size compressed, and archive offset of a file in
 *	the ZIP filesystem.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSInfoObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *filename;
    ZipEntry *z;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }
    filename = Tcl_GetString(objv[1]);
    ReadLock();
    z = ZipFSLookup(filename);
    if (z) {
	Tcl_Obj *result = Tcl_GetObjResult(interp);

	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewStringObj(z->zipFilePtr->name, -1));
	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewWideIntObj(z->numBytes));
	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewWideIntObj(z->numCompressedBytes));
	Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(z->offset));
    }
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSListObjCmd --
 *
 *	This procedure is invoked to process the [zipfs list] command.	 On
 *	success, it returns a Tcl list of files of the ZIP filesystem which
 *	match a search pattern (glob or regexp).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSListObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *pattern = NULL;
    Tcl_RegExp regexp = NULL;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *result = Tcl_GetObjResult(interp);

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	int n;
	char *what = Tcl_GetStringFromObj(objv[1], &n);

	if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) {
	    pattern = Tcl_GetString(objv[2]);
	} else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) {
	    regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2]));
	    if (!regexp) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown option \"%s\"", what));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_OPT", NULL);
	    return TCL_ERROR;
	}
    } else if (objc == 2) {
	pattern = Tcl_GetString(objv[1]);
    }
    ReadLock();
    if (pattern) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);

	    if (Tcl_StringMatch(z->name, pattern)) {
		Tcl_ListObjAppendElement(interp, result,
			Tcl_NewStringObj(z->name, -1));
	    }
	}
    } else if (regexp) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);

	    if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) {
		Tcl_ListObjAppendElement(interp, result,
			Tcl_NewStringObj(z->name, -1));
	    }
	}
    } else {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);

	    Tcl_ListObjAppendElement(interp, result,
		    Tcl_NewStringObj(z->name, -1));
	}
    }
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_TclLibrary --
 *
 *	This procedure gets (and possibly finds) the root that Tcl's library
 *	files are mounted under.
 *
 * Results:
 *	A Tcl object holding the location (with zero refcount), or NULL if no
 *	Tcl library can be found.
 *
 * Side effects:
 *	May initialise the cache of where such library files are to be found.
 *	This cache is never cleared.
 *
 *-------------------------------------------------------------------------
 */

#ifdef _WIN32
#define LIBRARY_SIZE	    64

static inline int
WCharToUtf(
    const WCHAR *wSrc,
    char *dst)
{
    char *start = dst;

    while (*wSrc != '\0') {
	dst += Tcl_UniCharToUtf(*wSrc, dst);
	wSrc++;
    }
    *dst = '\0';
    return (int) (dst - start);
}
#endif /* _WIN32 */

Tcl_Obj *
TclZipfs_TclLibrary(void)
{
    Tcl_Obj *vfsInitScript;
    int found;
#ifdef _WIN32
    HMODULE hModule;
    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
    char dllName[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
#endif /* _WIN32 */

    /*
     * Use the cached value if that has been set; we don't want to repeat the
     * searching and mounting.
     */

    if (zipfs_literal_tcl_library) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }

    /*
     * Look for the library file system within the executable.
     */

    vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",
	    -1);
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == TCL_OK) {
	zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }

    /*
     * Look for the library file system within the DLL/shared library.  Note
     * that we must mount the zip file and dll before releasing to search.
     */

#if defined(_WIN32)
    hModule = TclWinGetTclInstance();
    if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
	GetModuleFileNameA(hModule, dllName, MAX_PATH);
    } else {
	WCharToUtf(wName, dllName);
    }

    if (ZipfsAppHookFindTclInit(dllName) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#elif /* !_WIN32 && */ defined(CFG_RUNTIME_DLLFILE)
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#endif /* _WIN32 || CFG_RUNTIME_DLLFILE */

    /*
     * If we're configured to know about a ZIP archive we should use, do that.
     */

#ifdef CFG_RUNTIME_ZIPFILE
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_SCRDIR "/" CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    if (ZipfsAppHookFindTclInit(CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#endif /* CFG_RUNTIME_ZIPFILE */

    /*
     * If anything set the cache (but subsequently failed) go with that
     * anyway.
     */

    if (zipfs_literal_tcl_library) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSTclLibraryObjCmd --
 *
 *	This procedure is invoked to process the
 *	[::tcl::zipfs::tcl_library_init] command, usually called during the
 *	execution of Tcl's interpreter startup. It returns the root that Tcl's
 *	library files are mounted under.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May initialise the cache of where such library files are to be found.
 *	This cache is never cleared.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSTclLibraryObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (!Tcl_IsSafe(interp)) {
	Tcl_Obj *pResult = TclZipfs_TclLibrary();

	if (!pResult) {
	    pResult = Tcl_NewObj();
	}
	Tcl_SetObjResult(interp, pResult);
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelClose --
 *
 *	This function is called to close a channel.
 *
 * Results:
 *	Always TCL_OK.
 *
 * Side effects:
 *	Resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelClose(
    ClientData instanceData,
    Tcl_Interp *interp)		/* Current interpreter. */
{
    ZipChannel *info = instanceData;

    if (info->iscompr && info->ubuf) {
	ckfree(info->ubuf);
	info->ubuf = NULL;
    }
    if (info->isEncrypted) {
	info->isEncrypted = 0;
	memset(info->keys, 0, sizeof(info->keys));
    }
    if (info->isWriting) {
	ZipEntry *z = info->zipEntryPtr;
	unsigned char *newdata = attemptckrealloc(info->ubuf, info->numRead);

	if (newdata) {
	    if (z->data) {
		ckfree(z->data);
	    }
	    z->data = newdata;
	    z->numBytes = z->numCompressedBytes = info->numBytes;
	    z->compressMethod = ZIP_COMPMETH_STORED;
	    z->timestamp = time(NULL);
	    z->isDirectory = 0;
	    z->isEncrypted = 0;
	    z->offset = 0;
	    z->crc32 = 0;
	} else {
	    ckfree(info->ubuf);
	}
    }
    WriteLock();
    info->zipFilePtr->numOpen--;
    Unlock();
    ckfree(info);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelRead --
 *
 *	This function is called to read data from channel.
 *
 * Results:
 *	Number of bytes read or -1 on error with error number set.
 *
 * Side effects:
 *	Data is read and file pointer is advanced.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelRead(
    ClientData instanceData,
    char *buf,
    int toRead,
    int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long nextpos;

    if (info->isDirectory < 0) {
	/*
	 * Special case: when executable combined with ZIP archive file read
	 * data in front of ZIP, i.e. the executable itself.
	 */

	nextpos = info->numRead + toRead;
	if (nextpos > info->zipFilePtr->baseOffset) {
	    toRead = info->zipFilePtr->baseOffset - info->numRead;
	    nextpos = info->zipFilePtr->baseOffset;
	}
	if (toRead == 0) {
	    return 0;
	}
	memcpy(buf, info->zipFilePtr->data, toRead);
	info->numRead = nextpos;
	*errloc = 0;
	return toRead;
    }
    if (info->isDirectory) {
	*errloc = EISDIR;
	return -1;
    }
    nextpos = info->numRead + toRead;
    if (nextpos > info->numBytes) {
	toRead = info->numBytes - info->numRead;
	nextpos = info->numBytes;
    }
    if (toRead == 0) {
	return 0;
    }
    if (info->isEncrypted) {
	int i;

	for (i = 0; i < toRead; i++) {
	    int ch = info->ubuf[i + info->numRead];

	    buf[i] = zdecode(info->keys, crc32tab, ch);
	}
    } else {
	memcpy(buf, info->ubuf + info->numRead, toRead);
    }
    info->numRead = nextpos;
    *errloc = 0;
    return toRead;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelWrite --
 *
 *	This function is called to write data into channel.
 *
 * Results:
 *	Number of bytes written or -1 on error with error number set.
 *
 * Side effects:
 *	Data is written and file pointer is advanced.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelWrite(
    ClientData instanceData,
    const char *buf,
    int toWrite,
    int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long nextpos;

    if (!info->isWriting) {
	*errloc = EINVAL;
	return -1;
    }
    nextpos = info->numRead + toWrite;
    if (nextpos > info->maxWrite) {
	toWrite = info->maxWrite - info->numRead;
	nextpos = info->maxWrite;
    }
    if (toWrite == 0) {
	return 0;
    }
    memcpy(info->ubuf + info->numRead, buf, toWrite);
    info->numRead = nextpos;
    if (info->numRead > info->numBytes) {
	info->numBytes = info->numRead;
    }
    *errloc = 0;
    return toWrite;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelSeek --
 *
 *	This function is called to position file pointer of channel.
 *
 * Results:
 *	New file position or -1 on error with error number set.
 *
 * Side effects:
 *	File pointer is repositioned according to offset and mode.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelSeek(
    ClientData instanceData,
    long offset,
    int mode,
    int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long end;

    if (!info->isWriting && (info->isDirectory < 0)) {
	/*
	 * Special case: when executable combined with ZIP archive file, seek
	 * within front of ZIP, i.e. the executable itself.
	 */
	end = info->zipFilePtr->baseOffset;
    } else if (info->isDirectory) {
	*errloc = EINVAL;
	return -1;
    } else {
	end = info->numBytes;
    }
    switch (mode) {
    case SEEK_CUR:
	offset += info->numRead;
	break;
    case SEEK_END:
	offset += end;
	break;
    case SEEK_SET:
	break;
    default:
	*errloc = EINVAL;
	return -1;
    }
    if (offset < 0) {
	*errloc = EINVAL;
	return -1;
    }
    if (info->isWriting) {
	if ((unsigned long) offset > info->maxWrite) {
	    *errloc = EINVAL;
	    return -1;
	}
	if ((unsigned long) offset > info->numBytes) {
	    info->numBytes = offset;
	}
    } else if ((unsigned long) offset > end) {
	*errloc = EINVAL;
	return -1;
    }
    info->numRead = (unsigned long) offset;
    return info->numRead;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelWatchChannel --
 *
 *	This function is called for event notifications on channel. Does
 *	nothing.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipChannelWatchChannel(
    ClientData instanceData,
    int mask)
{
    return;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelGetFile --
 *
 *	This function is called to retrieve OS handle for channel.
 *
 * Results:
 *	Always TCL_ERROR since there's never an OS handle for a file within a
 *	ZIP archive.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelGetFile(
    ClientData instanceData,
    int direction,
    ClientData *handlePtr)
{
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelOpen --
 *
 *	This function opens a Tcl_Channel on a file from a mounted ZIP archive
 *	according to given open mode.
 *
 * Results:
 *	Tcl_Channel on success, or NULL on error.
 *
 * Side effects:
 *	Memory is allocated, the file from the ZIP archive is uncompressed.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Channel
ZipChannelOpen(
    Tcl_Interp *interp,		/* Current interpreter. */
    char *filename,
    int mode,
    int permissions)
{
    ZipEntry *z;
    ZipChannel *info;
    int i, ch, trunc, wr, flags = 0;
    char cname[128];

    if ((mode & O_APPEND)
	    || ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) {
	if (interp) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unsupported open mode", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_MODE", NULL);
	}
	return NULL;
    }
    WriteLock();
    z = ZipFSLookup(filename);
    if (!z) {
	Tcl_SetErrno(ENOENT);
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "file not found \"%s\": %s", filename,
		    Tcl_PosixError(interp)));
	}
	goto error;
    }
    trunc = (mode & O_TRUNC) != 0;
    wr = (mode & (O_WRONLY | O_RDWR)) != 0;
    if ((z->compressMethod != ZIP_COMPMETH_STORED)
	    && (z->compressMethod != ZIP_COMPMETH_DEFLATED)) {
	ZIPFS_ERROR(interp, "unsupported compression method");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "COMP_METHOD", NULL);
	}
	goto error;
    }
    if (wr && z->isDirectory) {
	ZIPFS_ERROR(interp, "unsupported file type");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_TYPE", NULL);
	}
	goto error;
    }
    if (!trunc) {
	flags |= TCL_READABLE;
	if (z->isEncrypted && (z->zipFilePtr->passBuf[0] == 0)) {
	    ZIPFS_ERROR(interp, "decryption failed");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DECRYPT", NULL);
	    }
	    goto error;
	} else if (wr && !z->data && (z->numBytes > ZipFS.wrmax)) {
	    ZIPFS_ERROR(interp, "file too large");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    goto error;
	}
    } else {
	flags = TCL_WRITABLE;
    }
    info = attemptckalloc(sizeof(ZipChannel));
    if (!info) {
	ZIPFS_ERROR(interp, "out of memory");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	goto error;
    }
    info->zipFilePtr = z->zipFilePtr;
    info->zipEntryPtr = z;
    info->numRead = 0;
    if (wr) {
	flags |= TCL_WRITABLE;
	info->isWriting = 1;
	info->isDirectory = 0;
	info->maxWrite = ZipFS.wrmax;
	info->iscompr = 0;
	info->isEncrypted = 0;
	info->ubuf = attemptckalloc(info->maxWrite);
	if (!info->ubuf) {
	merror0:
	    if (info->ubuf) {
		ckfree(info->ubuf);
	    }
	    ckfree(info);
	    ZIPFS_ERROR(interp, "out of memory");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    goto error;
	}
	memset(info->ubuf, 0, info->maxWrite);
	if (trunc) {
	    info->numBytes = 0;
	} else if (z->data) {
	    unsigned int j = z->numBytes;

	    if (j > info->maxWrite) {
		j = info->maxWrite;
	    }
	    memcpy(info->ubuf, z->data, j);
	    info->numBytes = j;
	} else {
	    unsigned char *zbuf = z->zipFilePtr->data + z->offset;

	    if (z->isEncrypted) {
		int len = z->zipFilePtr->passBuf[0];
		char passBuf[260];

		for (i = 0; i < len; i++) {
		    ch = z->zipFilePtr->passBuf[len - i];
		    passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
		}
		passBuf[i] = '\0';
		init_keys(passBuf, info->keys, crc32tab);
		memset(passBuf, 0, sizeof(passBuf));
		for (i = 0; i < 12; i++) {
		    ch = info->ubuf[i];
		    zdecode(info->keys, crc32tab, ch);
		}
		zbuf += i;
	    }
	    if (z->compressMethod == ZIP_COMPMETH_DEFLATED) {
		z_stream stream;
		int err;
		unsigned char *cbuf = NULL;

		memset(&stream, 0, sizeof(z_stream));
		stream.zalloc = Z_NULL;
		stream.zfree = Z_NULL;
		stream.opaque = Z_NULL;
		stream.avail_in = z->numCompressedBytes;
		if (z->isEncrypted) {
		    unsigned int j;

		    stream.avail_in -= 12;
		    cbuf = attemptckalloc(stream.avail_in);
		    if (!cbuf) {
			goto merror0;
		    }
		    for (j = 0; j < stream.avail_in; j++) {
			ch = info->ubuf[j];
			cbuf[j] = zdecode(info->keys, crc32tab, ch);
		    }
		    stream.next_in = cbuf;
		} else {
		    stream.next_in = zbuf;
		}
		stream.next_out = info->ubuf;
		stream.avail_out = info->maxWrite;
		if (inflateInit2(&stream, -15) != Z_OK) {
		    goto cerror0;
		}
		err = inflate(&stream, Z_SYNC_FLUSH);
		inflateEnd(&stream);
		if ((err == Z_STREAM_END)
			|| ((err == Z_OK) && (stream.avail_in == 0))) {
		    if (cbuf) {
			memset(info->keys, 0, sizeof(info->keys));
			ckfree(cbuf);
		    }
		    goto wrapchan;
		}
	    cerror0:
		if (cbuf) {
		    memset(info->keys, 0, sizeof(info->keys));
		    ckfree(cbuf);
		}
		if (info->ubuf) {
		    ckfree(info->ubuf);
		}
		ckfree(info);
		ZIPFS_ERROR(interp, "decompression error");
		if (interp) {
		    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
		}
		goto error;
	    } else if (z->isEncrypted) {
		for (i = 0; i < z->numBytes - 12; i++) {
		    ch = zbuf[i];
		    info->ubuf[i] = zdecode(info->keys, crc32tab, ch);
		}
	    } else {
		memcpy(info->ubuf, zbuf, z->numBytes);
	    }
	    memset(info->keys, 0, sizeof(info->keys));
	    goto wrapchan;
	}
    } else if (z->data) {
	flags |= TCL_READABLE;
	info->isWriting = 0;
	info->iscompr = 0;
	info->isDirectory = 0;
	info->isEncrypted = 0;
	info->numBytes = z->numBytes;
	info->maxWrite = 0;
	info->ubuf = z->data;
    } else {
	flags |= TCL_READABLE;
	info->isWriting = 0;
	info->iscompr = (z->compressMethod == ZIP_COMPMETH_DEFLATED);
	info->ubuf = z->zipFilePtr->data + z->offset;
	info->isDirectory = z->isDirectory;
	info->isEncrypted = z->isEncrypted;
	info->numBytes = z->numBytes;
	info->maxWrite = 0;
	if (info->isEncrypted) {
	    int len = z->zipFilePtr->passBuf[0];
	    char passBuf[260];

	    for (i = 0; i < len; i++) {
		ch = z->zipFilePtr->passBuf[len - i];
		passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	    }
	    passBuf[i] = '\0';
	    init_keys(passBuf, info->keys, crc32tab);
	    memset(passBuf, 0, sizeof(passBuf));
	    for (i = 0; i < 12; i++) {
		ch = info->ubuf[i];
		zdecode(info->keys, crc32tab, ch);
	    }
	    info->ubuf += i;
	}
	if (info->iscompr) {
	    z_stream stream;
	    int err;
	    unsigned char *ubuf = NULL;
	    unsigned int j;

	    memset(&stream, 0, sizeof(z_stream));
	    stream.zalloc = Z_NULL;
	    stream.zfree = Z_NULL;
	    stream.opaque = Z_NULL;
	    stream.avail_in = z->numCompressedBytes;
	    if (info->isEncrypted) {
		stream.avail_in -= 12;
		ubuf = attemptckalloc(stream.avail_in);
		if (!ubuf) {
		    info->ubuf = NULL;
		    goto merror;
		}
		for (j = 0; j < stream.avail_in; j++) {
		    ch = info->ubuf[j];
		    ubuf[j] = zdecode(info->keys, crc32tab, ch);
		}
		stream.next_in = ubuf;
	    } else {
		stream.next_in = info->ubuf;
	    }
	    stream.next_out = info->ubuf = attemptckalloc(info->numBytes);
	    if (!info->ubuf) {
	    merror:
		if (ubuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    ckfree(ubuf);
		}
		ckfree(info);
		if (interp) {
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj("out of memory", -1));
		    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
		}
		goto error;
	    }
	    stream.avail_out = info->numBytes;
	    if (inflateInit2(&stream, -15) != Z_OK) {
		goto cerror;
	    }
	    err = inflate(&stream, Z_SYNC_FLUSH);
	    inflateEnd(&stream);
	    if ((err == Z_STREAM_END)
		    || ((err == Z_OK) && (stream.avail_in == 0))) {
		if (ubuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    ckfree(ubuf);
		}
		goto wrapchan;
	    }
	cerror:
	    if (ubuf) {
		info->isEncrypted = 0;
		memset(info->keys, 0, sizeof(info->keys));
		ckfree(ubuf);
	    }
	    if (info->ubuf) {
		ckfree(info->ubuf);
	    }
	    ckfree(info);
	    ZIPFS_ERROR(interp, "decompression error");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
	    }
	    goto error;
	}
    }

  wrapchan:
    sprintf(cname, "zipfs_%" TCL_LL_MODIFIER "x_%d", z->offset,
	    ZipFS.idCount++);
    z->zipFilePtr->numOpen++;
    Unlock();
    return Tcl_CreateChannel(&ZipChannelType, cname, info, flags);

  error:
    Unlock();
    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipEntryStat --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of stat.
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipEntryStat(
    char *path,
    Tcl_StatBuf *buf)
{
    ZipEntry *z;
    int ret = -1;

    ReadLock();
    z = ZipFSLookup(path);
    if (z) {
	memset(buf, 0, sizeof(Tcl_StatBuf));
	if (z->isDirectory) {
	    buf->st_mode = S_IFDIR | 0555;
	} else {
	    buf->st_mode = S_IFREG | 0555;
	}
	buf->st_size = z->numBytes;
	buf->st_mtime = z->timestamp;
	buf->st_ctime = z->timestamp;
	buf->st_atime = z->timestamp;
	ret = 0;
    }
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipEntryAccess --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of access.
 *
 * Results:
 *	See access documentation.
 *
 * Side effects:
 *	See access documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipEntryAccess(
    char *path,
    int mode)
{
    ZipEntry *z;

    if (mode & 3) {
	return -1;
    }
    ReadLock();
    z = ZipFSLookup(path);
    Unlock();
    return (z ? 0 : -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSOpenFileChannelProc --
 *
 * Results:
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Channel
ZipFSOpenFileChannelProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *pathPtr,
    int mode,
    int permissions)
{
    int len;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return NULL;
    }
    return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode,
	    permissions);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSStatProc --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of stat.
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSStatProc(
    Tcl_Obj *pathPtr,
    Tcl_StatBuf *buf)
{
    int len;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSAccessProc --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of access.
 *
 * Results:
 *	See access documentation.
 *
 * Side effects:
 *	See access documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSAccessProc(
    Tcl_Obj *pathPtr,
    int mode)
{
    int len;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFilesystemSeparatorProc --
 *
 *	This function returns the separator to be used for a given path. The
 *	object returned should have a refCount of zero
 *
 * Results:
 *	A Tcl object, with a refCount of zero. If the caller needs to retain a
 *	reference to the object, it should call Tcl_IncrRefCount, and should
 *	otherwise free the object.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSFilesystemSeparatorProc(
    Tcl_Obj *pathPtr)
{
    return Tcl_NewStringObj("/", -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMatchInDirectoryProc --
 *
 *	This routine is used by the globbing code to search a directory for
 *	all files which match a given pattern.
 *
 * Results:
 *	The return value is a standard Tcl result indicating whether an error
 *	occurred in globbing. Errors are left in interp, good results are
 *	lappend'ed to resultPtr (which must be a valid object).
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMatchInDirectoryProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *result,
    Tcl_Obj *pathPtr,
    const char *pattern,
    Tcl_GlobTypeData *types)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    int scnt, l, dirOnly = -1, prefixLen, strip = 0;
    size_t len;
    char *pat, *prefix, *path;
    Tcl_DString dsPref;

    if (!normPathPtr) {
	return -1;
    }
    if (types) {
	dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;
    }

    /*
     * The prefix that gets prepended to results.
     */

    prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen);

    /*
     * The (normalized) path we're searching.
     */

    path = Tcl_GetString(normPathPtr);
    len = normPathPtr->length;

    Tcl_DStringInit(&dsPref);
    Tcl_DStringAppend(&dsPref, prefix, prefixLen);

    if (strcmp(prefix, path) == 0) {
	prefix = NULL;
    } else {
	strip = len + 1;
    }
    if (prefix) {
	Tcl_DStringAppend(&dsPref, "/", 1);
	prefixLen++;
	prefix = Tcl_DStringValue(&dsPref);
    }
    ReadLock();
    if (types && (types->type == TCL_GLOB_TYPE_MOUNT)) {
	l = CountSlashes(path);
	if (path[len - 1] == '/') {
	    len--;
	} else {
	    l++;
	}
	if (!pattern || (pattern[0] == '\0')) {
	    pattern = "*";
	}
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    ZipFile *zf = Tcl_GetHashValue(hPtr);

	    if (zf->mountPointLen == 0) {
		ZipEntry *z;

		for (z = zf->topEnts; z; z = z->tnext) {
		    size_t lenz = strlen(z->name);

		    if ((lenz > len + 1) && (strncmp(z->name, path, len) == 0)
			    && (z->name[len] == '/')
			    && (CountSlashes(z->name) == l)
			    && Tcl_StringCaseMatch(z->name + len + 1, pattern,
				    0)) {
			if (prefix) {
			    Tcl_DStringAppend(&dsPref, z->name, lenz);
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
					    Tcl_DStringLength(&dsPref)));
			    Tcl_DStringSetLength(&dsPref, prefixLen);
			} else {
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(z->name, lenz));
			}
		    }
		}
	    } else if ((zf->mountPointLen > len + 1)
		    && (strncmp(zf->mountPoint, path, len) == 0)
		    && (zf->mountPoint[len] == '/')
		    && (CountSlashes(zf->mountPoint) == l)
		    && Tcl_StringCaseMatch(zf->mountPoint + len + 1,
			    pattern, 0)) {
		if (prefix) {
		    Tcl_DStringAppend(&dsPref, zf->mountPoint,
			    zf->mountPointLen);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				    Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(zf->mountPoint,
				    zf->mountPointLen));
		}
	    }
	}
	goto end;
    }

    if (!pattern || (pattern[0] == '\0')) {
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
	if (hPtr) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);

	    if ((dirOnly < 0) || (!dirOnly && !z->isDirectory)
		    || (dirOnly && z->isDirectory)) {
		if (prefix) {
		    Tcl_DStringAppend(&dsPref, z->name, -1);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				    Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(z->name, -1));
		}
	    }
	}
	goto end;
    }

    l = strlen(pattern);
    pat = ckalloc(len + l + 2);
    memcpy(pat, path, len);
    while ((len > 1) && (pat[len - 1] == '/')) {
	--len;
    }
    if ((len > 1) || (pat[0] != '/')) {
	pat[len] = '/';
	++len;
    }
    memcpy(pat + len, pattern, l + 1);
    scnt = CountSlashes(pat);
    for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
	    hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	ZipEntry *z = Tcl_GetHashValue(hPtr);

	if ((dirOnly >= 0) && ((dirOnly && !z->isDirectory)
		|| (!dirOnly && z->isDirectory))) {
	    continue;
	}
	if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) {
	    if (prefix) {
		Tcl_DStringAppend(&dsPref, z->name + strip, -1);
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				Tcl_DStringLength(&dsPref)));
		Tcl_DStringSetLength(&dsPref, prefixLen);
	    } else {
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(z->name + strip, -1));
	    }
	}
    }
    ckfree(pat);

  end:
    Unlock();
    Tcl_DStringFree(&dsPref);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSPathInFilesystemProc --
 *
 *	This function determines if the given path object is in the ZIP
 *	filesystem.
 *
 * Results:
 *	TCL_OK when the path object is in the ZIP filesystem, -1 otherwise.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSPathInFilesystemProc(
    Tcl_Obj *pathPtr,
    ClientData *clientDataPtr)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    int ret = -1;
    size_t len;
    char *path;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }

    path = Tcl_GetString(pathPtr);
    if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) {
	return -1;
    }

    len = pathPtr->length;

    ReadLock();
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
    if (hPtr) {
	ret = TCL_OK;
	goto endloop;
    }

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = Tcl_GetHashValue(hPtr);

	if (zf->mountPointLen == 0) {
	    ZipEntry *z;

	    for (z = zf->topEnts; z != NULL; z = z->tnext) {
		size_t lenz = strlen(z->name);

		if ((len >= lenz) && (strncmp(path, z->name, lenz) == 0)) {
		    ret = TCL_OK;
		    goto endloop;
		}
	    }
	} else if ((len >= zf->mountPointLen) &&
		(strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) {
	    ret = TCL_OK;
	    break;
	}
    }

  endloop:
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSListVolumesProc --
 *
 *	Lists the currently mounted ZIP filesystem volumes.
 *
 * Results:
 *	The list of volumes.
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSListVolumesProc(void)
{
    return Tcl_NewStringObj(ZIPFS_VOLUME, -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrStringsProc --
 *
 *	This function implements the ZIP filesystem dependent 'file
 *	attributes' subcommand, for listing the set of possible attribute
 *	strings.
 *
 * Results:
 *	An array of strings
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static const char *const *
ZipFSFileAttrStringsProc(
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    static const char *const attrs[] = {
	"-uncompsize",
	"-compsize",
	"-offset",
	"-mount",
	"-archive",
	"-permissions",
	NULL,
    };
    return attrs;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrsGetProc --
 *
 *	This function implements the ZIP filesystem specific 'file attributes'
 *	subcommand, for 'get' operations.
 *
 * Results:
 *	Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
 *	was returned) is likely to have a refCount of zero. Either way we must
 *	either store it somewhere (e.g. the Tcl result), or Incr/Decr its
 *	refCount to ensure it is properly freed.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSFileAttrsGetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    int index,
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    int len, ret = TCL_OK;
    char *path;
    ZipEntry *z;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = Tcl_GetStringFromObj(pathPtr, &len);
    ReadLock();
    z = ZipFSLookup(path);
    if (!z) {
	Tcl_SetErrno(ENOENT);
	ZIPFS_POSIX_ERROR(interp, "file not found");
	ret = TCL_ERROR;
	goto done;
    }
    switch (index) {
    case 0:
	*objPtrRef = Tcl_NewWideIntObj(z->numBytes);
	break;
    case 1:
	*objPtrRef = Tcl_NewWideIntObj(z->numCompressedBytes);
	break;
    case 2:
	*objPtrRef = Tcl_NewWideIntObj(z->offset);
	break;
    case 3:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->mountPoint,
		z->zipFilePtr->mountPointLen);
	break;
    case 4:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->name, -1);
	break;
    case 5:
	*objPtrRef = Tcl_NewStringObj("0555", -1);
	break;
    default:
	ZIPFS_ERROR(interp, "unknown attribute");
	ret = TCL_ERROR;
    }

  done:
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrsSetProc --
 *
 *	This function implements the ZIP filesystem specific 'file attributes'
 *	subcommand, for 'set' operations.
 *
 * Results:
 *	Standard Tcl return code.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSFileAttrsSetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    int index,
    Tcl_Obj *pathPtr,
    Tcl_Obj *objPtr)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "UNSUPPORTED_OP", NULL);
    }
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFilesystemPathTypeProc --
 *
 * Results:
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSFilesystemPathTypeProc(
    Tcl_Obj *pathPtr)
{
    return Tcl_NewStringObj("zip", -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLoadFile --
 *
 *	This functions deals with loading native object code. If the given
 *	path object refers to a file within the ZIP filesystem, an approriate
 *	error code is returned to delegate loading to the caller (by copying
 *	the file to temp store and loading from there). As fallback when the
 *	file refers to the ZIP file system but is not present, it is looked up
 *	relative to the executable and loaded from there when available.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with error message left.
 *
 * Side effects:
 *	Loads native code into the process address space.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSLoadFile(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *path,
    Tcl_LoadHandle *loadHandle,
    Tcl_FSUnloadFileProc **unloadProcPtr,
    int flags)
{
    Tcl_FSLoadFileProc2 *loadFileProc;
#ifdef ANDROID
    /*
     * Force loadFileProc to native implementation since the package manager
     * already extracted the shared libraries from the APK at install time.
     */

    loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
    if (loadFileProc) {
	return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
    }
    Tcl_SetErrno(ENOENT);
    ZIPFS_ERROR(interp, Tcl_PosixError(interp));
    return TCL_ERROR;
#else /* !ANDROID */
    Tcl_Obj *altPath = NULL;
    int ret = TCL_ERROR;
    Tcl_Obj *objs[2] = { NULL, NULL };

    if (Tcl_FSAccess(path, R_OK) == 0) {
	/*
	 * EXDEV should trigger loading by copying to temp store.
	 */

	Tcl_SetErrno(EXDEV);
	ZIPFS_ERROR(interp, Tcl_PosixError(interp));
	return ret;
    }

    objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME);
    if (objs[1] && (ZipFSAccessProc(objs[1], R_OK) == 0)) {
	const char *execName = Tcl_GetNameOfExecutable();

	/*
	 * Shared object is not in ZIP but its path prefix is, thus try to
	 * load from directory where the executable came from.
	 */

	TclDecrRefCount(objs[1]);
	objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL);

	/*
	 * Get directory name of executable manually to deal with cases where
	 * [file dirname [info nameofexecutable]] is equal to [info
	 * nameofexecutable] due to VFS effects.
	 */

	if (execName) {
	    const char *p = strrchr(execName, '/');

	    if (p > execName + 1) {
		--p;
		objs[0] = Tcl_NewStringObj(execName, p - execName);
	    }
	}
	if (!objs[0]) {
	    objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
		    TCL_PATH_DIRNAME);
	}
	if (objs[0]) {
	    altPath = TclJoinPath(2, objs);
	    if (altPath) {
		Tcl_IncrRefCount(altPath);
		if (Tcl_FSAccess(altPath, R_OK) == 0) {
		    path = altPath;
		}
	    }
	}
    }
    if (objs[0]) {
	Tcl_DecrRefCount(objs[0]);
    }
    if (objs[1]) {
	Tcl_DecrRefCount(objs[1]);
    }

    loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
    if (loadFileProc) {
	ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
    } else {
	Tcl_SetErrno(ENOENT);
	ZIPFS_ERROR(interp, Tcl_PosixError(interp));
    }
    if (altPath) {
	Tcl_DecrRefCount(altPath);
    }
    return ret;
#endif /* ANDROID */
}

#endif /* HAVE_ZLIB */

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Init --
 *
 *	Perform per interpreter initialization of this module.
 *
 * Results:
 *	The return value is a standard Tcl result.
 *
 * Side effects:
 *	Initializes this module if not already initialized, and adds module
 *	related commands to the given interpreter.
 *
 *-------------------------------------------------------------------------
 */

MODULE_SCOPE int
TclZipfs_Init(
    Tcl_Interp *interp)		/* Current interpreter. */
{
#ifdef HAVE_ZLIB
    static const EnsembleImplMap initMap[] = {
	{"mkimg",	ZipFSMkImgObjCmd,	NULL, NULL, NULL, 1},
	{"mkzip",	ZipFSMkZipObjCmd,	NULL, NULL, NULL, 1},
	{"lmkimg",	ZipFSLMkImgObjCmd,	NULL, NULL, NULL, 1},
	{"lmkzip",	ZipFSLMkZipObjCmd,	NULL, NULL, NULL, 1},
	/* The 4 entries above are not available in safe interpreters */
	{"mount",	ZipFSMountObjCmd,	NULL, NULL, NULL, 1},
	{"mount_data",	ZipFSMountBufferObjCmd,	NULL, NULL, NULL, 1},
	{"unmount",	ZipFSUnmountObjCmd,	NULL, NULL, NULL, 1},
	{"mkkey",	ZipFSMkKeyObjCmd,	NULL, NULL, NULL, 1},
	{"exists",	ZipFSExistsObjCmd,	NULL, NULL, NULL, 0},
	{"info",	ZipFSInfoObjCmd,	NULL, NULL, NULL, 0},
	{"list",	ZipFSListObjCmd,	NULL, NULL, NULL, 0},
	{"canonical",	ZipFSCanonicalObjCmd,	NULL, NULL, NULL, 0},
	{"root",	ZipFSRootObjCmd,	NULL, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    static const char findproc[] =
	"namespace eval ::tcl::zipfs {}\n"
	"proc ::tcl::zipfs::Find dir {\n"
	"    set result {}\n"
	"    if {[catch {glob -directory $dir -nocomplain * .*} list]} {\n"
	"        return $result\n"
	"    }\n"
	"    foreach file $list {\n"
	"        if {[file tail $file] in {. ..}} {\n"
	"            continue\n"
	"        }\n"
	"        lappend result $file {*}[Find $file]\n"
	"    }\n"
	"    return $result\n"
	"}\n"
	"proc ::tcl::zipfs::find {directoryName} {\n"
	"    return [lsort [Find $directoryName]]\n"
	"}\n";

    /*
     * One-time initialization.
     */

    WriteLock();
    /* Tcl_StaticPackage(interp, "zipfs", TclZipfs_Init, TclZipfs_Init); */
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }
    Unlock();

    if (interp) {
	Tcl_Command ensemble;
	Tcl_Obj *mapObj;

	Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);
	Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
		TCL_LINK_INT);
	ensemble = TclMakeEnsemble(interp, "zipfs",
		Tcl_IsSafe(interp) ? (initMap + 4) : initMap);

	/*
	 * Add the [zipfs find] subcommand.
	 */

	Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
	Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
		Tcl_NewStringObj("::tcl::zipfs::find", -1));
	Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
		ZipFSTclLibraryObjCmd, NULL, NULL);
	Tcl_PkgProvide(interp, "zipfs", "2.0");
    }
    return TCL_OK;
#else /* !HAVE_ZLIB */
    ZIPFS_ERROR(interp, "no zlib available");
    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    return TCL_ERROR;
#endif /* HAVE_ZLIB */
}

static int
ZipfsAppHookFindTclInit(
    const char *archive)
{
    Tcl_Obj *vfsInitScript;
    int found;

    if (zipfs_literal_tcl_library) {
	return TCL_ERROR;
    }
    if (TclZipfs_Mount(NULL, ZIPFS_ZIP_MOUNT, archive, NULL)) {
	/* Either the file doesn't exist or it is not a zip archive */
	return TCL_ERROR;
    }

    TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl");
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == 0) {
	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT;
	return TCL_OK;
    }

    TclNewLiteralStringObj(vfsInitScript,
	    ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl");
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == 0) {
	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
	return TCL_OK;
    }

    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_AppHook --
 *
 *	Performs the argument munging for the shell
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_AppHook(
    int *argcPtr,		/* Pointer to argc */
#ifdef _WIN32
    TCHAR
#else /* !_WIN32 */
    char
#endif /* _WIN32 */
    ***argvPtr)			/* Pointer to argv */
{
    char *archive;

    Tcl_FindExecutable((*argvPtr)[0]);
    archive = (char *) Tcl_GetNameOfExecutable();
    TclZipfs_Init(NULL);

    /*
     * Look for init.tcl in one of the locations mounted later in this
     * function.
     */

    if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
	int found;
	Tcl_Obj *vfsInitScript;

	TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
	Tcl_IncrRefCount(vfsInitScript);
	if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
	    /*
	     * Startup script should be set before calling Tcl_AppInit
	     */

	    Tcl_SetStartupScript(vfsInitScript, NULL);
	} else {
	    Tcl_DecrRefCount(vfsInitScript);
	}

	/*
	 * Set Tcl Encodings
	 */

	if (!zipfs_literal_tcl_library) {
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    found = Tcl_FSAccess(vfsInitScript, F_OK);
	    Tcl_DecrRefCount(vfsInitScript);
	    if (found == TCL_OK) {
		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
		return TCL_OK;
	    }
	}
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
    } else if (*argcPtr > 1) {
	/*
	 * If the first argument is "install", run the supplied installer
	 * script.
	 */

#ifdef _WIN32
	Tcl_DString ds;

	archive = Tcl_WinTCharToUtf((*argvPtr)[1], -1, &ds);
#else /* !_WIN32 */
	archive = (*argvPtr)[1];
#endif /* _WIN32 */
	if (strcmp(archive, "install") == 0) {
	    Tcl_Obj *vfsInitScript;

	    /*
	     * Run this now to ensure the file is present by the time Tcl_Main
	     * wants it.
	     */

	    TclZipfs_TclLibrary();
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
		Tcl_SetStartupScript(vfsInitScript, NULL);
	    }
	    return TCL_OK;
	} else if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
	    int found;
	    Tcl_Obj *vfsInitScript;

	    TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
		/*
		 * Startup script should be set before calling Tcl_AppInit
		 */

		Tcl_SetStartupScript(vfsInitScript, NULL);
	    } else {
		Tcl_DecrRefCount(vfsInitScript);
	    }
	    /* Set Tcl Encodings */
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    found = Tcl_FSAccess(vfsInitScript, F_OK);
	    Tcl_DecrRefCount(vfsInitScript);
	    if (found == TCL_OK) {
		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
		return TCL_OK;
	    }
	}
#ifdef _WIN32
	Tcl_DStringFree(&ds);
#endif /* _WIN32 */
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
    }
    return TCL_OK;
}

#ifndef HAVE_ZLIB

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Mount, TclZipfs_MountBuffer, TclZipfs_Unmount --
 *
 *	Dummy version when no ZLIB support available.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Mount(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *mountPoint,	/* Mount point path. */
    const char *zipname,	/* Path to ZIP file to mount. */
    const char *passwd)		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
{
    ZIPFS_ERROR(interp, "no zlib available");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}

int
TclZipfs_MountBuffer(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint,	/* Mount point path. */
    unsigned char *data,
    size_t datalen,
    int copy)
{
    ZIPFS_ERROR(interp, "no zlib available");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}

int
TclZipfs_Unmount(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *mountPoint)	/* Mount point path. */
{
    ZIPFS_ERROR(interp, "no zlib available");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}
#endif /* !HAVE_ZLIB */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclZlib.c.

113
114
115
116
117
118
119
120

121
122
123
124
125
126
127
113
114
115
116
117
118
119

120
121
122
123
124
125
126
127







-
+







    int readAheadLimit;		/* The maximum number of bytes to read from
				 * the underlying stream in one go. */
    z_stream inStream;		/* Structure used by zlib for decompression of
				 * input. */
    z_stream outStream;		/* Structure used by zlib for compression of
				 * output. */
    char *inBuffer, *outBuffer;	/* Working buffers. */
    int inAllocated, outAllocated;
    size_t inAllocated, outAllocated;
				/* Sizes of working buffers. */
    GzipHeader inHeader;	/* Header read from input stream, when
				 * decompressing a gzip stream. */
    GzipHeader outHeader;	/* Header to write to an output stream, when
				 * compressing a gzip stream. */
    Tcl_TimerToken timer;	/* Timer used for keeping events fresh. */
    Tcl_DString decompressed;	/* Buffer for decompression results. */
369
370
371
372
373
374
375
376

377
378
379
380
381
382
383
369
370
371
372
373
374
375

376
377
378
379
380
381
382
383







-
+







	/*
	 * Catch-all. Should be unreachable because all cases are already
	 * listed above.
	 */

    default:
	TclNewLiteralStringObj(objv[2], "UNKNOWN");
	TclNewLongObj(objv[3], code);
	TclNewIntObj(objv[3], code);
	return Tcl_NewListObj(4, objv);
    }
}

/*
 *----------------------------------------------------------------------
 *
1511
1512
1513
1514
1515
1516
1517
1518

1519
1520
1521
1522
1523
1524
1525
1526
1527

1528
1529
1530
1531
1532
1533
1534
1511
1512
1513
1514
1515
1516
1517

1518
1519
1520
1521
1522
1523
1524
1525
1526

1527
1528
1529
1530
1531
1532
1533
1534







-
+








-
+







	     * Get the next chunk off our list of chunks and grab the data out
	     * of it.
	     */

	    Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
	    itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
	    if (itemLen-zshPtr->outPos >= count-dataPos) {
		unsigned len = count - dataPos;
		size_t len = count - dataPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		zshPtr->outPos += len;
		dataPos += len;
		if (zshPtr->outPos == itemLen) {
		    zshPtr->outPos = 0;
		}
	    } else {
		unsigned len = itemLen - zshPtr->outPos;
		size_t len = itemLen - zshPtr->outPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		dataPos += len;
		zshPtr->outPos = 0;
	    }
	    if (zshPtr->outPos == 0) {
		Tcl_ListObjReplace(NULL, zshPtr->outData, 0, 1, 0, NULL);
2927
2928
2929
2930
2931
2932
2933
2934

2935
2936
2937
2938
2939
2940
2941
2927
2928
2929
2930
2931
2932
2933

2934
2935
2936
2937
2938
2939
2940
2941







-
+







		/* TODO: is this the right way to do errors on close? */
		if (!TclInThreadExit()) {
		    ConvertError(interp, e, cd->outStream.adler);
		}
		result = TCL_ERROR;
		break;
	    }
	    if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) < 0) {
	    if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) == TCL_IO_FAILURE) {
		/* TODO: is this the right way to do errors on close?
		 * Note: when close is called from FinalizeIOSubsystem then
		 * interp may be NULL */
		if (!TclInThreadExit() && interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "error while finalizing file: %s",
			    Tcl_PosixError(interp)));
3126
3127
3128
3129
3130
3131
3132
3133

3134
3135
3136
3137
3138
3139
3140
3126
3127
3128
3129
3130
3131
3132

3133
3134
3135
3136
3137
3138
3139
3140







-
+







    while (cd->outStream.avail_in > 0) {
	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		Z_NO_FLUSH, &produced);
	if (e != Z_OK || produced == 0) {
	    break;
	}

	if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
	if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) == TCL_IO_FAILURE) {
	    *errorCodePtr = Tcl_GetErrno();
	    return -1;
	}
    }

    if (e == Z_OK) {
	return toWrite - cd->outStream.avail_in;
3182
3183
3184
3185
3186
3187
3188
3189

3190
3191
3192
3193
3194
3195
3196
3182
3183
3184
3185
3186
3187
3188

3189
3190
3191
3192
3193
3194
3195
3196







-
+







	    return TCL_ERROR;
	}

	/*
	 * Write the bytes we've received to the next layer.
	 */

	if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) {
	if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) == TCL_IO_FAILURE) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "problem flushing channel: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
3904
3905
3906
3907
3908
3909
3910






3911
3912
3913
3914
3915
3916
3917
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923







+
+
+
+
+
+







     */

    cfg[0].key = "zlibVersion";
    cfg[0].value = zlibVersion();
    cfg[1].key = NULL;
    Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1");

    /*
     * Allow command type introspection to do something sensible with streams.
     */

    TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");

    /*
     * Formally provide the package as a Tcl built-in.
     */

    return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
}


Changes to library/auto.tcl.

69
70
71
72
73
74
75



















































76
77
78
79
80
81
82
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
132
133







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	# 1. From an environment variable, if it exists.  Placing this first
	#    gives the end-user ultimate control to work-around any bugs, or
	#    to customize.

        if {[info exists env($enVarName)]} {
            lappend dirs $env($enVarName)
        }

	catch {
      set found 0
	    set root [zipfs root]
	    set mountpoint [file join $root lib [string tolower $basename]]
      lappend dirs [file join $root app ${basename}_library]
      lappend dirs [file join $root lib $mountpoint ${basename}_library]
      lappend dirs [file join $root lib $mountpoint]
	    if {![zipfs exists [file join $root app ${basename}_library]] \
	      && ![zipfs exists $mountpoint]} {
	      set found 0
	      foreach pkgdat [info loaded] {
	        lassign $pkgdat dllfile dllpkg
	        if {[string tolower $dllpkg] ne [string tolower $basename]} continue
	        if {$dllfile eq {}} {
	          # Loaded statically
	          break
	        }
          set found 1
	        zipfs mount $mountpoint $dllfile
	        break
	      }
	      if {!$found} {
  	      set paths {}
  	      lappend paths [file join $root app]
    	    lappend paths [::${basename}::pkgconfig get libdir,runtime]
	        lappend paths [::${basename}::pkgconfig get bindir,runtime]
	        if {[catch {::${basename}::pkgconfig get zipfile,runtime} zipfile]} {
  	        set zipfile [string tolower \
  	          "lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"]
  	      }
  	      lappend paths [file dirname [file join [pwd] [info nameofexecutable]]]
          foreach path $paths {
            set archive [file join $path $zipfile]
            if {![file exists $archive]} continue
            zipfs mount $mountpoint $archive
            if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} {
              lappend dirs [file join $mountpoint ${basename}_library]
              set found 1
              break
            } elseif {[zipfs exists [file join $mountpoint $initScript]]} {
              lappend dirs [file join $mountpoint $initScript]
              set found 1
              break
            } else {
              catch {zipfs unmount $archive}
            }
          }
        }
      }
   }

	# 2. In the package script directory registered within the
	#    configuration of the package itself.

	catch {
	    lappend dirs [::${basename}::pkgconfig get scriptdir,runtime]
	}

Changes to library/dde/pkgIndex.tcl.

1
2
3
4

5
6

7
1
2
3

4
5

6
7



-
+

-
+

if {([info commands ::tcl::pkgconfig] eq "")
	|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
    package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde]
} else {
    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
    package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde]
}

Added library/http/cookiejar.tcl.










































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# cookiejar.tcl --
#
#	Implementation of an HTTP cookie storage engine using SQLite. The
#	implementation is done as a TclOO class, and includes a punycode
#	encoder and decoder (though only the encoder is currently used).
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Dependencies
package require Tcl 8.6
package require http 2.8.4
package require sqlite3
package require tcl::idna 1.0

#
# Configuration for the cookiejar package, plus basic support procedures.
#

# This is the class that we are creating
if {![llength [info commands ::http::cookiejar]]} {
    ::oo::class create ::http::cookiejar
}

namespace eval [info object namespace ::http::cookiejar] {
    proc setInt {*var val} {
	upvar 1 ${*var} var
	if {[catch {incr dummy $val} msg]} {
	    return -code error $msg
	}
	set var $val
    }
    proc setInterval {trigger *var val} {
	upvar 1 ${*var} var
	if {![string is integer -strict $val] || $val < 1} {
	    return -code error "expected positive integer but got \"$val\""
	}
	set var $val
	{*}$trigger
    }
    proc setBool {*var val} {
	upvar 1 ${*var} var
	if {[catch {if {$val} {}} msg]} {
	    return -code error $msg
	}
	set var [expr {!!$val}]
    }

    proc setLog {*var val} {
	upvar 1 ${*var} var
	set var [::tcl::prefix match -message "log level" \
		{debug info warn error} $val]
    }

    # Keep this in sync with pkgIndex.tcl and with the install directories in
    # Makefiles
    variable version 0.1

    variable domainlist \
	http://publicsuffix.org/list/effective_tld_names.dat
    variable domainfile \
	[file join [file dirname [info script]] effective_tld_names.txt.gz]
    # The list is directed to from http://publicsuffix.org/list/
    variable loglevel info
    variable vacuumtrigger 200
    variable retainlimit 100
    variable offline false
    variable purgeinterval 60000
    variable refreshinterval 10000000
    variable domaincache {}

    # Some support procedures, none particularly useful in general
    namespace eval support {
	# Set up a logger if the http package isn't actually loaded yet.
	if {![llength [info commands ::http::Log]]} {
	    proc ::http::Log args {
		# Do nothing by default...
	    }
	}

	namespace export *
	proc locn {secure domain path {key ""}} {
	    if {$key eq ""} {
		format "%s://%s%s" [expr {$secure?"https":"http"}] \
		    [::tcl::idna encode $domain] $path
	    } else {
		format "%s://%s%s?%s" \
		    [expr {$secure?"https":"http"}] [::tcl::idna encode $domain] \
		    $path $key
	    }
	}
	proc splitDomain domain {
	    set pieces [split $domain "."]
	    for {set i [llength $pieces]} {[incr i -1] >= 0} {} {
		lappend result [join [lrange $pieces $i end] "."]
	    }
	    return $result
	}
	proc splitPath path {
	    set pieces [split [string trimleft $path "/"] "/"]
	    for {set j -1} {$j < [llength $pieces]} {incr j} {
		lappend result /[join [lrange $pieces 0 $j] "/"]
	    }
	    return $result
	}
	proc isoNow {} {
	    set ms [clock milliseconds]
	    set ts [expr {$ms / 1000}]
	    set ms [format %03d [expr {$ms % 1000}]]
	    clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1
	}
	proc log {level msg args} {
	    namespace upvar [info object namespace ::http::cookiejar] \
		loglevel loglevel
	    set who [uplevel 1 self class]
	    set mth [uplevel 1 self method]
	    set map {debug 0 info 1 warn 2 error 3}
	    if {[string map $map $level] >= [string map $map $loglevel]} {
		set msg [format $msg {*}$args]
		set LVL [string toupper $level]
		::http::Log "[isoNow] $LVL $who $mth - $msg"
	    }
	}
    }
}

# Now we have enough information to provide the package.
package provide cookiejar \
    [set [info object namespace ::http::cookiejar]::version]

# The implementation of the cookiejar package
::oo::define ::http::cookiejar {
    self {
	method configure {{optionName "\u0000\u0000"} {optionValue "\u0000\u0000"}} {
	    set tbl {
		-domainfile    {domainfile set}
		-domainlist    {domainlist set}
		-domainrefresh {refreshinterval setInterval}
		-loglevel      {loglevel setLog}
		-offline       {offline setBool}
		-purgeold      {purgeinterval setInterval}
		-retain        {retainlimit setInt}
		-vacuumtrigger {vacuumtrigger setInt}
	    }
	    dict lappend tbl -domainrefresh [namespace code {
		my IntervalTrigger PostponeRefresh
	    }]
	    dict lappend tbl -purgeold [namespace code {
		my IntervalTrigger PostponePurge
	    }]
	    if {$optionName eq "\u0000\u0000"} {
		return [dict keys $tbl]
	    }
	    set opt [::tcl::prefix match -message "option" \
		    [dict keys $tbl] $optionName]
	    set setter [lassign [dict get $tbl $opt] varname]
	    namespace upvar [namespace current] $varname var
	    if {$optionValue ne "\u0000\u0000"} {
		{*}$setter var $optionValue
	    }
	    return $var
	}

	method IntervalTrigger {method} {
	    # TODO: handle subclassing
	    foreach obj [info class instances [self]] {
		[info object namespace $obj]::my $method
	    }
	}
    }

    variable purgeTimer deletions refreshTimer
    constructor {{path ""}} {
	namespace import [info object namespace [self class]]::support::*

	if {$path eq ""} {
	    sqlite3 [namespace current]::db :memory:
	    set storeorigin "constructed cookie store in memory"
	} else {
	    sqlite3 [namespace current]::db $path
	    db timeout 500
	    set storeorigin "loaded cookie store from $path"
	}

	set deletions 0
	db transaction {
	    db eval {
		--;# Store the persistent cookies in this table.
		--;# Deletion policy: once they expire, or if explicitly
		--;# killed.
		CREATE TABLE IF NOT EXISTS persistentCookies (
		    id INTEGER PRIMARY KEY,
		    secure INTEGER NOT NULL,
		    domain TEXT NOT NULL COLLATE NOCASE,
		    path TEXT NOT NULL,
		    key TEXT NOT NULL,
		    value TEXT NOT NULL,
		    originonly INTEGER NOT NULL,
		    expiry INTEGER NOT NULL,
		    lastuse INTEGER NOT NULL,
		    creation INTEGER NOT NULL);
		CREATE UNIQUE INDEX IF NOT EXISTS persistentUnique
		    ON persistentCookies (domain, path, key);
		CREATE INDEX IF NOT EXISTS persistentLookup
		    ON persistentCookies (domain, path);

		--;# Store the session cookies in this table.
		--;# Deletion policy: at cookiejar instance deletion, if
		--;# explicitly killed, or if the number of session cookies is
		--;# too large and the cookie has not been used recently.
		CREATE TEMP TABLE sessionCookies (
		    id INTEGER PRIMARY KEY,
		    secure INTEGER NOT NULL,
		    domain TEXT NOT NULL COLLATE NOCASE,
		    path TEXT NOT NULL,
		    key TEXT NOT NULL,
		    originonly INTEGER NOT NULL,
		    value TEXT NOT NULL,
		    lastuse INTEGER NOT NULL,
		    creation INTEGER NOT NULL);
		CREATE UNIQUE INDEX sessionUnique
		    ON sessionCookies (domain, path, key);
		CREATE INDEX sessionLookup ON sessionCookies (domain, path);

		--;# View to allow for simple looking up of a cookie.
		--;# Deletion policy: NOT SUPPORTED via this view.
		CREATE TEMP VIEW cookies AS
		    SELECT id, domain, (
			    CASE originonly WHEN 1 THEN path ELSE '.' || path END
			) AS path, key, value, secure, 1 AS persistent
			FROM persistentCookies
		    UNION
		    SELECT id, domain, (
			    CASE originonly WHEN 1 THEN path ELSE '.' || path END
			) AS path, key, value, secure, 0 AS persistent
			FROM sessionCookies;

		--;# Encoded domain permission policy; if forbidden is 1, no
		--;# cookie may be ever set for the domain, and if forbidden
		--;# is 0, cookies *may* be created for the domain (overriding
		--;# the forbiddenSuper table).
		--;# Deletion policy: normally not modified.
		CREATE TABLE IF NOT EXISTS domains (
		    domain TEXT PRIMARY KEY NOT NULL,
		    forbidden INTEGER NOT NULL);

		--;# Domains that may not have a cookie defined for direct
		--;# child domains of them.
		--;# Deletion policy: normally not modified.
		CREATE TABLE IF NOT EXISTS forbiddenSuper (
		    domain TEXT PRIMARY KEY);

		--;# When we last retrieved the domain list.
		CREATE TABLE IF NOT EXISTS domainCacheMetadata (
		    id INTEGER PRIMARY KEY,
		    retrievalDate INTEGER,
		    installDate INTEGER);
	    }

	    set cookieCount "no"
	    db eval {
		SELECT COUNT(*) AS cookieCount FROM persistentCookies
	    }
	    log info "%s with %s entries" $storeorigin $cookieCount

	    my PostponePurge

	    if {$path ne ""} {
		if {[db exists {SELECT 1 FROM domains}]} {
		    my RefreshDomains
		} else {
		    my InitDomainList
		    my PostponeRefresh
		}
	    } else {
		set data [my GetDomainListOffline metadata]
		my InstallDomainData $data $metadata
		my PostponeRefresh
	    }
	}
    }

    method PostponePurge {} {
	namespace upvar [info object namespace [self class]] \
	    purgeinterval interval
	catch {after cancel $purgeTimer}
	set purgeTimer [after $interval [namespace code {my PurgeCookies}]]
    }

    method PostponeRefresh {} {
	namespace upvar [info object namespace [self class]] \
	    refreshinterval interval
	catch {after cancel $refreshTimer}
	set refreshTimer [after $interval [namespace code {my RefreshDomains}]]
    }

    method RefreshDomains {} {
	# TODO: domain list refresh policy
	my PostponeRefresh
    }

    method HttpGet {url {timeout 0} {maxRedirects 5}} {
	for {set r 0} {$r < $maxRedirects} {incr r} {
	    set tok [::http::geturl $url -timeout $timeout]
	    try {
		if {[::http::status $tok] eq "timeout"} {
		    return -code error "connection timed out"
		} elseif {[::http::ncode $tok] == 200} {
		    return [::http::data $tok]
		} elseif {[::http::ncode $tok] >= 400} {
		    return -code error [::http::error $tok]
		} elseif {[dict exists [::http::meta $tok] Location]} {
		    set url [dict get [::http::meta $tok] Location]
		    continue
		}
		return -code error \
		    "unexpected state: [::http::code $tok]"
	    } finally {
		::http::cleanup $tok
	    }
	}
	return -code error "too many redirects"
    }
    method GetDomainListOnline {metaVar} {
	upvar 1 $metaVar meta
	namespace upvar [info object namespace [self class]] \
	    domainlist url domaincache cache
	lassign $cache when data
	if {$when > [clock seconds] - 3600} {
	    log debug "using cached value created at %s" \
		[clock format $when -format {%Y%m%dT%H%M%SZ} -gmt 1]
	    dict set meta retrievalDate $when
	    return $data
	}
	log debug "loading domain list from %s" $url
	try {
	    set when [clock seconds]
	    set data [my HttpGet $url]
	    set cache [list $when $data]
	    # TODO: Should we use the Last-Modified header instead?
	    dict set meta retrievalDate $when
	    return $data
	} on error msg {
	    log error "failed to fetch list of forbidden cookie domains from %s: %s" \
		    $url $msg
	    return {}
	}
    }
    method GetDomainListOffline {metaVar} {
	upvar 1 $metaVar meta
	namespace upvar [info object namespace [self class]] \
	    domainfile filename
	log debug "loading domain list from %s" $filename
	try {
	    set f [open $filename]
	    try {
		if {[string match *.gz $filename]} {
		    zlib push gunzip $f
		}
		fconfigure $f -encoding utf-8
		dict set meta retrievalDate [file mtime $filename]
		return [read $f]
	    } finally {
		close $f
	    }
	} on error {msg opt} {
	    log error "failed to read list of forbidden cookie domains from %s: %s" \
		    $filename $msg
	    return -options $opt $msg
	}
    }
    method InitDomainList {} {
	namespace upvar [info object namespace [self class]] \
	    offline offline
	if {!$offline} {
	    try {
		set data [my GetDomainListOnline metadata]
		if {[string length $data]} {
		    my InstallDomainData $data $metadata
		    return
		}
	    } on error {} {
		log warn "attempting to fall back to built in version"
	    }
	}
	set data [my GetDomainListOffline metadata]
	my InstallDomainData $data $metadata
    }

    method InstallDomainData {data meta} {
	set n [db total_changes]
	db transaction {
	    foreach line [split $data "\n"] {
		if {[string trim $line] eq ""} {
		    continue
		} elseif {[string match //* $line]} {
		    continue
		} elseif {[string match !* $line]} {
		    set line [string range $line 1 end]
		    set idna [string tolower [::tcl::idna encode $line]]
		    set utf [::tcl::idna decode [string tolower $line]]
		    db eval {
			INSERT OR REPLACE INTO domains (domain, forbidden)
			VALUES ($utf, 0);
		    }
		    if {$idna ne $utf} {
			db eval {
			    INSERT OR REPLACE INTO domains (domain, forbidden)
			    VALUES ($idna, 0);
			}
		    }
		} else {
		    if {[string match {\*.*} $line]} {
			set line [string range $line 2 end]
			set idna [string tolower [::tcl::idna encode $line]]
			set utf [::tcl::idna decode [string tolower $line]]
			db eval {
			    INSERT OR REPLACE INTO forbiddenSuper (domain)
			    VALUES ($utf);
			}
			if {$idna ne $utf} {
			    db eval {
				INSERT OR REPLACE INTO forbiddenSuper (domain)
				VALUES ($idna);
			    }
			}
		    } else {
			set idna [string tolower [::tcl::idna encode $line]]
			set utf [::tcl::idna decode [string tolower $line]]
		    }
		    db eval {
			INSERT OR REPLACE INTO domains (domain, forbidden)
			VALUES ($utf, 1);
		    }
		    if {$idna ne $utf} {
			db eval {
			    INSERT OR REPLACE INTO domains (domain, forbidden)
			    VALUES ($idna, 1);
			}
		    }
		}
		if {$utf ne [::tcl::idna decode [string tolower $idna]]} {
		    log warn "mismatch in IDNA handling for %s (%d, %s, %s)" \
			    $idna $line $utf [::tcl::idna decode $idna]
		}
	    }

	    dict with meta {
		set installDate [clock seconds]
		db eval {
		    INSERT OR REPLACE INTO domainCacheMetadata
			(id, retrievalDate, installDate)
		    VALUES (1, $retrievalDate, $installDate);
		}
	    }
	}
	set n [expr {[db total_changes] - $n}]
	log info "constructed domain info with %d entries" $n
    }

    # This forces the rebuild of the domain data, loading it from 
    method forceLoadDomainData {} {
	db transaction {
	    db eval {
		DELETE FROM domains;
		DELETE FROM forbiddenSuper;
		INSERT OR REPLACE INTO domainCacheMetadata
		    (id, retrievalDate, installDate)
		VALUES (1, -1, -1);
	    }
	    my InitDomainList
	}
    }

    destructor {
	catch {
	    after cancel $purgeTimer
	}
	catch {
	    after cancel $refreshTimer
	}
	catch {
	    db close
	}
	return
    }

    method GetCookiesForHostAndPath {listVar secure host path fullhost} {
	upvar 1 $listVar result
	log debug "check for cookies for %s" [locn $secure $host $path]
	set exact [expr {$host eq $fullhost}]
	db eval {
	    SELECT key, value FROM persistentCookies
	    WHERE domain = $host AND path = $path AND secure <= $secure
		AND (NOT originonly OR domain = $fullhost)
		AND originonly = $exact
	} {
	    lappend result $key $value
	    db eval {
		UPDATE persistentCookies SET lastuse = $now WHERE id = $id
	    }
	}
	set now [clock seconds]
	db eval {
	    SELECT id, key, value FROM sessionCookies
	    WHERE domain = $host AND path = $path AND secure <= $secure
		AND (NOT originonly OR domain = $fullhost)
		AND originonly = $exact
	} {
	    lappend result $key $value
	    db eval {
		UPDATE sessionCookies SET lastuse = $now WHERE id = $id
	    }
	}
    }

    method getCookies {proto host path} {
	set result {}
	set paths [splitPath $path]
	if {[regexp {[^0-9.]} $host]} {
	    set domains [splitDomain [string tolower [::tcl::idna encode $host]]]
	} else {
	    # Ugh, it's a numeric domain! Restrict it to just itself...
	    set domains [list $host]
	}
	set secure [string equal -nocase $proto "https"]
	# Open question: how to move these manipulations into the database
	# engine (if that's where they *should* be).
	#
	# Suggestion from kbk:
	#LENGTH(theColumn) <= LENGTH($queryStr) AND
	#SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr
	#
	# However, we instead do most of the work in Tcl because that lets us
	# do the splitting exactly right, and it's far easier to work with
	# strings in Tcl than in SQL.
	db transaction {
	    foreach domain $domains {
		foreach p $paths {
		    my GetCookiesForHostAndPath result $secure $domain $p $host
		}
	    }
	    return $result
	}
    }

    method BadDomain options {
	if {![dict exists $options domain]} {
	    log error "no domain present in options"
	    return 0
	}
	dict with options {}
	if {$domain ne $origin} {
	    log debug "cookie domain varies from origin (%s, %s)" \
		    $domain $origin
	    if {[string match .* $domain]} {
		set dotd $domain
	    } else {
		set dotd .$domain
	    }
	    if {![string equal -length [string length $dotd] \
		    [string reverse $dotd] [string reverse $origin]]} {
		log warn "bad cookie: domain not suffix of origin"
		return 1
	    }
	}
	if {![regexp {[^0-9.]} $domain]} {
	    if {$domain eq $origin} {
		# May set for itself
		return 0
	    }
	    log warn "bad cookie: for a numeric address"
	    return 1
	}
	db eval {
	    SELECT forbidden FROM domains WHERE domain = $domain
	} {
	    if {$forbidden} {
		log warn "bad cookie: for a forbidden address"
	    }
	    return $forbidden
	}
	if {[regexp {^[^.]+\.(.+)$} $domain -> super] && [db exists {
	    SELECT 1 FROM forbiddenSuper WHERE domain = $super
	}]} then {
	    log warn "bad cookie: for a forbidden address"
	    return 1
	}
	return 0
    }

    # A defined extension point to allow users to easily impose extra policies
    # on whether to accept cookies from a particular domain and path.
    method policyAllow {operation domain path} {
	return true
    }

    method storeCookie {options} {
	db transaction {
	    if {[my BadDomain $options]} {
		return
	    }
	    set now [clock seconds]
	    set persistent [dict exists $options expires]
	    dict with options {}
	    if {!$persistent} {
		if {![my policyAllow session $domain $path]} {
		    log warn "bad cookie: $domain prohibited by user policy"
		    return
		}
		db eval {
		    INSERT OR REPLACE INTO sessionCookies (
			secure, domain, path, key, value, originonly, creation,
			lastuse)
		    VALUES ($secure, $domain, $path, $key, $value, $hostonly,
			$now, $now);
		    DELETE FROM persistentCookies
		    WHERE domain = $domain AND path = $path AND key = $key
			AND secure <= $secure AND originonly = $hostonly
		}
		incr deletions [db changes]
		log debug "defined session cookie for %s" \
			[locn $secure $domain $path $key]
	    } elseif {$expires < $now} {
		if {![my policyAllow delete $domain $path]} {
		    log warn "bad cookie: $domain prohibited by user policy"
		    return
		}
		db eval {
		    DELETE FROM persistentCookies
		    WHERE domain = $domain AND path = $path AND key = $key
			AND secure <= $secure AND originonly = $hostonly
		}
		set del [db changes]
		db eval {
		    DELETE FROM sessionCookies
		    WHERE domain = $domain AND path = $path AND key = $key
			AND secure <= $secure AND originonly = $hostonly
		}
		incr deletions [incr del [db changes]]
		log debug "deleted %d cookies for %s" \
			$del [locn $secure $domain $path $key]
	    } else {
		if {![my policyAllow set $domain $path]} {
		    log warn "bad cookie: $domain prohibited by user policy"
		    return
		}
		db eval {
		    INSERT OR REPLACE INTO persistentCookies (
			secure, domain, path, key, value, originonly, expiry,
			creation, lastuse)
		    VALUES ($secure, $domain, $path, $key, $value, $hostonly,
			$expires, $now, $now);
		    DELETE FROM sessionCookies
		    WHERE domain = $domain AND path = $path AND key = $key
			AND secure <= $secure AND originonly = $hostonly
		}
		incr deletions [db changes]
		log debug "defined persistent cookie for %s, expires at %s" \
			[locn $secure $domain $path $key] \
			[clock format $expires]
	    }
	}
    }

    method PurgeCookies {} {
	namespace upvar [info object namespace [self class]] \
	    vacuumtrigger trigger  retainlimit retain
	my PostponePurge
	set now [clock seconds]
	log debug "purging cookies that expired before %s" [clock format $now]
	db transaction {
	    db eval {
		DELETE FROM persistentCookies WHERE expiry < $now
	    }
	    incr deletions [db changes]
	    db eval {
		DELETE FROM persistentCookies WHERE id IN (
		    SELECT id FROM persistentCookies ORDER BY lastuse ASC
		    LIMIT -1 OFFSET $retain)
	    }
	    incr deletions [db changes]
	    db eval {
		DELETE FROM sessionCookies WHERE id IN (
		    SELECT id FROM sessionCookies ORDER BY lastuse
		    LIMIT -1 OFFSET $retain)
	    }
	    incr deletions [db changes]
	}

	# Once we've deleted a fair bit, vacuum the database. Must be done
	# outside a transaction.
	if {$deletions > $trigger} {
	    set deletions 0
	    log debug "vacuuming cookie database"
	    catch {
		db eval {
		    VACUUM
		}
	    }
	}
    }

    forward Database db

    method lookup {{host ""} {key ""}} {
	set host [string tolower [::tcl::idna encode $host]]
	db transaction {
	    if {$host eq ""} {
		set result {}
		db eval {
		    SELECT DISTINCT domain FROM cookies
		    ORDER BY domain
		} {
		    lappend result [::tcl::idna decode [string tolower $domain]]
		}
		return $result
	    } elseif {$key eq ""} {
		set result {}
		db eval {
		    SELECT DISTINCT key FROM cookies
		    WHERE domain = $host
		    ORDER BY key
		} {
		    lappend result $key
		}
		return $result
	    } else {
		db eval {
		    SELECT value FROM cookies
		    WHERE domain = $host AND key = $key
		    LIMIT 1
		} {
		    return $value
		}
		return -code error "no such key for that host"
	    }
	}
    }
}

# Local variables:
# mode: tcl
# fill-column: 78
# End:

Added library/http/effective_tld_names.txt.gz.

cannot compute difference between binary files

Changes to library/http/http.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22



23
24
25

26

27
28
29
30



31
32
33
34
35
36
37



38
39
40
41
42



43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67













68
69














70







71
72
73
74
75
76
77
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32



33
34
35
36
37
38
39



40
41
42
43
44



45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67





68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

97
98
99
100
101
102
103
104
105
106
107
108
109
110













-
+








+
+
+



+

+

-
-
-
+
+
+




-
-
-
+
+
+


-
-
-
+
+
+




















-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+







# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy.
#	These procedures use a callback interface to avoid using vwait, which
#	is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.8.12
package provide http 2.9.0

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {
	    -accept */*
	    -cookiejar {}
	    -pipeline 1
	    -postfresh 0
	    -proxyhost {}
	    -proxyport {}
	    -proxyfilter http::ProxyRequired
	    -repost 0
	    -urlencoding utf-8
	    -zip 1
	}
	# We need a useragent string of this style or various servers will refuse to
	# send us compressed content even when we ask for it. This follows the
	# de-facto layout of user-agent strings in current browsers.
	# We need a useragent string of this style or various servers will
	# refuse to send us compressed content even when we ask for it. This
	# follows the de-facto layout of user-agent strings in current browsers.
	# Safe interpreters do not have ::tcl_platform(os) or
	# ::tcl_platform(osVersion).
	if {[interp issafe]} {
	    set http(-useragent) "Mozilla/5.0\
                (Windows; U;\
                Windows NT 10.0)\
                http/[package provide http] Tcl/[package provide Tcl]"
		(Windows; U;\
		Windows NT 10.0)\
		http/[package provide http] Tcl/[package provide Tcl]"
	} else {
	    set http(-useragent) "Mozilla/5.0\
                ([string totitle $::tcl_platform(platform)]; U;\
                $::tcl_platform(os) $::tcl_platform(osVersion))\
                http/[package provide http] Tcl/[package provide Tcl]"
		([string totitle $::tcl_platform(platform)]; U;\
		$::tcl_platform(os) $::tcl_platform(osVersion))\
		http/[package provide http] Tcl/[package provide Tcl]"
	}
    }

    proc init {} {
	# Set up the map for quoting chars. RFC3986 Section 2.3 say percent
	# encode all except: "... percent-encoded octets in the ranges of
	# ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period
	# (%2E), underscore (%5F), or tilde (%7E) should not be created by URI
	# producers ..."
	for {set i 0} {$i <= 256} {incr i} {
	    set c [format %c $i]
	    if {![string match {[-._~a-zA-Z0-9]} $c]} {
		set map($c) %[format %.2X $i]
	    }
	}
	# These are handled specially
	set map(\n) %0D%0A
	variable formMap [array get map]

	# Create a map for HTTP/1.1 open sockets
	variable socketmap
	if {[info exists socketmap]} {
	    # Close but don't remove open sockets on re-init
	    foreach {url sock} [array get socketmap] {
		catch {close $sock}
	variable socketMapping
	variable socketRdState
	variable socketWrState
	variable socketRdQueue
	variable socketWrQueue
	variable socketClosing
	variable socketPlayCmd
	if {[info exists socketMapping]} {
	    # Close open sockets on re-init.  Do not permit retries.
	    foreach {url sock} [array get socketMapping] {
		unset -nocomplain socketClosing($url)
		unset -nocomplain socketPlayCmd($url)
		CloseSocket $sock
	    }
	}

	# CloseSocket should have unset the socket* arrays, one element at
	# a time.  Now unset anything that was overlooked.
	# Traces on "unset socketRdState(*)" will call CancelReadPipeline and
	# cancel any queued responses.
	# Traces on "unset socketWrState(*)" will call CancelWritePipeline and
	# cancel any queued requests.
	array unset socketMapping
	array unset socketRdState
	array unset socketWrState
	array unset socketRdQueue
	array unset socketWrQueue
	array unset socketClosing
	array unset socketPlayCmd
	array set socketmap {}
	array set socketMapping {}
	array set socketRdState {}
	array set socketWrState {}
	array set socketRdQueue {}
	array set socketWrQueue {}
	array set socketClosing {}
	array set socketPlayCmd {}
    }
    init

    variable urlTypes
    if {![info exists urlTypes]} {
	set urlTypes(http) [list 80 ::socket]
    }
91
92
93
94
95
96
97












98
99







100
101
102
103
104
105
106
124
125
126
127
128
129
130
131
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







+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+








    # Let user control default keepalive for compatibility
    variable defaultKeepalive
    if {![info exists defaultKeepalive]} {
	set defaultKeepalive 0
    }

    # Regular expression used to parse cookies
    variable CookieRE {(?x)                            # EXPANDED SYNTAX
	\s*                                            # Ignore leading spaces
	([^][\u0000- ()<>@,;:\\""/?={}\u007f-\uffff]+) # Match the name
	=                                              # LITERAL: Equal sign
	([!\u0023-+\u002D-:<-\u005B\u005D-~]*)         # Match the value
	(?:
	 \s* ; \s*                                     # LITERAL: semicolon
	 ([^\u0000]+)                                  # Match the options
	)?
    }

    namespace export geturl config reset wait formatQuery register unregister
    # Useful, but not exported: data size status code
    namespace export geturl config reset wait formatQuery quoteString
    namespace export register unregister registerError
    # - Useful, but not exported: data, size, status, code, cleanup, error,
    #   meta, ncode, mapReply, init.  Comments suggest that "init" can be used
    #   for re-initialisation, although the command is undocumented.
    # - Not exported, probably should be upper-case initial letter as part
    #   of the internals: getTextLine, make-transformation-chunked.
}

# http::Log --
#
#	Debugging output -- define this to observe HTTP/1.1 socket usage.
#	Should echo any args received.
#
186
187
188
189
190
191
192
193

194
195
196
197
198
199

200
201








202
203
204

205
206
207
208



209

210

211
212
213



214






215
216
217

218
219
220


221
222
223
224
225
226

























































































































































































































227
228
229
230
231
232
233
234

235
236
237











238
239

240
241
242
243
244
245





246
247
248
249



250
251
252


253

254
255
256
257
















258














































259


260
261
262
263
264
265
266











267
268
269






















270
271
272
273
274
275
276
277
278
279
280
281

282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303


304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322

323
324

325

326
327
328
329
330
331
332
333
334
335
336
337
338
339
340

341

342
343
344
345
346
347
348
236
237
238
239
240
241
242

243
244
245
246
247
248

249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270

271
272
273
274
275
276
277
278
279

280
281
282
283
284
285
286
287
288
289
290


291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522

523
524


525
526
527
528
529
530
531
532
533
534
535
536

537
538





539
540
541
542
543
544



545
546
547
548


549
550
551
552




553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618







619
620
621
622
623
624
625
626
627
628
629



630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662

663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683


684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724

725
726
727
728
729
730
731
732
733
734







-
+





-
+


+
+
+
+
+
+
+
+



+




+
+
+
-
+

+



+
+
+
-
+
+
+
+
+
+



+

-
-
+
+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+

-
-
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+

-
-
+
+

+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+




















-
-
+
+



















+


+

+














-
+

+







# http::Finish --
#
#	Clean up the socket and eval close time callbacks
#
# Arguments:
#	token	    Connection token.
#	errormsg    (optional) If set, forces status to error.
#       skipCB      (optional) If set, don't call the -command callback. This
#	skipCB      (optional) If set, don't call the -command callback. This
#		    is useful when geturl wants to throw an exception instead
#		    of calling the callback. That way, the same error isn't
#		    reported to two places.
#
# Side Effects:
#        Closes the socket
#        May close the socket.

proc http::Finish {token {errormsg ""} {skipCB 0}} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    global errorInfo errorCode
    set closeQueue 0
    if {$errormsg ne ""} {
	set state(error) [list $errormsg $errorInfo $errorCode]
	set state(status) "error"
    }
    if {[info commands ${token}EventCoroutine] ne {}} {
	rename ${token}EventCoroutine {}
    }
    if { ($state(status) eq "timeout")
    if {  ($state(status) eq "timeout")
       || ($state(status) eq "error")
       || ($state(status) eq "eof")
       || ([info exists state(-keepalive)] && !$state(-keepalive))
       || ([info exists state(connection)] && ($state(connection) eq "close"))
    } {
	set closeQueue 1
	set connId $state(socketinfo)
	set sock $state(sock)
        CloseSocket $state(sock) $token
	CloseSocket $state(sock) $token
    } elseif {
	  ([info exists state(-keepalive)] && $state(-keepalive))
       && ([info exists state(connection)] && ($state(connection) ne "close"))
    } {
	KeepSocket $token
    }
    if {[info exists state(after)]} {
	after cancel $state(after)
	unset state(after)
    }
    if {[info exists state(-command)] && !$skipCB
	    && ![info exists state(done-command-cb)]} {
    if {[info exists state(-command)] && (!$skipCB)
	    && (![info exists state(done-command-cb)])} {
	set state(done-command-cb) yes
	if {[catch {eval $state(-command) {$token}} err] && $errormsg eq ""} {
	    set state(error) [list $err $errorInfo $errorCode]
	    set state(status) error
	}
    }

    if {    $closeQueue
	 && [info exists socketMapping($connId)]
	 && ($socketMapping($connId) eq $sock)
    } {
	http::CloseQueuedQueries $connId $token
    }
}

# http::KeepSocket -
#
#	Keep a socket in the persistent sockets table and connect it to its next
#	queued task if possible.  Otherwise leave it idle and ready for its next
#	use.
#
#	If $socketClosing(*), then ($state(connection) eq "close") and therefore
#	this command will not be called by Finish.
#
# Arguments:
#	token	    Connection token.

proc http::KeepSocket {token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]

    # Keep this socket open for another request ("Keep-Alive").
    # React if the server half-closes the socket.
    # Discussion is in http::geturl.
    catch {fileevent $state(sock) readable [list http::CheckEof $state(sock)]}

    # The line below should not be changed in production code.
    # It is edited by the test suite.
    set TEST_EOF 0
    if {$TEST_EOF} {
	# ONLY for testing reaction to server eof.
	# No server timeouts will be caught.
	catch {fileevent $state(sock) readable {}}
    }

    if {    [info exists state(socketinfo)]
	 && [info exists socketMapping($state(socketinfo))]
    } {
	set connId $state(socketinfo)
	# The value "Rready" is set only here.
	set socketRdState($connId) Rready

	if {    $state(-pipeline)
	     && [info exists socketRdQueue($connId)]
	     && [llength $socketRdQueue($connId)]
	} {
	    # The usual case for pipelined responses - if another response is
	    # queued, arrange to read it.
	    set token3 [lindex $socketRdQueue($connId) 0]
	    set socketRdQueue($connId) [lrange $socketRdQueue($connId) 1 end]
	    variable $token3
	    upvar 0 $token3 state3
	    set tk2 [namespace tail $token3]

	    #Log pipelined, GRANT read access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    ReceiveResponse $token3

	    # Other pipelined cases.
	    # - The test above ensures that, for the pipelined cases in the two
	    #   tests below, the read queue is empty.
	    # - In those two tests, check whether the next write will be
	    #   nonpipeline.
	} elseif {
		$state(-pipeline)
	     && [info exists socketWrState($connId)]
	     && ($socketWrState($connId) eq "peNding")

	     && [info exists socketWrQueue($connId)]
	     && [llength $socketWrQueue($connId)]
	     && (![set token3 [lindex $socketWrQueue($connId) 0]
		   set ${token3}(-pipeline)
		  ]
		)
	} {
	    # This case:
	    # - Now it the time to run the "pending" request.
	    # - The next token in the write queue is nonpipeline, and
	    #   socketWrState has been marked "pending" (in
	    #   http::NextPipelinedWrite or http::geturl) so a new pipelined
	    #   request cannot jump the queue.
	    #
	    # Tests:
	    # - In this case the read queue (tested above) is empty and this
	    #   "pending" write token is in front of the rest of the write
	    #   queue.
	    # - The write state is not Wready and therefore appears to be busy,
	    #   but because it is "pending" we know that it is reserved for the
	    #   first item in the write queue, a non-pipelined request that is
	    #   waiting for the read queue to empty.  That has now happened: so
	    #   give that request read and write access.
	    variable $token3
	    set conn [set ${token3}(tmpConnArgs)]
	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    set socketWrState($connId) $token3
	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	    # Connect does its own fconfigure.
	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	    #Log ---- $state(sock) << conn to $token3 for HTTP request (c)

	} elseif {
		$state(-pipeline)
	     && [info exists socketWrState($connId)]
	     && ($socketWrState($connId) eq "peNding")

	} {
	    # Should not come here.  The second block in the previous "elseif"
	    # test should be tautologous (but was needed in an earlier
	    # implementation) and will be removed after testing.
	    # If we get here, the value "pending" was assigned in error.
	    # This error would block the queue for ever.
	    Log ^X$tk <<<<< Error in queueing of requests >>>>> - token $token

	} elseif {
		$state(-pipeline)
	     && [info exists socketWrState($connId)]
	     && ($socketWrState($connId) eq "Wready")

	     && [info exists socketWrQueue($connId)]
	     && [llength $socketWrQueue($connId)]
	     && (![set token3 [lindex $socketWrQueue($connId) 0]
		   set ${token3}(-pipeline)
		  ]
		)
	} {
	    # This case:
	    # - The next token in the write queue is nonpipeline, and
	    #   socketWrState is Wready.  Get the next event from socketWrQueue.
	    # Tests:
	    # - In this case the read state (tested above) is Rready and the
	    #   write state (tested here) is Wready - there is no "pending"
	    #   request.
	    # Code:
	    # - The code is the same as the code below for the nonpipelined
	    #   case with a queued request.
	    variable $token3
	    set conn [set ${token3}(tmpConnArgs)]
	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    set socketWrState($connId) $token3
	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	    # Connect does its own fconfigure.
	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	    #Log ---- $state(sock) << conn to $token3 for HTTP request (c)

	} elseif {
		(!$state(-pipeline))
	     && [info exists socketWrQueue($connId)]
	     && [llength $socketWrQueue($connId)]
	     && ($state(connection) ne "close")
	} {
	    # If not pipelined, (socketRdState eq Rready) tells us that we are
	    # ready for the next write - there is no need to check
	    # socketWrState. Write the next request, if one is waiting.
	    # If the next request is pipelined, it receives premature read
	    # access to the socket. This is not a problem.
	    set token3 [lindex $socketWrQueue($connId) 0]
	    variable $token3
	    set conn [set ${token3}(tmpConnArgs)]
	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    set socketWrState($connId) $token3
	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	    # Connect does its own fconfigure.
	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	    #Log ---- $state(sock) << conn to $token3 for HTTP request (d)

	} elseif {(!$state(-pipeline))} {
	    set socketWrState($connId) Wready
	    # Rready and Wready and idle: nothing to do.
	}

    } else {
	CloseSocket $state(sock) $token
	# There is no socketMapping($state(socketinfo)), so it does not matter
	# that CloseQueuedQueries is not called.
    }
}

# http::CheckEof -
#
#	Read from a socket and close it if eof.
#	The command is bound to "fileevent readable" on an idle socket, and
#	"eof" is the only event that should trigger the binding, occurring when
#	the server times out and half-closes the socket.
#
#	A read is necessary so that [eof] gives a meaningful result.
#	Any bytes sent are junk (or a bug).

proc http::CheckEof {sock} {
    set junk [read $sock]
    set n [string length $junk]
    if {$n} {
	Log "WARNING: $n bytes received but no HTTP request sent"
    }

    if {[catch {eof $sock} res] || $res} {
	# The server has half-closed the socket.
	# If a new write has started, its transaction will fail and
	# will then be error-handled.
	CloseSocket $sock
    }
}

# http::CloseSocket -
#
#	Close a socket and remove it from the persistent sockets table.  If
#	possible an http token is included here but when we are called from a
#	fileevent on remote closure we need to find the correct entry - hence
#	the second section.
#	the "else" block of the first "if" command.

proc ::http::CloseSocket {s {token {}}} {
    variable socketmap
proc http::CloseSocket {s {token {}}} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    set tk [namespace tail $token]

    catch {fileevent $s readable {}}
    set conn_id {}
    set connId {}
    if {$token ne ""} {
        variable $token
        upvar 0 $token state
        if {[info exists state(socketinfo)]} {
	    set conn_id $state(socketinfo)
        }
	variable $token
	upvar 0 $token state
	if {[info exists state(socketinfo)]} {
	    set connId $state(socketinfo)
	}
    } else {
        set map [array get socketmap]
        set ndx [lsearch -exact $map $s]
        if {$ndx != -1} {
	set map [array get socketMapping]
	set ndx [lsearch -exact $map $s]
	if {$ndx != -1} {
	    incr ndx -1
	    set conn_id [lindex $map $ndx]
        }
	    set connId [lindex $map $ndx]
	}
    }
    if {    ($connId ne {})
    if {$conn_id eq {} || ![info exists socketmap($conn_id)]} {
        Log "Closing socket $s (no connection info)"
        if {[catch {close $s} err]} {
	    Log "Error: $err"
	 && [info exists socketMapping($connId)]
	 && ($socketMapping($connId) eq $s)
    } {
	Log "Closing connection $connId (sock $socketMapping($connId))"
	if {[catch {close $socketMapping($connId)} err]} {
	    Log "Error closing connection: $err"
	}
	if {$token eq {}} {
	    # Cases with a non-empty token are handled by Finish, so the tokens
	    # are finished in connection order.
	    http::CloseQueuedQueries $connId
	}
    } else {
	Log "Closing socket $s (no connection info)"
	if {[catch {close $s} err]} {
	    Log "Error closing socket: $err"
	}
    }
}

# http::CloseQueuedQueries
#
#	connId  - identifier "domain:port" for the connection
#	token   - (optional) used only for logging
#
# Called from http::CloseSocket and http::Finish, after a connection is closed,
# to clear the read and write queues if this has not already been done.

proc http::CloseQueuedQueries {connId {token {}}} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    if {![info exists socketMapping($connId)]} {
	# Command has already been called.
	# Don't come here again - especially recursively.
	return
    }

    # Used only for logging.
    if {$token eq {}} {
	set tk {}
    } else {
	set tk [namespace tail $token]
    }

    if {    [info exists socketPlayCmd($connId)]
	 && ($socketPlayCmd($connId) ne {ReplayIfClose Wready {} {}})
    } {
	# Before unsetting, there is some unfinished business.
	# - If the server sent "Connection: close", we have stored the command
	#   for retrying any queued requests in socketPlayCmd, so copy that
	#   value for execution below.  socketClosing(*) was also set.
	# - Also clear the queues to prevent calls to Finish that would set the
	#   state for the requests that will be retried to "finished with error
	#   status".
	set unfinished $socketPlayCmd($connId)
	set socketRdQueue($connId) {}
	set socketWrQueue($connId) {}
    } else {
	set unfinished {}
    }
	if {[info exists socketmap($conn_id)]} {
	    Log "Closing connection $conn_id (sock $socketmap($conn_id))"
	    if {[catch {close $socketmap($conn_id)} err]} {
		Log "Error: $err"
	    }
	    unset socketmap($conn_id)
	} else {

    Unset $connId

    if {$unfinished ne {}} {
	Log ^R$tk Any unfinished transactions (excluding $token) failed \
		- token $token
	{*}$unfinished
    }
}

# http::Unset
	    Log "Cannot close connection $conn_id - no socket in socket map"
	}
    }
#
#	The trace on "unset socketRdState(*)" will call CancelReadPipeline
#	and cancel any queued responses.
#	The trace on "unset socketWrState(*)" will call CancelWritePipeline
#	and cancel any queued requests.

proc http::Unset {connId} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    unset socketMapping($connId)
    unset socketRdState($connId)
    unset socketWrState($connId)
    unset -nocomplain socketRdQueue($connId)
    unset -nocomplain socketWrQueue($connId)
    unset -nocomplain socketClosing($connId)
    unset -nocomplain socketPlayCmd($connId)
}

# http::reset --
#
#	See documentation for details.
#
# Arguments:
#	token	Connection token.
#	why	Status info.
#
# Side Effects:
#       See Finish
#        See Finish

proc http::reset {token {why reset}} {
    variable $token
    upvar 0 $token state
    set state(status) $why
    catch {fileevent $state(sock) readable {}}
    catch {fileevent $state(sock) writable {}}
    Finish $token
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state
	eval ::error $errorlist
    }
}

# http::geturl --
#
#	Establishes a connection to a remote url via http.
#
# Arguments:
#       url		The http URL to goget.
#       args		Option value pairs. Valid options include:
#	url		The http URL to goget.
#	args		Option value pairs. Valid options include:
#				-blocksize, -validate, -headers, -timeout
# Results:
#	Returns a token for this connection. This token is the name of an
#	array that the caller should unset to garbage collect the state.

proc http::geturl {url args} {
    variable http
    variable urlTypes
    variable defaultCharset
    variable defaultKeepalive
    variable strict

    # Initialize the state variable, an array. We'll return the name of this
    # array as the token for the transaction.

    if {![info exists http(uid)]} {
	set http(uid) 0
    }
    set token [namespace current]::[incr http(uid)]
    ##Log Starting http::geturl - token $token
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    reset $token
    Log ^A$tk URL $url - token $token

    # Process command options.

    array set state {
	-binary		false
	-blocksize	8192
	-queryblocksize 8192
	-validate	0
	-headers	{}
	-timeout	0
	-type		application/x-www-form-urlencoded
	-queryprogress	{}
	-protocol	1.1
	binary		0
	state		connecting
	state		created
	meta		{}
	method		{}
	coding		{}
	currentsize	0
	totalsize	0
	querylength	0
	queryoffset	0
	type		text/html
	body		{}
515
516
517
518
519
520
521



522
523

524
525
526
527
528
529
530
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920







+
+
+


+







	    # Provide a better error message in this error case
	    if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} {
		return -code error \
		    "Illegal encoding character usage \"$bad\" in URL path"
	    }
	    return -code error "Illegal characters in URL path"
	}
	if {![regexp {^[^?#]+} $srvurl state(path)]} {
	    set state(path) /
	}
    } else {
	set srvurl /
	set state(path) /
    }
    if {$proto eq ""} {
	set proto http
    }
    set lower [string tolower $proto]
    if {![info exists urlTypes($lower)]} {
	unset $token
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582




















583









584
585
586
587
588
589
















































590






591
592


593
594
595
596
597
598
599





































600
601
602
603
604



605
606


607
608
609
610
611
612


613

614
615
616




















617
618
619
620
621







































622
623
624
625
626















































































627


628
629
630
631
632
633
634
941
942
943
944
945
946
947



948




949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996





997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051


1052
1053







1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098


1099
1100
1101
1102
1103
1104


1105
1106
1107
1108



1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129




1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252

1253
1254
1255
1256
1257
1258
1259
1260
1261







-
-
-

-
-
-
-

















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





+
+
+
-
-
+
+




-
-
+
+

+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+







    if {$port != $defport} {
	append url : $port
    }
    append url $srvurl
    # Don't append the fragment!
    set state(url) $url

    # If a timeout is specified we set up the after event and arrange for an
    # asynchronous socket connection.

    set sockopts [list -async]
    if {$state(-timeout) > 0} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
    }

    # If we are using the proxy, we must pass in the full URL that includes
    # the server name.

    if {[info exists phost] && ($phost ne "")} {
	set srvurl $url
	set targetAddr [list $phost $pport]
    } else {
	set targetAddr [list $host $port]
    }
    # Proxy connections aren't shared among different hosts.
    set state(socketinfo) $host:$port

    # Save the accept types at this point to prevent a race condition. [Bug
    # c11a51c482]
    set state(accept-types) $http(-accept)

    if {$isQuery || $isQueryChannel} {
	# It's a POST.
	# A client wishing to send a non-idempotent request SHOULD wait to send
	# that request until it has received the response status for the
	# previous request.
	if {$http(-postfresh)} {
	    # Override -keepalive for a POST.  Use a new connection, and thus
	    # avoid the small risk of a race against server timeout.
	    set state(-keepalive) 0
	} else {
	    # Allow -keepalive but do not -pipeline - wait for the previous
	    # transaction to finish.
	    # There is a small risk of a race against server timeout.
	    set state(-pipeline) 0
	}
    } else {
	# It's a GET or HEAD.
	set state(-pipeline) $http(-pipeline)
    }

    # See if we are supposed to use a previously opened channel.
    # - In principle, ANY call to http::geturl could use a previously opened
    #   channel if it is available - the "Connection: keep-alive" header is a
    #   request to leave the channel open AFTER completion of this call.
    # - In fact, we try to use an existing channel only if -keepalive 1 -- this
    #   means that at most one channel is left open for each value of
    #   $state(socketinfo). This property simplifies the mapping of open
    #   channels.
    set reusing 0
    set alreadyQueued 0
    if {$state(-keepalive)} {
	variable socketmap
	if {[info exists socketmap($state(socketinfo))]} {
	    if {[catch {fconfigure $socketmap($state(socketinfo))}]} {
		Log "WARNING: socket for $state(socketinfo) was closed"
		unset socketmap($state(socketinfo))
	variable socketMapping
	variable socketRdState
	variable socketWrState
	variable socketRdQueue
	variable socketWrQueue
	variable socketClosing
	variable socketPlayCmd

	if {[info exists socketMapping($state(socketinfo))]} {
	    # - If the connection is idle, it has a "fileevent readable" binding
	    #   to http::CheckEof, in case the server times out and half-closes
	    #   the socket (http::CheckEof closes the other half).
	    # - We leave this binding in place until just before the last
	    #   puts+flush in http::Connected (GET/HEAD) or http::Write (POST),
	    #   after which the HTTP response might be generated.

	    if {    [info exists socketClosing($state(socketinfo))]
		       && $socketClosing($state(socketinfo))
	    } {
		# socketClosing(*) is set because the server has sent a
		# "Connection: close" header.
		# Do not use the persistent socket again.
		# Since we have only one persistent socket per server, and the
		# old socket is not yet dead, add the request to the write queue
		# of the dying socket, which will be replayed by ReplayIfClose.
		# Also add it to socketWrQueue(*) which is used only if an error
		# causes a call to Finish.
		set reusing 1
		set sock $socketMapping($state(socketinfo))
		Log "reusing socket $sock for $state(socketinfo) - token $token"

		set alreadyQueued 1
		lassign $socketPlayCmd($state(socketinfo)) com0 com1 com2 com3
		lappend com3 $token
		set socketPlayCmd($state(socketinfo)) [list $com0 $com1 $com2 $com3]
		lappend socketWrQueue($state(socketinfo)) $token
	    } elseif {[catch {fconfigure $socketMapping($state(socketinfo))}]} {
		# FIXME Is it still possible for this code to be executed? If
		#       so, this could be another place to call TestForReplay,
		#       rather than discarding the queued transactions.
		Log "WARNING: socket for $state(socketinfo) was closed\
			- token $token"
		Log "WARNING - if testing, pay special attention to this\
			case (GH) which is seldom executed - token $token"

		# This will call CancelReadPipeline, CancelWritePipeline, and
		# cancel any queued requests, responses.
		Unset $state(socketinfo)
	    } else {
		# Use the persistent socket.
		# The socket may not be ready to write: an earlier request might
		# still be still writing (in the pipelined case) or
		# writing/reading (in the nonpipeline case). This possibility
		# is handled by socketWrQueue later in this command.
		set reusing 1
		set sock $socketmap($state(socketinfo))
		Log "reusing socket $sock for $state(socketinfo)"
		set sock $socketMapping($state(socketinfo))
		Log "reusing socket $sock for $state(socketinfo) - token $token"
		catch {fileevent $sock writable {}}
		catch {fileevent $sock readable {}}
	    }
	}
	# don't automatically close this connection socket
	set state(connection) {}
    }

	    }
	    # Do not automatically close the connection socket.
	    set state(connection) {}
	}
    }

    if {$reusing} {
	# Define state(tmpState) and state(tmpOpenCmd) for use
	# by http::ReplayIfDead if the persistent connection has died.
	set state(tmpState) [array get state]

	# Pass -myaddr directly to the socket command
	if {[info exists state(-myaddr)]} {
	    lappend sockopts -myaddr $state(-myaddr)
	}

	set state(tmpOpenCmd) [list {*}$defcmd {*}$sockopts {*}$targetAddr]
    }

    set state(reusing) $reusing
    # Excluding ReplayIfDead and the decision whether to call it, there are four
    # places outside http::geturl where state(reusing) is used:
    # - Connected   - if reusing and not pipelined, start the state(-timeout)
    #                 timeout (when writing).
    # - DoneRequest - if reusing and pipelined, send the next pipelined write
    # - Event       - if reusing and pipelined, start the state(-timeout)
    #                 timeout (when reading).
    # - Event       - if (not reusing) and pipelined, send the next pipelined
    #                 write

    # See comments above re the start of this timeout in other cases.
    if {(!$state(reusing)) && ($state(-timeout) > 0)} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
    }

    if {![info exists sock]} {
	# Pass -myaddr directly to the socket command
	if {[info exists state(-myaddr)]} {
	    lappend sockopts -myaddr $state(-myaddr)
	}
	set pre [clock milliseconds]
	##Log pre socket opened, - token $token
	##Log [concat $defcmd $sockopts $targetAddr] - token $token
        if {[catch {eval $defcmd $sockopts $targetAddr} sock]} {
	    # something went wrong while trying to establish the connection.
	if {[catch {eval $defcmd $sockopts $targetAddr} sock errdict]} {
	    # Something went wrong while trying to establish the connection.
	    # Clean up after events and such, but DON'T call the command
	    # callback (if available) because we're going to throw an
	    # exception from here instead.

	    set state(sock) $sock
	    Finish $token "" 1
	    set state(sock) NONE
	    Finish $token $sock 1
	    cleanup $token
	    dict unset errdict -level
	    return -code error $sock
        }
    }
	    return -options $errdict $sock
	} else {
	    # Initialisation of a new socket.
	    ##Log post socket opened, - token $token
	    ##Log socket opened, now fconfigure - token $token
	    set delay [expr {[clock milliseconds] - $pre}]
	    if {$delay > 3000} {
		Log socket delay $delay - token $token
	    }
	    fconfigure $sock -translation {auto crlf} \
			     -buffersize $state(-blocksize)
	    ##Log socket opened, DONE fconfigure - token $token
	}
    }
    # Command [socket] is called with -async, but takes 5s to 5.1s to return,
    # with probability of order 1 in 10,000.  This may be a bizarre scheduling
    # issue with my (KJN's) system (Fedora Linux).
    # This does not cause a problem (unless the request times out when this
    # command returns).

    set state(sock) $sock
    Log "Using $sock for $state(socketinfo)" \
        [expr {$state(-keepalive)?"keepalive":""}]
    if {$state(-keepalive)} {
        set socketmap($state(socketinfo)) $sock
    Log "Using $sock for $state(socketinfo) - token $token" \
	[expr {$state(-keepalive)?"keepalive":""}]

    if {    $state(-keepalive)
	 && (![info exists socketMapping($state(socketinfo))])
    } {
	# Freshly-opened socket that we would like to become persistent.
	set socketMapping($state(socketinfo)) $sock

	if {![info exists socketRdState($state(socketinfo))]} {
	    set socketRdState($state(socketinfo)) {}
	    set varName ::http::socketRdState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelReadPipeline
	}
	if {![info exists socketWrState($state(socketinfo))]} {
	    set socketWrState($state(socketinfo)) {}
	    set varName ::http::socketWrState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelWritePipeline
	}

	if {$state(-pipeline)} {
	    #Log new, init for pipelined, GRANT write access to $token in geturl
	    # Also grant premature read access to the socket. This is OK.
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	} else {
	    # socketWrState is not used by this non-pipelined transaction.
	    # We cannot leave it as "Wready" because the next call to
	    # http::geturl with a pipelined transaction would conclude that the
	    # socket is available for writing.
	    #Log new, init for nonpipeline, GRANT r/w access to $token in geturl
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	}

	set socketRdQueue($state(socketinfo)) {}
	set socketWrQueue($state(socketinfo)) {}
	set socketClosing($state(socketinfo)) 0
	set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
    }

    if {![info exists phost]} {
	set phost ""
    }
    if {$reusing} {
	# For use by http::ReplayIfDead if the persistent connection has died.
	# Also used by NextPipelinedWrite.
	set state(tmpConnArgs) [list $proto $phost $srvurl]
    }

    # The element socketWrState($connId) has a value which is either the name of
    # the token that is permitted to write to the socket, or "Wready" if no
    # token is permitted to write.
    #
    # The code that sets the value to Wready immediately calls
    # http::NextPipelinedWrite, which examines socketWrQueue($connId) and
    # processes the next request in the queue, if there is one.  The value
    # Wready is not found when the interpreter is in the event loop unless the
    # socket is idle.
    #
    # The element socketRdState($connId) has a value which is either the name of
    # the token that is permitted to read from the socket, or "Rready" if no
    # token is permitted to read.
    #
    # The code that sets the value to Rready then examines
    # socketRdQueue($connId) and processes the next request in the queue, if
    # there is one.  The value Rready is not found when the interpreter is in
    # the event loop unless the socket is idle.

    if {$alreadyQueued} {
	# A write may or may not be in progress.  There is no need to set
	# socketWrState to prevent another call stealing write access - all
	# subsequent calls on this socket will come here because the socket
	# will close after the current read, and its
	# socketClosing($connId) is 1.
	##Log "HTTP request for token $token is queued"

    } elseif {    $reusing
	       && $state(-pipeline)
	       && ($socketWrState($state(socketinfo)) ne "Wready")
    } {
	##Log "HTTP request for token $token is queued for pipelined use"
	lappend socketWrQueue($state(socketinfo)) $token

    } elseif {    $reusing
	       && (!$state(-pipeline))
	       && ($socketWrState($state(socketinfo)) ne "Wready")
    } {
	# A write is queued or in progress.  Lappend to the write queue.
	##Log "HTTP request for token $token is queued for nonpipeline use"
	lappend socketWrQueue($state(socketinfo)) $token

    } elseif {    $reusing
	       && (!$state(-pipeline))
	       && ($socketWrState($state(socketinfo)) eq "Wready")
	       && ($socketRdState($state(socketinfo)) ne "Rready")
    } {
	# A read is queued or in progress, but not a write.  Cannot start the
	# nonpipeline transaction, but must set socketWrState to prevent a
	# pipelined request jumping the queue.
	##Log "HTTP request for token $token is queued for nonpipeline use"
	#Log re-use nonpipeline, GRANT delayed write access to $token in geturl

	set socketWrState($state(socketinfo)) peNding
	lappend socketWrQueue($state(socketinfo)) $token

    } else {
	if {$reusing && $state(-pipeline)} {
	    #Log re-use pipelined, GRANT write access to $token in geturl
	    set socketWrState($state(socketinfo)) $token

	} elseif {$reusing} {
	    # Cf tests above - both are ready.
	    #Log re-use nonpipeline, GRANT r/w access to $token in geturl
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	}

	# All (!$reusing) cases come here, and also some $reusing cases if the
	# connection is ready.
	#Log ---- $state(socketinfo) << conn to $token for HTTP request (a)
	# Connect does its own fconfigure.
	fileevent $sock writable \
    fileevent $sock writable [list http::Connect $token $proto $phost $srvurl]
		[list http::Connect $token $proto $phost $srvurl]
    }

    # Wait for the connection to complete.
    if {![info exists state(-command)]} {
	# geturl does EVERYTHING asynchronously, so if the user
	# calls it synchronously, we just do a wait here.
	http::wait $token

643
644
645
646
647
648
649
650

651
652
653
654
655
656
657
658
659
660
661


662
663
664
665
666
667
668
669







670
671
672

673





674

675
676
677
678
679
680
681
682
683
684
685
686






687
688
689
690
691
692
693
1270
1271
1272
1273
1274
1275
1276

1277
1278
1279
1280
1281
1282
1283
1284
1285
1286


1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313

1314
1315
1316
1317
1318
1319
1320
1321
1322
1323



1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336







-
+









-
-
+
+








+
+
+
+
+
+
+



+

+
+
+
+
+
-
+









-
-
-
+
+
+
+
+
+







	    # callback (if available) because we're going to throw an
	    # exception from here instead.
	    set err [lindex $state(error) 0]
	    cleanup $token
	    return -code error $err
	}
    }

    ##Log Leaving http::geturl - token $token
    return $token
}

# http::Connected --
#
#	Callback used when the connection to the HTTP server is actually
#	established.
#
# Arguments:
#       token	State token.
#       proto	What protocol (http, https, etc.) was used to connect.
#	token	State token.
#	proto	What protocol (http, https, etc.) was used to connect.
#	phost	Are we using keep-alive? Non-empty if yes.
#	srvurl	Service-local URL that we're requesting
# Results:
#	None.

proc http::Connected {token proto phost srvurl} {
    variable http
    variable urlTypes
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]

    if {$state(reusing) && (!$state(-pipeline)) && ($state(-timeout) > 0)} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
    }

    # Set back the variables needed here
    # Set back the variables needed here.
    set sock $state(sock)
    set isQueryChannel [info exists state(-querychannel)]
    set isQuery [info exists state(-query)]
    set host [lindex [split $state(socketinfo) :] 0]
    set port [lindex [split $state(socketinfo) :] 1]

    set lower [string tolower $proto]
    set defport [lindex $urlTypes($lower) 0]

    # Send data in cr-lf format, but accept any line terminators

    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
    # Send data in cr-lf format, but accept any line terminators.
    # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest.
    # We are concerned here with the request (write) not the response (read).
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list $trRead crlf] \
		     -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.

    catch {fconfigure $sock -blocking off}
    set how GET
    if {$isQuery} {
702
703
704
705
706
707
708

709


710
711
712

713
714
715
716
717
718
719
720



721

722
723
724


725

726
727
728

729
730

731
732
733
734



735
736
737


738
739
740


741
742
743


744
745
746
747
748
749
750
1345
1346
1347
1348
1349
1350
1351
1352

1353
1354
1355
1356

1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375

1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386

1387
1388
1389
1390


1391
1392
1393


1394
1395
1396


1397
1398
1399
1400
1401
1402
1403
1404
1405







+
-
+
+


-
+








+
+
+

+



+
+
-
+



+


+



-
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+







	}
    } elseif {$state(-validate)} {
	set how HEAD
    } elseif {$isQueryChannel} {
	set how POST
	# The query channel must be blocking for the async Write to
	# work properly.
	lassign [fconfigure $sock -translation] trRead trWrite
	fconfigure $state(-querychannel) -blocking 1 -translation binary
	fconfigure $state(-querychannel) -blocking 1 \
					 -translation [list $trRead binary]
	set contDone 0
    }
    if {[info exists state(-method)] && $state(-method) ne ""} {
    if {[info exists state(-method)] && ($state(-method) ne "")} {
	set how $state(-method)
    }
    # We cannot handle chunked encodings with -handler, so force HTTP/1.0
    # until we can manage this.
    if {[info exists state(-handler)]} {
	set state(-protocol) 1.0
    }
    set accept_types_seen 0

    Log ^B$tk begin sending request - token $token

    if {[catch {
	set state(method) $how
	puts $sock "$how $srvurl HTTP/$state(-protocol)"
	if {[dict exists $state(-headers) Host]} {
	    # Allow Host spoofing. [Bug 928154]
	    set hostHdr [dict get $state(-headers) Host]
	    regexp {^[^:]+} $hostHdr state(host)
	    puts $sock "Host: [dict get $state(-headers) Host]"
	    puts $sock "Host: $hostHdr"
	} elseif {$port == $defport} {
	    # Don't add port in this case, to handle broken servers. [Bug
	    # #504508]
	    set state(host) $host
	    puts $sock "Host: $host"
	} else {
	    set state(host) $host
	    puts $sock "Host: $host:$port"
	}
	puts $sock "User-Agent: $http(-useragent)"
        if {$state(-protocol) == 1.0 && $state(-keepalive)} {
	if {($state(-protocol) >= 1.0) && $state(-keepalive)} {
	    # Send this header, because a 1.1 server is not compelled to treat
	    # this as the default.
	    puts $sock "Connection: keep-alive"
        }
        if {$state(-protocol) > 1.0 && !$state(-keepalive)} {
	}
	if {($state(-protocol) > 1.0) && !$state(-keepalive)} {
	    puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
        }
        if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
	}
	if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
	    puts $sock "Proxy-Connection: Keep-Alive"
        }
        set accept_encoding_seen 0
	}
	set accept_encoding_seen 0
	set content_type_seen 0
	dict for {key value} $state(-headers) {
	    set value [string map [list \n "" \r ""] $value]
	    set key [string map {" " -} [string trim $key]]
	    if {[string equal -nocase $key "host"]} {
		continue
	    }
766
767
768
769
770
771
772

773



774
775
776


777
778
779
780
781
782
783
784
785
















786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804

805
806
807
808
809
810
811






812

813


814











815
816


817


818
819
820
821
822
823
824
825
826




























827
828
829
830








































































































































































































































































































































































































































































































































































































































































































831
832
833
834

835
836
837
838
839
840
841
1421
1422
1423
1424
1425
1426
1427
1428

1429
1430
1431
1432


1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492

1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512

1513
1514
1515
1516
1517






1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232

2233
2234
2235
2236
2237
2238
2239
2240







+
-
+
+
+

-
-
+
+









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



















+







+
+
+
+
+
+
-
+

+
+

+
+
+
+
+
+
+
+
+
+
+


+
+
-
+
+



-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+







	    }
	}
	# Allow overriding the Accept header on a per-connection basis. Useful
	# for working with REST services. [Bug c11a51c482]
	if {!$accept_types_seen} {
	    puts $sock "Accept: $state(accept-types)"
	}
	if {    (!$accept_encoding_seen)
        if {!$accept_encoding_seen && ![info exists state(-handler)]} {
	     && (![info exists state(-handler)])
	     && $http(-zip)
	} {
	    puts $sock "Accept-Encoding: gzip,deflate,compress"
        }
	if {$isQueryChannel && $state(querylength) == 0} {
	}
	if {$isQueryChannel && ($state(querylength) == 0)} {
	    # Try to determine size of data in channel. If we cannot seek, the
	    # surrounding catch will trap us

	    set start [tell $state(-querychannel)]
	    seek $state(-querychannel) 0 end
	    set state(querylength) \
		    [expr {[tell $state(-querychannel)] - $start}]
	    seek $state(-querychannel) $start
	}

	# Note that we don't do Cookie2; that's much nastier and not normally
	# observed in practice either. It also doesn't fix the multitude of
	# bugs in the basic cookie spec.
	if {$http(-cookiejar) ne ""} {
	    set cookies ""
	    set separator ""
	    foreach {key value} [{*}$http(-cookiejar) \
		    getCookies $proto $host $state(path)] {
		append cookies $separator $key = $value
		set separator "; "
	    }
	    if {$cookies ne ""} {
		puts $sock "Cookie: $cookies"
	    }
	}

	# Flush the request header and set up the fileevent that will either
	# push the POST data or read the response.
	#
	# fileevent note:
	#
	# It is possible to have both the read and write fileevents active at
	# this point. The only scenario it seems to affect is a server that
	# closes the connection without reading the POST data. (e.g., early
	# versions TclHttpd in various error cases). Depending on the
	# platform, the client may or may not be able to get the response from
	# the server because of the error it will get trying to write the post
	# data. Having both fileevents active changes the timing and the
	# behavior, but no two platforms (among Solaris, Linux, and NT) behave
	# the same, and none behave all that well in any case. Servers should
	# always read their POST data if they expect the client to read their
	# response.

	if {$isQuery || $isQueryChannel} {
	    # POST method.
	    if {!$content_type_seen} {
		puts $sock "Content-Type: $state(-type)"
	    }
	    if {!$contDone} {
		puts $sock "Content-Length: $state(querylength)"
	    }
	    puts $sock ""
	    flush $sock
	    # Flush flushes the error in the https case with a bad handshake:
	    # else the socket never becomes writable again, and hangs until
	    # timeout (if any).

	    lassign [fconfigure $sock -translation] trRead trWrite
	    fconfigure $sock -translation {auto binary}
	    fconfigure $sock -translation [list $trRead binary]
	    fileevent $sock writable [list http::Write $token]
	    # The http::Write command decides when to make the socket readable,
	    # using the same test as the GET/HEAD case below.
	} else {
	    # GET or HEAD method.
	    if {    (![catch {fileevent $sock readable} binding])
		 && ($binding eq [list http::CheckEof $sock])
	    } {
		# Remove the "fileevent readable" binding of an idle persistent
		# socket to http::CheckEof.  We can no longer treat bytes
		# received as junk. The server might still time out and
		# half-close the socket if it has not yet received the first
		# "puts".
		fileevent $sock readable {}
	    }
	    puts $sock ""
	    flush $sock
	    Log ^C$tk end sending request - token $token
	    # End of writing (GET/HEAD methods).  The request has been sent.
	    fileevent $sock readable [list http::Event $sock $token]

	    DoneRequest $token
	}

    } err]} {
	# The socket probably was never connected, or the connection dropped
	# later.

	# if state(status) is error, it means someone's already called Finish
	# to do the above-described clean up.
	if {$state(status) ne "error"} {
	# The socket probably was never connected, OR the connection dropped
	# later, OR https handshake error, which may be discovered as late as
	# the "flush" command above...
	Log "WARNING - if testing, pay special attention to this\
		case (GI) which is seldom executed - token $token"
	if {[info exists state(reusing)] && $state(reusing)} {
	    # The socket was closed at the server end, and closed at
	    # this end by http::CheckEof.
    	    if {[TestForReplay $token write $err a]} {
		return
	    } else {
		Finish $token {failed to re-use socket}
	    }

	    # else:
	    # This is NOT a persistent socket that has been closed since its
	    # last use.
	    # If any other requests are in flight or pipelined/queued, they will
	    # be discarded.
	} elseif {$state(status) eq ""} {
	    # ...https handshake errors come here.
	    set msg [registerError $sock]
	    registerError $sock {}
	    if {$msg eq {}} {
		set msg {failed to use socket}
	    }
	    Finish $token $msg
	} elseif {$state(status) ne "error"} {
	    Finish $token $err
	}
    }
}

# http::registerError
#
#	Called (for example when processing TclTLS activity) to register
#	an error for a connection on a specific socket.  This helps
#	http::Connected to deliver meaningful error messages, e.g. when a TLS
#	certificate fails verification.
#
#	Usage: http::registerError socket ?newValue?
#
#	"set" semantics, except that a "get" (a call without a new value) for a
#	non-existent socket returns {}, not an error.

proc http::registerError {sock args} {
    variable registeredErrors

    if {    ([llength $args] == 0)
	 && (![info exists registeredErrors($sock)])
    } {
	return
    } elseif {    ([llength $args] == 1)
	       && ([lindex $args 0] eq {})
    } {
	unset -nocomplain registeredErrors($sock)
	return
    }
    set registeredErrors($sock) {*}$args
}

# http::DoneRequest --
#
#	Command called when a request has been sent.  It will arrange the
#	next request and/or response as appropriate.
#
#	If this command is called when $socketClosing(*), the request $token
#	that calls it must be pipelined and destined to fail.

proc http::DoneRequest {token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    # If pipelined, connect the next HTTP request to the socket.
    if {$state(reusing) && $state(-pipeline)} {
	# Enable next token (if any) to write.
	# The value "Wready" is set only here, and
	# in http::Event after reading the response-headers of a
	# non-reusing transaction.
	# Previous value is $token. It cannot be pending.
	set socketWrState($state(socketinfo)) Wready

	# Now ready to write the next pipelined request (if any).
	http::NextPipelinedWrite $token
    } else {
	# If pipelined, this is the first transaction on this socket.  We wait
	# for the response headers to discover whether the connection is
	# persistent.  (If this is not done and the connection is not
	# persistent, we SHOULD retry and then MUST NOT pipeline before knowing
	# that we have a persistent connection
	# (rfc2616 8.1.2.2)).
    }

    # Connect to receive the response, unless the socket is pipelined
    # and another response is being sent.
    # This code block is separate from the code below because there are
    # cases where socketRdState already has the value $token.
    if {    $state(-keepalive)
	 && $state(-pipeline)
	 && [info exists socketRdState($state(socketinfo))]
	 && ($socketRdState($state(socketinfo)) eq "Rready")
    } {
	#Log pipelined, GRANT read access to $token in Connected
	set socketRdState($state(socketinfo)) $token
    }

    if {    $state(-keepalive)
	 && $state(-pipeline)
	 && [info exists socketRdState($state(socketinfo))]
	 && ($socketRdState($state(socketinfo)) ne $token)
    } {
	# Do not read from the socket until it is ready.
	##Log "HTTP response for token $token is queued for pipelined use"
	# If $socketClosing(*), then the caller will be a pipelined write and
	# execution will come here.
	# This token has already been recorded as "in flight" for writing.
	# When the socket is closed, the read queue will be cleared in
	# CloseQueuedQueries and so the "lappend" here has no effect.
	lappend socketRdQueue($state(socketinfo)) $token
    } else {
	# In the pipelined case, connection for reading depends on the
	# value of socketRdState.
	# In the nonpipeline case, connection for reading always occurs.
	ReceiveResponse $token
    }
}

# http::ReceiveResponse
#
#	Connects token to its socket for reading.

proc http::ReceiveResponse {token} {
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    #Log ---- $state(socketinfo) >> conn to $token for HTTP response
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list auto $trWrite] \
		     -buffersize $state(-blocksize)
    Log ^D$tk begin receiving response - token $token

    coroutine ${token}EventCoroutine http::Event $sock $token
    fileevent $sock readable ${token}EventCoroutine
}

# http::NextPipelinedWrite
#
# - Connecting a socket to a token for writing is done by this command and by
#   command KeepSocket.
# - If another request has a pipelined write scheduled for $token's socket,
#   and if the socket is ready to accept it, connect the write and update
#   the queue accordingly.
# - This command is called from http::DoneRequest and http::Event,
#   IF $state(-pipeline) AND (the current transfer has reached the point at
#   which the socket is ready for the next request to be written).
# - This command is called when a token has write access and is pipelined and
#   keep-alive, and sets socketWrState to Wready.
# - The command need not consider the case where socketWrState is set to a token
#   that does not yet have write access.  Such a token is waiting for Rready,
#   and the assignment of the connection to the token will be done elsewhere (in
#   http::KeepSocket).
# - This command cannot be called after socketWrState has been set to a
#   "pending" token value (that is then overwritten by the caller), because that
#   value is set by this command when it is called by an earlier token when it
#   relinquishes its write access, and the pending token is always the next in
#   line to write.

proc http::NextPipelinedWrite {token} {
    variable http
    variable socketRdState
    variable socketWrState
    variable socketWrQueue
    variable socketClosing
    variable $token
    upvar 0 $token state
    set connId $state(socketinfo)

    if {    [info exists socketClosing($connId)]
	 && $socketClosing($connId)
    } {
	# socketClosing(*) is set because the server has sent a
	# "Connection: close" header.
	# Behave as if the queues are empty - so do nothing.
    } elseif {    $state(-pipeline)
	 && [info exists socketWrState($connId)]
	 && ($socketWrState($connId) eq "Wready")

	 && [info exists socketWrQueue($connId)]
	 && [llength $socketWrQueue($connId)]
	 && ([set token2 [lindex $socketWrQueue($connId) 0]
	      set ${token2}(-pipeline)
	     ]
	    )
    } {
	# - The usual case for a pipelined connection, ready for a new request.
	#Log pipelined, GRANT write access to $token2 in NextPipelinedWrite
	set conn [set ${token2}(tmpConnArgs)]
	set socketWrState($connId) $token2
	set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	# Connect does its own fconfigure.
	fileevent $state(sock) writable [list http::Connect $token2 {*}$conn]
	#Log ---- $connId << conn to $token2 for HTTP request (b)

	# In the tests below, the next request will be nonpipeline.
    } elseif {    $state(-pipeline)
	       && [info exists socketWrState($connId)]
	       && ($socketWrState($connId) eq "Wready")

	       && [info exists socketWrQueue($connId)]
	       && [llength $socketWrQueue($connId)]
	       && (![ set token3 [lindex $socketWrQueue($connId) 0]
		      set ${token3}(-pipeline)
		    ]
		  )

	       && [info exists socketRdState($connId)]
	       && ($socketRdState($connId) eq "Rready")
    } {
	# The case in which the next request will be non-pipelined, and the read
	# and write queues is ready: which is the condition for a non-pipelined
	# write.
	variable $token3
	upvar 0 $token3 state3
	set conn [set ${token3}(tmpConnArgs)]
	#Log nonpipeline, GRANT r/w access to $token3 in NextPipelinedWrite
	set socketRdState($connId) $token3
	set socketWrState($connId) $token3
	set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	# Connect does its own fconfigure.
	fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	#Log ---- $state(sock) << conn to $token3 for HTTP request (c)

    } elseif {    $state(-pipeline)
	 && [info exists socketWrState($connId)]
	 && ($socketWrState($connId) eq "Wready")

	 && [info exists socketWrQueue($connId)]
	 && [llength $socketWrQueue($connId)]
	 && (![set token2 [lindex $socketWrQueue($connId) 0]
	      set ${token2}(-pipeline)
	     ]
	    )
    } {
	# - The case in which the next request will be non-pipelined, but the
	#   read queue is NOT ready.
	# - A read is queued or in progress, but not a write.  Cannot start the
	#   nonpipeline transaction, but must set socketWrState to prevent a new
	#   pipelined request (in http::geturl) jumping the queue.
	# - Because socketWrState($connId) is not set to Wready, the assignment
	#   of the connection to $token2 will be done elsewhere - by command
	#   http::KeepSocket when $socketRdState($connId) is set to "Rready".

	#Log re-use nonpipeline, GRANT delayed write access to $token in NextP..
	set socketWrState($connId) peNding
    }
}

# http::CancelReadPipeline
#
#	Cancel pipelined responses on a closing "Keep-Alive" socket.
#
#	- Called by a variable trace on "unset socketRdState($connId)".
#	- The variable relates to a Keep-Alive socket, which has been closed.
#	- Cancels all pipelined responses. The requests have been sent,
#	  the responses have not yet been received.
#	- This is a hard cancel that ends each transaction with error status,
#	  and closes the connection. Do not use it if you want to replay failed
#	  transactions.
#	- N.B. Always delete ::http::socketRdState($connId) before deleting
#	  ::http::socketRdQueue($connId), or this command will do nothing.
#
# Arguments
#	As for a trace command on a variable.

proc http::CancelReadPipeline {name1 connId op} {
    variable socketRdQueue
    ##Log CancelReadPipeline $name1 $connId $op
    if {[info exists socketRdQueue($connId)]} {
	set msg {the connection was closed by CancelReadPipeline}
	foreach token $socketRdQueue($connId) {
	    set tk [namespace tail $token]
	    Log ^X$tk end of response "($msg)" - token $token
	    set ${token}(status) eof
	    Finish $token ;#$msg
	}
	set socketRdQueue($connId) {}
    }
}

# http::CancelWritePipeline
#
#	Cancel queued events on a closing "Keep-Alive" socket.
#
#	- Called by a variable trace on "unset socketWrState($connId)".
#	- The variable relates to a Keep-Alive socket, which has been closed.
#	- In pipelined or nonpipeline case: cancels all queued requests.  The
#	  requests have not yet been sent, the responses are not due.
#	- This is a hard cancel that ends each transaction with error status,
#	  and closes the connection. Do not use it if you want to replay failed
#	  transactions.
#	- N.B. Always delete ::http::socketWrState($connId) before deleting
#	  ::http::socketWrQueue($connId), or this command will do nothing.
#
# Arguments
#	As for a trace command on a variable.

proc http::CancelWritePipeline {name1 connId op} {
    variable socketWrQueue

    ##Log CancelWritePipeline $name1 $connId $op
    if {[info exists socketWrQueue($connId)]} {
	set msg {the connection was closed by CancelWritePipeline}
	foreach token $socketWrQueue($connId) {
	    set tk [namespace tail $token]
	    Log ^X$tk end of response "($msg)" - token $token
	    set ${token}(status) eof
	    Finish $token ;#$msg
	}
	set socketWrQueue($connId) {}
    }
}

# http::ReplayIfDead --
#
# - A query on a re-used persistent socket failed at the earliest opportunity,
#   because the socket had been closed by the server.  Keep the token, tidy up,
#   and try to connect on a fresh socket.
# - The connection is monitored for eof by the command http::CheckEof.  Thus
#   http::ReplayIfDead is needed only when a server event (half-closing an
#   apparently idle connection), and a client event (sending a request) occur at
#   almost the same time, and neither client nor server detects the other's
#   action before performing its own (an "asynchronous close event").
# - To simplify testing of http::ReplayIfDead, set TEST_EOF 1 in
#   http::KeepSocket, and then http::ReplayIfDead will be called if http::geturl
#   is called at any time after the server timeout.
#
# Arguments:
#	token	Connection token.
#
# Side Effects:
#	Use the same token, but try to open a new socket.

proc http::ReplayIfDead {tokenArg doing} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $tokenArg
    upvar 0 $tokenArg stateArg

    Log running http::ReplayIfDead for $tokenArg $doing

    # 1. Merge the tokens for transactions in flight, the read (response) queue,
    #    and the write (request) queue.

    set InFlightR {}
    set InFlightW {}

    # Obtain the tokens for transactions in flight.
    if {$stateArg(-pipeline)} {
	# Two transactions may be in flight.  The "read" transaction was first.
	# It is unlikely that the server would close the socket if a response
	# was pending; however, an earlier request (as well as the present
	# request) may have been sent and ignored if the socket was half-closed
	# by the server.

	if {    [info exists socketRdState($stateArg(socketinfo))]
	     && ($socketRdState($stateArg(socketinfo)) ne "Rready")
	} {
	    lappend InFlightR $socketRdState($stateArg(socketinfo))
	} elseif {($doing eq "read")} {
	    lappend InFlightR $tokenArg
	}

	if {    [info exists socketWrState($stateArg(socketinfo))]
	     && $socketWrState($stateArg(socketinfo)) ni {Wready peNding}
	} {
	    lappend InFlightW $socketWrState($stateArg(socketinfo))
	} elseif {($doing eq "write")} {
	    lappend InFlightW $tokenArg
	}

	# Report any inconsistency of $tokenArg with socket*state.
	if {    ($doing eq "read")
	     && [info exists socketRdState($stateArg(socketinfo))]
	     && ($tokenArg ne $socketRdState($stateArg(socketinfo)))
	} {
	    Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \
		    ne socketRdState($stateArg(socketinfo)) \
		      $socketRdState($stateArg(socketinfo))

	} elseif {
		($doing eq "write")
	     && [info exists socketWrState($stateArg(socketinfo))]
	     && ($tokenArg ne $socketWrState($stateArg(socketinfo)))
	} {
	    Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \
		    ne socketWrState($stateArg(socketinfo)) \
		      $socketWrState($stateArg(socketinfo))
	}
    } else {
	# One transaction should be in flight.
	# socketRdState, socketWrQueue are used.
	# socketRdQueue should be empty.

	# Report any inconsistency of $tokenArg with socket*state.
	if {$tokenArg ne $socketRdState($stateArg(socketinfo))} {
	    Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \
		    ne socketRdState($stateArg(socketinfo)) \
		      $socketRdState($stateArg(socketinfo))
	}

	# Report the inconsistency that socketRdQueue is non-empty.
	if {    [info exists socketRdQueue($stateArg(socketinfo))]
	     && ($socketRdQueue($stateArg(socketinfo)) ne {})
	} {
	    Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \
		    has read queue socketRdQueue($stateArg(socketinfo)) \
		    $socketRdQueue($stateArg(socketinfo)) ne {}
	}

	lappend InFlightW $socketRdState($stateArg(socketinfo))
	set socketRdQueue($stateArg(socketinfo)) {}
    }

    set newQueue {}
    lappend newQueue {*}$InFlightR
    lappend newQueue {*}$socketRdQueue($stateArg(socketinfo))
    lappend newQueue {*}$InFlightW
    lappend newQueue {*}$socketWrQueue($stateArg(socketinfo))


    # 2. Tidy up tokenArg.  This is a cut-down form of Finish/CloseSocket.
    #    Do not change state(status).
    #    No need to after cancel stateArg(after) - either this is done in
    #    ReplayCore/ReInit, or Finish is called.

    catch {close $stateArg(sock)}

    # 2a. Tidy the tokens in the queues - this is done in ReplayCore/ReInit.
    # - Transactions, if any, that are awaiting responses cannot be completed.
    #   They are listed for re-sending in newQueue.
    # - All tokens are preserved for re-use by ReplayCore, and their variables
    #   will be re-initialised by calls to ReInit.
    # - The relevant element of socketMapping, socketRdState, socketWrState,
    #   socketRdQueue, socketWrQueue, socketClosing, socketPlayCmd will be set
    #   to new values in ReplayCore.

    ReplayCore $newQueue
}

# http::ReplayIfClose --
#
#	A request on a socket that was previously "Connection: keep-alive" has
#	received a "Connection: close" response header.  The server supplies
#	that response correctly, but any later requests already queued on this
#	connection will be lost when the socket closes.
#
#	This command takes arguments that represent the socketWrState,
#	socketRdQueue and socketWrQueue for this connection.  The socketRdState
#	is not needed because the server responds in full to the request that
#	received the "Connection: close" response header.
#
#	Existing request tokens $token (::http::$n) are preserved.  The caller
#	will be unaware that the request was processed this way.

proc http::ReplayIfClose {Wstate Rqueue Wqueue} {
    Log running http::ReplayIfClose for $Wstate $Rqueue $Wqueue

    if {$Wstate in $Rqueue || $Wstate in $Wqueue} {
	Log WARNING duplicate token in http::ReplayIfClose - token $Wstate
	set Wstate Wready
    }

    # 1. Create newQueue
    set InFlightW {}
    if {$Wstate ni {Wready peNding}} {
	lappend InFlightW $Wstate
    }

    set newQueue {}
    lappend newQueue {*}$Rqueue
    lappend newQueue {*}$InFlightW
    lappend newQueue {*}$Wqueue

    # 2. Cleanup - none needed, done by the caller.

    ReplayCore $newQueue
}

# http::ReInit --
#
#	Command to restore a token's state to a condition that
#	makes it ready to replay a request.
#
#	Command http::geturl stores extra state in state(tmp*) so
#	we don't need to do the argument processing again.
#
#	The caller must:
#	- Set state(reusing) and state(sock) to their new values after calling
#	  this command.
#	- Unset state(tmpState), state(tmpOpenCmd) if future calls to ReplayCore
#	  or ReInit are inappropriate for this token. Typically only one retry
#	  is allowed.
#	The caller may also unset state(tmpConnArgs) if this value (and the
#	token) will be used immediately.  The value is needed by tokens that
#	will be stored in a queue.
#
# Arguments:
#	token	Connection token.
#
# Return Value: (boolean) true iff the re-initialisation was successful.

proc http::ReInit {token} {
    variable $token
    upvar 0 $token state

    if {!(
	      [info exists state(tmpState)]
	   && [info exists state(tmpOpenCmd)]
	   && [info exists state(tmpConnArgs)]
	 )
    } {
	Log FAILED in http::ReInit via ReplayCore - NO tmp vars for $token
	return 0
    }

    if {[info exists state(after)]} {
	after cancel $state(after)
	unset state(after)
    }

    # Don't alter state(status) - this would trigger http::wait if it is in use.
    set tmpState    $state(tmpState)
    set tmpOpenCmd  $state(tmpOpenCmd)
    set tmpConnArgs $state(tmpConnArgs)
    foreach name [array names state] {
	if {$name ne "status"} {
	    unset state($name)
	}
    }

    # Don't alter state(status).
    # Restore state(tmp*) - the caller may decide to unset them.
    # Restore state(tmpConnArgs) which is needed for connection.
    # state(tmpState), state(tmpOpenCmd) are needed only for retries.

    dict unset tmpState status
    array set state $tmpState
    set state(tmpState)    $tmpState
    set state(tmpOpenCmd)  $tmpOpenCmd
    set state(tmpConnArgs) $tmpConnArgs

    return 1
}

# http::ReplayCore --
#
#	Command to replay a list of requests, using existing connection tokens.
#
#	Abstracted from http::geturl which stores extra state in state(tmp*) so
#	we don't need to do the argument processing again.
#
# Arguments:
#	newQueue	List of connection tokens.
#
# Side Effects:
#	Use existing tokens, but try to open a new socket.

proc http::ReplayCore {newQueue} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    if {[llength $newQueue] == 0} {
	# Nothing to do.
	return
    }

    ##Log running ReplayCore for {*}$newQueue
    set newToken [lindex $newQueue 0]
    set newQueue [lrange $newQueue 1 end]

    # 3. Use newToken, and restore its values of state(*).  Do not restore
    #    elements tmp* - we try again only once.

    set token $newToken
    variable $token
    upvar 0 $token state

    if {![ReInit $token]} {
	Log FAILED in http::ReplayCore - NO tmp vars
	Finish $token {cannot send this request again}
	return
    }

    set tmpState    $state(tmpState)
    set tmpOpenCmd  $state(tmpOpenCmd)
    set tmpConnArgs $state(tmpConnArgs)
    unset state(tmpState)
    unset state(tmpOpenCmd)
    unset state(tmpConnArgs)

    set state(reusing) 0

    if {$state(-timeout) > 0} {
	set resetCmd [list http::reset $token timeout]
	set state(after) [after $state(-timeout) $resetCmd]
    }

    set pre [clock milliseconds]
    ##Log pre socket opened, - token $token
    ##Log $tmpOpenCmd - token $token
    # 4. Open a socket.
    if {[catch {eval $tmpOpenCmd} sock]} {
	# Something went wrong while trying to establish the connection.
	Log FAILED - $sock
	set state(sock) NONE
	Finish $token $sock
	return
    }
    ##Log post socket opened, - token $token
    set delay [expr {[clock milliseconds] - $pre}]
    if {$delay > 3000} {
	Log socket delay $delay - token $token
    }
    # Command [socket] is called with -async, but takes 5s to 5.1s to return,
    # with probability of order 1 in 10,000.  This may be a bizarre scheduling
    # issue with my (KJN's) system (Fedora Linux).
    # This does not cause a problem (unless the request times out when this
    # command returns).

    # 5. Configure the persistent socket data.
    if {$state(-keepalive)} {
	set socketMapping($state(socketinfo)) $sock

	if {![info exists socketRdState($state(socketinfo))]} {
	    set socketRdState($state(socketinfo)) {}
	    set varName ::http::socketRdState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelReadPipeline
	}

	if {![info exists socketWrState($state(socketinfo))]} {
	    set socketWrState($state(socketinfo)) {}
	    set varName ::http::socketWrState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelWritePipeline
	}

	if {$state(-pipeline)} {
	    #Log new, init for pipelined, GRANT write acc to $token ReplayCore
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	} else {
	    #Log new, init for nonpipeline, GRANT r/w acc to $token ReplayCore
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	}

	set socketRdQueue($state(socketinfo)) {}
	set socketWrQueue($state(socketinfo)) $newQueue
	set socketClosing($state(socketinfo)) 0
	set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
    }

    ##Log pre newQueue ReInit, - token $token
    # 6. Configure sockets in the queue.
    foreach tok $newQueue {
	if {[ReInit $tok]} {
	    set ${tok}(reusing) 1
	    set ${tok}(sock) $sock
	} else {
	    set ${tok}(reusing) 1
	    set ${tok}(sock) NONE
	    Finish $token {cannot send this request again}
	}
    }

    # 7. Configure the socket for newToken to send a request.
    set state(sock) $sock
    Log "Using $sock for $state(socketinfo) - token $token" \
	[expr {$state(-keepalive)?"keepalive":""}]

    # Initialisation of a new socket.
    ##Log socket opened, now fconfigure - token $token
    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
    ##Log socket opened, DONE fconfigure - token $token

    # Connect does its own fconfigure.
    fileevent $sock writable [list http::Connect $token {*}$tmpConnArgs]
    #Log ---- $sock << conn to $token for HTTP request (e)
}

# Data access functions:
# Data - the URL data
# Status - the transaction status: ok, reset, eof, timeout
# Status - the transaction status: ok, reset, eof, timeout, error
# Code - the HTTP transaction code, e.g., 200
# Size - the size of the URL data

proc http::data {token} {
    variable $token
    upvar 0 $token state
    return $state(body)
890
891
892
893
894
895
896







897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915

916
917
918
919
920















921
922

923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939









940
941

942
943
944
945
946
947
948
949
950
951













952


953
954
955
956
957
958
959
960
961
962
963
964













965
966
967
968
969
970
971
972
973
974
975
976
977

978
979
980


981


982
983
984
985
986
987
988
989
990
991
992
993
994



995
996
997
998
999
1000
1001
1002
1003









1004
1005




1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032

























































































































































1033
1034

1035
1036
1037
1038
1039
1040







1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055





























1056
1057
1058



1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120












































































1121
1122
1123
1124
1125














1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136











































1137
1138
1139


1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182



































































































1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193


















































































1194
1195
1196
1197
1198
1199
1200
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348

2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396

2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442

2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456

2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484


























2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638

2639
2640





2641
2642
2643
2644
2645
2646
2647
2648














2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678


2679
2680
2681
2682





























































2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758





2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772











2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815



2816
2817











































2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917










2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006







+
+
+
+
+
+
+



















+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+



-













+
+
+
+
+
+
+
+
+


+










+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+












+
+
+
+
+
+
+
+
+
+
+
+
+













+



+
+
-
+
+












-
+
+
+









+
+
+
+
+
+
+
+
+


+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







#
# Side Effects
#	unsets the state array

proc http::cleanup {token} {
    variable $token
    upvar 0 $token state
    if {[info commands ${token}EventCoroutine] ne {}} {
	rename ${token}EventCoroutine {}
    }
    if {[info exists state(after)]} {
	after cancel $state(after)
	unset state(after)
    }
    if {[info exists state]} {
	unset state
    }
}

# http::Connect
#
#	This callback is made when an asyncronous connection completes.
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Sets the status of the connection, which unblocks
# 	the waiting geturl call

proc http::Connect {token proto phost srvurl} {
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set err "due to unexpected EOF"
    if {
	[eof $state(sock)] ||
	[set err [fconfigure $state(sock) -error]] ne ""
    } {
	Log "WARNING - if testing, pay special attention to this\
		case (GJ) which is seldom executed - token $token"
	if {[info exists state(reusing)] && $state(reusing)} {
	    # The socket was closed at the server end, and closed at
	    # this end by http::CheckEof.
	    if {[TestForReplay $token write $err b]} {
		return
	    }

	    # else:
	    # This is NOT a persistent socket that has been closed since its
	    # last use.
	    # If any other requests are in flight or pipelined/queued, they will
	    # be discarded.
	}
	Finish $token "connect failed $err"
    } else {
	set state(state) connecting
	fileevent $state(sock) writable {}
	::http::Connected $token $proto $phost $srvurl
    }
    return
}

# http::Write
#
#	Write POST query data to the socket
#
# Arguments
#	token	The token for the connection
#
# Side Effects
#	Write the socket and handle callbacks.

proc http::Write {token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    # Output a block.  Tcl will buffer this if the socket blocks
    set done 0
    if {[catch {
	# Catch I/O errors on dead sockets

	if {[info exists state(-query)]} {
	    # Chop up large query strings so queryprogress callback can give
	    # smooth feedback.
	    if {    $state(queryoffset) + $state(-queryblocksize)
		 >= $state(querylength)
	    } {
		# This will be the last puts for the request-body.
		if {    (![catch {fileevent $sock readable} binding])
		     && ($binding eq [list http::CheckEof $sock])
		} {
		    # Remove the "fileevent readable" binding of an idle
		    # persistent socket to http::CheckEof.  We can no longer
		    # treat bytes received as junk. The server might still time
		    # out and half-close the socket if it has not yet received
		    # the first "puts".
		    fileevent $sock readable {}

		}
	    }
	    puts -nonewline $sock \
		[string range $state(-query) $state(queryoffset) \
		     [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
	    incr state(queryoffset) $state(-queryblocksize)
	    if {$state(queryoffset) >= $state(querylength)} {
		set state(queryoffset) $state(querylength)
		set done 1
	    }
	} else {
	    # Copy blocks from the query channel

	    set outStr [read $state(-querychannel) $state(-queryblocksize)]
	    if {[eof $state(-querychannel)]} {
		# This will be the last puts for the request-body.
		if {    (![catch {fileevent $sock readable} binding])
		     && ($binding eq [list http::CheckEof $sock])
		} {
		    # Remove the "fileevent readable" binding of an idle
		    # persistent socket to http::CheckEof.  We can no longer
		    # treat bytes received as junk. The server might still time
		    # out and half-close the socket if it has not yet received
		    # the first "puts".
		    fileevent $sock readable {}
		}
	    }
	    puts -nonewline $sock $outStr
	    incr state(queryoffset) [string length $outStr]
	    if {[eof $state(-querychannel)]} {
		set done 1
	    }
	}
    } err]} {
	# Do not call Finish here, but instead let the read half of the socket
	# process whatever server reply there is to get.

	set state(posterror) $err
	set done 1
    }

    if {$done} {
	catch {flush $sock}
	fileevent $sock writable {}
	Log ^C$tk end sending request - token $token
	# End of writing (POST method).  The request has been sent.
	fileevent $sock readable [list http::Event $sock $token]

	DoneRequest $token
    }

    # Callback to the client after we've completely handled everything.

    if {[string length $state(-queryprogress)]} {
	eval $state(-queryprogress) \
	    [list $token $state(querylength) $state(queryoffset)]
    }
}

# http::Event
#
#	Handle input on the socket
#	Handle input on the socket. This command is the core of
#	the coroutine commands ${token}EventCoroutine that are
#	bound to "fileevent $sock readable" and process input.
#
# Arguments
#	sock	The socket receiving input.
#	token	The token returned from http::geturl
#
# Side Effects
#	Read the socket and handle callbacks.

proc http::Event {sock token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    while 1 {
	yield
	##Log Event call - token $token

    if {![info exists state]} {
	Log "Event $sock with invalid token '$token' - remote close?"
	if {![eof $sock]} {
	    if {[set d [read $sock]] ne ""} {
		Log "WARNING: additional data left on closed socket"
	    }
	}
	CloseSocket $sock
	return
    }
    if {$state(state) eq "connecting"} {
	if {[catch {gets $sock state(http)} n]} {
	    return [Finish $token $n]
	} elseif {$n >= 0} {
	    set state(state) "header"
	}
    } elseif {$state(state) eq "header"} {
	if {[catch {gets $sock line} n]} {
	    return [Finish $token $n]
	} elseif {$n == 0} {
	    # We have now read all headers
	    # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
	    if {$state(http) == "" || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)} {
		set state(state) "connecting"
		return
	    }
	if {![info exists state]} {
	    Log "Event $sock with invalid token '$token' - remote close?"
	    if {![eof $sock]} {
		if {[set d [read $sock]] ne ""} {
		    Log "WARNING: additional data left on closed socket\
			    - token $token"
		}
	    }
	    Log ^X$tk end of response (token error) - token $token
	    CloseSocket $sock
	    return
	}
	if {$state(state) eq "connecting"} {
	    ##Log - connecting - token $token
	    if {    $state(reusing)
		 && $state(-pipeline)
		 && ($state(-timeout) > 0)
		 && (![info exists state(after)])
	    } {
		set state(after) [after $state(-timeout) \
			[list http::reset $token timeout]]
	    }

	    if {[catch {gets $sock state(http)} nsl]} {
		Log "WARNING - if testing, pay special attention to this\
			case (GK) which is seldom executed - token $token"
		if {[info exists state(reusing)] && $state(reusing)} {
		    # The socket was closed at the server end, and closed at
		    # this end by http::CheckEof.

		    if {[TestForReplay $token read $nsl c]} {
			return
		    }

		    # else:
		    # This is NOT a persistent socket that has been closed since
		    # its last use.
		    # If any other requests are in flight or pipelined/queued,
		    # they will be discarded.
		} else {
		    Log ^X$tk end of response (error) - token $token
		    Finish $token $nsl
		    return
		}
	    } elseif {$nsl >= 0} {
		##Log - connecting 1 - token $token
		set state(state) "header"
	    } elseif {    [eof $sock]
		       && [info exists state(reusing)]
		       && $state(reusing)
	    } {
		# The socket was closed at the server end, and we didn't notice.
		# This is the first read - where the closure is usually first
		# detected.

		if {[TestForReplay $token read {} d]} {
		    return
		}

		# else:
		# This is NOT a persistent socket that has been closed since its
		# last use.
		# If any other requests are in flight or pipelined/queued, they
		# will be discarded.
	    }
	} elseif {$state(state) eq "header"} {
	    if {[catch {gets $sock line} nhl]} {
		##Log header failed - token $token
		Log ^X$tk end of response (error) - token $token
		Finish $token $nhl
		return
	    } elseif {$nhl == 0} {
		##Log header done - token $token
		Log ^E$tk end of response headers - token $token
		# We have now read all headers
		# We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
		if {    ($state(http) == "")
		     || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)
		} {
		    set state(state) "connecting"
		    continue
		    # This was a "return" in the pre-coroutine code.
		}

		if {    ([info exists state(connection)])
		     && ([info exists socketMapping($state(socketinfo))])
		     && ($state(connection) eq "keep-alive")
		     && ($state(-keepalive))
		     && (!$state(reusing))
		     && ($state(-pipeline))
		} {
		    # Response headers received for first request on a
		    # persistent socket.  Now ready for pipelined writes (if
		    # any).
		    # Previous value is $token. It cannot be "pending".
		    set socketWrState($state(socketinfo)) Wready
		    http::NextPipelinedWrite $token
		}

		# Once a "close" has been signaled, the client MUST NOT send any
		# more requests on that connection.
		#
		# If either the client or the server sends the "close" token in
		# the Connection header, that request becomes the last one for
		# the connection.

		if {    ([info exists state(connection)])
		     && ([info exists socketMapping($state(socketinfo))])
		     && ($state(connection) eq "close")
		     && ($state(-keepalive))
		} {
		    # The server warns that it will close the socket after this
		    # response.
		    ##Log WARNING - socket will close after response for $token
		    # Prepare data for a call to ReplayIfClose.
		    if {    ($socketRdQueue($state(socketinfo)) ne {})
			 || ($socketWrQueue($state(socketinfo)) ne {})
			 || ($socketWrState($state(socketinfo)) ni
						[list Wready peNding $token])
		    } {
			set InFlightW $socketWrState($state(socketinfo))
			if {$InFlightW in [list Wready peNding $token]} {
			    set InFlightW Wready
			} else {
			    set msg "token ${InFlightW} is InFlightW"
			    ##Log $msg - token $token
			}

			set socketPlayCmd($state(socketinfo)) \
				[list ReplayIfClose $InFlightW \
				$socketRdQueue($state(socketinfo)) \
				$socketWrQueue($state(socketinfo))]

			# - All tokens are preserved for re-use by ReplayCore.
			# - Queues are preserved in case of Finish with error,
			#   but are not used for anything else because
			#   socketClosing(*) is set below.
			# - Cancel the state(after) timeout events.
			foreach tokenVal $socketRdQueue($state(socketinfo)) {
			    if {[info exists ${tokenVal}(after)]} {
				after cancel [set ${tokenVal}(after)]
				unset ${tokenVal}(after)
			    }
			}

		    } else {
			set socketPlayCmd($state(socketinfo)) \
				{ReplayIfClose Wready {} {}}
		    }

		    # Do not allow further connections on this socket.
		    set socketClosing($state(socketinfo)) 1
		}

	    set state(state) body
		set state(state) body

	    # If doing a HEAD, then we won't get any body
	    if {$state(-validate)} {
		Eof $token
		return
	    }
		# If doing a HEAD, then we won't get any body
		if {$state(-validate)} {
		    Log ^F$tk end of response for HEAD request - token $token
		    set state(state) complete
		    Eot $token
		    return
		}

	    # For non-chunked transfer we may have no body - in this case we
	    # may get no further file event if the connection doesn't close
	    # and no more data is sent. We can tell and must finish up now -
	    # not later.
	    if {
		!(([info exists state(connection)]
			&& ($state(connection) eq "close"))
		    || [info exists state(transfer)])
		&& ($state(totalsize) == 0)
	    } {
		Log "body size is 0 and no events likely - complete."
		Eof $token
		return
	    }
		# - For non-chunked transfer we may have no body - in this case
		#   we may get no further file event if the connection doesn't
		#   close and no more data is sent. We can tell and must finish
		#   up now - not later - the alternative would be to wait until
		#   the server times out.
		# - In this case, the server has NOT told the client it will
		#   close the connection, AND it has NOT indicated the resource
		#   length EITHER by setting the Content-Length (totalsize) OR
		#   by using chunked Transfer-Encoding.
		# - Do not worry here about the case (Connection: close) because
		#   the server should close the connection.
		# - IF (NOT Connection: close) AND (NOT chunked encoding) AND
		#      (totalsize == 0).

		if {    (!(    [info exists state(connection)]
			    && ($state(connection) eq "close")
			  )
			)
		     && (![info exists state(transfer)])
		     && ($state(totalsize) == 0)
		} {
		    set msg {body size is 0 and no events likely - complete}
		    Log "$msg - token $token"
		    set msg {(length unknown, set to 0)}
		    Log ^F$tk end of response body {*}$msg - token $token
		    set state(state) complete
		    Eot $token
		    return
		}

	    # We have to use binary translation to count bytes properly.
	    fconfigure $sock -translation binary
		# We have to use binary translation to count bytes properly.
		lassign [fconfigure $sock -translation] trRead trWrite
		fconfigure $sock -translation [list binary $trWrite]

	    if {
		$state(-binary) || [IsBinaryContentType $state(type)]
	    } {
		# Turn off conversions for non-text data
		set state(binary) 1
	    }
	    if {[info exists state(-channel)]} {
		if {$state(binary) || [llength [ContentEncoding $token]]} {
		    fconfigure $state(-channel) -translation binary
		}
		if {![info exists state(-handler)]} {
		    # Initiate a sequence of background fcopies
		    fileevent $sock readable {}
		    CopyStart $sock $token
		    return
		}
	    }
	} elseif {$n > 0} {
	    # Process header lines
	    if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
		switch -- [string tolower $key] {
		    content-type {
			set state(type) [string trim [string tolower $value]]
			# grab the optional charset information
			if {[regexp -nocase \
				 {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
				 $state(type) -> cs]} {
			    set state(charset) [string map {{\"} \"} $cs]
			} else {
			    regexp -nocase {charset\s*=\s*(\S+?);?} \
				$state(type) -> state(charset)
			}
		    }
		    content-length {
			set state(totalsize) [string trim $value]
		    }
		    content-encoding {
			set state(coding) [string trim $value]
		    }
		    transfer-encoding {
			set state(transfer) \
			    [string trim [string tolower $value]]
		    }
		    proxy-connection -
		    connection {
			set state(connection) \
			    [string trim [string tolower $value]]
		    }
		}
		lappend state(meta) $key [string trim $value]
	    }
	}
    } else {
	# Now reading body
	if {[catch {
	    if {[info exists state(-handler)]} {
		set n [eval $state(-handler) [list $sock $token]]
	    } elseif {[info exists state(transfer_final)]} {
		set line [getTextLine $sock]
		set n [string length $line]
		if {$n > 0} {
		if {
		    $state(-binary) || [IsBinaryContentType $state(type)]
		} {
		    # Turn off conversions for non-text data.
		    set state(binary) 1
		}
		if {[info exists state(-channel)]} {
		    if {$state(binary) || [llength [ContentEncoding $token]]} {
			fconfigure $state(-channel) -translation binary
		    }
		    if {![info exists state(-handler)]} {
			# Initiate a sequence of background fcopies.
			fileevent $sock readable {}
			rename ${token}EventCoroutine {}
			CopyStart $sock $token
			return
		    }
		}
	    } elseif {$nhl > 0} {
		# Process header lines.
		##Log header - token $token - $line
		if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
		    switch -- [string tolower $key] {
			content-type {
			    set state(type) [string trim [string tolower $value]]
			    # Grab the optional charset information.
			    if {[regexp -nocase \
				    {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
				    $state(type) -> cs]} {
				set state(charset) [string map {{\"} \"} $cs]
			    } else {
				regexp -nocase {charset\s*=\s*(\S+?);?} \
					$state(type) -> state(charset)
			    }
			}
			content-length {
			    set state(totalsize) [string trim $value]
			}
			content-encoding {
			    set state(coding) [string trim $value]
			}
			transfer-encoding {
			    set state(transfer) \
				    [string trim [string tolower $value]]
			}
			proxy-connection -
			connection {
			    set state(connection) \
				    [string trim [string tolower $value]]
			}
			set-cookie {
			    if {$http(-cookiejar) ne ""} {
				ParseCookie $token [string trim $value]
			    }
			}
		    }
		    lappend state(meta) $key [string trim $value]
		}
	    }
	} else {
	    # Now reading body
	    ##Log body - token $token
	    if {[catch {
		if {[info exists state(-handler)]} {
		    set n [eval $state(-handler) [list $sock $token]]
		    ##Log handler $n - token $token
		    # N.B. the protocol has been set to 1.0 because the -handler
		    # logic is not expected to handle chunked encoding.
		    # FIXME Allow -handler with 1.1 on dechunked stacked chan.
		    if {$state(totalsize) == 0} {
			# We know the transfer is complete only when the server
			# closes the connection - i.e. eof is not an error.
			set state(state) complete
		    }
		    if {![string is integer -strict $n]} {
			if 1 {
		    Log "found $n bytes following final chunk"
		    append state(transfer_final) $line
		} else {
		    Log "final chunk part"
		    Eof $token
			    # Do not tolerate bad -handler - fail with error
			    # status.
			    set msg {the -handler command for http::geturl must\
				    return an integer (the number of bytes\
				    read)}
			    Log ^X$tk end of response (handler error) -\
				    token $token
			    Eot $token $msg
			} else {
			    # Tolerate the bad -handler, and continue.  The
			    # penalty:
			    # (a) Because the handler returns nonsense, we know
			    #     the transfer is complete only when the server
			    #     closes the connection - i.e. eof is not an
		}
	    } elseif {
		[info exists state(transfer)]
		&& $state(transfer) eq "chunked"
	    } {
		set size 0
		set chunk [getTextLine $sock]
		set n [string length $chunk]
		if {[string trim $chunk] ne ""} {
		    scan $chunk %x size
		    if {$size != 0} {
			    #     error.
			    # (b) http::size will not be accurate.
			    # (c) The transaction is already downgraded to 1.0
			    #     to avoid chunked transfer encoding.  It MUST
			    #     also be forced to "Connection: close" or the
			    #     HTTP/1.0 equivalent; or it MUST fail (as
			    #     above) if the server sends
			    #     "Connection: keep-alive" or the HTTP/1.0
			    #     equivalent.
			    set n 0
			    set state(state) complete
			}
		    }
		} elseif {[info exists state(transfer_final)]} {
		    # This code forgives EOF in place of the final CRLF.
		    set line [getTextLine $sock]
		    set n [string length $line]
		    set state(state) complete
		    if {$n > 0} {
			# - HTTP trailers (late response headers) are permitted
			#   by Chunked Transfer-Encoding, and can be safely
			#   ignored.
			# - Do not count these bytes in the total received for
			#   the response body.
			Log "trailer of $n bytes after final chunk -\
				token $token"
			append state(transfer_final) $line
			set n 0
		    } else {
			Log ^F$tk end of response body (chunked) - token $token
			Log "final chunk part - token $token"
			Eot $token
		    }
		} elseif {    [info exists state(transfer)]
			   && ($state(transfer) eq "chunked")
		} {
		    ##Log chunked - token $token
		    set size 0
		    set hexLenChunk [getTextLine $sock]
		    #set ntl [string length $hexLenChunk]
		    if {[string trim $hexLenChunk] ne ""} {
			scan $hexLenChunk %x size
			if {$size != 0} {
			set bl [fconfigure $sock -blocking]
			fconfigure $sock -blocking 1
			set chunk [read $sock $size]
			    ##Log chunk-measure $size - token $token
			    set chunk [BlockingRead $sock $size]
			fconfigure $sock -blocking $bl
			set n [string length $chunk]
			if {$n >= 0} {
			    append state(body) $chunk
			}
			if {$size != [string length $chunk]} {
			    Log "WARNING: mis-sized chunk:\
				was [string length $chunk], should be $size"
			}
			getTextLine $sock
		    } else {
			set state(transfer_final) {}
		    }
		}
	    } else {
		#Log "read non-chunk $state(currentsize) of $state(totalsize)"
		set block [read $sock $state(-blocksize)]
		set n [string length $block]
		if {$n >= 0} {
		    append state(body) $block
		}
	    }
	    if {[info exists state]} {
		if {$n >= 0} {
		    incr state(currentsize) $n
		}
		# If Content-Length - check for end of data.
		if {
		    ($state(totalsize) > 0)
		    && ($state(currentsize) >= $state(totalsize))
		} {
		    Eof $token
		}
	    }
	} err]} {
	    return [Finish $token $err]
	} else {
	    if {[info exists state(-progress)]} {
		eval $state(-progress) \
		    [list $token $state(totalsize) $state(currentsize)]
	    }
	}
    }
			    set n [string length $chunk]
			    if {$n >= 0} {
				append state(body) $chunk
				incr state(log_size) [string length $chunk]
				##Log chunk $n cumul $state(log_size) -\
					token $token
			    }
			    if {$size != [string length $chunk]} {
				Log "WARNING: mis-sized chunk:\
				    was [string length $chunk], should be\
				    $size - token $token"
				set n 0
				set state(connection) close
				Log ^X$tk end of response (chunk error) \
					- token $token
				set msg {error in chunked encoding - fetch\
					terminated}
				Eot $token $msg
			    }
			    # CRLF that follows chunk.
			    # If eof, this is handled at the end of this proc.
			    getTextLine $sock
			} else {
			    set n 0
			    set state(transfer_final) {}
			}
		    } else {
			# Line expected to hold chunk length is empty, or eof.
			##Log bad-chunk-measure - token $token
			set n 0
			set state(connection) close
			Log ^X$tk end of response (chunk error) - token $token
			Eot $token {error in chunked encoding -\
				fetch terminated}
		    }
		} else {
		    ##Log unchunked - token $token
		    if {$state(totalsize) == 0} {
			# We know the transfer is complete only when the server
			# closes the connection.
			set state(state) complete
			set reqSize $state(-blocksize)
		    } else {
			# Ask for the whole of the unserved response-body.
			# This works around a problem with a tls::socket - for
			# https in keep-alive mode, and a request for
			# $state(-blocksize) bytes, the last part of the
			# resource does not get read until the server times out.
			set reqSize [expr {  $state(totalsize)
					   - $state(currentsize)}]

			# The workaround fails if reqSize is
			# capped at $state(-blocksize).
			# set reqSize [expr {min($reqSize, $state(-blocksize))}]
		    }
		    set c $state(currentsize)
		    set t $state(totalsize)
		    ##Log non-chunk currentsize $c of totalsize $t -\
			    token $token
		    set block [read $sock $reqSize]
		    set n [string length $block]
		    if {$n >= 0} {
			append state(body) $block
			##Log non-chunk [string length $state(body)] -\
				token $token
		    }
		}
		# This calculation uses n from the -handler, chunked, or
		# unchunked case as appropriate.
		if {[info exists state]} {
		    if {$n >= 0} {
			incr state(currentsize) $n
			set c $state(currentsize)
			set t $state(totalsize)
			##Log another $n currentsize $c totalsize $t -\
				token $token
		    }
		    # If Content-Length - check for end of data.
		    if {
			   ($state(totalsize) > 0)
			&& ($state(currentsize) >= $state(totalsize))
		    } {
			Log ^F$tk end of response body (unchunked) -\
				token $token
			set state(state) complete
			Eot $token
		    }
		}
	    } err]} {
		Log ^X$tk end of response (error ${err}) - token $token
		Finish $token $err
		return
	    } else {
		if {[info exists state(-progress)]} {
		    eval $state(-progress) \
			[list $token $state(totalsize) $state(currentsize)]
		}
	    }
	}

    # catch as an Eof above may have closed the socket already
    if {![catch {eof $sock} eof] && $eof} {
	if {[info exists $token]} {
	    set state(connection) close
	    Eof $token
	} else {
	    # open connection closed on a token that has been cleaned up.
	    CloseSocket $sock
	}
	return
	# catch as an Eot above may have closed the socket already
	# $state(state) may be connecting, header, body, or complete
	if {![set cc [catch {eof $sock} eof]] && $eof} {
	    ##Log eof - token $token
	    if {[info exists $token]} {
		set state(connection) close
		if {$state(state) eq "complete"} {
		    # This includes all cases in which the transaction
		    # can be completed by eof.
		    # The value "complete" is set only in http::Event, and it is
		    # used only in the test above.
		    Log ^F$tk end of response body (unchunked, eof) -\
			    token $token
		    Eot $token
		} else {
		    # Premature eof.
		    Log ^X$tk end of response (unexpected eof) - token $token
		    Eot $token eof
		}
	    } else {
		# open connection closed on a token that has been cleaned up.
		Log ^X$tk end of response (token error) - token $token
		CloseSocket $sock
	    }
	} elseif {$cc} {
	    return
	}
    }
}

# http::TestForReplay
#
#	Command called if eof is discovered when a socket is first used for a
#	new transaction.  Typically this occurs if a persistent socket is used
#	after a period of idleness and the server has half-closed the socket.
#
# token  - the connection token returned by http::geturl
# doing  - "read" or "write"
# err    - error message, if any
# caller - code to identify the caller - used only in logging
#
# Return Value: boolean, true iff the command calls http::ReplayIfDead.

proc http::TestForReplay {token doing err caller} {
    variable http
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    if {$doing eq "read"} {
	set code Q
	set action response
	set ing reading
    } else {
	set code P
	set action request
	set ing writing
    }

    if {$err eq {}} {
	set err "detect eof when $ing (server timed out?)"
    }

    if {$state(method) eq "POST" && !$http(-repost)} {
	# No Replay.
	# The present transaction will end when Finish is called.
	# That call to Finish will abort any other transactions
	# currently in the write queue.
	# For calls from http::Event this occurs when execution
	# reaches the code block at the end of that proc.
	set msg {no retry for POST with http::config -repost 0}
	Log reusing socket failed "($caller)" - $msg - token $token
	Log error - $err - token $token
	Log ^X$tk end of $action (error) - token $token
	return 0
    } else {
	# Replay.
	set msg {try a new socket}
	Log reusing socket failed "($caller)" - $msg - token $token
	Log error - $err - token $token
	Log ^$code$tk Any unfinished (incl this one) failed - token $token
	ReplayIfDead $token $doing
	return 1
    }
}

# http::IsBinaryContentType --
#
#	Determine if the content-type means that we should definitely transfer
#	the data as binary. [Bug 838e99a76d]
1221
1222
1223
1224
1225
1226
1227
1228













































































1229
1230
1231




1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244




1245
1246










































1247
1248
1249
1250
1251
1252
1253
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113

3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126




3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+
+
+
+









-
-
-
-
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    # Not just application/foobar+xml but also image/svg+xml, so let us not
    # restrict things for now...
    if {[string match "*+xml" $minor]} {
	return false
    }
    return true
}

proc http::ParseCookie {token value} {
    variable http
    variable CookieRE
    variable $token
    upvar 0 $token state

    if {![regexp $CookieRE $value -> cookiename cookieval opts]} {
	# Bad cookie! No biscuit!
	return
    }

    # Convert the options into a list before feeding into the cookie store;
    # ugly, but quite easy.
    set realopts {hostonly 1 path / secure 0 httponly 0}
    dict set realopts origin $state(host)
    dict set realopts domain $state(host)
    foreach option [split [regsub -all {;\s+} $opts \u0000] \u0000] {
	regexp {^(.*?)(?:=(.*))?$} $option -> optname optval
	switch -exact -- [string tolower $optname] {
	    expires {
		if {[catch {
		    #Sun, 06 Nov 1994 08:49:37 GMT
		    dict set realopts expires \
			[clock scan $optval -format "%a, %d %b %Y %T %Z"]
		}] && [catch {
		    # Google does this one
		    #Mon, 01-Jan-1990 00:00:00 GMT
		    dict set realopts expires \
			[clock scan $optval -format "%a, %d-%b-%Y %T %Z"]
		}] && [catch {
		    # This is in the RFC, but it is also in the original
		    # Netscape cookie spec, now online at:
		    # <URL:http://curl.haxx.se/rfc/cookie_spec.html>
		    #Sunday, 06-Nov-94 08:49:37 GMT
		    dict set realopts expires \
			[clock scan $optval -format "%A, %d-%b-%y %T %Z"]
		}]} {catch {
		    #Sun Nov  6 08:49:37 1994
		    dict set realopts expires \
			[clock scan $optval -gmt 1 -format "%a %b %d %T %Y"]
		}}
	    }
	    max-age {
		# Normalize
		if {[string is integer -strict $optval]} {
		    dict set realopts expires [expr {[clock seconds] + $optval}]
		}
	    }
	    domain {
		# From the domain-matches definition [RFC 2109, section 2]:
		#   Host A's name domain-matches host B's if [...]
		#	A is a FQDN string and has the form NB, where N is a
		#	non-empty name string, B has the form .B', and B' is a
		#	FQDN string. (So, x.y.com domain-matches .y.com but
		#	not y.com.)
		if {$optval ne "" && ![string match *. $optval]} {
		    dict set realopts domain [string trimleft $optval "."]
		    dict set realopts hostonly [expr {
			! [string match .* $optval]
		    }]
		}
	    }
	    path {
		if {[string match /* $optval]} {
		    dict set realopts path $optval
		}
	    }
	    secure - httponly {
		dict set realopts [string tolower $optname] 1
	    }
	}
    }
    dict set realopts key $cookiename
    dict set realopts value $cookieval
    {*}$http(-cookiejar) storeCookie $realopts
}

# http::getTextLine --
#
#	Get one line with the stream in blocking crlf mode
#	Get one line with the stream in crlf mode.
#	Used if Transfer-Encoding is chunked.
#	Empty line is not distinguished from eof.  The caller must
#	be able to handle this.
#
# Arguments
#	sock	The socket receiving input.
#
# Results:
#	The line of text, without trailing newline

proc http::getTextLine {sock} {
    set tr [fconfigure $sock -translation]
    set bl [fconfigure $sock -blocking]
    fconfigure $sock -translation crlf -blocking 1
    set r [gets $sock]
    fconfigure $sock -translation $tr -blocking $bl
    lassign $tr trRead trWrite
    fconfigure $sock -translation [list crlf $trWrite]
    set r [BlockingGets $sock]
    fconfigure $sock -translation $tr
    return $r
}

# http::BlockingRead
#
#	Replacement for a blocking read.
#	The caller must be a coroutine.

proc http::BlockingRead {sock size} {
    if {$size < 1} {
	return
    }
    set result {}
    while 1 {
	set need [expr {$size - [string length $result]}]
	set block [read $sock $need]
	set eof [eof $sock]
	append result $block
	if {[string length $result] >= $size || $eof} {
	    return $result
	} else {
	    yield
	}
    }
}

# http::BlockingGets
#
#	Replacement for a blocking gets.
#	The caller must be a coroutine.
#	Empty line is not distinguished from eof.  The caller must
#	be able to handle this.

proc http::BlockingGets {sock} {
    while 1 {
	set count [gets $sock line]
	set eof [eof $sock]
	if {$count > -1 || $eof} {
	    return $line
	} else {
	    yield
	}
    }
}

# http::CopyStart
#
#	Error handling wrapper around fcopy
#
# Arguments
#	sock	The socket to copy from
1266
1267
1268
1269
1270
1271
1272




1273
1274
1275
1276
1277
1278
1279
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211







+
+
+
+







    } else {
	if {$initial} {
	    foreach coding [ContentEncoding $token] {
		zlib push $coding $sock
	    }
	}
	if {[catch {
	    # FIXME Keep-Alive on https tls::socket with unchunked transfer
	    # hangs until the server times out. A workaround is possible, as for
	    # the case without -channel, but it does not use the neat "fcopy"
	    # solution.
	    fcopy $sock $state(-channel) -size $state(-blocksize) -command \
		[list http::CopyDone $token]
	} err]} {
	    Finish $token $err
	}
    }
}
1289
1290
1291
1292
1293
1294
1295
1296

1297
1298
1299
1300
1301
1302
1303
1304
1305
1306

1307
1308
1309
1310
1311
1312
1313
3221
3222
3223
3224
3225
3226
3227

3228
3229
3230
3231
3232
3233
3234
3235
3236
3237

3238
3239
3240
3241
3242
3243
3244
3245







-
+









-
+







	}
	puts -nonewline $state(-channel) $chunk
	if {[info exists state(-progress)]} {
	    eval [linsert $state(-progress) end \
		      $token $state(totalsize) $state(currentsize)]
	}
    } else {
	Log "CopyChunk Finish $token"
	Log "CopyChunk Finish - token $token"
	if {[info exists state(zlib)]} {
	    set excess ""
	    foreach stream $state(zlib) {
		catch {set excess [$stream add -finalize $excess]}
	    }
	    puts -nonewline $state(-channel) $excess
	    foreach stream $state(zlib) { $stream close }
	    unset state(zlib)
	}
	Eof $token ;# FIX ME: pipelining.
	Eot $token ;# FIX ME: pipelining.
    }
}

# http::CopyDone
#
#	fcopy completion callback
#
1323
1324
1325
1326
1327
1328
1329
1330

1331
1332
1333
1334

1335
1336
1337
1338
1339
1340

1341

1342









1343
1344
1345






1346
1347
1348
1349
1350

1351
1352
1353
1354


1355




1356

1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367



1368
1369
1370
1371
1372
1373


1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385

1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396

1397
1398
1399
1400
1401
1402
1403
3255
3256
3257
3258
3259
3260
3261

3262
3263
3264
3265

3266
3267
3268
3269
3270
3271

3272
3273
3274

3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296

3297
3298
3299


3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317


3318
3319
3320
3321
3322
3323
3324


3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337

3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348

3349
3350
3351
3352
3353
3354
3355
3356







-
+



-
+





-
+

+
-
+
+
+
+
+
+
+
+
+



+
+
+
+
+
+




-
+


-
-
+
+

+
+
+
+

+









-
-
+
+
+




-
-
+
+











-
+










-
+







    upvar 0 $token state
    set sock $state(sock)
    incr state(currentsize) $count
    if {[info exists state(-progress)]} {
	eval $state(-progress) \
	    [list $token $state(totalsize) $state(currentsize)]
    }
    # At this point the token may have been reset
    # At this point the token may have been reset.
    if {[string length $error]} {
	Finish $token $error
    } elseif {[catch {eof $sock} iseof] || $iseof} {
	Eof $token
	Eot $token
    } else {
	CopyStart $sock $token 0
    }
}

# http::Eof
# http::Eot
#
#	Called when either:
#	Handle eof on the socket
#	a. An eof condition is detected on the socket.
#	b. The client decides that the response is complete.
#	c. The client detects an inconsistency and aborts the transaction.
#
#	Does:
#	1. Set state(status)
#	2. Reverse any Content-Encoding
#	3. Convert charset encoding and line ends if necessary
#	4. Call http::Finish
#
# Arguments
#	token	The token returned from http::geturl
#	force	(previously) optional, has no effect
#	reason	- "eof" means premature EOF (not EOF as the natural end of
#		  the response)
#		- "" means completion of response, with or without EOF
#		- anything else describes an error confition other than
#		  premature EOF.
#
# Side Effects
#	Clean up the socket

proc http::Eof {token {force 0}} {
proc http::Eot {token {reason {}}} {
    variable $token
    upvar 0 $token state
    if {$state(state) eq "header"} {
	# Premature eof
    if {$reason eq "eof"} {
	# Premature eof.
	set state(status) eof
	set reason {}
    } elseif {$reason ne ""} {
	# Abort the transaction.
	set state(status) $reason
    } else {
	# The response is complete.
	set state(status) ok
    }

    if {[string length $state(body)] > 0} {
	if {[catch {
	    foreach coding [ContentEncoding $token] {
		set state(body) [zlib $coding $state(body)]
	    }
	} err]} {
	    Log "error doing decompression: $err"
	    return [Finish $token $err]
	    Log "error doing decompression for token $token: $err"
	    Finish $token $err
	    return
	}

	if {!$state(binary)} {
	    # If we are getting text, set the incoming channel's encoding
	    # correctly.  iso8859-1 is the RFC default, but this could be any IANA
	    # charset.  However, we only know how to convert what we have
	    # correctly.  iso8859-1 is the RFC default, but this could be any
	    # IANA charset.  However, we only know how to convert what we have
	    # encodings for.

	    set enc [CharsetToEncoding $state(charset)]
	    if {$enc ne "binary"} {
		set state(body) [encoding convertfrom $enc $state(body)]
	    }

	    # Translate text line endings.
	    set state(body) [string map {\r\n \n \r \n} $state(body)]
	}
    }
    Finish $token
    Finish $token $reason
}

# http::wait --
#
#	See documentation for details.
#
# Arguments:
#	token	Connection token.
#
# Results:
#        The status after the wait.
#	The status after the wait.

proc http::wait {token} {
    variable $token
    upvar 0 $token state

    if {![info exists state(status)] || $state(status) eq ""} {
	# We must wait on the original variable name, not the upvar alias
1416
1417
1418
1419
1420
1421
1422






1423
1424
1425
1426
1427
1428
1429
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388







+
+
+
+
+
+







# Arguments:
#	args	A list of name-value pairs.
#
# Results:
#	TODO

proc http::formatQuery {args} {
    if {[llength $args] % 2} {
        return \
            -code error \
            -errorcode [list HTTP BADARGCNT $args] \
            {Incorrect number of arguments, must be an even number.}
    }
    set result ""
    set sep ""
    foreach i $args {
	append result $sep [mapReply $i]
	if {$sep eq "="} {
	    set sep &
	} else {
1460
1461
1462
1463
1464
1465
1466

1467
1468
1469
1470
1471
1472
1473
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433







+







	regexp "\[\u0100-\uffff\]" $converted badChar
	# Return this error message for maximum compatibility... :^/
	return -code error \
	    "can't read \"formMap($badChar)\": no such element in array"
    }
    return $converted
}
interp alias {} http::quoteString {} http::mapReply

# http::ProxyRequired --
#	Default proxy filter.
#
# Arguments:
#	host	The destination host
#
1541
1542
1543
1544
1545
1546
1547
1548
1549

1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
































1579
1580
1581
1582
1583
1584
3501
3502
3503
3504
3505
3506
3507
3508

3509





























3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541

3542
3543
3544
3545
3546








-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-





		    return -code error "unsupported content-encoding \"$coding\""
		}
	    }
	}
    }
    return $r
}

proc http::make-transformation-chunked {chan command} {
proc http::ReceiveChunked {chan command} {
    set lambda {{chan command} {
        set data ""
        set size -1
        yield
        while {1} {
            chan configure $chan -translation {crlf binary}
            while {[gets $chan line] < 1} { yield }
            chan configure $chan -translation {binary binary}
            if {[scan $line %x size] != 1} { return -code error "invalid size: \"$line\"" }
            set chunk ""
            while {$size && ![chan eof $chan]} {
                set part [chan read $chan $size]
                incr size -[string length $part]
                append chunk $part
            }
            if {[catch {
		uplevel #0 [linsert $command end $chunk]
	    }]} {
		http::Log "Error in callback: $::errorInfo"
	    }
            if {[string length $chunk] == 0} {
		# channel might have been closed in the callback
                catch {chan event $chan readable {}}
                return
            }
        }
    }}
    coroutine dechunk$chan ::apply $lambda $chan $command
    chan event $chan readable [namespace origin dechunk$chan]
    set data ""
    set size -1
    yield
    while {1} {
	chan configure $chan -translation {crlf binary}
	while {[gets $chan line] < 1} { yield }
	chan configure $chan -translation {binary binary}
	if {[scan $line %x size] != 1} {
	    return -code error "invalid size: \"$line\""
	}
	set chunk ""
	while {$size && ![chan eof $chan]} {
	    set part [chan read $chan $size]
	    incr size -[string length $part]
	    append chunk $part
	}
	if {[catch {
	    uplevel #0 [linsert $command end $chunk]
	}]} {
	    http::Log "Error in callback: $::errorInfo"
	}
	if {[string length $chunk] == 0} {
	    # channel might have been closed in the callback
	    catch {chan event $chan readable {}}
	    return
	}
    }
}

proc http::make-transformation-chunked {chan command} {
    coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked $chan $command
    chan event $chan readable [namespace current]::dechunk$chan
    return
}

# Local variables:
# indent-tabs-mode: t
# End:

Added library/http/idna.tcl.





































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# cookiejar.tcl --
#
#	Implementation of IDNA (Internationalized Domain Names for
#	Applications) encoding/decoding system, built on a punycode engine
#	developed directly from the code in RFC 3492, Appendix C (with
#	substantial modifications).
#
# This implementation includes code from that RFC, translated to Tcl; the
# other parts are:
# Copyright (c) 2014 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval ::tcl::idna {
    namespace ensemble create -command puny -map {
	encode punyencode
	decode punydecode
    }
    namespace ensemble create -command ::tcl::idna -map {
	encode IDNAencode
	decode IDNAdecode
	puny puny
	version {::apply {{} {package present tcl::idna} ::}}
    }

    proc IDNAencode hostname {
	set parts {}
	# Split term from RFC 3490, Sec 3.1
	foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] {
	    if {[regexp {[^-A-Za-z0-9]} $part]} {
		if {[regexp {[^-A-Za-z0-9\u00a1-\uffff]} $part ch]} {
		    scan $ch %c c
		    if {$ch < "!" || $ch > "~"} {
			set ch [format "\\u%04x" $c]
		    }
		    throw [list IDNA INVALID_NAME_CHARACTER $ch] \
			"bad character \"$ch\" in DNS name"
		}
		set part xn--[punyencode $part]
		# Length restriction from RFC 5890, Sec 2.3.1
		if {[string length $part] > 63} {
		    throw [list IDNA OVERLONG_PART $part] \
			"hostname part too long"
		}
	    }
	    lappend parts $part
	}
	return [join $parts .]
    }
    proc IDNAdecode hostname {
	set parts {}
	# Split term from RFC 3490, Sec 3.1
	foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] {
	    if {[string match -nocase "xn--*" $part]} {
		set part [punydecode [string range $part 4 end]]
	    }
	    lappend parts $part
	}
	return [join $parts .]
    }

    variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""]
    # Bootstring parameters for Punycode
    variable base 36
    variable tmin 1
    variable tmax 26
    variable skew 38
    variable damp 700
    variable initial_bias 72
    variable initial_n 0x80

    variable max_codepoint 0x10FFFF

    proc adapt {delta first numchars} {
	variable base
	variable tmin
	variable tmax
	variable damp
	variable skew

	set delta [expr {$delta / ($first ? $damp : 2)}]
	incr delta [expr {$delta / $numchars}]
	set k 0
	while {$delta > ($base - $tmin) * $tmax / 2} {
	    set delta [expr {$delta / ($base-$tmin)}]
	    incr k $base
	}
	return [expr {$k + ($base-$tmin+1) * $delta / ($delta+$skew)}]
    }

    # Main punycode encoding function
    proc punyencode {string {case ""}} {
	variable digits
	variable tmin
	variable tmax
	variable base
	variable initial_n
	variable initial_bias

	if {![string is boolean $case]} {
	    return -code error "\"$case\" must be boolean"
	}

	set in {}
	foreach char [set string [split $string ""]] {
	    scan $char "%c" ch
	    lappend in $ch
	}
	set output {}

	# Initialize the state:
	set n $initial_n
	set delta 0
	set bias $initial_bias

	# Handle the basic code points:
	foreach ch $string {
	    if {$ch < "\u0080"} {
		if {$case eq ""} {
		    append output $ch
		} elseif {[string is true $case]} {
		    append output [string toupper $ch]
		} elseif {[string is false $case]} {
		    append output [string tolower $ch]
		}
	    }
	}

	set b [string length $output]

	# h is the number of code points that have been handled, b is the
	# number of basic code points.

	if {$b > 0} {
	    append output "-"
	}

	# Main encoding loop:

	for {set h $b} {$h < [llength $in]} {incr delta; incr n} {
	    # All non-basic code points < n have been handled already.  Find
	    # the next larger one:

	    set m inf
	    foreach ch $in {
		if {$ch >= $n && $ch < $m} {
		    set m $ch
		}
	    }

	    # Increase delta enough to advance the decoder's <n,i> state to
	    # <m,0>, but guard against overflow:

	    if {$m-$n > (0xffffffff-$delta)/($h+1)} {
		throw {PUNYCODE OVERFLOW} "overflow in delta computation"
	    }
	    incr delta [expr {($m-$n) * ($h+1)}]
	    set n $m

	    foreach ch $in {
		if {$ch < $n && ([incr delta] & 0xffffffff) == 0} {
		    throw {PUNYCODE OVERFLOW} "overflow in delta computation"
		}

		if {$ch != $n} {
		    continue
		}

		# Represent delta as a generalized variable-length integer:

		for {set q $delta; set k $base} true {incr k $base} {
		    set t [expr {min(max($k-$bias, $tmin), $tmax)}]
		    if {$q < $t} {
			break
		    }
		    append output \
			[lindex $digits [expr {$t + ($q-$t)%($base-$t)}]]
		    set q [expr {($q-$t) / ($base-$t)}]
		}

		append output [lindex $digits $q]
		set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]]
		set delta 0
		incr h
	    }
	}

	return $output
    }

    # Main punycode decode function
    proc punydecode {string {case ""}} {
	variable tmin
	variable tmax
	variable base
	variable initial_n
	variable initial_bias
	variable max_codepoint

	if {![string is boolean $case]} {
	    return -code error "\"$case\" must be boolean"
	}

	# Initialize the state:

	set n $initial_n
	set i 0
	set first 1
	set bias $initial_bias

	# Split the string into the "real" ASCII characters and the ones to
	# feed into the main decoder. Note that we don't need to check the
	# result of [regexp] because that RE will technically match any string
	# at all.

	regexp {^(?:(.*)-)?([^-]*)$} $string -> pre post
	if {[string is true -strict $case]} {
	    set pre [string toupper $pre]
	} elseif {[string is false -strict $case]} {
	    set pre [string tolower $pre]
	}
	set output [split $pre ""]
	set out [llength $output]

	# Main decoding loop:

	for {set in 0} {$in < [string length $post]} {incr in} {
	    # Decode a generalized variable-length integer into delta, which
	    # gets added to i. The overflow checking is easier if we increase
	    # i as we go, then subtract off its starting value at the end to
	    # obtain delta.

	    for {set oldi $i; set w 1; set k $base} 1 {incr in} {
		if {[set ch [string index $post $in]] eq ""} {
		    throw {PUNYCODE BAD_INPUT LENGTH} "exceeded input data"
		}
		if {[string match -nocase {[a-z]} $ch]} {
		    scan [string toupper $ch] %c digit
		    incr digit -65
		} elseif {[string match {[0-9]} $ch]} {
		    set digit [expr {$ch + 26}]
		} else {
		    throw {PUNYCODE BAD_INPUT CHAR} \
			    "bad decode character \"$ch\""
		}
		incr i [expr {$digit * $w}]
		set t [expr {min(max($tmin, $k-$bias), $tmax)}]
		if {$digit < $t} {
		    set bias [adapt [expr {$i-$oldi}] $first [incr out]]
		    set first 0
		    break
		}
		if {[set w [expr {$w * ($base - $t)}]] > 0x7fffffff} {
		    throw {PUNYCODE OVERFLOW} \
			"excessively large integer computed in digit decode"
		}
		incr k $base
	    }

	    # i was supposed to wrap around from out+1 to 0, incrementing n
	    # each time, so we'll fix that now:

	    if {[incr n [expr {$i / $out}]] > 0x7fffffff} {
		throw {PUNYCODE OVERFLOW} \
		    "excessively large integer computed in character choice"
	    } elseif {$n > $max_codepoint} {
		if {$n >= 0x00d800 && $n < 0x00e000} {
		    # Bare surrogate?!
		    throw {PUNYCODE NON_BMP} \
			[format "unsupported character U+%06x" $n]
		}
		throw {PUNYCODE NON_UNICODE} "bad codepoint $n"
	    }
	    set i [expr {$i % $out}]

	    # Insert n at position i of the output:

	    set output [linsert $output $i [format "%c" $n]]
	    incr i
	}

	return [join $output ""]
    }
}

package provide tcl::idna 1.0

# Local variables:
# mode: tcl
# fill-column: 78
# End:

Changes to library/http/pkgIndex.tcl.

1
2



1

2
3
4

-
+
+
+
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.8.12 [list tclPkgSetup $dir http 2.8.12 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
package ifneeded http 2.9.0 [list tclPkgSetup $dir http 2.9.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
package ifneeded cookiejar 0.1 [list source [file join $dir cookiejar.tcl]]
package ifneeded tcl::idna 1.0 [list source [file join $dir idna.tcl]]

Deleted library/http1.0/http.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377

























































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# http.tcl
# Client-side HTTP for GET, POST, and HEAD commands.
# These routines can be used in untrusted code that uses the Safesock
# security policy.
# These procedures use a callback interface to avoid using vwait,
# which is not defined in the safe base.
#
# See the http.n man page for documentation

package provide http 1.0

array set http {
    -accept */*
    -proxyhost {}
    -proxyport {}
    -useragent {Tcl http client package 1.0}
    -proxyfilter httpProxyRequired
}
proc http_config {args} {
    global http
    set options [lsort [array names http -*]]
    set usage [join $options ", "]
    if {[llength $args] == 0} {
	set result {}
	foreach name $options {
	    lappend result $name $http($name)
	}
	return $result
    }
    regsub -all -- - $options {} options
    set pat ^-([join $options |])$
    if {[llength $args] == 1} {
	set flag [lindex $args 0]
	if {[regexp -- $pat $flag]} {
	    return $http($flag)
	} else {
	    return -code error "Unknown option $flag, must be: $usage"
	}
    } else {
	foreach {flag value} $args {
	    if {[regexp -- $pat $flag]} {
		set http($flag) $value
	    } else {
		return -code error "Unknown option $flag, must be: $usage"
	    }
	}
    }
}

 proc httpFinish { token {errormsg ""} } {
    upvar #0 $token state
    global errorInfo errorCode
    if {[string length $errormsg] != 0} {
	set state(error) [list $errormsg $errorInfo $errorCode]
	set state(status) error
    }
    catch {close $state(sock)}
    catch {after cancel $state(after)}
    if {[info exists state(-command)]} {
	if {[catch {eval $state(-command) {$token}} err]} {
	    if {[string length $errormsg] == 0} {
		set state(error) [list $err $errorInfo $errorCode]
		set state(status) error
	    }
	}
	unset state(-command)
    }
}
proc http_reset { token {why reset} } {
    upvar #0 $token state
    set state(status) $why
    catch {fileevent $state(sock) readable {}}
    httpFinish $token
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state(error)
	eval error $errorlist
    }
}
proc http_get { url args } {
    global http
    if {![info exists http(uid)]} {
	set http(uid) 0
    }
    set token http#[incr http(uid)]
    upvar #0 $token state
    http_reset $token
    array set state {
	-blocksize 	8192
	-validate 	0
	-headers 	{}
	-timeout 	0
	state		header
	meta		{}
	currentsize	0
	totalsize	0
        type            text/html
        body            {}
	status		""
    }
    set options {-blocksize -channel -command -handler -headers \
		-progress -query -validate -timeout}
    set usage [join $options ", "]
    regsub -all -- - $options {} options
    set pat ^-([join $options |])$
    foreach {flag value} $args {
	if {[regexp $pat $flag]} {
	    # Validate numbers
	    if {[info exists state($flag)] && \
		    [regexp {^[0-9]+$} $state($flag)] && \
		    ![regexp {^[0-9]+$} $value]} {
		return -code error "Bad value for $flag ($value), must be integer"
	    }
	    set state($flag) $value
	} else {
	    return -code error "Unknown option $flag, can be: $usage"
	}
    }
    if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
	    x proto host y port srvurl]} {
	error "Unsupported URL: $url"
    }
    if {[string length $port] == 0} {
	set port 80
    }
    if {[string length $srvurl] == 0} {
	set srvurl /
    }
    if {[string length $proto] == 0} {
	set url http://$url
    }
    set state(url) $url
    if {![catch {$http(-proxyfilter) $host} proxy]} {
	set phost [lindex $proxy 0]
	set pport [lindex $proxy 1]
    }
    if {$state(-timeout) > 0} {
	set state(after) [after $state(-timeout) [list http_reset $token timeout]]
    }
    if {[info exists phost] && [string length $phost]} {
	set srvurl $url
	set s [socket $phost $pport]
    } else {
	set s [socket $host $port]
    }
    set state(sock) $s

    # Send data in cr-lf format, but accept any line terminators

    fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket
    # is already in non-blocking mode in that case.

    catch {fconfigure $s -blocking off}
    set len 0
    set how GET
    if {[info exists state(-query)]} {
	set len [string length $state(-query)]
	if {$len > 0} {
	    set how POST
	}
    } elseif {$state(-validate)} {
	set how HEAD
    }
    puts $s "$how $srvurl HTTP/1.0"
    puts $s "Accept: $http(-accept)"
    puts $s "Host: $host"
    puts $s "User-Agent: $http(-useragent)"
    foreach {key value} $state(-headers) {
	regsub -all \[\n\r\]  $value {} value
	set key [string trim $key]
	if {[string length $key]} {
	    puts $s "$key: $value"
	}
    }
    if {$len > 0} {
	puts $s "Content-Length: $len"
	puts $s "Content-Type: application/x-www-form-urlencoded"
	puts $s ""
	fconfigure $s -translation {auto binary}
	puts -nonewline $s $state(-query)
    } else {
	puts $s ""
    }
    flush $s
    fileevent $s readable [list httpEvent $token]
    if {! [info exists state(-command)]} {
	http_wait $token
    }
    return $token
}
proc http_data {token} {
    upvar #0 $token state
    return $state(body)
}
proc http_status {token} {
    upvar #0 $token state
    return $state(status)
}
proc http_code {token} {
    upvar #0 $token state
    return $state(http)
}
proc http_size {token} {
    upvar #0 $token state
    return $state(currentsize)
}

 proc httpEvent {token} {
    upvar #0 $token state
    set s $state(sock)

     if {[eof $s]} {
	httpEof $token
	return
    }
    if {$state(state) == "header"} {
	set n [gets $s line]
	if {$n == 0} {
	    set state(state) body
	    if {![regexp -nocase ^text $state(type)]} {
		# Turn off conversions for non-text data
		fconfigure $s -translation binary
		if {[info exists state(-channel)]} {
		    fconfigure $state(-channel) -translation binary
		}
	    }
	    if {[info exists state(-channel)] &&
		    ![info exists state(-handler)]} {
		# Initiate a sequence of background fcopies
		fileevent $s readable {}
		httpCopyStart $s $token
	    }
	} elseif {$n > 0} {
	    if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
		set state(type) [string trim $type]
	    }
	    if {[regexp -nocase {^content-length:(.+)$} $line x length]} {
		set state(totalsize) [string trim $length]
	    }
	    if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
		lappend state(meta) $key $value
	    } elseif {[regexp ^HTTP $line]} {
		set state(http) $line
	    }
	}
    } else {
	if {[catch {
	    if {[info exists state(-handler)]} {
		set n [eval $state(-handler) {$s $token}]
	    } else {
		set block [read $s $state(-blocksize)]
		set n [string length $block]
		if {$n >= 0} {
		    append state(body) $block
		}
	    }
	    if {$n >= 0} {
		incr state(currentsize) $n
	    }
	} err]} {
	    httpFinish $token $err
	} else {
	    if {[info exists state(-progress)]} {
		eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
	    }
	}
    }
}
 proc httpCopyStart {s token} {
    upvar #0 $token state
    if {[catch {
	fcopy $s $state(-channel) -size $state(-blocksize) -command \
	    [list httpCopyDone $token]
    } err]} {
	httpFinish $token $err
    }
}
 proc httpCopyDone {token count {error {}}} {
    upvar #0 $token state
    set s $state(sock)
    incr state(currentsize) $count
    if {[info exists state(-progress)]} {
	eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
    }
    if {([string length $error] != 0)} {
	httpFinish $token $error
    } elseif {[eof $s]} {
	httpEof $token
    } else {
	httpCopyStart $s $token
    }
}
 proc httpEof {token} {
    upvar #0 $token state
    if {$state(state) == "header"} {
	# Premature eof
	set state(status) eof
    } else {
	set state(status) ok
    }
    set state(state) eof
    httpFinish $token
}
proc http_wait {token} {
    upvar #0 $token state
    if {![info exists state(status)] || [string length $state(status)] == 0} {
	vwait $token\(status)
    }
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state(error)
	eval error $errorlist
    }
    return $state(status)
}

# Call http_formatQuery with an even number of arguments, where the first is
# a name, the second is a value, the third is another name, and so on.

proc http_formatQuery {args} {
    set result ""
    set sep ""
    foreach i $args {
	append result  $sep [httpMapReply $i]
	if {$sep != "="} {
	    set sep =
	} else {
	    set sep &
	}
    }
    return $result
}

# do x-www-urlencoded character mapping
# The spec says: "non-alphanumeric characters are replaced by '%HH'"
# 1 leave alphanumerics characters alone
# 2 Convert every other character to an array lookup
# 3 Escape constructs that are "special" to the tcl parser
# 4 "subst" the result, doing all the array substitutions

 proc httpMapReply {string} {
    global httpFormMap
    set alphanumeric	a-zA-Z0-9
    if {![info exists httpFormMap]} {

	for {set i 1} {$i <= 256} {incr i} {
	    set c [format %c $i]
	    if {![string match \[$alphanumeric\] $c]} {
		set httpFormMap($c) %[format %.2x $i]
	    }
	}
	# These are handled specially
	array set httpFormMap {
	    " " +   \n %0d%0a
	}
    }
    regsub -all \[^$alphanumeric\] $string {$httpFormMap(&)} string
    regsub -all \n $string {\\n} string
    regsub -all \t $string {\\t} string
    regsub -all {[][{})\\]\)} $string {\\&} string
    return [subst $string]
}

# Default proxy filter.
 proc httpProxyRequired {host} {
    global http
    if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
	if {![info exists http(-proxyport)] || ![string length $http(-proxyport)]} {
	    set http(-proxyport) 8080
	}
	return [list $http(-proxyhost) $http(-proxyport)]
    } else {
	return {}
    }
}

Deleted library/http1.0/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
11











-
-
-
-
-
-
-
-
-
-
-
# Tcl package index file, version 1.0
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded http 1.0 [list tclPkgSetup $dir http 1.0 {{http.tcl source {httpCopyDone httpCopyStart httpEof httpEvent httpFinish httpMapReply httpProxyRequired http_code http_config http_data http_formatQuery http_get http_reset http_size http_status http_wait}}}]

Changes to library/init.tcl.

1
2
3
4
5
6
7
8
9




10
11
12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29








-
+
+
+
+









-
+







# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2004 by Kevin B. Kenny.
# Copyright (c) 2018 by Sean Woods
#
# All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# This test intentionally written in pre-7.5 Tcl
if {[info commands package] == ""} {
    error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact Tcl 9.0a0
package require -exact Tcl 8.7a2

# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
#
# The environment variable TCLLIBPATH
#
# tcl_library, which is the directory containing this init.tcl script.
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
72
73
74
75
76
77
78





































79
80
81
82
83
84
85







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







        variable Path [encoding dirs]
        set Dir [file join $::tcl_library encoding]
        if {$Dir ni $Path} {
	    lappend Path $Dir
	    encoding dirs $Path
        }
    }

    # TIP #255 min and max functions
    namespace eval mathfunc {
	proc min {args} {
	    if {![llength $args]} {
		return -code error \
		    "too few arguments to math function \"min\""
	    }
	    set val Inf
	    foreach arg $args {
		# This will handle forcing the numeric value without
		# ruining the internal type of a numeric object
		if {[catch {expr {double($arg)}} err]} {
		    return -code error $err
		}
		if {$arg < $val} {set val $arg}
	    }
	    return $val
	}
	proc max {args} {
	    if {![llength $args]} {
		return -code error \
		    "too few arguments to math function \"max\""
	    }
	    set val -Inf
	    foreach arg $args {
		# This will handle forcing the numeric value without
		# ruining the internal type of a numeric object
		if {[catch {expr {double($arg)}} err]} {
		    return -code error $err
		}
		if {$arg > $val} {set val $arg}
	    }
	    return $val
	}
	namespace export min max
    }
}

namespace eval tcl::Pkg {}

# Windows specific end of initialization

if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
652
653
654
655
656
657
658
659

660
661
662
663
664
665
666
667
618
619
620
621
622
623
624

625

626
627
628
629
630
631
632







-
+
-








    if {[info exists auto_execs($name)]} {
	return $auto_execs($name)
    }
    set auto_execs($name) ""

    set shellBuiltins [list assoc cls copy date del dir echo erase ftype \
                           md mkdir mklink move rd ren rename rmdir start \
	    md mkdir mklink move rd ren rename rmdir start time type ver vol]
                           time type ver vol]
    if {[info exists env(PATHEXT)]} {
	# Add an initial ; to have the {} extension check first.
	set execExtensions [split ";$env(PATHEXT)" ";"]
    } else {
	set execExtensions [list {} .com .exe .bat .cmd]
    }

687
688
689
690
691
692
693
694
695

696
697
698
699
700
701
702
703
704
652
653
654
655
656
657
658


659


660
661
662
663
664
665
666







-
-
+
-
-







    }

    set path "[file dirname [info nameof]];.;"
    if {[info exists env(WINDIR)]} {
	set windir $env(WINDIR)
    }
    if {[info exists windir]} {
	if {$tcl_platform(os) eq "Windows NT"} {
	    append path "$windir/system32;"
	append path "$windir/system32;$windir/system;$windir;"
	}
	append path "$windir/system;$windir;"
    }

    foreach var {PATH Path path} {
	if {[info exists env($var)]} {
	    append path ";$env($var)"
	}
    }
832
833
834
835
836
837
838

















794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
    foreach s [lsort -unique $filelist] {
	if {[file tail $s] ni {. ..}} {
	    file copy -force -- $s [file join $dest [file tail $s]]
	}
    }
    return
}
set isafe [interp issafe]
###
# Package manifest for all Tcl packages included in the /library file system
###
set isafe [interp issafe]
set dir [file dirname [info script]]
foreach {safe package version file} {
  0 http            2.9.0 {http http.tcl}
  1 msgcat          1.7.0  {msgcat msgcat.tcl}
  1 opt             0.4.7  {opt optparse.tcl}
  0 platform        1.0.14 {platform platform.tcl}
  0 platform::shell 1.1.4  {platform shell.tcl}
  1 tcltest         2.5.0  {tcltest tcltest.tcl}
} {
  if {$isafe && !$safe} continue
  package ifneeded $package $version  [list source [file join $dir {*}$file]]
}

Added library/install.tcl.





















































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
###
# Installer actions built into tclsh and invoked
# if the first command line argument is "install"
###
if {[llength $argv] < 2} {
  exit 0
}
namespace eval ::practcl {}
###
# Installer tools
###
proc ::practcl::_isdirectory name {
  return [file isdirectory $name]
}
###
# Return true if the pkgindex file contains
# any statement other than "package ifneeded"
# and/or if any package ifneeded loads a DLL
###
proc ::practcl::_pkgindex_directory {path} {
  set buffer {}
  set pkgidxfile [file join $path pkgIndex.tcl]
  if {![file exists $pkgidxfile]} {
    # No pkgIndex file, read the source
    foreach file [glob -nocomplain $path/*.tm] {
      set file [file normalize $file]
      set fname [file rootname [file tail $file]]
      ###
      # We used to be able to ... Assume the package is correct in the filename
      # No hunt for a "package provides"
      ###
      set package [lindex [split $fname -] 0]
      set version [lindex [split $fname -] 1]
      ###
      # Read the file, and override assumptions as needed
      ###
      set fin [open $file r]
      set dat [read $fin]
      close $fin
      # Look for a teapot style Package statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 9] != "# Package " } continue
        set package [lindex $line 2]
        set version [lindex $line 3]
        break
      }
      # Look for a package provide statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 14] != "package provide" } continue
        set package [lindex $line 2]
        set version [lindex $line 3]
        break
      }
      append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
    }
    foreach file [glob -nocomplain $path/*.tcl] {
      if { [file tail $file] == "version_info.tcl" } continue
      set fin [open $file r]
      set dat [read $fin]
      close $fin
      if {![regexp "package provide" $dat]} continue
      set fname [file rootname [file tail $file]]
      # Look for a package provide statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 14] != "package provide" } continue
        set package [lindex $line 2]
        set version [lindex $line 3]
        if {[string index $package 0] in "\$ \[ @"} continue
        if {[string index $version 0] in "\$ \[ @"} continue
        append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
        break
      }
    }
    return $buffer
  }
  set fin [open $pkgidxfile r]
  set dat [read $fin]
  close $fin
  set trace 0
  #if {[file tail $path] eq "tool"} {
  #  set trace 1
  #}
  set thisline {}
  foreach line [split $dat \n] {
    append thisline $line \n
    if {![info complete $thisline]} continue
    set line [string trim $line]
    if {[string length $line]==0} {
      set thisline {} ; continue
    }
    if {[string index $line 0] eq "#"} {
      set thisline {} ; continue
    }
    if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} {
      if {$trace} {puts "[file dirname $pkgidxfile] Ignoring $thisline"}
      set thisline {} ; continue
    }
    if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} {
      if {$trace} { puts "[file dirname $pkgidxfile] Ignoring $thisline" }
      set thisline {} ; continue
    }
    if {![regexp "package.*ifneeded" $thisline]} {
      # This package index contains arbitrary code
      # source instead of trying to add it to the master
      # package index
      if {$trace} { puts "[file dirname $pkgidxfile] Arbitrary code $thisline" }
      return {source [file join $dir pkgIndex.tcl]}
    }
    append buffer $thisline \n
    set thisline {}
  }
  if {$trace} {puts [list [file dirname $pkgidxfile] $buffer]}
  return $buffer
}


proc ::practcl::_pkgindex_path_subdir {path} {
  set result {}
  foreach subpath [glob -nocomplain [file join $path *]] {
    if {[file isdirectory $subpath]} {
      lappend result $subpath {*}[_pkgindex_path_subdir $subpath]
    }
  }
  return $result
}
###
# Index all paths given as though they will end up in the same
# virtual file system
###
proc ::practcl::pkgindex_path args {
  set stack {}
  set buffer {
lappend ::PATHSTACK $dir
  }
  foreach base $args {
    set base [file normalize $base]
    set paths {}
    foreach dir [glob -nocomplain [file join $base *]] {
      if {[file tail $dir] eq "teapot"} continue
      lappend paths $dir {*}[::practcl::_pkgindex_path_subdir $dir]
    }
    set i    [string length  $base]
    # Build a list of all of the paths
    if {[llength $paths]} {
      foreach path $paths {
        if {$path eq $base} continue
        set path_indexed($path) 0
      }
    } else {
      puts [list WARNING: NO PATHS FOUND IN $base]
    }
    set path_indexed($base) 1
    set path_indexed([file join $base boot tcl]) 1
    foreach teapath [glob -nocomplain [file join $base teapot *]] {
      set pkg [file tail $teapath]
      append buffer [list set pkg $pkg]
      append buffer {
set pkginstall [file join $::g(HOME) teapot $pkg]
if {![file exists $pkginstall]} {
  installDir [file join $dir teapot $pkg] $pkginstall
}
}
    }
    foreach path $paths {
      if {$path_indexed($path)} continue
      set thisdir [file_relative $base $path]
      set idxbuf [::practcl::_pkgindex_directory $path]
      if {[string length $idxbuf]} {
        incr path_indexed($path)
        append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n
        append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n
      }
    }
  }
  append buffer {
set dir [lindex $::PATHSTACK end]
set ::PATHSTACK [lrange $::PATHSTACK 0 end-1]
}
  return $buffer
}

###
# topic: 64319f4600fb63c82b2258d908f9d066
# description: Script to build the VFS file system
###
proc ::practcl::installDir {d1 d2} {

  puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]]
  file delete -force -- $d2
  file mkdir $d2

  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      installDir $f [file join $d2 $ftail]
    } elseif {[file isfile $f]} {
	    file copy -force $f [file join $d2 $ftail]
	    if {$::tcl_platform(platform) eq {unix}} {
        file attributes [file join $d2 $ftail] -permissions 0644
	    } else {
        file attributes [file join $d2 $ftail] -readonly 1
	    }
    }
  }

  if {$::tcl_platform(platform) eq {unix}} {
    file attributes $d2 -permissions 0755
  } else {
    file attributes $d2 -readonly 1
  }
}

proc ::practcl::copyDir {d1 d2 {toplevel 1}} {
  #if {$toplevel} {
  #  puts [list ::practcl::copyDir $d1 -> $d2]
  #}
  #file delete -force -- $d2
  file mkdir $d2

  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      copyDir $f [file join $d2 $ftail] 0
    } elseif {[file isfile $f]} {
      file copy -force $f [file join $d2 $ftail]
    }
  }
}

switch [lindex $argv 1] {
  mkzip {
    zipfs mkzip {*}[lrange $argv 2 end]
  }
  mkzip {
    zipfs mkimg {*}[lrange $argv 2 end]
  }
  default {
    ::practcl::[lindex $argv 1] {*}[lrange $argv 2 end]
  }
}
exit 0

Changes to library/msgcat/msgcat.tcl.

1
2
3
4
5
6
7

8
9
10
11
12
13

14

15
16
17

18
19

20

21
22

23
24
25
26
27
28
29
1
2
3
4
5
6

7
8
9
10
11
12
13
14

15
16
17

18
19
20
21

22
23

24
25
26
27
28
29
30
31






-
+






+
-
+


-
+


+
-
+

-
+







# msgcat.tcl --
#
#	This file defines various procedures which implement a
#	message catalog facility for Tcl programs.  It should be
#	loaded with the command "package require msgcat".
#
# Copyright (c) 2010-2015 by Harald Oehlmann.
# Copyright (c) 2010-2018 by Harald Oehlmann.
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 1998 by Mark Harrison.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# We use oo::define::self, which is new in Tcl 8.7
package require Tcl 8.5-
package require Tcl 8.7-
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
package provide msgcat 1.6.1
package provide msgcat 1.7.0

namespace eval msgcat {
    namespace export mc mcn mcexists mcload mclocale mcmax\
    namespace export mc mcexists mcload mclocale mcmax mcmset mcpreferences mcset\
	    mcmset mcpreferences mcset\
            mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\
	    mcpackageconfig mcpackagelocale
	    mcpackagenamespaceget mcpackageconfig mcpackagelocale mcutil

    # Records the list of locales to search
    variable Loclist {}

    # List of currently loaded locales
    variable LoadedLocales {}

37
38
39
40
41
42
43






44
45
46
47
48
49
50
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58







+
+
+
+
+
+







	    unknowncmd {} loadedlocales {} loclist {}]

    # Records the mapping between source strings and translated strings.  The
    # dict key is of the form "<namespace> <locale> <src>", where locale and
    # namespace should be themselves dict values and the value is
    # the translated string.
    variable Msgs [dict create]
}

# create ensemble namespace for mcutil command
namespace eval msgcat::mcutil {
    namespace export getsystemlocale getpreferences
    namespace ensemble create -prefix 0

    # Map of language codes used in Windows registry to those of ISO-639
    if {[info sharedlibextension] eq ".dll"} {
	variable WinRegToISO639 [dict create  {*}{
	    01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ
		  1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY
		  2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH
188
189
190
191
192
193
194
195
196
197
198
























199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222

223
224
225
226
227
228
229
196
197
198
199
200
201
202




203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233

234
235
236
237
238
239
240
241
242
243
244
245
246
247
248

249
250
251
252
253
254
255
256







-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-















-
+







#	src	The string to translate.
#	args	Args to pass to the format command
#
# Results:
#	Returns the translated string.  Propagates errors thrown by the
#	format command.

proc msgcat::mc {src args} {
    # this may be replaced by:
    # return [mcget -namespace [uplevel 1 [list ::namespace current]] --\
    #	    $src {*}$args]
proc msgcat::mc {args} {
    tailcall mcn [PackageNamespaceGet] {*}$args
}

# msgcat::mcn --
#
#	Find the translation for the given string based on the current
#	locale setting. Check the passed namespace first, then look in each
#	parent namespace until the source is found.  If additional args are
#	specified, use the format command to work them into the traslated
#	string.
#	If no catalog item is found, mcunknown is called in the caller frame
#	and its result is returned.
#
# Arguments:
#	ns	Package namespace of the translation
#	src	The string to translate.
#	args	Args to pass to the format command
#
# Results:
#	Returns the translated string.  Propagates errors thrown by the
#	format command.

proc msgcat::mcn {ns src args} {

    # Check for the src in each namespace starting from the local and
    # ending in the global.

    variable Msgs
    variable Loclist

    set ns [uplevel 1 [list ::namespace current]]
    set loclist [PackagePreferences $ns]

    set nscur $ns
    while {$nscur != ""} {
	foreach loc $loclist {
	    if {[dict exists $Msgs $nscur $loc $src]} {
		return [DefaultUnknown "" [dict get $Msgs $nscur $loc $src]\
			{*}$args]
	    }
	}
	set nscur [namespace parent $nscur]
    }
    # call package local or default unknown command
    set args [linsert $args 0 [lindex $loclist 0] $src]
    switch -exact -- [Invoke unknowncmd $args $ns result 1] {
	0 { return [uplevel 1 [linsert $args 0 [namespace origin mcunknown]]] }
	0 { tailcall mcunknown {*}$args }
	1 { return [DefaultUnknown {*}$args] }
	default { return $result }
    }
}

# msgcat::mcexists --
#
241
242
243
244
245
246
247
248
249
250
251
252
253

254
255







256
257
258
259
260

261
262
263
264
265





266
267
268
269
270
271
272

273
274
275
276
277
278
279
268
269
270
271
272
273
274



275
276
277
278


279
280
281
282
283
284
285
286
287
288
289

290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306

307
308
309
310
311
312
313
314







-
-
-



+
-
-
+
+
+
+
+
+
+




-
+





+
+
+
+
+






-
+








proc msgcat::mcexists {args} {

    variable Msgs
    variable Loclist
    variable PackageConfig

    set ns [uplevel 1 [list ::namespace current]]
    set loclist [PackagePreferences $ns]

    while {[llength $args] != 1} {
	set args [lassign $args option]
	switch -glob -- $option {
	    -exactnamespace - -exactlocale { set $option 1 }
	    -exactnamespace { set exactnamespace 1 }
	    -exactlocale { set loclist [lrange $loclist 0 0] }
	    -namespace {
		if {[llength $args] < 2} {
		    return -code error\
			    "Argument missing for switch \"-namespace\""
		}
		set args [lassign $args ns]
	    }
	    -* { return -code error "unknown option \"$option\"" }
	    default {
		return -code error "wrong # args: should be\
			\"[lindex [info level 0] 0] ?-exactnamespace?\
			?-exactlocale? src\""
			?-exactlocale? ?-namespace ns? src\""
	    }
	}
    }
    set src [lindex $args 0]

    if {![info exists ns]} { set ns [PackageNamespaceGet] }

    set loclist [PackagePreferences $ns]
    if {[info exists -exactlocale]} { set loclist [lrange $loclist 0 0] }

    while {$ns ne ""} {
	foreach loc $loclist {
	    if {[dict exists $Msgs $ns $loc $src]} {
		return 1
	    }
	}
	if {[info exists exactnamespace]} {return 0}
	if {[info exists -exactnamespace]} {return 0}
	set ns [namespace parent $ns]
    }
    return 0
}

# msgcat::mclocale --
#
299
300
301
302
303
304
305
306
307
308

309
310
311
312
313
314
315
316
317
318

319
320
321
322
323


324
325
326
327
328
329
330
331

332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352

353
354
355
356
357

358












359
360























361
362
363
364
365
366
367
334
335
336
337
338
339
340



341





342
343
344
345

346
347
348
349
350
351
352
353
354
355
356
357
358
359
360

361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381

382
383
384
385
386

387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432







-
-
-
+
-
-
-
-
-




-
+





+
+







-
+




















-
+




-
+

+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    if {$len == 1} {
	set newLocale [string tolower [lindex $args 0]]
	if {$newLocale ne [file tail $newLocale]} {
	    return -code error "invalid newLocale value \"$newLocale\":\
		    could be path to unsafe code."
	}
	if {[lindex $Loclist 0] ne $newLocale} {
	    set Loclist [GetPreferences $newLocale]

	mcpreferences {*}[mcutil getpreferences $newLocale]
	    # locale not loaded jet
	    LoadAll $Loclist
	    # Invoke callback
	    Invoke changecmd $Loclist
	}
    }
    return [lindex $Loclist 0]
}

# msgcat::GetPreferences --
# msgcat::mcutil::getpreferences --
#
#	Get list of locales from a locale.
#	The first element is always the lowercase locale.
#	Other elements have one component separated by "_" less.
#	Multiple "_" are seen as one separator: de__ch_spec de__ch de {}
#
#	This method is part of the ensemble mcutil
#
# Arguments:
#	Locale.
#
# Results:
#	Locale list

proc msgcat::GetPreferences {locale} {
proc msgcat::mcutil::getpreferences {locale} {
    set locale [string tolower $locale]
    set loclist [list $locale]
    while {-1 !=[set pos [string last "_" $locale]]} {
	set locale [string range $locale 0 $pos-1]
	if { "_" ne [string index $locale end] } {
	    lappend loclist $locale
	}
    }
    if {"" ne [lindex $loclist end]} {
	lappend loclist {}
    }
    return $loclist
}

# msgcat::mcpreferences --
#
#	Fetch the list of locales used to look up strings, ordered from
#	most preferred to least preferred.
#
# Arguments:
#	None.
#	New location list
#
# Results:
#	Returns an ordered list of the locales preferred by the user.

proc msgcat::mcpreferences {} {
proc msgcat::mcpreferences {args} {
    variable Loclist

    if {[llength $args] > 0} {
	# args is the new loclist
	if {![ListEqualString $args $Loclist]} {
	    set Loclist $args

	    # locale not loaded jet
	    LoadAll $Loclist
	    # Invoke callback
	    Invoke changecmd $Loclist
	}
    }
    return $Loclist
}

# msgcat::ListStringEqual --
#
#	Compare two strings for equal string contents
#
# Arguments:
#	list1		first list
#	list2		second list
#
# Results:
#	1 if lists of strings are identical, 0 otherwise

proc msgcat::ListEqualString {list1 list2} {
    if {[llength $list1] != [llength $list2]} {
	return 0
    }
    foreach item1 $list1 item2 $list2 {
	if {$item1 ne $item2} {
	    return 0
	}
    }
    return 1
}

# msgcat::mcloadedlocales --
#
#	Get or change the list of currently loaded default locales
#
#	The following subcommands are available:
#	loaded
438
439
440
441
442
443
444
445

446
447
448
449
450
451
452
453

454
455
456
457
458
459
460
461
462




463
464
465

466
467
468
469
470






471


472

473













474
475
476
477
478
479
480















481
482
483
484
485
486









487
488
489
490
491
492
493
494
495
496
497
498



499

500
501
502
503
504
505
506
503
504
505
506
507
508
509

510
511
512
513
514
515
516
517

518









519
520
521
522



523
524
525
526

527
528
529
530
531
532
533

534
535
536
537

538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572






573
574
575
576
577
578
579
580
581
582


583
584
585
586

587
588
589
590
591
592
593

594
595
596
597
598
599
600
601







-
+







-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
+



-

+
+
+
+
+
+
-
+
+

+
-
+
+
+
+
+
+
+
+
+
+
+
+
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-




-




+
+
+
-
+







# Arguments:
#	subcommand		see list above
#	locale			package locale (only set subcommand)
#
# Results:
#	Empty string, if not stated differently for the subcommand

proc msgcat::mcpackagelocale {subcommand {locale ""}} {
proc msgcat::mcpackagelocale {subcommand args} {
    # todo: implement using an ensemble
    variable Loclist
    variable LoadedLocales
    variable Msgs
    variable PackageConfig
    # Check option
    # check if required item is exactly provided
    if {[llength [info level 0]] == 2} {
    if {    [llength $args] > 0
	# locale not given
	unset locale
    } else {
	# locale given
	if {$subcommand in
		{"get" "isset" "unset" "preferences" "loaded" "clear"} } {
	    return -code error "wrong # args: should be\
		    \"[lrange [info level 0] 0 1]\""
	}
	    && $subcommand in {"get" "isset" "unset" "loaded" "clear"} } {
	return -code error "wrong # args: should be\
		\"[lrange [info level 0] 0 1]\""
    }
        set locale [string tolower $locale]
    }
    set ns [uplevel 1 {::namespace current}]
    set ns [PackageNamespaceGet]

    switch -exact -- $subcommand {
	get { return [lindex [PackagePreferences $ns] 0] }
	preferences { return [PackagePreferences $ns] }
	loaded { return [PackageLocales $ns] }
	present {
	    if {[llength $args] != 1} {
		return -code error "wrong # args: should be\
			\"[lrange [info level 0] 0 1] locale\""
	    }
	    return [expr {[string tolower [lindex $args 0]]
	present { return [expr {$locale in [PackageLocales $ns]} ]}
		    in [PackageLocales $ns]} ]
	}
	isset { return [dict exists $PackageConfig loclist $ns] }
	set - preferences {
	set { # set a package locale or add a package locale
	    # set a package locale or add a package locale
	    set fSet [expr {$subcommand eq "set"}]

	    # Check parameter
	    if {$fSet && 1 < [llength $args] } {
		return -code error "wrong # args: should be\
			\"[lrange [info level 0] 0 1] ?locale?\""
	    }

	    # > Return preferences if no parameter
	    if {!$fSet && 0 == [llength $args] } {
		return [PackagePreferences $ns]
	    }

	    # Copy the default locale if no package locale set so far
	    if {![dict exists $PackageConfig loclist $ns]} {
		dict set PackageConfig loclist $ns $Loclist
		dict set PackageConfig loadedlocales $ns $LoadedLocales
	    }

	    # No argument for set: return current package locale
	    # The difference to no argument and subcommand "preferences" is,
	    # that "preferences" does not set the package locale property.
	    # This case is processed above, so no check for fSet here
	    if { 0 == [llength $args] } {
		return [lindex [dict get $PackageConfig loclist $ns] 0]
	    }

	    # Get new loclist
	    if {$fSet} {
		set loclist [mcutil getpreferences [lindex $args 0]]
	    } else {
		set loclist $args
	    }

	    # Check if changed
	    set loclist [dict get $PackageConfig loclist $ns]
	    if {! [info exists locale] || $locale eq [lindex $loclist 0] } {
		return [lindex $loclist 0]
	    }

	    # Check if not changed to return imediately
	    if {    [ListEqualString $loclist\
			[dict get $PackageConfig loclist $ns]] } {
		if {$fSet} {
		    return [lindex $loclist 0]
		}
		return $loclist
	    }

	    # Change loclist
	    set loclist [GetPreferences $locale]
	    set locale [lindex $loclist 0]
	    dict set PackageConfig loclist $ns $loclist

	    # load eventual missing locales
	    set loadedLocales [dict get $PackageConfig loadedlocales $ns]
	    if {$locale in $loadedLocales} { return $locale }
	    set loadLocales [ListComplement $loadedLocales $loclist]
	    dict set PackageConfig loadedlocales $ns\
		    [concat $loadedLocales $loadLocales]
	    Load $ns $loadLocales
	    if {$fSet} {
		return [lindex $loclist 0]
	    }
	    return $locale
	    return $loclist
	}
	clear { # Remove all locales not contained in Loclist
	    if {![dict exists $PackageConfig loclist $ns]} {
		return -code error "clear only when package locale set"
	    }
	    set loclist [dict get $PackageConfig loclist $ns]
	    dict set PackageConfig loadedlocales $ns $loclist
547
548
549
550
551
552
553
554

555
556
557
558
559
560
561
562









563
564
565
566
567
568
569
642
643
644
645
646
647
648

649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673







-
+








+
+
+
+
+
+
+
+
+







#	Remove any data of the calling package from msgcat
#

proc msgcat::mcforgetpackage {} {
    # todo: this may be implemented using an ensemble
    variable PackageConfig
    variable Msgs
    set ns [uplevel 1 {::namespace current}]
    set ns [PackageNamespaceGet]
    # Remove MC items
    dict unset Msgs $ns
    # Remove config items
    foreach key [dict keys $PackageConfig] {
	dict unset PackageConfig $key $ns
    }
    return
}

# msgcat::mcgetmynamespace --
#
#	Return the package namespace of the caller
#	This consideres to be called from a class or object.

proc msgcat::mcpackagenamespaceget {} {
    return [PackageNamespaceGet]
}

# msgcat::mcpackageconfig --
#
#	Get or modify the per caller namespace (e.g. packages) config options.
#
#	Available subcommands are:
#
612
613
614
615
616
617
618
619

620
621
622
623
624
625
626
716
717
718
719
720
721
722

723
724
725
726
727
728
729
730







-
+







#
# Results:
#	Depends on the subcommand and option and is described there

proc msgcat::mcpackageconfig {subcommand option {value ""}} {
    variable PackageConfig
    # get namespace
    set ns [uplevel 1 {::namespace current}]
    set ns [PackageNamespaceGet]

    if {$option ni {"mcfolder" "loadcmd" "changecmd" "unknowncmd"}} {
	return -code error "bad option \"$option\": must be mcfolder, loadcmd,\
		changecmd, or unknowncmd"
    }

    # check if value argument is exactly provided
752
753
754
755
756
757
758
759
760

761
762
763
764
765
766
767
856
857
858
859
860
861
862


863
864
865
866
867
868
869
870







-
-
+







# Arguments:
#	langdir		The directory to search.
#
# Results:
#	Returns the number of message catalogs that were loaded.

proc msgcat::mcload {langdir} {
    return [uplevel 1 [list\
	    [namespace origin mcpackageconfig] set mcfolder $langdir]]
    tailcall mcpackageconfig set mcfolder $langdir
}

# msgcat::LoadAll --
#
#	Load a list of locales for all packages not having a package locale
#	list.
#
919
920
921
922
923
924
925
926

927
928
929
930
931
932
933
1022
1023
1024
1025
1026
1027
1028

1029
1030
1031
1032
1033
1034
1035
1036







-
+








proc msgcat::mcset {locale src {dest ""}} {
    variable Msgs
    if {[llength [info level 0]] == 3} { ;# dest not specified
	set dest $src
    }

    set ns [uplevel 1 [list ::namespace current]]
    set ns [PackageNamespaceGet]

    set locale [string tolower $locale]

    dict set Msgs $ns $locale $src $dest
    return $dest
}

947
948
949
950
951
952
953
954

955
956
957
958
959
960
961
1050
1051
1052
1053
1054
1055
1056

1057
1058
1059
1060
1061
1062
1063
1064







-
+







    variable FileLocale
    variable Msgs

    if {![info exists FileLocale]} {
	return -code error "must only be used inside a message catalog loaded\
		with ::msgcat::mcload"
    }
    return [uplevel 1 [list [namespace origin mcset] $FileLocale $src $dest]]
    tailcall mcset $FileLocale $src $dest
}

# msgcat::mcmset --
#
#	Set the translation for multiple strings in a specified locale.
#
# Arguments:
971
972
973
974
975
976
977
978

979
980
981
982
983
984
985
1074
1075
1076
1077
1078
1079
1080

1081
1082
1083
1084
1085
1086
1087
1088







-
+







    set length [llength $pairs]
    if {$length % 2} {
	return -code error "bad translation list:\
		should be \"[lindex [info level 0] 0] locale {src dest ...}\""
    }

    set locale [string tolower $locale]
    set ns [uplevel 1 [list ::namespace current]]
    set ns [PackageNamespaceGet]

    foreach {src dest} $pairs {
	dict set Msgs $ns $locale $src $dest
    }

    return [expr {$length / 2}]
}
998
999
1000
1001
1002
1003
1004
1005

1006
1007
1008
1009
1010
1011
1012
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114
1115







-
+







    variable FileLocale
    variable Msgs

    if {![info exists FileLocale]} {
	return -code error "must only be used inside a message catalog loaded\
		with ::msgcat::mcload"
    }
    return [uplevel 1 [list [namespace origin mcmset] $FileLocale $pairs]]
    tailcal mcmset $FileLocale $pairs
}

# msgcat::mcunknown --
#
#	This routine is called by msgcat::mc if a translation cannot
#	be found for a string and no unknowncmd is set for the current
#	package. This routine is intended to be replaced
1020
1021
1022
1023
1024
1025
1026
1027

1028
1029
1030
1031
1032
1033
1034
1123
1124
1125
1126
1127
1128
1129

1130
1131
1132
1133
1134
1135
1136
1137







-
+







#	src		The string to be translated.
#	args		Args to pass to the format command
#
# Results:
#	Returns the translated value.

proc msgcat::mcunknown {args} {
    return [uplevel 1 [list [namespace origin DefaultUnknown] {*}$args]]
    tailcall DefaultUnknown {*}$args
}

# msgcat::DefaultUnknown --
#
#	This routine is called by msgcat::mc if a translation cannot
#	be found for a string in the following circumstances:
#	- Default global handler, if mcunknown is not redefined.
1063
1064
1065
1066
1067
1068
1069

1070
1071

1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082

1083
1084
1085
1086
1087
1088
1089
1166
1167
1168
1169
1170
1171
1172
1173
1174

1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185

1186
1187
1188
1189
1190
1191
1192
1193







+

-
+










-
+







#	args	strings to translate.
#
# Results:
#	Returns the length of the longest translated string.

proc msgcat::mcmax {args} {
    set max 0
    set ns [PackageNamespaceGet]
    foreach string $args {
	set translated [uplevel 1 [list [namespace origin mc] $string]]
	set translated [uplevel 1 [list [namespace origin mcn] $ns $string]]
	set len [string length $translated]
	if {$len>$max} {
	    set max $len
	}
    }
    return $max
}

# Convert the locale values stored in environment variables to a form
# suitable for passing to [mclocale]
proc msgcat::ConvertLocale {value} {
proc msgcat::mcutil::ConvertLocale {value} {
    # Assume $value is of form: $language[_$territory][.$codeset][@modifier]
    # Convert to form: $language[_$territory][_$modifier]
    #
    # Comment out expanded RE version -- bugs alleged
    # regexp -expanded {
    #	^		# Match all the way to the beginning
    #	([^_.@]*)	# Match "lanugage"; ends with _, ., or @
1101
1102
1103
1104
1105
1106
1107
1108
































1109
1110

1111
1112
1113
1114
1115
1116
1117
1118
1119

1120
1121

1122
1123
1124
1125
1126
1127
1128
1129
1130

1131
1132

1133
1134
1135
1136
1137
1138
1139
1140
1141
1142

1143
1144
1145
1146
1147
1148
1149
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245

1246
1247
1248
1249
1250
1251
1252
1253


1254


1255
1256
1257
1258
1259
1260
1261
1262


1263


1264
1265
1266
1267
1268
1269
1270
1271
1272


1273
1274
1275
1276
1277
1278
1279
1280








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+







-
-
+
-
-
+







-
-
+
-
-
+








-
-
+







	append ret _$territory
    }
    if {[string length $modifier]} {
	append ret _$modifier
    }
    return $ret
}

# helper function to find package namespace of stack-frame -2
# There are 4 possibilities:
# - called from a proc
# - called within a class definition script
# - called from an class defined oo object
# - called from a classless oo object
proc ::msgcat::PackageNamespaceGet {} {
    uplevel 2 {
	# Check self namespace to determine environment
	switch -exact -- [namespace which self] {
	    {::oo::define::self} {
		# We are within a class definition
		return [namespace qualifiers [self]]
	    }
	    {::oo::Helpers::self} {
		# We are within an object
		set Class [info object class [self]]
		# Check for classless defined object
		if {$Class eq {::oo::object}} {
		    return [namespace qualifiers [self]]
		}
		# Class defined object
		return [namespace qualifiers $Class]
	    }
	    default {
		# Not in object environment
		return [namespace current]
	    }
	}
    }
}

# Initialize the default locale
proc msgcat::Init {} {
proc msgcat::mcutil::getsystemlocale {} {
    global env

    #
    # set default locale, try to get from environment
    #
    foreach varName {LC_ALL LC_MESSAGES LANG} {
	if {[info exists env($varName)] && ("" ne $env($varName))} {
	    if {![catch {
		mclocale [ConvertLocale $env($varName)]
	    if {![catch { ConvertLocale $env($varName) } locale]} {
	    }]} {
		return
		return $locale
	    }
	}
    }
    #
    # On Darwin, fallback to current CFLocale identifier if available.
    #
    if {[info exists ::tcl::mac::locale] && $::tcl::mac::locale ne ""} {
	if {![catch {
	    mclocale [ConvertLocale $::tcl::mac::locale]
	if {![catch { ConvertLocale $::tcl::mac::locale } locale]} {
	}]} {
	    return
	    return $locale
	}
    }
    #
    # The rest of this routine is special processing for Windows or
    # Cygwin. All other platforms, get out now.
    #
    if {([info sharedlibextension] ne ".dll")
	    || [catch {package require registry}]} {
	mclocale C
	return
	return C
    }
    #
    # On Windows or Cygwin, try to set locale depending on registry
    # settings, or fall back on locale of "C".
    #

    # On Vista and later:
1166
1167
1168
1169
1170
1171
1172
1173
1174


1175
1176
1177
1178
1179
1180
1181
1182
1183
1184

1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201



1202
1203
1204
1205
1206
1207
1208

1209
1210

1297
1298
1299
1300
1301
1302
1303


1304
1305
1306
1307
1308
1309
1310
1311
1312
1313


1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328



1329
1330
1331
1332
1333
1334
1335
1336
1337

1338
1339

1340







-
-
+
+








-
-
+














-
-
-
+
+
+






-
+

-
+
	    if {"" ne $territory} {
		append locale _ $territory
	    }
	    set modifierDict [dict create latn latin cyrl cyrillic]
	    if {[dict exists $modifierDict $script]} {
		append locale @ [dict get $modifierDict $script]
	    }
	    if {![catch {mclocale [ConvertLocale $locale]}]} {
		return
	    if {![catch {ConvertLocale $locale} locale]} {
		return $locale
	    }
	}
    }

    # then check value locale which contains a numerical language ID
    if {[catch {
	set locale [registry get $key "locale"]
    }]} {
	mclocale C
	return
	return C
    }
    #
    # Keep trying to match against smaller and smaller suffixes
    # of the registry value, since the latter hexadigits appear
    # to determine general language and earlier hexadigits determine
    # more precise information, such as territory.  For example,
    #     0409 - English - United States
    #     0809 - English - United Kingdom
    # Add more translations to the WinRegToISO639 array above.
    #
    variable WinRegToISO639
    set locale [string tolower $locale]
    while {[string length $locale]} {
	if {![catch {
	    mclocale [ConvertLocale [dict get $WinRegToISO639 $locale]]
	}]} {
	    return
	    ConvertLocale [dict get $WinRegToISO639 $locale]
	} localeOut]} {
	    return $localeOut
	}
	set locale [string range $locale 1 end]
    }
    #
    # No translation known.  Fall back on "C" locale
    #
    mclocale C
    return C
}
msgcat::Init
msgcat::mclocale [msgcat::mcutil getsystemlocale]

Changes to library/msgcat/pkgIndex.tcl.

1
2




1
2
-
-
+
+
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
package ifneeded msgcat 1.6.1 [list source [file join $dir msgcat.tcl]]
if {![package vsatisfies [package provide Tcl] 8.7-]} {return}
package ifneeded msgcat 1.7.0 [list source [file join $dir msgcat.tcl]]

Changes to library/reg/pkgIndex.tcl.

1
2
3
4

5
6
7

8
9
1
2
3

4
5
6

7
8
9



-
+


-
+


if {([info commands ::tcl::pkgconfig] eq "")
	|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded registry 1.3.2 \
    package ifneeded registry 1.3.3 \
            [list load [file join $dir tclreg13g.dll] registry]
} else {
    package ifneeded registry 1.3.2 \
    package ifneeded registry 1.3.3 \
            [list load [file join $dir tclreg13.dll] registry]
}

Changes to library/safe.tcl.

109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
109
110
111
112
113
114
115

116
117
118
119
120
121
122
123







-
+







# -> TODO (the app should share or access easily the program/value stored
# by opt)

# This is even more complicated by the boolean flags with no values that
# we had the bad idea to support for the sake of user simplicity in
# create/init but which makes life hard in configure...
# So this will be hopefully written and some integrated with opt1.0
# (hopefully for tcl9.0 ?)
# (hopefully for tcl8.1 ?)
proc ::safe::interpConfigure {args} {
    switch [llength $args] {
	1 {
	    # If we have exactly 1 argument the semantic is to return all
	    # the current configuration. We still call OptKeyParse though
	    # we know that "slave" is our given argument because it also
	    # checks for the "-help" option.
451
452
453
454
455
456
457
458
459
460
461
462
463







464
465
466
467
468
469
470
471
472
473
474
475



476
477
478
479
480



481
482
483
484
485
486
487


488
489
490
491
492
493
494
495
451
452
453
454
455
456
457

458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473

474
475
476
477



478
479
480





481
482
483

484





485
486

487
488
489
490
491
492
493







-





+
+
+
+
+
+
+




-




-
-
-
+
+
+
-
-
-
-
-
+
+
+
-

-
-
-
-
-
+
+
-







    # Handling Tcl Modules, we need a restricted form of Glob.
    # This alias interposes on the 'exit' command and cleanly terminates
    # the slave.

    foreach {command alias} {
	source   AliasSource
	load     AliasLoad
	encoding AliasEncoding
	exit     interpDelete
	glob     AliasGlob
    } {
	::interp alias $slave $command {} [namespace current]::$alias $slave
    }

    # UGLY POINT! These commands are safe (they're ensembles with unsafe
    # subcommands), but is assumed to not be by existing policies so it is
    # hidden by default. Hack it...
    foreach command {encoding file} {
	::interp alias $slave $command {} interp invokehidden $slave $command
    }

    # This alias lets the slave have access to a subset of the 'file'
    # command functionality.

    ::interp expose $slave file
    foreach subcommand {dirname extension rootname tail} {
	::interp alias $slave ::tcl::file::$subcommand {} \
	    ::safe::AliasFileSubcommand $slave $subcommand
    }
    foreach subcommand {
	atime attributes copy delete executable exists isdirectory isfile
	link lstat mtime mkdir nativename normalize owned readable readlink

    # Subcommand of 'encoding' that has special handling; [encoding system] is
    # OK provided it has no other arguments passed to it.
	rename size stat tempfile type volumes writable
    } {
	::interp alias $slave ::tcl::file::$subcommand {} \
	    ::safe::BadSubcommand $slave file $subcommand
    }
    ::interp alias $slave ::tcl::encoding::system {} \
	::safe::AliasEncodingSystem $slave


    # Subcommands of info
    foreach {subcommand alias} {
	nameofexecutable   AliasExeName
    } {
	::interp alias $slave ::tcl::info::$subcommand \
	    {} [namespace current]::$alias $slave
    ::interp alias $slave ::tcl::info::nameofexecutable {} \
	::safe::AliasExeName $slave
    }

    # The allowed slave variables already have been set by Tcl_MakeSafe(3)

    # Source init.tcl and tm.tcl into the slave, to get auto_load and
    # other procedures defined:

    if {[catch {::interp eval $slave {
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032



1033
1034
1035
1036
1037
1038
1039



1040
1041
1042
1043
1044
1045
1046
1047

1048
1049
1050
1051
1052
1053
1054
1021
1022
1023
1024
1025
1026
1027



1028
1029
1030


1031




1032
1033
1034
1035
1036
1037
1038
1039
1040
1041

1042
1043
1044
1045
1046
1047
1048
1049







-
-
-
+
+
+
-
-

-
-
-
-
+
+
+







-
+








proc ::safe::BadSubcommand {slave command subcommand args} {
    set msg "not allowed to invoke subcommand $subcommand of $command"
    Log $slave $msg
    return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
}

# AliasEncoding is the target of the "encoding" alias in safe interpreters.

proc ::safe::AliasEncoding {slave option args} {
# AliasEncodingSystem is the target of the "encoding system" alias in safe
# interpreters.
proc ::safe::AliasEncodingSystem {slave args} {
    # Note that [encoding dirs] is not supported in safe slaves at all
    set subcommands {convertfrom convertto names system}
    try {
	set option [tcl::prefix match -error [list -level 1 -errorcode \
		[list TCL LOOKUP INDEX option $option]] $subcommands $option]
	# Special case: [encoding system] ok, but [encoding system foo] not
	if {$option eq "system" && [llength $args]} {
	# Must not pass extra arguments; safe slaves may not set the system
	# encoding but they may read it.
	if {[llength $args]} {
	    return -code error -errorcode {TCL WRONGARGS} \
		"wrong # args: should be \"encoding system\""
	}
    } on error {msg options} {
	Log $slave $msg
	return -options $options $msg
    }
    tailcall ::interp invokehidden $slave encoding $option {*}$args
    tailcall ::interp invokehidden $slave tcl:encoding:system
}

# Various minor hiding of platform features. [Bug 2913625]

proc ::safe::AliasExeName {slave} {
    return ""
}

Changes to library/tcltest/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
11
12

1
2
3
4
5
6
7
8
9
10
11

12











-
+
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex -direct" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
package ifneeded tcltest 2.4.1 [list source [file join $dir tcltest.tcl]]
package ifneeded tcltest 2.5.0 [list source [file join $dir tcltest.tcl]]

Changes to library/tcltest/tcltest.tcl.

18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32







-
+








package require Tcl 8.5-		;# -verbose line uses [info frame]
namespace eval tcltest {

    # When the version number changes, be sure to update the pkgIndex.tcl file,
    # and the install directory in the Makefiles.  When the minor version
    # changes (new feature) be sure to update the man page as well.
    variable Version 2.4.1
    variable Version 2.5.0

    # Compatibility support for dumb variables defined in tcltest 1
    # Do not use these.  Call [package provide Tcl] and [info patchlevel]
    # yourself.  You don't need tcltest to wrap it for you.
    variable version [package provide Tcl]
    variable patchLevel [info patchlevel]

1837
1838
1839
1840
1841
1842
1843



1844
1845
1846
1847
1848
1849
1850
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853







+
+
+







#                       optional; default is {}.
#   output -            Expected output sent to stdout.  This attribute
#                       is optional; default is {}.
#   errorOutput -       Expected output sent to stderr.  This attribute
#                       is optional; default is {}.
#   returnCodes -       Expected return codes.  This attribute is
#                       optional; default is {0 2}.
#   errorCode -         Expected error code.  This attribute is
#                       optional; default is {*}. It is a glob pattern.
#                       If given, returnCodes defaults to {1}.
#   setup -             Code to run before $script (above).  This
#                       attribute is optional; default is {}.
#   cleanup -           Code to run after $script (above).  This
#                       attribute is optional; default is {}.
#   match -             specifies type of matching to do on result,
#                       output, errorOutput; this must be a string
#			previously registered by a call to [customMatch].
1878
1879
1880
1881
1882
1883
1884
1885

1886
1887
1888
1889
1890
1891
1892
1893



1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904

1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915

1916
1917
1918
1919
1920
1921
1922
1881
1882
1883
1884
1885
1886
1887

1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909

1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920

1921
1922
1923
1924
1925
1926
1927
1928







-
+








+
+
+










-
+










-
+








    FillFilesExisted
    incr testLevel

    # Pre-define everything to null except output and errorOutput.  We
    # determine whether or not to trap output based on whether or not
    # these variables (output & errorOutput) are defined.
    lassign {} constraints setup cleanup body result returnCodes match
    lassign {} constraints setup cleanup body result returnCodes errorCode match

    # Set the default match mode
    set match exact

    # Set the default match values for return codes (0 is the standard
    # expected return value if everything went well; 2 represents
    # 'return' being used in the test script).
    set returnCodes [list 0 2]

    # Set the default error code pattern
    set errorCode "*"

    # The old test format can't have a 3rd argument (constraints or
    # script) that starts with '-'.
    if {[string match -* [lindex $args 0]] || ([llength $args] <= 1)} {
	if {[llength $args] == 1} {
	    set list [SubstArguments [lindex $args 0]]
	    foreach {element value} $list {
		set testAttributes($element) $value
	    }
	    foreach item {constraints match setup body cleanup \
		    result returnCodes output errorOutput} {
		    result returnCodes errorCode output errorOutput} {
		if {[info exists testAttributes(-$item)]} {
		    set testAttributes(-$item) [uplevel 1 \
			    ::concat $testAttributes(-$item)]
		}
	    }
	} else {
	    array set testAttributes $args
	}

	set validFlags {-setup -cleanup -body -result -returnCodes \
		-match -output -errorOutput -constraints}
		-errorCode -match -output -errorOutput -constraints}

	foreach flag [array names testAttributes] {
	    if {$flag ni $validFlags} {
		incr testLevel -1
		set sorted [lsort $validFlags]
		set options [join [lrange $sorted 0 end-1] ", "]
		append options ", or [lindex $sorted end]"
1940
1941
1942
1943
1944
1945
1946




1947
1948
1949
1950
1951
1952
1953
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963







+
+
+
+







		    must be $values"
	}

	# Replace symbolic valies supplied for -returnCodes
	foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} {
	    set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes]
	}
        # errorCode without returnCode 1 is meaningless
        if {$errorCode ne "*" && 1 ni $returnCodes} {
            set returnCodes 1
        }
    } else {
	# This is parsing for the old test command format; it is here
	# for backward compatibility.
	set result [lindex $args end]
	if {[llength $args] == 2} {
	    set body [lindex $args 0]
	} elseif {[llength $args] == 3} {
1972
1973
1974
1975
1976
1977
1978
1979

1980
1981
1982
1983
1984
1985
1986
1982
1983
1984
1985
1986
1987
1988

1989
1990
1991
1992
1993
1994
1995
1996







-
+







	}
    }

    # First, run the setup script
    set code [catch {uplevel 1 $setup} setupMsg]
    if {$code == 1} {
	set errorInfo(setup) $::errorInfo
	set errorCode(setup) $::errorCode
	set errorCodeRes(setup) $::errorCode
    }
    set setupFailure [expr {$code != 0}]

    # Only run the test body if the setup was successful
    if {!$setupFailure} {

	# Register startup time
1999
2000
2001
2002
2003
2004
2005
2006

2007
2008
2009
2010
2011
2012
2013





2014
2015
2016
2017
2018
2019
2020
2009
2010
2011
2012
2013
2014
2015

2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035







-
+







+
+
+
+
+







	    set testResult [uplevel 1 [list [namespace origin Eval] $command 0]]
	} else {
	    set testResult [uplevel 1 [list [namespace origin Eval] $command 1]]
	}
	lassign $testResult actualAnswer returnCode
	if {$returnCode == 1} {
	    set errorInfo(body) $::errorInfo
	    set errorCode(body) $::errorCode
	    set errorCodeRes(body) $::errorCode
	}
    }

    # check if the return code matched the expected return code
    set codeFailure 0
    if {!$setupFailure && ($returnCode ni $returnCodes)} {
	set codeFailure 1
    }
    set errorCodeFailure 0
    if {!$setupFailure && !$codeFailure && $returnCode == 1 && \
                ![string match $errorCode $errorCodeRes(body)]} {
	set errorCodeFailure 1
    }

    # If expected output/error strings exist, we have to compare
    # them.  If the comparison fails, then so did the test.
    set outputFailure 0
    variable outData
    if {[info exists output] && !$codeFailure} {
2051
2052
2053
2054
2055
2056
2057
2058

2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072

2073
2074
2075
2076
2077
2078
2079
2080







-
+







	set scriptFailure 1
    }

    # Always run the cleanup script
    set code [catch {uplevel 1 $cleanup} cleanupMsg]
    if {$code == 1} {
	set errorInfo(cleanup) $::errorInfo
	set errorCode(cleanup) $::errorCode
	set errorCodeRes(cleanup) $::errorCode
    }
    set cleanupFailure [expr {$code != 0}]

    set coreFailure 0
    set coreMsg ""
    # check for a core file first - if one was created by the test,
    # then the test failed
2102
2103
2104
2105
2106
2107
2108
2109

2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123

2124
2125
2126
2127
2128
2129
2130
2131







-
+







	}
    }

    # if we didn't experience any failures, then we passed
    variable numTests
    if {!($setupFailure || $cleanupFailure || $coreFailure
	    || $outputFailure || $errorFailure || $codeFailure
	    || $scriptFailure)} {
	    || $errorCodeFailure || $scriptFailure)} {
	if {$testLevel == 1} {
	    incr numTests(Passed)
	    if {[IsVerbose pass]} {
		puts [outputChannel] "++++ $name PASSED"
	    }
	}
	incr testLevel -1
2155
2156
2157
2158
2159
2160
2161
2162

2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173




2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189

2190
2191
2192
2193
2194
2195
2196
2170
2171
2172
2173
2174
2175
2176

2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207

2208
2209
2210
2211
2212
2213
2214
2215







-
+











+
+
+
+















-
+







	puts [outputChannel] $body
    }
    if {$setupFailure} {
	puts [outputChannel] "---- Test setup\
		failed:\n$setupMsg"
	if {[info exists errorInfo(setup)]} {
	    puts [outputChannel] "---- errorInfo(setup): $errorInfo(setup)"
	    puts [outputChannel] "---- errorCode(setup): $errorCode(setup)"
	    puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
	}
    }
    if {$scriptFailure} {
	if {$scriptCompare} {
	    puts [outputChannel] "---- Error testing result: $scriptMatch"
	} else {
	    puts [outputChannel] "---- Result was:\n$actualAnswer"
	    puts [outputChannel] "---- Result should have been\
		    ($match matching):\n$result"
	}
    }
    if {$errorCodeFailure} {
	puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'"
	puts [outputChannel] "---- Error code should have been: '$errorCode'"
    }
    if {$codeFailure} {
	switch -- $returnCode {
	    0 { set msg "Test completed normally" }
	    1 { set msg "Test generated error" }
	    2 { set msg "Test generated return exception" }
	    3 { set msg "Test generated break exception" }
	    4 { set msg "Test generated continue exception" }
	    default { set msg "Test generated exception" }
	}
	puts [outputChannel] "---- $msg; Return code was: $returnCode"
	puts [outputChannel] "---- Return code should have been\
		one of: $returnCodes"
	if {[IsVerbose error]} {
	    if {[info exists errorInfo(body)] && (1 ni $returnCodes)} {
		puts [outputChannel] "---- errorInfo: $errorInfo(body)"
		puts [outputChannel] "---- errorCode: $errorCode(body)"
		puts [outputChannel] "---- errorCode: $errorCodeRes(body)"
	    }
	}
    }
    if {$outputFailure} {
	if {$outputCompare} {
	    puts [outputChannel] "---- Error testing output: $outputMatch"
	} else {
2208
2209
2210
2211
2212
2213
2214
2215

2216
2217
2218
2219
2220
2221
2222
2227
2228
2229
2230
2231
2232
2233

2234
2235
2236
2237
2238
2239
2240
2241







-
+







		    been ($match matching):\n$errorOutput"
	}
    }
    if {$cleanupFailure} {
	puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg"
	if {[info exists errorInfo(cleanup)]} {
	    puts [outputChannel] "---- errorInfo(cleanup): $errorInfo(cleanup)"
	    puts [outputChannel] "---- errorCode(cleanup): $errorCode(cleanup)"
	    puts [outputChannel] "---- errorCode(cleanup): $errorCodeRes(cleanup)"
	}
    }
    if {$coreFailure} {
	puts [outputChannel] "---- Core file produced while running\
		test!  $coreMsg"
    }
    puts [outputChannel] "==== $name FAILED\n"
2718
2719
2720
2721
2722
2723
2724
2725

2726
2727
2728
2729
2730
2731
2732
2737
2738
2739
2740
2741
2742
2743

2744
2745
2746
2747
2748
2749
2750
2751







-
+







#	skip patterns provided.  after sourcing test files, it goes on
#	to source all.tcl files in matching test subdirectories.
#
# Arguments:
#	shell being tested
#
# Results:
#	None.
#	Whether there were any failures.
#
# Side effects:
#	None.

proc tcltest::runAllTests { {shell ""} } {
    variable testSingleFile
    variable numTestFiles
2864
2865
2866
2867
2868
2869
2870
2871

2872
2873
2874
2875
2876
2877
2878
2883
2884
2885
2886
2887
2888
2889

2890
2891
2892
2893
2894
2895
2896
2897







-
+







	uplevel 1 [list ::source [file join $directory all.tcl]]

	set endTime [eval $timeCmd]
	puts [outputChannel] "\n$dir test ended at $endTime"
	puts [outputChannel] ""
	puts [outputChannel] [string repeat ~ 44]
    }
    return
    return [info exists testFileFailures]
}

#####################################################################

# Test utility procs - not used in tcltest, but may be useful for
# testing.

Changes to library/tzdata/Africa/Accra.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51















































52
1
2
3
4















































5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Accra) {
    {-9223372036854775808 -52 0 LMT}
    {-1640995148 0 0 +0020}
    {-1556841600 1200 1 +0020}
    {-1546388400 0 0 +0020}
    {-1525305600 1200 1 +0020}
    {-1514852400 0 0 +0020}
    {-1493769600 1200 1 +0020}
    {-1483316400 0 0 +0020}
    {-1462233600 1200 1 +0020}
    {-1451780400 0 0 +0020}
    {-1430611200 1200 1 +0020}
    {-1420158000 0 0 +0020}
    {-1399075200 1200 1 +0020}
    {-1388622000 0 0 +0020}
    {-1367539200 1200 1 +0020}
    {-1357086000 0 0 +0020}
    {-1336003200 1200 1 +0020}
    {-1325550000 0 0 +0020}
    {-1304380800 1200 1 +0020}
    {-1293927600 0 0 +0020}
    {-1272844800 1200 1 +0020}
    {-1262391600 0 0 +0020}
    {-1241308800 1200 1 +0020}
    {-1230855600 0 0 +0020}
    {-1209772800 1200 1 +0020}
    {-1199319600 0 0 +0020}
    {-1178150400 1200 1 +0020}
    {-1167697200 0 0 +0020}
    {-1146614400 1200 1 +0020}
    {-1136161200 0 0 +0020}
    {-1115078400 1200 1 +0020}
    {-1104625200 0 0 +0020}
    {-1083542400 1200 1 +0020}
    {-1073089200 0 0 +0020}
    {-1051920000 1200 1 +0020}
    {-1041466800 0 0 +0020}
    {-1020384000 1200 1 +0020}
    {-1009930800 0 0 +0020}
    {-988848000 1200 1 +0020}
    {-978394800 0 0 +0020}
    {-957312000 1200 1 +0020}
    {-946858800 0 0 +0020}
    {-925689600 1200 1 +0020}
    {-915236400 0 0 +0020}
    {-894153600 1200 1 +0020}
    {-883700400 0 0 +0020}
    {-862617600 1200 1 +0020}
    {-852164400 0 0 +0020}
    {-1640995148 0 0 GMT}
    {-1556841600 1200 1 GMT}
    {-1546388400 0 0 GMT}
    {-1525305600 1200 1 GMT}
    {-1514852400 0 0 GMT}
    {-1493769600 1200 1 GMT}
    {-1483316400 0 0 GMT}
    {-1462233600 1200 1 GMT}
    {-1451780400 0 0 GMT}
    {-1430611200 1200 1 GMT}
    {-1420158000 0 0 GMT}
    {-1399075200 1200 1 GMT}
    {-1388622000 0 0 GMT}
    {-1367539200 1200 1 GMT}
    {-1357086000 0 0 GMT}
    {-1336003200 1200 1 GMT}
    {-1325550000 0 0 GMT}
    {-1304380800 1200 1 GMT}
    {-1293927600 0 0 GMT}
    {-1272844800 1200 1 GMT}
    {-1262391600 0 0 GMT}
    {-1241308800 1200 1 GMT}
    {-1230855600 0 0 GMT}
    {-1209772800 1200 1 GMT}
    {-1199319600 0 0 GMT}
    {-1178150400 1200 1 GMT}
    {-1167697200 0 0 GMT}
    {-1146614400 1200 1 GMT}
    {-1136161200 0 0 GMT}
    {-1115078400 1200 1 GMT}
    {-1104625200 0 0 GMT}
    {-1083542400 1200 1 GMT}
    {-1073089200 0 0 GMT}
    {-1051920000 1200 1 GMT}
    {-1041466800 0 0 GMT}
    {-1020384000 1200 1 GMT}
    {-1009930800 0 0 GMT}
    {-988848000 1200 1 GMT}
    {-978394800 0 0 GMT}
    {-957312000 1200 1 GMT}
    {-946858800 0 0 GMT}
    {-925689600 1200 1 GMT}
    {-915236400 0 0 GMT}
    {-894153600 1200 1 GMT}
    {-883700400 0 0 GMT}
    {-862617600 1200 1 GMT}
    {-852164400 0 0 GMT}
}

Changes to library/tzdata/Africa/Bissau.

1
2
3
4
5

6
7
1
2
3
4

5
6
7




-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Bissau) {
    {-9223372036854775808 -3740 0 LMT}
    {-1830380260 -3600 0 -01}
    {-1830380400 -3600 0 -01}
    {157770000 0 0 GMT}
}

Changes to library/tzdata/Africa/Casablanca.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18














19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

62
63
64

65
66
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81
82
83


84
85
86

87
88
89
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
128
129
130
131
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
161





162
163
164
165
166



167
168
169
170
171
172
173
174
175
176




177
178
179

180
181
182
183
184
185
186
187
188



189
190
191

192
193
194
195
196

197
198
199
200
201
202
203

204
205
206
207
208
209
210



211
212

213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
1
2
3
4














5
6
7
8
9
10
11
12
13
14
15
16
17
18











































19



20









21










22
23



24













25









26
27
28








29
30
31
32



33



34





















35









36









37
38
39
40
41





42
43
44










45
46
47
48



49









50
51
52



53





54







55







56
57
58


59

















60




-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Casablanca) {
    {-9223372036854775808 -1820 0 LMT}
    {-1773012580 0 0 WET}
    {-956361600 3600 1 WEST}
    {-950490000 0 0 WET}
    {-942019200 3600 1 WEST}
    {-761187600 0 0 WET}
    {-617241600 3600 1 WEST}
    {-605149200 0 0 WET}
    {-81432000 3600 1 WEST}
    {-71110800 0 0 WET}
    {141264000 3600 1 WEST}
    {147222000 0 0 WET}
    {199756800 3600 1 WEST}
    {207702000 0 0 WET}
    {231292800 3600 1 WEST}
    {-1773012580 0 0 +00}
    {-956361600 3600 1 +00}
    {-950490000 0 0 +00}
    {-942019200 3600 1 +00}
    {-761187600 0 0 +00}
    {-617241600 3600 1 +00}
    {-605149200 0 0 +00}
    {-81432000 3600 1 +00}
    {-71110800 0 0 +00}
    {141264000 3600 1 +00}
    {147222000 0 0 +00}
    {199756800 3600 1 +00}
    {207702000 0 0 +00}
    {231292800 3600 1 +00}
    {244249200 0 0 WET}
    {265507200 3600 1 WEST}
    {271033200 0 0 WET}
    {448243200 3600 0 CET}
    {504918000 0 0 WET}
    {1212278400 3600 1 WEST}
    {1220223600 0 0 WET}
    {1243814400 3600 1 WEST}
    {1250809200 0 0 WET}
    {1272758400 3600 1 WEST}
    {1281222000 0 0 WET}
    {1301788800 3600 1 WEST}
    {1312066800 0 0 WET}
    {1335664800 3600 1 WEST}
    {1342749600 0 0 WET}
    {1345428000 3600 1 WEST}
    {1348970400 0 0 WET}
    {1367114400 3600 1 WEST}
    {1373162400 0 0 WET}
    {1376100000 3600 1 WEST}
    {1382839200 0 0 WET}
    {1396144800 3600 1 WEST}
    {1403920800 0 0 WET}
    {1406944800 3600 1 WEST}
    {1414288800 0 0 WET}
    {1427594400 3600 1 WEST}
    {1434247200 0 0 WET}
    {1437271200 3600 1 WEST}
    {1445738400 0 0 WET}
    {1459044000 3600 1 WEST}
    {1465092000 0 0 WET}
    {1468116000 3600 1 WEST}
    {1477792800 0 0 WET}
    {1490493600 3600 1 WEST}
    {1495332000 0 0 WET}
    {1498960800 3600 1 WEST}
    {1509242400 0 0 WET}
    {1521943200 3600 1 WEST}
    {1526176800 0 0 WET}
    {1529200800 3600 1 WEST}
    {1540692000 0 0 WET}
    {1553997600 3600 1 WEST}
    {1557021600 0 0 WET}
    {244249200 0 0 +00}
    {1560045600 3600 1 WEST}
    {1572141600 0 0 WET}
    {1585447200 3600 1 WEST}
    {265507200 3600 1 +00}
    {1587261600 0 0 WET}
    {1590285600 3600 1 WEST}
    {1603591200 0 0 WET}
    {1616896800 3600 1 WEST}
    {1618106400 0 0 WET}
    {1621130400 3600 1 WEST}
    {1635645600 0 0 WET}
    {1651975200 3600 1 WEST}
    {1667095200 0 0 WET}
    {271033200 0 0 +00}
    {1682215200 3600 1 WEST}
    {1698544800 0 0 WET}
    {1713060000 3600 1 WEST}
    {1729994400 0 0 WET}
    {1743904800 3600 1 WEST}
    {1761444000 0 0 WET}
    {1774749600 3600 1 WEST}
    {1792893600 0 0 WET}
    {1806199200 3600 1 WEST}
    {1824948000 0 0 WET}
    {448243200 3600 0 +01}
    {504918000 0 0 +00}
    {1837648800 3600 1 WEST}
    {1856397600 0 0 WET}
    {1869098400 3600 1 WEST}
    {1212278400 3600 1 +00}
    {1887847200 0 0 WET}
    {1901152800 3600 1 WEST}
    {1919296800 0 0 WET}
    {1932602400 3600 1 WEST}
    {1950746400 0 0 WET}
    {1964052000 3600 1 WEST}
    {1982800800 0 0 WET}
    {1995501600 3600 1 WEST}
    {2014250400 0 0 WET}
    {2026951200 3600 1 WEST}
    {2045700000 0 0 WET}
    {2058400800 3600 1 WEST}
    {2077149600 0 0 WET}
    {1220223600 0 0 +00}
    {2090455200 3600 1 WEST}
    {2107994400 0 0 WET}
    {2108602800 0 0 WET}
    {2121904800 3600 1 WEST}
    {2138234400 0 0 WET}
    {2140052400 0 0 WET}
    {2153354400 3600 1 WEST}
    {2172103200 0 0 WET}
    {2184804000 3600 1 WEST}
    {1243814400 3600 1 +00}
    {1250809200 0 0 +00}
    {1272758400 3600 1 +00}
    {2203552800 0 0 WET}
    {2216253600 3600 1 WEST}
    {2235002400 0 0 WET}
    {2248308000 3600 1 WEST}
    {2266452000 0 0 WET}
    {2279757600 3600 1 WEST}
    {2297901600 0 0 WET}
    {2311207200 3600 1 WEST}
    {1281222000 0 0 +00}
    {1301788800 3600 1 +00}
    {1312066800 0 0 +00}
    {1335664800 3600 1 +00}
    {2329351200 0 0 WET}
    {2342656800 3600 1 WEST}
    {2361405600 0 0 WET}
    {1342749600 0 0 +00}
    {2374106400 3600 1 WEST}
    {2392855200 0 0 WET}
    {2405556000 3600 1 WEST}
    {1345428000 3600 1 +00}
    {2424304800 0 0 WET}
    {2437610400 3600 1 WEST}
    {2455754400 0 0 WET}
    {2469060000 3600 1 WEST}
    {2487204000 0 0 WET}
    {2500509600 3600 1 WEST}
    {2519258400 0 0 WET}
    {2531959200 3600 1 WEST}
    {2550708000 0 0 WET}
    {2563408800 3600 1 WEST}
    {2582157600 0 0 WET}
    {2595463200 3600 1 WEST}
    {2613607200 0 0 WET}
    {2626912800 3600 1 WEST}
    {2645056800 0 0 WET}
    {2658362400 3600 1 WEST}
    {2676506400 0 0 WET}
    {2689812000 3600 1 WEST}
    {2708560800 0 0 WET}
    {2721261600 3600 1 WEST}
    {2740010400 0 0 WET}
    {1348970400 0 0 +00}
    {2752711200 3600 1 WEST}
    {2771460000 0 0 WET}
    {2784765600 3600 1 WEST}
    {2802909600 0 0 WET}
    {2816215200 3600 1 WEST}
    {2834359200 0 0 WET}
    {2847664800 3600 1 WEST}
    {2866413600 0 0 WET}
    {2879114400 3600 1 WEST}
    {1367114400 3600 1 +00}
    {2897863200 0 0 WET}
    {2910564000 3600 1 WEST}
    {2929312800 0 0 WET}
    {2942013600 3600 1 WEST}
    {2960762400 0 0 WET}
    {2974068000 3600 1 WEST}
    {2992212000 0 0 WET}
    {3005517600 3600 1 WEST}
    {3023661600 0 0 WET}
    {1373162400 0 0 +00}
    {1376100000 3600 1 +00}
    {1382839200 0 0 +00}
    {1396144800 3600 1 +00}
    {1403920800 0 0 +00}
    {3036967200 3600 1 WEST}
    {3055716000 0 0 WET}
    {3068416800 3600 1 WEST}
    {3087165600 0 0 WET}
    {3099866400 3600 1 WEST}
    {1406944800 3600 1 +00}
    {1414288800 0 0 +00}
    {1427594400 3600 1 +00}
    {3118615200 0 0 WET}
    {3131920800 3600 1 WEST}
    {3150064800 0 0 WET}
    {3163370400 3600 1 WEST}
    {3181514400 0 0 WET}
    {3194820000 3600 1 WEST}
    {3212964000 0 0 WET}
    {3226269600 3600 1 WEST}
    {3245018400 0 0 WET}
    {3257719200 3600 1 WEST}
    {1434247200 0 0 +00}
    {1437271200 3600 1 +00}
    {1445738400 0 0 +00}
    {1459044000 3600 1 +00}
    {3276468000 0 0 WET}
    {3289168800 3600 1 WEST}
    {3307917600 0 0 WET}
    {1465092000 0 0 +00}
    {3321223200 3600 1 WEST}
    {3339367200 0 0 WET}
    {3352672800 3600 1 WEST}
    {3370816800 0 0 WET}
    {3384122400 3600 1 WEST}
    {3402871200 0 0 WET}
    {3415572000 3600 1 WEST}
    {3434320800 0 0 WET}
    {3447021600 3600 1 WEST}
    {1468116000 3600 1 +00}
    {1477792800 0 0 +00}
    {1490493600 3600 1 +00}
    {3465770400 0 0 WET}
    {3479076000 3600 1 WEST}
    {3497220000 0 0 WET}
    {1495332000 0 0 +00}
    {3510525600 3600 1 WEST}
    {3528669600 0 0 WET}
    {3541975200 3600 1 WEST}
    {3560119200 0 0 WET}
    {3573424800 3600 1 WEST}
    {1498960800 3600 1 +00}
    {3592173600 0 0 WET}
    {3604874400 3600 1 WEST}
    {3623623200 0 0 WET}
    {3636324000 3600 1 WEST}
    {3655072800 0 0 WET}
    {3668378400 3600 1 WEST}
    {3686522400 0 0 WET}
    {1509242400 0 0 +00}
    {3699828000 3600 1 WEST}
    {3717972000 0 0 WET}
    {3731277600 3600 1 WEST}
    {3750026400 0 0 WET}
    {3762727200 3600 1 WEST}
    {3781476000 0 0 WET}
    {3794176800 3600 1 WEST}
    {1521943200 3600 1 +00}
    {1526176800 0 0 +00}
    {1529200800 3600 1 +00}
    {3812925600 0 0 WET}
    {3825626400 3600 1 WEST}
    {1540598400 3600 0 +01}
    {3844375200 0 0 WET}
    {3857680800 3600 1 WEST}
    {3875824800 0 0 WET}
    {3889130400 3600 1 WEST}
    {3907274400 0 0 WET}
    {3920580000 3600 1 WEST}
    {3939328800 0 0 WET}
    {3952029600 3600 1 WEST}
    {3970778400 0 0 WET}
    {3983479200 3600 1 WEST}
    {4002228000 0 0 WET}
    {4015533600 3600 1 WEST}
    {4033677600 0 0 WET}
    {4046983200 3600 1 WEST}
    {4065127200 0 0 WET}
    {4078432800 3600 1 WEST}
    {4096576800 0 0 WET}
}

Changes to library/tzdata/Africa/Ceuta.

11
12
13
14
15
16
17

18
19
20
21
22
23
24
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25







+







    {-1379293200 3600 1 WEST}
    {-1364774400 0 0 WET}
    {-1348448400 3600 1 WEST}
    {-1333324800 0 0 WET}
    {-1316390400 3600 1 WEST}
    {-1301270400 0 0 WET}
    {-1293840000 0 0 WET}
    {-94694400 0 0 WET}
    {-81432000 3600 1 WEST}
    {-71110800 0 0 WET}
    {141264000 3600 1 WEST}
    {147222000 0 0 WET}
    {199756800 3600 1 WEST}
    {207702000 0 0 WET}
    {231292800 3600 1 WEST}

Changes to library/tzdata/Africa/El_Aaiun.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16











17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
67
68

69
70
71
72
73

74
75
76
77
78

79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165


166
167
168

169
170
171
172
173
174
175
176
177



178
179
180

181
182
183
184
185

186
187
188
189
190
191
192

193
194
195
196
197
198
199



200
201

202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
1
2
3
4
5











6
7
8
9
10
11
12
13
14
15
16











































17









18





19





20












21
22
23
24





25




















26
27
























28
29





30













31
32
33
34
35








36
37



38









39
40
41



42





43







44







45
46
47


48

















49





-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/El_Aaiun) {
    {-9223372036854775808 -3168 0 LMT}
    {-1136070432 -3600 0 -01}
    {198291600 0 0 WET}
    {199756800 3600 1 WEST}
    {207702000 0 0 WET}
    {231292800 3600 1 WEST}
    {244249200 0 0 WET}
    {265507200 3600 1 WEST}
    {271033200 0 0 WET}
    {1212278400 3600 1 WEST}
    {1220223600 0 0 WET}
    {1243814400 3600 1 WEST}
    {1250809200 0 0 WET}
    {198291600 0 0 +00}
    {199756800 3600 1 +00}
    {207702000 0 0 +00}
    {231292800 3600 1 +00}
    {244249200 0 0 +00}
    {265507200 3600 1 +00}
    {271033200 0 0 +00}
    {1212278400 3600 1 +00}
    {1220223600 0 0 +00}
    {1243814400 3600 1 +00}
    {1250809200 0 0 +00}
    {1272758400 3600 1 WEST}
    {1281222000 0 0 WET}
    {1301788800 3600 1 WEST}
    {1312066800 0 0 WET}
    {1335664800 3600 1 WEST}
    {1342749600 0 0 WET}
    {1345428000 3600 1 WEST}
    {1348970400 0 0 WET}
    {1367114400 3600 1 WEST}
    {1373162400 0 0 WET}
    {1376100000 3600 1 WEST}
    {1382839200 0 0 WET}
    {1396144800 3600 1 WEST}
    {1403920800 0 0 WET}
    {1406944800 3600 1 WEST}
    {1414288800 0 0 WET}
    {1427594400 3600 1 WEST}
    {1434247200 0 0 WET}
    {1437271200 3600 1 WEST}
    {1445738400 0 0 WET}
    {1459044000 3600 1 WEST}
    {1465092000 0 0 WET}
    {1468116000 3600 1 WEST}
    {1477792800 0 0 WET}
    {1490493600 3600 1 WEST}
    {1495332000 0 0 WET}
    {1498960800 3600 1 WEST}
    {1509242400 0 0 WET}
    {1521943200 3600 1 WEST}
    {1526176800 0 0 WET}
    {1529200800 3600 1 WEST}
    {1540692000 0 0 WET}
    {1553997600 3600 1 WEST}
    {1557021600 0 0 WET}
    {1560045600 3600 1 WEST}
    {1572141600 0 0 WET}
    {1585447200 3600 1 WEST}
    {1587261600 0 0 WET}
    {1590285600 3600 1 WEST}
    {1603591200 0 0 WET}
    {1616896800 3600 1 WEST}
    {1618106400 0 0 WET}
    {1621130400 3600 1 WEST}
    {1272758400 3600 1 +00}
    {1635645600 0 0 WET}
    {1651975200 3600 1 WEST}
    {1667095200 0 0 WET}
    {1682215200 3600 1 WEST}
    {1698544800 0 0 WET}
    {1713060000 3600 1 WEST}
    {1729994400 0 0 WET}
    {1743904800 3600 1 WEST}
    {1761444000 0 0 WET}
    {1281222000 0 0 +00}
    {1774749600 3600 1 WEST}
    {1792893600 0 0 WET}
    {1806199200 3600 1 WEST}
    {1824948000 0 0 WET}
    {1837648800 3600 1 WEST}
    {1301788800 3600 1 +00}
    {1856397600 0 0 WET}
    {1869098400 3600 1 WEST}
    {1887847200 0 0 WET}
    {1901152800 3600 1 WEST}
    {1919296800 0 0 WET}
    {1312066800 0 0 +00}
    {1932602400 3600 1 WEST}
    {1950746400 0 0 WET}
    {1964052000 3600 1 WEST}
    {1982800800 0 0 WET}
    {1995501600 3600 1 WEST}
    {2014250400 0 0 WET}
    {2026951200 3600 1 WEST}
    {2045700000 0 0 WET}
    {2058400800 3600 1 WEST}
    {2077149600 0 0 WET}
    {2090455200 3600 1 WEST}
    {2107994400 0 0 WET}
    {1335664800 3600 1 +00}
    {1342749600 0 0 +00}
    {1345428000 3600 1 +00}
    {1348970400 0 0 +00}
    {2108602800 0 0 WET}
    {2121904800 3600 1 WEST}
    {2138234400 0 0 WET}
    {2140052400 0 0 WET}
    {2153354400 3600 1 WEST}
    {1367114400 3600 1 +00}
    {2172103200 0 0 WET}
    {2184804000 3600 1 WEST}
    {2203552800 0 0 WET}
    {2216253600 3600 1 WEST}
    {2235002400 0 0 WET}
    {2248308000 3600 1 WEST}
    {2266452000 0 0 WET}
    {2279757600 3600 1 WEST}
    {2297901600 0 0 WET}
    {2311207200 3600 1 WEST}
    {2329351200 0 0 WET}
    {2342656800 3600 1 WEST}
    {2361405600 0 0 WET}
    {2374106400 3600 1 WEST}
    {2392855200 0 0 WET}
    {2405556000 3600 1 WEST}
    {2424304800 0 0 WET}
    {2437610400 3600 1 WEST}
    {2455754400 0 0 WET}
    {2469060000 3600 1 WEST}
    {1373162400 0 0 +00}
    {1376100000 3600 1 +00}
    {2487204000 0 0 WET}
    {2500509600 3600 1 WEST}
    {2519258400 0 0 WET}
    {2531959200 3600 1 WEST}
    {2550708000 0 0 WET}
    {2563408800 3600 1 WEST}
    {2582157600 0 0 WET}
    {2595463200 3600 1 WEST}
    {2613607200 0 0 WET}
    {2626912800 3600 1 WEST}
    {2645056800 0 0 WET}
    {2658362400 3600 1 WEST}
    {2676506400 0 0 WET}
    {2689812000 3600 1 WEST}
    {2708560800 0 0 WET}
    {2721261600 3600 1 WEST}
    {2740010400 0 0 WET}
    {2752711200 3600 1 WEST}
    {2771460000 0 0 WET}
    {2784765600 3600 1 WEST}
    {2802909600 0 0 WET}
    {2816215200 3600 1 WEST}
    {2834359200 0 0 WET}
    {2847664800 3600 1 WEST}
    {1382839200 0 0 +00}
    {1396144800 3600 1 +00}
    {2866413600 0 0 WET}
    {2879114400 3600 1 WEST}
    {2897863200 0 0 WET}
    {2910564000 3600 1 WEST}
    {2929312800 0 0 WET}
    {1403920800 0 0 +00}
    {2942013600 3600 1 WEST}
    {2960762400 0 0 WET}
    {2974068000 3600 1 WEST}
    {2992212000 0 0 WET}
    {3005517600 3600 1 WEST}
    {3023661600 0 0 WET}
    {3036967200 3600 1 WEST}
    {3055716000 0 0 WET}
    {3068416800 3600 1 WEST}
    {3087165600 0 0 WET}
    {3099866400 3600 1 WEST}
    {3118615200 0 0 WET}
    {3131920800 3600 1 WEST}
    {1406944800 3600 1 +00}
    {1414288800 0 0 +00}
    {1427594400 3600 1 +00}
    {1434247200 0 0 +00}
    {1437271200 3600 1 +00}
    {3150064800 0 0 WET}
    {3163370400 3600 1 WEST}
    {3181514400 0 0 WET}
    {3194820000 3600 1 WEST}
    {3212964000 0 0 WET}
    {3226269600 3600 1 WEST}
    {3245018400 0 0 WET}
    {3257719200 3600 1 WEST}
    {1445738400 0 0 +00}
    {1459044000 3600 1 +00}
    {3276468000 0 0 WET}
    {3289168800 3600 1 WEST}
    {3307917600 0 0 WET}
    {1465092000 0 0 +00}
    {3321223200 3600 1 WEST}
    {3339367200 0 0 WET}
    {3352672800 3600 1 WEST}
    {3370816800 0 0 WET}
    {3384122400 3600 1 WEST}
    {3402871200 0 0 WET}
    {3415572000 3600 1 WEST}
    {3434320800 0 0 WET}
    {3447021600 3600 1 WEST}
    {1468116000 3600 1 +00}
    {1477792800 0 0 +00}
    {1490493600 3600 1 +00}
    {3465770400 0 0 WET}
    {3479076000 3600 1 WEST}
    {3497220000 0 0 WET}
    {1495332000 0 0 +00}
    {3510525600 3600 1 WEST}
    {3528669600 0 0 WET}
    {3541975200 3600 1 WEST}
    {3560119200 0 0 WET}
    {3573424800 3600 1 WEST}
    {1498960800 3600 1 +00}
    {3592173600 0 0 WET}
    {3604874400 3600 1 WEST}
    {3623623200 0 0 WET}
    {3636324000 3600 1 WEST}
    {3655072800 0 0 WET}
    {3668378400 3600 1 WEST}
    {3686522400 0 0 WET}
    {1509242400 0 0 +00}
    {3699828000 3600 1 WEST}
    {3717972000 0 0 WET}
    {3731277600 3600 1 WEST}
    {3750026400 0 0 WET}
    {3762727200 3600 1 WEST}
    {3781476000 0 0 WET}
    {3794176800 3600 1 WEST}
    {1521943200 3600 1 +00}
    {1526176800 0 0 +00}
    {1529200800 3600 1 +00}
    {3812925600 0 0 WET}
    {3825626400 3600 1 WEST}
    {1540598400 3600 0 +01}
    {3844375200 0 0 WET}
    {3857680800 3600 1 WEST}
    {3875824800 0 0 WET}
    {3889130400 3600 1 WEST}
    {3907274400 0 0 WET}
    {3920580000 3600 1 WEST}
    {3939328800 0 0 WET}
    {3952029600 3600 1 WEST}
    {3970778400 0 0 WET}
    {3983479200 3600 1 WEST}
    {4002228000 0 0 WET}
    {4015533600 3600 1 WEST}
    {4033677600 0 0 WET}
    {4046983200 3600 1 WEST}
    {4065127200 0 0 WET}
    {4078432800 3600 1 WEST}
    {4096576800 0 0 WET}
}

Changes to library/tzdata/Africa/Sao_Tome.

1
2
3
4
5







1




2
3
4
5
6
7
8

-
-
-
-
+
+
+
+
+
+
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
    LoadTimeZoneFile Africa/Abidjan
}
set TZData(:Africa/Sao_Tome) $TZData(:Africa/Abidjan)

set TZData(:Africa/Sao_Tome) {
    {-9223372036854775808 1616 0 LMT}
    {-2713912016 -2205 0 LMT}
    {-1830384000 0 0 GMT}
    {1514768400 3600 0 WAT}
}

Changes to library/tzdata/Africa/Windhoek.

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57














































58
59
1
2
3
4
5
6
7
8
9

10















































11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58









-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Windhoek) {
    {-9223372036854775808 4104 0 LMT}
    {-2458170504 5400 0 +0130}
    {-2109288600 7200 0 SAST}
    {-860976000 10800 1 SAST}
    {-845254800 7200 0 SAST}
    {637970400 7200 0 CAT}
    {764200800 3600 0 WAT}
    {764200800 3600 1 WAT}
    {764204400 3600 0 WAT}
    {778640400 7200 1 WAST}
    {796780800 3600 0 WAT}
    {810090000 7200 1 WAST}
    {828835200 3600 0 WAT}
    {841539600 7200 1 WAST}
    {860284800 3600 0 WAT}
    {873594000 7200 1 WAST}
    {891734400 3600 0 WAT}
    {905043600 7200 1 WAST}
    {923184000 3600 0 WAT}
    {936493200 7200 1 WAST}
    {954633600 3600 0 WAT}
    {967942800 7200 1 WAST}
    {986083200 3600 0 WAT}
    {999392400 7200 1 WAST}
    {1018137600 3600 0 WAT}
    {1030842000 7200 1 WAST}
    {1049587200 3600 0 WAT}
    {1062896400 7200 1 WAST}
    {1081036800 3600 0 WAT}
    {1094346000 7200 1 WAST}
    {1112486400 3600 0 WAT}
    {1125795600 7200 1 WAST}
    {1143936000 3600 0 WAT}
    {1157245200 7200 1 WAST}
    {1175385600 3600 0 WAT}
    {1188694800 7200 1 WAST}
    {1207440000 3600 0 WAT}
    {1220749200 7200 1 WAST}
    {1238889600 3600 0 WAT}
    {1252198800 7200 1 WAST}
    {1270339200 3600 0 WAT}
    {1283648400 7200 1 WAST}
    {1301788800 3600 0 WAT}
    {1315098000 7200 1 WAST}
    {1333238400 3600 0 WAT}
    {1346547600 7200 1 WAST}
    {1365292800 3600 0 WAT}
    {1377997200 7200 1 WAST}
    {1396742400 3600 0 WAT}
    {1410051600 7200 1 WAST}
    {1428192000 3600 0 WAT}
    {1441501200 7200 1 WAST}
    {1459641600 3600 0 WAT}
    {1472950800 7200 1 WAST}
    {1491091200 3600 0 WAT}
    {778640400 7200 0 CAT}
    {796780800 3600 1 WAT}
    {810090000 7200 0 CAT}
    {828835200 3600 1 WAT}
    {841539600 7200 0 CAT}
    {860284800 3600 1 WAT}
    {873594000 7200 0 CAT}
    {891734400 3600 1 WAT}
    {905043600 7200 0 CAT}
    {923184000 3600 1 WAT}
    {936493200 7200 0 CAT}
    {954633600 3600 1 WAT}
    {967942800 7200 0 CAT}
    {986083200 3600 1 WAT}
    {999392400 7200 0 CAT}
    {1018137600 3600 1 WAT}
    {1030842000 7200 0 CAT}
    {1049587200 3600 1 WAT}
    {1062896400 7200 0 CAT}
    {1081036800 3600 1 WAT}
    {1094346000 7200 0 CAT}
    {1112486400 3600 1 WAT}
    {1125795600 7200 0 CAT}
    {1143936000 3600 1 WAT}
    {1157245200 7200 0 CAT}
    {1175385600 3600 1 WAT}
    {1188694800 7200 0 CAT}
    {1207440000 3600 1 WAT}
    {1220749200 7200 0 CAT}
    {1238889600 3600 1 WAT}
    {1252198800 7200 0 CAT}
    {1270339200 3600 1 WAT}
    {1283648400 7200 0 CAT}
    {1301788800 3600 1 WAT}
    {1315098000 7200 0 CAT}
    {1333238400 3600 1 WAT}
    {1346547600 7200 0 CAT}
    {1365292800 3600 1 WAT}
    {1377997200 7200 0 CAT}
    {1396742400 3600 1 WAT}
    {1410051600 7200 0 CAT}
    {1428192000 3600 1 WAT}
    {1441501200 7200 0 CAT}
    {1459641600 3600 1 WAT}
    {1472950800 7200 0 CAT}
    {1491091200 3600 1 WAT}
    {1504400400 7200 0 CAT}
}

Changes to library/tzdata/America/Araguaina.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38
39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56
57

58
59
60
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37
38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55
56

57
58
59
60





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Araguaina) {
    {-9223372036854775808 -11568 0 LMT}
    {-1767214032 -10800 0 -03}
    {-1206957600 -7200 1 -02}
    {-1206957600 -7200 1 -03}
    {-1191362400 -10800 0 -03}
    {-1175374800 -7200 1 -02}
    {-1175374800 -7200 1 -03}
    {-1159826400 -10800 0 -03}
    {-633819600 -7200 1 -02}
    {-633819600 -7200 1 -03}
    {-622069200 -10800 0 -03}
    {-602283600 -7200 1 -02}
    {-602283600 -7200 1 -03}
    {-591832800 -10800 0 -03}
    {-570747600 -7200 1 -02}
    {-570747600 -7200 1 -03}
    {-560210400 -10800 0 -03}
    {-539125200 -7200 1 -02}
    {-539125200 -7200 1 -03}
    {-531352800 -10800 0 -03}
    {-191365200 -7200 1 -02}
    {-191365200 -7200 1 -03}
    {-184197600 -10800 0 -03}
    {-155163600 -7200 1 -02}
    {-155163600 -7200 1 -03}
    {-150069600 -10800 0 -03}
    {-128898000 -7200 1 -02}
    {-128898000 -7200 1 -03}
    {-121125600 -10800 0 -03}
    {-99954000 -7200 1 -02}
    {-99954000 -7200 1 -03}
    {-89589600 -10800 0 -03}
    {-68418000 -7200 1 -02}
    {-68418000 -7200 1 -03}
    {-57967200 -10800 0 -03}
    {499748400 -7200 1 -02}
    {499748400 -7200 1 -03}
    {511236000 -10800 0 -03}
    {530593200 -7200 1 -02}
    {530593200 -7200 1 -03}
    {540266400 -10800 0 -03}
    {562129200 -7200 1 -02}
    {562129200 -7200 1 -03}
    {571197600 -10800 0 -03}
    {592974000 -7200 1 -02}
    {592974000 -7200 1 -03}
    {602042400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {634701600 -10800 0 -03}
    {653536800 -10800 0 -03}
    {811047600 -10800 0 -03}
    {813726000 -7200 1 -02}
    {813726000 -7200 1 -03}
    {824004000 -10800 0 -03}
    {844570800 -7200 1 -02}
    {844570800 -7200 1 -03}
    {856058400 -10800 0 -03}
    {876106800 -7200 1 -02}
    {876106800 -7200 1 -03}
    {888717600 -10800 0 -03}
    {908074800 -7200 1 -02}
    {908074800 -7200 1 -03}
    {919562400 -10800 0 -03}
    {938919600 -7200 1 -02}
    {938919600 -7200 1 -03}
    {951616800 -10800 0 -03}
    {970974000 -7200 1 -02}
    {970974000 -7200 1 -03}
    {982461600 -10800 0 -03}
    {1003028400 -7200 1 -02}
    {1003028400 -7200 1 -03}
    {1013911200 -10800 0 -03}
    {1036292400 -7200 1 -02}
    {1036292400 -7200 1 -03}
    {1045360800 -10800 0 -03}
    {1064368800 -10800 0 -03}
    {1350788400 -7200 0 -02}
    {1350788400 -7200 0 -03}
    {1361066400 -10800 0 -03}
    {1378000800 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/Buenos_Aires.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54

55
56

57
58

59
60
61

62
63

64
65

66
67
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53

54
55

56
57

58
59
60

61
62

63
64

65
66
67






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/Buenos_Aires) {
    {-9223372036854775808 -14028 0 LMT}
    {-2372097972 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {667965600 -10800 0 -03}
    {687927600 -7200 1 -02}
    {687927600 -7200 1 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224385200 -7200 1 -02}
    {1224385200 -7200 1 -03}
    {1237082400 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/Catamarca.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54

55
56

57
58

59
60
61

62
63
64
65

66
67
68
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53

54
55

56
57

58
59
60

61
62
63
64

65
66
67
68






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+


-
+



-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/Catamarca) {
    {-9223372036854775808 -15788 0 LMT}
    {-2372096212 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {667965600 -14400 0 -04}
    {687931200 -7200 0 -02}
    {687931200 -7200 0 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1086058800 -14400 0 -04}
    {1087704000 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224295200 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/Cordoba.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54

55
56

57
58

59
60
61

62
63

64
65

66
67
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53

54
55

56
57

58
59
60

61
62

63
64

65
66
67






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/Cordoba) {
    {-9223372036854775808 -15408 0 LMT}
    {-2372096592 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {667965600 -14400 0 -04}
    {687931200 -7200 0 -02}
    {687931200 -7200 0 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224385200 -7200 1 -02}
    {1224385200 -7200 1 -03}
    {1237082400 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/Jujuy.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54
55
56
57
58
59

60
61
62

63
64

65
66
67
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53
54
55
56
57
58

59
60
61

62
63

64
65
66
67






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+






-
+


-
+

-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/Jujuy) {
    {-9223372036854775808 -15672 0 LMT}
    {-2372096328 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -14400 0 -04}
    {657086400 -10800 1 -03}
    {669178800 -14400 0 -04}
    {686721600 -7200 1 -02}
    {694231200 -7200 0 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224295200 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/La_Rioja.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54

55
56
57

58
59

60
61
62

63
64
65
66

67
68
69
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53

54
55
56

57
58

59
60
61

62
63
64
65

66
67
68
69






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+


-
+

-
+


-
+



-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/La_Rioja) {
    {-9223372036854775808 -16044 0 LMT}
    {-2372095956 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {667792800 -14400 0 -04}
    {673588800 -10800 0 -03}
    {687927600 -7200 1 -02}
    {687927600 -7200 1 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1086058800 -14400 0 -04}
    {1087704000 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224295200 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/Mendoza.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54
55
56
57
58

59
60
61

62
63
64
65

66
67
68
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53
54
55
56
57

58
59
60

61
62
63
64

65
66
67
68






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+





-
+


-
+



-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/Mendoza) {
    {-9223372036854775808 -16516 0 LMT}
    {-2372095484 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -14400 0 -04}
    {655963200 -10800 1 -03}
    {667796400 -14400 0 -04}
    {687499200 -10800 1 -03}
    {699418800 -14400 0 -04}
    {719380800 -7200 0 -02}
    {719380800 -7200 0 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1085281200 -14400 0 -04}
    {1096171200 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224295200 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/Rio_Gallegos.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54

55
56

57
58

59
60
61

62
63
64
65

66
67
68
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53

54
55

56
57

58
59
60

61
62
63
64

65
66
67
68






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+


-
+



-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/Rio_Gallegos) {
    {-9223372036854775808 -16612 0 LMT}
    {-2372095388 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {667965600 -10800 0 -03}
    {687927600 -7200 1 -02}
    {687927600 -7200 1 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1086058800 -14400 0 -04}
    {1087704000 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224295200 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/Salta.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54

55
56

57
58

59
60
61

62
63

64
65
66
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53

54
55

56
57

58
59
60

61
62

63
64
65
66






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/Salta) {
    {-9223372036854775808 -15700 0 LMT}
    {-2372096300 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {667965600 -14400 0 -04}
    {687931200 -7200 0 -02}
    {687931200 -7200 0 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224295200 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/San_Juan.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54

55
56
57

58
59

60
61
62

63
64
65
66

67
68
69
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53

54
55
56

57
58

59
60
61

62
63
64
65

66
67
68
69






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+


-
+

-
+


-
+



-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/San_Juan) {
    {-9223372036854775808 -16444 0 LMT}
    {-2372095556 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {667792800 -14400 0 -04}
    {673588800 -10800 0 -03}
    {687927600 -7200 1 -02}
    {687927600 -7200 1 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1085972400 -14400 0 -04}
    {1090728000 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224295200 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/San_Luis.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54
55
56
57
58
59
60
61
62

63
64
65

66
67
68
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53
54
55
56
57
58
59
60
61

62
63
64

65
66
67
68






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+









-
+


-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/San_Luis) {
    {-9223372036854775808 -15924 0 LMT}
    {-2372096076 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {631159200 -7200 1 -02}
    {637380000 -14400 0 -04}
    {655963200 -10800 1 -03}
    {667796400 -14400 0 -04}
    {675748800 -10800 0 -03}
    {938919600 -10800 1 -03}
    {952052400 -10800 0 -03}
    {1085972400 -14400 0 -04}
    {1090728000 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1200880800 -10800 0 -04}
    {1205031600 -14400 0 -04}
    {1223784000 -10800 1 -03}
    {1223784000 -10800 1 -04}
    {1236481200 -14400 0 -04}
    {1255233600 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/Tucuman.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54

55
56

57
58

59
60
61

62
63
64
65

66
67

68
69
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53

54
55

56
57

58
59
60

61
62
63
64

65
66

67
68
69






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+


-
+



-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/Tucuman) {
    {-9223372036854775808 -15652 0 LMT}
    {-2372096348 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {667965600 -14400 0 -04}
    {687931200 -7200 0 -02}
    {687931200 -7200 0 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1086058800 -14400 0 -04}
    {1087099200 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224385200 -7200 1 -02}
    {1224385200 -7200 1 -03}
    {1237082400 -10800 0 -03}
}

Changes to library/tzdata/America/Argentina/Ushuaia.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47
48

49
50

51
52

53
54

55
56

57
58

59
60
61

62
63
64
65

66
67
68
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46
47

48
49

50
51

52
53

54
55

56
57

58
59
60

61
62
63
64

65
66
67
68






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+


-
+



-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Argentina/Ushuaia) {
    {-9223372036854775808 -16392 0 LMT}
    {-2372095608 -15408 0 CMT}
    {-1567453392 -14400 0 -04}
    {-1233432000 -10800 0 -03}
    {-1233432000 -10800 0 -04}
    {-1222981200 -14400 0 -04}
    {-1205956800 -10800 1 -03}
    {-1205956800 -10800 1 -04}
    {-1194037200 -14400 0 -04}
    {-1172865600 -10800 1 -03}
    {-1172865600 -10800 1 -04}
    {-1162501200 -14400 0 -04}
    {-1141329600 -10800 1 -03}
    {-1141329600 -10800 1 -04}
    {-1130965200 -14400 0 -04}
    {-1109793600 -10800 1 -03}
    {-1109793600 -10800 1 -04}
    {-1099429200 -14400 0 -04}
    {-1078257600 -10800 1 -03}
    {-1078257600 -10800 1 -04}
    {-1067806800 -14400 0 -04}
    {-1046635200 -10800 1 -03}
    {-1046635200 -10800 1 -04}
    {-1036270800 -14400 0 -04}
    {-1015099200 -10800 1 -03}
    {-1015099200 -10800 1 -04}
    {-1004734800 -14400 0 -04}
    {-983563200 -10800 1 -03}
    {-983563200 -10800 1 -04}
    {-973198800 -14400 0 -04}
    {-952027200 -10800 1 -03}
    {-952027200 -10800 1 -04}
    {-941576400 -14400 0 -04}
    {-931032000 -10800 1 -03}
    {-931032000 -10800 1 -04}
    {-900882000 -14400 0 -04}
    {-890337600 -10800 1 -03}
    {-890337600 -10800 1 -04}
    {-833749200 -14400 0 -04}
    {-827265600 -10800 1 -03}
    {-827265600 -10800 1 -04}
    {-752274000 -14400 0 -04}
    {-733780800 -10800 1 -03}
    {-733780800 -10800 1 -04}
    {-197326800 -14400 0 -04}
    {-190843200 -10800 1 -03}
    {-190843200 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-164491200 -10800 1 -03}
    {-164491200 -10800 1 -04}
    {-152658000 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {596948400 -7200 1 -02}
    {596948400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {636516000 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {667965600 -10800 0 -03}
    {687927600 -7200 1 -02}
    {687927600 -7200 1 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {731469600 -10800 0 -03}
    {938916000 -10800 0 -04}
    {938919600 -10800 1 -03}
    {938919600 -10800 1 -04}
    {952056000 -10800 0 -03}
    {1085886000 -14400 0 -04}
    {1087704000 -10800 0 -03}
    {1198983600 -7200 1 -02}
    {1198983600 -7200 1 -03}
    {1205632800 -10800 0 -03}
    {1224295200 -10800 0 -03}
}

Changes to library/tzdata/America/Asuncion.

1
2
3
4
5
6
7
8
9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66

67
68

69
70

71
72

73
74

75
76

77
78

79
80

81
82

83
84

85
86

87
88

89
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
128

129
130

131
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

161
162

163
164

165
166

167
168

169
170

171
172

173
174

175
176

177
178

179
180

181
182

183
184

185
186

187
188

189
190

191
192

193
194

195
196

197
198

199
200

201
202

203
204

205
206

207
208

209
210

211
212

213
214

215
216

217
218

219
220

221
222

223
224

225
226

227
228

229
230

231
232

233
234

235
236

237
238

239
240

241
242

243
244

245
246

247
248

249
250

251
252

253
254

255
256

257
258

259
1
2
3
4
5
6
7
8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67

68
69

70
71

72
73

74
75

76
77

78
79

80
81

82
83

84
85

86
87

88
89

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

128
129

130
131

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
161

162
163

164
165

166
167

168
169

170
171

172
173

174
175

176
177

178
179

180
181

182
183

184
185

186
187

188
189

190
191

192
193

194
195

196
197

198
199

200
201

202
203

204
205

206
207

208
209

210
211

212
213

214
215

216
217

218
219

220
221

222
223

224
225

226
227

228
229

230
231

232
233

234
235

236
237

238
239

240
241

242
243

244
245

246
247

248
249

250
251

252
253

254
255

256
257

258
259









-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Asuncion) {
    {-9223372036854775808 -13840 0 LMT}
    {-2524507760 -13840 0 AMT}
    {-1206389360 -14400 0 -04}
    {86760000 -10800 0 -03}
    {134017200 -14400 0 -04}
    {162878400 -14400 0 -04}
    {181368000 -10800 1 -03}
    {181368000 -10800 1 -04}
    {194497200 -14400 0 -04}
    {212990400 -10800 1 -03}
    {212990400 -10800 1 -04}
    {226033200 -14400 0 -04}
    {244526400 -10800 1 -03}
    {244526400 -10800 1 -04}
    {257569200 -14400 0 -04}
    {276062400 -10800 1 -03}
    {276062400 -10800 1 -04}
    {291783600 -14400 0 -04}
    {307598400 -10800 1 -03}
    {307598400 -10800 1 -04}
    {323406000 -14400 0 -04}
    {339220800 -10800 1 -03}
    {339220800 -10800 1 -04}
    {354942000 -14400 0 -04}
    {370756800 -10800 1 -03}
    {370756800 -10800 1 -04}
    {386478000 -14400 0 -04}
    {402292800 -10800 1 -03}
    {402292800 -10800 1 -04}
    {418014000 -14400 0 -04}
    {433828800 -10800 1 -03}
    {433828800 -10800 1 -04}
    {449636400 -14400 0 -04}
    {465451200 -10800 1 -03}
    {465451200 -10800 1 -04}
    {481172400 -14400 0 -04}
    {496987200 -10800 1 -03}
    {496987200 -10800 1 -04}
    {512708400 -14400 0 -04}
    {528523200 -10800 1 -03}
    {528523200 -10800 1 -04}
    {544244400 -14400 0 -04}
    {560059200 -10800 1 -03}
    {560059200 -10800 1 -04}
    {575866800 -14400 0 -04}
    {591681600 -10800 1 -03}
    {591681600 -10800 1 -04}
    {607402800 -14400 0 -04}
    {625032000 -10800 1 -03}
    {625032000 -10800 1 -04}
    {638938800 -14400 0 -04}
    {654753600 -10800 1 -03}
    {654753600 -10800 1 -04}
    {670474800 -14400 0 -04}
    {686721600 -10800 1 -03}
    {686721600 -10800 1 -04}
    {699418800 -14400 0 -04}
    {718257600 -10800 1 -03}
    {718257600 -10800 1 -04}
    {733546800 -14400 0 -04}
    {749448000 -10800 1 -03}
    {749448000 -10800 1 -04}
    {762318000 -14400 0 -04}
    {780984000 -10800 1 -03}
    {780984000 -10800 1 -04}
    {793767600 -14400 0 -04}
    {812520000 -10800 1 -03}
    {812520000 -10800 1 -04}
    {825649200 -14400 0 -04}
    {844574400 -10800 1 -03}
    {844574400 -10800 1 -04}
    {856666800 -14400 0 -04}
    {876024000 -10800 1 -03}
    {876024000 -10800 1 -04}
    {888721200 -14400 0 -04}
    {907473600 -10800 1 -03}
    {907473600 -10800 1 -04}
    {920775600 -14400 0 -04}
    {938923200 -10800 1 -03}
    {938923200 -10800 1 -04}
    {952225200 -14400 0 -04}
    {970372800 -10800 1 -03}
    {970372800 -10800 1 -04}
    {983674800 -14400 0 -04}
    {1002427200 -10800 1 -03}
    {1002427200 -10800 1 -04}
    {1018148400 -14400 0 -04}
    {1030852800 -10800 1 -03}
    {1030852800 -10800 1 -04}
    {1049598000 -14400 0 -04}
    {1062907200 -10800 1 -03}
    {1062907200 -10800 1 -04}
    {1081047600 -14400 0 -04}
    {1097985600 -10800 1 -03}
    {1097985600 -10800 1 -04}
    {1110682800 -14400 0 -04}
    {1129435200 -10800 1 -03}
    {1129435200 -10800 1 -04}
    {1142132400 -14400 0 -04}
    {1160884800 -10800 1 -03}
    {1160884800 -10800 1 -04}
    {1173582000 -14400 0 -04}
    {1192939200 -10800 1 -03}
    {1192939200 -10800 1 -04}
    {1205031600 -14400 0 -04}
    {1224388800 -10800 1 -03}
    {1224388800 -10800 1 -04}
    {1236481200 -14400 0 -04}
    {1255838400 -10800 1 -03}
    {1255838400 -10800 1 -04}
    {1270954800 -14400 0 -04}
    {1286078400 -10800 1 -03}
    {1286078400 -10800 1 -04}
    {1302404400 -14400 0 -04}
    {1317528000 -10800 1 -03}
    {1317528000 -10800 1 -04}
    {1333854000 -14400 0 -04}
    {1349582400 -10800 1 -03}
    {1349582400 -10800 1 -04}
    {1364094000 -14400 0 -04}
    {1381032000 -10800 1 -03}
    {1381032000 -10800 1 -04}
    {1395543600 -14400 0 -04}
    {1412481600 -10800 1 -03}
    {1412481600 -10800 1 -04}
    {1426993200 -14400 0 -04}
    {1443931200 -10800 1 -03}
    {1443931200 -10800 1 -04}
    {1459047600 -14400 0 -04}
    {1475380800 -10800 1 -03}
    {1475380800 -10800 1 -04}
    {1490497200 -14400 0 -04}
    {1506830400 -10800 1 -03}
    {1506830400 -10800 1 -04}
    {1521946800 -14400 0 -04}
    {1538884800 -10800 1 -03}
    {1538884800 -10800 1 -04}
    {1553396400 -14400 0 -04}
    {1570334400 -10800 1 -03}
    {1570334400 -10800 1 -04}
    {1584846000 -14400 0 -04}
    {1601784000 -10800 1 -03}
    {1601784000 -10800 1 -04}
    {1616900400 -14400 0 -04}
    {1633233600 -10800 1 -03}
    {1633233600 -10800 1 -04}
    {1648350000 -14400 0 -04}
    {1664683200 -10800 1 -03}
    {1664683200 -10800 1 -04}
    {1679799600 -14400 0 -04}
    {1696132800 -10800 1 -03}
    {1696132800 -10800 1 -04}
    {1711249200 -14400 0 -04}
    {1728187200 -10800 1 -03}
    {1728187200 -10800 1 -04}
    {1742698800 -14400 0 -04}
    {1759636800 -10800 1 -03}
    {1759636800 -10800 1 -04}
    {1774148400 -14400 0 -04}
    {1791086400 -10800 1 -03}
    {1791086400 -10800 1 -04}
    {1806202800 -14400 0 -04}
    {1822536000 -10800 1 -03}
    {1822536000 -10800 1 -04}
    {1837652400 -14400 0 -04}
    {1853985600 -10800 1 -03}
    {1853985600 -10800 1 -04}
    {1869102000 -14400 0 -04}
    {1886040000 -10800 1 -03}
    {1886040000 -10800 1 -04}
    {1900551600 -14400 0 -04}
    {1917489600 -10800 1 -03}
    {1917489600 -10800 1 -04}
    {1932001200 -14400 0 -04}
    {1948939200 -10800 1 -03}
    {1948939200 -10800 1 -04}
    {1964055600 -14400 0 -04}
    {1980388800 -10800 1 -03}
    {1980388800 -10800 1 -04}
    {1995505200 -14400 0 -04}
    {2011838400 -10800 1 -03}
    {2011838400 -10800 1 -04}
    {2026954800 -14400 0 -04}
    {2043288000 -10800 1 -03}
    {2043288000 -10800 1 -04}
    {2058404400 -14400 0 -04}
    {2075342400 -10800 1 -03}
    {2075342400 -10800 1 -04}
    {2089854000 -14400 0 -04}
    {2106792000 -10800 1 -03}
    {2106792000 -10800 1 -04}
    {2121303600 -14400 0 -04}
    {2138241600 -10800 1 -03}
    {2138241600 -10800 1 -04}
    {2153358000 -14400 0 -04}
    {2169691200 -10800 1 -03}
    {2169691200 -10800 1 -04}
    {2184807600 -14400 0 -04}
    {2201140800 -10800 1 -03}
    {2201140800 -10800 1 -04}
    {2216257200 -14400 0 -04}
    {2233195200 -10800 1 -03}
    {2233195200 -10800 1 -04}
    {2247706800 -14400 0 -04}
    {2264644800 -10800 1 -03}
    {2264644800 -10800 1 -04}
    {2279156400 -14400 0 -04}
    {2296094400 -10800 1 -03}
    {2296094400 -10800 1 -04}
    {2310606000 -14400 0 -04}
    {2327544000 -10800 1 -03}
    {2327544000 -10800 1 -04}
    {2342660400 -14400 0 -04}
    {2358993600 -10800 1 -03}
    {2358993600 -10800 1 -04}
    {2374110000 -14400 0 -04}
    {2390443200 -10800 1 -03}
    {2390443200 -10800 1 -04}
    {2405559600 -14400 0 -04}
    {2422497600 -10800 1 -03}
    {2422497600 -10800 1 -04}
    {2437009200 -14400 0 -04}
    {2453947200 -10800 1 -03}
    {2453947200 -10800 1 -04}
    {2468458800 -14400 0 -04}
    {2485396800 -10800 1 -03}
    {2485396800 -10800 1 -04}
    {2500513200 -14400 0 -04}
    {2516846400 -10800 1 -03}
    {2516846400 -10800 1 -04}
    {2531962800 -14400 0 -04}
    {2548296000 -10800 1 -03}
    {2548296000 -10800 1 -04}
    {2563412400 -14400 0 -04}
    {2579745600 -10800 1 -03}
    {2579745600 -10800 1 -04}
    {2594862000 -14400 0 -04}
    {2611800000 -10800 1 -03}
    {2611800000 -10800 1 -04}
    {2626311600 -14400 0 -04}
    {2643249600 -10800 1 -03}
    {2643249600 -10800 1 -04}
    {2657761200 -14400 0 -04}
    {2674699200 -10800 1 -03}
    {2674699200 -10800 1 -04}
    {2689815600 -14400 0 -04}
    {2706148800 -10800 1 -03}
    {2706148800 -10800 1 -04}
    {2721265200 -14400 0 -04}
    {2737598400 -10800 1 -03}
    {2737598400 -10800 1 -04}
    {2752714800 -14400 0 -04}
    {2769652800 -10800 1 -03}
    {2769652800 -10800 1 -04}
    {2784164400 -14400 0 -04}
    {2801102400 -10800 1 -03}
    {2801102400 -10800 1 -04}
    {2815614000 -14400 0 -04}
    {2832552000 -10800 1 -03}
    {2832552000 -10800 1 -04}
    {2847668400 -14400 0 -04}
    {2864001600 -10800 1 -03}
    {2864001600 -10800 1 -04}
    {2879118000 -14400 0 -04}
    {2895451200 -10800 1 -03}
    {2895451200 -10800 1 -04}
    {2910567600 -14400 0 -04}
    {2926900800 -10800 1 -03}
    {2926900800 -10800 1 -04}
    {2942017200 -14400 0 -04}
    {2958955200 -10800 1 -03}
    {2958955200 -10800 1 -04}
    {2973466800 -14400 0 -04}
    {2990404800 -10800 1 -03}
    {2990404800 -10800 1 -04}
    {3004916400 -14400 0 -04}
    {3021854400 -10800 1 -03}
    {3021854400 -10800 1 -04}
    {3036970800 -14400 0 -04}
    {3053304000 -10800 1 -03}
    {3053304000 -10800 1 -04}
    {3068420400 -14400 0 -04}
    {3084753600 -10800 1 -03}
    {3084753600 -10800 1 -04}
    {3099870000 -14400 0 -04}
    {3116808000 -10800 1 -03}
    {3116808000 -10800 1 -04}
    {3131319600 -14400 0 -04}
    {3148257600 -10800 1 -03}
    {3148257600 -10800 1 -04}
    {3162769200 -14400 0 -04}
    {3179707200 -10800 1 -03}
    {3179707200 -10800 1 -04}
    {3194218800 -14400 0 -04}
    {3211156800 -10800 1 -03}
    {3211156800 -10800 1 -04}
    {3226273200 -14400 0 -04}
    {3242606400 -10800 1 -03}
    {3242606400 -10800 1 -04}
    {3257722800 -14400 0 -04}
    {3274056000 -10800 1 -03}
    {3274056000 -10800 1 -04}
    {3289172400 -14400 0 -04}
    {3306110400 -10800 1 -03}
    {3306110400 -10800 1 -04}
    {3320622000 -14400 0 -04}
    {3337560000 -10800 1 -03}
    {3337560000 -10800 1 -04}
    {3352071600 -14400 0 -04}
    {3369009600 -10800 1 -03}
    {3369009600 -10800 1 -04}
    {3384126000 -14400 0 -04}
    {3400459200 -10800 1 -03}
    {3400459200 -10800 1 -04}
    {3415575600 -14400 0 -04}
    {3431908800 -10800 1 -03}
    {3431908800 -10800 1 -04}
    {3447025200 -14400 0 -04}
    {3463358400 -10800 1 -03}
    {3463358400 -10800 1 -04}
    {3478474800 -14400 0 -04}
    {3495412800 -10800 1 -03}
    {3495412800 -10800 1 -04}
    {3509924400 -14400 0 -04}
    {3526862400 -10800 1 -03}
    {3526862400 -10800 1 -04}
    {3541374000 -14400 0 -04}
    {3558312000 -10800 1 -03}
    {3558312000 -10800 1 -04}
    {3573428400 -14400 0 -04}
    {3589761600 -10800 1 -03}
    {3589761600 -10800 1 -04}
    {3604878000 -14400 0 -04}
    {3621211200 -10800 1 -03}
    {3621211200 -10800 1 -04}
    {3636327600 -14400 0 -04}
    {3653265600 -10800 1 -03}
    {3653265600 -10800 1 -04}
    {3667777200 -14400 0 -04}
    {3684715200 -10800 1 -03}
    {3684715200 -10800 1 -04}
    {3699226800 -14400 0 -04}
    {3716164800 -10800 1 -03}
    {3716164800 -10800 1 -04}
    {3731281200 -14400 0 -04}
    {3747614400 -10800 1 -03}
    {3747614400 -10800 1 -04}
    {3762730800 -14400 0 -04}
    {3779064000 -10800 1 -03}
    {3779064000 -10800 1 -04}
    {3794180400 -14400 0 -04}
    {3810513600 -10800 1 -03}
    {3810513600 -10800 1 -04}
    {3825630000 -14400 0 -04}
    {3842568000 -10800 1 -03}
    {3842568000 -10800 1 -04}
    {3857079600 -14400 0 -04}
    {3874017600 -10800 1 -03}
    {3874017600 -10800 1 -04}
    {3888529200 -14400 0 -04}
    {3905467200 -10800 1 -03}
    {3905467200 -10800 1 -04}
    {3920583600 -14400 0 -04}
    {3936916800 -10800 1 -03}
    {3936916800 -10800 1 -04}
    {3952033200 -14400 0 -04}
    {3968366400 -10800 1 -03}
    {3968366400 -10800 1 -04}
    {3983482800 -14400 0 -04}
    {4000420800 -10800 1 -03}
    {4000420800 -10800 1 -04}
    {4014932400 -14400 0 -04}
    {4031870400 -10800 1 -03}
    {4031870400 -10800 1 -04}
    {4046382000 -14400 0 -04}
    {4063320000 -10800 1 -03}
    {4063320000 -10800 1 -04}
    {4077831600 -14400 0 -04}
    {4094769600 -10800 1 -03}
    {4094769600 -10800 1 -04}
}

Changes to library/tzdata/America/Bahia.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64
65

66
67
68
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63
64

65
66
67
68





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Bahia) {
    {-9223372036854775808 -9244 0 LMT}
    {-1767216356 -10800 0 -03}
    {-1206957600 -7200 1 -02}
    {-1206957600 -7200 1 -03}
    {-1191362400 -10800 0 -03}
    {-1175374800 -7200 1 -02}
    {-1175374800 -7200 1 -03}
    {-1159826400 -10800 0 -03}
    {-633819600 -7200 1 -02}
    {-633819600 -7200 1 -03}
    {-622069200 -10800 0 -03}
    {-602283600 -7200 1 -02}
    {-602283600 -7200 1 -03}
    {-591832800 -10800 0 -03}
    {-570747600 -7200 1 -02}
    {-570747600 -7200 1 -03}
    {-560210400 -10800 0 -03}
    {-539125200 -7200 1 -02}
    {-539125200 -7200 1 -03}
    {-531352800 -10800 0 -03}
    {-191365200 -7200 1 -02}
    {-191365200 -7200 1 -03}
    {-184197600 -10800 0 -03}
    {-155163600 -7200 1 -02}
    {-155163600 -7200 1 -03}
    {-150069600 -10800 0 -03}
    {-128898000 -7200 1 -02}
    {-128898000 -7200 1 -03}
    {-121125600 -10800 0 -03}
    {-99954000 -7200 1 -02}
    {-99954000 -7200 1 -03}
    {-89589600 -10800 0 -03}
    {-68418000 -7200 1 -02}
    {-68418000 -7200 1 -03}
    {-57967200 -10800 0 -03}
    {499748400 -7200 1 -02}
    {499748400 -7200 1 -03}
    {511236000 -10800 0 -03}
    {530593200 -7200 1 -02}
    {530593200 -7200 1 -03}
    {540266400 -10800 0 -03}
    {562129200 -7200 1 -02}
    {562129200 -7200 1 -03}
    {571197600 -10800 0 -03}
    {592974000 -7200 1 -02}
    {592974000 -7200 1 -03}
    {602042400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {634701600 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {666756000 -10800 0 -03}
    {687927600 -7200 1 -02}
    {687927600 -7200 1 -03}
    {697600800 -10800 0 -03}
    {719982000 -7200 1 -02}
    {719982000 -7200 1 -03}
    {728445600 -10800 0 -03}
    {750826800 -7200 1 -02}
    {750826800 -7200 1 -03}
    {761709600 -10800 0 -03}
    {782276400 -7200 1 -02}
    {782276400 -7200 1 -03}
    {793159200 -10800 0 -03}
    {813726000 -7200 1 -02}
    {813726000 -7200 1 -03}
    {824004000 -10800 0 -03}
    {844570800 -7200 1 -02}
    {844570800 -7200 1 -03}
    {856058400 -10800 0 -03}
    {876106800 -7200 1 -02}
    {876106800 -7200 1 -03}
    {888717600 -10800 0 -03}
    {908074800 -7200 1 -02}
    {908074800 -7200 1 -03}
    {919562400 -10800 0 -03}
    {938919600 -7200 1 -02}
    {938919600 -7200 1 -03}
    {951616800 -10800 0 -03}
    {970974000 -7200 1 -02}
    {970974000 -7200 1 -03}
    {982461600 -10800 0 -03}
    {1003028400 -7200 1 -02}
    {1003028400 -7200 1 -03}
    {1013911200 -10800 0 -03}
    {1036292400 -7200 1 -02}
    {1036292400 -7200 1 -03}
    {1045360800 -10800 0 -03}
    {1064368800 -10800 0 -03}
    {1318734000 -7200 0 -02}
    {1318734000 -7200 0 -03}
    {1330221600 -10800 0 -03}
    {1350784800 -10800 0 -03}
}

Changes to library/tzdata/America/Belem.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34
35
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33
34
35





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Belem) {
    {-9223372036854775808 -11636 0 LMT}
    {-1767213964 -10800 0 -03}
    {-1206957600 -7200 1 -02}
    {-1206957600 -7200 1 -03}
    {-1191362400 -10800 0 -03}
    {-1175374800 -7200 1 -02}
    {-1175374800 -7200 1 -03}
    {-1159826400 -10800 0 -03}
    {-633819600 -7200 1 -02}
    {-633819600 -7200 1 -03}
    {-622069200 -10800 0 -03}
    {-602283600 -7200 1 -02}
    {-602283600 -7200 1 -03}
    {-591832800 -10800 0 -03}
    {-570747600 -7200 1 -02}
    {-570747600 -7200 1 -03}
    {-560210400 -10800 0 -03}
    {-539125200 -7200 1 -02}
    {-539125200 -7200 1 -03}
    {-531352800 -10800 0 -03}
    {-191365200 -7200 1 -02}
    {-191365200 -7200 1 -03}
    {-184197600 -10800 0 -03}
    {-155163600 -7200 1 -02}
    {-155163600 -7200 1 -03}
    {-150069600 -10800 0 -03}
    {-128898000 -7200 1 -02}
    {-128898000 -7200 1 -03}
    {-121125600 -10800 0 -03}
    {-99954000 -7200 1 -02}
    {-99954000 -7200 1 -03}
    {-89589600 -10800 0 -03}
    {-68418000 -7200 1 -02}
    {-68418000 -7200 1 -03}
    {-57967200 -10800 0 -03}
    {499748400 -7200 1 -02}
    {499748400 -7200 1 -03}
    {511236000 -10800 0 -03}
    {530593200 -7200 1 -02}
    {530593200 -7200 1 -03}
    {540266400 -10800 0 -03}
    {562129200 -7200 1 -02}
    {562129200 -7200 1 -03}
    {571197600 -10800 0 -03}
    {590032800 -10800 0 -03}
}

Changes to library/tzdata/America/Boa_Vista.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34
35
36

37
38

39
40
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33
34
35

36
37

38
39
40





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Boa_Vista) {
    {-9223372036854775808 -14560 0 LMT}
    {-1767211040 -14400 0 -04}
    {-1206954000 -10800 1 -03}
    {-1206954000 -10800 1 -04}
    {-1191358800 -14400 0 -04}
    {-1175371200 -10800 1 -03}
    {-1175371200 -10800 1 -04}
    {-1159822800 -14400 0 -04}
    {-633816000 -10800 1 -03}
    {-633816000 -10800 1 -04}
    {-622065600 -14400 0 -04}
    {-602280000 -10800 1 -03}
    {-602280000 -10800 1 -04}
    {-591829200 -14400 0 -04}
    {-570744000 -10800 1 -03}
    {-570744000 -10800 1 -04}
    {-560206800 -14400 0 -04}
    {-539121600 -10800 1 -03}
    {-539121600 -10800 1 -04}
    {-531349200 -14400 0 -04}
    {-191361600 -10800 1 -03}
    {-191361600 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-155160000 -10800 1 -03}
    {-155160000 -10800 1 -04}
    {-150066000 -14400 0 -04}
    {-128894400 -10800 1 -03}
    {-128894400 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-99950400 -10800 1 -03}
    {-99950400 -10800 1 -04}
    {-89586000 -14400 0 -04}
    {-68414400 -10800 1 -03}
    {-68414400 -10800 1 -04}
    {-57963600 -14400 0 -04}
    {499752000 -10800 1 -03}
    {499752000 -10800 1 -04}
    {511239600 -14400 0 -04}
    {530596800 -10800 1 -03}
    {530596800 -10800 1 -04}
    {540270000 -14400 0 -04}
    {562132800 -10800 1 -03}
    {562132800 -10800 1 -04}
    {571201200 -14400 0 -04}
    {590036400 -14400 0 -04}
    {938664000 -14400 0 -04}
    {938923200 -10800 1 -03}
    {938923200 -10800 1 -04}
    {951620400 -14400 0 -04}
    {970977600 -10800 1 -03}
    {970977600 -10800 1 -04}
    {971578800 -14400 0 -04}
}

Changes to library/tzdata/America/Bogota.

1
2
3
4
5
6
7

8
9
1
2
3
4
5
6

7
8
9






-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Bogota) {
    {-9223372036854775808 -17776 0 LMT}
    {-2707671824 -17776 0 BMT}
    {-1739041424 -18000 0 -05}
    {704869200 -14400 1 -04}
    {704869200 -14400 1 -05}
    {733896000 -18000 0 -05}
}

Changes to library/tzdata/America/Campo_Grande.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66

67
68

69
70

71
72

73
74

75
76

77
78

79
80

81
82

83
84

85
86

87
88

89
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
128

129
130

131
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

161
162

163
164

165
166

167
168

169
170

171
172

173
174

175
176

177
178

179
180

181
182

183
184

185
186

187
188

189
190

191
192

193
194

195
196

197
198

199
200

201
202

203
204

205
206

207
208

209
210

211
212

213
214

215
216

217
218

219
220

221
222

223
224

225
226

227
228

229
230

231
232

233
234

235
236

237
238

239
240

241
242

243
244

245
246

247
248

249
250

251
252

253
254

255
256

257
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67

68
69

70
71

72
73

74
75

76
77

78
79

80
81

82
83

84
85

86
87

88
89

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

128
129

130
131

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
161

162
163

164
165

166
167

168
169

170
171

172
173

174
175

176
177

178
179

180
181

182
183

184
185

186
187

188
189

190
191

192
193

194
195

196
197

198
199

200
201

202
203

204
205

206
207

208
209

210
211

212
213

214
215

216
217

218
219

220
221

222
223

224
225

226
227

228
229

230
231

232
233

234
235

236
237

238
239

240
241

242
243

244
245

246
247

248
249

250
251

252
253

254
255

256
257





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Campo_Grande) {
    {-9223372036854775808 -13108 0 LMT}
    {-1767212492 -14400 0 -04}
    {-1206954000 -10800 1 -03}
    {-1206954000 -10800 1 -04}
    {-1191358800 -14400 0 -04}
    {-1175371200 -10800 1 -03}
    {-1175371200 -10800 1 -04}
    {-1159822800 -14400 0 -04}
    {-633816000 -10800 1 -03}
    {-633816000 -10800 1 -04}
    {-622065600 -14400 0 -04}
    {-602280000 -10800 1 -03}
    {-602280000 -10800 1 -04}
    {-591829200 -14400 0 -04}
    {-570744000 -10800 1 -03}
    {-570744000 -10800 1 -04}
    {-560206800 -14400 0 -04}
    {-539121600 -10800 1 -03}
    {-539121600 -10800 1 -04}
    {-531349200 -14400 0 -04}
    {-191361600 -10800 1 -03}
    {-191361600 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-155160000 -10800 1 -03}
    {-155160000 -10800 1 -04}
    {-150066000 -14400 0 -04}
    {-128894400 -10800 1 -03}
    {-128894400 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-99950400 -10800 1 -03}
    {-99950400 -10800 1 -04}
    {-89586000 -14400 0 -04}
    {-68414400 -10800 1 -03}
    {-68414400 -10800 1 -04}
    {-57963600 -14400 0 -04}
    {499752000 -10800 1 -03}
    {499752000 -10800 1 -04}
    {511239600 -14400 0 -04}
    {530596800 -10800 1 -03}
    {530596800 -10800 1 -04}
    {540270000 -14400 0 -04}
    {562132800 -10800 1 -03}
    {562132800 -10800 1 -04}
    {571201200 -14400 0 -04}
    {592977600 -10800 1 -03}
    {592977600 -10800 1 -04}
    {602046000 -14400 0 -04}
    {624427200 -10800 1 -03}
    {624427200 -10800 1 -04}
    {634705200 -14400 0 -04}
    {656481600 -10800 1 -03}
    {656481600 -10800 1 -04}
    {666759600 -14400 0 -04}
    {687931200 -10800 1 -03}
    {687931200 -10800 1 -04}
    {697604400 -14400 0 -04}
    {719985600 -10800 1 -03}
    {719985600 -10800 1 -04}
    {728449200 -14400 0 -04}
    {750830400 -10800 1 -03}
    {750830400 -10800 1 -04}
    {761713200 -14400 0 -04}
    {782280000 -10800 1 -03}
    {782280000 -10800 1 -04}
    {793162800 -14400 0 -04}
    {813729600 -10800 1 -03}
    {813729600 -10800 1 -04}
    {824007600 -14400 0 -04}
    {844574400 -10800 1 -03}
    {844574400 -10800 1 -04}
    {856062000 -14400 0 -04}
    {876110400 -10800 1 -03}
    {876110400 -10800 1 -04}
    {888721200 -14400 0 -04}
    {908078400 -10800 1 -03}
    {908078400 -10800 1 -04}
    {919566000 -14400 0 -04}
    {938923200 -10800 1 -03}
    {938923200 -10800 1 -04}
    {951620400 -14400 0 -04}
    {970977600 -10800 1 -03}
    {970977600 -10800 1 -04}
    {982465200 -14400 0 -04}
    {1003032000 -10800 1 -03}
    {1003032000 -10800 1 -04}
    {1013914800 -14400 0 -04}
    {1036296000 -10800 1 -03}
    {1036296000 -10800 1 -04}
    {1045364400 -14400 0 -04}
    {1066536000 -10800 1 -03}
    {1066536000 -10800 1 -04}
    {1076814000 -14400 0 -04}
    {1099368000 -10800 1 -03}
    {1099368000 -10800 1 -04}
    {1108868400 -14400 0 -04}
    {1129435200 -10800 1 -03}
    {1129435200 -10800 1 -04}
    {1140318000 -14400 0 -04}
    {1162699200 -10800 1 -03}
    {1162699200 -10800 1 -04}
    {1172372400 -14400 0 -04}
    {1192334400 -10800 1 -03}
    {1192334400 -10800 1 -04}
    {1203217200 -14400 0 -04}
    {1224388800 -10800 1 -03}
    {1224388800 -10800 1 -04}
    {1234666800 -14400 0 -04}
    {1255838400 -10800 1 -03}
    {1255838400 -10800 1 -04}
    {1266721200 -14400 0 -04}
    {1287288000 -10800 1 -03}
    {1287288000 -10800 1 -04}
    {1298170800 -14400 0 -04}
    {1318737600 -10800 1 -03}
    {1318737600 -10800 1 -04}
    {1330225200 -14400 0 -04}
    {1350792000 -10800 1 -03}
    {1350792000 -10800 1 -04}
    {1361070000 -14400 0 -04}
    {1382241600 -10800 1 -03}
    {1382241600 -10800 1 -04}
    {1392519600 -14400 0 -04}
    {1413691200 -10800 1 -03}
    {1413691200 -10800 1 -04}
    {1424574000 -14400 0 -04}
    {1445140800 -10800 1 -03}
    {1445140800 -10800 1 -04}
    {1456023600 -14400 0 -04}
    {1476590400 -10800 1 -03}
    {1476590400 -10800 1 -04}
    {1487473200 -14400 0 -04}
    {1508040000 -10800 1 -03}
    {1508040000 -10800 1 -04}
    {1518922800 -14400 0 -04}
    {1540094400 -10800 1 -03}
    {1541304000 -10800 1 -04}
    {1550372400 -14400 0 -04}
    {1571544000 -10800 1 -03}
    {1572753600 -10800 1 -04}
    {1581822000 -14400 0 -04}
    {1602993600 -10800 1 -03}
    {1604203200 -10800 1 -04}
    {1613876400 -14400 0 -04}
    {1634443200 -10800 1 -03}
    {1636257600 -10800 1 -04}
    {1645326000 -14400 0 -04}
    {1665892800 -10800 1 -03}
    {1667707200 -10800 1 -04}
    {1677380400 -14400 0 -04}
    {1697342400 -10800 1 -03}
    {1699156800 -10800 1 -04}
    {1708225200 -14400 0 -04}
    {1729396800 -10800 1 -03}
    {1730606400 -10800 1 -04}
    {1739674800 -14400 0 -04}
    {1760846400 -10800 1 -03}
    {1762056000 -10800 1 -04}
    {1771729200 -14400 0 -04}
    {1792296000 -10800 1 -03}
    {1793505600 -10800 1 -04}
    {1803178800 -14400 0 -04}
    {1823745600 -10800 1 -03}
    {1825560000 -10800 1 -04}
    {1834628400 -14400 0 -04}
    {1855195200 -10800 1 -03}
    {1857009600 -10800 1 -04}
    {1866078000 -14400 0 -04}
    {1887249600 -10800 1 -03}
    {1888459200 -10800 1 -04}
    {1897527600 -14400 0 -04}
    {1918699200 -10800 1 -03}
    {1919908800 -10800 1 -04}
    {1928977200 -14400 0 -04}
    {1950148800 -10800 1 -03}
    {1951358400 -10800 1 -04}
    {1960426800 -14400 0 -04}
    {1981598400 -10800 1 -03}
    {1983412800 -10800 1 -04}
    {1992481200 -14400 0 -04}
    {2013048000 -10800 1 -03}
    {2014862400 -10800 1 -04}
    {2024535600 -14400 0 -04}
    {2044497600 -10800 1 -03}
    {2046312000 -10800 1 -04}
    {2055380400 -14400 0 -04}
    {2076552000 -10800 1 -03}
    {2077761600 -10800 1 -04}
    {2086830000 -14400 0 -04}
    {2108001600 -10800 1 -03}
    {2109211200 -10800 1 -04}
    {2118884400 -14400 0 -04}
    {2139451200 -10800 1 -03}
    {2140660800 -10800 1 -04}
    {2150334000 -14400 0 -04}
    {2170900800 -10800 1 -03}
    {2172715200 -10800 1 -04}
    {2181783600 -14400 0 -04}
    {2202350400 -10800 1 -03}
    {2204164800 -10800 1 -04}
    {2213233200 -14400 0 -04}
    {2234404800 -10800 1 -03}
    {2235614400 -10800 1 -04}
    {2244682800 -14400 0 -04}
    {2265854400 -10800 1 -03}
    {2267064000 -10800 1 -04}
    {2276132400 -14400 0 -04}
    {2297304000 -10800 1 -03}
    {2298513600 -10800 1 -04}
    {2307582000 -14400 0 -04}
    {2328753600 -10800 1 -03}
    {2329963200 -10800 1 -04}
    {2339636400 -14400 0 -04}
    {2360203200 -10800 1 -03}
    {2362017600 -10800 1 -04}
    {2371086000 -14400 0 -04}
    {2391652800 -10800 1 -03}
    {2393467200 -10800 1 -04}
    {2402535600 -14400 0 -04}
    {2423707200 -10800 1 -03}
    {2424916800 -10800 1 -04}
    {2433985200 -14400 0 -04}
    {2455156800 -10800 1 -03}
    {2456366400 -10800 1 -04}
    {2465434800 -14400 0 -04}
    {2486606400 -10800 1 -03}
    {2487816000 -10800 1 -04}
    {2497489200 -14400 0 -04}
    {2518056000 -10800 1 -03}
    {2519870400 -10800 1 -04}
    {2528938800 -14400 0 -04}
    {2549505600 -10800 1 -03}
    {2551320000 -10800 1 -04}
    {2560388400 -14400 0 -04}
    {2580955200 -10800 1 -03}
    {2582769600 -10800 1 -04}
    {2591838000 -14400 0 -04}
    {2613009600 -10800 1 -03}
    {2614219200 -10800 1 -04}
    {2623287600 -14400 0 -04}
    {2644459200 -10800 1 -03}
    {2645668800 -10800 1 -04}
    {2654737200 -14400 0 -04}
    {2675908800 -10800 1 -03}
    {2677118400 -10800 1 -04}
    {2686791600 -14400 0 -04}
    {2707358400 -10800 1 -03}
    {2709172800 -10800 1 -04}
    {2718241200 -14400 0 -04}
    {2738808000 -10800 1 -03}
    {2740622400 -10800 1 -04}
    {2749690800 -14400 0 -04}
    {2770862400 -10800 1 -03}
    {2772072000 -10800 1 -04}
    {2781140400 -14400 0 -04}
    {2802312000 -10800 1 -03}
    {2803521600 -10800 1 -04}
    {2812590000 -14400 0 -04}
    {2833761600 -10800 1 -03}
    {2834971200 -10800 1 -04}
    {2844039600 -14400 0 -04}
    {2865211200 -10800 1 -03}
    {2867025600 -10800 1 -04}
    {2876094000 -14400 0 -04}
    {2896660800 -10800 1 -03}
    {2898475200 -10800 1 -04}
    {2907543600 -14400 0 -04}
    {2928110400 -10800 1 -03}
    {2929924800 -10800 1 -04}
    {2938993200 -14400 0 -04}
    {2960164800 -10800 1 -03}
    {2961374400 -10800 1 -04}
    {2970442800 -14400 0 -04}
    {2991614400 -10800 1 -03}
    {2992824000 -10800 1 -04}
    {3001892400 -14400 0 -04}
    {3023064000 -10800 1 -03}
    {3024273600 -10800 1 -04}
    {3033946800 -14400 0 -04}
    {3054513600 -10800 1 -03}
    {3056328000 -10800 1 -04}
    {3065396400 -14400 0 -04}
    {3085963200 -10800 1 -03}
    {3087777600 -10800 1 -04}
    {3096846000 -14400 0 -04}
    {3118017600 -10800 1 -03}
    {3119227200 -10800 1 -04}
    {3128295600 -14400 0 -04}
    {3149467200 -10800 1 -03}
    {3150676800 -10800 1 -04}
    {3159745200 -14400 0 -04}
    {3180916800 -10800 1 -03}
    {3182126400 -10800 1 -04}
    {3191194800 -14400 0 -04}
    {3212366400 -10800 1 -03}
    {3213576000 -10800 1 -04}
    {3223249200 -14400 0 -04}
    {3243816000 -10800 1 -03}
    {3245630400 -10800 1 -04}
    {3254698800 -14400 0 -04}
    {3275265600 -10800 1 -03}
    {3277080000 -10800 1 -04}
    {3286148400 -14400 0 -04}
    {3307320000 -10800 1 -03}
    {3308529600 -10800 1 -04}
    {3317598000 -14400 0 -04}
    {3338769600 -10800 1 -03}
    {3339979200 -10800 1 -04}
    {3349047600 -14400 0 -04}
    {3370219200 -10800 1 -03}
    {3371428800 -10800 1 -04}
    {3381102000 -14400 0 -04}
    {3401668800 -10800 1 -03}
    {3403483200 -10800 1 -04}
    {3412551600 -14400 0 -04}
    {3433118400 -10800 1 -03}
    {3434932800 -10800 1 -04}
    {3444001200 -14400 0 -04}
    {3464568000 -10800 1 -03}
    {3466382400 -10800 1 -04}
    {3475450800 -14400 0 -04}
    {3496622400 -10800 1 -03}
    {3497832000 -10800 1 -04}
    {3506900400 -14400 0 -04}
    {3528072000 -10800 1 -03}
    {3529281600 -10800 1 -04}
    {3538350000 -14400 0 -04}
    {3559521600 -10800 1 -03}
    {3560731200 -10800 1 -04}
    {3570404400 -14400 0 -04}
    {3590971200 -10800 1 -03}
    {3592785600 -10800 1 -04}
    {3601854000 -14400 0 -04}
    {3622420800 -10800 1 -03}
    {3624235200 -10800 1 -04}
    {3633303600 -14400 0 -04}
    {3654475200 -10800 1 -03}
    {3655684800 -10800 1 -04}
    {3664753200 -14400 0 -04}
    {3685924800 -10800 1 -03}
    {3687134400 -10800 1 -04}
    {3696202800 -14400 0 -04}
    {3717374400 -10800 1 -03}
    {3718584000 -10800 1 -04}
    {3727652400 -14400 0 -04}
    {3748824000 -10800 1 -03}
    {3750638400 -10800 1 -04}
    {3759706800 -14400 0 -04}
    {3780273600 -10800 1 -03}
    {3782088000 -10800 1 -04}
    {3791156400 -14400 0 -04}
    {3811723200 -10800 1 -03}
    {3813537600 -10800 1 -04}
    {3822606000 -14400 0 -04}
    {3843777600 -10800 1 -03}
    {3844987200 -10800 1 -04}
    {3854055600 -14400 0 -04}
    {3875227200 -10800 1 -03}
    {3876436800 -10800 1 -04}
    {3885505200 -14400 0 -04}
    {3906676800 -10800 1 -03}
    {3907886400 -10800 1 -04}
    {3917559600 -14400 0 -04}
    {3938126400 -10800 1 -03}
    {3939940800 -10800 1 -04}
    {3949009200 -14400 0 -04}
    {3969576000 -10800 1 -03}
    {3971390400 -10800 1 -04}
    {3980458800 -14400 0 -04}
    {4001630400 -10800 1 -03}
    {4002840000 -10800 1 -04}
    {4011908400 -14400 0 -04}
    {4033080000 -10800 1 -03}
    {4034289600 -10800 1 -04}
    {4043358000 -14400 0 -04}
    {4064529600 -10800 1 -03}
    {4065739200 -10800 1 -04}
    {4074807600 -14400 0 -04}
    {4095979200 -10800 1 -03}
    {4097188800 -10800 1 -04}
}

Changes to library/tzdata/America/Cuiaba.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64
65
66

67
68

69
70

71
72

73
74

75
76

77
78

79
80

81
82

83
84

85
86

87
88

89
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
128

129
130

131
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

161
162

163
164

165
166

167
168

169
170

171
172

173
174

175
176

177
178

179
180

181
182

183
184

185
186

187
188

189
190

191
192

193
194

195
196

197
198

199
200

201
202

203
204

205
206

207
208

209
210

211
212

213
214

215
216

217
218

219
220

221
222

223
224

225
226

227
228

229
230

231
232

233
234

235
236

237
238

239
240

241
242

243
244

245
246

247
248

249
250

251
252

253
254

255
256

257
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63
64
65

66
67

68
69

70
71

72
73

74
75

76
77

78
79

80
81

82
83

84
85

86
87

88
89

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

128
129

130
131

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
161

162
163

164
165

166
167

168
169

170
171

172
173

174
175

176
177

178
179

180
181

182
183

184
185

186
187

188
189

190
191

192
193

194
195

196
197

198
199

200
201

202
203

204
205

206
207

208
209

210
211

212
213

214
215

216
217

218
219

220
221

222
223

224
225

226
227

228
229

230
231

232
233

234
235

236
237

238
239

240
241

242
243

244
245

246
247

248
249

250
251

252
253

254
255

256
257





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Cuiaba) {
    {-9223372036854775808 -13460 0 LMT}
    {-1767212140 -14400 0 -04}
    {-1206954000 -10800 1 -03}
    {-1206954000 -10800 1 -04}
    {-1191358800 -14400 0 -04}
    {-1175371200 -10800 1 -03}
    {-1175371200 -10800 1 -04}
    {-1159822800 -14400 0 -04}
    {-633816000 -10800 1 -03}
    {-633816000 -10800 1 -04}
    {-622065600 -14400 0 -04}
    {-602280000 -10800 1 -03}
    {-602280000 -10800 1 -04}
    {-591829200 -14400 0 -04}
    {-570744000 -10800 1 -03}
    {-570744000 -10800 1 -04}
    {-560206800 -14400 0 -04}
    {-539121600 -10800 1 -03}
    {-539121600 -10800 1 -04}
    {-531349200 -14400 0 -04}
    {-191361600 -10800 1 -03}
    {-191361600 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-155160000 -10800 1 -03}
    {-155160000 -10800 1 -04}
    {-150066000 -14400 0 -04}
    {-128894400 -10800 1 -03}
    {-128894400 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-99950400 -10800 1 -03}
    {-99950400 -10800 1 -04}
    {-89586000 -14400 0 -04}
    {-68414400 -10800 1 -03}
    {-68414400 -10800 1 -04}
    {-57963600 -14400 0 -04}
    {499752000 -10800 1 -03}
    {499752000 -10800 1 -04}
    {511239600 -14400 0 -04}
    {530596800 -10800 1 -03}
    {530596800 -10800 1 -04}
    {540270000 -14400 0 -04}
    {562132800 -10800 1 -03}
    {562132800 -10800 1 -04}
    {571201200 -14400 0 -04}
    {592977600 -10800 1 -03}
    {592977600 -10800 1 -04}
    {602046000 -14400 0 -04}
    {624427200 -10800 1 -03}
    {624427200 -10800 1 -04}
    {634705200 -14400 0 -04}
    {656481600 -10800 1 -03}
    {656481600 -10800 1 -04}
    {666759600 -14400 0 -04}
    {687931200 -10800 1 -03}
    {687931200 -10800 1 -04}
    {697604400 -14400 0 -04}
    {719985600 -10800 1 -03}
    {719985600 -10800 1 -04}
    {728449200 -14400 0 -04}
    {750830400 -10800 1 -03}
    {750830400 -10800 1 -04}
    {761713200 -14400 0 -04}
    {782280000 -10800 1 -03}
    {782280000 -10800 1 -04}
    {793162800 -14400 0 -04}
    {813729600 -10800 1 -03}
    {813729600 -10800 1 -04}
    {824007600 -14400 0 -04}
    {844574400 -10800 1 -03}
    {844574400 -10800 1 -04}
    {856062000 -14400 0 -04}
    {876110400 -10800 1 -03}
    {876110400 -10800 1 -04}
    {888721200 -14400 0 -04}
    {908078400 -10800 1 -03}
    {908078400 -10800 1 -04}
    {919566000 -14400 0 -04}
    {938923200 -10800 1 -03}
    {938923200 -10800 1 -04}
    {951620400 -14400 0 -04}
    {970977600 -10800 1 -03}
    {970977600 -10800 1 -04}
    {982465200 -14400 0 -04}
    {1003032000 -10800 1 -03}
    {1003032000 -10800 1 -04}
    {1013914800 -14400 0 -04}
    {1036296000 -10800 1 -03}
    {1036296000 -10800 1 -04}
    {1045364400 -14400 0 -04}
    {1064372400 -14400 0 -04}
    {1096603200 -14400 0 -04}
    {1099368000 -10800 1 -03}
    {1099368000 -10800 1 -04}
    {1108868400 -14400 0 -04}
    {1129435200 -10800 1 -03}
    {1129435200 -10800 1 -04}
    {1140318000 -14400 0 -04}
    {1162699200 -10800 1 -03}
    {1162699200 -10800 1 -04}
    {1172372400 -14400 0 -04}
    {1192334400 -10800 1 -03}
    {1192334400 -10800 1 -04}
    {1203217200 -14400 0 -04}
    {1224388800 -10800 1 -03}
    {1224388800 -10800 1 -04}
    {1234666800 -14400 0 -04}
    {1255838400 -10800 1 -03}
    {1255838400 -10800 1 -04}
    {1266721200 -14400 0 -04}
    {1287288000 -10800 1 -03}
    {1287288000 -10800 1 -04}
    {1298170800 -14400 0 -04}
    {1318737600 -10800 1 -03}
    {1318737600 -10800 1 -04}
    {1330225200 -14400 0 -04}
    {1350792000 -10800 1 -03}
    {1350792000 -10800 1 -04}
    {1361070000 -14400 0 -04}
    {1382241600 -10800 1 -03}
    {1382241600 -10800 1 -04}
    {1392519600 -14400 0 -04}
    {1413691200 -10800 1 -03}
    {1413691200 -10800 1 -04}
    {1424574000 -14400 0 -04}
    {1445140800 -10800 1 -03}
    {1445140800 -10800 1 -04}
    {1456023600 -14400 0 -04}
    {1476590400 -10800 1 -03}
    {1476590400 -10800 1 -04}
    {1487473200 -14400 0 -04}
    {1508040000 -10800 1 -03}
    {1508040000 -10800 1 -04}
    {1518922800 -14400 0 -04}
    {1540094400 -10800 1 -03}
    {1541304000 -10800 1 -04}
    {1550372400 -14400 0 -04}
    {1571544000 -10800 1 -03}
    {1572753600 -10800 1 -04}
    {1581822000 -14400 0 -04}
    {1602993600 -10800 1 -03}
    {1604203200 -10800 1 -04}
    {1613876400 -14400 0 -04}
    {1634443200 -10800 1 -03}
    {1636257600 -10800 1 -04}
    {1645326000 -14400 0 -04}
    {1665892800 -10800 1 -03}
    {1667707200 -10800 1 -04}
    {1677380400 -14400 0 -04}
    {1697342400 -10800 1 -03}
    {1699156800 -10800 1 -04}
    {1708225200 -14400 0 -04}
    {1729396800 -10800 1 -03}
    {1730606400 -10800 1 -04}
    {1739674800 -14400 0 -04}
    {1760846400 -10800 1 -03}
    {1762056000 -10800 1 -04}
    {1771729200 -14400 0 -04}
    {1792296000 -10800 1 -03}
    {1793505600 -10800 1 -04}
    {1803178800 -14400 0 -04}
    {1823745600 -10800 1 -03}
    {1825560000 -10800 1 -04}
    {1834628400 -14400 0 -04}
    {1855195200 -10800 1 -03}
    {1857009600 -10800 1 -04}
    {1866078000 -14400 0 -04}
    {1887249600 -10800 1 -03}
    {1888459200 -10800 1 -04}
    {1897527600 -14400 0 -04}
    {1918699200 -10800 1 -03}
    {1919908800 -10800 1 -04}
    {1928977200 -14400 0 -04}
    {1950148800 -10800 1 -03}
    {1951358400 -10800 1 -04}
    {1960426800 -14400 0 -04}
    {1981598400 -10800 1 -03}
    {1983412800 -10800 1 -04}
    {1992481200 -14400 0 -04}
    {2013048000 -10800 1 -03}
    {2014862400 -10800 1 -04}
    {2024535600 -14400 0 -04}
    {2044497600 -10800 1 -03}
    {2046312000 -10800 1 -04}
    {2055380400 -14400 0 -04}
    {2076552000 -10800 1 -03}
    {2077761600 -10800 1 -04}
    {2086830000 -14400 0 -04}
    {2108001600 -10800 1 -03}
    {2109211200 -10800 1 -04}
    {2118884400 -14400 0 -04}
    {2139451200 -10800 1 -03}
    {2140660800 -10800 1 -04}
    {2150334000 -14400 0 -04}
    {2170900800 -10800 1 -03}
    {2172715200 -10800 1 -04}
    {2181783600 -14400 0 -04}
    {2202350400 -10800 1 -03}
    {2204164800 -10800 1 -04}
    {2213233200 -14400 0 -04}
    {2234404800 -10800 1 -03}
    {2235614400 -10800 1 -04}
    {2244682800 -14400 0 -04}
    {2265854400 -10800 1 -03}
    {2267064000 -10800 1 -04}
    {2276132400 -14400 0 -04}
    {2297304000 -10800 1 -03}
    {2298513600 -10800 1 -04}
    {2307582000 -14400 0 -04}
    {2328753600 -10800 1 -03}
    {2329963200 -10800 1 -04}
    {2339636400 -14400 0 -04}
    {2360203200 -10800 1 -03}
    {2362017600 -10800 1 -04}
    {2371086000 -14400 0 -04}
    {2391652800 -10800 1 -03}
    {2393467200 -10800 1 -04}
    {2402535600 -14400 0 -04}
    {2423707200 -10800 1 -03}
    {2424916800 -10800 1 -04}
    {2433985200 -14400 0 -04}
    {2455156800 -10800 1 -03}
    {2456366400 -10800 1 -04}
    {2465434800 -14400 0 -04}
    {2486606400 -10800 1 -03}
    {2487816000 -10800 1 -04}
    {2497489200 -14400 0 -04}
    {2518056000 -10800 1 -03}
    {2519870400 -10800 1 -04}
    {2528938800 -14400 0 -04}
    {2549505600 -10800 1 -03}
    {2551320000 -10800 1 -04}
    {2560388400 -14400 0 -04}
    {2580955200 -10800 1 -03}
    {2582769600 -10800 1 -04}
    {2591838000 -14400 0 -04}
    {2613009600 -10800 1 -03}
    {2614219200 -10800 1 -04}
    {2623287600 -14400 0 -04}
    {2644459200 -10800 1 -03}
    {2645668800 -10800 1 -04}
    {2654737200 -14400 0 -04}
    {2675908800 -10800 1 -03}
    {2677118400 -10800 1 -04}
    {2686791600 -14400 0 -04}
    {2707358400 -10800 1 -03}
    {2709172800 -10800 1 -04}
    {2718241200 -14400 0 -04}
    {2738808000 -10800 1 -03}
    {2740622400 -10800 1 -04}
    {2749690800 -14400 0 -04}
    {2770862400 -10800 1 -03}
    {2772072000 -10800 1 -04}
    {2781140400 -14400 0 -04}
    {2802312000 -10800 1 -03}
    {2803521600 -10800 1 -04}
    {2812590000 -14400 0 -04}
    {2833761600 -10800 1 -03}
    {2834971200 -10800 1 -04}
    {2844039600 -14400 0 -04}
    {2865211200 -10800 1 -03}
    {2867025600 -10800 1 -04}
    {2876094000 -14400 0 -04}
    {2896660800 -10800 1 -03}
    {2898475200 -10800 1 -04}
    {2907543600 -14400 0 -04}
    {2928110400 -10800 1 -03}
    {2929924800 -10800 1 -04}
    {2938993200 -14400 0 -04}
    {2960164800 -10800 1 -03}
    {2961374400 -10800 1 -04}
    {2970442800 -14400 0 -04}
    {2991614400 -10800 1 -03}
    {2992824000 -10800 1 -04}
    {3001892400 -14400 0 -04}
    {3023064000 -10800 1 -03}
    {3024273600 -10800 1 -04}
    {3033946800 -14400 0 -04}
    {3054513600 -10800 1 -03}
    {3056328000 -10800 1 -04}
    {3065396400 -14400 0 -04}
    {3085963200 -10800 1 -03}
    {3087777600 -10800 1 -04}
    {3096846000 -14400 0 -04}
    {3118017600 -10800 1 -03}
    {3119227200 -10800 1 -04}
    {3128295600 -14400 0 -04}
    {3149467200 -10800 1 -03}
    {3150676800 -10800 1 -04}
    {3159745200 -14400 0 -04}
    {3180916800 -10800 1 -03}
    {3182126400 -10800 1 -04}
    {3191194800 -14400 0 -04}
    {3212366400 -10800 1 -03}
    {3213576000 -10800 1 -04}
    {3223249200 -14400 0 -04}
    {3243816000 -10800 1 -03}
    {3245630400 -10800 1 -04}
    {3254698800 -14400 0 -04}
    {3275265600 -10800 1 -03}
    {3277080000 -10800 1 -04}
    {3286148400 -14400 0 -04}
    {3307320000 -10800 1 -03}
    {3308529600 -10800 1 -04}
    {3317598000 -14400 0 -04}
    {3338769600 -10800 1 -03}
    {3339979200 -10800 1 -04}
    {3349047600 -14400 0 -04}
    {3370219200 -10800 1 -03}
    {3371428800 -10800 1 -04}
    {3381102000 -14400 0 -04}
    {3401668800 -10800 1 -03}
    {3403483200 -10800 1 -04}
    {3412551600 -14400 0 -04}
    {3433118400 -10800 1 -03}
    {3434932800 -10800 1 -04}
    {3444001200 -14400 0 -04}
    {3464568000 -10800 1 -03}
    {3466382400 -10800 1 -04}
    {3475450800 -14400 0 -04}
    {3496622400 -10800 1 -03}
    {3497832000 -10800 1 -04}
    {3506900400 -14400 0 -04}
    {3528072000 -10800 1 -03}
    {3529281600 -10800 1 -04}
    {3538350000 -14400 0 -04}
    {3559521600 -10800 1 -03}
    {3560731200 -10800 1 -04}
    {3570404400 -14400 0 -04}
    {3590971200 -10800 1 -03}
    {3592785600 -10800 1 -04}
    {3601854000 -14400 0 -04}
    {3622420800 -10800 1 -03}
    {3624235200 -10800 1 -04}
    {3633303600 -14400 0 -04}
    {3654475200 -10800 1 -03}
    {3655684800 -10800 1 -04}
    {3664753200 -14400 0 -04}
    {3685924800 -10800 1 -03}
    {3687134400 -10800 1 -04}
    {3696202800 -14400 0 -04}
    {3717374400 -10800 1 -03}
    {3718584000 -10800 1 -04}
    {3727652400 -14400 0 -04}
    {3748824000 -10800 1 -03}
    {3750638400 -10800 1 -04}
    {3759706800 -14400 0 -04}
    {3780273600 -10800 1 -03}
    {3782088000 -10800 1 -04}
    {3791156400 -14400 0 -04}
    {3811723200 -10800 1 -03}
    {3813537600 -10800 1 -04}
    {3822606000 -14400 0 -04}
    {3843777600 -10800 1 -03}
    {3844987200 -10800 1 -04}
    {3854055600 -14400 0 -04}
    {3875227200 -10800 1 -03}
    {3876436800 -10800 1 -04}
    {3885505200 -14400 0 -04}
    {3906676800 -10800 1 -03}
    {3907886400 -10800 1 -04}
    {3917559600 -14400 0 -04}
    {3938126400 -10800 1 -03}
    {3939940800 -10800 1 -04}
    {3949009200 -14400 0 -04}
    {3969576000 -10800 1 -03}
    {3971390400 -10800 1 -04}
    {3980458800 -14400 0 -04}
    {4001630400 -10800 1 -03}
    {4002840000 -10800 1 -04}
    {4011908400 -14400 0 -04}
    {4033080000 -10800 1 -03}
    {4034289600 -10800 1 -04}
    {4043358000 -14400 0 -04}
    {4064529600 -10800 1 -03}
    {4065739200 -10800 1 -04}
    {4074807600 -14400 0 -04}
    {4095979200 -10800 1 -03}
    {4097188800 -10800 1 -04}
}

Changes to library/tzdata/America/Eirunepe.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34
35
36

37
38
39
40
41
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33
34
35

36
37
38
39
40
41





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



-
+





# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Eirunepe) {
    {-9223372036854775808 -16768 0 LMT}
    {-1767208832 -18000 0 -05}
    {-1206950400 -14400 1 -04}
    {-1206950400 -14400 1 -05}
    {-1191355200 -18000 0 -05}
    {-1175367600 -14400 1 -04}
    {-1175367600 -14400 1 -05}
    {-1159819200 -18000 0 -05}
    {-633812400 -14400 1 -04}
    {-633812400 -14400 1 -05}
    {-622062000 -18000 0 -05}
    {-602276400 -14400 1 -04}
    {-602276400 -14400 1 -05}
    {-591825600 -18000 0 -05}
    {-570740400 -14400 1 -04}
    {-570740400 -14400 1 -05}
    {-560203200 -18000 0 -05}
    {-539118000 -14400 1 -04}
    {-539118000 -14400 1 -05}
    {-531345600 -18000 0 -05}
    {-191358000 -14400 1 -04}
    {-191358000 -14400 1 -05}
    {-184190400 -18000 0 -05}
    {-155156400 -14400 1 -04}
    {-155156400 -14400 1 -05}
    {-150062400 -18000 0 -05}
    {-128890800 -14400 1 -04}
    {-128890800 -14400 1 -05}
    {-121118400 -18000 0 -05}
    {-99946800 -14400 1 -04}
    {-99946800 -14400 1 -05}
    {-89582400 -18000 0 -05}
    {-68410800 -14400 1 -04}
    {-68410800 -14400 1 -05}
    {-57960000 -18000 0 -05}
    {499755600 -14400 1 -04}
    {499755600 -14400 1 -05}
    {511243200 -18000 0 -05}
    {530600400 -14400 1 -04}
    {530600400 -14400 1 -05}
    {540273600 -18000 0 -05}
    {562136400 -14400 1 -04}
    {562136400 -14400 1 -05}
    {571204800 -18000 0 -05}
    {590040000 -18000 0 -05}
    {749192400 -18000 0 -05}
    {750834000 -14400 1 -04}
    {750834000 -14400 1 -05}
    {761716800 -18000 0 -05}
    {780206400 -18000 0 -05}
    {1214283600 -14400 0 -04}
    {1384056000 -18000 0 -05}
}

Changes to library/tzdata/America/Fortaleza.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38
39
40

41
42

43
44
45

46
47
48
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37
38
39

40
41

42
43
44

45
46
47
48





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



-
+

-
+


-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Fortaleza) {
    {-9223372036854775808 -9240 0 LMT}
    {-1767216360 -10800 0 -03}
    {-1206957600 -7200 1 -02}
    {-1206957600 -7200 1 -03}
    {-1191362400 -10800 0 -03}
    {-1175374800 -7200 1 -02}
    {-1175374800 -7200 1 -03}
    {-1159826400 -10800 0 -03}
    {-633819600 -7200 1 -02}
    {-633819600 -7200 1 -03}
    {-622069200 -10800 0 -03}
    {-602283600 -7200 1 -02}
    {-602283600 -7200 1 -03}
    {-591832800 -10800 0 -03}
    {-570747600 -7200 1 -02}
    {-570747600 -7200 1 -03}
    {-560210400 -10800 0 -03}
    {-539125200 -7200 1 -02}
    {-539125200 -7200 1 -03}
    {-531352800 -10800 0 -03}
    {-191365200 -7200 1 -02}
    {-191365200 -7200 1 -03}
    {-184197600 -10800 0 -03}
    {-155163600 -7200 1 -02}
    {-155163600 -7200 1 -03}
    {-150069600 -10800 0 -03}
    {-128898000 -7200 1 -02}
    {-128898000 -7200 1 -03}
    {-121125600 -10800 0 -03}
    {-99954000 -7200 1 -02}
    {-99954000 -7200 1 -03}
    {-89589600 -10800 0 -03}
    {-68418000 -7200 1 -02}
    {-68418000 -7200 1 -03}
    {-57967200 -10800 0 -03}
    {499748400 -7200 1 -02}
    {499748400 -7200 1 -03}
    {511236000 -10800 0 -03}
    {530593200 -7200 1 -02}
    {530593200 -7200 1 -03}
    {540266400 -10800 0 -03}
    {562129200 -7200 1 -02}
    {562129200 -7200 1 -03}
    {571197600 -10800 0 -03}
    {592974000 -7200 1 -02}
    {592974000 -7200 1 -03}
    {602042400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {634701600 -10800 0 -03}
    {653536800 -10800 0 -03}
    {938660400 -10800 0 -03}
    {938919600 -7200 1 -02}
    {938919600 -7200 1 -03}
    {951616800 -10800 0 -03}
    {970974000 -7200 1 -02}
    {970974000 -7200 1 -03}
    {972180000 -10800 0 -03}
    {1000350000 -10800 0 -03}
    {1003028400 -7200 1 -02}
    {1003028400 -7200 1 -03}
    {1013911200 -10800 0 -03}
    {1033437600 -10800 0 -03}
}

Changes to library/tzdata/America/Grand_Turk.

1
2
3
4
5
6


7
8
9
10
11
12
13
1
2
3
4


5
6
7
8
9
10
11
12
13




-
-
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Grand_Turk) {
    {-9223372036854775808 -17072 0 LMT}
    {-2524504528 -18431 0 KMT}
    {-1827687169 -18000 0 EST}
    {-2524504528 -18430 0 KMT}
    {-1827687170 -18000 0 EST}
    {284014800 -18000 0 EST}
    {294217200 -14400 1 EDT}
    {309938400 -18000 0 EST}
    {325666800 -14400 1 EDT}
    {341388000 -18000 0 EST}
    {357116400 -14400 1 EDT}
    {372837600 -18000 0 EST}

Changes to library/tzdata/America/Guayaquil.

1
2
3
4
5
6
7

8
9
1
2
3
4
5
6

7
8
9






-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Guayaquil) {
    {-9223372036854775808 -19160 0 LMT}
    {-2524502440 -18840 0 QMT}
    {-1230749160 -18000 0 -05}
    {722926800 -14400 1 -04}
    {722926800 -14400 1 -05}
    {728884800 -18000 0 -05}
}

Changes to library/tzdata/America/Jamaica.

1
2
3
4
5
6



7
8
9
10
11
12
13
1
2
3



4
5
6
7
8
9
10
11
12
13



-
-
-
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Jamaica) {
    {-9223372036854775808 -18431 0 LMT}
    {-2524503169 -18431 0 KMT}
    {-1827687169 -18000 0 EST}
    {-9223372036854775808 -18430 0 LMT}
    {-2524503170 -18430 0 KMT}
    {-1827687170 -18000 0 EST}
    {126248400 -18000 0 EST}
    {126687600 -14400 1 EDT}
    {152085600 -18000 0 EST}
    {162370800 -14400 1 EDT}
    {183535200 -18000 0 EST}
    {199263600 -14400 1 EDT}
    {215589600 -18000 0 EST}

Changes to library/tzdata/America/La_Paz.

1
2
3
4
5
6

7
8
1
2
3
4
5

6
7
8





-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:America/La_Paz) {
    {-9223372036854775808 -16356 0 LMT}
    {-2524505244 -16356 0 CMT}
    {-1205954844 -12756 1 BOST}
    {-1205954844 -12756 1 BST}
    {-1192307244 -14400 0 -04}
}

Changes to library/tzdata/America/Lima.

1
2
3
4
5
6

7
8

9
10

11
12
13
14
15
16
1
2
3
4
5

6
7

8
9

10
11
12
13
14
15
16





-
+

-
+

-
+






# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Lima) {
    {-9223372036854775808 -18492 0 LMT}
    {-2524503108 -18516 0 LMT}
    {-1938538284 -14400 0 -04}
    {-1938538284 -14400 0 -05}
    {-1002052800 -18000 0 -05}
    {-986756400 -14400 1 -04}
    {-986756400 -14400 1 -05}
    {-971035200 -18000 0 -05}
    {-955306800 -14400 1 -04}
    {-955306800 -14400 1 -05}
    {-939585600 -18000 0 -05}
    {512712000 -18000 0 -05}
    {544248000 -18000 0 -05}
    {638942400 -18000 0 -05}
    {765172800 -18000 0 -05}
}

Changes to library/tzdata/America/Maceio.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38
39
40

41
42
43
44

45
46

47
48
49

50
51
52
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37
38
39

40
41
42
43

44
45

46
47
48

49
50
51
52





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



-
+



-
+

-
+


-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Maceio) {
    {-9223372036854775808 -8572 0 LMT}
    {-1767217028 -10800 0 -03}
    {-1206957600 -7200 1 -02}
    {-1206957600 -7200 1 -03}
    {-1191362400 -10800 0 -03}
    {-1175374800 -7200 1 -02}
    {-1175374800 -7200 1 -03}
    {-1159826400 -10800 0 -03}
    {-633819600 -7200 1 -02}
    {-633819600 -7200 1 -03}
    {-622069200 -10800 0 -03}
    {-602283600 -7200 1 -02}
    {-602283600 -7200 1 -03}
    {-591832800 -10800 0 -03}
    {-570747600 -7200 1 -02}
    {-570747600 -7200 1 -03}
    {-560210400 -10800 0 -03}
    {-539125200 -7200 1 -02}
    {-539125200 -7200 1 -03}
    {-531352800 -10800 0 -03}
    {-191365200 -7200 1 -02}
    {-191365200 -7200 1 -03}
    {-184197600 -10800 0 -03}
    {-155163600 -7200 1 -02}
    {-155163600 -7200 1 -03}
    {-150069600 -10800 0 -03}
    {-128898000 -7200 1 -02}
    {-128898000 -7200 1 -03}
    {-121125600 -10800 0 -03}
    {-99954000 -7200 1 -02}
    {-99954000 -7200 1 -03}
    {-89589600 -10800 0 -03}
    {-68418000 -7200 1 -02}
    {-68418000 -7200 1 -03}
    {-57967200 -10800 0 -03}
    {499748400 -7200 1 -02}
    {499748400 -7200 1 -03}
    {511236000 -10800 0 -03}
    {530593200 -7200 1 -02}
    {530593200 -7200 1 -03}
    {540266400 -10800 0 -03}
    {562129200 -7200 1 -02}
    {562129200 -7200 1 -03}
    {571197600 -10800 0 -03}
    {592974000 -7200 1 -02}
    {592974000 -7200 1 -03}
    {602042400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {634701600 -10800 0 -03}
    {653536800 -10800 0 -03}
    {813553200 -10800 0 -03}
    {813726000 -7200 1 -02}
    {813726000 -7200 1 -03}
    {824004000 -10800 0 -03}
    {841802400 -10800 0 -03}
    {938660400 -10800 0 -03}
    {938919600 -7200 1 -02}
    {938919600 -7200 1 -03}
    {951616800 -10800 0 -03}
    {970974000 -7200 1 -02}
    {970974000 -7200 1 -03}
    {972180000 -10800 0 -03}
    {1000350000 -10800 0 -03}
    {1003028400 -7200 1 -02}
    {1003028400 -7200 1 -03}
    {1013911200 -10800 0 -03}
    {1033437600 -10800 0 -03}
}

Changes to library/tzdata/America/Manaus.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34
35
36

37
38
39
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33
34
35

36
37
38
39





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Manaus) {
    {-9223372036854775808 -14404 0 LMT}
    {-1767211196 -14400 0 -04}
    {-1206954000 -10800 1 -03}
    {-1206954000 -10800 1 -04}
    {-1191358800 -14400 0 -04}
    {-1175371200 -10800 1 -03}
    {-1175371200 -10800 1 -04}
    {-1159822800 -14400 0 -04}
    {-633816000 -10800 1 -03}
    {-633816000 -10800 1 -04}
    {-622065600 -14400 0 -04}
    {-602280000 -10800 1 -03}
    {-602280000 -10800 1 -04}
    {-591829200 -14400 0 -04}
    {-570744000 -10800 1 -03}
    {-570744000 -10800 1 -04}
    {-560206800 -14400 0 -04}
    {-539121600 -10800 1 -03}
    {-539121600 -10800 1 -04}
    {-531349200 -14400 0 -04}
    {-191361600 -10800 1 -03}
    {-191361600 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-155160000 -10800 1 -03}
    {-155160000 -10800 1 -04}
    {-150066000 -14400 0 -04}
    {-128894400 -10800 1 -03}
    {-128894400 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-99950400 -10800 1 -03}
    {-99950400 -10800 1 -04}
    {-89586000 -14400 0 -04}
    {-68414400 -10800 1 -03}
    {-68414400 -10800 1 -04}
    {-57963600 -14400 0 -04}
    {499752000 -10800 1 -03}
    {499752000 -10800 1 -04}
    {511239600 -14400 0 -04}
    {530596800 -10800 1 -03}
    {530596800 -10800 1 -04}
    {540270000 -14400 0 -04}
    {562132800 -10800 1 -03}
    {562132800 -10800 1 -04}
    {571201200 -14400 0 -04}
    {590036400 -14400 0 -04}
    {749188800 -14400 0 -04}
    {750830400 -10800 1 -03}
    {750830400 -10800 1 -04}
    {761713200 -14400 0 -04}
    {780202800 -14400 0 -04}
}

Changes to library/tzdata/America/Montevideo.

1
2
3
4
5
6
7




8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31
32
33
34
35






36
37

38
39
40
41
42
43
44
45


46
47
48


49
50
51
52



53

54
55
56
57
58
59
60
61
62
63
64
65
66
67
68




















69
70

71
72

73
74

75
76

77
78

79
80

81
82

83
84

85
86

87
88

89
90

91
92

93
94

95
96
1
2
3




4
5
6
7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29






30
31
32
33
34
35
36

37
38




39


40
41



42
43




44
45
46
47
48















49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

70
71

72
73

74
75

76
77

78
79

80
81

82
83

84
85

86
87

88
89

90
91

92
93

94
95
96



-
-
-
-
+
+
+
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+
-
-
-
-
-
-
+
+
+
+
+
+

-
+

-
-
-
-

-
-
+
+
-
-
-
+
+
-
-
-
-
+
+
+

+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Montevideo) {
    {-9223372036854775808 -13484 0 LMT}
    {-2256668116 -13484 0 MMT}
    {-1567455316 -12600 0 -0330}
    {-1459542600 -10800 1 -03}
    {-9223372036854775808 -13491 0 LMT}
    {-1942690509 -13491 0 MMT}
    {-1567455309 -14400 0 -04}
    {-1459627200 -10800 0 -0330}
    {-1443819600 -12600 0 -0330}
    {-1428006600 -10800 1 -03}
    {-1428006600 -10800 1 -0330}
    {-1412283600 -12600 0 -0330}
    {-1396470600 -10800 1 -03}
    {-1396470600 -10800 1 -0330}
    {-1380747600 -12600 0 -0330}
    {-1141590600 -10800 1 -03}
    {-1141590600 -10800 1 -0330}
    {-1128286800 -12600 0 -0330}
    {-1110141000 -10800 1 -03}
    {-1110141000 -10800 1 -0330}
    {-1096837200 -12600 0 -0330}
    {-1078691400 -10800 1 -03}
    {-1078691400 -10800 1 -0330}
    {-1065387600 -12600 0 -0330}
    {-1046637000 -10800 1 -03}
    {-1047241800 -10800 1 -0330}
    {-1033938000 -12600 0 -0330}
    {-1015187400 -10800 1 -03}
    {-1015187400 -10800 1 -0330}
    {-1002488400 -12600 0 -0330}
    {-983737800 -10800 1 -03}
    {-983737800 -10800 1 -0330}
    {-971038800 -12600 0 -0330}
    {-952288200 -10800 1 -03}
    {-954707400 -10800 1 -0330}
    {-938984400 -12600 0 -0330}
    {-920838600 -10800 1 -03}
    {-920838600 -10800 1 -0330}
    {-907534800 -12600 0 -0330}
    {-896819400 -10800 1 -03}
    {-896819400 -10800 1 -0330}
    {-853623000 -10800 0 -03}
    {-853621200 -7200 1 -02}
    {-845848800 -10800 0 -03}
    {-334789200 -7200 1 -02}
    {-319672800 -10800 0 -03}
    {-314226000 -7200 1 -02}
    {-853621200 -9000 0 -03}
    {-845847000 -10800 0 -03}
    {-334789200 -9000 1 -03}
    {-319671000 -10800 0 -03}
    {-315608400 -10800 0 -03}
    {-314226000 -7200 1 -03}
    {-309996000 -10800 0 -03}
    {-149720400 -7200 1 -02}
    {-149720400 -7200 1 -03}
    {-134604000 -10800 0 -03}
    {-118270800 -7200 1 -02}
    {-100044000 -10800 0 -03}
    {-86821200 -7200 1 -02}
    {-68508000 -10800 0 -03}
    {-63147600 -10800 0 -03}
    {-50446800 -9000 1 -0230}
    {-34119000 -10800 0 -03}
    {-50446800 -9000 1 -03}
    {-34205400 -10800 0 -03}
    {-18910800 -9000 1 -0230}
    {-2583000 -10800 0 -03}
    {12625200 -9000 1 -0230}
    {10800 -10800 0 -03}
    {9860400 -7200 1 -03}
    {28953000 -10800 0 -03}
    {31546800 -10800 0 -03}
    {72932400 -7200 1 -02}
    {82692000 -10800 0 -03}
    {14176800 -10800 0 -03}
    {72846000 -7200 1 -03}
    {80100000 -10800 0 -03}
    {126241200 -10800 0 -03}
    {127278000 -5400 1 -03}
    {132116400 -9000 1 -0230}
    {156909600 -9000 0 -02}
    {156911400 -7200 1 -02}
    {212983200 -10800 0 -03}
    {250052400 -7200 1 -02}
    {260244000 -10800 0 -03}
    {307594800 -7200 1 -02}
    {325994400 -10800 0 -03}
    {566449200 -7200 1 -02}
    {574308000 -10800 0 -03}
    {597812400 -7200 1 -02}
    {605671200 -10800 0 -03}
    {625633200 -7200 1 -02}
    {636516000 -10800 0 -03}
    {656478000 -7200 1 -02}
    {132112800 -9000 0 -03}
    {147234600 -10800 0 -03}
    {156909600 -10800 0 -03}
    {156913200 -7200 1 -03}
    {165376800 -10800 0 -03}
    {219812400 -7200 1 -03}
    {226461600 -10800 0 -03}
    {250052400 -7200 1 -03}
    {257911200 -10800 0 -03}
    {282711600 -7200 1 -03}
    {289360800 -10800 0 -03}
    {294202800 -7200 1 -03}
    {322020000 -10800 0 -03}
    {566449200 -7200 1 -03}
    {573012000 -10800 0 -03}
    {597812400 -7200 1 -03}
    {605066400 -10800 0 -03}
    {625633200 -7200 1 -03}
    {635911200 -10800 0 -03}
    {656478000 -7200 1 -03}
    {667965600 -10800 0 -03}
    {688532400 -7200 1 -02}
    {688532400 -7200 1 -03}
    {699415200 -10800 0 -03}
    {719377200 -7200 1 -02}
    {719377200 -7200 1 -03}
    {730864800 -10800 0 -03}
    {1095562800 -7200 1 -02}
    {1095562800 -7200 1 -03}
    {1111896000 -10800 0 -03}
    {1128834000 -7200 1 -02}
    {1128834000 -7200 1 -03}
    {1142136000 -10800 0 -03}
    {1159678800 -7200 1 -02}
    {1159678800 -7200 1 -03}
    {1173585600 -10800 0 -03}
    {1191733200 -7200 1 -02}
    {1191733200 -7200 1 -03}
    {1205035200 -10800 0 -03}
    {1223182800 -7200 1 -02}
    {1223182800 -7200 1 -03}
    {1236484800 -10800 0 -03}
    {1254632400 -7200 1 -02}
    {1254632400 -7200 1 -03}
    {1268539200 -10800 0 -03}
    {1286082000 -7200 1 -02}
    {1286082000 -7200 1 -03}
    {1299988800 -10800 0 -03}
    {1317531600 -7200 1 -02}
    {1317531600 -7200 1 -03}
    {1331438400 -10800 0 -03}
    {1349586000 -7200 1 -02}
    {1349586000 -7200 1 -03}
    {1362888000 -10800 0 -03}
    {1381035600 -7200 1 -02}
    {1381035600 -7200 1 -03}
    {1394337600 -10800 0 -03}
    {1412485200 -7200 1 -02}
    {1412485200 -7200 1 -03}
    {1425787200 -10800 0 -03}
}

Changes to library/tzdata/America/Noronha.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38
39
40

41
42

43
44
45

46
47
48
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37
38
39

40
41

42
43
44

45
46
47
48





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



-
+

-
+


-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Noronha) {
    {-9223372036854775808 -7780 0 LMT}
    {-1767217820 -7200 0 -02}
    {-1206961200 -3600 1 -01}
    {-1206961200 -3600 1 -02}
    {-1191366000 -7200 0 -02}
    {-1175378400 -3600 1 -01}
    {-1175378400 -3600 1 -02}
    {-1159830000 -7200 0 -02}
    {-633823200 -3600 1 -01}
    {-633823200 -3600 1 -02}
    {-622072800 -7200 0 -02}
    {-602287200 -3600 1 -01}
    {-602287200 -3600 1 -02}
    {-591836400 -7200 0 -02}
    {-570751200 -3600 1 -01}
    {-570751200 -3600 1 -02}
    {-560214000 -7200 0 -02}
    {-539128800 -3600 1 -01}
    {-539128800 -3600 1 -02}
    {-531356400 -7200 0 -02}
    {-191368800 -3600 1 -01}
    {-191368800 -3600 1 -02}
    {-184201200 -7200 0 -02}
    {-155167200 -3600 1 -01}
    {-155167200 -3600 1 -02}
    {-150073200 -7200 0 -02}
    {-128901600 -3600 1 -01}
    {-128901600 -3600 1 -02}
    {-121129200 -7200 0 -02}
    {-99957600 -3600 1 -01}
    {-99957600 -3600 1 -02}
    {-89593200 -7200 0 -02}
    {-68421600 -3600 1 -01}
    {-68421600 -3600 1 -02}
    {-57970800 -7200 0 -02}
    {499744800 -3600 1 -01}
    {499744800 -3600 1 -02}
    {511232400 -7200 0 -02}
    {530589600 -3600 1 -01}
    {530589600 -3600 1 -02}
    {540262800 -7200 0 -02}
    {562125600 -3600 1 -01}
    {562125600 -3600 1 -02}
    {571194000 -7200 0 -02}
    {592970400 -3600 1 -01}
    {592970400 -3600 1 -02}
    {602038800 -7200 0 -02}
    {624420000 -3600 1 -01}
    {624420000 -3600 1 -02}
    {634698000 -7200 0 -02}
    {653533200 -7200 0 -02}
    {938656800 -7200 0 -02}
    {938916000 -3600 1 -01}
    {938916000 -3600 1 -02}
    {951613200 -7200 0 -02}
    {970970400 -3600 1 -01}
    {970970400 -3600 1 -02}
    {971571600 -7200 0 -02}
    {1000346400 -7200 0 -02}
    {1003024800 -3600 1 -01}
    {1003024800 -3600 1 -02}
    {1013907600 -7200 0 -02}
    {1033434000 -7200 0 -02}
}

Changes to library/tzdata/America/Porto_Velho.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34
35
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33
34
35





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Porto_Velho) {
    {-9223372036854775808 -15336 0 LMT}
    {-1767210264 -14400 0 -04}
    {-1206954000 -10800 1 -03}
    {-1206954000 -10800 1 -04}
    {-1191358800 -14400 0 -04}
    {-1175371200 -10800 1 -03}
    {-1175371200 -10800 1 -04}
    {-1159822800 -14400 0 -04}
    {-633816000 -10800 1 -03}
    {-633816000 -10800 1 -04}
    {-622065600 -14400 0 -04}
    {-602280000 -10800 1 -03}
    {-602280000 -10800 1 -04}
    {-591829200 -14400 0 -04}
    {-570744000 -10800 1 -03}
    {-570744000 -10800 1 -04}
    {-560206800 -14400 0 -04}
    {-539121600 -10800 1 -03}
    {-539121600 -10800 1 -04}
    {-531349200 -14400 0 -04}
    {-191361600 -10800 1 -03}
    {-191361600 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-155160000 -10800 1 -03}
    {-155160000 -10800 1 -04}
    {-150066000 -14400 0 -04}
    {-128894400 -10800 1 -03}
    {-128894400 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-99950400 -10800 1 -03}
    {-99950400 -10800 1 -04}
    {-89586000 -14400 0 -04}
    {-68414400 -10800 1 -03}
    {-68414400 -10800 1 -04}
    {-57963600 -14400 0 -04}
    {499752000 -10800 1 -03}
    {499752000 -10800 1 -04}
    {511239600 -14400 0 -04}
    {530596800 -10800 1 -03}
    {530596800 -10800 1 -04}
    {540270000 -14400 0 -04}
    {562132800 -10800 1 -03}
    {562132800 -10800 1 -04}
    {571201200 -14400 0 -04}
    {590036400 -14400 0 -04}
}

Changes to library/tzdata/America/Punta_Arenas.

1
2
3
4
5
6
7
8
9
10
11

12
13

14
15

16
17

18
19

20
21
22
23
24
25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66

67
68

69
70

71
72

73
74

75
76

77
78

79
80

81
82

83
84

85
86

87
88

89
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
1
2
3
4
5
6
7
8
9
10

11
12

13
14

15
16

17
18

19
20
21
22
23
24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67

68
69

70
71

72
73

74
75

76
77

78
79

80
81

82
83

84
85

86
87

88
89

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










-
+

-
+

-
+

-
+

-
+






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Punta_Arenas) {
    {-9223372036854775808 -17020 0 LMT}
    {-2524504580 -16966 0 SMT}
    {-1892661434 -18000 0 -05}
    {-1688410800 -16966 0 SMT}
    {-1619205434 -14400 0 -04}
    {-1593806400 -16966 0 SMT}
    {-1335986234 -18000 0 -05}
    {-1335985200 -14400 1 -04}
    {-1335985200 -14400 1 -05}
    {-1317585600 -18000 0 -05}
    {-1304362800 -14400 1 -04}
    {-1304362800 -14400 1 -05}
    {-1286049600 -18000 0 -05}
    {-1272826800 -14400 1 -04}
    {-1272826800 -14400 1 -05}
    {-1254513600 -18000 0 -05}
    {-1241290800 -14400 1 -04}
    {-1241290800 -14400 1 -05}
    {-1222977600 -18000 0 -05}
    {-1209754800 -14400 1 -04}
    {-1209754800 -14400 1 -05}
    {-1191355200 -18000 0 -05}
    {-1178132400 -14400 0 -04}
    {-870552000 -18000 0 -05}
    {-865278000 -14400 0 -04}
    {-718056000 -18000 0 -05}
    {-713649600 -14400 0 -04}
    {-36619200 -10800 1 -03}
    {-36619200 -10800 1 -04}
    {-23922000 -14400 0 -04}
    {-3355200 -10800 1 -03}
    {-3355200 -10800 1 -04}
    {7527600 -14400 0 -04}
    {24465600 -10800 1 -03}
    {24465600 -10800 1 -04}
    {37767600 -14400 0 -04}
    {55915200 -10800 1 -03}
    {55915200 -10800 1 -04}
    {69217200 -14400 0 -04}
    {87969600 -10800 1 -03}
    {87969600 -10800 1 -04}
    {100666800 -14400 0 -04}
    {118209600 -10800 1 -03}
    {118209600 -10800 1 -04}
    {132116400 -14400 0 -04}
    {150868800 -10800 1 -03}
    {150868800 -10800 1 -04}
    {163566000 -14400 0 -04}
    {182318400 -10800 1 -03}
    {182318400 -10800 1 -04}
    {195620400 -14400 0 -04}
    {213768000 -10800 1 -03}
    {213768000 -10800 1 -04}
    {227070000 -14400 0 -04}
    {245217600 -10800 1 -03}
    {245217600 -10800 1 -04}
    {258519600 -14400 0 -04}
    {277272000 -10800 1 -03}
    {277272000 -10800 1 -04}
    {289969200 -14400 0 -04}
    {308721600 -10800 1 -03}
    {308721600 -10800 1 -04}
    {321418800 -14400 0 -04}
    {340171200 -10800 1 -03}
    {340171200 -10800 1 -04}
    {353473200 -14400 0 -04}
    {371620800 -10800 1 -03}
    {371620800 -10800 1 -04}
    {384922800 -14400 0 -04}
    {403070400 -10800 1 -03}
    {403070400 -10800 1 -04}
    {416372400 -14400 0 -04}
    {434520000 -10800 1 -03}
    {434520000 -10800 1 -04}
    {447822000 -14400 0 -04}
    {466574400 -10800 1 -03}
    {466574400 -10800 1 -04}
    {479271600 -14400 0 -04}
    {498024000 -10800 1 -03}
    {498024000 -10800 1 -04}
    {510721200 -14400 0 -04}
    {529473600 -10800 1 -03}
    {529473600 -10800 1 -04}
    {545194800 -14400 0 -04}
    {560923200 -10800 1 -03}
    {560923200 -10800 1 -04}
    {574225200 -14400 0 -04}
    {592372800 -10800 1 -03}
    {592372800 -10800 1 -04}
    {605674800 -14400 0 -04}
    {624427200 -10800 1 -03}
    {624427200 -10800 1 -04}
    {637124400 -14400 0 -04}
    {653457600 -10800 1 -03}
    {653457600 -10800 1 -04}
    {668574000 -14400 0 -04}
    {687326400 -10800 1 -03}
    {687326400 -10800 1 -04}
    {700628400 -14400 0 -04}
    {718776000 -10800 1 -03}
    {718776000 -10800 1 -04}
    {732078000 -14400 0 -04}
    {750225600 -10800 1 -03}
    {750225600 -10800 1 -04}
    {763527600 -14400 0 -04}
    {781675200 -10800 1 -03}
    {781675200 -10800 1 -04}
    {794977200 -14400 0 -04}
    {813729600 -10800 1 -03}
    {813729600 -10800 1 -04}
    {826426800 -14400 0 -04}
    {845179200 -10800 1 -03}
    {845179200 -10800 1 -04}
    {859690800 -14400 0 -04}
    {876628800 -10800 1 -03}
    {876628800 -10800 1 -04}
    {889930800 -14400 0 -04}
    {906868800 -10800 1 -03}
    {906868800 -10800 1 -04}
    {923194800 -14400 0 -04}
    {939528000 -10800 1 -03}
    {939528000 -10800 1 -04}
    {952830000 -14400 0 -04}
    {971582400 -10800 1 -03}
    {971582400 -10800 1 -04}
    {984279600 -14400 0 -04}
    {1003032000 -10800 1 -03}
    {1003032000 -10800 1 -04}
    {1015729200 -14400 0 -04}
    {1034481600 -10800 1 -03}
    {1034481600 -10800 1 -04}
    {1047178800 -14400 0 -04}
    {1065931200 -10800 1 -03}
    {1065931200 -10800 1 -04}
    {1079233200 -14400 0 -04}
    {1097380800 -10800 1 -03}
    {1097380800 -10800 1 -04}
    {1110682800 -14400 0 -04}
    {1128830400 -10800 1 -03}
    {1128830400 -10800 1 -04}
    {1142132400 -14400 0 -04}
    {1160884800 -10800 1 -03}
    {1160884800 -10800 1 -04}
    {1173582000 -14400 0 -04}
    {1192334400 -10800 1 -03}
    {1192334400 -10800 1 -04}
    {1206846000 -14400 0 -04}
    {1223784000 -10800 1 -03}
    {1223784000 -10800 1 -04}
    {1237086000 -14400 0 -04}
    {1255233600 -10800 1 -03}
    {1255233600 -10800 1 -04}
    {1270350000 -14400 0 -04}
    {1286683200 -10800 1 -03}
    {1286683200 -10800 1 -04}
    {1304823600 -14400 0 -04}
    {1313899200 -10800 1 -03}
    {1313899200 -10800 1 -04}
    {1335668400 -14400 0 -04}
    {1346558400 -10800 1 -03}
    {1346558400 -10800 1 -04}
    {1367118000 -14400 0 -04}
    {1378612800 -10800 1 -03}
    {1378612800 -10800 1 -04}
    {1398567600 -14400 0 -04}
    {1410062400 -10800 1 -03}
    {1410062400 -10800 1 -04}
    {1463281200 -14400 0 -04}
    {1471147200 -10800 1 -03}
    {1471147200 -10800 1 -04}
    {1480820400 -10800 0 -03}
}

Changes to library/tzdata/America/Recife.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38
39
40

41
42

43
44
45

46
47
48
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37
38
39

40
41

42
43
44

45
46
47
48





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



-
+

-
+


-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Recife) {
    {-9223372036854775808 -8376 0 LMT}
    {-1767217224 -10800 0 -03}
    {-1206957600 -7200 1 -02}
    {-1206957600 -7200 1 -03}
    {-1191362400 -10800 0 -03}
    {-1175374800 -7200 1 -02}
    {-1175374800 -7200 1 -03}
    {-1159826400 -10800 0 -03}
    {-633819600 -7200 1 -02}
    {-633819600 -7200 1 -03}
    {-622069200 -10800 0 -03}
    {-602283600 -7200 1 -02}
    {-602283600 -7200 1 -03}
    {-591832800 -10800 0 -03}
    {-570747600 -7200 1 -02}
    {-570747600 -7200 1 -03}
    {-560210400 -10800 0 -03}
    {-539125200 -7200 1 -02}
    {-539125200 -7200 1 -03}
    {-531352800 -10800 0 -03}
    {-191365200 -7200 1 -02}
    {-191365200 -7200 1 -03}
    {-184197600 -10800 0 -03}
    {-155163600 -7200 1 -02}
    {-155163600 -7200 1 -03}
    {-150069600 -10800 0 -03}
    {-128898000 -7200 1 -02}
    {-128898000 -7200 1 -03}
    {-121125600 -10800 0 -03}
    {-99954000 -7200 1 -02}
    {-99954000 -7200 1 -03}
    {-89589600 -10800 0 -03}
    {-68418000 -7200 1 -02}
    {-68418000 -7200 1 -03}
    {-57967200 -10800 0 -03}
    {499748400 -7200 1 -02}
    {499748400 -7200 1 -03}
    {511236000 -10800 0 -03}
    {530593200 -7200 1 -02}
    {530593200 -7200 1 -03}
    {540266400 -10800 0 -03}
    {562129200 -7200 1 -02}
    {562129200 -7200 1 -03}
    {571197600 -10800 0 -03}
    {592974000 -7200 1 -02}
    {592974000 -7200 1 -03}
    {602042400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {634701600 -10800 0 -03}
    {653536800 -10800 0 -03}
    {938660400 -10800 0 -03}
    {938919600 -7200 1 -02}
    {938919600 -7200 1 -03}
    {951616800 -10800 0 -03}
    {970974000 -7200 1 -02}
    {970974000 -7200 1 -03}
    {971575200 -10800 0 -03}
    {1000350000 -10800 0 -03}
    {1003028400 -7200 1 -02}
    {1003028400 -7200 1 -03}
    {1013911200 -10800 0 -03}
    {1033437600 -10800 0 -03}
}

Changes to library/tzdata/America/Rio_Branco.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34
35
36
37
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33
34
35
36
37





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+





# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Rio_Branco) {
    {-9223372036854775808 -16272 0 LMT}
    {-1767209328 -18000 0 -05}
    {-1206950400 -14400 1 -04}
    {-1206950400 -14400 1 -05}
    {-1191355200 -18000 0 -05}
    {-1175367600 -14400 1 -04}
    {-1175367600 -14400 1 -05}
    {-1159819200 -18000 0 -05}
    {-633812400 -14400 1 -04}
    {-633812400 -14400 1 -05}
    {-622062000 -18000 0 -05}
    {-602276400 -14400 1 -04}
    {-602276400 -14400 1 -05}
    {-591825600 -18000 0 -05}
    {-570740400 -14400 1 -04}
    {-570740400 -14400 1 -05}
    {-560203200 -18000 0 -05}
    {-539118000 -14400 1 -04}
    {-539118000 -14400 1 -05}
    {-531345600 -18000 0 -05}
    {-191358000 -14400 1 -04}
    {-191358000 -14400 1 -05}
    {-184190400 -18000 0 -05}
    {-155156400 -14400 1 -04}
    {-155156400 -14400 1 -05}
    {-150062400 -18000 0 -05}
    {-128890800 -14400 1 -04}
    {-128890800 -14400 1 -05}
    {-121118400 -18000 0 -05}
    {-99946800 -14400 1 -04}
    {-99946800 -14400 1 -05}
    {-89582400 -18000 0 -05}
    {-68410800 -14400 1 -04}
    {-68410800 -14400 1 -05}
    {-57960000 -18000 0 -05}
    {499755600 -14400 1 -04}
    {499755600 -14400 1 -05}
    {511243200 -18000 0 -05}
    {530600400 -14400 1 -04}
    {530600400 -14400 1 -05}
    {540273600 -18000 0 -05}
    {562136400 -14400 1 -04}
    {562136400 -14400 1 -05}
    {571204800 -18000 0 -05}
    {590040000 -18000 0 -05}
    {1214283600 -14400 0 -04}
    {1384056000 -18000 0 -05}
}

Changes to library/tzdata/America/Santarem.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34
35
36
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33
34
35
36





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+




# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Santarem) {
    {-9223372036854775808 -13128 0 LMT}
    {-1767212472 -14400 0 -04}
    {-1206954000 -10800 1 -03}
    {-1206954000 -10800 1 -04}
    {-1191358800 -14400 0 -04}
    {-1175371200 -10800 1 -03}
    {-1175371200 -10800 1 -04}
    {-1159822800 -14400 0 -04}
    {-633816000 -10800 1 -03}
    {-633816000 -10800 1 -04}
    {-622065600 -14400 0 -04}
    {-602280000 -10800 1 -03}
    {-602280000 -10800 1 -04}
    {-591829200 -14400 0 -04}
    {-570744000 -10800 1 -03}
    {-570744000 -10800 1 -04}
    {-560206800 -14400 0 -04}
    {-539121600 -10800 1 -03}
    {-539121600 -10800 1 -04}
    {-531349200 -14400 0 -04}
    {-191361600 -10800 1 -03}
    {-191361600 -10800 1 -04}
    {-184194000 -14400 0 -04}
    {-155160000 -10800 1 -03}
    {-155160000 -10800 1 -04}
    {-150066000 -14400 0 -04}
    {-128894400 -10800 1 -03}
    {-128894400 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-99950400 -10800 1 -03}
    {-99950400 -10800 1 -04}
    {-89586000 -14400 0 -04}
    {-68414400 -10800 1 -03}
    {-68414400 -10800 1 -04}
    {-57963600 -14400 0 -04}
    {499752000 -10800 1 -03}
    {499752000 -10800 1 -04}
    {511239600 -14400 0 -04}
    {530596800 -10800 1 -03}
    {530596800 -10800 1 -04}
    {540270000 -14400 0 -04}
    {562132800 -10800 1 -03}
    {562132800 -10800 1 -04}
    {571201200 -14400 0 -04}
    {590036400 -14400 0 -04}
    {1214280000 -10800 0 -03}
}

Changes to library/tzdata/America/Santiago.

1
2
3
4
5
6
7
8
9
10
11

12
13

14
15

16
17

18
19

20
21
22
23
24
25
26
27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66

67
68

69
70

71
72

73
74

75
76

77
78

79
80

81
82

83
84

85
86

87
88

89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185







































186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280



































































































281
282
283
284
285
286
287
288




289
1
2
3
4
5
6
7
8
9
10

11
12

13
14

15
16

17
18

19
20
21
22
23
24
25
26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67

68
69

70
71

72
73

74
75

76
77

78
79

80
81

82
83

84
85

86
87

88
89

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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185































































































186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284








285
286
287
288
289










-
+

-
+

-
+

-
+

-
+








-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Santiago) {
    {-9223372036854775808 -16966 0 LMT}
    {-2524504634 -16966 0 SMT}
    {-1892661434 -18000 0 -05}
    {-1688410800 -16966 0 SMT}
    {-1619205434 -14400 0 -04}
    {-1593806400 -16966 0 SMT}
    {-1335986234 -18000 0 -05}
    {-1335985200 -14400 1 -04}
    {-1335985200 -14400 1 -05}
    {-1317585600 -18000 0 -05}
    {-1304362800 -14400 1 -04}
    {-1304362800 -14400 1 -05}
    {-1286049600 -18000 0 -05}
    {-1272826800 -14400 1 -04}
    {-1272826800 -14400 1 -05}
    {-1254513600 -18000 0 -05}
    {-1241290800 -14400 1 -04}
    {-1241290800 -14400 1 -05}
    {-1222977600 -18000 0 -05}
    {-1209754800 -14400 1 -04}
    {-1209754800 -14400 1 -05}
    {-1191355200 -18000 0 -05}
    {-1178132400 -14400 0 -04}
    {-870552000 -18000 0 -05}
    {-865278000 -14400 0 -04}
    {-740520000 -10800 1 -03}
    {-736376400 -14400 0 -04}
    {-718056000 -18000 0 -05}
    {-713649600 -14400 0 -04}
    {-36619200 -10800 1 -03}
    {-36619200 -10800 1 -04}
    {-23922000 -14400 0 -04}
    {-3355200 -10800 1 -03}
    {-3355200 -10800 1 -04}
    {7527600 -14400 0 -04}
    {24465600 -10800 1 -03}
    {24465600 -10800 1 -04}
    {37767600 -14400 0 -04}
    {55915200 -10800 1 -03}
    {55915200 -10800 1 -04}
    {69217200 -14400 0 -04}
    {87969600 -10800 1 -03}
    {87969600 -10800 1 -04}
    {100666800 -14400 0 -04}
    {118209600 -10800 1 -03}
    {118209600 -10800 1 -04}
    {132116400 -14400 0 -04}
    {150868800 -10800 1 -03}
    {150868800 -10800 1 -04}
    {163566000 -14400 0 -04}
    {182318400 -10800 1 -03}
    {182318400 -10800 1 -04}
    {195620400 -14400 0 -04}
    {213768000 -10800 1 -03}
    {213768000 -10800 1 -04}
    {227070000 -14400 0 -04}
    {245217600 -10800 1 -03}
    {245217600 -10800 1 -04}
    {258519600 -14400 0 -04}
    {277272000 -10800 1 -03}
    {277272000 -10800 1 -04}
    {289969200 -14400 0 -04}
    {308721600 -10800 1 -03}
    {308721600 -10800 1 -04}
    {321418800 -14400 0 -04}
    {340171200 -10800 1 -03}
    {340171200 -10800 1 -04}
    {353473200 -14400 0 -04}
    {371620800 -10800 1 -03}
    {371620800 -10800 1 -04}
    {384922800 -14400 0 -04}
    {403070400 -10800 1 -03}
    {403070400 -10800 1 -04}
    {416372400 -14400 0 -04}
    {434520000 -10800 1 -03}
    {434520000 -10800 1 -04}
    {447822000 -14400 0 -04}
    {466574400 -10800 1 -03}
    {466574400 -10800 1 -04}
    {479271600 -14400 0 -04}
    {498024000 -10800 1 -03}
    {498024000 -10800 1 -04}
    {510721200 -14400 0 -04}
    {529473600 -10800 1 -03}
    {529473600 -10800 1 -04}
    {545194800 -14400 0 -04}
    {560923200 -10800 1 -03}
    {560923200 -10800 1 -04}
    {574225200 -14400 0 -04}
    {592372800 -10800 1 -03}
    {592372800 -10800 1 -04}
    {605674800 -14400 0 -04}
    {624427200 -10800 1 -03}
    {624427200 -10800 1 -04}
    {637124400 -14400 0 -04}
    {653457600 -10800 1 -03}
    {653457600 -10800 1 -04}
    {668574000 -14400 0 -04}
    {687326400 -10800 1 -03}
    {687326400 -10800 1 -04}
    {700628400 -14400 0 -04}
    {718776000 -10800 1 -03}
    {718776000 -10800 1 -04}
    {732078000 -14400 0 -04}
    {750225600 -10800 1 -03}
    {750225600 -10800 1 -04}
    {763527600 -14400 0 -04}
    {781675200 -10800 1 -03}
    {781675200 -10800 1 -04}
    {794977200 -14400 0 -04}
    {813729600 -10800 1 -03}
    {813729600 -10800 1 -04}
    {826426800 -14400 0 -04}
    {845179200 -10800 1 -03}
    {845179200 -10800 1 -04}
    {859690800 -14400 0 -04}
    {876628800 -10800 1 -03}
    {876628800 -10800 1 -04}
    {889930800 -14400 0 -04}
    {906868800 -10800 1 -03}
    {906868800 -10800 1 -04}
    {923194800 -14400 0 -04}
    {939528000 -10800 1 -03}
    {939528000 -10800 1 -04}
    {952830000 -14400 0 -04}
    {971582400 -10800 1 -03}
    {971582400 -10800 1 -04}
    {984279600 -14400 0 -04}
    {1003032000 -10800 1 -03}
    {1003032000 -10800 1 -04}
    {1015729200 -14400 0 -04}
    {1034481600 -10800 1 -03}
    {1034481600 -10800 1 -04}
    {1047178800 -14400 0 -04}
    {1065931200 -10800 1 -03}
    {1065931200 -10800 1 -04}
    {1079233200 -14400 0 -04}
    {1097380800 -10800 1 -03}
    {1097380800 -10800 1 -04}
    {1110682800 -14400 0 -04}
    {1128830400 -10800 1 -03}
    {1128830400 -10800 1 -04}
    {1142132400 -14400 0 -04}
    {1160884800 -10800 1 -03}
    {1160884800 -10800 1 -04}
    {1173582000 -14400 0 -04}
    {1192334400 -10800 1 -03}
    {1192334400 -10800 1 -04}
    {1206846000 -14400 0 -04}
    {1223784000 -10800 1 -03}
    {1223784000 -10800 1 -04}
    {1237086000 -14400 0 -04}
    {1255233600 -10800 1 -03}
    {1255233600 -10800 1 -04}
    {1270350000 -14400 0 -04}
    {1286683200 -10800 1 -03}
    {1286683200 -10800 1 -04}
    {1304823600 -14400 0 -04}
    {1313899200 -10800 1 -03}
    {1313899200 -10800 1 -04}
    {1335668400 -14400 0 -04}
    {1346558400 -10800 1 -03}
    {1346558400 -10800 1 -04}
    {1367118000 -14400 0 -04}
    {1378612800 -10800 1 -03}
    {1378612800 -10800 1 -04}
    {1398567600 -14400 0 -04}
    {1410062400 -10800 1 -03}
    {1410062400 -10800 1 -04}
    {1463281200 -14400 0 -04}
    {1471147200 -10800 1 -03}
    {1471147200 -10800 1 -04}
    {1494730800 -14400 0 -04}
    {1502596800 -10800 1 -03}
    {1502596800 -10800 1 -04}
    {1526180400 -14400 0 -04}
    {1534046400 -10800 1 -03}
    {1557630000 -14400 0 -04}
    {1565496000 -10800 1 -03}
    {1589079600 -14400 0 -04}
    {1596945600 -10800 1 -03}
    {1620529200 -14400 0 -04}
    {1629000000 -10800 1 -03}
    {1652583600 -14400 0 -04}
    {1660449600 -10800 1 -03}
    {1684033200 -14400 0 -04}
    {1691899200 -10800 1 -03}
    {1715482800 -14400 0 -04}
    {1723348800 -10800 1 -03}
    {1746932400 -14400 0 -04}
    {1754798400 -10800 1 -03}
    {1778382000 -14400 0 -04}
    {1786248000 -10800 1 -03}
    {1809831600 -14400 0 -04}
    {1818302400 -10800 1 -03}
    {1534046400 -10800 1 -04}
    {1554606000 -14400 0 -04}
    {1567915200 -10800 1 -04}
    {1586055600 -14400 0 -04}
    {1599364800 -10800 1 -04}
    {1617505200 -14400 0 -04}
    {1630814400 -10800 1 -04}
    {1648954800 -14400 0 -04}
    {1662264000 -10800 1 -04}
    {1680404400 -14400 0 -04}
    {1693713600 -10800 1 -04}
    {1712458800 -14400 0 -04}
    {1725768000 -10800 1 -04}
    {1743908400 -14400 0 -04}
    {1757217600 -10800 1 -04}
    {1775358000 -14400 0 -04}
    {1788667200 -10800 1 -04}
    {1806807600 -14400 0 -04}
    {1820116800 -10800 1 -04}
    {1838257200 -14400 0 -04}
    {1851566400 -10800 1 -04}
    {1841886000 -14400 0 -04}
    {1849752000 -10800 1 -03}
    {1873335600 -14400 0 -04}
    {1881201600 -10800 1 -03}
    {1904785200 -14400 0 -04}
    {1912651200 -10800 1 -03}
    {1936234800 -14400 0 -04}
    {1944100800 -10800 1 -03}
    {1967684400 -14400 0 -04}
    {1976155200 -10800 1 -03}
    {1999738800 -14400 0 -04}
    {2007604800 -10800 1 -03}
    {2031188400 -14400 0 -04}
    {2039054400 -10800 1 -03}
    {2062638000 -14400 0 -04}
    {2070504000 -10800 1 -03}
    {2094087600 -14400 0 -04}
    {2101953600 -10800 1 -03}
    {2125537200 -14400 0 -04}
    {2133403200 -10800 1 -03}
    {2156986800 -14400 0 -04}
    {2165457600 -10800 1 -03}
    {2189041200 -14400 0 -04}
    {2196907200 -10800 1 -03}
    {2220490800 -14400 0 -04}
    {2228356800 -10800 1 -03}
    {2251940400 -14400 0 -04}
    {2259806400 -10800 1 -03}
    {2283390000 -14400 0 -04}
    {2291256000 -10800 1 -03}
    {2314839600 -14400 0 -04}
    {2322705600 -10800 1 -03}
    {2346894000 -14400 0 -04}
    {2354760000 -10800 1 -03}
    {2378343600 -14400 0 -04}
    {2386209600 -10800 1 -03}
    {2409793200 -14400 0 -04}
    {2417659200 -10800 1 -03}
    {2441242800 -14400 0 -04}
    {2449108800 -10800 1 -03}
    {2472692400 -14400 0 -04}
    {1870311600 -14400 0 -04}
    {1883016000 -10800 1 -04}
    {1901761200 -14400 0 -04}
    {1915070400 -10800 1 -04}
    {1933210800 -14400 0 -04}
    {1946520000 -10800 1 -04}
    {1964660400 -14400 0 -04}
    {1977969600 -10800 1 -04}
    {1996110000 -14400 0 -04}
    {2009419200 -10800 1 -04}
    {2027559600 -14400 0 -04}
    {2040868800 -10800 1 -04}
    {2059614000 -14400 0 -04}
    {2072318400 -10800 1 -04}
    {2091063600 -14400 0 -04}
    {2104372800 -10800 1 -04}
    {2122513200 -14400 0 -04}
    {2135822400 -10800 1 -04}
    {2153962800 -14400 0 -04}
    {2167272000 -10800 1 -04}
    {2185412400 -14400 0 -04}
    {2198721600 -10800 1 -04}
    {2217466800 -14400 0 -04}
    {2230171200 -10800 1 -04}
    {2248916400 -14400 0 -04}
    {2262225600 -10800 1 -04}
    {2280366000 -14400 0 -04}
    {2293675200 -10800 1 -04}
    {2311815600 -14400 0 -04}
    {2325124800 -10800 1 -04}
    {2343265200 -14400 0 -04}
    {2356574400 -10800 1 -04}
    {2374714800 -14400 0 -04}
    {2388024000 -10800 1 -04}
    {2406769200 -14400 0 -04}
    {2419473600 -10800 1 -04}
    {2438218800 -14400 0 -04}
    {2451528000 -10800 1 -04}
    {2469668400 -14400 0 -04}
    {2480558400 -10800 1 -03}
    {2504142000 -14400 0 -04}
    {2512612800 -10800 1 -03}
    {2536196400 -14400 0 -04}
    {2544062400 -10800 1 -03}
    {2567646000 -14400 0 -04}
    {2575512000 -10800 1 -03}
    {2599095600 -14400 0 -04}
    {2606961600 -10800 1 -03}
    {2630545200 -14400 0 -04}
    {2638411200 -10800 1 -03}
    {2661994800 -14400 0 -04}
    {2669860800 -10800 1 -03}
    {2693444400 -14400 0 -04}
    {2701915200 -10800 1 -03}
    {2725498800 -14400 0 -04}
    {2733364800 -10800 1 -03}
    {2756948400 -14400 0 -04}
    {2764814400 -10800 1 -03}
    {2788398000 -14400 0 -04}
    {2796264000 -10800 1 -03}
    {2819847600 -14400 0 -04}
    {2827713600 -10800 1 -03}
    {2851297200 -14400 0 -04}
    {2859768000 -10800 1 -03}
    {2883351600 -14400 0 -04}
    {2891217600 -10800 1 -03}
    {2914801200 -14400 0 -04}
    {2922667200 -10800 1 -03}
    {2946250800 -14400 0 -04}
    {2954116800 -10800 1 -03}
    {2977700400 -14400 0 -04}
    {2985566400 -10800 1 -03}
    {3009150000 -14400 0 -04}
    {3017016000 -10800 1 -03}
    {3040599600 -14400 0 -04}
    {3049070400 -10800 1 -03}
    {3072654000 -14400 0 -04}
    {3080520000 -10800 1 -03}
    {3104103600 -14400 0 -04}
    {3111969600 -10800 1 -03}
    {3135553200 -14400 0 -04}
    {3143419200 -10800 1 -03}
    {3167002800 -14400 0 -04}
    {3174868800 -10800 1 -03}
    {3198452400 -14400 0 -04}
    {3206318400 -10800 1 -03}
    {3230506800 -14400 0 -04}
    {3238372800 -10800 1 -03}
    {3261956400 -14400 0 -04}
    {3269822400 -10800 1 -03}
    {3293406000 -14400 0 -04}
    {3301272000 -10800 1 -03}
    {3324855600 -14400 0 -04}
    {3332721600 -10800 1 -03}
    {3356305200 -14400 0 -04}
    {3364171200 -10800 1 -03}
    {3387754800 -14400 0 -04}
    {3396225600 -10800 1 -03}
    {3419809200 -14400 0 -04}
    {3427675200 -10800 1 -03}
    {3451258800 -14400 0 -04}
    {3459124800 -10800 1 -03}
    {3482708400 -14400 0 -04}
    {3490574400 -10800 1 -03}
    {3514158000 -14400 0 -04}
    {3522024000 -10800 1 -03}
    {3545607600 -14400 0 -04}
    {3553473600 -10800 1 -03}
    {3577057200 -14400 0 -04}
    {3585528000 -10800 1 -03}
    {3609111600 -14400 0 -04}
    {3616977600 -10800 1 -03}
    {3640561200 -14400 0 -04}
    {3648427200 -10800 1 -03}
    {3672010800 -14400 0 -04}
    {3679876800 -10800 1 -03}
    {3703460400 -14400 0 -04}
    {3711326400 -10800 1 -03}
    {3734910000 -14400 0 -04}
    {3743380800 -10800 1 -03}
    {3766964400 -14400 0 -04}
    {3774830400 -10800 1 -03}
    {3798414000 -14400 0 -04}
    {3806280000 -10800 1 -03}
    {3829863600 -14400 0 -04}
    {3837729600 -10800 1 -03}
    {3861313200 -14400 0 -04}
    {3869179200 -10800 1 -03}
    {3892762800 -14400 0 -04}
    {3900628800 -10800 1 -03}
    {3924212400 -14400 0 -04}
    {3932683200 -10800 1 -03}
    {3956266800 -14400 0 -04}
    {3964132800 -10800 1 -03}
    {2482977600 -10800 1 -04}
    {2501118000 -14400 0 -04}
    {2514427200 -10800 1 -04}
    {2532567600 -14400 0 -04}
    {2545876800 -10800 1 -04}
    {2564017200 -14400 0 -04}
    {2577326400 -10800 1 -04}
    {2596071600 -14400 0 -04}
    {2609380800 -10800 1 -04}
    {2627521200 -14400 0 -04}
    {2640830400 -10800 1 -04}
    {2658970800 -14400 0 -04}
    {2672280000 -10800 1 -04}
    {2690420400 -14400 0 -04}
    {2703729600 -10800 1 -04}
    {2721870000 -14400 0 -04}
    {2735179200 -10800 1 -04}
    {2753924400 -14400 0 -04}
    {2766628800 -10800 1 -04}
    {2785374000 -14400 0 -04}
    {2798683200 -10800 1 -04}
    {2816823600 -14400 0 -04}
    {2830132800 -10800 1 -04}
    {2848273200 -14400 0 -04}
    {2861582400 -10800 1 -04}
    {2879722800 -14400 0 -04}
    {2893032000 -10800 1 -04}
    {2911172400 -14400 0 -04}
    {2924481600 -10800 1 -04}
    {2943226800 -14400 0 -04}
    {2955931200 -10800 1 -04}
    {2974676400 -14400 0 -04}
    {2987985600 -10800 1 -04}
    {3006126000 -14400 0 -04}
    {3019435200 -10800 1 -04}
    {3037575600 -14400 0 -04}
    {3050884800 -10800 1 -04}
    {3069025200 -14400 0 -04}
    {3082334400 -10800 1 -04}
    {3101079600 -14400 0 -04}
    {3113784000 -10800 1 -04}
    {3132529200 -14400 0 -04}
    {3145838400 -10800 1 -04}
    {3163978800 -14400 0 -04}
    {3177288000 -10800 1 -04}
    {3195428400 -14400 0 -04}
    {3208737600 -10800 1 -04}
    {3226878000 -14400 0 -04}
    {3240187200 -10800 1 -04}
    {3258327600 -14400 0 -04}
    {3271636800 -10800 1 -04}
    {3290382000 -14400 0 -04}
    {3303086400 -10800 1 -04}
    {3321831600 -14400 0 -04}
    {3335140800 -10800 1 -04}
    {3353281200 -14400 0 -04}
    {3366590400 -10800 1 -04}
    {3384730800 -14400 0 -04}
    {3398040000 -10800 1 -04}
    {3416180400 -14400 0 -04}
    {3429489600 -10800 1 -04}
    {3447630000 -14400 0 -04}
    {3460939200 -10800 1 -04}
    {3479684400 -14400 0 -04}
    {3492993600 -10800 1 -04}
    {3511134000 -14400 0 -04}
    {3524443200 -10800 1 -04}
    {3542583600 -14400 0 -04}
    {3555892800 -10800 1 -04}
    {3574033200 -14400 0 -04}
    {3587342400 -10800 1 -04}
    {3605482800 -14400 0 -04}
    {3618792000 -10800 1 -04}
    {3637537200 -14400 0 -04}
    {3650241600 -10800 1 -04}
    {3668986800 -14400 0 -04}
    {3682296000 -10800 1 -04}
    {3700436400 -14400 0 -04}
    {3713745600 -10800 1 -04}
    {3731886000 -14400 0 -04}
    {3745195200 -10800 1 -04}
    {3763335600 -14400 0 -04}
    {3776644800 -10800 1 -04}
    {3794785200 -14400 0 -04}
    {3808094400 -10800 1 -04}
    {3826839600 -14400 0 -04}
    {3839544000 -10800 1 -04}
    {3858289200 -14400 0 -04}
    {3871598400 -10800 1 -04}
    {3889738800 -14400 0 -04}
    {3903048000 -10800 1 -04}
    {3921188400 -14400 0 -04}
    {3934497600 -10800 1 -04}
    {3952638000 -14400 0 -04}
    {3965947200 -10800 1 -04}
    {3984692400 -14400 0 -04}
    {3997396800 -10800 1 -04}
    {4016142000 -14400 0 -04}
    {4029451200 -10800 1 -04}
    {3987716400 -14400 0 -04}
    {3995582400 -10800 1 -03}
    {4019166000 -14400 0 -04}
    {4027032000 -10800 1 -03}
    {4050615600 -14400 0 -04}
    {4058481600 -10800 1 -03}
    {4082065200 -14400 0 -04}
    {4089931200 -10800 1 -03}
    {4047591600 -14400 0 -04}
    {4060900800 -10800 1 -04}
    {4079041200 -14400 0 -04}
    {4092350400 -10800 1 -04}
}

Changes to library/tzdata/America/Sao_Paulo.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18
19
20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67

68
69

70
71

72
73

74
75

76
77

78
79

80
81

82
83

84
85

86
87

88
89

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

128
129

130
131

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
161

162
163

164
165

166
167

168
169

170
171

172
173

174
175

176
177

178
179

180
181

182
183

184
185

186
187

188
189

190
191

192
193

194
195

196
197

198
199

200
201

202
203

204
205

206
207

208
209

210
211

212
213

214
215

216
217

218
219

220
221

222
223

224
225

226
227

228
229

230
231

232
233

234
235

236
237

238
239

240
241

242
243

244
245

246
247

248
249

250
251

252
253

254
255

256
257

258
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17
18
19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66

67
68

69
70

71
72

73
74

75
76

77
78

79
80

81
82

83
84

85
86

87
88

89
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
128

129
130

131
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

161
162

163
164

165
166

167
168

169
170

171
172

173
174

175
176

177
178

179
180

181
182

183
184

185
186

187
188

189
190

191
192

193
194

195
196

197
198

199
200

201
202

203
204

205
206

207
208

209
210

211
212

213
214

215
216

217
218

219
220

221
222

223
224

225
226

227
228

229
230

231
232

233
234

235
236

237
238

239
240

241
242

243
244

245
246

247
248

249
250

251
252

253
254

255
256

257
258





-
+

-
+

-
+

-
+

-
+

-
+




-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Sao_Paulo) {
    {-9223372036854775808 -11188 0 LMT}
    {-1767214412 -10800 0 -03}
    {-1206957600 -7200 1 -02}
    {-1206957600 -7200 1 -03}
    {-1191362400 -10800 0 -03}
    {-1175374800 -7200 1 -02}
    {-1175374800 -7200 1 -03}
    {-1159826400 -10800 0 -03}
    {-633819600 -7200 1 -02}
    {-633819600 -7200 1 -03}
    {-622069200 -10800 0 -03}
    {-602283600 -7200 1 -02}
    {-602283600 -7200 1 -03}
    {-591832800 -10800 0 -03}
    {-570747600 -7200 1 -02}
    {-570747600 -7200 1 -03}
    {-560210400 -10800 0 -03}
    {-539125200 -7200 1 -02}
    {-539125200 -7200 1 -03}
    {-531352800 -10800 0 -03}
    {-195429600 -7200 1 -02}
    {-189381600 -7200 0 -03}
    {-184197600 -10800 0 -03}
    {-155163600 -7200 1 -02}
    {-155163600 -7200 1 -03}
    {-150069600 -10800 0 -03}
    {-128898000 -7200 1 -02}
    {-128898000 -7200 1 -03}
    {-121125600 -10800 0 -03}
    {-99954000 -7200 1 -02}
    {-99954000 -7200 1 -03}
    {-89589600 -10800 0 -03}
    {-68418000 -7200 1 -02}
    {-68418000 -7200 1 -03}
    {-57967200 -10800 0 -03}
    {499748400 -7200 1 -02}
    {499748400 -7200 1 -03}
    {511236000 -10800 0 -03}
    {530593200 -7200 1 -02}
    {530593200 -7200 1 -03}
    {540266400 -10800 0 -03}
    {562129200 -7200 1 -02}
    {562129200 -7200 1 -03}
    {571197600 -10800 0 -03}
    {592974000 -7200 1 -02}
    {592974000 -7200 1 -03}
    {602042400 -10800 0 -03}
    {624423600 -7200 1 -02}
    {624423600 -7200 1 -03}
    {634701600 -10800 0 -03}
    {656478000 -7200 1 -02}
    {656478000 -7200 1 -03}
    {666756000 -10800 0 -03}
    {687927600 -7200 1 -02}
    {687927600 -7200 1 -03}
    {697600800 -10800 0 -03}
    {719982000 -7200 1 -02}
    {719982000 -7200 1 -03}
    {728445600 -10800 0 -03}
    {750826800 -7200 1 -02}
    {750826800 -7200 1 -03}
    {761709600 -10800 0 -03}
    {782276400 -7200 1 -02}
    {782276400 -7200 1 -03}
    {793159200 -10800 0 -03}
    {813726000 -7200 1 -02}
    {813726000 -7200 1 -03}
    {824004000 -10800 0 -03}
    {844570800 -7200 1 -02}
    {844570800 -7200 1 -03}
    {856058400 -10800 0 -03}
    {876106800 -7200 1 -02}
    {876106800 -7200 1 -03}
    {888717600 -10800 0 -03}
    {908074800 -7200 1 -02}
    {908074800 -7200 1 -03}
    {919562400 -10800 0 -03}
    {938919600 -7200 1 -02}
    {938919600 -7200 1 -03}
    {951616800 -10800 0 -03}
    {970974000 -7200 1 -02}
    {970974000 -7200 1 -03}
    {982461600 -10800 0 -03}
    {1003028400 -7200 1 -02}
    {1003028400 -7200 1 -03}
    {1013911200 -10800 0 -03}
    {1036292400 -7200 1 -02}
    {1036292400 -7200 1 -03}
    {1045360800 -10800 0 -03}
    {1066532400 -7200 1 -02}
    {1066532400 -7200 1 -03}
    {1076810400 -10800 0 -03}
    {1099364400 -7200 1 -02}
    {1099364400 -7200 1 -03}
    {1108864800 -10800 0 -03}
    {1129431600 -7200 1 -02}
    {1129431600 -7200 1 -03}
    {1140314400 -10800 0 -03}
    {1162695600 -7200 1 -02}
    {1162695600 -7200 1 -03}
    {1172368800 -10800 0 -03}
    {1192330800 -7200 1 -02}
    {1192330800 -7200 1 -03}
    {1203213600 -10800 0 -03}
    {1224385200 -7200 1 -02}
    {1224385200 -7200 1 -03}
    {1234663200 -10800 0 -03}
    {1255834800 -7200 1 -02}
    {1255834800 -7200 1 -03}
    {1266717600 -10800 0 -03}
    {1287284400 -7200 1 -02}
    {1287284400 -7200 1 -03}
    {1298167200 -10800 0 -03}
    {1318734000 -7200 1 -02}
    {1318734000 -7200 1 -03}
    {1330221600 -10800 0 -03}
    {1350788400 -7200 1 -02}
    {1350788400 -7200 1 -03}
    {1361066400 -10800 0 -03}
    {1382238000 -7200 1 -02}
    {1382238000 -7200 1 -03}
    {1392516000 -10800 0 -03}
    {1413687600 -7200 1 -02}
    {1413687600 -7200 1 -03}
    {1424570400 -10800 0 -03}
    {1445137200 -7200 1 -02}
    {1445137200 -7200 1 -03}
    {1456020000 -10800 0 -03}
    {1476586800 -7200 1 -02}
    {1476586800 -7200 1 -03}
    {1487469600 -10800 0 -03}
    {1508036400 -7200 1 -02}
    {1508036400 -7200 1 -03}
    {1518919200 -10800 0 -03}
    {1540090800 -7200 1 -02}
    {1541300400 -7200 1 -03}
    {1550368800 -10800 0 -03}
    {1571540400 -7200 1 -02}
    {1572750000 -7200 1 -03}
    {1581818400 -10800 0 -03}
    {1602990000 -7200 1 -02}
    {1604199600 -7200 1 -03}
    {1613872800 -10800 0 -03}
    {1634439600 -7200 1 -02}
    {1636254000 -7200 1 -03}
    {1645322400 -10800 0 -03}
    {1665889200 -7200 1 -02}
    {1667703600 -7200 1 -03}
    {1677376800 -10800 0 -03}
    {1697338800 -7200 1 -02}
    {1699153200 -7200 1 -03}
    {1708221600 -10800 0 -03}
    {1729393200 -7200 1 -02}
    {1730602800 -7200 1 -03}
    {1739671200 -10800 0 -03}
    {1760842800 -7200 1 -02}
    {1762052400 -7200 1 -03}
    {1771725600 -10800 0 -03}
    {1792292400 -7200 1 -02}
    {1793502000 -7200 1 -03}
    {1803175200 -10800 0 -03}
    {1823742000 -7200 1 -02}
    {1825556400 -7200 1 -03}
    {1834624800 -10800 0 -03}
    {1855191600 -7200 1 -02}
    {1857006000 -7200 1 -03}
    {1866074400 -10800 0 -03}
    {1887246000 -7200 1 -02}
    {1888455600 -7200 1 -03}
    {1897524000 -10800 0 -03}
    {1918695600 -7200 1 -02}
    {1919905200 -7200 1 -03}
    {1928973600 -10800 0 -03}
    {1950145200 -7200 1 -02}
    {1951354800 -7200 1 -03}
    {1960423200 -10800 0 -03}
    {1981594800 -7200 1 -02}
    {1983409200 -7200 1 -03}
    {1992477600 -10800 0 -03}
    {2013044400 -7200 1 -02}
    {2014858800 -7200 1 -03}
    {2024532000 -10800 0 -03}
    {2044494000 -7200 1 -02}
    {2046308400 -7200 1 -03}
    {2055376800 -10800 0 -03}
    {2076548400 -7200 1 -02}
    {2077758000 -7200 1 -03}
    {2086826400 -10800 0 -03}
    {2107998000 -7200 1 -02}
    {2109207600 -7200 1 -03}
    {2118880800 -10800 0 -03}
    {2139447600 -7200 1 -02}
    {2140657200 -7200 1 -03}
    {2150330400 -10800 0 -03}
    {2170897200 -7200 1 -02}
    {2172711600 -7200 1 -03}
    {2181780000 -10800 0 -03}
    {2202346800 -7200 1 -02}
    {2204161200 -7200 1 -03}
    {2213229600 -10800 0 -03}
    {2234401200 -7200 1 -02}
    {2235610800 -7200 1 -03}
    {2244679200 -10800 0 -03}
    {2265850800 -7200 1 -02}
    {2267060400 -7200 1 -03}
    {2276128800 -10800 0 -03}
    {2297300400 -7200 1 -02}
    {2298510000 -7200 1 -03}
    {2307578400 -10800 0 -03}
    {2328750000 -7200 1 -02}
    {2329959600 -7200 1 -03}
    {2339632800 -10800 0 -03}
    {2360199600 -7200 1 -02}
    {2362014000 -7200 1 -03}
    {2371082400 -10800 0 -03}
    {2391649200 -7200 1 -02}
    {2393463600 -7200 1 -03}
    {2402532000 -10800 0 -03}
    {2423703600 -7200 1 -02}
    {2424913200 -7200 1 -03}
    {2433981600 -10800 0 -03}
    {2455153200 -7200 1 -02}
    {2456362800 -7200 1 -03}
    {2465431200 -10800 0 -03}
    {2486602800 -7200 1 -02}
    {2487812400 -7200 1 -03}
    {2497485600 -10800 0 -03}
    {2518052400 -7200 1 -02}
    {2519866800 -7200 1 -03}
    {2528935200 -10800 0 -03}
    {2549502000 -7200 1 -02}
    {2551316400 -7200 1 -03}
    {2560384800 -10800 0 -03}
    {2580951600 -7200 1 -02}
    {2582766000 -7200 1 -03}
    {2591834400 -10800 0 -03}
    {2613006000 -7200 1 -02}
    {2614215600 -7200 1 -03}
    {2623284000 -10800 0 -03}
    {2644455600 -7200 1 -02}
    {2645665200 -7200 1 -03}
    {2654733600 -10800 0 -03}
    {2675905200 -7200 1 -02}
    {2677114800 -7200 1 -03}
    {2686788000 -10800 0 -03}
    {2707354800 -7200 1 -02}
    {2709169200 -7200 1 -03}
    {2718237600 -10800 0 -03}
    {2738804400 -7200 1 -02}
    {2740618800 -7200 1 -03}
    {2749687200 -10800 0 -03}
    {2770858800 -7200 1 -02}
    {2772068400 -7200 1 -03}
    {2781136800 -10800 0 -03}
    {2802308400 -7200 1 -02}
    {2803518000 -7200 1 -03}
    {2812586400 -10800 0 -03}
    {2833758000 -7200 1 -02}
    {2834967600 -7200 1 -03}
    {2844036000 -10800 0 -03}
    {2865207600 -7200 1 -02}
    {2867022000 -7200 1 -03}
    {2876090400 -10800 0 -03}
    {2896657200 -7200 1 -02}
    {2898471600 -7200 1 -03}
    {2907540000 -10800 0 -03}
    {2928106800 -7200 1 -02}
    {2929921200 -7200 1 -03}
    {2938989600 -10800 0 -03}
    {2960161200 -7200 1 -02}
    {2961370800 -7200 1 -03}
    {2970439200 -10800 0 -03}
    {2991610800 -7200 1 -02}
    {2992820400 -7200 1 -03}
    {3001888800 -10800 0 -03}
    {3023060400 -7200 1 -02}
    {3024270000 -7200 1 -03}
    {3033943200 -10800 0 -03}
    {3054510000 -7200 1 -02}
    {3056324400 -7200 1 -03}
    {3065392800 -10800 0 -03}
    {3085959600 -7200 1 -02}
    {3087774000 -7200 1 -03}
    {3096842400 -10800 0 -03}
    {3118014000 -7200 1 -02}
    {3119223600 -7200 1 -03}
    {3128292000 -10800 0 -03}
    {3149463600 -7200 1 -02}
    {3150673200 -7200 1 -03}
    {3159741600 -10800 0 -03}
    {3180913200 -7200 1 -02}
    {3182122800 -7200 1 -03}
    {3191191200 -10800 0 -03}
    {3212362800 -7200 1 -02}
    {3213572400 -7200 1 -03}
    {3223245600 -10800 0 -03}
    {3243812400 -7200 1 -02}
    {3245626800 -7200 1 -03}
    {3254695200 -10800 0 -03}
    {3275262000 -7200 1 -02}
    {3277076400 -7200 1 -03}
    {3286144800 -10800 0 -03}
    {3307316400 -7200 1 -02}
    {3308526000 -7200 1 -03}
    {3317594400 -10800 0 -03}
    {3338766000 -7200 1 -02}
    {3339975600 -7200 1 -03}
    {3349044000 -10800 0 -03}
    {3370215600 -7200 1 -02}
    {3371425200 -7200 1 -03}
    {3381098400 -10800 0 -03}
    {3401665200 -7200 1 -02}
    {3403479600 -7200 1 -03}
    {3412548000 -10800 0 -03}
    {3433114800 -7200 1 -02}
    {3434929200 -7200 1 -03}
    {3443997600 -10800 0 -03}
    {3464564400 -7200 1 -02}
    {3466378800 -7200 1 -03}
    {3475447200 -10800 0 -03}
    {3496618800 -7200 1 -02}
    {3497828400 -7200 1 -03}
    {3506896800 -10800 0 -03}
    {3528068400 -7200 1 -02}
    {3529278000 -7200 1 -03}
    {3538346400 -10800 0 -03}
    {3559518000 -7200 1 -02}
    {3560727600 -7200 1 -03}
    {3570400800 -10800 0 -03}
    {3590967600 -7200 1 -02}
    {3592782000 -7200 1 -03}
    {3601850400 -10800 0 -03}
    {3622417200 -7200 1 -02}
    {3624231600 -7200 1 -03}
    {3633300000 -10800 0 -03}
    {3654471600 -7200 1 -02}
    {3655681200 -7200 1 -03}
    {3664749600 -10800 0 -03}
    {3685921200 -7200 1 -02}
    {3687130800 -7200 1 -03}
    {3696199200 -10800 0 -03}
    {3717370800 -7200 1 -02}
    {3718580400 -7200 1 -03}
    {3727648800 -10800 0 -03}
    {3748820400 -7200 1 -02}
    {3750634800 -7200 1 -03}
    {3759703200 -10800 0 -03}
    {3780270000 -7200 1 -02}
    {3782084400 -7200 1 -03}
    {3791152800 -10800 0 -03}
    {3811719600 -7200 1 -02}
    {3813534000 -7200 1 -03}
    {3822602400 -10800 0 -03}
    {3843774000 -7200 1 -02}
    {3844983600 -7200 1 -03}
    {3854052000 -10800 0 -03}
    {3875223600 -7200 1 -02}
    {3876433200 -7200 1 -03}
    {3885501600 -10800 0 -03}
    {3906673200 -7200 1 -02}
    {3907882800 -7200 1 -03}
    {3917556000 -10800 0 -03}
    {3938122800 -7200 1 -02}
    {3939937200 -7200 1 -03}
    {3949005600 -10800 0 -03}
    {3969572400 -7200 1 -02}
    {3971386800 -7200 1 -03}
    {3980455200 -10800 0 -03}
    {4001626800 -7200 1 -02}
    {4002836400 -7200 1 -03}
    {4011904800 -10800 0 -03}
    {4033076400 -7200 1 -02}
    {4034286000 -7200 1 -03}
    {4043354400 -10800 0 -03}
    {4064526000 -7200 1 -02}
    {4065735600 -7200 1 -03}
    {4074804000 -10800 0 -03}
    {4095975600 -7200 1 -02}
    {4097185200 -7200 1 -03}
}

Changes to library/tzdata/Antarctica/Casey.

1
2
3
4
5
6
7
8
9
10

11
1
2
3
4
5
6
7
8
9
10
11
12










+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Casey) {
    {-9223372036854775808 0 0 -00}
    {-31536000 28800 0 +08}
    {1255802400 39600 0 +11}
    {1267714800 28800 0 +08}
    {1319738400 39600 0 +11}
    {1329843600 28800 0 +08}
    {1477065600 39600 0 +11}
    {1520701200 28800 0 +08}
}

Changes to library/tzdata/Antarctica/Palmer.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15
16

17
18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67

68
69

70
71

72
73

74
75

76
77

78
79

80
81

82
83

84
85

86
87
1
2
3
4
5
6

7
8

9
10

11
12

13
14
15

16
17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66

67
68

69
70

71
72

73
74

75
76

77
78

79
80

81
82

83
84

85
86
87






-
+

-
+

-
+

-
+


-
+


-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Palmer) {
    {-9223372036854775808 0 0 -00}
    {-157766400 -14400 0 -04}
    {-152654400 -14400 0 -04}
    {-132955200 -10800 1 -03}
    {-132955200 -10800 1 -04}
    {-121122000 -14400 0 -04}
    {-101419200 -10800 1 -03}
    {-101419200 -10800 1 -04}
    {-86821200 -14400 0 -04}
    {-71092800 -10800 1 -03}
    {-71092800 -10800 1 -04}
    {-54766800 -14400 0 -04}
    {-39038400 -10800 1 -03}
    {-39038400 -10800 1 -04}
    {-23317200 -14400 0 -04}
    {-7588800 -10800 0 -03}
    {128142000 -7200 1 -02}
    {128142000 -7200 1 -03}
    {136605600 -10800 0 -03}
    {389070000 -14400 0 -04}
    {403070400 -10800 1 -03}
    {403070400 -10800 1 -04}
    {416372400 -14400 0 -04}
    {434520000 -10800 1 -03}
    {434520000 -10800 1 -04}
    {447822000 -14400 0 -04}
    {466574400 -10800 1 -03}
    {466574400 -10800 1 -04}
    {479271600 -14400 0 -04}
    {498024000 -10800 1 -03}
    {498024000 -10800 1 -04}
    {510721200 -14400 0 -04}
    {529473600 -10800 1 -03}
    {529473600 -10800 1 -04}
    {545194800 -14400 0 -04}
    {560923200 -10800 1 -03}
    {560923200 -10800 1 -04}
    {574225200 -14400 0 -04}
    {592372800 -10800 1 -03}
    {592372800 -10800 1 -04}
    {605674800 -14400 0 -04}
    {624427200 -10800 1 -03}
    {624427200 -10800 1 -04}
    {637124400 -14400 0 -04}
    {653457600 -10800 1 -03}
    {653457600 -10800 1 -04}
    {668574000 -14400 0 -04}
    {687326400 -10800 1 -03}
    {687326400 -10800 1 -04}
    {700628400 -14400 0 -04}
    {718776000 -10800 1 -03}
    {718776000 -10800 1 -04}
    {732078000 -14400 0 -04}
    {750225600 -10800 1 -03}
    {750225600 -10800 1 -04}
    {763527600 -14400 0 -04}
    {781675200 -10800 1 -03}
    {781675200 -10800 1 -04}
    {794977200 -14400 0 -04}
    {813729600 -10800 1 -03}
    {813729600 -10800 1 -04}
    {826426800 -14400 0 -04}
    {845179200 -10800 1 -03}
    {845179200 -10800 1 -04}
    {859690800 -14400 0 -04}
    {876628800 -10800 1 -03}
    {876628800 -10800 1 -04}
    {889930800 -14400 0 -04}
    {906868800 -10800 1 -03}
    {906868800 -10800 1 -04}
    {923194800 -14400 0 -04}
    {939528000 -10800 1 -03}
    {939528000 -10800 1 -04}
    {952830000 -14400 0 -04}
    {971582400 -10800 1 -03}
    {971582400 -10800 1 -04}
    {984279600 -14400 0 -04}
    {1003032000 -10800 1 -03}
    {1003032000 -10800 1 -04}
    {1015729200 -14400 0 -04}
    {1034481600 -10800 1 -03}
    {1034481600 -10800 1 -04}
    {1047178800 -14400 0 -04}
    {1065931200 -10800 1 -03}
    {1065931200 -10800 1 -04}
    {1079233200 -14400 0 -04}
    {1097380800 -10800 1 -03}
    {1097380800 -10800 1 -04}
    {1110682800 -14400 0 -04}
    {1128830400 -10800 1 -03}
    {1128830400 -10800 1 -04}
    {1142132400 -14400 0 -04}
    {1160884800 -10800 1 -03}
    {1160884800 -10800 1 -04}
    {1173582000 -14400 0 -04}
    {1192334400 -10800 1 -03}
    {1192334400 -10800 1 -04}
    {1206846000 -14400 0 -04}
    {1223784000 -10800 1 -03}
    {1223784000 -10800 1 -04}
    {1237086000 -14400 0 -04}
    {1255233600 -10800 1 -03}
    {1255233600 -10800 1 -04}
    {1270350000 -14400 0 -04}
    {1286683200 -10800 1 -03}
    {1286683200 -10800 1 -04}
    {1304823600 -14400 0 -04}
    {1313899200 -10800 1 -03}
    {1313899200 -10800 1 -04}
    {1335668400 -14400 0 -04}
    {1346558400 -10800 1 -03}
    {1346558400 -10800 1 -04}
    {1367118000 -14400 0 -04}
    {1378612800 -10800 1 -03}
    {1378612800 -10800 1 -04}
    {1398567600 -14400 0 -04}
    {1410062400 -10800 1 -03}
    {1410062400 -10800 1 -04}
    {1463281200 -14400 0 -04}
    {1471147200 -10800 1 -03}
    {1471147200 -10800 1 -04}
    {1480820400 -10800 0 -03}
}

Changes to library/tzdata/Asia/Almaty.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26
27

28
29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56
57






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+


-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Almaty) {
    {-9223372036854775808 18468 0 LMT}
    {-1441170468 18000 0 +05}
    {-1247547600 21600 0 +06}
    {354909600 25200 1 +07}
    {354909600 25200 1 +06}
    {370717200 21600 0 +06}
    {386445600 25200 1 +07}
    {386445600 25200 1 +06}
    {402253200 21600 0 +06}
    {417981600 25200 1 +07}
    {417981600 25200 1 +06}
    {433789200 21600 0 +06}
    {449604000 25200 1 +07}
    {449604000 25200 1 +06}
    {465336000 21600 0 +06}
    {481060800 25200 1 +07}
    {481060800 25200 1 +06}
    {496785600 21600 0 +06}
    {512510400 25200 1 +07}
    {512510400 25200 1 +06}
    {528235200 21600 0 +06}
    {543960000 25200 1 +07}
    {543960000 25200 1 +06}
    {559684800 21600 0 +06}
    {575409600 25200 1 +07}
    {575409600 25200 1 +06}
    {591134400 21600 0 +06}
    {606859200 25200 1 +07}
    {606859200 25200 1 +06}
    {622584000 21600 0 +06}
    {638308800 25200 1 +07}
    {638308800 25200 1 +06}
    {654638400 21600 0 +06}
    {670363200 18000 0 +05}
    {670366800 21600 1 +06}
    {670366800 21600 1 +05}
    {686091600 18000 0 +05}
    {695768400 21600 0 +06}
    {701812800 25200 1 +07}
    {701812800 25200 1 +06}
    {717537600 21600 0 +06}
    {733262400 25200 1 +07}
    {733262400 25200 1 +06}
    {748987200 21600 0 +06}
    {764712000 25200 1 +07}
    {764712000 25200 1 +06}
    {780436800 21600 0 +06}
    {796161600 25200 1 +07}
    {796161600 25200 1 +06}
    {811886400 21600 0 +06}
    {828216000 25200 1 +07}
    {828216000 25200 1 +06}
    {846360000 21600 0 +06}
    {859665600 25200 1 +07}
    {859665600 25200 1 +06}
    {877809600 21600 0 +06}
    {891115200 25200 1 +07}
    {891115200 25200 1 +06}
    {909259200 21600 0 +06}
    {922564800 25200 1 +07}
    {922564800 25200 1 +06}
    {941313600 21600 0 +06}
    {954014400 25200 1 +07}
    {954014400 25200 1 +06}
    {972763200 21600 0 +06}
    {985464000 25200 1 +07}
    {985464000 25200 1 +06}
    {1004212800 21600 0 +06}
    {1017518400 25200 1 +07}
    {1017518400 25200 1 +06}
    {1035662400 21600 0 +06}
    {1048968000 25200 1 +07}
    {1048968000 25200 1 +06}
    {1067112000 21600 0 +06}
    {1080417600 25200 1 +07}
    {1080417600 25200 1 +06}
    {1099166400 21600 0 +06}
}

Changes to library/tzdata/Asia/Aqtau.

1
2
3
4
5
6
7
8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30
31

32
33

34
35
36


37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58
1
2
3
4
5
6
7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26
27

28
29
30

31
32

33
34


35
36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57
58








-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+


-
+

-
+

-
-
+
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Aqtau) {
    {-9223372036854775808 12064 0 LMT}
    {-1441164064 14400 0 +04}
    {-1247544000 18000 0 +05}
    {370724400 21600 0 +06}
    {386445600 18000 0 +05}
    {386449200 21600 1 +06}
    {386449200 21600 1 +05}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {417985200 21600 1 +05}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {449607600 21600 1 +05}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {481064400 21600 1 +05}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {512514000 21600 1 +05}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {543963600 21600 1 +05}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {575413200 21600 1 +05}
    {591138000 18000 0 +05}
    {606862800 21600 1 +06}
    {606862800 21600 1 +05}
    {622587600 18000 0 +05}
    {638312400 21600 1 +06}
    {638312400 21600 1 +05}
    {654642000 18000 0 +05}
    {670366800 14400 0 +04}
    {670370400 18000 1 +05}
    {670370400 18000 1 +04}
    {686095200 14400 0 +04}
    {695772000 18000 0 +05}
    {701816400 21600 1 +06}
    {701816400 21600 1 +05}
    {717541200 18000 0 +05}
    {733266000 21600 1 +06}
    {733266000 21600 1 +05}
    {748990800 18000 0 +05}
    {764715600 21600 1 +06}
    {780440400 18000 0 +05}
    {764715600 21600 1 +05}
    {780440400 18000 0 +04}
    {780444000 14400 0 +04}
    {796168800 18000 1 +05}
    {796168800 18000 1 +04}
    {811893600 14400 0 +04}
    {828223200 18000 1 +05}
    {828223200 18000 1 +04}
    {846367200 14400 0 +04}
    {859672800 18000 1 +05}
    {859672800 18000 1 +04}
    {877816800 14400 0 +04}
    {891122400 18000 1 +05}
    {891122400 18000 1 +04}
    {909266400 14400 0 +04}
    {922572000 18000 1 +05}
    {922572000 18000 1 +04}
    {941320800 14400 0 +04}
    {954021600 18000 1 +05}
    {954021600 18000 1 +04}
    {972770400 14400 0 +04}
    {985471200 18000 1 +05}
    {985471200 18000 1 +04}
    {1004220000 14400 0 +04}
    {1017525600 18000 1 +05}
    {1017525600 18000 1 +04}
    {1035669600 14400 0 +04}
    {1048975200 18000 1 +05}
    {1048975200 18000 1 +04}
    {1067119200 14400 0 +04}
    {1080424800 18000 1 +05}
    {1080424800 18000 1 +04}
    {1099173600 18000 0 +05}
}

Changes to library/tzdata/Asia/Aqtobe.

1
2
3
4
5
6
7
8
9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28
29

30
31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58
1
2
3
4
5
6
7
8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57
58









-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+


-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Aqtobe) {
    {-9223372036854775808 13720 0 LMT}
    {-1441165720 14400 0 +04}
    {-1247544000 18000 0 +05}
    {354913200 21600 1 +06}
    {370720800 21600 0 +06}
    {386445600 18000 0 +05}
    {386449200 21600 1 +06}
    {386449200 21600 1 +05}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {417985200 21600 1 +05}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {449607600 21600 1 +05}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {481064400 21600 1 +05}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {512514000 21600 1 +05}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {543963600 21600 1 +05}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {575413200 21600 1 +05}
    {591138000 18000 0 +05}
    {606862800 21600 1 +06}
    {606862800 21600 1 +05}
    {622587600 18000 0 +05}
    {638312400 21600 1 +06}
    {638312400 21600 1 +05}
    {654642000 18000 0 +05}
    {670366800 14400 0 +04}
    {670370400 18000 1 +05}
    {670370400 18000 1 +04}
    {686095200 14400 0 +04}
    {695772000 18000 0 +05}
    {701816400 21600 1 +06}
    {701816400 21600 1 +05}
    {717541200 18000 0 +05}
    {733266000 21600 1 +06}
    {733266000 21600 1 +05}
    {748990800 18000 0 +05}
    {764715600 21600 1 +06}
    {764715600 21600 1 +05}
    {780440400 18000 0 +05}
    {796165200 21600 1 +06}
    {796165200 21600 1 +05}
    {811890000 18000 0 +05}
    {828219600 21600 1 +06}
    {828219600 21600 1 +05}
    {846363600 18000 0 +05}
    {859669200 21600 1 +06}
    {859669200 21600 1 +05}
    {877813200 18000 0 +05}
    {891118800 21600 1 +06}
    {891118800 21600 1 +05}
    {909262800 18000 0 +05}
    {922568400 21600 1 +06}
    {922568400 21600 1 +05}
    {941317200 18000 0 +05}
    {954018000 21600 1 +06}
    {954018000 21600 1 +05}
    {972766800 18000 0 +05}
    {985467600 21600 1 +06}
    {985467600 21600 1 +05}
    {1004216400 18000 0 +05}
    {1017522000 21600 1 +06}
    {1017522000 21600 1 +05}
    {1035666000 18000 0 +05}
    {1048971600 21600 1 +06}
    {1048971600 21600 1 +05}
    {1067115600 18000 0 +05}
    {1080421200 21600 1 +06}
    {1080421200 21600 1 +05}
    {1099170000 18000 0 +05}
}

Changes to library/tzdata/Asia/Ashgabat.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30
31
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26
27

28
29
30
31






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Ashgabat) {
    {-9223372036854775808 14012 0 LMT}
    {-1441166012 14400 0 +04}
    {-1247544000 18000 0 +05}
    {354913200 21600 1 +06}
    {354913200 21600 1 +05}
    {370720800 18000 0 +05}
    {386449200 21600 1 +06}
    {386449200 21600 1 +05}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {417985200 21600 1 +05}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {449607600 21600 1 +05}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {481064400 21600 1 +05}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {512514000 21600 1 +05}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {543963600 21600 1 +05}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {575413200 21600 1 +05}
    {591138000 18000 0 +05}
    {606862800 21600 1 +06}
    {606862800 21600 1 +05}
    {622587600 18000 0 +05}
    {638312400 21600 1 +06}
    {638312400 21600 1 +05}
    {654642000 18000 0 +05}
    {670366800 14400 0 +04}
    {670370400 18000 1 +05}
    {670370400 18000 1 +04}
    {686095200 14400 0 +04}
    {695772000 18000 0 +05}
}

Changes to library/tzdata/Asia/Atyrau.

1
2
3
4
5
6
7
8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45
46

47
48

49
50

51
52

53
54

55
56

57
58
1
2
3
4
5
6
7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26
27

28
29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44
45

46
47

48
49

50
51

52
53

54
55

56
57
58








-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+


-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Atyrau) {
    {-9223372036854775808 12464 0 LMT}
    {-1441164464 10800 0 +03}
    {-1247540400 18000 0 +05}
    {370724400 21600 0 +06}
    {386445600 18000 0 +05}
    {386449200 21600 1 +06}
    {386449200 21600 1 +05}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {417985200 21600 1 +05}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {449607600 21600 1 +05}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {481064400 21600 1 +05}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {512514000 21600 1 +05}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {543963600 21600 1 +05}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {575413200 21600 1 +05}
    {591138000 18000 0 +05}
    {606862800 21600 1 +06}
    {606862800 21600 1 +05}
    {622587600 18000 0 +05}
    {638312400 21600 1 +06}
    {638312400 21600 1 +05}
    {654642000 18000 0 +05}
    {670366800 14400 0 +04}
    {670370400 18000 1 +05}
    {670370400 18000 1 +04}
    {686095200 14400 0 +04}
    {695772000 18000 0 +05}
    {701816400 21600 1 +06}
    {701816400 21600 1 +05}
    {717541200 18000 0 +05}
    {733266000 21600 1 +06}
    {733266000 21600 1 +05}
    {748990800 18000 0 +05}
    {764715600 21600 1 +06}
    {764715600 21600 1 +05}
    {780440400 18000 0 +05}
    {796165200 21600 1 +06}
    {796165200 21600 1 +05}
    {811890000 18000 0 +05}
    {828219600 21600 1 +06}
    {828219600 21600 1 +05}
    {846363600 18000 0 +05}
    {859669200 21600 1 +06}
    {859669200 21600 1 +05}
    {877813200 18000 0 +05}
    {891118800 21600 1 +06}
    {891118800 21600 1 +05}
    {909262800 18000 0 +05}
    {922568400 14400 0 +04}
    {922572000 18000 1 +05}
    {922572000 18000 1 +04}
    {941320800 14400 0 +04}
    {954021600 18000 1 +05}
    {954021600 18000 1 +04}
    {972770400 14400 0 +04}
    {985471200 18000 1 +05}
    {985471200 18000 1 +04}
    {1004220000 14400 0 +04}
    {1017525600 18000 1 +05}
    {1017525600 18000 1 +04}
    {1035669600 14400 0 +04}
    {1048975200 18000 1 +05}
    {1048975200 18000 1 +04}
    {1067119200 14400 0 +04}
    {1080424800 18000 1 +05}
    {1080424800 18000 1 +04}
    {1099173600 18000 0 +05}
}

Changes to library/tzdata/Asia/Baghdad.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58




















































59
1
2
3
4
5
6




















































7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Baghdad) {
    {-9223372036854775808 10660 0 LMT}
    {-2524532260 10656 0 BMT}
    {-1641005856 10800 0 +03}
    {389048400 14400 0 +04}
    {402264000 10800 0 +04}
    {417906000 14400 1 +04}
    {433800000 10800 0 +04}
    {449614800 14400 1 +04}
    {465422400 10800 0 +04}
    {481150800 14400 1 +04}
    {496792800 10800 0 +04}
    {512517600 14400 1 +04}
    {528242400 10800 0 +04}
    {543967200 14400 1 +04}
    {559692000 10800 0 +04}
    {575416800 14400 1 +04}
    {591141600 10800 0 +04}
    {606866400 14400 1 +04}
    {622591200 10800 0 +04}
    {638316000 14400 1 +04}
    {654645600 10800 0 +04}
    {670464000 14400 1 +04}
    {686275200 10800 0 +04}
    {702086400 14400 1 +04}
    {717897600 10800 0 +04}
    {733622400 14400 1 +04}
    {749433600 10800 0 +04}
    {765158400 14400 1 +04}
    {780969600 10800 0 +04}
    {796694400 14400 1 +04}
    {812505600 10800 0 +04}
    {828316800 14400 1 +04}
    {844128000 10800 0 +04}
    {859852800 14400 1 +04}
    {875664000 10800 0 +04}
    {891388800 14400 1 +04}
    {907200000 10800 0 +04}
    {922924800 14400 1 +04}
    {938736000 10800 0 +04}
    {954547200 14400 1 +04}
    {970358400 10800 0 +04}
    {986083200 14400 1 +04}
    {1001894400 10800 0 +04}
    {1017619200 14400 1 +04}
    {1033430400 10800 0 +04}
    {1049155200 14400 1 +04}
    {1064966400 10800 0 +04}
    {1080777600 14400 1 +04}
    {1096588800 10800 0 +04}
    {1112313600 14400 1 +04}
    {1128124800 10800 0 +04}
    {1143849600 14400 1 +04}
    {1159660800 10800 0 +04}
    {1175385600 14400 1 +04}
    {1191196800 10800 0 +04}
    {389048400 14400 0 +03}
    {402264000 10800 0 +03}
    {417906000 14400 1 +03}
    {433800000 10800 0 +03}
    {449614800 14400 1 +03}
    {465422400 10800 0 +03}
    {481150800 14400 1 +03}
    {496792800 10800 0 +03}
    {512517600 14400 1 +03}
    {528242400 10800 0 +03}
    {543967200 14400 1 +03}
    {559692000 10800 0 +03}
    {575416800 14400 1 +03}
    {591141600 10800 0 +03}
    {606866400 14400 1 +03}
    {622591200 10800 0 +03}
    {638316000 14400 1 +03}
    {654645600 10800 0 +03}
    {670464000 14400 1 +03}
    {686275200 10800 0 +03}
    {702086400 14400 1 +03}
    {717897600 10800 0 +03}
    {733622400 14400 1 +03}
    {749433600 10800 0 +03}
    {765158400 14400 1 +03}
    {780969600 10800 0 +03}
    {796694400 14400 1 +03}
    {812505600 10800 0 +03}
    {828316800 14400 1 +03}
    {844128000 10800 0 +03}
    {859852800 14400 1 +03}
    {875664000 10800 0 +03}
    {891388800 14400 1 +03}
    {907200000 10800 0 +03}
    {922924800 14400 1 +03}
    {938736000 10800 0 +03}
    {954547200 14400 1 +03}
    {970358400 10800 0 +03}
    {986083200 14400 1 +03}
    {1001894400 10800 0 +03}
    {1017619200 14400 1 +03}
    {1033430400 10800 0 +03}
    {1049155200 14400 1 +03}
    {1064966400 10800 0 +03}
    {1080777600 14400 1 +03}
    {1096588800 10800 0 +03}
    {1112313600 14400 1 +03}
    {1128124800 10800 0 +03}
    {1143849600 14400 1 +03}
    {1159660800 10800 0 +03}
    {1175385600 14400 1 +03}
    {1191196800 10800 0 +03}
}

Changes to library/tzdata/Asia/Baku.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30

31
32
33
34
35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66

67
68

69
70

71
72

73
74
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26
27

28
29

30
31
32
33
34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67

68
69

70
71

72
73
74






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Baku) {
    {-9223372036854775808 11964 0 LMT}
    {-1441163964 10800 0 +03}
    {-405140400 14400 0 +04}
    {354916800 18000 1 +05}
    {354916800 18000 1 +04}
    {370724400 14400 0 +04}
    {386452800 18000 1 +05}
    {386452800 18000 1 +04}
    {402260400 14400 0 +04}
    {417988800 18000 1 +05}
    {417988800 18000 1 +04}
    {433796400 14400 0 +04}
    {449611200 18000 1 +05}
    {449611200 18000 1 +04}
    {465343200 14400 0 +04}
    {481068000 18000 1 +05}
    {481068000 18000 1 +04}
    {496792800 14400 0 +04}
    {512517600 18000 1 +05}
    {512517600 18000 1 +04}
    {528242400 14400 0 +04}
    {543967200 18000 1 +05}
    {543967200 18000 1 +04}
    {559692000 14400 0 +04}
    {575416800 18000 1 +05}
    {575416800 18000 1 +04}
    {591141600 14400 0 +04}
    {606866400 18000 1 +05}
    {606866400 18000 1 +04}
    {622591200 14400 0 +04}
    {638316000 18000 1 +05}
    {638316000 18000 1 +04}
    {654645600 14400 0 +04}
    {670370400 10800 0 +03}
    {670374000 14400 1 +04}
    {670374000 14400 1 +03}
    {686098800 10800 0 +03}
    {701823600 14400 1 +04}
    {701823600 14400 1 +03}
    {717548400 14400 0 +04}
    {820440000 14400 0 +04}
    {828234000 18000 1 +05}
    {846378000 14400 0 +04}
    {852062400 14400 0 +04}
    {859680000 18000 1 +05}
    {859680000 18000 1 +04}
    {877824000 14400 0 +04}
    {891129600 18000 1 +05}
    {891129600 18000 1 +04}
    {909273600 14400 0 +04}
    {922579200 18000 1 +05}
    {922579200 18000 1 +04}
    {941328000 14400 0 +04}
    {954028800 18000 1 +05}
    {954028800 18000 1 +04}
    {972777600 14400 0 +04}
    {985478400 18000 1 +05}
    {985478400 18000 1 +04}
    {1004227200 14400 0 +04}
    {1017532800 18000 1 +05}
    {1017532800 18000 1 +04}
    {1035676800 14400 0 +04}
    {1048982400 18000 1 +05}
    {1048982400 18000 1 +04}
    {1067126400 14400 0 +04}
    {1080432000 18000 1 +05}
    {1080432000 18000 1 +04}
    {1099180800 14400 0 +04}
    {1111881600 18000 1 +05}
    {1111881600 18000 1 +04}
    {1130630400 14400 0 +04}
    {1143331200 18000 1 +05}
    {1143331200 18000 1 +04}
    {1162080000 14400 0 +04}
    {1174780800 18000 1 +05}
    {1174780800 18000 1 +04}
    {1193529600 14400 0 +04}
    {1206835200 18000 1 +05}
    {1206835200 18000 1 +04}
    {1224979200 14400 0 +04}
    {1238284800 18000 1 +05}
    {1238284800 18000 1 +04}
    {1256428800 14400 0 +04}
    {1269734400 18000 1 +05}
    {1269734400 18000 1 +04}
    {1288483200 14400 0 +04}
    {1301184000 18000 1 +05}
    {1301184000 18000 1 +04}
    {1319932800 14400 0 +04}
    {1332633600 18000 1 +05}
    {1332633600 18000 1 +04}
    {1351382400 14400 0 +04}
    {1364688000 18000 1 +05}
    {1364688000 18000 1 +04}
    {1382832000 14400 0 +04}
    {1396137600 18000 1 +05}
    {1396137600 18000 1 +04}
    {1414281600 14400 0 +04}
    {1427587200 18000 1 +05}
    {1427587200 18000 1 +04}
    {1445731200 14400 0 +04}
}

Changes to library/tzdata/Asia/Bishkek.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57
58






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Bishkek) {
    {-9223372036854775808 17904 0 LMT}
    {-1441169904 18000 0 +05}
    {-1247547600 21600 0 +06}
    {354909600 25200 1 +07}
    {354909600 25200 1 +06}
    {370717200 21600 0 +06}
    {386445600 25200 1 +07}
    {386445600 25200 1 +06}
    {402253200 21600 0 +06}
    {417981600 25200 1 +07}
    {417981600 25200 1 +06}
    {433789200 21600 0 +06}
    {449604000 25200 1 +07}
    {449604000 25200 1 +06}
    {465336000 21600 0 +06}
    {481060800 25200 1 +07}
    {481060800 25200 1 +06}
    {496785600 21600 0 +06}
    {512510400 25200 1 +07}
    {512510400 25200 1 +06}
    {528235200 21600 0 +06}
    {543960000 25200 1 +07}
    {543960000 25200 1 +06}
    {559684800 21600 0 +06}
    {575409600 25200 1 +07}
    {575409600 25200 1 +06}
    {591134400 21600 0 +06}
    {606859200 25200 1 +07}
    {606859200 25200 1 +06}
    {622584000 21600 0 +06}
    {638308800 25200 1 +07}
    {638308800 25200 1 +06}
    {654638400 21600 0 +06}
    {670363200 18000 0 +05}
    {670366800 21600 1 +06}
    {670366800 21600 1 +05}
    {683586000 18000 0 +05}
    {703018800 21600 1 +06}
    {703018800 21600 1 +05}
    {717530400 18000 0 +05}
    {734468400 21600 1 +06}
    {734468400 21600 1 +05}
    {748980000 18000 0 +05}
    {765918000 21600 1 +06}
    {765918000 21600 1 +05}
    {780429600 18000 0 +05}
    {797367600 21600 1 +06}
    {797367600 21600 1 +05}
    {811879200 18000 0 +05}
    {828817200 21600 1 +06}
    {828817200 21600 1 +05}
    {843933600 18000 0 +05}
    {859671000 21600 1 +06}
    {859671000 21600 1 +05}
    {877811400 18000 0 +05}
    {891120600 21600 1 +06}
    {891120600 21600 1 +05}
    {909261000 18000 0 +05}
    {922570200 21600 1 +06}
    {922570200 21600 1 +05}
    {941315400 18000 0 +05}
    {954019800 21600 1 +06}
    {954019800 21600 1 +05}
    {972765000 18000 0 +05}
    {985469400 21600 1 +06}
    {985469400 21600 1 +05}
    {1004214600 18000 0 +05}
    {1017523800 21600 1 +06}
    {1017523800 21600 1 +05}
    {1035664200 18000 0 +05}
    {1048973400 21600 1 +06}
    {1048973400 21600 1 +05}
    {1067113800 18000 0 +05}
    {1080423000 21600 1 +06}
    {1080423000 21600 1 +05}
    {1099168200 18000 0 +05}
    {1111872600 21600 1 +06}
    {1111872600 21600 1 +05}
    {1123783200 21600 0 +06}
}

Changes to library/tzdata/Asia/Choibalsan.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51
52

53
54

55
56
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50
51

52
53

54
55
56






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Choibalsan) {
    {-9223372036854775808 27480 0 LMT}
    {-2032933080 25200 0 +07}
    {252435600 28800 0 +08}
    {417974400 36000 0 +10}
    {417974400 36000 0 +09}
    {433778400 32400 0 +09}
    {449593200 36000 1 +10}
    {449593200 36000 1 +09}
    {465314400 32400 0 +09}
    {481042800 36000 1 +10}
    {481042800 36000 1 +09}
    {496764000 32400 0 +09}
    {512492400 36000 1 +10}
    {512492400 36000 1 +09}
    {528213600 32400 0 +09}
    {543942000 36000 1 +10}
    {543942000 36000 1 +09}
    {559663200 32400 0 +09}
    {575391600 36000 1 +10}
    {575391600 36000 1 +09}
    {591112800 32400 0 +09}
    {606841200 36000 1 +10}
    {606841200 36000 1 +09}
    {622562400 32400 0 +09}
    {638290800 36000 1 +10}
    {638290800 36000 1 +09}
    {654616800 32400 0 +09}
    {670345200 36000 1 +10}
    {670345200 36000 1 +09}
    {686066400 32400 0 +09}
    {701794800 36000 1 +10}
    {701794800 36000 1 +09}
    {717516000 32400 0 +09}
    {733244400 36000 1 +10}
    {733244400 36000 1 +09}
    {748965600 32400 0 +09}
    {764694000 36000 1 +10}
    {764694000 36000 1 +09}
    {780415200 32400 0 +09}
    {796143600 36000 1 +10}
    {796143600 36000 1 +09}
    {811864800 32400 0 +09}
    {828198000 36000 1 +10}
    {828198000 36000 1 +09}
    {843919200 32400 0 +09}
    {859647600 36000 1 +10}
    {859647600 36000 1 +09}
    {875368800 32400 0 +09}
    {891097200 36000 1 +10}
    {891097200 36000 1 +09}
    {906818400 32400 0 +09}
    {988390800 36000 1 +10}
    {988390800 36000 1 +09}
    {1001692800 32400 0 +09}
    {1017421200 36000 1 +10}
    {1017421200 36000 1 +09}
    {1033142400 32400 0 +09}
    {1048870800 36000 1 +10}
    {1048870800 36000 1 +09}
    {1064592000 32400 0 +09}
    {1080320400 36000 1 +10}
    {1080320400 36000 1 +09}
    {1096041600 32400 0 +09}
    {1111770000 36000 1 +10}
    {1111770000 36000 1 +09}
    {1127491200 32400 0 +09}
    {1143219600 36000 1 +10}
    {1143219600 36000 1 +09}
    {1159545600 32400 0 +09}
    {1206889200 28800 0 +08}
    {1427479200 32400 1 +09}
    {1427479200 32400 1 +08}
    {1443193200 28800 0 +08}
    {1458928800 32400 1 +09}
    {1458928800 32400 1 +08}
    {1474642800 28800 0 +08}
}

Changes to library/tzdata/Asia/Dhaka.

1
2
3
4
5
6
7
8
9
10
11

12
13
1
2
3
4
5
6
7
8
9
10

11
12
13










-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Dhaka) {
    {-9223372036854775808 21700 0 LMT}
    {-2524543300 21200 0 HMT}
    {-891582800 23400 0 +0630}
    {-872058600 19800 0 +0530}
    {-862637400 23400 0 +0630}
    {-576138600 21600 0 +06}
    {1230746400 21600 0 +06}
    {1245430800 25200 1 +07}
    {1245430800 25200 1 +06}
    {1262278800 21600 0 +06}
}

Changes to library/tzdata/Asia/Dushanbe.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28
29
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26
27
28
29






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+




# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Dushanbe) {
    {-9223372036854775808 16512 0 LMT}
    {-1441168512 18000 0 +05}
    {-1247547600 21600 0 +06}
    {354909600 25200 1 +07}
    {354909600 25200 1 +06}
    {370717200 21600 0 +06}
    {386445600 25200 1 +07}
    {386445600 25200 1 +06}
    {402253200 21600 0 +06}
    {417981600 25200 1 +07}
    {417981600 25200 1 +06}
    {433789200 21600 0 +06}
    {449604000 25200 1 +07}
    {449604000 25200 1 +06}
    {465336000 21600 0 +06}
    {481060800 25200 1 +07}
    {481060800 25200 1 +06}
    {496785600 21600 0 +06}
    {512510400 25200 1 +07}
    {512510400 25200 1 +06}
    {528235200 21600 0 +06}
    {543960000 25200 1 +07}
    {543960000 25200 1 +06}
    {559684800 21600 0 +06}
    {575409600 25200 1 +07}
    {575409600 25200 1 +06}
    {591134400 21600 0 +06}
    {606859200 25200 1 +07}
    {606859200 25200 1 +06}
    {622584000 21600 0 +06}
    {638308800 25200 1 +07}
    {638308800 25200 1 +06}
    {654638400 21600 0 +06}
    {670363200 21600 1 +06}
    {684363600 18000 0 +05}
}

Changes to library/tzdata/Asia/Gaza.

107
108
109
110
111
112
113
114

115
116

117
118
119
120
121
122
123
124
125
126

127
128

129
130
131
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

161
162

163
164
165
166
167
168
169
170

171
172

173
174
175
176
177
178
179
180
181
182

183
184

185
186
187
188
189
190
191
192

193
194

195
196

197
198
199
200
201
202
203
204

205
206

207
208
209
210
211
212
213
214

215
216

217
218

219
220
221
222
223
224
225
226

227
228

229
230
231
232
233
234
235
236
237
238

239
240

241
242
243
244
245
246
247
248

249
250

251
252

253
254
255
256
257
258
259
260

261
262

263
264
265
266
267
268
269
270

271
272

273
274

275
276
277
278
107
108
109
110
111
112
113

114
115

116
117
118
119
120
121
122
123
124
125

126
127

128
129
130
131
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
161

162
163
164
165
166
167
168
169

170
171

172
173
174
175
176
177
178
179
180
181

182
183

184
185
186
187
188
189
190
191

192
193

194
195

196
197
198
199
200
201
202
203

204
205

206
207
208
209
210
211
212
213

214
215

216
217

218
219
220
221
222
223
224
225

226
227

228
229
230
231
232
233
234
235
236
237

238
239

240
241
242
243
244
245
246
247

248
249

250
251

252
253
254
255
256
257
258
259

260
261

262
263
264
265
266
267
268
269

270
271

272
273

274
275
276
277
278







-
+

-
+









-
+

-
+







-
+

-
+

-
+







-
+

-
+







-
+

-
+

-
+







-
+

-
+









-
+

-
+







-
+

-
+

-
+







-
+

-
+







-
+

-
+

-
+







-
+

-
+









-
+

-
+







-
+

-
+

-
+







-
+

-
+







-
+

-
+

-
+




    {1414098000 7200 0 EET}
    {1427493600 10800 1 EEST}
    {1445547600 7200 0 EET}
    {1458946800 10800 1 EEST}
    {1477692000 7200 0 EET}
    {1490396400 10800 1 EEST}
    {1509141600 7200 0 EET}
    {1522450800 10800 1 EEST}
    {1521846000 10800 1 EEST}
    {1540591200 7200 0 EET}
    {1553900400 10800 1 EEST}
    {1553295600 10800 1 EEST}
    {1572040800 7200 0 EET}
    {1585350000 10800 1 EEST}
    {1604095200 7200 0 EET}
    {1616799600 10800 1 EEST}
    {1635544800 7200 0 EET}
    {1648249200 10800 1 EEST}
    {1666994400 7200 0 EET}
    {1679698800 10800 1 EEST}
    {1698444000 7200 0 EET}
    {1711753200 10800 1 EEST}
    {1711148400 10800 1 EEST}
    {1729893600 7200 0 EET}
    {1743202800 10800 1 EEST}
    {1742598000 10800 1 EEST}
    {1761343200 7200 0 EET}
    {1774652400 10800 1 EEST}
    {1793397600 7200 0 EET}
    {1806102000 10800 1 EEST}
    {1824847200 7200 0 EET}
    {1837551600 10800 1 EEST}
    {1856296800 7200 0 EET}
    {1869606000 10800 1 EEST}
    {1869001200 10800 1 EEST}
    {1887746400 7200 0 EET}
    {1901055600 10800 1 EEST}
    {1900450800 10800 1 EEST}
    {1919196000 7200 0 EET}
    {1932505200 10800 1 EEST}
    {1931900400 10800 1 EEST}
    {1950645600 7200 0 EET}
    {1963954800 10800 1 EEST}
    {1982700000 7200 0 EET}
    {1995404400 10800 1 EEST}
    {2014149600 7200 0 EET}
    {2026854000 10800 1 EEST}
    {2045599200 7200 0 EET}
    {2058908400 10800 1 EEST}
    {2058303600 10800 1 EEST}
    {2077048800 7200 0 EET}
    {2090358000 10800 1 EEST}
    {2089753200 10800 1 EEST}
    {2108498400 7200 0 EET}
    {2121807600 10800 1 EEST}
    {2140552800 7200 0 EET}
    {2153257200 10800 1 EEST}
    {2172002400 7200 0 EET}
    {2184706800 10800 1 EEST}
    {2203452000 7200 0 EET}
    {2216761200 10800 1 EEST}
    {2216156400 10800 1 EEST}
    {2234901600 7200 0 EET}
    {2248210800 10800 1 EEST}
    {2247606000 10800 1 EEST}
    {2266351200 7200 0 EET}
    {2279660400 10800 1 EEST}
    {2279055600 10800 1 EEST}
    {2297800800 7200 0 EET}
    {2311110000 10800 1 EEST}
    {2329855200 7200 0 EET}
    {2342559600 10800 1 EEST}
    {2361304800 7200 0 EET}
    {2374009200 10800 1 EEST}
    {2392754400 7200 0 EET}
    {2406063600 10800 1 EEST}
    {2405458800 10800 1 EEST}
    {2424204000 7200 0 EET}
    {2437513200 10800 1 EEST}
    {2436908400 10800 1 EEST}
    {2455653600 7200 0 EET}
    {2468962800 10800 1 EEST}
    {2487708000 7200 0 EET}
    {2500412400 10800 1 EEST}
    {2519157600 7200 0 EET}
    {2531862000 10800 1 EEST}
    {2550607200 7200 0 EET}
    {2563311600 10800 1 EEST}
    {2582056800 7200 0 EET}
    {2595366000 10800 1 EEST}
    {2594761200 10800 1 EEST}
    {2613506400 7200 0 EET}
    {2626815600 10800 1 EEST}
    {2626210800 10800 1 EEST}
    {2644956000 7200 0 EET}
    {2658265200 10800 1 EEST}
    {2677010400 7200 0 EET}
    {2689714800 10800 1 EEST}
    {2708460000 7200 0 EET}
    {2721164400 10800 1 EEST}
    {2739909600 7200 0 EET}
    {2753218800 10800 1 EEST}
    {2752614000 10800 1 EEST}
    {2771359200 7200 0 EET}
    {2784668400 10800 1 EEST}
    {2784063600 10800 1 EEST}
    {2802808800 7200 0 EET}
    {2816118000 10800 1 EEST}
    {2815513200 10800 1 EEST}
    {2834258400 7200 0 EET}
    {2847567600 10800 1 EEST}
    {2866312800 7200 0 EET}
    {2879017200 10800 1 EEST}
    {2897762400 7200 0 EET}
    {2910466800 10800 1 EEST}
    {2929212000 7200 0 EET}
    {2942521200 10800 1 EEST}
    {2941916400 10800 1 EEST}
    {2960661600 7200 0 EET}
    {2973970800 10800 1 EEST}
    {2973366000 10800 1 EEST}
    {2992111200 7200 0 EET}
    {3005420400 10800 1 EEST}
    {3024165600 7200 0 EET}
    {3036870000 10800 1 EEST}
    {3055615200 7200 0 EET}
    {3068319600 10800 1 EEST}
    {3087064800 7200 0 EET}
    {3100374000 10800 1 EEST}
    {3099769200 10800 1 EEST}
    {3118514400 7200 0 EET}
    {3131823600 10800 1 EEST}
    {3131218800 10800 1 EEST}
    {3149964000 7200 0 EET}
    {3163273200 10800 1 EEST}
    {3162668400 10800 1 EEST}
    {3181413600 7200 0 EET}
    {3194722800 10800 1 EEST}
    {3213468000 7200 0 EET}
    {3226172400 10800 1 EEST}
    {3244917600 7200 0 EET}
    {3257622000 10800 1 EEST}
    {3276367200 7200 0 EET}
    {3289676400 10800 1 EEST}
    {3289071600 10800 1 EEST}
    {3307816800 7200 0 EET}
    {3321126000 10800 1 EEST}
    {3320521200 10800 1 EEST}
    {3339266400 7200 0 EET}
    {3352575600 10800 1 EEST}
    {3371320800 7200 0 EET}
    {3384025200 10800 1 EEST}
    {3402770400 7200 0 EET}
    {3415474800 10800 1 EEST}
    {3434220000 7200 0 EET}
    {3446924400 10800 1 EEST}
    {3465669600 7200 0 EET}
    {3478978800 10800 1 EEST}
    {3478374000 10800 1 EEST}
    {3497119200 7200 0 EET}
    {3510428400 10800 1 EEST}
    {3509823600 10800 1 EEST}
    {3528568800 7200 0 EET}
    {3541878000 10800 1 EEST}
    {3560623200 7200 0 EET}
    {3573327600 10800 1 EEST}
    {3592072800 7200 0 EET}
    {3604777200 10800 1 EEST}
    {3623522400 7200 0 EET}
    {3636831600 10800 1 EEST}
    {3636226800 10800 1 EEST}
    {3654972000 7200 0 EET}
    {3668281200 10800 1 EEST}
    {3667676400 10800 1 EEST}
    {3686421600 7200 0 EET}
    {3699730800 10800 1 EEST}
    {3699126000 10800 1 EEST}
    {3717871200 7200 0 EET}
    {3731180400 10800 1 EEST}
    {3749925600 7200 0 EET}
    {3762630000 10800 1 EEST}
    {3781375200 7200 0 EET}
    {3794079600 10800 1 EEST}
    {3812824800 7200 0 EET}
    {3826134000 10800 1 EEST}
    {3825529200 10800 1 EEST}
    {3844274400 7200 0 EET}
    {3857583600 10800 1 EEST}
    {3856978800 10800 1 EEST}
    {3875724000 7200 0 EET}
    {3889033200 10800 1 EEST}
    {3907778400 7200 0 EET}
    {3920482800 10800 1 EEST}
    {3939228000 7200 0 EET}
    {3951932400 10800 1 EEST}
    {3970677600 7200 0 EET}
    {3983986800 10800 1 EEST}
    {3983382000 10800 1 EEST}
    {4002127200 7200 0 EET}
    {4015436400 10800 1 EEST}
    {4014831600 10800 1 EEST}
    {4033576800 7200 0 EET}
    {4046886000 10800 1 EEST}
    {4046281200 10800 1 EEST}
    {4065026400 7200 0 EET}
    {4078335600 10800 1 EEST}
    {4097080800 7200 0 EET}
}

Changes to library/tzdata/Asia/Hebron.

106
107
108
109
110
111
112
113

114
115

116
117
118
119
120
121
122
123
124
125

126
127

128
129
130
131
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
161

162
163
164
165
166
167
168
169

170
171

172
173
174
175
176
177
178
179
180
181

182
183

184
185
186
187
188
189
190
191

192
193

194
195

196
197
198
199
200
201
202
203

204
205

206
207
208
209
210
211
212
213

214
215

216
217

218
219
220
221
222
223
224
225

226
227

228
229
230
231
232
233
234
235
236
237

238
239

240
241
242
243
244
245
246
247

248
249

250
251

252
253
254
255
256
257
258
259

260
261

262
263
264
265
266
267
268
269

270
271

272
273

274
275
276
277
106
107
108
109
110
111
112

113
114

115
116
117
118
119
120
121
122
123
124

125
126

127
128
129
130
131
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

161
162
163
164
165
166
167
168

169
170

171
172
173
174
175
176
177
178
179
180

181
182

183
184
185
186
187
188
189
190

191
192

193
194

195
196
197
198
199
200
201
202

203
204

205
206
207
208
209
210
211
212

213
214

215
216

217
218
219
220
221
222
223
224

225
226

227
228
229
230
231
232
233
234
235
236

237
238

239
240
241
242
243
244
245
246

247
248

249
250

251
252
253
254
255
256
257
258

259
260

261
262
263
264
265
266
267
268

269
270

271
272

273
274
275
276
277







-
+

-
+









-
+

-
+







-
+

-
+

-
+







-
+

-
+







-
+

-
+

-
+







-
+

-
+









-
+

-
+







-
+

-
+

-
+







-
+

-
+







-
+

-
+

-
+







-
+

-
+









-
+

-
+







-
+

-
+

-
+







-
+

-
+







-
+

-
+

-
+




    {1414098000 7200 0 EET}
    {1427493600 10800 1 EEST}
    {1445547600 7200 0 EET}
    {1458946800 10800 1 EEST}
    {1477692000 7200 0 EET}
    {1490396400 10800 1 EEST}
    {1509141600 7200 0 EET}
    {1522450800 10800 1 EEST}
    {1521846000 10800 1 EEST}
    {1540591200 7200 0 EET}
    {1553900400 10800 1 EEST}
    {1553295600 10800 1 EEST}
    {1572040800 7200 0 EET}
    {1585350000 10800 1 EEST}
    {1604095200 7200 0 EET}
    {1616799600 10800 1 EEST}
    {1635544800 7200 0 EET}
    {1648249200 10800 1 EEST}
    {1666994400 7200 0 EET}
    {1679698800 10800 1 EEST}
    {1698444000 7200 0 EET}
    {1711753200 10800 1 EEST}
    {1711148400 10800 1 EEST}
    {1729893600 7200 0 EET}
    {1743202800 10800 1 EEST}
    {1742598000 10800 1 EEST}
    {1761343200 7200 0 EET}
    {1774652400 10800 1 EEST}
    {1793397600 7200 0 EET}
    {1806102000 10800 1 EEST}
    {1824847200 7200 0 EET}
    {1837551600 10800 1 EEST}
    {1856296800 7200 0 EET}
    {1869606000 10800 1 EEST}
    {1869001200 10800 1 EEST}
    {1887746400 7200 0 EET}
    {1901055600 10800 1 EEST}
    {1900450800 10800 1 EEST}
    {1919196000 7200 0 EET}
    {1932505200 10800 1 EEST}
    {1931900400 10800 1 EEST}
    {1950645600 7200 0 EET}
    {1963954800 10800 1 EEST}
    {1982700000 7200 0 EET}
    {1995404400 10800 1 EEST}
    {2014149600 7200 0 EET}
    {2026854000 10800 1 EEST}
    {2045599200 7200 0 EET}
    {2058908400 10800 1 EEST}
    {2058303600 10800 1 EEST}
    {2077048800 7200 0 EET}
    {2090358000 10800 1 EEST}
    {2089753200 10800 1 EEST}
    {2108498400 7200 0 EET}
    {2121807600 10800 1 EEST}
    {2140552800 7200 0 EET}
    {2153257200 10800 1 EEST}
    {2172002400 7200 0 EET}
    {2184706800 10800 1 EEST}
    {2203452000 7200 0 EET}
    {2216761200 10800 1 EEST}
    {2216156400 10800 1 EEST}
    {2234901600 7200 0 EET}
    {2248210800 10800 1 EEST}
    {2247606000 10800 1 EEST}
    {2266351200 7200 0 EET}
    {2279660400 10800 1 EEST}
    {2279055600 10800 1 EEST}
    {2297800800 7200 0 EET}
    {2311110000 10800 1 EEST}
    {2329855200 7200 0 EET}
    {2342559600 10800 1 EEST}
    {2361304800 7200 0 EET}
    {2374009200 10800 1 EEST}
    {2392754400 7200 0 EET}
    {2406063600 10800 1 EEST}
    {2405458800 10800 1 EEST}
    {2424204000 7200 0 EET}
    {2437513200 10800 1 EEST}
    {2436908400 10800 1 EEST}
    {2455653600 7200 0 EET}
    {2468962800 10800 1 EEST}
    {2487708000 7200 0 EET}
    {2500412400 10800 1 EEST}
    {2519157600 7200 0 EET}
    {2531862000 10800 1 EEST}
    {2550607200 7200 0 EET}
    {2563311600 10800 1 EEST}
    {2582056800 7200 0 EET}
    {2595366000 10800 1 EEST}
    {2594761200 10800 1 EEST}
    {2613506400 7200 0 EET}
    {2626815600 10800 1 EEST}
    {2626210800 10800 1 EEST}
    {2644956000 7200 0 EET}
    {2658265200 10800 1 EEST}
    {2677010400 7200 0 EET}
    {2689714800 10800 1 EEST}
    {2708460000 7200 0 EET}
    {2721164400 10800 1 EEST}
    {2739909600 7200 0 EET}
    {2753218800 10800 1 EEST}
    {2752614000 10800 1 EEST}
    {2771359200 7200 0 EET}
    {2784668400 10800 1 EEST}
    {2784063600 10800 1 EEST}
    {2802808800 7200 0 EET}
    {2816118000 10800 1 EEST}
    {2815513200 10800 1 EEST}
    {2834258400 7200 0 EET}
    {2847567600 10800 1 EEST}
    {2866312800 7200 0 EET}
    {2879017200 10800 1 EEST}
    {2897762400 7200 0 EET}
    {2910466800 10800 1 EEST}
    {2929212000 7200 0 EET}
    {2942521200 10800 1 EEST}
    {2941916400 10800 1 EEST}
    {2960661600 7200 0 EET}
    {2973970800 10800 1 EEST}
    {2973366000 10800 1 EEST}
    {2992111200 7200 0 EET}
    {3005420400 10800 1 EEST}
    {3024165600 7200 0 EET}
    {3036870000 10800 1 EEST}
    {3055615200 7200 0 EET}
    {3068319600 10800 1 EEST}
    {3087064800 7200 0 EET}
    {3100374000 10800 1 EEST}
    {3099769200 10800 1 EEST}
    {3118514400 7200 0 EET}
    {3131823600 10800 1 EEST}
    {3131218800 10800 1 EEST}
    {3149964000 7200 0 EET}
    {3163273200 10800 1 EEST}
    {3162668400 10800 1 EEST}
    {3181413600 7200 0 EET}
    {3194722800 10800 1 EEST}
    {3213468000 7200 0 EET}
    {3226172400 10800 1 EEST}
    {3244917600 7200 0 EET}
    {3257622000 10800 1 EEST}
    {3276367200 7200 0 EET}
    {3289676400 10800 1 EEST}
    {3289071600 10800 1 EEST}
    {3307816800 7200 0 EET}
    {3321126000 10800 1 EEST}
    {3320521200 10800 1 EEST}
    {3339266400 7200 0 EET}
    {3352575600 10800 1 EEST}
    {3371320800 7200 0 EET}
    {3384025200 10800 1 EEST}
    {3402770400 7200 0 EET}
    {3415474800 10800 1 EEST}
    {3434220000 7200 0 EET}
    {3446924400 10800 1 EEST}
    {3465669600 7200 0 EET}
    {3478978800 10800 1 EEST}
    {3478374000 10800 1 EEST}
    {3497119200 7200 0 EET}
    {3510428400 10800 1 EEST}
    {3509823600 10800 1 EEST}
    {3528568800 7200 0 EET}
    {3541878000 10800 1 EEST}
    {3560623200 7200 0 EET}
    {3573327600 10800 1 EEST}
    {3592072800 7200 0 EET}
    {3604777200 10800 1 EEST}
    {3623522400 7200 0 EET}
    {3636831600 10800 1 EEST}
    {3636226800 10800 1 EEST}
    {3654972000 7200 0 EET}
    {3668281200 10800 1 EEST}
    {3667676400 10800 1 EEST}
    {3686421600 7200 0 EET}
    {3699730800 10800 1 EEST}
    {3699126000 10800 1 EEST}
    {3717871200 7200 0 EET}
    {3731180400 10800 1 EEST}
    {3749925600 7200 0 EET}
    {3762630000 10800 1 EEST}
    {3781375200 7200 0 EET}
    {3794079600 10800 1 EEST}
    {3812824800 7200 0 EET}
    {3826134000 10800 1 EEST}
    {3825529200 10800 1 EEST}
    {3844274400 7200 0 EET}
    {3857583600 10800 1 EEST}
    {3856978800 10800 1 EEST}
    {3875724000 7200 0 EET}
    {3889033200 10800 1 EEST}
    {3907778400 7200 0 EET}
    {3920482800 10800 1 EEST}
    {3939228000 7200 0 EET}
    {3951932400 10800 1 EEST}
    {3970677600 7200 0 EET}
    {3983986800 10800 1 EEST}
    {3983382000 10800 1 EEST}
    {4002127200 7200 0 EET}
    {4015436400 10800 1 EEST}
    {4014831600 10800 1 EEST}
    {4033576800 7200 0 EET}
    {4046886000 10800 1 EEST}
    {4046281200 10800 1 EEST}
    {4065026400 7200 0 EET}
    {4078335600 10800 1 EEST}
    {4097080800 7200 0 EET}
}

Changes to library/tzdata/Asia/Hovd.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54
55






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Hovd) {
    {-9223372036854775808 21996 0 LMT}
    {-2032927596 21600 0 +06}
    {252439200 25200 0 +07}
    {417978000 28800 1 +08}
    {417978000 28800 1 +07}
    {433785600 25200 0 +07}
    {449600400 28800 1 +08}
    {449600400 28800 1 +07}
    {465321600 25200 0 +07}
    {481050000 28800 1 +08}
    {481050000 28800 1 +07}
    {496771200 25200 0 +07}
    {512499600 28800 1 +08}
    {512499600 28800 1 +07}
    {528220800 25200 0 +07}
    {543949200 28800 1 +08}
    {543949200 28800 1 +07}
    {559670400 25200 0 +07}
    {575398800 28800 1 +08}
    {575398800 28800 1 +07}
    {591120000 25200 0 +07}
    {606848400 28800 1 +08}
    {606848400 28800 1 +07}
    {622569600 25200 0 +07}
    {638298000 28800 1 +08}
    {638298000 28800 1 +07}
    {654624000 25200 0 +07}
    {670352400 28800 1 +08}
    {670352400 28800 1 +07}
    {686073600 25200 0 +07}
    {701802000 28800 1 +08}
    {701802000 28800 1 +07}
    {717523200 25200 0 +07}
    {733251600 28800 1 +08}
    {733251600 28800 1 +07}
    {748972800 25200 0 +07}
    {764701200 28800 1 +08}
    {764701200 28800 1 +07}
    {780422400 25200 0 +07}
    {796150800 28800 1 +08}
    {796150800 28800 1 +07}
    {811872000 25200 0 +07}
    {828205200 28800 1 +08}
    {828205200 28800 1 +07}
    {843926400 25200 0 +07}
    {859654800 28800 1 +08}
    {859654800 28800 1 +07}
    {875376000 25200 0 +07}
    {891104400 28800 1 +08}
    {891104400 28800 1 +07}
    {906825600 25200 0 +07}
    {988398000 28800 1 +08}
    {988398000 28800 1 +07}
    {1001700000 25200 0 +07}
    {1017428400 28800 1 +08}
    {1017428400 28800 1 +07}
    {1033149600 25200 0 +07}
    {1048878000 28800 1 +08}
    {1048878000 28800 1 +07}
    {1064599200 25200 0 +07}
    {1080327600 28800 1 +08}
    {1080327600 28800 1 +07}
    {1096048800 25200 0 +07}
    {1111777200 28800 1 +08}
    {1111777200 28800 1 +07}
    {1127498400 25200 0 +07}
    {1143226800 28800 1 +08}
    {1143226800 28800 1 +07}
    {1159552800 25200 0 +07}
    {1427482800 28800 1 +08}
    {1427482800 28800 1 +07}
    {1443196800 25200 0 +07}
    {1458932400 28800 1 +08}
    {1458932400 28800 1 +07}
    {1474646400 25200 0 +07}
}

Changes to library/tzdata/Asia/Kuching.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21
22
23
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20
21
22
23






-
+

-
+

-
+

-
+

-
+

-
+

-
+




# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Kuching) {
    {-9223372036854775808 26480 0 LMT}
    {-1383463280 27000 0 +0730}
    {-1167636600 28800 0 +08}
    {-1082448000 30000 1 +0820}
    {-1082448000 30000 1 +08}
    {-1074586800 28800 0 +08}
    {-1050825600 30000 1 +0820}
    {-1050825600 30000 1 +08}
    {-1042964400 28800 0 +08}
    {-1019289600 30000 1 +0820}
    {-1019289600 30000 1 +08}
    {-1011428400 28800 0 +08}
    {-987753600 30000 1 +0820}
    {-987753600 30000 1 +08}
    {-979892400 28800 0 +08}
    {-956217600 30000 1 +0820}
    {-956217600 30000 1 +08}
    {-948356400 28800 0 +08}
    {-924595200 30000 1 +0820}
    {-924595200 30000 1 +08}
    {-916734000 28800 0 +08}
    {-893059200 30000 1 +0820}
    {-893059200 30000 1 +08}
    {-885198000 28800 0 +08}
    {-879667200 32400 0 +09}
    {-767005200 28800 0 +08}
}

Changes to library/tzdata/Asia/Macau.

1
2
3
4
5






































6
7
8
9
10

11
12
13
14
15


16
17

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32





33
34
35
36
37
38
39


40
41
42
43
44
45
46
1
2
3


4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

46
47
48
49


50
51
52

53
54
55
56
57
58
59
60
61
62
63





64
65
66
67
68
69
70
71
72
73


74
75






76



-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+



-
-
+
+

-
+










-
-
-
-
-
+
+
+
+
+





-
-
+
+
-
-
-
-
-
-

# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Macau) {
    {-9223372036854775808 27260 0 LMT}
    {-1830411260 28800 0 CST}
    {-9223372036854775808 27250 0 LMT}
    {-2056692850 28800 0 CST}
    {-884509200 32400 0 +09}
    {-873280800 36000 1 +09}
    {-855918000 32400 0 +09}
    {-841744800 36000 1 +09}
    {-828529200 32400 0 +10}
    {-765363600 28800 0 CT}
    {-747046800 32400 1 CDT}
    {-733827600 28800 0 CST}
    {-716461200 32400 1 CDT}
    {-697021200 28800 0 CST}
    {-683715600 32400 1 CDT}
    {-667990800 28800 0 CST}
    {-654771600 32400 1 CDT}
    {-636627600 28800 0 CST}
    {-623322000 32400 1 CDT}
    {-605178000 28800 0 CST}
    {-591872400 32400 1 CDT}
    {-573642000 28800 0 CST}
    {-559818000 32400 1 CDT}
    {-541674000 28800 0 CST}
    {-528368400 32400 1 CDT}
    {-510224400 28800 0 CST}
    {-498128400 32400 1 CDT}
    {-478774800 28800 0 CST}
    {-466678800 32400 1 CDT}
    {-446720400 28800 0 CST}
    {-435229200 32400 1 CDT}
    {-415258200 28800 0 CST}
    {-403158600 32400 1 CDT}
    {-383808600 28800 0 CST}
    {-371709000 32400 1 CDT}
    {-352359000 28800 0 CST}
    {-340259400 32400 1 CDT}
    {-320909400 28800 0 CST}
    {-308809800 32400 1 CDT}
    {-288855000 28800 0 CST}
    {-277360200 32400 1 CDT}
    {-257405400 28800 0 CST}
    {-245910600 32400 1 CDT}
    {-225955800 28800 0 CST}
    {-214473600 32400 1 CDT}
    {-213856200 32400 1 CDT}
    {-194506200 28800 0 CST}
    {-182406600 32400 1 CDT}
    {-163056600 28800 0 CST}
    {-150969600 32400 1 CDT}
    {-131619600 28800 0 CST}
    {-148537800 32400 1 CDT}
    {-132820200 28800 0 CST}
    {-117088200 32400 1 CDT}
    {-101367000 28800 0 CST}
    {-101370600 28800 0 CST}
    {-85638600 32400 1 CDT}
    {-69312600 28800 0 CST}
    {-53584200 32400 1 CDT}
    {-37863000 28800 0 CST}
    {-22134600 32400 1 CDT}
    {-6413400 28800 0 CST}
    {9315000 32400 1 CDT}
    {25036200 28800 0 CST}
    {40764600 32400 1 CDT}
    {56485800 28800 0 CST}
    {72201600 32400 1 CDT}
    {87922800 28800 0 CST}
    {103651200 32400 1 CDT}
    {119977200 28800 0 CST}
    {135705600 32400 1 CDT}
    {72214200 32400 1 CDT}
    {88540200 28800 0 CST}
    {104268600 32400 1 CDT}
    {119989800 28800 0 CST}
    {126041400 32400 1 CDT}
    {151439400 28800 0 CST}
    {167167800 32400 1 CDT}
    {182889000 28800 0 CST}
    {198617400 32400 1 CDT}
    {214338600 28800 0 CST}
    {230067000 32400 1 CDT}
    {245788200 28800 0 CST}
    {295385400 32400 1 CDT}
    {309292200 28800 0 CST}
    {261504000 32400 1 CDT}
    {277225200 28800 0 CST}
    {292953600 32400 1 CDT}
    {309279600 28800 0 CST}
    {325008000 32400 1 CDT}
    {340729200 28800 0 CST}
}

Changes to library/tzdata/Asia/Manila.

1
2
3
4
5
6
7
8
9
10
11
12
13
14









15
1
2
3
4
5









6
7
8
9
10
11
12
13
14
15





-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Manila) {
    {-9223372036854775808 -57360 0 LMT}
    {-3944621040 29040 0 LMT}
    {-2229321840 28800 0 +08}
    {-1046678400 32400 1 +09}
    {-1038733200 28800 0 +08}
    {-873273600 32400 0 +09}
    {-794221200 28800 0 +08}
    {-496224000 32400 1 +09}
    {-489315600 28800 0 +08}
    {259344000 32400 1 +09}
    {275151600 28800 0 +08}
    {-2229321840 28800 0 PST}
    {-1046678400 32400 1 PDT}
    {-1038733200 28800 0 PST}
    {-873273600 32400 0 JST}
    {-794221200 28800 0 PST}
    {-496224000 32400 1 PDT}
    {-489315600 28800 0 PST}
    {259344000 32400 1 PDT}
    {275151600 28800 0 PST}
}

Changes to library/tzdata/Asia/Oral.

1
2
3
4
5
6
7
8
9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24
25

26
27

28
29

30
31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58
1
2
3
4
5
6
7
8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23
24

25
26

27
28

29
30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57
58









-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Oral) {
    {-9223372036854775808 12324 0 LMT}
    {-1441164324 10800 0 +03}
    {-1247540400 18000 0 +05}
    {354913200 21600 1 +06}
    {370720800 21600 0 +06}
    {386445600 18000 0 +05}
    {386449200 21600 1 +06}
    {386449200 21600 1 +05}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {417985200 21600 1 +05}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {449607600 21600 1 +05}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {481064400 21600 1 +05}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {512514000 21600 1 +05}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {543963600 21600 1 +05}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {575413200 21600 1 +05}
    {591138000 18000 0 +05}
    {606862800 14400 0 +04}
    {606866400 18000 1 +05}
    {606866400 18000 1 +04}
    {622591200 14400 0 +04}
    {638316000 18000 1 +05}
    {638316000 18000 1 +04}
    {654645600 14400 0 +04}
    {670370400 18000 1 +05}
    {670370400 18000 1 +04}
    {686095200 14400 0 +04}
    {701816400 14400 0 +04}
    {701820000 18000 1 +05}
    {701820000 18000 1 +04}
    {717544800 14400 0 +04}
    {733269600 18000 1 +05}
    {733269600 18000 1 +04}
    {748994400 14400 0 +04}
    {764719200 18000 1 +05}
    {764719200 18000 1 +04}
    {780444000 14400 0 +04}
    {796168800 18000 1 +05}
    {796168800 18000 1 +04}
    {811893600 14400 0 +04}
    {828223200 18000 1 +05}
    {828223200 18000 1 +04}
    {846367200 14400 0 +04}
    {859672800 18000 1 +05}
    {859672800 18000 1 +04}
    {877816800 14400 0 +04}
    {891122400 18000 1 +05}
    {891122400 18000 1 +04}
    {909266400 14400 0 +04}
    {922572000 18000 1 +05}
    {922572000 18000 1 +04}
    {941320800 14400 0 +04}
    {954021600 18000 1 +05}
    {954021600 18000 1 +04}
    {972770400 14400 0 +04}
    {985471200 18000 1 +05}
    {985471200 18000 1 +04}
    {1004220000 14400 0 +04}
    {1017525600 18000 1 +05}
    {1017525600 18000 1 +04}
    {1035669600 14400 0 +04}
    {1048975200 18000 1 +05}
    {1048975200 18000 1 +04}
    {1067119200 14400 0 +04}
    {1080424800 18000 1 +05}
    {1080424800 18000 1 +04}
    {1099173600 18000 0 +05}
}

Changes to library/tzdata/Asia/Pyongyang.

1
2
3
4
5
6
7
8

9
1
2
3
4
5
6
7
8
9
10








+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Pyongyang) {
    {-9223372036854775808 30180 0 LMT}
    {-1948782180 30600 0 KST}
    {-1830414600 32400 0 JST}
    {-768646800 32400 0 KST}
    {1439564400 30600 0 KST}
    {1525446000 32400 0 KST}
}

Changes to library/tzdata/Asia/Qyzylorda.

1
2
3
4
5
6
7
8
9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57
1
2
3
4
5
6
7
8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56
57









-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Qyzylorda) {
    {-9223372036854775808 15712 0 LMT}
    {-1441167712 14400 0 +04}
    {-1247544000 18000 0 +05}
    {354913200 21600 1 +06}
    {370720800 21600 0 +06}
    {386445600 18000 0 +05}
    {386449200 21600 1 +06}
    {386449200 21600 1 +05}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {417985200 21600 1 +05}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {449607600 21600 1 +05}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {481064400 21600 1 +05}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {512514000 21600 1 +05}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {543963600 21600 1 +05}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {575413200 21600 1 +05}
    {591138000 18000 0 +05}
    {606862800 21600 1 +06}
    {606862800 21600 1 +05}
    {622587600 18000 0 +05}
    {638312400 21600 1 +06}
    {638312400 21600 1 +05}
    {654642000 18000 0 +05}
    {670366800 14400 0 +04}
    {670370400 18000 1 +05}
    {670370400 18000 1 +04}
    {701812800 18000 0 +05}
    {701816400 21600 1 +06}
    {701816400 21600 1 +05}
    {717541200 18000 0 +05}
    {733266000 21600 1 +06}
    {733266000 21600 1 +05}
    {748990800 18000 0 +05}
    {764715600 21600 1 +06}
    {764715600 21600 1 +05}
    {780440400 18000 0 +05}
    {796165200 21600 1 +06}
    {796165200 21600 1 +05}
    {811890000 18000 0 +05}
    {828219600 21600 1 +06}
    {828219600 21600 1 +05}
    {846363600 18000 0 +05}
    {859669200 21600 1 +06}
    {859669200 21600 1 +05}
    {877813200 18000 0 +05}
    {891118800 21600 1 +06}
    {891118800 21600 1 +05}
    {909262800 18000 0 +05}
    {922568400 21600 1 +06}
    {922568400 21600 1 +05}
    {941317200 18000 0 +05}
    {954018000 21600 1 +06}
    {954018000 21600 1 +05}
    {972766800 18000 0 +05}
    {985467600 21600 1 +06}
    {985467600 21600 1 +05}
    {1004216400 18000 0 +05}
    {1017522000 21600 1 +06}
    {1017522000 21600 1 +05}
    {1035666000 18000 0 +05}
    {1048971600 21600 1 +06}
    {1048971600 21600 1 +05}
    {1067115600 18000 0 +05}
    {1080421200 21600 1 +06}
    {1080421200 21600 1 +05}
    {1099170000 21600 0 +06}
}

Changes to library/tzdata/Asia/Samarkand.

1
2
3
4
5
6
7
8
9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30
31
1
2
3
4
5
6
7
8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29
30
31









-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Samarkand) {
    {-9223372036854775808 16073 0 LMT}
    {-1441168073 14400 0 +04}
    {-1247544000 18000 0 +05}
    {354913200 21600 1 +06}
    {370720800 21600 0 +06}
    {386445600 18000 0 +05}
    {386449200 21600 1 +06}
    {386449200 21600 1 +05}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {417985200 21600 1 +05}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {449607600 21600 1 +05}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {481064400 21600 1 +05}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {512514000 21600 1 +05}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {543963600 21600 1 +05}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {575413200 21600 1 +05}
    {591138000 18000 0 +05}
    {606862800 21600 1 +06}
    {606862800 21600 1 +05}
    {622587600 18000 0 +05}
    {638312400 21600 1 +06}
    {638312400 21600 1 +05}
    {654642000 18000 0 +05}
    {670366800 21600 1 +06}
    {670366800 21600 1 +05}
    {686091600 18000 0 +05}
    {694206000 18000 0 +05}
}

Changes to library/tzdata/Asia/Shanghai.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22


























23
1
2
3
4
5

















6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Shanghai) {
    {-9223372036854775808 29143 0 LMT}
    {-2177481943 28800 0 CST}
    {-933494400 32400 1 CDT}
    {-923130000 28800 0 CST}
    {-908784000 32400 1 CDT}
    {-891594000 28800 0 CST}
    {-662716800 28800 0 CST}
    {515520000 32400 1 CDT}
    {527007600 28800 0 CST}
    {545155200 32400 1 CDT}
    {558457200 28800 0 CST}
    {576604800 32400 1 CDT}
    {589906800 28800 0 CST}
    {608659200 32400 1 CDT}
    {621961200 28800 0 CST}
    {640108800 32400 1 CDT}
    {653410800 28800 0 CST}
    {671558400 32400 1 CDT}
    {684860400 28800 0 CST}
    {-933667200 32400 1 CDT}
    {-922093200 28800 0 CST}
    {-908870400 32400 1 CDT}
    {-888829200 28800 0 CST}
    {-881049600 32400 1 CDT}
    {-767869200 28800 0 CST}
    {-745833600 32400 1 CDT}
    {-733827600 28800 0 CST}
    {-716889600 32400 1 CDT}
    {-699613200 28800 0 CST}
    {-683884800 32400 1 CDT}
    {-670669200 28800 0 CST}
    {-652348800 32400 1 CDT}
    {-650016000 28800 0 CST}
    {515527200 32400 1 CDT}
    {527014800 28800 0 CST}
    {545162400 32400 1 CDT}
    {558464400 28800 0 CST}
    {577216800 32400 1 CDT}
    {589914000 28800 0 CST}
    {608666400 32400 1 CDT}
    {621968400 28800 0 CST}
    {640116000 32400 1 CDT}
    {653418000 28800 0 CST}
    {671565600 32400 1 CDT}
    {684867600 28800 0 CST}
}

Changes to library/tzdata/Asia/Tashkent.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30
31
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26
27

28
29
30
31






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Tashkent) {
    {-9223372036854775808 16631 0 LMT}
    {-1441168631 18000 0 +05}
    {-1247547600 21600 0 +06}
    {354909600 25200 1 +07}
    {354909600 25200 1 +06}
    {370717200 21600 0 +06}
    {386445600 25200 1 +07}
    {386445600 25200 1 +06}
    {402253200 21600 0 +06}
    {417981600 25200 1 +07}
    {417981600 25200 1 +06}
    {433789200 21600 0 +06}
    {449604000 25200 1 +07}
    {449604000 25200 1 +06}
    {465336000 21600 0 +06}
    {481060800 25200 1 +07}
    {481060800 25200 1 +06}
    {496785600 21600 0 +06}
    {512510400 25200 1 +07}
    {512510400 25200 1 +06}
    {528235200 21600 0 +06}
    {543960000 25200 1 +07}
    {543960000 25200 1 +06}
    {559684800 21600 0 +06}
    {575409600 25200 1 +07}
    {575409600 25200 1 +06}
    {591134400 21600 0 +06}
    {606859200 25200 1 +07}
    {606859200 25200 1 +06}
    {622584000 21600 0 +06}
    {638308800 25200 1 +07}
    {638308800 25200 1 +06}
    {654638400 21600 0 +06}
    {670363200 18000 0 +05}
    {670366800 21600 1 +06}
    {670366800 21600 1 +05}
    {686091600 18000 0 +05}
    {694206000 18000 0 +05}
}

Changes to library/tzdata/Asia/Tbilisi.

1
2
3
4
5
6
7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28
29

30
31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56
57


58
59
60
1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55


56
57
58
59
60







-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+


-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
-
+
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Tbilisi) {
    {-9223372036854775808 10751 0 LMT}
    {-2840151551 10751 0 TBMT}
    {-1441162751 10800 0 +03}
    {-405140400 14400 0 +04}
    {354916800 18000 1 +05}
    {354916800 18000 1 +04}
    {370724400 14400 0 +04}
    {386452800 18000 1 +05}
    {386452800 18000 1 +04}
    {402260400 14400 0 +04}
    {417988800 18000 1 +05}
    {417988800 18000 1 +04}
    {433796400 14400 0 +04}
    {449611200 18000 1 +05}
    {449611200 18000 1 +04}
    {465343200 14400 0 +04}
    {481068000 18000 1 +05}
    {481068000 18000 1 +04}
    {496792800 14400 0 +04}
    {512517600 18000 1 +05}
    {512517600 18000 1 +04}
    {528242400 14400 0 +04}
    {543967200 18000 1 +05}
    {543967200 18000 1 +04}
    {559692000 14400 0 +04}
    {575416800 18000 1 +05}
    {575416800 18000 1 +04}
    {591141600 14400 0 +04}
    {606866400 18000 1 +05}
    {606866400 18000 1 +04}
    {622591200 14400 0 +04}
    {638316000 18000 1 +05}
    {638316000 18000 1 +04}
    {654645600 14400 0 +04}
    {670370400 10800 0 +03}
    {670374000 14400 1 +04}
    {670374000 14400 1 +03}
    {686098800 10800 0 +03}
    {694213200 10800 0 +03}
    {701816400 14400 1 +04}
    {701816400 14400 1 +03}
    {717537600 10800 0 +03}
    {733266000 14400 1 +04}
    {733266000 14400 1 +03}
    {748987200 10800 0 +03}
    {764715600 14400 1 +04}
    {764715600 14400 1 +03}
    {780440400 14400 0 +04}
    {796161600 18000 1 +05}
    {796161600 18000 1 +04}
    {811882800 14400 0 +04}
    {828216000 18000 1 +05}
    {828216000 18000 1 +04}
    {846360000 18000 1 +05}
    {859662000 18000 0 +05}
    {859662000 18000 0 +04}
    {877806000 14400 0 +04}
    {891115200 18000 1 +05}
    {891115200 18000 1 +04}
    {909255600 14400 0 +04}
    {922564800 18000 1 +05}
    {922564800 18000 1 +04}
    {941310000 14400 0 +04}
    {954014400 18000 1 +05}
    {954014400 18000 1 +04}
    {972759600 14400 0 +04}
    {985464000 18000 1 +05}
    {985464000 18000 1 +04}
    {1004209200 14400 0 +04}
    {1017518400 18000 1 +05}
    {1017518400 18000 1 +04}
    {1035658800 14400 0 +04}
    {1048968000 18000 1 +05}
    {1048968000 18000 1 +04}
    {1067108400 14400 0 +04}
    {1080417600 18000 1 +05}
    {1088280000 14400 0 +04}
    {1080417600 18000 1 +04}
    {1088280000 14400 0 +03}
    {1099177200 10800 0 +03}
    {1111878000 14400 0 +04}
}

Changes to library/tzdata/Asia/Tehran.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228






























































































































































































































229
1
2
3
4
5
6






























































































































































































































7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Tehran) {
    {-9223372036854775808 12344 0 LMT}
    {-1704165944 12344 0 TMT}
    {-757394744 12600 0 +0330}
    {247177800 14400 0 +05}
    {259272000 18000 1 +05}
    {277758000 14400 0 +05}
    {283982400 12600 0 +0430}
    {290809800 16200 1 +0430}
    {306531000 12600 0 +0430}
    {322432200 16200 1 +0430}
    {338499000 12600 0 +0430}
    {673216200 16200 1 +0430}
    {685481400 12600 0 +0430}
    {701209800 16200 1 +0430}
    {717103800 12600 0 +0430}
    {732745800 16200 1 +0430}
    {748639800 12600 0 +0430}
    {764281800 16200 1 +0430}
    {780175800 12600 0 +0430}
    {795817800 16200 1 +0430}
    {811711800 12600 0 +0430}
    {827353800 16200 1 +0430}
    {843247800 12600 0 +0430}
    {858976200 16200 1 +0430}
    {874870200 12600 0 +0430}
    {890512200 16200 1 +0430}
    {906406200 12600 0 +0430}
    {922048200 16200 1 +0430}
    {937942200 12600 0 +0430}
    {953584200 16200 1 +0430}
    {969478200 12600 0 +0430}
    {985206600 16200 1 +0430}
    {1001100600 12600 0 +0430}
    {1016742600 16200 1 +0430}
    {1032636600 12600 0 +0430}
    {1048278600 16200 1 +0430}
    {1064172600 12600 0 +0430}
    {1079814600 16200 1 +0430}
    {1095708600 12600 0 +0430}
    {1111437000 16200 1 +0430}
    {1127331000 12600 0 +0430}
    {1206045000 16200 1 +0430}
    {1221939000 12600 0 +0430}
    {1237667400 16200 1 +0430}
    {1253561400 12600 0 +0430}
    {1269203400 16200 1 +0430}
    {1285097400 12600 0 +0430}
    {1300739400 16200 1 +0430}
    {1316633400 12600 0 +0430}
    {1332275400 16200 1 +0430}
    {1348169400 12600 0 +0430}
    {1363897800 16200 1 +0430}
    {1379791800 12600 0 +0430}
    {1395433800 16200 1 +0430}
    {1411327800 12600 0 +0430}
    {1426969800 16200 1 +0430}
    {1442863800 12600 0 +0430}
    {1458505800 16200 1 +0430}
    {1474399800 12600 0 +0430}
    {1490128200 16200 1 +0430}
    {1506022200 12600 0 +0430}
    {1521664200 16200 1 +0430}
    {1537558200 12600 0 +0430}
    {1553200200 16200 1 +0430}
    {1569094200 12600 0 +0430}
    {1584736200 16200 1 +0430}
    {1600630200 12600 0 +0430}
    {1616358600 16200 1 +0430}
    {1632252600 12600 0 +0430}
    {1647894600 16200 1 +0430}
    {1663788600 12600 0 +0430}
    {1679430600 16200 1 +0430}
    {1695324600 12600 0 +0430}
    {1710966600 16200 1 +0430}
    {1726860600 12600 0 +0430}
    {1742589000 16200 1 +0430}
    {1758483000 12600 0 +0430}
    {1774125000 16200 1 +0430}
    {1790019000 12600 0 +0430}
    {1805661000 16200 1 +0430}
    {1821555000 12600 0 +0430}
    {1837197000 16200 1 +0430}
    {1853091000 12600 0 +0430}
    {1868733000 16200 1 +0430}
    {1884627000 12600 0 +0430}
    {1900355400 16200 1 +0430}
    {1916249400 12600 0 +0430}
    {1931891400 16200 1 +0430}
    {1947785400 12600 0 +0430}
    {1963427400 16200 1 +0430}
    {1979321400 12600 0 +0430}
    {1994963400 16200 1 +0430}
    {2010857400 12600 0 +0430}
    {2026585800 16200 1 +0430}
    {2042479800 12600 0 +0430}
    {2058121800 16200 1 +0430}
    {2074015800 12600 0 +0430}
    {2089657800 16200 1 +0430}
    {2105551800 12600 0 +0430}
    {2121193800 16200 1 +0430}
    {2137087800 12600 0 +0430}
    {2152729800 16200 1 +0430}
    {2168623800 12600 0 +0430}
    {2184265800 16200 1 +0430}
    {2200159800 12600 0 +0430}
    {2215888200 16200 1 +0430}
    {2231782200 12600 0 +0430}
    {2247424200 16200 1 +0430}
    {2263318200 12600 0 +0430}
    {2278960200 16200 1 +0430}
    {2294854200 12600 0 +0430}
    {2310496200 16200 1 +0430}
    {2326390200 12600 0 +0430}
    {2342118600 16200 1 +0430}
    {2358012600 12600 0 +0430}
    {2373654600 16200 1 +0430}
    {2389548600 12600 0 +0430}
    {2405190600 16200 1 +0430}
    {2421084600 12600 0 +0430}
    {2436726600 16200 1 +0430}
    {2452620600 12600 0 +0430}
    {2468349000 16200 1 +0430}
    {2484243000 12600 0 +0430}
    {2499885000 16200 1 +0430}
    {2515779000 12600 0 +0430}
    {2531421000 16200 1 +0430}
    {2547315000 12600 0 +0430}
    {2562957000 16200 1 +0430}
    {2578851000 12600 0 +0430}
    {2594579400 16200 1 +0430}
    {2610473400 12600 0 +0430}
    {2626115400 16200 1 +0430}
    {2642009400 12600 0 +0430}
    {2657651400 16200 1 +0430}
    {2673545400 12600 0 +0430}
    {2689187400 16200 1 +0430}
    {2705081400 12600 0 +0430}
    {2720809800 16200 1 +0430}
    {2736703800 12600 0 +0430}
    {2752345800 16200 1 +0430}
    {2768239800 12600 0 +0430}
    {2783881800 16200 1 +0430}
    {2799775800 12600 0 +0430}
    {2815417800 16200 1 +0430}
    {2831311800 12600 0 +0430}
    {2847040200 16200 1 +0430}
    {2862934200 12600 0 +0430}
    {2878576200 16200 1 +0430}
    {2894470200 12600 0 +0430}
    {2910112200 16200 1 +0430}
    {2926006200 12600 0 +0430}
    {2941648200 16200 1 +0430}
    {2957542200 12600 0 +0430}
    {2973270600 16200 1 +0430}
    {2989164600 12600 0 +0430}
    {3004806600 16200 1 +0430}
    {3020700600 12600 0 +0430}
    {3036342600 16200 1 +0430}
    {3052236600 12600 0 +0430}
    {3067878600 16200 1 +0430}
    {3083772600 12600 0 +0430}
    {3099501000 16200 1 +0430}
    {3115395000 12600 0 +0430}
    {3131037000 16200 1 +0430}
    {3146931000 12600 0 +0430}
    {3162573000 16200 1 +0430}
    {3178467000 12600 0 +0430}
    {3194109000 16200 1 +0430}
    {3210003000 12600 0 +0430}
    {3225731400 16200 1 +0430}
    {3241625400 12600 0 +0430}
    {3257267400 16200 1 +0430}
    {3273161400 12600 0 +0430}
    {3288803400 16200 1 +0430}
    {3304697400 12600 0 +0430}
    {3320339400 16200 1 +0430}
    {3336233400 12600 0 +0430}
    {3351961800 16200 1 +0430}
    {3367855800 12600 0 +0430}
    {3383497800 16200 1 +0430}
    {3399391800 12600 0 +0430}
    {3415033800 16200 1 +0430}
    {3430927800 12600 0 +0430}
    {3446569800 16200 1 +0430}
    {3462463800 12600 0 +0430}
    {3478192200 16200 1 +0430}
    {3494086200 12600 0 +0430}
    {3509728200 16200 1 +0430}
    {3525622200 12600 0 +0430}
    {3541264200 16200 1 +0430}
    {3557158200 12600 0 +0430}
    {3572800200 16200 1 +0430}
    {3588694200 12600 0 +0430}
    {3604422600 16200 1 +0430}
    {3620316600 12600 0 +0430}
    {3635958600 16200 1 +0430}
    {3651852600 12600 0 +0430}
    {3667494600 16200 1 +0430}
    {3683388600 12600 0 +0430}
    {3699030600 16200 1 +0430}
    {3714924600 12600 0 +0430}
    {3730653000 16200 1 +0430}
    {3746547000 12600 0 +0430}
    {3762189000 16200 1 +0430}
    {3778083000 12600 0 +0430}
    {3793725000 16200 1 +0430}
    {3809619000 12600 0 +0430}
    {3825261000 16200 1 +0430}
    {3841155000 12600 0 +0430}
    {3856883400 16200 1 +0430}
    {3872777400 12600 0 +0430}
    {3888419400 16200 1 +0430}
    {3904313400 12600 0 +0430}
    {3919955400 16200 1 +0430}
    {3935849400 12600 0 +0430}
    {3951491400 16200 1 +0430}
    {3967385400 12600 0 +0430}
    {3983113800 16200 1 +0430}
    {3999007800 12600 0 +0430}
    {4014649800 16200 1 +0430}
    {4030543800 12600 0 +0430}
    {4046185800 16200 1 +0430}
    {4062079800 12600 0 +0430}
    {4077721800 16200 1 +0430}
    {4093615800 12600 0 +0430}
    {247177800 14400 0 +04}
    {259272000 18000 1 +04}
    {277758000 14400 0 +04}
    {283982400 12600 0 +0330}
    {290809800 16200 1 +0330}
    {306531000 12600 0 +0330}
    {322432200 16200 1 +0330}
    {338499000 12600 0 +0330}
    {673216200 16200 1 +0330}
    {685481400 12600 0 +0330}
    {701209800 16200 1 +0330}
    {717103800 12600 0 +0330}
    {732745800 16200 1 +0330}
    {748639800 12600 0 +0330}
    {764281800 16200 1 +0330}
    {780175800 12600 0 +0330}
    {795817800 16200 1 +0330}
    {811711800 12600 0 +0330}
    {827353800 16200 1 +0330}
    {843247800 12600 0 +0330}
    {858976200 16200 1 +0330}
    {874870200 12600 0 +0330}
    {890512200 16200 1 +0330}
    {906406200 12600 0 +0330}
    {922048200 16200 1 +0330}
    {937942200 12600 0 +0330}
    {953584200 16200 1 +0330}
    {969478200 12600 0 +0330}
    {985206600 16200 1 +0330}
    {1001100600 12600 0 +0330}
    {1016742600 16200 1 +0330}
    {1032636600 12600 0 +0330}
    {1048278600 16200 1 +0330}
    {1064172600 12600 0 +0330}
    {1079814600 16200 1 +0330}
    {1095708600 12600 0 +0330}
    {1111437000 16200 1 +0330}
    {1127331000 12600 0 +0330}
    {1206045000 16200 1 +0330}
    {1221939000 12600 0 +0330}
    {1237667400 16200 1 +0330}
    {1253561400 12600 0 +0330}
    {1269203400 16200 1 +0330}
    {1285097400 12600 0 +0330}
    {1300739400 16200 1 +0330}
    {1316633400 12600 0 +0330}
    {1332275400 16200 1 +0330}
    {1348169400 12600 0 +0330}
    {1363897800 16200 1 +0330}
    {1379791800 12600 0 +0330}
    {1395433800 16200 1 +0330}
    {1411327800 12600 0 +0330}
    {1426969800 16200 1 +0330}
    {1442863800 12600 0 +0330}
    {1458505800 16200 1 +0330}
    {1474399800 12600 0 +0330}
    {1490128200 16200 1 +0330}
    {1506022200 12600 0 +0330}
    {1521664200 16200 1 +0330}
    {1537558200 12600 0 +0330}
    {1553200200 16200 1 +0330}
    {1569094200 12600 0 +0330}
    {1584736200 16200 1 +0330}
    {1600630200 12600 0 +0330}
    {1616358600 16200 1 +0330}
    {1632252600 12600 0 +0330}
    {1647894600 16200 1 +0330}
    {1663788600 12600 0 +0330}
    {1679430600 16200 1 +0330}
    {1695324600 12600 0 +0330}
    {1710966600 16200 1 +0330}
    {1726860600 12600 0 +0330}
    {1742589000 16200 1 +0330}
    {1758483000 12600 0 +0330}
    {1774125000 16200 1 +0330}
    {1790019000 12600 0 +0330}
    {1805661000 16200 1 +0330}
    {1821555000 12600 0 +0330}
    {1837197000 16200 1 +0330}
    {1853091000 12600 0 +0330}
    {1868733000 16200 1 +0330}
    {1884627000 12600 0 +0330}
    {1900355400 16200 1 +0330}
    {1916249400 12600 0 +0330}
    {1931891400 16200 1 +0330}
    {1947785400 12600 0 +0330}
    {1963427400 16200 1 +0330}
    {1979321400 12600 0 +0330}
    {1994963400 16200 1 +0330}
    {2010857400 12600 0 +0330}
    {2026585800 16200 1 +0330}
    {2042479800 12600 0 +0330}
    {2058121800 16200 1 +0330}
    {2074015800 12600 0 +0330}
    {2089657800 16200 1 +0330}
    {2105551800 12600 0 +0330}
    {2121193800 16200 1 +0330}
    {2137087800 12600 0 +0330}
    {2152729800 16200 1 +0330}
    {2168623800 12600 0 +0330}
    {2184265800 16200 1 +0330}
    {2200159800 12600 0 +0330}
    {2215888200 16200 1 +0330}
    {2231782200 12600 0 +0330}
    {2247424200 16200 1 +0330}
    {2263318200 12600 0 +0330}
    {2278960200 16200 1 +0330}
    {2294854200 12600 0 +0330}
    {2310496200 16200 1 +0330}
    {2326390200 12600 0 +0330}
    {2342118600 16200 1 +0330}
    {2358012600 12600 0 +0330}
    {2373654600 16200 1 +0330}
    {2389548600 12600 0 +0330}
    {2405190600 16200 1 +0330}
    {2421084600 12600 0 +0330}
    {2436726600 16200 1 +0330}
    {2452620600 12600 0 +0330}
    {2468349000 16200 1 +0330}
    {2484243000 12600 0 +0330}
    {2499885000 16200 1 +0330}
    {2515779000 12600 0 +0330}
    {2531421000 16200 1 +0330}
    {2547315000 12600 0 +0330}
    {2562957000 16200 1 +0330}
    {2578851000 12600 0 +0330}
    {2594579400 16200 1 +0330}
    {2610473400 12600 0 +0330}
    {2626115400 16200 1 +0330}
    {2642009400 12600 0 +0330}
    {2657651400 16200 1 +0330}
    {2673545400 12600 0 +0330}
    {2689187400 16200 1 +0330}
    {2705081400 12600 0 +0330}
    {2720809800 16200 1 +0330}
    {2736703800 12600 0 +0330}
    {2752345800 16200 1 +0330}
    {2768239800 12600 0 +0330}
    {2783881800 16200 1 +0330}
    {2799775800 12600 0 +0330}
    {2815417800 16200 1 +0330}
    {2831311800 12600 0 +0330}
    {2847040200 16200 1 +0330}
    {2862934200 12600 0 +0330}
    {2878576200 16200 1 +0330}
    {2894470200 12600 0 +0330}
    {2910112200 16200 1 +0330}
    {2926006200 12600 0 +0330}
    {2941648200 16200 1 +0330}
    {2957542200 12600 0 +0330}
    {2973270600 16200 1 +0330}
    {2989164600 12600 0 +0330}
    {3004806600 16200 1 +0330}
    {3020700600 12600 0 +0330}
    {3036342600 16200 1 +0330}
    {3052236600 12600 0 +0330}
    {3067878600 16200 1 +0330}
    {3083772600 12600 0 +0330}
    {3099501000 16200 1 +0330}
    {3115395000 12600 0 +0330}
    {3131037000 16200 1 +0330}
    {3146931000 12600 0 +0330}
    {3162573000 16200 1 +0330}
    {3178467000 12600 0 +0330}
    {3194109000 16200 1 +0330}
    {3210003000 12600 0 +0330}
    {3225731400 16200 1 +0330}
    {3241625400 12600 0 +0330}
    {3257267400 16200 1 +0330}
    {3273161400 12600 0 +0330}
    {3288803400 16200 1 +0330}
    {3304697400 12600 0 +0330}
    {3320339400 16200 1 +0330}
    {3336233400 12600 0 +0330}
    {3351961800 16200 1 +0330}
    {3367855800 12600 0 +0330}
    {3383497800 16200 1 +0330}
    {3399391800 12600 0 +0330}
    {3415033800 16200 1 +0330}
    {3430927800 12600 0 +0330}
    {3446569800 16200 1 +0330}
    {3462463800 12600 0 +0330}
    {3478192200 16200 1 +0330}
    {3494086200 12600 0 +0330}
    {3509728200 16200 1 +0330}
    {3525622200 12600 0 +0330}
    {3541264200 16200 1 +0330}
    {3557158200 12600 0 +0330}
    {3572800200 16200 1 +0330}
    {3588694200 12600 0 +0330}
    {3604422600 16200 1 +0330}
    {3620316600 12600 0 +0330}
    {3635958600 16200 1 +0330}
    {3651852600 12600 0 +0330}
    {3667494600 16200 1 +0330}
    {3683388600 12600 0 +0330}
    {3699030600 16200 1 +0330}
    {3714924600 12600 0 +0330}
    {3730653000 16200 1 +0330}
    {3746547000 12600 0 +0330}
    {3762189000 16200 1 +0330}
    {3778083000 12600 0 +0330}
    {3793725000 16200 1 +0330}
    {3809619000 12600 0 +0330}
    {3825261000 16200 1 +0330}
    {3841155000 12600 0 +0330}
    {3856883400 16200 1 +0330}
    {3872777400 12600 0 +0330}
    {3888419400 16200 1 +0330}
    {3904313400 12600 0 +0330}
    {3919955400 16200 1 +0330}
    {3935849400 12600 0 +0330}
    {3951491400 16200 1 +0330}
    {3967385400 12600 0 +0330}
    {3983113800 16200 1 +0330}
    {3999007800 12600 0 +0330}
    {4014649800 16200 1 +0330}
    {4030543800 12600 0 +0330}
    {4046185800 16200 1 +0330}
    {4062079800 12600 0 +0330}
    {4077721800 16200 1 +0330}
    {4093615800 12600 0 +0330}
}

Changes to library/tzdata/Asia/Tokyo.

1
2
3
4
5
6
7
8
9
10
11
12
13








14
1
2
3
4
5








6
7
8
9
10
11
12
13
14





-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Tokyo) {
    {-9223372036854775808 33539 0 LMT}
    {-2587712400 32400 0 JST}
    {-683794800 36000 1 JDT}
    {-672393600 32400 0 JST}
    {-654764400 36000 1 JDT}
    {-640944000 32400 0 JST}
    {-620290800 36000 1 JDT}
    {-609494400 32400 0 JST}
    {-588841200 36000 1 JDT}
    {-578044800 32400 0 JST}
    {-683802000 36000 1 JDT}
    {-672310800 32400 0 JST}
    {-654771600 36000 1 JDT}
    {-640861200 32400 0 JST}
    {-620298000 36000 1 JDT}
    {-609411600 32400 0 JST}
    {-588848400 36000 1 JDT}
    {-577962000 32400 0 JST}
}

Changes to library/tzdata/Asia/Ulaanbaatar.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54
55






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Ulaanbaatar) {
    {-9223372036854775808 25652 0 LMT}
    {-2032931252 25200 0 +07}
    {252435600 28800 0 +08}
    {417974400 32400 1 +09}
    {417974400 32400 1 +08}
    {433782000 28800 0 +08}
    {449596800 32400 1 +09}
    {449596800 32400 1 +08}
    {465318000 28800 0 +08}
    {481046400 32400 1 +09}
    {481046400 32400 1 +08}
    {496767600 28800 0 +08}
    {512496000 32400 1 +09}
    {512496000 32400 1 +08}
    {528217200 28800 0 +08}
    {543945600 32400 1 +09}
    {543945600 32400 1 +08}
    {559666800 28800 0 +08}
    {575395200 32400 1 +09}
    {575395200 32400 1 +08}
    {591116400 28800 0 +08}
    {606844800 32400 1 +09}
    {606844800 32400 1 +08}
    {622566000 28800 0 +08}
    {638294400 32400 1 +09}
    {638294400 32400 1 +08}
    {654620400 28800 0 +08}
    {670348800 32400 1 +09}
    {670348800 32400 1 +08}
    {686070000 28800 0 +08}
    {701798400 32400 1 +09}
    {701798400 32400 1 +08}
    {717519600 28800 0 +08}
    {733248000 32400 1 +09}
    {733248000 32400 1 +08}
    {748969200 28800 0 +08}
    {764697600 32400 1 +09}
    {764697600 32400 1 +08}
    {780418800 28800 0 +08}
    {796147200 32400 1 +09}
    {796147200 32400 1 +08}
    {811868400 28800 0 +08}
    {828201600 32400 1 +09}
    {828201600 32400 1 +08}
    {843922800 28800 0 +08}
    {859651200 32400 1 +09}
    {859651200 32400 1 +08}
    {875372400 28800 0 +08}
    {891100800 32400 1 +09}
    {891100800 32400 1 +08}
    {906822000 28800 0 +08}
    {988394400 32400 1 +09}
    {988394400 32400 1 +08}
    {1001696400 28800 0 +08}
    {1017424800 32400 1 +09}
    {1017424800 32400 1 +08}
    {1033146000 28800 0 +08}
    {1048874400 32400 1 +09}
    {1048874400 32400 1 +08}
    {1064595600 28800 0 +08}
    {1080324000 32400 1 +09}
    {1080324000 32400 1 +08}
    {1096045200 28800 0 +08}
    {1111773600 32400 1 +09}
    {1111773600 32400 1 +08}
    {1127494800 28800 0 +08}
    {1143223200 32400 1 +09}
    {1143223200 32400 1 +08}
    {1159549200 28800 0 +08}
    {1427479200 32400 1 +09}
    {1427479200 32400 1 +08}
    {1443193200 28800 0 +08}
    {1458928800 32400 1 +09}
    {1458928800 32400 1 +08}
    {1474642800 28800 0 +08}
}

Changes to library/tzdata/Asia/Yerevan.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27
28

29
30

31
32

33
34

35
36

37
38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67
68

69
70
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26
27

28
29

30
31

32
33

34
35

36
37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66
67

68
69
70






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Yerevan) {
    {-9223372036854775808 10680 0 LMT}
    {-1441162680 10800 0 +03}
    {-405140400 14400 0 +04}
    {354916800 18000 1 +05}
    {354916800 18000 1 +04}
    {370724400 14400 0 +04}
    {386452800 18000 1 +05}
    {386452800 18000 1 +04}
    {402260400 14400 0 +04}
    {417988800 18000 1 +05}
    {417988800 18000 1 +04}
    {433796400 14400 0 +04}
    {449611200 18000 1 +05}
    {449611200 18000 1 +04}
    {465343200 14400 0 +04}
    {481068000 18000 1 +05}
    {481068000 18000 1 +04}
    {496792800 14400 0 +04}
    {512517600 18000 1 +05}
    {512517600 18000 1 +04}
    {528242400 14400 0 +04}
    {543967200 18000 1 +05}
    {543967200 18000 1 +04}
    {559692000 14400 0 +04}
    {575416800 18000 1 +05}
    {575416800 18000 1 +04}
    {591141600 14400 0 +04}
    {606866400 18000 1 +05}
    {606866400 18000 1 +04}
    {622591200 14400 0 +04}
    {638316000 18000 1 +05}
    {638316000 18000 1 +04}
    {654645600 14400 0 +04}
    {670370400 10800 0 +03}
    {670374000 14400 1 +04}
    {670374000 14400 1 +03}
    {686098800 10800 0 +03}
    {701823600 14400 1 +04}
    {701823600 14400 1 +03}
    {717548400 10800 0 +03}
    {733273200 14400 1 +04}
    {733273200 14400 1 +03}
    {748998000 10800 0 +03}
    {764722800 14400 1 +04}
    {764722800 14400 1 +03}
    {780447600 10800 0 +03}
    {796172400 14400 1 +04}
    {796172400 14400 1 +03}
    {811897200 14400 0 +04}
    {852062400 14400 0 +04}
    {859672800 18000 1 +05}
    {859672800 18000 1 +04}
    {877816800 14400 0 +04}
    {891122400 18000 1 +05}
    {891122400 18000 1 +04}
    {909266400 14400 0 +04}
    {922572000 18000 1 +05}
    {922572000 18000 1 +04}
    {941320800 14400 0 +04}
    {954021600 18000 1 +05}
    {954021600 18000 1 +04}
    {972770400 14400 0 +04}
    {985471200 18000 1 +05}
    {985471200 18000 1 +04}
    {1004220000 14400 0 +04}
    {1017525600 18000 1 +05}
    {1017525600 18000 1 +04}
    {1035669600 14400 0 +04}
    {1048975200 18000 1 +05}
    {1048975200 18000 1 +04}
    {1067119200 14400 0 +04}
    {1080424800 18000 1 +05}
    {1080424800 18000 1 +04}
    {1099173600 14400 0 +04}
    {1111874400 18000 1 +05}
    {1111874400 18000 1 +04}
    {1130623200 14400 0 +04}
    {1143324000 18000 1 +05}
    {1143324000 18000 1 +04}
    {1162072800 14400 0 +04}
    {1174773600 18000 1 +05}
    {1174773600 18000 1 +04}
    {1193522400 14400 0 +04}
    {1206828000 18000 1 +05}
    {1206828000 18000 1 +04}
    {1224972000 14400 0 +04}
    {1238277600 18000 1 +05}
    {1238277600 18000 1 +04}
    {1256421600 14400 0 +04}
    {1269727200 18000 1 +05}
    {1269727200 18000 1 +04}
    {1288476000 14400 0 +04}
    {1293825600 14400 0 +04}
    {1301176800 18000 1 +05}
    {1301176800 18000 1 +04}
    {1319925600 14400 0 +04}
}

Changes to library/tzdata/Atlantic/Azores.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Atlantic/Azores) {
    {-9223372036854775808 -6160 0 LMT}
    {-2713904240 -6872 0 HMT}
    {-1830377128 -7200 0 -02}
    {-1830376800 -7200 0 -02}
    {-1689548400 -3600 1 -01}
    {-1677794400 -7200 0 -02}
    {-1667430000 -3600 1 -01}
    {-1647730800 -7200 0 -02}
    {-1635807600 -3600 1 -01}
    {-1616194800 -7200 0 -02}
    {-1604358000 -3600 1 -01}

Changes to library/tzdata/Atlantic/Cape_Verde.

1
2
3
4
5

6
7
8
9
1
2
3
4

5
6
7
8
9




-
+




# created by tools/tclZIC.tcl - do not edit

set TZData(:Atlantic/Cape_Verde) {
    {-9223372036854775808 -5644 0 LMT}
    {-1988144756 -7200 0 -02}
    {-1830376800 -7200 0 -02}
    {-862610400 -3600 1 -01}
    {-764118000 -7200 0 -02}
    {186120000 -3600 0 -01}
}

Changes to library/tzdata/Atlantic/Madeira.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Atlantic/Madeira) {
    {-9223372036854775808 -4056 0 LMT}
    {-2713906344 -4056 0 FMT}
    {-1830379944 -3600 0 -01}
    {-1830380400 -3600 0 -01}
    {-1689552000 0 1 +00}
    {-1677798000 -3600 0 -01}
    {-1667433600 0 1 +00}
    {-1647734400 -3600 0 -01}
    {-1635811200 0 1 +00}
    {-1616198400 -3600 0 -01}
    {-1604361600 0 1 +00}

Changes to library/tzdata/Atlantic/Reykjavik.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66

67
68

69
70

71
72
73
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67

68
69

70
71
72
73





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:Atlantic/Reykjavik) {
    {-9223372036854775808 -5280 0 LMT}
    {-1956609120 -3600 0 -01}
    {-1668211200 0 1 +00}
    {-1668211200 0 1 -01}
    {-1647212400 -3600 0 -01}
    {-1636675200 0 1 +00}
    {-1636675200 0 1 -01}
    {-1613430000 -3600 0 -01}
    {-1605139200 0 1 +00}
    {-1605139200 0 1 -01}
    {-1581894000 -3600 0 -01}
    {-1539561600 0 1 +00}
    {-1539561600 0 1 -01}
    {-1531350000 -3600 0 -01}
    {-968025600 0 1 +00}
    {-968025600 0 1 -01}
    {-952293600 -3600 0 -01}
    {-942008400 0 1 +00}
    {-942008400 0 1 -01}
    {-920239200 -3600 0 -01}
    {-909957600 0 1 +00}
    {-909957600 0 1 -01}
    {-888789600 -3600 0 -01}
    {-877903200 0 1 +00}
    {-877903200 0 1 -01}
    {-857944800 -3600 0 -01}
    {-846453600 0 1 +00}
    {-846453600 0 1 -01}
    {-826495200 -3600 0 -01}
    {-815004000 0 1 +00}
    {-815004000 0 1 -01}
    {-795045600 -3600 0 -01}
    {-783554400 0 1 +00}
    {-783554400 0 1 -01}
    {-762991200 -3600 0 -01}
    {-752104800 0 1 +00}
    {-752104800 0 1 -01}
    {-731541600 -3600 0 -01}
    {-717631200 0 1 +00}
    {-717631200 0 1 -01}
    {-700092000 -3600 0 -01}
    {-686181600 0 1 +00}
    {-686181600 0 1 -01}
    {-668642400 -3600 0 -01}
    {-654732000 0 1 +00}
    {-654732000 0 1 -01}
    {-636588000 -3600 0 -01}
    {-623282400 0 1 +00}
    {-623282400 0 1 -01}
    {-605743200 -3600 0 -01}
    {-591832800 0 1 +00}
    {-591832800 0 1 -01}
    {-573688800 -3600 0 -01}
    {-559778400 0 1 +00}
    {-559778400 0 1 -01}
    {-542239200 -3600 0 -01}
    {-528328800 0 1 +00}
    {-528328800 0 1 -01}
    {-510789600 -3600 0 -01}
    {-496879200 0 1 +00}
    {-496879200 0 1 -01}
    {-479340000 -3600 0 -01}
    {-465429600 0 1 +00}
    {-465429600 0 1 -01}
    {-447890400 -3600 0 -01}
    {-433980000 0 1 +00}
    {-433980000 0 1 -01}
    {-415836000 -3600 0 -01}
    {-401925600 0 1 +00}
    {-401925600 0 1 -01}
    {-384386400 -3600 0 -01}
    {-370476000 0 1 +00}
    {-370476000 0 1 -01}
    {-352936800 -3600 0 -01}
    {-339026400 0 1 +00}
    {-339026400 0 1 -01}
    {-321487200 -3600 0 -01}
    {-307576800 0 1 +00}
    {-307576800 0 1 -01}
    {-290037600 -3600 0 -01}
    {-276127200 0 1 +00}
    {-276127200 0 1 -01}
    {-258588000 -3600 0 -01}
    {-244677600 0 1 +00}
    {-244677600 0 1 -01}
    {-226533600 -3600 0 -01}
    {-212623200 0 1 +00}
    {-212623200 0 1 -01}
    {-195084000 -3600 0 -01}
    {-181173600 0 1 +00}
    {-181173600 0 1 -01}
    {-163634400 -3600 0 -01}
    {-149724000 0 1 +00}
    {-149724000 0 1 -01}
    {-132184800 -3600 0 -01}
    {-118274400 0 1 +00}
    {-118274400 0 1 -01}
    {-100735200 -3600 0 -01}
    {-86824800 0 1 +00}
    {-86824800 0 1 -01}
    {-68680800 -3600 0 -01}
    {-54770400 0 0 GMT}
}

Changes to library/tzdata/Atlantic/Stanley.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66

67
68

69
70

71
72

73
74
75
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67

68
69

70
71

72
73
74
75






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:Atlantic/Stanley) {
    {-9223372036854775808 -13884 0 LMT}
    {-2524507716 -13884 0 SMT}
    {-1824235716 -14400 0 -04}
    {-1018209600 -10800 1 -03}
    {-1018209600 -10800 1 -04}
    {-1003093200 -14400 0 -04}
    {-986760000 -10800 1 -03}
    {-986760000 -10800 1 -04}
    {-971643600 -14400 0 -04}
    {-954705600 -10800 1 -03}
    {-954705600 -10800 1 -04}
    {-939589200 -14400 0 -04}
    {-923256000 -10800 1 -03}
    {-923256000 -10800 1 -04}
    {-908139600 -14400 0 -04}
    {-891806400 -10800 1 -03}
    {-891806400 -10800 1 -04}
    {-876690000 -14400 0 -04}
    {-860356800 -10800 1 -03}
    {-860356800 -10800 1 -04}
    {420606000 -7200 0 -03}
    {433303200 -7200 1 -02}
    {433303200 -7200 1 -03}
    {452052000 -10800 0 -03}
    {464151600 -7200 1 -02}
    {464151600 -7200 1 -03}
    {483501600 -10800 0 -03}
    {495597600 -14400 0 -04}
    {495604800 -10800 1 -03}
    {495604800 -10800 1 -04}
    {514350000 -14400 0 -04}
    {527054400 -10800 1 -03}
    {527054400 -10800 1 -04}
    {545799600 -14400 0 -04}
    {558504000 -10800 1 -03}
    {558504000 -10800 1 -04}
    {577249200 -14400 0 -04}
    {589953600 -10800 1 -03}
    {589953600 -10800 1 -04}
    {608698800 -14400 0 -04}
    {621403200 -10800 1 -03}
    {621403200 -10800 1 -04}
    {640753200 -14400 0 -04}
    {652852800 -10800 1 -03}
    {652852800 -10800 1 -04}
    {672202800 -14400 0 -04}
    {684907200 -10800 1 -03}
    {684907200 -10800 1 -04}
    {703652400 -14400 0 -04}
    {716356800 -10800 1 -03}
    {716356800 -10800 1 -04}
    {735102000 -14400 0 -04}
    {747806400 -10800 1 -03}
    {747806400 -10800 1 -04}
    {766551600 -14400 0 -04}
    {779256000 -10800 1 -03}
    {779256000 -10800 1 -04}
    {798001200 -14400 0 -04}
    {810705600 -10800 1 -03}
    {810705600 -10800 1 -04}
    {830055600 -14400 0 -04}
    {842760000 -10800 1 -03}
    {842760000 -10800 1 -04}
    {861505200 -14400 0 -04}
    {874209600 -10800 1 -03}
    {874209600 -10800 1 -04}
    {892954800 -14400 0 -04}
    {905659200 -10800 1 -03}
    {905659200 -10800 1 -04}
    {924404400 -14400 0 -04}
    {937108800 -10800 1 -03}
    {937108800 -10800 1 -04}
    {955854000 -14400 0 -04}
    {968558400 -10800 1 -03}
    {968558400 -10800 1 -04}
    {987310800 -14400 0 -04}
    {999410400 -10800 1 -03}
    {999410400 -10800 1 -04}
    {1019365200 -14400 0 -04}
    {1030860000 -10800 1 -03}
    {1030860000 -10800 1 -04}
    {1050814800 -14400 0 -04}
    {1062914400 -10800 1 -03}
    {1062914400 -10800 1 -04}
    {1082264400 -14400 0 -04}
    {1094364000 -10800 1 -03}
    {1094364000 -10800 1 -04}
    {1113714000 -14400 0 -04}
    {1125813600 -10800 1 -03}
    {1125813600 -10800 1 -04}
    {1145163600 -14400 0 -04}
    {1157263200 -10800 1 -03}
    {1157263200 -10800 1 -04}
    {1176613200 -14400 0 -04}
    {1188712800 -10800 1 -03}
    {1188712800 -10800 1 -04}
    {1208667600 -14400 0 -04}
    {1220767200 -10800 1 -03}
    {1220767200 -10800 1 -04}
    {1240117200 -14400 0 -04}
    {1252216800 -10800 1 -03}
    {1252216800 -10800 1 -04}
    {1271566800 -14400 0 -04}
    {1283662800 -10800 0 -03}
}

Changes to library/tzdata/Australia/Lord_Howe.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244















































































































































































































































245
1
2
3
4
5















































































































































































































































6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Australia/Lord_Howe) {
    {-9223372036854775808 38180 0 LMT}
    {-2364114980 36000 0 AEST}
    {352216800 37800 0 +1130}
    {372785400 41400 1 +1130}
    {384273000 37800 0 +1130}
    {404839800 41400 1 +1130}
    {415722600 37800 0 +1130}
    {436289400 41400 1 +1130}
    {447172200 37800 0 +1130}
    {467739000 41400 1 +1130}
    {478621800 37800 0 +1130}
    {488984400 37800 0 +11}
    {499188600 39600 1 +11}
    {511282800 37800 0 +11}
    {530033400 39600 1 +11}
    {542732400 37800 0 +11}
    {562087800 39600 1 +11}
    {574786800 37800 0 +11}
    {594142200 39600 1 +11}
    {606236400 37800 0 +11}
    {625591800 39600 1 +11}
    {636476400 37800 0 +11}
    {657041400 39600 1 +11}
    {667926000 37800 0 +11}
    {688491000 39600 1 +11}
    {699375600 37800 0 +11}
    {719940600 39600 1 +11}
    {731430000 37800 0 +11}
    {751995000 39600 1 +11}
    {762879600 37800 0 +11}
    {783444600 39600 1 +11}
    {794329200 37800 0 +11}
    {814894200 39600 1 +11}
    {828198000 37800 0 +11}
    {846343800 39600 1 +11}
    {859647600 37800 0 +11}
    {877793400 39600 1 +11}
    {891097200 37800 0 +11}
    {909243000 39600 1 +11}
    {922546800 37800 0 +11}
    {941297400 39600 1 +11}
    {953996400 37800 0 +11}
    {967303800 39600 1 +11}
    {985446000 37800 0 +11}
    {1004196600 39600 1 +11}
    {1017500400 37800 0 +11}
    {1035646200 39600 1 +11}
    {1048950000 37800 0 +11}
    {1067095800 39600 1 +11}
    {1080399600 37800 0 +11}
    {1099150200 39600 1 +11}
    {1111849200 37800 0 +11}
    {1130599800 39600 1 +11}
    {1143903600 37800 0 +11}
    {1162049400 39600 1 +11}
    {1174748400 37800 0 +11}
    {1193499000 39600 1 +11}
    {1207407600 37800 0 +11}
    {1223134200 39600 1 +11}
    {1238857200 37800 0 +11}
    {1254583800 39600 1 +11}
    {1270306800 37800 0 +11}
    {1286033400 39600 1 +11}
    {1301756400 37800 0 +11}
    {1317483000 39600 1 +11}
    {1333206000 37800 0 +11}
    {1349537400 39600 1 +11}
    {1365260400 37800 0 +11}
    {1380987000 39600 1 +11}
    {1396710000 37800 0 +11}
    {1412436600 39600 1 +11}
    {1428159600 37800 0 +11}
    {1443886200 39600 1 +11}
    {1459609200 37800 0 +11}
    {1475335800 39600 1 +11}
    {1491058800 37800 0 +11}
    {1506785400 39600 1 +11}
    {1522508400 37800 0 +11}
    {1538839800 39600 1 +11}
    {1554562800 37800 0 +11}
    {1570289400 39600 1 +11}
    {1586012400 37800 0 +11}
    {1601739000 39600 1 +11}
    {1617462000 37800 0 +11}
    {1633188600 39600 1 +11}
    {1648911600 37800 0 +11}
    {1664638200 39600 1 +11}
    {1680361200 37800 0 +11}
    {1696087800 39600 1 +11}
    {1712415600 37800 0 +11}
    {1728142200 39600 1 +11}
    {1743865200 37800 0 +11}
    {1759591800 39600 1 +11}
    {1775314800 37800 0 +11}
    {1791041400 39600 1 +11}
    {1806764400 37800 0 +11}
    {1822491000 39600 1 +11}
    {1838214000 37800 0 +11}
    {1853940600 39600 1 +11}
    {1869663600 37800 0 +11}
    {1885995000 39600 1 +11}
    {1901718000 37800 0 +11}
    {1917444600 39600 1 +11}
    {1933167600 37800 0 +11}
    {1948894200 39600 1 +11}
    {1964617200 37800 0 +11}
    {1980343800 39600 1 +11}
    {1996066800 37800 0 +11}
    {2011793400 39600 1 +11}
    {2027516400 37800 0 +11}
    {2043243000 39600 1 +11}
    {2058966000 37800 0 +11}
    {2075297400 39600 1 +11}
    {2091020400 37800 0 +11}
    {2106747000 39600 1 +11}
    {2122470000 37800 0 +11}
    {2138196600 39600 1 +11}
    {2153919600 37800 0 +11}
    {2169646200 39600 1 +11}
    {2185369200 37800 0 +11}
    {2201095800 39600 1 +11}
    {2216818800 37800 0 +11}
    {2233150200 39600 1 +11}
    {2248873200 37800 0 +11}
    {2264599800 39600 1 +11}
    {2280322800 37800 0 +11}
    {2296049400 39600 1 +11}
    {2311772400 37800 0 +11}
    {2327499000 39600 1 +11}
    {2343222000 37800 0 +11}
    {2358948600 39600 1 +11}
    {2374671600 37800 0 +11}
    {2390398200 39600 1 +11}
    {2406121200 37800 0 +11}
    {2422452600 39600 1 +11}
    {2438175600 37800 0 +11}
    {2453902200 39600 1 +11}
    {2469625200 37800 0 +11}
    {2485351800 39600 1 +11}
    {2501074800 37800 0 +11}
    {2516801400 39600 1 +11}
    {2532524400 37800 0 +11}
    {2548251000 39600 1 +11}
    {2563974000 37800 0 +11}
    {2579700600 39600 1 +11}
    {2596028400 37800 0 +11}
    {2611755000 39600 1 +11}
    {2627478000 37800 0 +11}
    {2643204600 39600 1 +11}
    {2658927600 37800 0 +11}
    {2674654200 39600 1 +11}
    {2690377200 37800 0 +11}
    {2706103800 39600 1 +11}
    {2721826800 37800 0 +11}
    {2737553400 39600 1 +11}
    {2753276400 37800 0 +11}
    {2769607800 39600 1 +11}
    {2785330800 37800 0 +11}
    {2801057400 39600 1 +11}
    {2816780400 37800 0 +11}
    {2832507000 39600 1 +11}
    {2848230000 37800 0 +11}
    {2863956600 39600 1 +11}
    {2879679600 37800 0 +11}
    {2895406200 39600 1 +11}
    {2911129200 37800 0 +11}
    {2926855800 39600 1 +11}
    {2942578800 37800 0 +11}
    {2958910200 39600 1 +11}
    {2974633200 37800 0 +11}
    {2990359800 39600 1 +11}
    {3006082800 37800 0 +11}
    {3021809400 39600 1 +11}
    {3037532400 37800 0 +11}
    {3053259000 39600 1 +11}
    {3068982000 37800 0 +11}
    {3084708600 39600 1 +11}
    {3100431600 37800 0 +11}
    {3116763000 39600 1 +11}
    {3132486000 37800 0 +11}
    {3148212600 39600 1 +11}
    {3163935600 37800 0 +11}
    {3179662200 39600 1 +11}
    {3195385200 37800 0 +11}
    {3211111800 39600 1 +11}
    {3226834800 37800 0 +11}
    {3242561400 39600 1 +11}
    {3258284400 37800 0 +11}
    {3274011000 39600 1 +11}
    {3289734000 37800 0 +11}
    {3306065400 39600 1 +11}
    {3321788400 37800 0 +11}
    {3337515000 39600 1 +11}
    {3353238000 37800 0 +11}
    {3368964600 39600 1 +11}
    {3384687600 37800 0 +11}
    {3400414200 39600 1 +11}
    {3416137200 37800 0 +11}
    {3431863800 39600 1 +11}
    {3447586800 37800 0 +11}
    {3463313400 39600 1 +11}
    {3479641200 37800 0 +11}
    {3495367800 39600 1 +11}
    {3511090800 37800 0 +11}
    {3526817400 39600 1 +11}
    {3542540400 37800 0 +11}
    {3558267000 39600 1 +11}
    {3573990000 37800 0 +11}
    {3589716600 39600 1 +11}
    {3605439600 37800 0 +11}
    {3621166200 39600 1 +11}
    {3636889200 37800 0 +11}
    {3653220600 39600 1 +11}
    {3668943600 37800 0 +11}
    {3684670200 39600 1 +11}
    {3700393200 37800 0 +11}
    {3716119800 39600 1 +11}
    {3731842800 37800 0 +11}
    {3747569400 39600 1 +11}
    {3763292400 37800 0 +11}
    {3779019000 39600 1 +11}
    {3794742000 37800 0 +11}
    {3810468600 39600 1 +11}
    {3826191600 37800 0 +11}
    {3842523000 39600 1 +11}
    {3858246000 37800 0 +11}
    {3873972600 39600 1 +11}
    {3889695600 37800 0 +11}
    {3905422200 39600 1 +11}
    {3921145200 37800 0 +11}
    {3936871800 39600 1 +11}
    {3952594800 37800 0 +11}
    {3968321400 39600 1 +11}
    {3984044400 37800 0 +11}
    {4000375800 39600 1 +11}
    {4016098800 37800 0 +11}
    {4031825400 39600 1 +11}
    {4047548400 37800 0 +11}
    {4063275000 39600 1 +11}
    {4078998000 37800 0 +11}
    {4094724600 39600 1 +11}
    {352216800 37800 0 +1030}
    {372785400 41400 1 +1030}
    {384273000 37800 0 +1030}
    {404839800 41400 1 +1030}
    {415722600 37800 0 +1030}
    {436289400 41400 1 +1030}
    {447172200 37800 0 +1030}
    {467739000 41400 1 +1030}
    {478621800 37800 0 +1030}
    {488984400 37800 0 +1030}
    {499188600 39600 1 +1030}
    {511282800 37800 0 +1030}
    {530033400 39600 1 +1030}
    {542732400 37800 0 +1030}
    {562087800 39600 1 +1030}
    {574786800 37800 0 +1030}
    {594142200 39600 1 +1030}
    {606236400 37800 0 +1030}
    {625591800 39600 1 +1030}
    {636476400 37800 0 +1030}
    {657041400 39600 1 +1030}
    {667926000 37800 0 +1030}
    {688491000 39600 1 +1030}
    {699375600 37800 0 +1030}
    {719940600 39600 1 +1030}
    {731430000 37800 0 +1030}
    {751995000 39600 1 +1030}
    {762879600 37800 0 +1030}
    {783444600 39600 1 +1030}
    {794329200 37800 0 +1030}
    {814894200 39600 1 +1030}
    {828198000 37800 0 +1030}
    {846343800 39600 1 +1030}
    {859647600 37800 0 +1030}
    {877793400 39600 1 +1030}
    {891097200 37800 0 +1030}
    {909243000 39600 1 +1030}
    {922546800 37800 0 +1030}
    {941297400 39600 1 +1030}
    {953996400 37800 0 +1030}
    {967303800 39600 1 +1030}
    {985446000 37800 0 +1030}
    {1004196600 39600 1 +1030}
    {1017500400 37800 0 +1030}
    {1035646200 39600 1 +1030}
    {1048950000 37800 0 +1030}
    {1067095800 39600 1 +1030}
    {1080399600 37800 0 +1030}
    {1099150200 39600 1 +1030}
    {1111849200 37800 0 +1030}
    {1130599800 39600 1 +1030}
    {1143903600 37800 0 +1030}
    {1162049400 39600 1 +1030}
    {1174748400 37800 0 +1030}
    {1193499000 39600 1 +1030}
    {1207407600 37800 0 +1030}
    {1223134200 39600 1 +1030}
    {1238857200 37800 0 +1030}
    {1254583800 39600 1 +1030}
    {1270306800 37800 0 +1030}
    {1286033400 39600 1 +1030}
    {1301756400 37800 0 +1030}
    {1317483000 39600 1 +1030}
    {1333206000 37800 0 +1030}
    {1349537400 39600 1 +1030}
    {1365260400 37800 0 +1030}
    {1380987000 39600 1 +1030}
    {1396710000 37800 0 +1030}
    {1412436600 39600 1 +1030}
    {1428159600 37800 0 +1030}
    {1443886200 39600 1 +1030}
    {1459609200 37800 0 +1030}
    {1475335800 39600 1 +1030}
    {1491058800 37800 0 +1030}
    {1506785400 39600 1 +1030}
    {1522508400 37800 0 +1030}
    {1538839800 39600 1 +1030}
    {1554562800 37800 0 +1030}
    {1570289400 39600 1 +1030}
    {1586012400 37800 0 +1030}
    {1601739000 39600 1 +1030}
    {1617462000 37800 0 +1030}
    {1633188600 39600 1 +1030}
    {1648911600 37800 0 +1030}
    {1664638200 39600 1 +1030}
    {1680361200 37800 0 +1030}
    {1696087800 39600 1 +1030}
    {1712415600 37800 0 +1030}
    {1728142200 39600 1 +1030}
    {1743865200 37800 0 +1030}
    {1759591800 39600 1 +1030}
    {1775314800 37800 0 +1030}
    {1791041400 39600 1 +1030}
    {1806764400 37800 0 +1030}
    {1822491000 39600 1 +1030}
    {1838214000 37800 0 +1030}
    {1853940600 39600 1 +1030}
    {1869663600 37800 0 +1030}
    {1885995000 39600 1 +1030}
    {1901718000 37800 0 +1030}
    {1917444600 39600 1 +1030}
    {1933167600 37800 0 +1030}
    {1948894200 39600 1 +1030}
    {1964617200 37800 0 +1030}
    {1980343800 39600 1 +1030}
    {1996066800 37800 0 +1030}
    {2011793400 39600 1 +1030}
    {2027516400 37800 0 +1030}
    {2043243000 39600 1 +1030}
    {2058966000 37800 0 +1030}
    {2075297400 39600 1 +1030}
    {2091020400 37800 0 +1030}
    {2106747000 39600 1 +1030}
    {2122470000 37800 0 +1030}
    {2138196600 39600 1 +1030}
    {2153919600 37800 0 +1030}
    {2169646200 39600 1 +1030}
    {2185369200 37800 0 +1030}
    {2201095800 39600 1 +1030}
    {2216818800 37800 0 +1030}
    {2233150200 39600 1 +1030}
    {2248873200 37800 0 +1030}
    {2264599800 39600 1 +1030}
    {2280322800 37800 0 +1030}
    {2296049400 39600 1 +1030}
    {2311772400 37800 0 +1030}
    {2327499000 39600 1 +1030}
    {2343222000 37800 0 +1030}
    {2358948600 39600 1 +1030}
    {2374671600 37800 0 +1030}
    {2390398200 39600 1 +1030}
    {2406121200 37800 0 +1030}
    {2422452600 39600 1 +1030}
    {2438175600 37800 0 +1030}
    {2453902200 39600 1 +1030}
    {2469625200 37800 0 +1030}
    {2485351800 39600 1 +1030}
    {2501074800 37800 0 +1030}
    {2516801400 39600 1 +1030}
    {2532524400 37800 0 +1030}
    {2548251000 39600 1 +1030}
    {2563974000 37800 0 +1030}
    {2579700600 39600 1 +1030}
    {2596028400 37800 0 +1030}
    {2611755000 39600 1 +1030}
    {2627478000 37800 0 +1030}
    {2643204600 39600 1 +1030}
    {2658927600 37800 0 +1030}
    {2674654200 39600 1 +1030}
    {2690377200 37800 0 +1030}
    {2706103800 39600 1 +1030}
    {2721826800 37800 0 +1030}
    {2737553400 39600 1 +1030}
    {2753276400 37800 0 +1030}
    {2769607800 39600 1 +1030}
    {2785330800 37800 0 +1030}
    {2801057400 39600 1 +1030}
    {2816780400 37800 0 +1030}
    {2832507000 39600 1 +1030}
    {2848230000 37800 0 +1030}
    {2863956600 39600 1 +1030}
    {2879679600 37800 0 +1030}
    {2895406200 39600 1 +1030}
    {2911129200 37800 0 +1030}
    {2926855800 39600 1 +1030}
    {2942578800 37800 0 +1030}
    {2958910200 39600 1 +1030}
    {2974633200 37800 0 +1030}
    {2990359800 39600 1 +1030}
    {3006082800 37800 0 +1030}
    {3021809400 39600 1 +1030}
    {3037532400 37800 0 +1030}
    {3053259000 39600 1 +1030}
    {3068982000 37800 0 +1030}
    {3084708600 39600 1 +1030}
    {3100431600 37800 0 +1030}
    {3116763000 39600 1 +1030}
    {3132486000 37800 0 +1030}
    {3148212600 39600 1 +1030}
    {3163935600 37800 0 +1030}
    {3179662200 39600 1 +1030}
    {3195385200 37800 0 +1030}
    {3211111800 39600 1 +1030}
    {3226834800 37800 0 +1030}
    {3242561400 39600 1 +1030}
    {3258284400 37800 0 +1030}
    {3274011000 39600 1 +1030}
    {3289734000 37800 0 +1030}
    {3306065400 39600 1 +1030}
    {3321788400 37800 0 +1030}
    {3337515000 39600 1 +1030}
    {3353238000 37800 0 +1030}
    {3368964600 39600 1 +1030}
    {3384687600 37800 0 +1030}
    {3400414200 39600 1 +1030}
    {3416137200 37800 0 +1030}
    {3431863800 39600 1 +1030}
    {3447586800 37800 0 +1030}
    {3463313400 39600 1 +1030}
    {3479641200 37800 0 +1030}
    {3495367800 39600 1 +1030}
    {3511090800 37800 0 +1030}
    {3526817400 39600 1 +1030}
    {3542540400 37800 0 +1030}
    {3558267000 39600 1 +1030}
    {3573990000 37800 0 +1030}
    {3589716600 39600 1 +1030}
    {3605439600 37800 0 +1030}
    {3621166200 39600 1 +1030}
    {3636889200 37800 0 +1030}
    {3653220600 39600 1 +1030}
    {3668943600 37800 0 +1030}
    {3684670200 39600 1 +1030}
    {3700393200 37800 0 +1030}
    {3716119800 39600 1 +1030}
    {3731842800 37800 0 +1030}
    {3747569400 39600 1 +1030}
    {3763292400 37800 0 +1030}
    {3779019000 39600 1 +1030}
    {3794742000 37800 0 +1030}
    {3810468600 39600 1 +1030}
    {3826191600 37800 0 +1030}
    {3842523000 39600 1 +1030}
    {3858246000 37800 0 +1030}
    {3873972600 39600 1 +1030}
    {3889695600 37800 0 +1030}
    {3905422200 39600 1 +1030}
    {3921145200 37800 0 +1030}
    {3936871800 39600 1 +1030}
    {3952594800 37800 0 +1030}
    {3968321400 39600 1 +1030}
    {3984044400 37800 0 +1030}
    {4000375800 39600 1 +1030}
    {4016098800 37800 0 +1030}
    {4031825400 39600 1 +1030}
    {4047548400 37800 0 +1030}
    {4063275000 39600 1 +1030}
    {4078998000 37800 0 +1030}
    {4094724600 39600 1 +1030}
}

Changes to library/tzdata/Europe/Dublin.

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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
















































































































































































































359
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

    {-132184800 0 0 IST}
    {-119484000 3600 1 IST}
    {-100735200 0 0 IST}
    {-88034400 3600 1 IST}
    {-68680800 0 0 IST}
    {-59004000 3600 1 IST}
    {-37238400 3600 0 IST}
    {57722400 0 0 IST}
    {69818400 3600 1 IST}
    {89172000 0 0 IST}
    {101268000 3600 1 IST}
    {120621600 0 0 IST}
    {132717600 3600 1 IST}
    {152071200 0 0 IST}
    {164167200 3600 1 IST}
    {183520800 0 0 IST}
    {196221600 3600 1 IST}
    {214970400 0 0 IST}
    {227671200 3600 1 IST}
    {246420000 0 0 IST}
    {259120800 3600 1 IST}
    {278474400 0 0 IST}
    {290570400 3600 1 IST}
    {309924000 0 0 IST}
    {322020000 3600 1 IST}
    {341373600 0 0 IST}
    {354675600 3600 1 IST}
    {372819600 0 0 IST}
    {386125200 3600 1 IST}
    {404269200 0 0 IST}
    {417574800 3600 1 IST}
    {435718800 0 0 IST}
    {449024400 3600 1 IST}
    {467773200 0 0 IST}
    {481078800 3600 1 IST}
    {499222800 0 0 IST}
    {512528400 3600 1 IST}
    {530672400 0 0 IST}
    {543978000 3600 1 IST}
    {562122000 0 0 IST}
    {575427600 3600 1 IST}
    {593571600 0 0 IST}
    {606877200 3600 1 IST}
    {625626000 0 0 IST}
    {638326800 3600 1 IST}
    {657075600 0 0 IST}
    {670381200 3600 1 IST}
    {688525200 0 0 IST}
    {701830800 3600 1 IST}
    {719974800 0 0 IST}
    {733280400 3600 1 IST}
    {751424400 0 0 IST}
    {764730000 3600 1 IST}
    {782874000 0 0 IST}
    {796179600 3600 1 IST}
    {814323600 0 0 IST}
    {57722400 0 1 IST}
    {69818400 3600 0 IST}
    {89172000 0 1 IST}
    {101268000 3600 0 IST}
    {120621600 0 1 IST}
    {132717600 3600 0 IST}
    {152071200 0 1 IST}
    {164167200 3600 0 IST}
    {183520800 0 1 IST}
    {196221600 3600 0 IST}
    {214970400 0 1 IST}
    {227671200 3600 0 IST}
    {246420000 0 1 IST}
    {259120800 3600 0 IST}
    {278474400 0 1 IST}
    {290570400 3600 0 IST}
    {309924000 0 1 IST}
    {322020000 3600 0 IST}
    {341373600 0 1 IST}
    {354675600 3600 0 IST}
    {372819600 0 1 IST}
    {386125200 3600 0 IST}
    {404269200 0 1 IST}
    {417574800 3600 0 IST}
    {435718800 0 1 IST}
    {449024400 3600 0 IST}
    {467773200 0 1 IST}
    {481078800 3600 0 IST}
    {499222800 0 1 IST}
    {512528400 3600 0 IST}
    {530672400 0 1 IST}
    {543978000 3600 0 IST}
    {562122000 0 1 IST}
    {575427600 3600 0 IST}
    {593571600 0 1 IST}
    {606877200 3600 0 IST}
    {625626000 0 1 IST}
    {638326800 3600 0 IST}
    {657075600 0 1 IST}
    {670381200 3600 0 IST}
    {688525200 0 1 IST}
    {701830800 3600 0 IST}
    {719974800 0 1 IST}
    {733280400 3600 0 IST}
    {751424400 0 1 IST}
    {764730000 3600 0 IST}
    {782874000 0 1 IST}
    {796179600 3600 0 IST}
    {814323600 0 1 IST}
    {820454400 0 0 GMT}
    {828234000 3600 1 IST}
    {846378000 0 0 GMT}
    {859683600 3600 1 IST}
    {877827600 0 0 GMT}
    {891133200 3600 1 IST}
    {909277200 0 0 GMT}
    {922582800 3600 1 IST}
    {941331600 0 0 GMT}
    {954032400 3600 1 IST}
    {972781200 0 0 GMT}
    {985482000 3600 1 IST}
    {1004230800 0 0 GMT}
    {1017536400 3600 1 IST}
    {1035680400 0 0 GMT}
    {1048986000 3600 1 IST}
    {1067130000 0 0 GMT}
    {1080435600 3600 1 IST}
    {1099184400 0 0 GMT}
    {1111885200 3600 1 IST}
    {1130634000 0 0 GMT}
    {1143334800 3600 1 IST}
    {1162083600 0 0 GMT}
    {1174784400 3600 1 IST}
    {1193533200 0 0 GMT}
    {1206838800 3600 1 IST}
    {1224982800 0 0 GMT}
    {1238288400 3600 1 IST}
    {1256432400 0 0 GMT}
    {1269738000 3600 1 IST}
    {1288486800 0 0 GMT}
    {1301187600 3600 1 IST}
    {1319936400 0 0 GMT}
    {1332637200 3600 1 IST}
    {1351386000 0 0 GMT}
    {1364691600 3600 1 IST}
    {1382835600 0 0 GMT}
    {1396141200 3600 1 IST}
    {1414285200 0 0 GMT}
    {1427590800 3600 1 IST}
    {1445734800 0 0 GMT}
    {1459040400 3600 1 IST}
    {1477789200 0 0 GMT}
    {1490490000 3600 1 IST}
    {1509238800 0 0 GMT}
    {1521939600 3600 1 IST}
    {1540688400 0 0 GMT}
    {1553994000 3600 1 IST}
    {1572138000 0 0 GMT}
    {1585443600 3600 1 IST}
    {1603587600 0 0 GMT}
    {1616893200 3600 1 IST}
    {1635642000 0 0 GMT}
    {1648342800 3600 1 IST}
    {1667091600 0 0 GMT}
    {1679792400 3600 1 IST}
    {1698541200 0 0 GMT}
    {1711846800 3600 1 IST}
    {1729990800 0 0 GMT}
    {1743296400 3600 1 IST}
    {1761440400 0 0 GMT}
    {1774746000 3600 1 IST}
    {1792890000 0 0 GMT}
    {1806195600 3600 1 IST}
    {1824944400 0 0 GMT}
    {1837645200 3600 1 IST}
    {1856394000 0 0 GMT}
    {1869094800 3600 1 IST}
    {1887843600 0 0 GMT}
    {1901149200 3600 1 IST}
    {1919293200 0 0 GMT}
    {1932598800 3600 1 IST}
    {1950742800 0 0 GMT}
    {1964048400 3600 1 IST}
    {1982797200 0 0 GMT}
    {1995498000 3600 1 IST}
    {2014246800 0 0 GMT}
    {2026947600 3600 1 IST}
    {2045696400 0 0 GMT}
    {2058397200 3600 1 IST}
    {2077146000 0 0 GMT}
    {2090451600 3600 1 IST}
    {2108595600 0 0 GMT}
    {2121901200 3600 1 IST}
    {2140045200 0 0 GMT}
    {2153350800 3600 1 IST}
    {2172099600 0 0 GMT}
    {2184800400 3600 1 IST}
    {2203549200 0 0 GMT}
    {2216250000 3600 1 IST}
    {2234998800 0 0 GMT}
    {2248304400 3600 1 IST}
    {2266448400 0 0 GMT}
    {2279754000 3600 1 IST}
    {2297898000 0 0 GMT}
    {2311203600 3600 1 IST}
    {2329347600 0 0 GMT}
    {2342653200 3600 1 IST}
    {2361402000 0 0 GMT}
    {2374102800 3600 1 IST}
    {2392851600 0 0 GMT}
    {2405552400 3600 1 IST}
    {2424301200 0 0 GMT}
    {2437606800 3600 1 IST}
    {2455750800 0 0 GMT}
    {2469056400 3600 1 IST}
    {2487200400 0 0 GMT}
    {2500506000 3600 1 IST}
    {2519254800 0 0 GMT}
    {2531955600 3600 1 IST}
    {2550704400 0 0 GMT}
    {2563405200 3600 1 IST}
    {2582154000 0 0 GMT}
    {2595459600 3600 1 IST}
    {2613603600 0 0 GMT}
    {2626909200 3600 1 IST}
    {2645053200 0 0 GMT}
    {2658358800 3600 1 IST}
    {2676502800 0 0 GMT}
    {2689808400 3600 1 IST}
    {2708557200 0 0 GMT}
    {2721258000 3600 1 IST}
    {2740006800 0 0 GMT}
    {2752707600 3600 1 IST}
    {2771456400 0 0 GMT}
    {2784762000 3600 1 IST}
    {2802906000 0 0 GMT}
    {2816211600 3600 1 IST}
    {2834355600 0 0 GMT}
    {2847661200 3600 1 IST}
    {2866410000 0 0 GMT}
    {2879110800 3600 1 IST}
    {2897859600 0 0 GMT}
    {2910560400 3600 1 IST}
    {2929309200 0 0 GMT}
    {2942010000 3600 1 IST}
    {2960758800 0 0 GMT}
    {2974064400 3600 1 IST}
    {2992208400 0 0 GMT}
    {3005514000 3600 1 IST}
    {3023658000 0 0 GMT}
    {3036963600 3600 1 IST}
    {3055712400 0 0 GMT}
    {3068413200 3600 1 IST}
    {3087162000 0 0 GMT}
    {3099862800 3600 1 IST}
    {3118611600 0 0 GMT}
    {3131917200 3600 1 IST}
    {3150061200 0 0 GMT}
    {3163366800 3600 1 IST}
    {3181510800 0 0 GMT}
    {3194816400 3600 1 IST}
    {3212960400 0 0 GMT}
    {3226266000 3600 1 IST}
    {3245014800 0 0 GMT}
    {3257715600 3600 1 IST}
    {3276464400 0 0 GMT}
    {3289165200 3600 1 IST}
    {3307914000 0 0 GMT}
    {3321219600 3600 1 IST}
    {3339363600 0 0 GMT}
    {3352669200 3600 1 IST}
    {3370813200 0 0 GMT}
    {3384118800 3600 1 IST}
    {3402867600 0 0 GMT}
    {3415568400 3600 1 IST}
    {3434317200 0 0 GMT}
    {3447018000 3600 1 IST}
    {3465766800 0 0 GMT}
    {3479072400 3600 1 IST}
    {3497216400 0 0 GMT}
    {3510522000 3600 1 IST}
    {3528666000 0 0 GMT}
    {3541971600 3600 1 IST}
    {3560115600 0 0 GMT}
    {3573421200 3600 1 IST}
    {3592170000 0 0 GMT}
    {3604870800 3600 1 IST}
    {3623619600 0 0 GMT}
    {3636320400 3600 1 IST}
    {3655069200 0 0 GMT}
    {3668374800 3600 1 IST}
    {3686518800 0 0 GMT}
    {3699824400 3600 1 IST}
    {3717968400 0 0 GMT}
    {3731274000 3600 1 IST}
    {3750022800 0 0 GMT}
    {3762723600 3600 1 IST}
    {3781472400 0 0 GMT}
    {3794173200 3600 1 IST}
    {3812922000 0 0 GMT}
    {3825622800 3600 1 IST}
    {3844371600 0 0 GMT}
    {3857677200 3600 1 IST}
    {3875821200 0 0 GMT}
    {3889126800 3600 1 IST}
    {3907270800 0 0 GMT}
    {3920576400 3600 1 IST}
    {3939325200 0 0 GMT}
    {3952026000 3600 1 IST}
    {3970774800 0 0 GMT}
    {3983475600 3600 1 IST}
    {4002224400 0 0 GMT}
    {4015530000 3600 1 IST}
    {4033674000 0 0 GMT}
    {4046979600 3600 1 IST}
    {4065123600 0 0 GMT}
    {4078429200 3600 1 IST}
    {4096573200 0 0 GMT}
    {828234000 3600 0 IST}
    {846378000 0 1 IST}
    {859683600 3600 0 IST}
    {877827600 0 1 IST}
    {891133200 3600 0 IST}
    {909277200 0 1 IST}
    {922582800 3600 0 IST}
    {941331600 0 1 IST}
    {954032400 3600 0 IST}
    {972781200 0 1 IST}
    {985482000 3600 0 IST}
    {1004230800 0 1 IST}
    {1017536400 3600 0 IST}
    {1035680400 0 1 IST}
    {1048986000 3600 0 IST}
    {1067130000 0 1 IST}
    {1080435600 3600 0 IST}
    {1099184400 0 1 IST}
    {1111885200 3600 0 IST}
    {1130634000 0 1 IST}
    {1143334800 3600 0 IST}
    {1162083600 0 1 IST}
    {1174784400 3600 0 IST}
    {1193533200 0 1 IST}
    {1206838800 3600 0 IST}
    {1224982800 0 1 IST}
    {1238288400 3600 0 IST}
    {1256432400 0 1 IST}
    {1269738000 3600 0 IST}
    {1288486800 0 1 IST}
    {1301187600 3600 0 IST}
    {1319936400 0 1 IST}
    {1332637200 3600 0 IST}
    {1351386000 0 1 IST}
    {1364691600 3600 0 IST}
    {1382835600 0 1 IST}
    {1396141200 3600 0 IST}
    {1414285200 0 1 IST}
    {1427590800 3600 0 IST}
    {1445734800 0 1 IST}
    {1459040400 3600 0 IST}
    {1477789200 0 1 IST}
    {1490490000 3600 0 IST}
    {1509238800 0 1 IST}
    {1521939600 3600 0 IST}
    {1540688400 0 1 IST}
    {1553994000 3600 0 IST}
    {1572138000 0 1 IST}
    {1585443600 3600 0 IST}
    {1603587600 0 1 IST}
    {1616893200 3600 0 IST}
    {1635642000 0 1 IST}
    {1648342800 3600 0 IST}
    {1667091600 0 1 IST}
    {1679792400 3600 0 IST}
    {1698541200 0 1 IST}
    {1711846800 3600 0 IST}
    {1729990800 0 1 IST}
    {1743296400 3600 0 IST}
    {1761440400 0 1 IST}
    {1774746000 3600 0 IST}
    {1792890000 0 1 IST}
    {1806195600 3600 0 IST}
    {1824944400 0 1 IST}
    {1837645200 3600 0 IST}
    {1856394000 0 1 IST}
    {1869094800 3600 0 IST}
    {1887843600 0 1 IST}
    {1901149200 3600 0 IST}
    {1919293200 0 1 IST}
    {1932598800 3600 0 IST}
    {1950742800 0 1 IST}
    {1964048400 3600 0 IST}
    {1982797200 0 1 IST}
    {1995498000 3600 0 IST}
    {2014246800 0 1 IST}
    {2026947600 3600 0 IST}
    {2045696400 0 1 IST}
    {2058397200 3600 0 IST}
    {2077146000 0 1 IST}
    {2090451600 3600 0 IST}
    {2108595600 0 1 IST}
    {2121901200 3600 0 IST}
    {2140045200 0 1 IST}
    {2153350800 3600 0 IST}
    {2172099600 0 1 IST}
    {2184800400 3600 0 IST}
    {2203549200 0 1 IST}
    {2216250000 3600 0 IST}
    {2234998800 0 1 IST}
    {2248304400 3600 0 IST}
    {2266448400 0 1 IST}
    {2279754000 3600 0 IST}
    {2297898000 0 1 IST}
    {2311203600 3600 0 IST}
    {2329347600 0 1 IST}
    {2342653200 3600 0 IST}
    {2361402000 0 1 IST}
    {2374102800 3600 0 IST}
    {2392851600 0 1 IST}
    {2405552400 3600 0 IST}
    {2424301200 0 1 IST}
    {2437606800 3600 0 IST}
    {2455750800 0 1 IST}
    {2469056400 3600 0 IST}
    {2487200400 0 1 IST}
    {2500506000 3600 0 IST}
    {2519254800 0 1 IST}
    {2531955600 3600 0 IST}
    {2550704400 0 1 IST}
    {2563405200 3600 0 IST}
    {2582154000 0 1 IST}
    {2595459600 3600 0 IST}
    {2613603600 0 1 IST}
    {2626909200 3600 0 IST}
    {2645053200 0 1 IST}
    {2658358800 3600 0 IST}
    {2676502800 0 1 IST}
    {2689808400 3600 0 IST}
    {2708557200 0 1 IST}
    {2721258000 3600 0 IST}
    {2740006800 0 1 IST}
    {2752707600 3600 0 IST}
    {2771456400 0 1 IST}
    {2784762000 3600 0 IST}
    {2802906000 0 1 IST}
    {2816211600 3600 0 IST}
    {2834355600 0 1 IST}
    {2847661200 3600 0 IST}
    {2866410000 0 1 IST}
    {2879110800 3600 0 IST}
    {2897859600 0 1 IST}
    {2910560400 3600 0 IST}
    {2929309200 0 1 IST}
    {2942010000 3600 0 IST}
    {2960758800 0 1 IST}
    {2974064400 3600 0 IST}
    {2992208400 0 1 IST}
    {3005514000 3600 0 IST}
    {3023658000 0 1 IST}
    {3036963600 3600 0 IST}
    {3055712400 0 1 IST}
    {3068413200 3600 0 IST}
    {3087162000 0 1 IST}
    {3099862800 3600 0 IST}
    {3118611600 0 1 IST}
    {3131917200 3600 0 IST}
    {3150061200 0 1 IST}
    {3163366800 3600 0 IST}
    {3181510800 0 1 IST}
    {3194816400 3600 0 IST}
    {3212960400 0 1 IST}
    {3226266000 3600 0 IST}
    {3245014800 0 1 IST}
    {3257715600 3600 0 IST}
    {3276464400 0 1 IST}
    {3289165200 3600 0 IST}
    {3307914000 0 1 IST}
    {3321219600 3600 0 IST}
    {3339363600 0 1 IST}
    {3352669200 3600 0 IST}
    {3370813200 0 1 IST}
    {3384118800 3600 0 IST}
    {3402867600 0 1 IST}
    {3415568400 3600 0 IST}
    {3434317200 0 1 IST}
    {3447018000 3600 0 IST}
    {3465766800 0 1 IST}
    {3479072400 3600 0 IST}
    {3497216400 0 1 IST}
    {3510522000 3600 0 IST}
    {3528666000 0 1 IST}
    {3541971600 3600 0 IST}
    {3560115600 0 1 IST}
    {3573421200 3600 0 IST}
    {3592170000 0 1 IST}
    {3604870800 3600 0 IST}
    {3623619600 0 1 IST}
    {3636320400 3600 0 IST}
    {3655069200 0 1 IST}
    {3668374800 3600 0 IST}
    {3686518800 0 1 IST}
    {3699824400 3600 0 IST}
    {3717968400 0 1 IST}
    {3731274000 3600 0 IST}
    {3750022800 0 1 IST}
    {3762723600 3600 0 IST}
    {3781472400 0 1 IST}
    {3794173200 3600 0 IST}
    {3812922000 0 1 IST}
    {3825622800 3600 0 IST}
    {3844371600 0 1 IST}
    {3857677200 3600 0 IST}
    {3875821200 0 1 IST}
    {3889126800 3600 0 IST}
    {3907270800 0 1 IST}
    {3920576400 3600 0 IST}
    {3939325200 0 1 IST}
    {3952026000 3600 0 IST}
    {3970774800 0 1 IST}
    {3983475600 3600 0 IST}
    {4002224400 0 1 IST}
    {4015530000 3600 0 IST}
    {4033674000 0 1 IST}
    {4046979600 3600 0 IST}
    {4065123600 0 1 IST}
    {4078429200 3600 0 IST}
    {4096573200 0 1 IST}
}

Changes to library/tzdata/Europe/Lisbon.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Lisbon) {
    {-9223372036854775808 -2205 0 LMT}
    {-2713908195 -2205 0 LMT}
    {-1830381795 0 0 WET}
    {-1830384000 0 0 WET}
    {-1689555600 3600 1 WEST}
    {-1677801600 0 0 WET}
    {-1667437200 3600 1 WEST}
    {-1647738000 0 0 WET}
    {-1635814800 3600 1 WEST}
    {-1616202000 0 0 WET}
    {-1604365200 3600 1 WEST}

Changes to library/tzdata/Europe/Prague.

11
12
13
14
15
16
17
18
19
20




21
22


23
24
25
26
27
28
29
11
12
13
14
15
16
17



18
19
20
21
22
23
24
25
26
27
28
29
30
31
32







-
-
-
+
+
+
+


+
+







    {-1632006000 7200 1 CEST}
    {-1618700400 3600 0 CET}
    {-938905200 7200 1 CEST}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-812502000 7200 1 CEST}
    {-798073200 3600 0 CET}
    {-780534000 7200 1 CEST}
    {-761180400 3600 0 CET}
    {-796777200 3600 0 CET}
    {-781052400 7200 1 CEST}
    {-777862800 7200 0 CEST}
    {-765327600 3600 0 CET}
    {-746578800 7200 1 CEST}
    {-733359600 3600 0 CET}
    {-728517600 0 1 GMT}
    {-721260000 0 0 CET}
    {-716425200 7200 1 CEST}
    {-701910000 3600 0 CET}
    {-684975600 7200 1 CEST}
    {-670460400 3600 0 CET}
    {-654217200 7200 1 CEST}
    {-639010800 3600 0 CET}
    {283993200 3600 0 CET}

Changes to library/tzdata/Europe/Volgograd.

64
65
66
67
68
69
70

71
64
65
66
67
68
69
70
71
72







+

    {1224975600 10800 0 +03}
    {1238281200 14400 1 +04}
    {1256425200 10800 0 +03}
    {1269730800 14400 1 +04}
    {1288479600 10800 0 +03}
    {1301180400 14400 0 +04}
    {1414274400 10800 0 +03}
    {1540681200 14400 0 +04}
}

Changes to library/tzdata/Indian/Mauritius.

1
2
3
4
5
6

7
8

9
10
1
2
3
4
5

6
7

8
9
10





-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Indian/Mauritius) {
    {-9223372036854775808 13800 0 LMT}
    {-1988164200 14400 0 +04}
    {403041600 18000 1 +05}
    {403041600 18000 1 +04}
    {417034800 14400 0 +04}
    {1224972000 18000 1 +05}
    {1224972000 18000 1 +04}
    {1238274000 14400 0 +04}
}

Changes to library/tzdata/Pacific/Apia.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187





















































































































































































188
1
2
3
4
5
6





















































































































































































7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Apia) {
    {-9223372036854775808 45184 0 LMT}
    {-2445424384 -41216 0 LMT}
    {-1861878784 -41400 0 -1130}
    {-631110600 -39600 0 -10}
    {1285498800 -36000 1 -10}
    {1301752800 -39600 0 -10}
    {1316872800 -36000 1 -10}
    {1325239200 50400 0 +14}
    {1333202400 46800 0 +14}
    {1348927200 50400 1 +14}
    {1365256800 46800 0 +14}
    {1380376800 50400 1 +14}
    {1396706400 46800 0 +14}
    {1411826400 50400 1 +14}
    {1428156000 46800 0 +14}
    {1443276000 50400 1 +14}
    {1459605600 46800 0 +14}
    {1474725600 50400 1 +14}
    {1491055200 46800 0 +14}
    {1506175200 50400 1 +14}
    {1522504800 46800 0 +14}
    {1538229600 50400 1 +14}
    {1554559200 46800 0 +14}
    {1569679200 50400 1 +14}
    {1586008800 46800 0 +14}
    {1601128800 50400 1 +14}
    {1617458400 46800 0 +14}
    {1632578400 50400 1 +14}
    {1648908000 46800 0 +14}
    {1664028000 50400 1 +14}
    {1680357600 46800 0 +14}
    {1695477600 50400 1 +14}
    {1712412000 46800 0 +14}
    {1727532000 50400 1 +14}
    {1743861600 46800 0 +14}
    {1758981600 50400 1 +14}
    {1775311200 46800 0 +14}
    {1790431200 50400 1 +14}
    {1806760800 46800 0 +14}
    {1821880800 50400 1 +14}
    {1838210400 46800 0 +14}
    {1853330400 50400 1 +14}
    {1869660000 46800 0 +14}
    {1885384800 50400 1 +14}
    {1901714400 46800 0 +14}
    {1916834400 50400 1 +14}
    {1933164000 46800 0 +14}
    {1948284000 50400 1 +14}
    {1964613600 46800 0 +14}
    {1979733600 50400 1 +14}
    {1996063200 46800 0 +14}
    {2011183200 50400 1 +14}
    {2027512800 46800 0 +14}
    {2042632800 50400 1 +14}
    {2058962400 46800 0 +14}
    {2074687200 50400 1 +14}
    {2091016800 46800 0 +14}
    {2106136800 50400 1 +14}
    {2122466400 46800 0 +14}
    {2137586400 50400 1 +14}
    {2153916000 46800 0 +14}
    {2169036000 50400 1 +14}
    {2185365600 46800 0 +14}
    {2200485600 50400 1 +14}
    {2216815200 46800 0 +14}
    {2232540000 50400 1 +14}
    {2248869600 46800 0 +14}
    {2263989600 50400 1 +14}
    {2280319200 46800 0 +14}
    {2295439200 50400 1 +14}
    {2311768800 46800 0 +14}
    {2326888800 50400 1 +14}
    {2343218400 46800 0 +14}
    {2358338400 50400 1 +14}
    {2374668000 46800 0 +14}
    {2389788000 50400 1 +14}
    {2406117600 46800 0 +14}
    {2421842400 50400 1 +14}
    {2438172000 46800 0 +14}
    {2453292000 50400 1 +14}
    {2469621600 46800 0 +14}
    {2484741600 50400 1 +14}
    {2501071200 46800 0 +14}
    {2516191200 50400 1 +14}
    {2532520800 46800 0 +14}
    {2547640800 50400 1 +14}
    {2563970400 46800 0 +14}
    {2579090400 50400 1 +14}
    {2596024800 46800 0 +14}
    {2611144800 50400 1 +14}
    {2627474400 46800 0 +14}
    {2642594400 50400 1 +14}
    {2658924000 46800 0 +14}
    {2674044000 50400 1 +14}
    {2690373600 46800 0 +14}
    {2705493600 50400 1 +14}
    {2721823200 46800 0 +14}
    {2736943200 50400 1 +14}
    {2753272800 46800 0 +14}
    {2768997600 50400 1 +14}
    {2785327200 46800 0 +14}
    {2800447200 50400 1 +14}
    {2816776800 46800 0 +14}
    {2831896800 50400 1 +14}
    {2848226400 46800 0 +14}
    {2863346400 50400 1 +14}
    {2879676000 46800 0 +14}
    {2894796000 50400 1 +14}
    {2911125600 46800 0 +14}
    {2926245600 50400 1 +14}
    {2942575200 46800 0 +14}
    {2958300000 50400 1 +14}
    {2974629600 46800 0 +14}
    {2989749600 50400 1 +14}
    {3006079200 46800 0 +14}
    {3021199200 50400 1 +14}
    {3037528800 46800 0 +14}
    {3052648800 50400 1 +14}
    {3068978400 46800 0 +14}
    {3084098400 50400 1 +14}
    {3100428000 46800 0 +14}
    {3116152800 50400 1 +14}
    {3132482400 46800 0 +14}
    {3147602400 50400 1 +14}
    {3163932000 46800 0 +14}
    {3179052000 50400 1 +14}
    {3195381600 46800 0 +14}
    {3210501600 50400 1 +14}
    {3226831200 46800 0 +14}
    {3241951200 50400 1 +14}
    {3258280800 46800 0 +14}
    {3273400800 50400 1 +14}
    {3289730400 46800 0 +14}
    {3305455200 50400 1 +14}
    {3321784800 46800 0 +14}
    {3336904800 50400 1 +14}
    {3353234400 46800 0 +14}
    {3368354400 50400 1 +14}
    {3384684000 46800 0 +14}
    {3399804000 50400 1 +14}
    {3416133600 46800 0 +14}
    {3431253600 50400 1 +14}
    {3447583200 46800 0 +14}
    {3462703200 50400 1 +14}
    {3479637600 46800 0 +14}
    {3494757600 50400 1 +14}
    {3511087200 46800 0 +14}
    {3526207200 50400 1 +14}
    {3542536800 46800 0 +14}
    {3557656800 50400 1 +14}
    {3573986400 46800 0 +14}
    {3589106400 50400 1 +14}
    {3605436000 46800 0 +14}
    {3620556000 50400 1 +14}
    {3636885600 46800 0 +14}
    {3652610400 50400 1 +14}
    {3668940000 46800 0 +14}
    {3684060000 50400 1 +14}
    {3700389600 46800 0 +14}
    {3715509600 50400 1 +14}
    {3731839200 46800 0 +14}
    {3746959200 50400 1 +14}
    {3763288800 46800 0 +14}
    {3778408800 50400 1 +14}
    {3794738400 46800 0 +14}
    {3809858400 50400 1 +14}
    {3826188000 46800 0 +14}
    {3841912800 50400 1 +14}
    {3858242400 46800 0 +14}
    {3873362400 50400 1 +14}
    {3889692000 46800 0 +14}
    {3904812000 50400 1 +14}
    {3921141600 46800 0 +14}
    {3936261600 50400 1 +14}
    {3952591200 46800 0 +14}
    {3967711200 50400 1 +14}
    {3984040800 46800 0 +14}
    {3999765600 50400 1 +14}
    {4016095200 46800 0 +14}
    {4031215200 50400 1 +14}
    {4047544800 46800 0 +14}
    {4062664800 50400 1 +14}
    {4078994400 46800 0 +14}
    {4094114400 50400 1 +14}
    {-631110600 -39600 0 -11}
    {1285498800 -36000 1 -11}
    {1301752800 -39600 0 -11}
    {1316872800 -36000 1 -11}
    {1325239200 50400 0 +13}
    {1333202400 46800 0 +13}
    {1348927200 50400 1 +13}
    {1365256800 46800 0 +13}
    {1380376800 50400 1 +13}
    {1396706400 46800 0 +13}
    {1411826400 50400 1 +13}
    {1428156000 46800 0 +13}
    {1443276000 50400 1 +13}
    {1459605600 46800 0 +13}
    {1474725600 50400 1 +13}
    {1491055200 46800 0 +13}
    {1506175200 50400 1 +13}
    {1522504800 46800 0 +13}
    {1538229600 50400 1 +13}
    {1554559200 46800 0 +13}
    {1569679200 50400 1 +13}
    {1586008800 46800 0 +13}
    {1601128800 50400 1 +13}
    {1617458400 46800 0 +13}
    {1632578400 50400 1 +13}
    {1648908000 46800 0 +13}
    {1664028000 50400 1 +13}
    {1680357600 46800 0 +13}
    {1695477600 50400 1 +13}
    {1712412000 46800 0 +13}
    {1727532000 50400 1 +13}
    {1743861600 46800 0 +13}
    {1758981600 50400 1 +13}
    {1775311200 46800 0 +13}
    {1790431200 50400 1 +13}
    {1806760800 46800 0 +13}
    {1821880800 50400 1 +13}
    {1838210400 46800 0 +13}
    {1853330400 50400 1 +13}
    {1869660000 46800 0 +13}
    {1885384800 50400 1 +13}
    {1901714400 46800 0 +13}
    {1916834400 50400 1 +13}
    {1933164000 46800 0 +13}
    {1948284000 50400 1 +13}
    {1964613600 46800 0 +13}
    {1979733600 50400 1 +13}
    {1996063200 46800 0 +13}
    {2011183200 50400 1 +13}
    {2027512800 46800 0 +13}
    {2042632800 50400 1 +13}
    {2058962400 46800 0 +13}
    {2074687200 50400 1 +13}
    {2091016800 46800 0 +13}
    {2106136800 50400 1 +13}
    {2122466400 46800 0 +13}
    {2137586400 50400 1 +13}
    {2153916000 46800 0 +13}
    {2169036000 50400 1 +13}
    {2185365600 46800 0 +13}
    {2200485600 50400 1 +13}
    {2216815200 46800 0 +13}
    {2232540000 50400 1 +13}
    {2248869600 46800 0 +13}
    {2263989600 50400 1 +13}
    {2280319200 46800 0 +13}
    {2295439200 50400 1 +13}
    {2311768800 46800 0 +13}
    {2326888800 50400 1 +13}
    {2343218400 46800 0 +13}
    {2358338400 50400 1 +13}
    {2374668000 46800 0 +13}
    {2389788000 50400 1 +13}
    {2406117600 46800 0 +13}
    {2421842400 50400 1 +13}
    {2438172000 46800 0 +13}
    {2453292000 50400 1 +13}
    {2469621600 46800 0 +13}
    {2484741600 50400 1 +13}
    {2501071200 46800 0 +13}
    {2516191200 50400 1 +13}
    {2532520800 46800 0 +13}
    {2547640800 50400 1 +13}
    {2563970400 46800 0 +13}
    {2579090400 50400 1 +13}
    {2596024800 46800 0 +13}
    {2611144800 50400 1 +13}
    {2627474400 46800 0 +13}
    {2642594400 50400 1 +13}
    {2658924000 46800 0 +13}
    {2674044000 50400 1 +13}
    {2690373600 46800 0 +13}
    {2705493600 50400 1 +13}
    {2721823200 46800 0 +13}
    {2736943200 50400 1 +13}
    {2753272800 46800 0 +13}
    {2768997600 50400 1 +13}
    {2785327200 46800 0 +13}
    {2800447200 50400 1 +13}
    {2816776800 46800 0 +13}
    {2831896800 50400 1 +13}
    {2848226400 46800 0 +13}
    {2863346400 50400 1 +13}
    {2879676000 46800 0 +13}
    {2894796000 50400 1 +13}
    {2911125600 46800 0 +13}
    {2926245600 50400 1 +13}
    {2942575200 46800 0 +13}
    {2958300000 50400 1 +13}
    {2974629600 46800 0 +13}
    {2989749600 50400 1 +13}
    {3006079200 46800 0 +13}
    {3021199200 50400 1 +13}
    {3037528800 46800 0 +13}
    {3052648800 50400 1 +13}
    {3068978400 46800 0 +13}
    {3084098400 50400 1 +13}
    {3100428000 46800 0 +13}
    {3116152800 50400 1 +13}
    {3132482400 46800 0 +13}
    {3147602400 50400 1 +13}
    {3163932000 46800 0 +13}
    {3179052000 50400 1 +13}
    {3195381600 46800 0 +13}
    {3210501600 50400 1 +13}
    {3226831200 46800 0 +13}
    {3241951200 50400 1 +13}
    {3258280800 46800 0 +13}
    {3273400800 50400 1 +13}
    {3289730400 46800 0 +13}
    {3305455200 50400 1 +13}
    {3321784800 46800 0 +13}
    {3336904800 50400 1 +13}
    {3353234400 46800 0 +13}
    {3368354400 50400 1 +13}
    {3384684000 46800 0 +13}
    {3399804000 50400 1 +13}
    {3416133600 46800 0 +13}
    {3431253600 50400 1 +13}
    {3447583200 46800 0 +13}
    {3462703200 50400 1 +13}
    {3479637600 46800 0 +13}
    {3494757600 50400 1 +13}
    {3511087200 46800 0 +13}
    {3526207200 50400 1 +13}
    {3542536800 46800 0 +13}
    {3557656800 50400 1 +13}
    {3573986400 46800 0 +13}
    {3589106400 50400 1 +13}
    {3605436000 46800 0 +13}
    {3620556000 50400 1 +13}
    {3636885600 46800 0 +13}
    {3652610400 50400 1 +13}
    {3668940000 46800 0 +13}
    {3684060000 50400 1 +13}
    {3700389600 46800 0 +13}
    {3715509600 50400 1 +13}
    {3731839200 46800 0 +13}
    {3746959200 50400 1 +13}
    {3763288800 46800 0 +13}
    {3778408800 50400 1 +13}
    {3794738400 46800 0 +13}
    {3809858400 50400 1 +13}
    {3826188000 46800 0 +13}
    {3841912800 50400 1 +13}
    {3858242400 46800 0 +13}
    {3873362400 50400 1 +13}
    {3889692000 46800 0 +13}
    {3904812000 50400 1 +13}
    {3921141600 46800 0 +13}
    {3936261600 50400 1 +13}
    {3952591200 46800 0 +13}
    {3967711200 50400 1 +13}
    {3984040800 46800 0 +13}
    {3999765600 50400 1 +13}
    {4016095200 46800 0 +13}
    {4031215200 50400 1 +13}
    {4047544800 46800 0 +13}
    {4062664800 50400 1 +13}
    {4078994400 46800 0 +13}
    {4094114400 50400 1 +13}
}

Changes to library/tzdata/Pacific/Chatham.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257




























































































































































































































































258
1
2
3
4
5




























































































































































































































































6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Chatham) {
    {-9223372036854775808 44028 0 LMT}
    {-3192437628 44100 0 +1215}
    {-757426500 45900 0 +1345}
    {152632800 49500 1 +1345}
    {162309600 45900 0 +1345}
    {183477600 49500 1 +1345}
    {194968800 45900 0 +1345}
    {215532000 49500 1 +1345}
    {226418400 45900 0 +1345}
    {246981600 49500 1 +1345}
    {257868000 45900 0 +1345}
    {278431200 49500 1 +1345}
    {289317600 45900 0 +1345}
    {309880800 49500 1 +1345}
    {320767200 45900 0 +1345}
    {341330400 49500 1 +1345}
    {352216800 45900 0 +1345}
    {372780000 49500 1 +1345}
    {384271200 45900 0 +1345}
    {404834400 49500 1 +1345}
    {415720800 45900 0 +1345}
    {436284000 49500 1 +1345}
    {447170400 45900 0 +1345}
    {467733600 49500 1 +1345}
    {478620000 45900 0 +1345}
    {499183200 49500 1 +1345}
    {510069600 45900 0 +1345}
    {530632800 49500 1 +1345}
    {541519200 45900 0 +1345}
    {562082400 49500 1 +1345}
    {573573600 45900 0 +1345}
    {594136800 49500 1 +1345}
    {605023200 45900 0 +1345}
    {623772000 49500 1 +1345}
    {637682400 45900 0 +1345}
    {655221600 49500 1 +1345}
    {669132000 45900 0 +1345}
    {686671200 49500 1 +1345}
    {700581600 45900 0 +1345}
    {718120800 49500 1 +1345}
    {732636000 45900 0 +1345}
    {749570400 49500 1 +1345}
    {764085600 45900 0 +1345}
    {781020000 49500 1 +1345}
    {795535200 45900 0 +1345}
    {812469600 49500 1 +1345}
    {826984800 45900 0 +1345}
    {844524000 49500 1 +1345}
    {858434400 45900 0 +1345}
    {875973600 49500 1 +1345}
    {889884000 45900 0 +1345}
    {907423200 49500 1 +1345}
    {921938400 45900 0 +1345}
    {938872800 49500 1 +1345}
    {953388000 45900 0 +1345}
    {970322400 49500 1 +1345}
    {984837600 45900 0 +1345}
    {1002376800 49500 1 +1345}
    {1016287200 45900 0 +1345}
    {1033826400 49500 1 +1345}
    {1047736800 45900 0 +1345}
    {1065276000 49500 1 +1345}
    {1079791200 45900 0 +1345}
    {1096725600 49500 1 +1345}
    {1111240800 45900 0 +1345}
    {1128175200 49500 1 +1345}
    {1142690400 45900 0 +1345}
    {1159624800 49500 1 +1345}
    {1174140000 45900 0 +1345}
    {1191074400 49500 1 +1345}
    {1207404000 45900 0 +1345}
    {1222524000 49500 1 +1345}
    {1238853600 45900 0 +1345}
    {1253973600 49500 1 +1345}
    {1270303200 45900 0 +1345}
    {1285423200 49500 1 +1345}
    {1301752800 45900 0 +1345}
    {1316872800 49500 1 +1345}
    {1333202400 45900 0 +1345}
    {1348927200 49500 1 +1345}
    {1365256800 45900 0 +1345}
    {1380376800 49500 1 +1345}
    {1396706400 45900 0 +1345}
    {1411826400 49500 1 +1345}
    {1428156000 45900 0 +1345}
    {1443276000 49500 1 +1345}
    {1459605600 45900 0 +1345}
    {1474725600 49500 1 +1345}
    {1491055200 45900 0 +1345}
    {1506175200 49500 1 +1345}
    {1522504800 45900 0 +1345}
    {1538229600 49500 1 +1345}
    {1554559200 45900 0 +1345}
    {1569679200 49500 1 +1345}
    {1586008800 45900 0 +1345}
    {1601128800 49500 1 +1345}
    {1617458400 45900 0 +1345}
    {1632578400 49500 1 +1345}
    {1648908000 45900 0 +1345}
    {1664028000 49500 1 +1345}
    {1680357600 45900 0 +1345}
    {1695477600 49500 1 +1345}
    {1712412000 45900 0 +1345}
    {1727532000 49500 1 +1345}
    {1743861600 45900 0 +1345}
    {1758981600 49500 1 +1345}
    {1775311200 45900 0 +1345}
    {1790431200 49500 1 +1345}
    {1806760800 45900 0 +1345}
    {1821880800 49500 1 +1345}
    {1838210400 45900 0 +1345}
    {1853330400 49500 1 +1345}
    {1869660000 45900 0 +1345}
    {1885384800 49500 1 +1345}
    {1901714400 45900 0 +1345}
    {1916834400 49500 1 +1345}
    {1933164000 45900 0 +1345}
    {1948284000 49500 1 +1345}
    {1964613600 45900 0 +1345}
    {1979733600 49500 1 +1345}
    {1996063200 45900 0 +1345}
    {2011183200 49500 1 +1345}
    {2027512800 45900 0 +1345}
    {2042632800 49500 1 +1345}
    {2058962400 45900 0 +1345}
    {2074687200 49500 1 +1345}
    {2091016800 45900 0 +1345}
    {2106136800 49500 1 +1345}
    {2122466400 45900 0 +1345}
    {2137586400 49500 1 +1345}
    {2153916000 45900 0 +1345}
    {2169036000 49500 1 +1345}
    {2185365600 45900 0 +1345}
    {2200485600 49500 1 +1345}
    {2216815200 45900 0 +1345}
    {2232540000 49500 1 +1345}
    {2248869600 45900 0 +1345}
    {2263989600 49500 1 +1345}
    {2280319200 45900 0 +1345}
    {2295439200 49500 1 +1345}
    {2311768800 45900 0 +1345}
    {2326888800 49500 1 +1345}
    {2343218400 45900 0 +1345}
    {2358338400 49500 1 +1345}
    {2374668000 45900 0 +1345}
    {2389788000 49500 1 +1345}
    {2406117600 45900 0 +1345}
    {2421842400 49500 1 +1345}
    {2438172000 45900 0 +1345}
    {2453292000 49500 1 +1345}
    {2469621600 45900 0 +1345}
    {2484741600 49500 1 +1345}
    {2501071200 45900 0 +1345}
    {2516191200 49500 1 +1345}
    {2532520800 45900 0 +1345}
    {2547640800 49500 1 +1345}
    {2563970400 45900 0 +1345}
    {2579090400 49500 1 +1345}
    {2596024800 45900 0 +1345}
    {2611144800 49500 1 +1345}
    {2627474400 45900 0 +1345}
    {2642594400 49500 1 +1345}
    {2658924000 45900 0 +1345}
    {2674044000 49500 1 +1345}
    {2690373600 45900 0 +1345}
    {2705493600 49500 1 +1345}
    {2721823200 45900 0 +1345}
    {2736943200 49500 1 +1345}
    {2753272800 45900 0 +1345}
    {2768997600 49500 1 +1345}
    {2785327200 45900 0 +1345}
    {2800447200 49500 1 +1345}
    {2816776800 45900 0 +1345}
    {2831896800 49500 1 +1345}
    {2848226400 45900 0 +1345}
    {2863346400 49500 1 +1345}
    {2879676000 45900 0 +1345}
    {2894796000 49500 1 +1345}
    {2911125600 45900 0 +1345}
    {2926245600 49500 1 +1345}
    {2942575200 45900 0 +1345}
    {2958300000 49500 1 +1345}
    {2974629600 45900 0 +1345}
    {2989749600 49500 1 +1345}
    {3006079200 45900 0 +1345}
    {3021199200 49500 1 +1345}
    {3037528800 45900 0 +1345}
    {3052648800 49500 1 +1345}
    {3068978400 45900 0 +1345}
    {3084098400 49500 1 +1345}
    {3100428000 45900 0 +1345}
    {3116152800 49500 1 +1345}
    {3132482400 45900 0 +1345}
    {3147602400 49500 1 +1345}
    {3163932000 45900 0 +1345}
    {3179052000 49500 1 +1345}
    {3195381600 45900 0 +1345}
    {3210501600 49500 1 +1345}
    {3226831200 45900 0 +1345}
    {3241951200 49500 1 +1345}
    {3258280800 45900 0 +1345}
    {3273400800 49500 1 +1345}
    {3289730400 45900 0 +1345}
    {3305455200 49500 1 +1345}
    {3321784800 45900 0 +1345}
    {3336904800 49500 1 +1345}
    {3353234400 45900 0 +1345}
    {3368354400 49500 1 +1345}
    {3384684000 45900 0 +1345}
    {3399804000 49500 1 +1345}
    {3416133600 45900 0 +1345}
    {3431253600 49500 1 +1345}
    {3447583200 45900 0 +1345}
    {3462703200 49500 1 +1345}
    {3479637600 45900 0 +1345}
    {3494757600 49500 1 +1345}
    {3511087200 45900 0 +1345}
    {3526207200 49500 1 +1345}
    {3542536800 45900 0 +1345}
    {3557656800 49500 1 +1345}
    {3573986400 45900 0 +1345}
    {3589106400 49500 1 +1345}
    {3605436000 45900 0 +1345}
    {3620556000 49500 1 +1345}
    {3636885600 45900 0 +1345}
    {3652610400 49500 1 +1345}
    {3668940000 45900 0 +1345}
    {3684060000 49500 1 +1345}
    {3700389600 45900 0 +1345}
    {3715509600 49500 1 +1345}
    {3731839200 45900 0 +1345}
    {3746959200 49500 1 +1345}
    {3763288800 45900 0 +1345}
    {3778408800 49500 1 +1345}
    {3794738400 45900 0 +1345}
    {3809858400 49500 1 +1345}
    {3826188000 45900 0 +1345}
    {3841912800 49500 1 +1345}
    {3858242400 45900 0 +1345}
    {3873362400 49500 1 +1345}
    {3889692000 45900 0 +1345}
    {3904812000 49500 1 +1345}
    {3921141600 45900 0 +1345}
    {3936261600 49500 1 +1345}
    {3952591200 45900 0 +1345}
    {3967711200 49500 1 +1345}
    {3984040800 45900 0 +1345}
    {3999765600 49500 1 +1345}
    {4016095200 45900 0 +1345}
    {4031215200 49500 1 +1345}
    {4047544800 45900 0 +1345}
    {4062664800 49500 1 +1345}
    {4078994400 45900 0 +1345}
    {4094114400 49500 1 +1345}
    {-757426500 45900 0 +1245}
    {152632800 49500 1 +1245}
    {162309600 45900 0 +1245}
    {183477600 49500 1 +1245}
    {194968800 45900 0 +1245}
    {215532000 49500 1 +1245}
    {226418400 45900 0 +1245}
    {246981600 49500 1 +1245}
    {257868000 45900 0 +1245}
    {278431200 49500 1 +1245}
    {289317600 45900 0 +1245}
    {309880800 49500 1 +1245}
    {320767200 45900 0 +1245}
    {341330400 49500 1 +1245}
    {352216800 45900 0 +1245}
    {372780000 49500 1 +1245}
    {384271200 45900 0 +1245}
    {404834400 49500 1 +1245}
    {415720800 45900 0 +1245}
    {436284000 49500 1 +1245}
    {447170400 45900 0 +1245}
    {467733600 49500 1 +1245}
    {478620000 45900 0 +1245}
    {499183200 49500 1 +1245}
    {510069600 45900 0 +1245}
    {530632800 49500 1 +1245}
    {541519200 45900 0 +1245}
    {562082400 49500 1 +1245}
    {573573600 45900 0 +1245}
    {594136800 49500 1 +1245}
    {605023200 45900 0 +1245}
    {623772000 49500 1 +1245}
    {637682400 45900 0 +1245}
    {655221600 49500 1 +1245}
    {669132000 45900 0 +1245}
    {686671200 49500 1 +1245}
    {700581600 45900 0 +1245}
    {718120800 49500 1 +1245}
    {732636000 45900 0 +1245}
    {749570400 49500 1 +1245}
    {764085600 45900 0 +1245}
    {781020000 49500 1 +1245}
    {795535200 45900 0 +1245}
    {812469600 49500 1 +1245}
    {826984800 45900 0 +1245}
    {844524000 49500 1 +1245}
    {858434400 45900 0 +1245}
    {875973600 49500 1 +1245}
    {889884000 45900 0 +1245}
    {907423200 49500 1 +1245}
    {921938400 45900 0 +1245}
    {938872800 49500 1 +1245}
    {953388000 45900 0 +1245}
    {970322400 49500 1 +1245}
    {984837600 45900 0 +1245}
    {1002376800 49500 1 +1245}
    {1016287200 45900 0 +1245}
    {1033826400 49500 1 +1245}
    {1047736800 45900 0 +1245}
    {1065276000 49500 1 +1245}
    {1079791200 45900 0 +1245}
    {1096725600 49500 1 +1245}
    {1111240800 45900 0 +1245}
    {1128175200 49500 1 +1245}
    {1142690400 45900 0 +1245}
    {1159624800 49500 1 +1245}
    {1174140000 45900 0 +1245}
    {1191074400 49500 1 +1245}
    {1207404000 45900 0 +1245}
    {1222524000 49500 1 +1245}
    {1238853600 45900 0 +1245}
    {1253973600 49500 1 +1245}
    {1270303200 45900 0 +1245}
    {1285423200 49500 1 +1245}
    {1301752800 45900 0 +1245}
    {1316872800 49500 1 +1245}
    {1333202400 45900 0 +1245}
    {1348927200 49500 1 +1245}
    {1365256800 45900 0 +1245}
    {1380376800 49500 1 +1245}
    {1396706400 45900 0 +1245}
    {1411826400 49500 1 +1245}
    {1428156000 45900 0 +1245}
    {1443276000 49500 1 +1245}
    {1459605600 45900 0 +1245}
    {1474725600 49500 1 +1245}
    {1491055200 45900 0 +1245}
    {1506175200 49500 1 +1245}
    {1522504800 45900 0 +1245}
    {1538229600 49500 1 +1245}
    {1554559200 45900 0 +1245}
    {1569679200 49500 1 +1245}
    {1586008800 45900 0 +1245}
    {1601128800 49500 1 +1245}
    {1617458400 45900 0 +1245}
    {1632578400 49500 1 +1245}
    {1648908000 45900 0 +1245}
    {1664028000 49500 1 +1245}
    {1680357600 45900 0 +1245}
    {1695477600 49500 1 +1245}
    {1712412000 45900 0 +1245}
    {1727532000 49500 1 +1245}
    {1743861600 45900 0 +1245}
    {1758981600 49500 1 +1245}
    {1775311200 45900 0 +1245}
    {1790431200 49500 1 +1245}
    {1806760800 45900 0 +1245}
    {1821880800 49500 1 +1245}
    {1838210400 45900 0 +1245}
    {1853330400 49500 1 +1245}
    {1869660000 45900 0 +1245}
    {1885384800 49500 1 +1245}
    {1901714400 45900 0 +1245}
    {1916834400 49500 1 +1245}
    {1933164000 45900 0 +1245}
    {1948284000 49500 1 +1245}
    {1964613600 45900 0 +1245}
    {1979733600 49500 1 +1245}
    {1996063200 45900 0 +1245}
    {2011183200 49500 1 +1245}
    {2027512800 45900 0 +1245}
    {2042632800 49500 1 +1245}
    {2058962400 45900 0 +1245}
    {2074687200 49500 1 +1245}
    {2091016800 45900 0 +1245}
    {2106136800 49500 1 +1245}
    {2122466400 45900 0 +1245}
    {2137586400 49500 1 +1245}
    {2153916000 45900 0 +1245}
    {2169036000 49500 1 +1245}
    {2185365600 45900 0 +1245}
    {2200485600 49500 1 +1245}
    {2216815200 45900 0 +1245}
    {2232540000 49500 1 +1245}
    {2248869600 45900 0 +1245}
    {2263989600 49500 1 +1245}
    {2280319200 45900 0 +1245}
    {2295439200 49500 1 +1245}
    {2311768800 45900 0 +1245}
    {2326888800 49500 1 +1245}
    {2343218400 45900 0 +1245}
    {2358338400 49500 1 +1245}
    {2374668000 45900 0 +1245}
    {2389788000 49500 1 +1245}
    {2406117600 45900 0 +1245}
    {2421842400 49500 1 +1245}
    {2438172000 45900 0 +1245}
    {2453292000 49500 1 +1245}
    {2469621600 45900 0 +1245}
    {2484741600 49500 1 +1245}
    {2501071200 45900 0 +1245}
    {2516191200 49500 1 +1245}
    {2532520800 45900 0 +1245}
    {2547640800 49500 1 +1245}
    {2563970400 45900 0 +1245}
    {2579090400 49500 1 +1245}
    {2596024800 45900 0 +1245}
    {2611144800 49500 1 +1245}
    {2627474400 45900 0 +1245}
    {2642594400 49500 1 +1245}
    {2658924000 45900 0 +1245}
    {2674044000 49500 1 +1245}
    {2690373600 45900 0 +1245}
    {2705493600 49500 1 +1245}
    {2721823200 45900 0 +1245}
    {2736943200 49500 1 +1245}
    {2753272800 45900 0 +1245}
    {2768997600 49500 1 +1245}
    {2785327200 45900 0 +1245}
    {2800447200 49500 1 +1245}
    {2816776800 45900 0 +1245}
    {2831896800 49500 1 +1245}
    {2848226400 45900 0 +1245}
    {2863346400 49500 1 +1245}
    {2879676000 45900 0 +1245}
    {2894796000 49500 1 +1245}
    {2911125600 45900 0 +1245}
    {2926245600 49500 1 +1245}
    {2942575200 45900 0 +1245}
    {2958300000 49500 1 +1245}
    {2974629600 45900 0 +1245}
    {2989749600 49500 1 +1245}
    {3006079200 45900 0 +1245}
    {3021199200 49500 1 +1245}
    {3037528800 45900 0 +1245}
    {3052648800 49500 1 +1245}
    {3068978400 45900 0 +1245}
    {3084098400 49500 1 +1245}
    {3100428000 45900 0 +1245}
    {3116152800 49500 1 +1245}
    {3132482400 45900 0 +1245}
    {3147602400 49500 1 +1245}
    {3163932000 45900 0 +1245}
    {3179052000 49500 1 +1245}
    {3195381600 45900 0 +1245}
    {3210501600 49500 1 +1245}
    {3226831200 45900 0 +1245}
    {3241951200 49500 1 +1245}
    {3258280800 45900 0 +1245}
    {3273400800 49500 1 +1245}
    {3289730400 45900 0 +1245}
    {3305455200 49500 1 +1245}
    {3321784800 45900 0 +1245}
    {3336904800 49500 1 +1245}
    {3353234400 45900 0 +1245}
    {3368354400 49500 1 +1245}
    {3384684000 45900 0 +1245}
    {3399804000 49500 1 +1245}
    {3416133600 45900 0 +1245}
    {3431253600 49500 1 +1245}
    {3447583200 45900 0 +1245}
    {3462703200 49500 1 +1245}
    {3479637600 45900 0 +1245}
    {3494757600 49500 1 +1245}
    {3511087200 45900 0 +1245}
    {3526207200 49500 1 +1245}
    {3542536800 45900 0 +1245}
    {3557656800 49500 1 +1245}
    {3573986400 45900 0 +1245}
    {3589106400 49500 1 +1245}
    {3605436000 45900 0 +1245}
    {3620556000 49500 1 +1245}
    {3636885600 45900 0 +1245}
    {3652610400 49500 1 +1245}
    {3668940000 45900 0 +1245}
    {3684060000 49500 1 +1245}
    {3700389600 45900 0 +1245}
    {3715509600 49500 1 +1245}
    {3731839200 45900 0 +1245}
    {3746959200 49500 1 +1245}
    {3763288800 45900 0 +1245}
    {3778408800 49500 1 +1245}
    {3794738400 45900 0 +1245}
    {3809858400 49500 1 +1245}
    {3826188000 45900 0 +1245}
    {3841912800 49500 1 +1245}
    {3858242400 45900 0 +1245}
    {3873362400 49500 1 +1245}
    {3889692000 45900 0 +1245}
    {3904812000 49500 1 +1245}
    {3921141600 45900 0 +1245}
    {3936261600 49500 1 +1245}
    {3952591200 45900 0 +1245}
    {3967711200 49500 1 +1245}
    {3984040800 45900 0 +1245}
    {3999765600 49500 1 +1245}
    {4016095200 45900 0 +1245}
    {4031215200 49500 1 +1245}
    {4047544800 45900 0 +1245}
    {4062664800 49500 1 +1245}
    {4078994400 45900 0 +1245}
    {4094114400 49500 1 +1245}
}

Changes to library/tzdata/Pacific/Easter.

1
2
3
4
5
6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49

50
51

52
53

54
55

56
57

58
59

60
61

62
63

64
65

66
67

68
69

70
71

72
73

74
75

76
77

78
79

80
81

82
83

84
85

86
87

88
89

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
128
129
130
131
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
161
162
163
164







































165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259



































































































260
261
262
263
264
265
266
267




268
1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50

51
52

53
54

55
56

57
58

59
60

61
62

63
64

65
66

67
68

69
70

71
72

73
74

75
76

77
78

79
80

81
82

83
84

85
86

87
88

89
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
128
129
130
131
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
161
162
163
164































































































165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263








264
265
266
267
268






-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Easter) {
    {-9223372036854775808 -26248 0 LMT}
    {-2524495352 -26248 0 EMT}
    {-1178124152 -25200 0 -07}
    {-36619200 -21600 1 -06}
    {-36619200 -21600 1 -07}
    {-23922000 -25200 0 -07}
    {-3355200 -21600 1 -06}
    {-3355200 -21600 1 -07}
    {7527600 -25200 0 -07}
    {24465600 -21600 1 -06}
    {24465600 -21600 1 -07}
    {37767600 -25200 0 -07}
    {55915200 -21600 1 -06}
    {55915200 -21600 1 -07}
    {69217200 -25200 0 -07}
    {87969600 -21600 1 -06}
    {87969600 -21600 1 -07}
    {100666800 -25200 0 -07}
    {118209600 -21600 1 -06}
    {118209600 -21600 1 -07}
    {132116400 -25200 0 -07}
    {150868800 -21600 1 -06}
    {150868800 -21600 1 -07}
    {163566000 -25200 0 -07}
    {182318400 -21600 1 -06}
    {182318400 -21600 1 -07}
    {195620400 -25200 0 -07}
    {213768000 -21600 1 -06}
    {213768000 -21600 1 -07}
    {227070000 -25200 0 -07}
    {245217600 -21600 1 -06}
    {245217600 -21600 1 -07}
    {258519600 -25200 0 -07}
    {277272000 -21600 1 -06}
    {277272000 -21600 1 -07}
    {289969200 -25200 0 -07}
    {308721600 -21600 1 -06}
    {308721600 -21600 1 -07}
    {321418800 -25200 0 -07}
    {340171200 -21600 1 -06}
    {340171200 -21600 1 -07}
    {353473200 -25200 0 -07}
    {371620800 -21600 1 -06}
    {371620800 -21600 1 -07}
    {384922800 -21600 0 -06}
    {403070400 -18000 1 -05}
    {403070400 -18000 1 -06}
    {416372400 -21600 0 -06}
    {434520000 -18000 1 -05}
    {434520000 -18000 1 -06}
    {447822000 -21600 0 -06}
    {466574400 -18000 1 -05}
    {466574400 -18000 1 -06}
    {479271600 -21600 0 -06}
    {498024000 -18000 1 -05}
    {498024000 -18000 1 -06}
    {510721200 -21600 0 -06}
    {529473600 -18000 1 -05}
    {529473600 -18000 1 -06}
    {545194800 -21600 0 -06}
    {560923200 -18000 1 -05}
    {560923200 -18000 1 -06}
    {574225200 -21600 0 -06}
    {592372800 -18000 1 -05}
    {592372800 -18000 1 -06}
    {605674800 -21600 0 -06}
    {624427200 -18000 1 -05}
    {624427200 -18000 1 -06}
    {637124400 -21600 0 -06}
    {653457600 -18000 1 -05}
    {653457600 -18000 1 -06}
    {668574000 -21600 0 -06}
    {687326400 -18000 1 -05}
    {687326400 -18000 1 -06}
    {700628400 -21600 0 -06}
    {718776000 -18000 1 -05}
    {718776000 -18000 1 -06}
    {732078000 -21600 0 -06}
    {750225600 -18000 1 -05}
    {750225600 -18000 1 -06}
    {763527600 -21600 0 -06}
    {781675200 -18000 1 -05}
    {781675200 -18000 1 -06}
    {794977200 -21600 0 -06}
    {813729600 -18000 1 -05}
    {813729600 -18000 1 -06}
    {826426800 -21600 0 -06}
    {845179200 -18000 1 -05}
    {845179200 -18000 1 -06}
    {859690800 -21600 0 -06}
    {876628800 -18000 1 -05}
    {876628800 -18000 1 -06}
    {889930800 -21600 0 -06}
    {906868800 -18000 1 -05}
    {906868800 -18000 1 -06}
    {923194800 -21600 0 -06}
    {939528000 -18000 1 -05}
    {939528000 -18000 1 -06}
    {952830000 -21600 0 -06}
    {971582400 -18000 1 -05}
    {971582400 -18000 1 -06}
    {984279600 -21600 0 -06}
    {1003032000 -18000 1 -05}
    {1003032000 -18000 1 -06}
    {1015729200 -21600 0 -06}
    {1034481600 -18000 1 -05}
    {1034481600 -18000 1 -06}
    {1047178800 -21600 0 -06}
    {1065931200 -18000 1 -05}
    {1065931200 -18000 1 -06}
    {1079233200 -21600 0 -06}
    {1097380800 -18000 1 -05}
    {1097380800 -18000 1 -06}
    {1110682800 -21600 0 -06}
    {1128830400 -18000 1 -05}
    {1128830400 -18000 1 -06}
    {1142132400 -21600 0 -06}
    {1160884800 -18000 1 -05}
    {1160884800 -18000 1 -06}
    {1173582000 -21600 0 -06}
    {1192334400 -18000 1 -05}
    {1192334400 -18000 1 -06}
    {1206846000 -21600 0 -06}
    {1223784000 -18000 1 -05}
    {1223784000 -18000 1 -06}
    {1237086000 -21600 0 -06}
    {1255233600 -18000 1 -05}
    {1255233600 -18000 1 -06}
    {1270350000 -21600 0 -06}
    {1286683200 -18000 1 -05}
    {1286683200 -18000 1 -06}
    {1304823600 -21600 0 -06}
    {1313899200 -18000 1 -05}
    {1313899200 -18000 1 -06}
    {1335668400 -21600 0 -06}
    {1346558400 -18000 1 -05}
    {1346558400 -18000 1 -06}
    {1367118000 -21600 0 -06}
    {1378612800 -18000 1 -05}
    {1378612800 -18000 1 -06}
    {1398567600 -21600 0 -06}
    {1410062400 -18000 1 -05}
    {1410062400 -18000 1 -06}
    {1463281200 -21600 0 -06}
    {1471147200 -18000 1 -05}
    {1471147200 -18000 1 -06}
    {1494730800 -21600 0 -06}
    {1502596800 -18000 1 -05}
    {1502596800 -18000 1 -06}
    {1526180400 -21600 0 -06}
    {1534046400 -18000 1 -05}
    {1557630000 -21600 0 -06}
    {1565496000 -18000 1 -05}
    {1589079600 -21600 0 -06}
    {1596945600 -18000 1 -05}
    {1620529200 -21600 0 -06}
    {1629000000 -18000 1 -05}
    {1652583600 -21600 0 -06}
    {1660449600 -18000 1 -05}
    {1684033200 -21600 0 -06}
    {1691899200 -18000 1 -05}
    {1715482800 -21600 0 -06}
    {1723348800 -18000 1 -05}
    {1746932400 -21600 0 -06}
    {1754798400 -18000 1 -05}
    {1778382000 -21600 0 -06}
    {1786248000 -18000 1 -05}
    {1809831600 -21600 0 -06}
    {1818302400 -18000 1 -05}
    {1534046400 -18000 1 -06}
    {1554606000 -21600 0 -06}
    {1567915200 -18000 1 -06}
    {1586055600 -21600 0 -06}
    {1599364800 -18000 1 -06}
    {1617505200 -21600 0 -06}
    {1630814400 -18000 1 -06}
    {1648954800 -21600 0 -06}
    {1662264000 -18000 1 -06}
    {1680404400 -21600 0 -06}
    {1693713600 -18000 1 -06}
    {1712458800 -21600 0 -06}
    {1725768000 -18000 1 -06}
    {1743908400 -21600 0 -06}
    {1757217600 -18000 1 -06}
    {1775358000 -21600 0 -06}
    {1788667200 -18000 1 -06}
    {1806807600 -21600 0 -06}
    {1820116800 -18000 1 -06}
    {1838257200 -21600 0 -06}
    {1851566400 -18000 1 -06}
    {1841886000 -21600 0 -06}
    {1849752000 -18000 1 -05}
    {1873335600 -21600 0 -06}
    {1881201600 -18000 1 -05}
    {1904785200 -21600 0 -06}
    {1912651200 -18000 1 -05}
    {1936234800 -21600 0 -06}
    {1944100800 -18000 1 -05}
    {1967684400 -21600 0 -06}
    {1976155200 -18000 1 -05}
    {1999738800 -21600 0 -06}
    {2007604800 -18000 1 -05}
    {2031188400 -21600 0 -06}
    {2039054400 -18000 1 -05}
    {2062638000 -21600 0 -06}
    {2070504000 -18000 1 -05}
    {2094087600 -21600 0 -06}
    {2101953600 -18000 1 -05}
    {2125537200 -21600 0 -06}
    {2133403200 -18000 1 -05}
    {2156986800 -21600 0 -06}
    {2165457600 -18000 1 -05}
    {2189041200 -21600 0 -06}
    {2196907200 -18000 1 -05}
    {2220490800 -21600 0 -06}
    {2228356800 -18000 1 -05}
    {2251940400 -21600 0 -06}
    {2259806400 -18000 1 -05}
    {2283390000 -21600 0 -06}
    {2291256000 -18000 1 -05}
    {2314839600 -21600 0 -06}
    {2322705600 -18000 1 -05}
    {2346894000 -21600 0 -06}
    {2354760000 -18000 1 -05}
    {2378343600 -21600 0 -06}
    {2386209600 -18000 1 -05}
    {2409793200 -21600 0 -06}
    {2417659200 -18000 1 -05}
    {2441242800 -21600 0 -06}
    {2449108800 -18000 1 -05}
    {2472692400 -21600 0 -06}
    {1870311600 -21600 0 -06}
    {1883016000 -18000 1 -06}
    {1901761200 -21600 0 -06}
    {1915070400 -18000 1 -06}
    {1933210800 -21600 0 -06}
    {1946520000 -18000 1 -06}
    {1964660400 -21600 0 -06}
    {1977969600 -18000 1 -06}
    {1996110000 -21600 0 -06}
    {2009419200 -18000 1 -06}
    {2027559600 -21600 0 -06}
    {2040868800 -18000 1 -06}
    {2059614000 -21600 0 -06}
    {2072318400 -18000 1 -06}
    {2091063600 -21600 0 -06}
    {2104372800 -18000 1 -06}
    {2122513200 -21600 0 -06}
    {2135822400 -18000 1 -06}
    {2153962800 -21600 0 -06}
    {2167272000 -18000 1 -06}
    {2185412400 -21600 0 -06}
    {2198721600 -18000 1 -06}
    {2217466800 -21600 0 -06}
    {2230171200 -18000 1 -06}
    {2248916400 -21600 0 -06}
    {2262225600 -18000 1 -06}
    {2280366000 -21600 0 -06}
    {2293675200 -18000 1 -06}
    {2311815600 -21600 0 -06}
    {2325124800 -18000 1 -06}
    {2343265200 -21600 0 -06}
    {2356574400 -18000 1 -06}
    {2374714800 -21600 0 -06}
    {2388024000 -18000 1 -06}
    {2406769200 -21600 0 -06}
    {2419473600 -18000 1 -06}
    {2438218800 -21600 0 -06}
    {2451528000 -18000 1 -06}
    {2469668400 -21600 0 -06}
    {2480558400 -18000 1 -05}
    {2504142000 -21600 0 -06}
    {2512612800 -18000 1 -05}
    {2536196400 -21600 0 -06}
    {2544062400 -18000 1 -05}
    {2567646000 -21600 0 -06}
    {2575512000 -18000 1 -05}
    {2599095600 -21600 0 -06}
    {2606961600 -18000 1 -05}
    {2630545200 -21600 0 -06}
    {2638411200 -18000 1 -05}
    {2661994800 -21600 0 -06}
    {2669860800 -18000 1 -05}
    {2693444400 -21600 0 -06}
    {2701915200 -18000 1 -05}
    {2725498800 -21600 0 -06}
    {2733364800 -18000 1 -05}
    {2756948400 -21600 0 -06}
    {2764814400 -18000 1 -05}
    {2788398000 -21600 0 -06}
    {2796264000 -18000 1 -05}
    {2819847600 -21600 0 -06}
    {2827713600 -18000 1 -05}
    {2851297200 -21600 0 -06}
    {2859768000 -18000 1 -05}
    {2883351600 -21600 0 -06}
    {2891217600 -18000 1 -05}
    {2914801200 -21600 0 -06}
    {2922667200 -18000 1 -05}
    {2946250800 -21600 0 -06}
    {2954116800 -18000 1 -05}
    {2977700400 -21600 0 -06}
    {2985566400 -18000 1 -05}
    {3009150000 -21600 0 -06}
    {3017016000 -18000 1 -05}
    {3040599600 -21600 0 -06}
    {3049070400 -18000 1 -05}
    {3072654000 -21600 0 -06}
    {3080520000 -18000 1 -05}
    {3104103600 -21600 0 -06}
    {3111969600 -18000 1 -05}
    {3135553200 -21600 0 -06}
    {3143419200 -18000 1 -05}
    {3167002800 -21600 0 -06}
    {3174868800 -18000 1 -05}
    {3198452400 -21600 0 -06}
    {3206318400 -18000 1 -05}
    {3230506800 -21600 0 -06}
    {3238372800 -18000 1 -05}
    {3261956400 -21600 0 -06}
    {3269822400 -18000 1 -05}
    {3293406000 -21600 0 -06}
    {3301272000 -18000 1 -05}
    {3324855600 -21600 0 -06}
    {3332721600 -18000 1 -05}
    {3356305200 -21600 0 -06}
    {3364171200 -18000 1 -05}
    {3387754800 -21600 0 -06}
    {3396225600 -18000 1 -05}
    {3419809200 -21600 0 -06}
    {3427675200 -18000 1 -05}
    {3451258800 -21600 0 -06}
    {3459124800 -18000 1 -05}
    {3482708400 -21600 0 -06}
    {3490574400 -18000 1 -05}
    {3514158000 -21600 0 -06}
    {3522024000 -18000 1 -05}
    {3545607600 -21600 0 -06}
    {3553473600 -18000 1 -05}
    {3577057200 -21600 0 -06}
    {3585528000 -18000 1 -05}
    {3609111600 -21600 0 -06}
    {3616977600 -18000 1 -05}
    {3640561200 -21600 0 -06}
    {3648427200 -18000 1 -05}
    {3672010800 -21600 0 -06}
    {3679876800 -18000 1 -05}
    {3703460400 -21600 0 -06}
    {3711326400 -18000 1 -05}
    {3734910000 -21600 0 -06}
    {3743380800 -18000 1 -05}
    {3766964400 -21600 0 -06}
    {3774830400 -18000 1 -05}
    {3798414000 -21600 0 -06}
    {3806280000 -18000 1 -05}
    {3829863600 -21600 0 -06}
    {3837729600 -18000 1 -05}
    {3861313200 -21600 0 -06}
    {3869179200 -18000 1 -05}
    {3892762800 -21600 0 -06}
    {3900628800 -18000 1 -05}
    {3924212400 -21600 0 -06}
    {3932683200 -18000 1 -05}
    {3956266800 -21600 0 -06}
    {3964132800 -18000 1 -05}
    {2482977600 -18000 1 -06}
    {2501118000 -21600 0 -06}
    {2514427200 -18000 1 -06}
    {2532567600 -21600 0 -06}
    {2545876800 -18000 1 -06}
    {2564017200 -21600 0 -06}
    {2577326400 -18000 1 -06}
    {2596071600 -21600 0 -06}
    {2609380800 -18000 1 -06}
    {2627521200 -21600 0 -06}
    {2640830400 -18000 1 -06}
    {2658970800 -21600 0 -06}
    {2672280000 -18000 1 -06}
    {2690420400 -21600 0 -06}
    {2703729600 -18000 1 -06}
    {2721870000 -21600 0 -06}
    {2735179200 -18000 1 -06}
    {2753924400 -21600 0 -06}
    {2766628800 -18000 1 -06}
    {2785374000 -21600 0 -06}
    {2798683200 -18000 1 -06}
    {2816823600 -21600 0 -06}
    {2830132800 -18000 1 -06}
    {2848273200 -21600 0 -06}
    {2861582400 -18000 1 -06}
    {2879722800 -21600 0 -06}
    {2893032000 -18000 1 -06}
    {2911172400 -21600 0 -06}
    {2924481600 -18000 1 -06}
    {2943226800 -21600 0 -06}
    {2955931200 -18000 1 -06}
    {2974676400 -21600 0 -06}
    {2987985600 -18000 1 -06}
    {3006126000 -21600 0 -06}
    {3019435200 -18000 1 -06}
    {3037575600 -21600 0 -06}
    {3050884800 -18000 1 -06}
    {3069025200 -21600 0 -06}
    {3082334400 -18000 1 -06}
    {3101079600 -21600 0 -06}
    {3113784000 -18000 1 -06}
    {3132529200 -21600 0 -06}
    {3145838400 -18000 1 -06}
    {3163978800 -21600 0 -06}
    {3177288000 -18000 1 -06}
    {3195428400 -21600 0 -06}
    {3208737600 -18000 1 -06}
    {3226878000 -21600 0 -06}
    {3240187200 -18000 1 -06}
    {3258327600 -21600 0 -06}
    {3271636800 -18000 1 -06}
    {3290382000 -21600 0 -06}
    {3303086400 -18000 1 -06}
    {3321831600 -21600 0 -06}
    {3335140800 -18000 1 -06}
    {3353281200 -21600 0 -06}
    {3366590400 -18000 1 -06}
    {3384730800 -21600 0 -06}
    {3398040000 -18000 1 -06}
    {3416180400 -21600 0 -06}
    {3429489600 -18000 1 -06}
    {3447630000 -21600 0 -06}
    {3460939200 -18000 1 -06}
    {3479684400 -21600 0 -06}
    {3492993600 -18000 1 -06}
    {3511134000 -21600 0 -06}
    {3524443200 -18000 1 -06}
    {3542583600 -21600 0 -06}
    {3555892800 -18000 1 -06}
    {3574033200 -21600 0 -06}
    {3587342400 -18000 1 -06}
    {3605482800 -21600 0 -06}
    {3618792000 -18000 1 -06}
    {3637537200 -21600 0 -06}
    {3650241600 -18000 1 -06}
    {3668986800 -21600 0 -06}
    {3682296000 -18000 1 -06}
    {3700436400 -21600 0 -06}
    {3713745600 -18000 1 -06}
    {3731886000 -21600 0 -06}
    {3745195200 -18000 1 -06}
    {3763335600 -21600 0 -06}
    {3776644800 -18000 1 -06}
    {3794785200 -21600 0 -06}
    {3808094400 -18000 1 -06}
    {3826839600 -21600 0 -06}
    {3839544000 -18000 1 -06}
    {3858289200 -21600 0 -06}
    {3871598400 -18000 1 -06}
    {3889738800 -21600 0 -06}
    {3903048000 -18000 1 -06}
    {3921188400 -21600 0 -06}
    {3934497600 -18000 1 -06}
    {3952638000 -21600 0 -06}
    {3965947200 -18000 1 -06}
    {3984692400 -21600 0 -06}
    {3997396800 -18000 1 -06}
    {4016142000 -21600 0 -06}
    {4029451200 -18000 1 -06}
    {3987716400 -21600 0 -06}
    {3995582400 -18000 1 -05}
    {4019166000 -21600 0 -06}
    {4027032000 -18000 1 -05}
    {4050615600 -21600 0 -06}
    {4058481600 -18000 1 -05}
    {4082065200 -21600 0 -06}
    {4089931200 -18000 1 -05}
    {4047591600 -21600 0 -06}
    {4060900800 -18000 1 -06}
    {4079041200 -21600 0 -06}
    {4092350400 -18000 1 -06}
}

Changes to library/tzdata/Pacific/Efate.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25
26





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Efate) {
    {-9223372036854775808 40396 0 LMT}
    {-1829387596 39600 0 +11}
    {433256400 43200 1 +12}
    {433256400 43200 1 +11}
    {448977600 39600 0 +11}
    {467298000 43200 1 +12}
    {467298000 43200 1 +11}
    {480427200 39600 0 +11}
    {496760400 43200 1 +12}
    {496760400 43200 1 +11}
    {511876800 39600 0 +11}
    {528210000 43200 1 +12}
    {528210000 43200 1 +11}
    {543931200 39600 0 +11}
    {559659600 43200 1 +12}
    {559659600 43200 1 +11}
    {575380800 39600 0 +11}
    {591109200 43200 1 +12}
    {591109200 43200 1 +11}
    {606830400 39600 0 +11}
    {622558800 43200 1 +12}
    {622558800 43200 1 +11}
    {638280000 39600 0 +11}
    {654008400 43200 1 +12}
    {654008400 43200 1 +11}
    {669729600 39600 0 +11}
    {686062800 43200 1 +12}
    {686062800 43200 1 +11}
    {696340800 39600 0 +11}
    {719931600 43200 1 +12}
    {719931600 43200 1 +11}
    {727790400 39600 0 +11}
}

Changes to library/tzdata/Pacific/Enderbury.

1
2
3
4
5
6
7

8
1
2
3
4
5
6

7
8






-
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Enderbury) {
    {-9223372036854775808 -41060 0 LMT}
    {-2177411740 -43200 0 -12}
    {307627200 -39600 0 -11}
    {788958000 46800 0 +13}
    {788871600 46800 0 +13}
}

Changes to library/tzdata/Pacific/Fiji.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28
29
30



31
32

33
34

35
36

37
38

39
40

41
42

43
44

45
46

47
48

49
50
51
52



53
54

55
56

57
58

59
60

61
62
63
64



65
66

67
68

69
70

71
72
73
74



75
76

77
78

79
80

81
82

83
84
85
86



87
88

89
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
128
129
130



131
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

161
162
163
164



165
166

167
168

169
170

171
172

173
174
175
176



177
178

179
180

181
182

183
184
185
186



187
188

189
190

191
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27



28
29
30
31

32
33

34
35

36
37

38
39

40
41

42
43

44
45

46
47

48
49



50
51
52
53

54
55

56
57

58
59

60
61



62
63
64
65

66
67

68
69

70
71



72
73
74
75

76
77

78
79

80
81

82
83



84
85
86
87

88
89

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



128
129
130
131

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
161



162
163
164
165

166
167

168
169

170
171

172
173



174
175
176
177

178
179

180
181

182
183



184
185
186
187

188
189

190
191





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+

-
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Fiji) {
    {-9223372036854775808 42944 0 LMT}
    {-1709985344 43200 0 +12}
    {909842400 46800 1 +13}
    {909842400 46800 1 +12}
    {920124000 43200 0 +12}
    {941896800 46800 1 +13}
    {941896800 46800 1 +12}
    {951573600 43200 0 +12}
    {1259416800 46800 1 +13}
    {1259416800 46800 1 +12}
    {1269698400 43200 0 +12}
    {1287842400 46800 1 +13}
    {1287842400 46800 1 +12}
    {1299333600 43200 0 +12}
    {1319292000 46800 1 +13}
    {1319292000 46800 1 +12}
    {1327154400 43200 0 +12}
    {1350741600 46800 1 +13}
    {1350741600 46800 1 +12}
    {1358604000 43200 0 +12}
    {1382796000 46800 1 +13}
    {1382796000 46800 1 +12}
    {1390050000 43200 0 +12}
    {1414850400 46800 1 +13}
    {1414850400 46800 1 +12}
    {1421503200 43200 0 +12}
    {1446300000 46800 1 +13}
    {1446300000 46800 1 +12}
    {1452952800 43200 0 +12}
    {1478354400 46800 1 +13}
    {1478354400 46800 1 +12}
    {1484402400 43200 0 +12}
    {1509804000 46800 1 +13}
    {1509804000 46800 1 +12}
    {1515852000 43200 0 +12}
    {1541253600 46800 1 +13}
    {1547906400 43200 0 +12}
    {1572703200 46800 1 +13}
    {1541253600 46800 1 +12}
    {1547301600 43200 0 +12}
    {1572703200 46800 1 +12}
    {1579356000 43200 0 +12}
    {1604152800 46800 1 +13}
    {1604152800 46800 1 +12}
    {1610805600 43200 0 +12}
    {1636207200 46800 1 +13}
    {1636207200 46800 1 +12}
    {1642255200 43200 0 +12}
    {1667656800 46800 1 +13}
    {1667656800 46800 1 +12}
    {1673704800 43200 0 +12}
    {1699106400 46800 1 +13}
    {1699106400 46800 1 +12}
    {1705154400 43200 0 +12}
    {1730556000 46800 1 +13}
    {1730556000 46800 1 +12}
    {1737208800 43200 0 +12}
    {1762005600 46800 1 +13}
    {1762005600 46800 1 +12}
    {1768658400 43200 0 +12}
    {1793455200 46800 1 +13}
    {1793455200 46800 1 +12}
    {1800108000 43200 0 +12}
    {1825509600 46800 1 +13}
    {1825509600 46800 1 +12}
    {1831557600 43200 0 +12}
    {1856959200 46800 1 +13}
    {1856959200 46800 1 +12}
    {1863007200 43200 0 +12}
    {1888408800 46800 1 +13}
    {1895061600 43200 0 +12}
    {1919858400 46800 1 +13}
    {1888408800 46800 1 +12}
    {1894456800 43200 0 +12}
    {1919858400 46800 1 +12}
    {1926511200 43200 0 +12}
    {1951308000 46800 1 +13}
    {1951308000 46800 1 +12}
    {1957960800 43200 0 +12}
    {1983362400 46800 1 +13}
    {1983362400 46800 1 +12}
    {1989410400 43200 0 +12}
    {2014812000 46800 1 +13}
    {2014812000 46800 1 +12}
    {2020860000 43200 0 +12}
    {2046261600 46800 1 +13}
    {2046261600 46800 1 +12}
    {2052309600 43200 0 +12}
    {2077711200 46800 1 +13}
    {2084364000 43200 0 +12}
    {2109160800 46800 1 +13}
    {2077711200 46800 1 +12}
    {2083759200 43200 0 +12}
    {2109160800 46800 1 +12}
    {2115813600 43200 0 +12}
    {2140610400 46800 1 +13}
    {2140610400 46800 1 +12}
    {2147263200 43200 0 +12}
    {2172664800 46800 1 +13}
    {2172664800 46800 1 +12}
    {2178712800 43200 0 +12}
    {2204114400 46800 1 +13}
    {2204114400 46800 1 +12}
    {2210162400 43200 0 +12}
    {2235564000 46800 1 +13}
    {2242216800 43200 0 +12}
    {2267013600 46800 1 +13}
    {2235564000 46800 1 +12}
    {2241612000 43200 0 +12}
    {2267013600 46800 1 +12}
    {2273666400 43200 0 +12}
    {2298463200 46800 1 +13}
    {2298463200 46800 1 +12}
    {2305116000 43200 0 +12}
    {2329912800 46800 1 +13}
    {2329912800 46800 1 +12}
    {2336565600 43200 0 +12}
    {2361967200 46800 1 +13}
    {2361967200 46800 1 +12}
    {2368015200 43200 0 +12}
    {2393416800 46800 1 +13}
    {2393416800 46800 1 +12}
    {2399464800 43200 0 +12}
    {2424866400 46800 1 +13}
    {2431519200 43200 0 +12}
    {2456316000 46800 1 +13}
    {2424866400 46800 1 +12}
    {2430914400 43200 0 +12}
    {2456316000 46800 1 +12}
    {2462968800 43200 0 +12}
    {2487765600 46800 1 +13}
    {2487765600 46800 1 +12}
    {2494418400 43200 0 +12}
    {2519820000 46800 1 +13}
    {2519820000 46800 1 +12}
    {2525868000 43200 0 +12}
    {2551269600 46800 1 +13}
    {2551269600 46800 1 +12}
    {2557317600 43200 0 +12}
    {2582719200 46800 1 +13}
    {2582719200 46800 1 +12}
    {2588767200 43200 0 +12}
    {2614168800 46800 1 +13}
    {2614168800 46800 1 +12}
    {2620821600 43200 0 +12}
    {2645618400 46800 1 +13}
    {2645618400 46800 1 +12}
    {2652271200 43200 0 +12}
    {2677068000 46800 1 +13}
    {2677068000 46800 1 +12}
    {2683720800 43200 0 +12}
    {2709122400 46800 1 +13}
    {2709122400 46800 1 +12}
    {2715170400 43200 0 +12}
    {2740572000 46800 1 +13}
    {2740572000 46800 1 +12}
    {2746620000 43200 0 +12}
    {2772021600 46800 1 +13}
    {2778674400 43200 0 +12}
    {2803471200 46800 1 +13}
    {2772021600 46800 1 +12}
    {2778069600 43200 0 +12}
    {2803471200 46800 1 +12}
    {2810124000 43200 0 +12}
    {2834920800 46800 1 +13}
    {2834920800 46800 1 +12}
    {2841573600 43200 0 +12}
    {2866975200 46800 1 +13}
    {2866975200 46800 1 +12}
    {2873023200 43200 0 +12}
    {2898424800 46800 1 +13}
    {2898424800 46800 1 +12}
    {2904472800 43200 0 +12}
    {2929874400 46800 1 +13}
    {2929874400 46800 1 +12}
    {2935922400 43200 0 +12}
    {2961324000 46800 1 +13}
    {2967976800 43200 0 +12}
    {2992773600 46800 1 +13}
    {2961324000 46800 1 +12}
    {2967372000 43200 0 +12}
    {2992773600 46800 1 +12}
    {2999426400 43200 0 +12}
    {3024223200 46800 1 +13}
    {3024223200 46800 1 +12}
    {3030876000 43200 0 +12}
    {3056277600 46800 1 +13}
    {3056277600 46800 1 +12}
    {3062325600 43200 0 +12}
    {3087727200 46800 1 +13}
    {3087727200 46800 1 +12}
    {3093775200 43200 0 +12}
    {3119176800 46800 1 +13}
    {3125829600 43200 0 +12}
    {3150626400 46800 1 +13}
    {3119176800 46800 1 +12}
    {3125224800 43200 0 +12}
    {3150626400 46800 1 +12}
    {3157279200 43200 0 +12}
    {3182076000 46800 1 +13}
    {3182076000 46800 1 +12}
    {3188728800 43200 0 +12}
    {3213525600 46800 1 +13}
    {3213525600 46800 1 +12}
    {3220178400 43200 0 +12}
    {3245580000 46800 1 +13}
    {3245580000 46800 1 +12}
    {3251628000 43200 0 +12}
    {3277029600 46800 1 +13}
    {3277029600 46800 1 +12}
    {3283077600 43200 0 +12}
    {3308479200 46800 1 +13}
    {3315132000 43200 0 +12}
    {3339928800 46800 1 +13}
    {3308479200 46800 1 +12}
    {3314527200 43200 0 +12}
    {3339928800 46800 1 +12}
    {3346581600 43200 0 +12}
    {3371378400 46800 1 +13}
    {3371378400 46800 1 +12}
    {3378031200 43200 0 +12}
    {3403432800 46800 1 +13}
    {3403432800 46800 1 +12}
    {3409480800 43200 0 +12}
    {3434882400 46800 1 +13}
    {3434882400 46800 1 +12}
    {3440930400 43200 0 +12}
    {3466332000 46800 1 +13}
    {3466332000 46800 1 +12}
    {3472380000 43200 0 +12}
    {3497781600 46800 1 +13}
    {3497781600 46800 1 +12}
    {3504434400 43200 0 +12}
    {3529231200 46800 1 +13}
    {3529231200 46800 1 +12}
    {3535884000 43200 0 +12}
    {3560680800 46800 1 +13}
    {3560680800 46800 1 +12}
    {3567333600 43200 0 +12}
    {3592735200 46800 1 +13}
    {3592735200 46800 1 +12}
    {3598783200 43200 0 +12}
    {3624184800 46800 1 +13}
    {3624184800 46800 1 +12}
    {3630232800 43200 0 +12}
    {3655634400 46800 1 +13}
    {3662287200 43200 0 +12}
    {3687084000 46800 1 +13}
    {3655634400 46800 1 +12}
    {3661682400 43200 0 +12}
    {3687084000 46800 1 +12}
    {3693736800 43200 0 +12}
    {3718533600 46800 1 +13}
    {3718533600 46800 1 +12}
    {3725186400 43200 0 +12}
    {3750588000 46800 1 +13}
    {3750588000 46800 1 +12}
    {3756636000 43200 0 +12}
    {3782037600 46800 1 +13}
    {3782037600 46800 1 +12}
    {3788085600 43200 0 +12}
    {3813487200 46800 1 +13}
    {3813487200 46800 1 +12}
    {3819535200 43200 0 +12}
    {3844936800 46800 1 +13}
    {3851589600 43200 0 +12}
    {3876386400 46800 1 +13}
    {3844936800 46800 1 +12}
    {3850984800 43200 0 +12}
    {3876386400 46800 1 +12}
    {3883039200 43200 0 +12}
    {3907836000 46800 1 +13}
    {3907836000 46800 1 +12}
    {3914488800 43200 0 +12}
    {3939890400 46800 1 +13}
    {3939890400 46800 1 +12}
    {3945938400 43200 0 +12}
    {3971340000 46800 1 +13}
    {3971340000 46800 1 +12}
    {3977388000 43200 0 +12}
    {4002789600 46800 1 +13}
    {4009442400 43200 0 +12}
    {4034239200 46800 1 +13}
    {4002789600 46800 1 +12}
    {4008837600 43200 0 +12}
    {4034239200 46800 1 +12}
    {4040892000 43200 0 +12}
    {4065688800 46800 1 +13}
    {4065688800 46800 1 +12}
    {4072341600 43200 0 +12}
    {4097138400 46800 1 +13}
    {4097138400 46800 1 +12}
}

Changes to library/tzdata/Pacific/Galapagos.

1
2
3
4
5
6
7

8
9
1
2
3
4
5
6

7
8
9






-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Galapagos) {
    {-9223372036854775808 -21504 0 LMT}
    {-1230746496 -18000 0 -05}
    {504939600 -21600 0 -06}
    {722930400 -18000 1 -05}
    {722930400 -18000 1 -06}
    {728888400 -21600 0 -06}
}

Changes to library/tzdata/Pacific/Honolulu.

1
2
3
4
5
6
7
8



9
10
11
1
2
3
4
5
6


7
8
9
10
11
12






-
-
+
+
+



# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Honolulu) {
    {-9223372036854775808 -37886 0 LMT}
    {-2334101314 -37800 0 HST}
    {-1157283000 -34200 1 HDT}
    {-1155436200 -37800 0 HST}
    {-880198200 -34200 1 HDT}
    {-1155436200 -34200 0 HST}
    {-880201800 -34200 1 HWT}
    {-769395600 -34200 1 HPT}
    {-765376200 -37800 0 HST}
    {-712150200 -36000 0 HST}
}

Changes to library/tzdata/Pacific/Kiritimati.

1
2
3
4
5
6
7

8
1
2
3
4
5
6

7
8






-
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Kiritimati) {
    {-9223372036854775808 -37760 0 LMT}
    {-2177415040 -38400 0 -1040}
    {307622400 -36000 0 -10}
    {788954400 50400 0 +14}
    {788868000 50400 0 +14}
}

Changes to library/tzdata/Pacific/Noumea.

1
2
3
4
5
6

7
8

9
10

11
12
1
2
3
4
5

6
7

8
9

10
11
12





-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Noumea) {
    {-9223372036854775808 39948 0 LMT}
    {-1829387148 39600 0 +11}
    {250002000 43200 1 +12}
    {250002000 43200 1 +11}
    {257342400 39600 0 +11}
    {281451600 43200 1 +12}
    {281451600 43200 1 +11}
    {288878400 39600 0 +11}
    {849366000 43200 1 +12}
    {849366000 43200 1 +11}
    {857228400 39600 0 +11}
}

Changes to library/tzdata/Pacific/Rarotonga.

1
2
3
4
5
6

7
8

9
10

11
12

13
14

15
16

17
18

19
20

21
22

23
24

25
26

27
28

29
30

31
32
1
2
3
4
5

6
7

8
9

10
11

12
13

14
15

16
17

18
19

20
21

22
23

24
25

26
27

28
29

30
31
32





-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Rarotonga) {
    {-9223372036854775808 -38344 0 LMT}
    {-2177414456 -37800 0 -1030}
    {279714600 -34200 0 -0930}
    {279714600 -34200 0 -10}
    {289387800 -36000 0 -10}
    {309952800 -34200 1 -0930}
    {309952800 -34200 1 -10}
    {320837400 -36000 0 -10}
    {341402400 -34200 1 -0930}
    {341402400 -34200 1 -10}
    {352287000 -36000 0 -10}
    {372852000 -34200 1 -0930}
    {372852000 -34200 1 -10}
    {384341400 -36000 0 -10}
    {404906400 -34200 1 -0930}
    {404906400 -34200 1 -10}
    {415791000 -36000 0 -10}
    {436356000 -34200 1 -0930}
    {436356000 -34200 1 -10}
    {447240600 -36000 0 -10}
    {467805600 -34200 1 -0930}
    {467805600 -34200 1 -10}
    {478690200 -36000 0 -10}
    {499255200 -34200 1 -0930}
    {499255200 -34200 1 -10}
    {510139800 -36000 0 -10}
    {530704800 -34200 1 -0930}
    {530704800 -34200 1 -10}
    {541589400 -36000 0 -10}
    {562154400 -34200 1 -0930}
    {562154400 -34200 1 -10}
    {573643800 -36000 0 -10}
    {594208800 -34200 1 -0930}
    {594208800 -34200 1 -10}
    {605093400 -36000 0 -10}
    {625658400 -34200 1 -0930}
    {625658400 -34200 1 -10}
    {636543000 -36000 0 -10}
    {657108000 -34200 1 -0930}
    {657108000 -34200 1 -10}
    {667992600 -36000 0 -10}
}

Changes to library/tzdata/Pacific/Tongatapu.

1
2
3
4
5
6
7
8

9
10

11
12

13
14

15
16
1
2
3
4
5
6
7

8
9

10
11

12
13

14
15
16







-
+

-
+

-
+

-
+


# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Tongatapu) {
    {-9223372036854775808 44360 0 LMT}
    {-2177497160 44400 0 +1220}
    {-915193200 46800 0 +13}
    {915102000 46800 0 +13}
    {939214800 50400 1 +14}
    {939214800 50400 1 +13}
    {953384400 46800 0 +13}
    {973342800 50400 1 +14}
    {973342800 50400 1 +13}
    {980596800 46800 0 +13}
    {1004792400 50400 1 +14}
    {1004792400 50400 1 +13}
    {1012046400 46800 0 +13}
    {1478350800 50400 1 +14}
    {1478350800 50400 1 +13}
    {1484398800 46800 0 +13}
}

Changes to libtommath/README.md.







1

2
3

4

5


6
7
8
9
10
11


12
13
14
15
1
2
3
4
5
6

7
8

9
10
11

12
13
14
15
16
17
18
19
20
21
22
23
24
25
+
+
+
+
+
+
-
+

-
+

+
-
+
+






+
+




# libtommath

This is the git repository for [LibTomMath](http://www.libtom.net/LibTomMath/), a free open source portable number theoretic multiple-precision integer (MPI) library written entirely in C.

## Build Status

[![Build Status - master](https://travis-ci.org/libtom/libtommath.png?branch=master)](https://travis-ci.org/libtom/libtommath)
master: [![Build Status](https://api.travis-ci.org/libtom/libtommath.png?branch=master)](https://travis-ci.org/libtom/libtommath)

[![Build Status - develop](https://travis-ci.org/libtom/libtommath.png?branch=develop)](https://travis-ci.org/libtom/libtommath)
develop: [![Build Status](https://api.travis-ci.org/libtom/libtommath.png?branch=develop)](https://travis-ci.org/libtom/libtommath)

API/ABI changes: [check here](https://abi-laboratory.pro/tracker/timeline/libtommath/)
This is the git repository for [LibTomMath](http://www.libtom.org/), a free open source portable number theoretic multiple-precision integer (MPI) library written entirely in C.

## Summary

The `develop` branch contains the in-development version. Stable releases are tagged.

Documentation is built from the LaTeX file `bn.tex`. There is also limited documentation in `tommath.h`. There is also a document, `tommath.pdf`, which describes the goals of the project and many of the algorithms used.

The project can be build by using `make`. Along with the usual `make`, `make clean` and `make install`, there are several other build targets, see the makefile for details. There are also makefiles for certain specific platforms.

## Testing

Tests are located in `demo/` and can be built in two flavors.
* `make test` creates a test binary that is intended to be run against `mtest`. `mtest` can be built with `make mtest` and test execution is done like `./mtest/mtest | ./test`. `mtest` is creating test vectors using an alternative MPI library and `test` is consuming these vectors to verify correct behavior of ltm
* `make test_standalone` creates a stand-alone test binary that executes several test routines.

Changes to libtommath/bn_error.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

31
32
33

34
35
36
37
38
39
40

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30

31
32
33
34
35
36
37
38
-
+












-
-














-
+


-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_ERROR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

static const struct {
   int code;
   const char *msg;
} msgs[] = {
   { MP_OKAY, "Successful" },
   { MP_MEM,  "Out of heap" },
   { MP_VAL,  "Value out of range" }
};

/* return a char * string for a given code */
const char *mp_error_to_string(int code)
{
   int x;
   size_t x;

   /* scan the lookup table for the given message */
   for (x = 0; x < (int)(sizeof(msgs) / sizeof(msgs[0])); x++) {
   for (x = 0; x < (sizeof(msgs) / sizeof(msgs[0])); x++) {
      if (msgs[x].code == code) {
         return msgs[x].msg;
      }
   }

   /* generic reply for invalid code */
   return "Invalid error code";

Changes to libtommath/bn_fast_mp_invmod.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_FAST_MP_INVMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* computes the modular inverse via binary extended euclidean algorithm,
 * that is c = 1/a mod b
 *
 * Based on slow invmod except this is optimized for the case where b is
 * odd as per HAC Note 14.64 on pp. 610
41
42
43
44
45
46
47






48
49
50
51
52
53
54
55
56

57
58
59
60
61
62
63
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
67







+
+
+
+
+
+








-
+







      goto LBL_ERR;
   }

   /* we need y = |a| */
   if ((res = mp_mod(a, b, &y)) != MP_OKAY) {
      goto LBL_ERR;
   }

   /* if one of x,y is zero return an error! */
   if ((mp_iszero(&x) == MP_YES) || (mp_iszero(&y) == MP_YES)) {
      res = MP_VAL;
      goto LBL_ERR;
   }

   /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */
   if ((res = mp_copy(&x, &u)) != MP_OKAY) {
      goto LBL_ERR;
   }
   if ((res = mp_copy(&y, &v)) != MP_OKAY) {
      goto LBL_ERR;
   }
   mp_set(&D, 1);
   mp_set(&D, 1uL);

top:
   /* 4.  while u is even do */
   while (mp_iseven(&u) == MP_YES) {
      /* 4.1 u = u/2 */
      if ((res = mp_div_2(&u, &u)) != MP_OKAY) {
         goto LBL_ERR;
118
119
120
121
122
123
124
125

126
127
128
129
130
131
132
133
134
135
136








137
138
139
140
141
142
143
144
145
146
147
148
149
122
123
124
125
126
127
128

129
130
131
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
161







-
+











+
+
+
+
+
+
+
+













   if (mp_iszero(&u) == MP_NO) {
      goto top;
   }

   /* now a = C, b = D, gcd == g*v */

   /* if v != 1 then there is no inverse */
   if (mp_cmp_d(&v, 1) != MP_EQ) {
   if (mp_cmp_d(&v, 1uL) != MP_EQ) {
      res = MP_VAL;
      goto LBL_ERR;
   }

   /* b is now the inverse */
   neg = a->sign;
   while (D.sign == MP_NEG) {
      if ((res = mp_add(&D, b, &D)) != MP_OKAY) {
         goto LBL_ERR;
      }
   }

   /* too big */
   while (mp_cmp_mag(&D, b) != MP_LT) {
      if ((res = mp_sub(&D, b, &D)) != MP_OKAY) {
         goto LBL_ERR;
      }
   }

   mp_exch(&D, c);
   c->sign = neg;
   res = MP_OKAY;

LBL_ERR:
   mp_clear_multi(&x, &y, &u, &v, &B, &D, NULL);
   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_fast_mp_montgomery_reduce.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29




30
31
32
33
34
35
36

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
-
+












-
-














+
+
+
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* computes xR**-1 == x (mod N) via Montgomery Reduction
 *
 * This is an optimized implementation of montgomery_reduce
 * which uses the comba method to quickly calculate the columns of the
 * reduction.
 *
 * Based on Algorithm 14.32 on pp.601 of HAC.
*/
int fast_mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho)
{
   int     ix, res, olduse;
   mp_word W[MP_WARRAY];

   if (x->used > (int)MP_WARRAY) {
      return MP_VAL;
   }

   /* get old used count */
   olduse = x->used;

   /* grow a as required */
   if (x->alloc < (n->used + 1)) {
      if ((res = mp_grow(x, n->used + 1)) != MP_OKAY) {
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
71
72
73
74
75
76
77

78
79
80
81
82
83
84
85







-
+







      /* mu = ai * m' mod b
       *
       * We avoid a double precision multiplication (which isn't required)
       * by casting the value down to a mp_digit.  Note this requires
       * that W[ix-1] have  the carry cleared (see after the inner loop)
       */
      mp_digit mu;
      mu = (mp_digit)(((W[ix] & MP_MASK) * rho) & MP_MASK);
      mu = ((W[ix] & MP_MASK) * rho) & MP_MASK;

      /* a = a + mu * m * b**i
       *
       * This is computed in place and on the fly.  The multiplication
       * by b**i is handled by offseting which columns the results
       * are added to.
       *
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
128
129
130

131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147

148
149
150
151
152
153
154
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
128
129
130
131

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







-
+




-
+



















-
+
















-
+







         tmpn = n->dp;

         /* Alias for the columns set by an offset of ix */
         _W = W + ix;

         /* inner loop */
         for (iy = 0; iy < n->used; iy++) {
            *_W++ += ((mp_word)mu) * ((mp_word)*tmpn++);
            *_W++ += (mp_word)mu * (mp_word)*tmpn++;
         }
      }

      /* now fix carry for next digit, W[ix+1] */
      W[ix + 1] += W[ix] >> ((mp_word) DIGIT_BIT);
      W[ix + 1] += W[ix] >> (mp_word)DIGIT_BIT;
   }

   /* now we have to propagate the carries and
    * shift the words downward [all those least
    * significant digits we zeroed].
    */
   {
      mp_digit *tmpx;
      mp_word *_W, *_W1;

      /* nox fix rest of carries */

      /* alias for current word */
      _W1 = W + ix;

      /* alias for next word, where the carry goes */
      _W = W + ++ix;

      for (; ix <= ((n->used * 2) + 1); ix++) {
         *_W++ += *_W1++ >> ((mp_word) DIGIT_BIT);
         *_W++ += *_W1++ >> (mp_word)DIGIT_BIT;
      }

      /* copy out, A = A/b**n
       *
       * The result is A/b**n but instead of converting from an
       * array of mp_word to mp_digit than calling mp_rshd
       * we just copy them in the right order
       */

      /* alias for destination word */
      tmpx = x->dp;

      /* alias for shifted double precision result */
      _W = W + n->used;

      for (ix = 0; ix < (n->used + 1); ix++) {
         *tmpx++ = (mp_digit)(*_W++ & ((mp_word) MP_MASK));
         *tmpx++ = *_W++ & (mp_word)MP_MASK;
      }

      /* zero oldused digits, if the input a was larger than
       * m->used+1 we'll have to clear the digits
       */
      for (; ix < olduse; ix++) {
         *tmpx++ = 0;

Changes to libtommath/bn_fast_s_mp_mul_digs.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_FAST_S_MP_MUL_DIGS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* Fast (comba) multiplier
 *
 * This is the fast column-array [comba] multiplier.  It is
 * designed to compute the columns of the product first
 * then handle the carries afterwards.  This has the effect
65
66
67
68
69
70
71
72

73
74
75
76
77

78
79
80

81
82
83
84
85
86
87
88
89
90

91
92
93
94
95
96
97
63
64
65
66
67
68
69

70
71
72
73
74

75
76
77

78
79
80
81
82
83
84
85
86
87

88
89
90
91
92
93
94
95







-
+




-
+


-
+









-
+







      /* this is the number of times the loop will iterrate, essentially
         while (tx++ < a->used && ty-- >= 0) { ... }
       */
      iy = MIN(a->used-tx, ty+1);

      /* execute loop */
      for (iz = 0; iz < iy; ++iz) {
         _W += ((mp_word)*tmpx++)*((mp_word)*tmpy--);
         _W += (mp_word)*tmpx++ * (mp_word)*tmpy--;

      }

      /* store term */
      W[ix] = ((mp_digit)_W) & MP_MASK;
      W[ix] = (mp_digit)_W & MP_MASK;

      /* make next carry */
      _W = _W >> ((mp_word)DIGIT_BIT);
      _W = _W >> (mp_word)DIGIT_BIT;
   }

   /* setup dest */
   olduse  = c->used;
   c->used = pa;

   {
      mp_digit *tmpc;
      tmpc = c->dp;
      for (ix = 0; ix < (pa + 1); ix++) {
      for (ix = 0; ix < pa; ix++) {
         /* now extract the previous digit [below the carry] */
         *tmpc++ = W[ix];
      }

      /* clear unused digits [that existed in the old copy of c] */
      for (; ix < olduse; ix++) {
         *tmpc++ = 0;

Changes to libtommath/bn_fast_s_mp_mul_high_digs.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* this is a modified version of fast_s_mul_digs that only produces
 * output digits *above* digs.  See the comments for fast_s_mul_digs
 * to see how it works.
 *
 * This is used in the Barrett reduction since for one of the multiplications
56
57
58
59
60
61
62
63

64
65
66
67

68
69
70

71
72
73
74
75
76
77
54
55
56
57
58
59
60

61
62
63
64

65
66
67

68
69
70
71
72
73
74
75







-
+



-
+


-
+







      /* this is the number of times the loop will iterrate, essentially its
         while (tx++ < a->used && ty-- >= 0) { ... }
       */
      iy = MIN(a->used-tx, ty+1);

      /* execute loop */
      for (iz = 0; iz < iy; iz++) {
         _W += ((mp_word)*tmpx++)*((mp_word)*tmpy--);
         _W += (mp_word)*tmpx++ * (mp_word)*tmpy--;
      }

      /* store term */
      W[ix] = ((mp_digit)_W) & MP_MASK;
      W[ix] = (mp_digit)_W & MP_MASK;

      /* make next carry */
      _W = _W >> ((mp_word)DIGIT_BIT);
      _W = _W >> (mp_word)DIGIT_BIT;
   }

   /* setup dest */
   olduse  = c->used;
   c->used = pa;

   {

Changes to libtommath/bn_fast_s_mp_sqr.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_FAST_S_MP_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* the jist of squaring...
 * you do like mult except the offset of the tmpx [one that
 * starts closer to zero] can't equal the offset of tmpy.
 * So basically you set up iy like before then you min it with
 * (ty-tx) so that it never happens.  You double all those
66
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81


82
83
84
85

86
87
88

89
90
91
92
93
94
95
64
65
66
67
68
69
70

71
72
73
74
75
76
77


78
79
80
81
82

83
84
85

86
87
88
89
90
91
92
93







-
+






-
-
+
+



-
+


-
+







       * we halve the distance since they approach at a rate of 2x
       * and we have to round because odd cases need to be executed
       */
      iy = MIN(iy, ((ty-tx)+1)>>1);

      /* execute loop */
      for (iz = 0; iz < iy; iz++) {
         _W += ((mp_word)*tmpx++)*((mp_word)*tmpy--);
         _W += (mp_word)*tmpx++ * (mp_word)*tmpy--;
      }

      /* double the inner product and add carry */
      _W = _W + _W + W1;

      /* even columns have the square term in them */
      if ((ix&1) == 0) {
         _W += ((mp_word)a->dp[ix>>1])*((mp_word)a->dp[ix>>1]);
      if (((unsigned)ix & 1u) == 0u) {
         _W += (mp_word)a->dp[ix>>1] * (mp_word)a->dp[ix>>1];
      }

      /* store it */
      W[ix] = (mp_digit)(_W & MP_MASK);
      W[ix] = _W & MP_MASK;

      /* make next carry */
      W1 = _W >> ((mp_word)DIGIT_BIT);
      W1 = _W >> (mp_word)DIGIT_BIT;
   }

   /* setup dest */
   olduse  = b->used;
   b->used = a->used+a->used;

   {

Changes to libtommath/bn_mp_2expt.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_2EXPT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* computes a = 2**b
 *
 * Simple algorithm which zeroes the int, grows it then just sets one bit
 * as required.
 */
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
45







-
+








      return res;
   }

   /* set the used count of where the bit will go */
   a->used = (b / DIGIT_BIT) + 1;

   /* put the single bit in its place */
   a->dp[b / DIGIT_BIT] = ((mp_digit)1) << (b % DIGIT_BIT);
   a->dp[b / DIGIT_BIT] = (mp_digit)1 << (mp_digit)(b % DIGIT_BIT);

   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_abs.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_ABS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* b = |a|
 *
 * Simple function copies the input and fixes the sign to positive
 */
int mp_abs(const mp_int *a, mp_int *b)

Changes to libtommath/bn_mp_add.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_ADD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* high level addition (handles signs) */
int mp_add(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     sa, sb, res;

Changes to libtommath/bn_mp_add_d.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_ADD_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* single digit addition */
int mp_add_d(const mp_int *a, mp_digit b, mp_int *c)
{
   int     res, ix, oldused;
   mp_digit *tmpa, *tmpc, mu;

Changes to libtommath/bn_mp_addmod.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_ADDMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* d = a + b (mod c) */
int mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d)
{
   int     res;
   mp_int  t;

Changes to libtommath/bn_mp_and.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_AND_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* AND two ints together */
int mp_and(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     res, ix, px;
   mp_int  t;

Changes to libtommath/bn_mp_clamp.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38
39
40
41
42
43

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36
37
38
39
40
41
-
+












-
-














-
+













#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_CLAMP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* trim unused digits
 *
 * This is used to ensure that leading zero digits are
 * trimed and the leading "used" digit will be non-zero
 * Typically very fast.  Also fixes the sign if there
 * are no more leading digits
 */
void mp_clamp(mp_int *a)
{
   /* decrease used while the most significant digit is
    * zero.
    */
   while ((a->used > 0) && (a->dp[a->used - 1] == 0)) {
   while ((a->used > 0) && (a->dp[a->used - 1] == 0u)) {
      --(a->used);
   }

   /* reset the sign flag if used == 0 */
   if (a->used == 0) {
      a->sign = MP_ZPOS;
   }
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_clear.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_CLEAR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* clear one (frees)  */
void mp_clear(mp_int *a)
{
   int i;

Changes to libtommath/bn_mp_clear_multi.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18
19
20
21
22
23

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15

16
17
18
19
20
21
22
-
+












-
-
+
+
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_CLEAR_MULTI_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

 */
#include <stdarg.h>

void mp_clear_multi(mp_int *mp, ...)
{
   mp_int *next_mp = mp;
   va_list args;
   va_start(args, mp);

Changes to libtommath/bn_mp_cmp.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_CMP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* compare two ints (signed)*/
int mp_cmp(const mp_int *a, const mp_int *b)
{
   /* compare based on sign */
   if (a->sign != b->sign) {

Changes to libtommath/bn_mp_cmp_d.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_CMP_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* compare a digit */
int mp_cmp_d(const mp_int *a, mp_digit b)
{
   /* compare based on sign */
   if (a->sign == MP_NEG) {

Changes to libtommath/bn_mp_cmp_mag.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_CMP_MAG_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* compare maginitude of two ints (unsigned) */
int mp_cmp_mag(const mp_int *a, const mp_int *b)
{
   int     n;
   mp_digit *tmpa, *tmpb;

Changes to libtommath/bn_mp_cnt_lsb.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

35
36
37
38
39

40
41

42
43
44

45
46
47
48
49
50
51
52
53

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36

37
38

39
40
41

42
43
44
45
46
47
48
49
50
51
-
+












-
-


















-
+




-
+

-
+


-
+









#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_CNT_LSB_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

static const int lnz[16] = {
   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0
};

/* Counts the number of lsbs which are zero before the first zero bit */
int mp_cnt_lsb(const mp_int *a)
{
   int x;
   mp_digit q, qq;

   /* easy out */
   if (mp_iszero(a) == MP_YES) {
      return 0;
   }

   /* scan lower digits until non-zero */
   for (x = 0; (x < a->used) && (a->dp[x] == 0); x++) {}
   for (x = 0; (x < a->used) && (a->dp[x] == 0u); x++) {}
   q = a->dp[x];
   x *= DIGIT_BIT;

   /* now scan this digit until a 1 is found */
   if ((q & 1) == 0) {
   if ((q & 1u) == 0u) {
      do {
         qq  = q & 15;
         qq  = q & 15u;
         x  += lnz[qq];
         q >>= 4;
      } while (qq == 0);
      } while (qq == 0u);
   }
   return x;
}

#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Added libtommath/bn_mp_complement.c.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include "tommath_private.h"
#ifdef BN_MP_COMPLEMENT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 */

/* b = ~a */
int mp_complement(const mp_int *a, mp_int *b)
{
   int res = mp_neg(a, b);
   return (res == MP_OKAY) ? mp_sub_d(b, 1uL, b) : res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_copy.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_COPY_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* copy, b = a */
int mp_copy(const mp_int *a, mp_int *b)
{
   int     res, n;

Changes to libtommath/bn_mp_count_bits.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

35
36

37
38
39
40
41
42
43
44

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33

34
35
36
37
38
39
40
41
42
-
+












-
-


















-
+

-
+








#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_COUNT_BITS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* returns the number of bits in an int */
int mp_count_bits(const mp_int *a)
{
   int     r;
   mp_digit q;

   /* shortcut */
   if (a->used == 0) {
      return 0;
   }

   /* get number of digits and add that */
   r = (a->used - 1) * DIGIT_BIT;

   /* take the last digit and count the bits in it */
   q = a->dp[a->used - 1];
   while (q > ((mp_digit) 0)) {
   while (q > (mp_digit)0) {
      ++r;
      q >>= ((mp_digit) 1);
      q >>= (mp_digit)1;
   }
   return r;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_div.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_DIV_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

#ifdef BN_MP_DIV_SMALL

/* slower bit-bang division... also smaller */
int mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d)
{
43
44
45
46
47
48
49
50

51
52
53
54
55
56
57
41
42
43
44
45
46
47

48
49
50
51
52
53
54
55







-
+








   /* init our temps */
   if ((res = mp_init_multi(&ta, &tb, &tq, &q, NULL)) != MP_OKAY) {
      return res;
   }


   mp_set(&tq, 1);
   mp_set(&tq, 1uL);
   n = mp_count_bits(a) - mp_count_bits(b);
   if (((res = mp_abs(a, &ta)) != MP_OKAY) ||
       ((res = mp_abs(b, &tb)) != MP_OKAY) ||
       ((res = mp_mul_2d(&tb, n, &tb)) != MP_OKAY) ||
       ((res = mp_mul_2d(&tq, n, &tq)) != MP_OKAY)) {
      goto LBL_ERR;
   }
146
147
148
149
150
151
152
153
154


155
156
157
158
159
160
161
144
145
146
147
148
149
150


151
152
153
154
155
156
157
158
159







-
-
+
+








   /* fix the sign */
   neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG;
   x.sign = y.sign = MP_ZPOS;

   /* normalize both x and y, ensure that y >= b/2, [b == 2**DIGIT_BIT] */
   norm = mp_count_bits(&y) % DIGIT_BIT;
   if (norm < (int)(DIGIT_BIT-1)) {
      norm = (DIGIT_BIT-1) - norm;
   if (norm < (DIGIT_BIT - 1)) {
      norm = (DIGIT_BIT - 1) - norm;
      if ((res = mp_mul_2d(&x, norm, &x)) != MP_OKAY) {
         goto LBL_Y;
      }
      if ((res = mp_mul_2d(&y, norm, &y)) != MP_OKAY) {
         goto LBL_Y;
      }
   } else {
186
187
188
189
190
191
192
193

194
195
196
197
198
199




200
201
202

203
204
205
206
207
208
209
210

211
212

213
214
215
216

217
218
219
220
221
222
223
224
225


226
227
228
229
230
231
232
184
185
186
187
188
189
190

191
192
193




194
195
196
197
198
199

200
201
202
203
204
205
206
207

208
209

210
211
212
213

214
215
216
217
218
219
220
221


222
223
224
225
226
227
228
229
230







-
+


-
-
-
-
+
+
+
+


-
+







-
+

-
+



-
+







-
-
+
+







      if (i > x.used) {
         continue;
      }

      /* step 3.1 if xi == yt then set q{i-t-1} to b-1,
       * otherwise set q{i-t-1} to (xi*b + x{i-1})/yt */
      if (x.dp[i] == y.dp[t]) {
         q.dp[(i - t) - 1] = ((((mp_digit)1) << DIGIT_BIT) - 1);
         q.dp[(i - t) - 1] = ((mp_digit)1 << (mp_digit)DIGIT_BIT) - (mp_digit)1;
      } else {
         mp_word tmp;
         tmp = ((mp_word) x.dp[i]) << ((mp_word) DIGIT_BIT);
         tmp |= ((mp_word) x.dp[i - 1]);
         tmp /= ((mp_word) y.dp[t]);
         if (tmp > (mp_word) MP_MASK) {
         tmp = (mp_word)x.dp[i] << (mp_word)DIGIT_BIT;
         tmp |= (mp_word)x.dp[i - 1];
         tmp /= (mp_word)y.dp[t];
         if (tmp > (mp_word)MP_MASK) {
            tmp = MP_MASK;
         }
         q.dp[(i - t) - 1] = (mp_digit)(tmp & (mp_word)(MP_MASK));
         q.dp[(i - t) - 1] = (mp_digit)(tmp & (mp_word)MP_MASK);
      }

      /* while (q{i-t-1} * (yt * b + y{t-1})) >
               xi * b**2 + xi-1 * b + xi-2

         do q{i-t-1} -= 1;
      */
      q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] + 1) & MP_MASK;
      q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] + 1uL) & (mp_digit)MP_MASK;
      do {
         q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] - 1) & MP_MASK;
         q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] - 1uL) & (mp_digit)MP_MASK;

         /* find left hand */
         mp_zero(&t1);
         t1.dp[0] = ((t - 1) < 0) ? 0 : y.dp[t - 1];
         t1.dp[0] = ((t - 1) < 0) ? 0u : y.dp[t - 1];
         t1.dp[1] = y.dp[t];
         t1.used = 2;
         if ((res = mp_mul_d(&t1, q.dp[(i - t) - 1], &t1)) != MP_OKAY) {
            goto LBL_Y;
         }

         /* find right hand */
         t2.dp[0] = ((i - 2) < 0) ? 0 : x.dp[i - 2];
         t2.dp[1] = ((i - 1) < 0) ? 0 : x.dp[i - 1];
         t2.dp[0] = ((i - 2) < 0) ? 0u : x.dp[i - 2];
         t2.dp[1] = ((i - 1) < 0) ? 0u : x.dp[i - 1];
         t2.dp[2] = x.dp[i];
         t2.used = 3;
      } while (mp_cmp_mag(&t1, &t2) == MP_GT);

      /* step 3.3 x = x - q{i-t-1} * y * b**{i-t-1} */
      if ((res = mp_mul_d(&y, q.dp[(i - t) - 1], &t1)) != MP_OKAY) {
         goto LBL_Y;
248
249
250
251
252
253
254
255

256
257
258
259
260
261
262
246
247
248
249
250
251
252

253
254
255
256
257
258
259
260







-
+







         if ((res = mp_lshd(&t1, (i - t) - 1)) != MP_OKAY) {
            goto LBL_Y;
         }
         if ((res = mp_add(&x, &t1, &x)) != MP_OKAY) {
            goto LBL_Y;
         }

         q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] - 1UL) & MP_MASK;
         q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] - 1uL) & MP_MASK;
      }
   }

   /* now q is the quotient and x is the remainder
    * [which we have to normalize]
    */

Changes to libtommath/bn_mp_div_2.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_DIV_2_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* b = a/2 */
int mp_div_2(const mp_int *a, mp_int *b)
{
   int     x, res, oldused;

38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50







-
+







      /* dest alias */
      tmpb = b->dp + b->used - 1;

      /* carry */
      r = 0;
      for (x = b->used - 1; x >= 0; x--) {
         /* get the carry for the next iteration */
         rr = *tmpa & 1;
         rr = *tmpa & 1u;

         /* shift the current digit, add in carry and store */
         *tmpb-- = (*tmpa-- >> 1) | (r << (DIGIT_BIT - 1));

         /* forward carry to next iteration */
         r = rr;
      }

Changes to libtommath/bn_mp_div_2d.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_DIV_2D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* shift right by a certain bit count (store quotient in c, optional remainder in d) */
int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d)
{
   mp_digit D, r, rr;
   int     x, res;
40
41
42
43
44
45
46
47

48
49
50
51
52
53

54
55
56
57

58
59
60

61
62
63
64
65
66
67
38
39
40
41
42
43
44

45
46
47
48
49
50

51
52
53
54

55
56
57

58
59
60
61
62
63
64
65







-
+





-
+



-
+


-
+







   if (d != NULL) {
      if ((res = mp_mod_2d(a, b, d)) != MP_OKAY) {
         return res;
      }
   }

   /* shift by as many digits in the bit count */
   if (b >= (int)DIGIT_BIT) {
   if (b >= DIGIT_BIT) {
      mp_rshd(c, b / DIGIT_BIT);
   }

   /* shift any bit count < DIGIT_BIT */
   D = (mp_digit)(b % DIGIT_BIT);
   if (D != 0) {
   if (D != 0u) {
      mp_digit *tmpc, mask, shift;

      /* mask */
      mask = (((mp_digit)1) << D) - 1;
      mask = ((mp_digit)1 << D) - 1uL;

      /* shift for lsb */
      shift = DIGIT_BIT - D;
      shift = (mp_digit)DIGIT_BIT - D;

      /* alias */
      tmpc = c->dp + (c->used - 1);

      /* carry */
      r = 0;
      for (x = c->used - 1; x >= 0; x--) {

Changes to libtommath/bn_mp_div_3.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36
37

38
39

40
41

42
43
44
45
46
47
48
49
50
51



52
53
54
55
56
57
58

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
33
34

35
36

37
38

39
40
41
42
43
44
45
46



47
48
49
50
51
52
53
54
55
56
-
+












-
-











-
+









-
+

-
+

-
+







-
-
-
+
+
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_DIV_3_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* divide by three (based on routine from MPI and the GMP manual) */
int mp_div_3(const mp_int *a, mp_int *c, mp_digit *d)
{
   mp_int   q;
   mp_word  w, t;
   mp_digit b;
   int      res, ix;

   /* b = 2**DIGIT_BIT / 3 */
   b = (((mp_word)1) << ((mp_word)DIGIT_BIT)) / ((mp_word)3);
   b = ((mp_word)1 << (mp_word)DIGIT_BIT) / (mp_word)3;

   if ((res = mp_init_size(&q, a->used)) != MP_OKAY) {
      return res;
   }

   q.used = a->used;
   q.sign = a->sign;
   w = 0;
   for (ix = a->used - 1; ix >= 0; ix--) {
      w = (w << ((mp_word)DIGIT_BIT)) | ((mp_word)a->dp[ix]);
      w = (w << (mp_word)DIGIT_BIT) | (mp_word)a->dp[ix];

      if (w >= 3) {
      if (w >= 3u) {
         /* multiply w by [1/3] */
         t = (w * ((mp_word)b)) >> ((mp_word)DIGIT_BIT);
         t = (w * (mp_word)b) >> (mp_word)DIGIT_BIT;

         /* now subtract 3 * [w/3] from w, to get the remainder */
         w -= t+t+t;

         /* fixup the remainder as required since
          * the optimization is not exact.
          */
         while (w >= 3) {
            t += 1;
            w -= 3;
         while (w >= 3u) {
            t += 1u;
            w -= 3u;
         }
      } else {
         t = 0;
      }
      q.dp[ix] = (mp_digit)t;
   }

Changes to libtommath/bn_mp_div_d.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

51
52
53
54
55
56
57
58
59
60

61
62
63
64
65
66
67
68
69
70
71
72
73
74

75
76
77
78

79
80
81
82

83
84
85
86
87
88
89

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

48
49
50
51
52
53
54
55
56
57

58
59
60
61
62
63
64
65
66
67
68
69
70
71

72
73
74
75

76
77
78
79

80
81
82
83
84
85
86
87
-
+












-
-











-
+




-
+

















-
+









-
+













-
+



-
+



-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_DIV_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* single digit division (based on routine from MPI) */
int mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d)
{
   mp_int  q;
   mp_word w;
   mp_digit t;
   int     res, ix;

   /* cannot divide by zero */
   if (b == 0) {
   if (b == 0u) {
      return MP_VAL;
   }

   /* quick outs */
   if ((b == 1) || (mp_iszero(a) == MP_YES)) {
   if ((b == 1u) || (mp_iszero(a) == MP_YES)) {
      if (d != NULL) {
         *d = 0;
      }
      if (c != NULL) {
         return mp_copy(a, c);
      }
      return MP_OKAY;
   }

   /* power of two ? */
   if (((b & (b-1)) == 0)) {
      for (ix = 1; ix < DIGIT_BIT; ix++) {
         if (b == (((mp_digit)1)<<ix)) {
            break;
         }
      }
      if (d != NULL) {
         *d = a->dp[0] & ((((mp_digit)1)<<ix) - 1);
         *d = a->dp[0] & (((mp_digit)1<<(mp_digit)ix) - 1uL);
      }
      if (c != NULL) {
         return mp_div_2d(a, ix, c, NULL);
      }
      return MP_OKAY;
   }

#ifdef BN_MP_DIV_3_C
   /* three? */
   if (b == 3) {
   if (b == 3u) {
      return mp_div_3(a, c, d);
   }
#endif

   /* no easy answer [c'est la vie].  Just division */
   if ((res = mp_init_size(&q, a->used)) != MP_OKAY) {
      return res;
   }

   q.used = a->used;
   q.sign = a->sign;
   w = 0;
   for (ix = a->used - 1; ix >= 0; ix--) {
      w = (w << ((mp_word)DIGIT_BIT)) | ((mp_word)a->dp[ix]);
      w = (w << (mp_word)DIGIT_BIT) | (mp_word)a->dp[ix];

      if (w >= b) {
         t = (mp_digit)(w / b);
         w -= ((mp_word)t) * ((mp_word)b);
         w -= (mp_word)t * (mp_word)b;
      } else {
         t = 0;
      }
      q.dp[ix] = (mp_digit)t;
      q.dp[ix] = t;
   }

   if (d != NULL) {
      *d = (mp_digit)w;
   }

   if (c != NULL) {

Changes to libtommath/bn_mp_dr_is_modulus.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_DR_IS_MODULUS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* determines if a number is a valid DR modulus */
int mp_dr_is_modulus(const mp_int *a)
{
   int ix;

Changes to libtommath/bn_mp_dr_reduce.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_DR_REDUCE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* reduce "x" in place modulo "n" using the Diminished Radix algorithm.
 *
 * Based on algorithm from the paper
 *
 * "Generating Efficient Primes for Discrete Log Cryptosystems"
57
58
59
60
61
62
63
64

65
66
67
68
69
70
71
55
56
57
58
59
60
61

62
63
64
65
66
67
68
69







-
+







   tmpx2 = x->dp + m;

   /* set carry to zero */
   mu = 0;

   /* compute (x mod B**m) + k * [x/B**m] inline and inplace */
   for (i = 0; i < m; i++) {
      r         = (((mp_word)*tmpx2++) * (mp_word)k) + *tmpx1 + mu;
      r         = ((mp_word)*tmpx2++ * (mp_word)k) + *tmpx1 + mu;
      *tmpx1++  = (mp_digit)(r & MP_MASK);
      mu        = (mp_digit)(r >> ((mp_word)DIGIT_BIT));
   }

   /* set final carry */
   *tmpx1++ = mu;

Changes to libtommath/bn_mp_dr_setup.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
-
+












-
-








-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_DR_SETUP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* determines the setup value */
void mp_dr_setup(const mp_int *a, mp_digit *d)
{
   /* the casts are required if DIGIT_BIT is one less than
    * the number of bits in a mp_digit [e.g. DIGIT_BIT==31]
    */
   *d = (mp_digit)((((mp_word)1) << ((mp_word)DIGIT_BIT)) - ((mp_word)a->dp[0]));
   *d = (mp_digit)(((mp_word)1 << (mp_word)DIGIT_BIT) - (mp_word)a->dp[0]);
}

#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_exch.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_EXCH_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* swap the elements of two integers, for cases where you can't simply swap the
 * mp_int pointers around
 */
void mp_exch(mp_int *a, mp_int *b)
{

Changes to libtommath/bn_mp_export.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_EXPORT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* based on gmp's mpz_export.
 * see http://gmplib.org/manual/Integer-Import-and-Export.html
 */
int mp_export(void *rop, size_t *countp, int order, size_t size,
              int endian, size_t nails, const mp_int *op)
34
35
36
37
38
39
40
41

42
43
44

45
46
47

48
49

50
51
52


53
54
55
56
57
58


59
60
61
62
63
64
65

66
67

68
69
70
71
72
73
74
32
33
34
35
36
37
38

39
40
41

42
43
44

45
46

47
48


49
50
51
52
53
54


55
56
57
58
59
60
61
62

63
64

65
66
67
68
69
70
71
72







-
+


-
+


-
+

-
+

-
-
+
+




-
-
+
+






-
+

-
+







   if (endian == 0) {
      union {
         unsigned int i;
         char c[4];
      } lint;
      lint.i = 0x01020304;

      endian = (lint.c[0] == 4) ? -1 : 1;
      endian = (lint.c[0] == '\x04') ? -1 : 1;
   }

   odd_nails = (nails % 8);
   odd_nails = (nails % 8u);
   odd_nail_mask = 0xff;
   for (i = 0; i < odd_nails; ++i) {
      odd_nail_mask ^= (1 << (7 - i));
      odd_nail_mask ^= (unsigned char)(1u << (7u - i));
   }
   nail_bytes = nails / 8;
   nail_bytes = nails / 8u;

   bits = mp_count_bits(&t);
   count = (bits / ((size * 8) - nails)) + (((bits % ((size * 8) - nails)) != 0) ? 1 : 0);
   bits = (size_t)mp_count_bits(&t);
   count = (bits / ((size * 8u) - nails)) + (((bits % ((size * 8u) - nails)) != 0u) ? 1u : 0u);

   for (i = 0; i < count; ++i) {
      for (j = 0; j < size; ++j) {
         unsigned char *byte = (unsigned char *)rop +
                               (((order == -1) ? i : ((count - 1) - i)) * size) +
                               ((endian == -1) ? j : ((size - 1) - j));
                               (((order == -1) ? i : ((count - 1u) - i)) * size) +
                               ((endian == -1) ? j : ((size - 1u) - j));

         if (j >= (size - nail_bytes)) {
            *byte = 0;
            continue;
         }

         *byte = (unsigned char)((j == ((size - nail_bytes) - 1)) ? (t.dp[0] & odd_nail_mask) : (t.dp[0] & 0xFF));
         *byte = (unsigned char)((j == ((size - nail_bytes) - 1u)) ? (t.dp[0] & odd_nail_mask) : (t.dp[0] & 0xFFuL));

         if ((result = mp_div_2d(&t, ((j == ((size - nail_bytes) - 1)) ? (8 - odd_nails) : 8), &t, NULL)) != MP_OKAY) {
         if ((result = mp_div_2d(&t, (j == ((size - nail_bytes) - 1u)) ? (int)(8u - odd_nails) : 8, &t, NULL)) != MP_OKAY) {
            mp_clear(&t);
            return result;
         }
      }
   }

   mp_clear(&t);

Changes to libtommath/bn_mp_expt_d.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_EXPT_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* wrapper function for mp_expt_d_ex() */
int mp_expt_d(const mp_int *a, mp_digit b, mp_int *c)
{
   return mp_expt_d_ex(a, b, c, 0);
}

Changes to libtommath/bn_mp_expt_d_ex.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34

35
36

37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
52
53
54
55

56
57
58
59
60
61
62
63

64
65
66
67
68
69
70

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
30
31

32
33

34
35
36
37
38
39
40
41

42
43
44
45
46
47
48
49
50
51
52

53
54
55
56
57
58
59
60

61
62
63
64
65
66
67
68
-
+












-
-















-
+


-
+

-
+







-
+










-
+







-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_EXPT_D_EX_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* calculate c = a**b  using a square-multiply algorithm */
int mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast)
{
   int     res;
   unsigned int x;

   mp_int  g;

   if ((res = mp_init_copy(&g, a)) != MP_OKAY) {
      return res;
   }

   /* set initial result */
   mp_set(c, 1);
   mp_set(c, 1uL);

   if (fast != 0) {
      while (b > 0) {
      while (b > 0u) {
         /* if the bit is set multiply */
         if ((b & 1) != 0) {
         if ((b & 1u) != 0u) {
            if ((res = mp_mul(c, &g, c)) != MP_OKAY) {
               mp_clear(&g);
               return res;
            }
         }

         /* square */
         if (b > 1) {
         if (b > 1u) {
            if ((res = mp_sqr(&g, &g)) != MP_OKAY) {
               mp_clear(&g);
               return res;
            }
         }

         /* shift to next bit */
         b >>= 1;
      }
   } else {
      for (x = 0; x < DIGIT_BIT; x++) {
      for (x = 0; x < (unsigned)DIGIT_BIT; x++) {
         /* square */
         if ((res = mp_sqr(c, c)) != MP_OKAY) {
            mp_clear(&g);
            return res;
         }

         /* if the bit is set multiply */
         if ((b & (mp_digit)(((mp_digit)1) << (DIGIT_BIT - 1))) != 0) {
         if ((b & ((mp_digit)1 << (DIGIT_BIT - 1))) != 0u) {
            if ((res = mp_mul(c, &g, c)) != MP_OKAY) {
               mp_clear(&g);
               return res;
            }
         }

         /* shift to next bit */

Changes to libtommath/bn_mp_exptmod.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_EXPTMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */


/* this is a shell function that calls either the normal or Montgomery
 * exptmod functions.  Originally the call to the montgomery code was
 * embedded in the normal function but that wasted alot of stack space
 * for nothing (since 99% of the time the Montgomery code would be called)

Changes to libtommath/bn_mp_exptmod_fast.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_EXPTMOD_FAST_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* computes Y == G**X mod P, HAC pp.616, Algorithm 14.85
 *
 * Uses a left-to-right k-ary sliding window to compute the modular exponentiation.
 * The value of k changes based on the size of the exponent.
 *
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47







-
+







   mp_digit buf, mp;
   int     err, bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize;

   /* use a pointer to the reduction algorithm.  This allows us to use
    * one of many reduction algorithms without modding the guts of
    * the code with if statements everywhere.
    */
   int (*redux)(mp_int *,const mp_int *,mp_digit);
   int (*redux)(mp_int *x, const mp_int *n, mp_digit rho);

   /* find window size */
   x = mp_count_bits(X);
   if (x <= 7) {
      winsize = 2;
   } else if (x <= 36) {
      winsize = 3;
92
93
94
95
96
97
98
99

100
101
102
103
104
105
106
90
91
92
93
94
95
96

97
98
99
100
101
102
103
104







-
+







#else
      err = MP_VAL;
      goto LBL_M;
#endif

      /* automatically pick the comba one if available (saves quite a few calls/ifs) */
#ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C
      if ((((P->used * 2) + 1) < MP_WARRAY) &&
      if ((((P->used * 2) + 1) < (int)MP_WARRAY) &&
          (P->used < (1 << ((CHAR_BIT * sizeof(mp_word)) - (2 * DIGIT_BIT))))) {
         redux = fast_mp_montgomery_reduce;
      } else
#endif
      {
#ifdef BN_MP_MONTGOMERY_REDUCE_C
         /* use slower baseline Montgomery method */
156
157
158
159
160
161
162
163

164
165
166
167
168
169
170
154
155
156
157
158
159
160

161
162
163
164
165
166
167
168







-
+







         goto LBL_RES;
      }
#else
      err = MP_VAL;
      goto LBL_RES;
#endif
   } else {
      mp_set(&res, 1);
      mp_set(&res, 1uL);
      if ((err = mp_mod(G, P, &M[1])) != MP_OKAY) {
         goto LBL_RES;
      }
   }

   /* compute the value at M[1<<(winsize-1)] by squaring M[1] (winsize-1) times */
   if ((err = mp_copy(&M[1], &M[1 << (winsize - 1)])) != MP_OKAY) {

Changes to libtommath/bn_mp_exteuclid.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32


33
34
35
36
37
38


39
40
41
42
43
44
45

46
47
48
49
50

51
52
53

54
55
56

57
58
59

60
61
62

63
64
65

66
67
68
69
70

71
72
73

74
75
76

77
78
79
80
81

82
83
84

85
86
87

88
89
90
91
92
93
94

95
96
97

98
99
100

101
102
103
104
105
106
107

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28


29
30
31
32
33
34


35
36
37
38
39
40
41
42

43
44
45
46
47

48
49
50

51
52
53

54
55
56

57
58
59

60
61
62

63
64
65
66
67

68
69
70

71
72
73

74
75
76
77
78

79
80
81

82
83
84

85
86
87
88
89
90
91

92
93
94

95
96
97

98
99
100
101
102
103
104
105
-
+












-
-















-
-
+
+




-
-
+
+






-
+




-
+


-
+


-
+


-
+


-
+


-
+




-
+


-
+


-
+




-
+


-
+


-
+






-
+


-
+


-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_EXTEUCLID_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* Extended euclidean algorithm of (a, b) produces
   a*u1 + b*u2 = u3
 */
int mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3)
{
   mp_int u1, u2, u3, v1, v2, v3, t1, t2, t3, q, tmp;
   int err;

   if ((err = mp_init_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL)) != MP_OKAY) {
      return err;
   }

   /* initialize, (u1,u2,u3) = (1,0,a) */
   mp_set(&u1, 1);
   if ((err = mp_copy(a, &u3)) != MP_OKAY)                                        {
   mp_set(&u1, 1uL);
   if ((err = mp_copy(a, &u3)) != MP_OKAY) {
      goto LBL_ERR;
   }

   /* initialize, (v1,v2,v3) = (0,1,b) */
   mp_set(&v2, 1);
   if ((err = mp_copy(b, &v3)) != MP_OKAY)                                        {
   mp_set(&v2, 1uL);
   if ((err = mp_copy(b, &v3)) != MP_OKAY) {
      goto LBL_ERR;
   }

   /* loop while v3 != 0 */
   while (mp_iszero(&v3) == MP_NO) {
      /* q = u3/v3 */
      if ((err = mp_div(&u3, &v3, &q, NULL)) != MP_OKAY)                         {
      if ((err = mp_div(&u3, &v3, &q, NULL)) != MP_OKAY) {
         goto LBL_ERR;
      }

      /* (t1,t2,t3) = (u1,u2,u3) - (v1,v2,v3)q */
      if ((err = mp_mul(&v1, &q, &tmp)) != MP_OKAY)                              {
      if ((err = mp_mul(&v1, &q, &tmp)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_sub(&u1, &tmp, &t1)) != MP_OKAY)                             {
      if ((err = mp_sub(&u1, &tmp, &t1)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_mul(&v2, &q, &tmp)) != MP_OKAY)                              {
      if ((err = mp_mul(&v2, &q, &tmp)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_sub(&u2, &tmp, &t2)) != MP_OKAY)                             {
      if ((err = mp_sub(&u2, &tmp, &t2)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_mul(&v3, &q, &tmp)) != MP_OKAY)                              {
      if ((err = mp_mul(&v3, &q, &tmp)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_sub(&u3, &tmp, &t3)) != MP_OKAY)                             {
      if ((err = mp_sub(&u3, &tmp, &t3)) != MP_OKAY) {
         goto LBL_ERR;
      }

      /* (u1,u2,u3) = (v1,v2,v3) */
      if ((err = mp_copy(&v1, &u1)) != MP_OKAY)                                  {
      if ((err = mp_copy(&v1, &u1)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_copy(&v2, &u2)) != MP_OKAY)                                  {
      if ((err = mp_copy(&v2, &u2)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_copy(&v3, &u3)) != MP_OKAY)                                  {
      if ((err = mp_copy(&v3, &u3)) != MP_OKAY) {
         goto LBL_ERR;
      }

      /* (v1,v2,v3) = (t1,t2,t3) */
      if ((err = mp_copy(&t1, &v1)) != MP_OKAY)                                  {
      if ((err = mp_copy(&t1, &v1)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_copy(&t2, &v2)) != MP_OKAY)                                  {
      if ((err = mp_copy(&t2, &v2)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_copy(&t3, &v3)) != MP_OKAY)                                  {
      if ((err = mp_copy(&t3, &v3)) != MP_OKAY) {
         goto LBL_ERR;
      }
   }

   /* make sure U3 >= 0 */
   if (u3.sign == MP_NEG) {
      if ((err = mp_neg(&u1, &u1)) != MP_OKAY)                                   {
      if ((err = mp_neg(&u1, &u1)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_neg(&u2, &u2)) != MP_OKAY)                                   {
      if ((err = mp_neg(&u2, &u2)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_neg(&u3, &u3)) != MP_OKAY)                                   {
      if ((err = mp_neg(&u3, &u3)) != MP_OKAY) {
         goto LBL_ERR;
      }
   }

   /* copy result out */
   if (U1 != NULL) {
      mp_exch(U1, &u1);

Changes to libtommath/bn_mp_fread.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40
41
42
43








44
45
46
47
48

49
50
51

52
53
54
55
56
57

58
59
60
61
62
63
64

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
35







36
37
38
39
40
41
42
43
44
45
46
47

48
49
50

51
52
53
54
55
56

57
58
59
60
61
62
63
64
-
+












-
-







+






-
+







-
-
-
-
-
-
-
+
+
+
+
+
+
+
+




-
+


-
+





-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_FREAD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

#ifndef LTM_NO_FILE
/* read a bigint from a file stream in ASCII */
int mp_fread(mp_int *a, int radix, FILE *stream)
{
   int err, ch, neg, y;
   unsigned pos;

   /* clear a */
   mp_zero(a);

   /* if first digit is - then set negative */
   ch = fgetc(stream);
   if (ch == '-') {
   if (ch == (int)'-') {
      neg = MP_NEG;
      ch = fgetc(stream);
   } else {
      neg = MP_ZPOS;
   }

   for (;;) {
      /* find y in the radix map */
      for (y = 0; y < radix; y++) {
         if (mp_s_rmap[y] == ch) {
            break;
         }
      }
      if (y == radix) {
      pos = (unsigned)(ch - (int)'(');
      if (mp_s_rmap_reverse_sz < pos) {
         break;
      }

      y = (int)mp_s_rmap_reverse[pos];

      if ((y == 0xff) || (y >= radix)) {
         break;
      }

      /* shift up and add */
      if ((err = mp_mul_d(a, radix, a)) != MP_OKAY) {
      if ((err = mp_mul_d(a, (mp_digit)radix, a)) != MP_OKAY) {
         return err;
      }
      if ((err = mp_add_d(a, y, a)) != MP_OKAY) {
      if ((err = mp_add_d(a, (mp_digit)y, a)) != MP_OKAY) {
         return err;
      }

      ch = fgetc(stream);
   }
   if (mp_cmp_d(a, 0) != MP_EQ) {
   if (mp_cmp_d(a, 0uL) != MP_EQ) {
      a->sign = neg;
   }

   return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_fwrite.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
-
+












-
-












-
+










-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_FWRITE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

#ifndef LTM_NO_FILE
int mp_fwrite(const mp_int *a, int radix, FILE *stream)
{
   char *buf;
   int err, len, x;

   if ((err = mp_radix_size(a, radix, &len)) != MP_OKAY) {
      return err;
   }

   buf = OPT_CAST(char) XMALLOC(len);
   buf = OPT_CAST(char) XMALLOC((size_t)len);
   if (buf == NULL) {
      return MP_MEM;
   }

   if ((err = mp_toradix(a, buf, radix)) != MP_OKAY) {
      XFREE(buf);
      return err;
   }

   for (x = 0; x < len; x++) {
      if (fputc(buf[x], stream) == EOF) {
      if (fputc((int)buf[x], stream) == EOF) {
         XFREE(buf);
         return MP_VAL;
      }
   }

   XFREE(buf);
   return MP_OKAY;

Changes to libtommath/bn_mp_gcd.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_GCD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* Greatest Common Divisor using the binary method */
int mp_gcd(const mp_int *a, const mp_int *b, mp_int *c)
{
   mp_int  u, v;
   int     k, u_lsb, v_lsb, res;

Changes to libtommath/bn_mp_get_int.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
-
+












-
-













-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_GET_INT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* get the lower 32-bits of an mp_int */
unsigned long mp_get_int(const mp_int *a)
{
   int i;
   mp_min_u32 res;

   if (a->used == 0) {
      return 0;
   }

   /* get number of digits of the lsb we have to read */
   i = MIN(a->used, (int)(((sizeof(unsigned long) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;
   i = MIN(a->used, ((((int)sizeof(unsigned long) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;

   /* get most significant digit of result */
   res = DIGIT(a, i);

   while (--i >= 0) {
      res = (res << DIGIT_BIT) | DIGIT(a, i);
   }

Changes to libtommath/bn_mp_get_long.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
-
+












-
-













-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_GET_LONG_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* get the lower unsigned long of an mp_int, platform dependent */
unsigned long mp_get_long(const mp_int *a)
{
   int i;
   unsigned long res;

   if (a->used == 0) {
      return 0;
   }

   /* get number of digits of the lsb we have to read */
   i = MIN(a->used, (int)(((sizeof(unsigned long) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;
   i = MIN(a->used, ((((int)sizeof(unsigned long) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;

   /* get most significant digit of result */
   res = DIGIT(a, i);

#if (ULONG_MAX != 0xffffffffuL) || (DIGIT_BIT < 32)
   while (--i >= 0) {
      res = (res << DIGIT_BIT) | DIGIT(a, i);

Changes to libtommath/bn_mp_get_long_long.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
-
+












-
-













-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_GET_LONG_LONG_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* get the lower unsigned long long of an mp_int, platform dependent */
Tcl_WideUInt mp_get_long_long(const mp_int *a)
{
   int i;
   Tcl_WideUInt res;

   if (a->used == 0) {
      return 0;
   }

   /* get number of digits of the lsb we have to read */
   i = MIN(a->used, (int)(((sizeof(Tcl_WideUInt) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;
   i = MIN(a->used, ((((int)sizeof(Tcl_WideUInt) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;

   /* get most significant digit of result */
   res = DIGIT(a, i);

#if DIGIT_BIT < 64
   while (--i >= 0) {
      res = (res << DIGIT_BIT) | DIGIT(a, i);

Changes to libtommath/bn_mp_grow.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
-
+












-
-



















-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_GROW_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* grow as required */
int mp_grow(mp_int *a, int size)
{
   int     i;
   mp_digit *tmp;

   /* if the alloc size is smaller alloc more ram */
   if (a->alloc < size) {
      /* ensure there are always at least MP_PREC digits extra on top */
      size += (MP_PREC * 2) - (size % MP_PREC);

      /* reallocate the array a->dp
       *
       * We store the return in a temporary variable
       * in case the operation failed we don't want
       * to overwrite the dp member of a.
       */
      tmp = OPT_CAST(mp_digit) XREALLOC(a->dp, sizeof(mp_digit) * size);
      tmp = OPT_CAST(mp_digit) XREALLOC(a->dp, sizeof(mp_digit) * (size_t)size);
      if (tmp == NULL) {
         /* reallocation failed but "a" is still valid [can be freed] */
         return MP_MEM;
      }

      /* reallocation succeeded so set a->dp */
      a->dp = tmp;

Changes to libtommath/bn_mp_import.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_IMPORT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* based on gmp's mpz_import.
 * see http://gmplib.org/manual/Integer-Import-and-Export.html
 */
int mp_import(mp_int *rop, size_t count, int order, size_t size,
              int endian, size_t nails, const void *op)
30
31
32
33
34
35
36
37

38
39
40

41
42
43

44
45

46
47
48
49
50
51


52
53

54
55
56
57

58
59
60
61
62
63
64
28
29
30
31
32
33
34

35
36
37

38
39
40

41
42

43
44
45
46
47


48
49
50

51
52
53
54

55
56
57
58
59
60
61
62







-
+


-
+


-
+

-
+




-
-
+
+

-
+



-
+







   if (endian == 0) {
      union {
         unsigned int i;
         char c[4];
      } lint;
      lint.i = 0x01020304;

      endian = (lint.c[0] == 4) ? -1 : 1;
      endian = (lint.c[0] == '\x04') ? -1 : 1;
   }

   odd_nails = (nails % 8);
   odd_nails = (nails % 8u);
   odd_nail_mask = 0xff;
   for (i = 0; i < odd_nails; ++i) {
      odd_nail_mask ^= (1 << (7 - i));
      odd_nail_mask ^= (unsigned char)(1u << (7u - i));
   }
   nail_bytes = nails / 8;
   nail_bytes = nails / 8u;

   for (i = 0; i < count; ++i) {
      for (j = 0; j < (size - nail_bytes); ++j) {
         unsigned char byte = *((unsigned char *)op +
                                (((order == 1) ? i : ((count - 1) - i)) * size) +
                                ((endian == 1) ? (j + nail_bytes) : (((size - 1) - j) - nail_bytes)));
                                (((order == 1) ? i : ((count - 1u) - i)) * size) +
                                ((endian == 1) ? (j + nail_bytes) : (((size - 1u) - j) - nail_bytes)));

         if ((result = mp_mul_2d(rop, ((j == 0) ? (8 - odd_nails) : 8), rop)) != MP_OKAY) {
         if ((result = mp_mul_2d(rop, (j == 0u) ? (int)(8u - odd_nails) : 8, rop)) != MP_OKAY) {
            return result;
         }

         rop->dp[0] |= (j == 0) ? (byte & odd_nail_mask) : byte;
         rop->dp[0] |= (j == 0u) ? (mp_digit)(byte & odd_nail_mask) : (mp_digit)byte;
         rop->used  += 1;
      }
   }

   mp_clamp(rop);

   return MP_OKAY;

Changes to libtommath/bn_mp_init.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
-
+












-
-








-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_INIT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* init a new mp_int */
int mp_init(mp_int *a)
{
   int i;

   /* allocate memory required and clear it */
   a->dp = OPT_CAST(mp_digit) XMALLOC(sizeof(mp_digit) * MP_PREC);
   a->dp = OPT_CAST(mp_digit) XMALLOC(sizeof(mp_digit) * (size_t)MP_PREC);
   if (a->dp == NULL) {
      return MP_MEM;
   }

   /* set the digits to zero */
   for (i = 0; i < MP_PREC; i++) {
      a->dp[i] = 0;

Changes to libtommath/bn_mp_init_copy.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_INIT_COPY_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* creates "a" then copies b into it */
int mp_init_copy(mp_int *a, const mp_int *b)
{
   int     res;

Changes to libtommath/bn_mp_init_multi.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18
19
20
21
22
23

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15

16
17
18
19
20
21
22
-
+












-
-
+
+
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_INIT_MULTI_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

 */
#include <stdarg.h>

int mp_init_multi(mp_int *mp, ...)
{
   mp_err res = MP_OKAY;      /* Assume ok until proven otherwise */
   int n = 0;                 /* Number of ok inits */
   mp_int *cur_arg = mp;

Changes to libtommath/bn_mp_init_set.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_INIT_SET_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* initialize and set a digit */
int mp_init_set(mp_int *a, mp_digit b)
{
   int err;
   if ((err = mp_init(a)) != MP_OKAY) {

Changes to libtommath/bn_mp_init_set_int.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_INIT_SET_INT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* initialize and set a digit */
int mp_init_set_int(mp_int *a, unsigned long b)
{
   int err;
   if ((err = mp_init(a)) != MP_OKAY) {

Changes to libtommath/bn_mp_init_size.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
-
+












-
-











-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_INIT_SIZE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* init an mp_init for a given size */
int mp_init_size(mp_int *a, int size)
{
   int x;

   /* pad size so there are always extra digits */
   size += (MP_PREC * 2) - (size % MP_PREC);

   /* alloc mem */
   a->dp = OPT_CAST(mp_digit) XMALLOC(sizeof(mp_digit) * size);
   a->dp = OPT_CAST(mp_digit) XMALLOC(sizeof(mp_digit) * (size_t)size);
   if (a->dp == NULL) {
      return MP_MEM;
   }

   /* set the members */
   a->used  = 0;
   a->alloc = size;

Changes to libtommath/bn_mp_invmod.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22


23
24
25
26
27
28

29
30
31
32
33
34
35

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18


19
20
21
22
23
24
25

26
27
28
29
30
31
32
33
-
+












-
-





-
-
+
+





-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_INVMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* hac 14.61, pp608 */
int mp_invmod(const mp_int *a, const mp_int *b, mp_int *c)
{
   /* b cannot be negative */
   if ((b->sign == MP_NEG) || (mp_iszero(b) == MP_YES)) {
   /* b cannot be negative and has to be >1 */
   if ((b->sign == MP_NEG) || (mp_cmp_d(b, 1uL) != MP_GT)) {
      return MP_VAL;
   }

#ifdef BN_FAST_MP_INVMOD_C
   /* if the modulus is odd we can use a faster routine instead */
   if ((mp_isodd(b) == MP_YES) && (mp_cmp_d(b, 1) != MP_EQ)) {
   if ((mp_isodd(b) == MP_YES)) {
      return fast_mp_invmod(a, b, c);
   }
#endif

#ifdef BN_MP_INVMOD_SLOW_C
   return mp_invmod_slow(a, b, c);
#else

Changes to libtommath/bn_mp_invmod_slow.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_INVMOD_SLOW_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* hac 14.61, pp608 */
int mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c)
{
   mp_int  x, y, u, v, A, B, C, D;
   int     res;
49
50
51
52
53
54
55
56
57


58
59
60
61
62
63
64
47
48
49
50
51
52
53


54
55
56
57
58
59
60
61
62







-
-
+
+







   /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */
   if ((res = mp_copy(&x, &u)) != MP_OKAY) {
      goto LBL_ERR;
   }
   if ((res = mp_copy(&y, &v)) != MP_OKAY) {
      goto LBL_ERR;
   }
   mp_set(&A, 1);
   mp_set(&D, 1);
   mp_set(&A, 1uL);
   mp_set(&D, 1uL);

top:
   /* 4.  while u is even do */
   while (mp_iseven(&u) == MP_YES) {
      /* 4.1 u = u/2 */
      if ((res = mp_div_2(&u, &u)) != MP_OKAY) {
         goto LBL_ERR;
139
140
141
142
143
144
145
146

147
148
149
150
151
152

153
154
155
156
157
158
159
137
138
139
140
141
142
143

144
145
146
147
148
149

150
151
152
153
154
155
156
157







-
+





-
+







   /* if not zero goto step 4 */
   if (mp_iszero(&u) == MP_NO)
      goto top;

   /* now a = C, b = D, gcd == g*v */

   /* if v != 1 then there is no inverse */
   if (mp_cmp_d(&v, 1) != MP_EQ) {
   if (mp_cmp_d(&v, 1uL) != MP_EQ) {
      res = MP_VAL;
      goto LBL_ERR;
   }

   /* if its too low */
   while (mp_cmp_d(&C, 0) == MP_LT) {
   while (mp_cmp_d(&C, 0uL) == MP_LT) {
      if ((res = mp_add(&C, b, &C)) != MP_OKAY) {
         goto LBL_ERR;
      }
   }

   /* too big */
   while (mp_cmp_mag(&C, b) != MP_LT) {

Changes to libtommath/bn_mp_is_square.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_IS_SQUARE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* Check if remainders are possible squares - fast exclude non-squares */
static const char rem_128[128] = {
   0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
   0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
   1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
54
55
56
57
58
59
60
61

62
63
64
65
66

67
68
69

70
71
72
73
74
75
76
77
78

79
80
81
82

83
84
85
86
87
88
89
90
91







92
93
94
95

96
97
98

99
100
101
102

103
104
105
106
107
108
109
110
52
53
54
55
56
57
58

59
60
61
62
63

64
65
66

67
68
69
70
71
72
73
74
75

76
77
78
79

80
81
82







83
84
85
86
87
88
89
90
91
92

93
94
95

96
97
98
99

100
101
102
103
104
105
106
107
108







-
+




-
+


-
+








-
+



-
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+



-
+


-
+



-
+









   /* digits used?  (TSD) */
   if (arg->used == 0) {
      return MP_OKAY;
   }

   /* First check mod 128 (suppose that DIGIT_BIT is at least 7) */
   if (rem_128[127 & DIGIT(arg, 0)] == 1) {
   if (rem_128[127u & DIGIT(arg, 0)] == (char)1) {
      return MP_OKAY;
   }

   /* Next check mod 105 (3*5*7) */
   if ((res = mp_mod_d(arg, 105, &c)) != MP_OKAY) {
   if ((res = mp_mod_d(arg, 105uL, &c)) != MP_OKAY) {
      return res;
   }
   if (rem_105[c] == 1) {
   if (rem_105[c] == (char)1) {
      return MP_OKAY;
   }


   if ((res = mp_init_set_int(&t, 11L*13L*17L*19L*23L*29L*31L)) != MP_OKAY) {
      return res;
   }
   if ((res = mp_mod(arg, &t, &t)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   r = mp_get_int(&t);
   /* Check for other prime modules, note it's not an ERROR but we must
    * free "t" so the easiest way is to goto ERR.  We know that res
    * free "t" so the easiest way is to goto LBL_ERR.  We know that res
    * is already equal to MP_OKAY from the mp_mod call
    */
   if (((1L<<(r%11)) & 0x5C4L) != 0L)       goto ERR;
   if (((1L<<(r%13)) & 0x9E4L) != 0L)       goto ERR;
   if (((1L<<(r%17)) & 0x5CE8L) != 0L)      goto ERR;
   if (((1L<<(r%19)) & 0x4F50CL) != 0L)     goto ERR;
   if (((1L<<(r%23)) & 0x7ACCA0L) != 0L)    goto ERR;
   if (((1L<<(r%29)) & 0xC2EDD0CL) != 0L)   goto ERR;
   if (((1L<<(r%31)) & 0x6DE2B848L) != 0L)  goto ERR;
   if (((1uL<<(r%11uL)) & 0x5C4uL) != 0uL)         goto LBL_ERR;
   if (((1uL<<(r%13uL)) & 0x9E4uL) != 0uL)         goto LBL_ERR;
   if (((1uL<<(r%17uL)) & 0x5CE8uL) != 0uL)        goto LBL_ERR;
   if (((1uL<<(r%19uL)) & 0x4F50CuL) != 0uL)       goto LBL_ERR;
   if (((1uL<<(r%23uL)) & 0x7ACCA0uL) != 0uL)      goto LBL_ERR;
   if (((1uL<<(r%29uL)) & 0xC2EDD0CuL) != 0uL)     goto LBL_ERR;
   if (((1uL<<(r%31uL)) & 0x6DE2B848uL) != 0uL)    goto LBL_ERR;

   /* Final check - is sqr(sqrt(arg)) == arg ? */
   if ((res = mp_sqrt(arg, &t)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_sqr(&t, &t)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   *ret = (mp_cmp_mag(&t, arg) == MP_EQ) ? MP_YES : MP_NO;
ERR:
LBL_ERR:
   mp_clear(&t);
   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_jacobi.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
51

52
53
54
55
56
57
58

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
56
-
+












-
-



















-
+






-
+








-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_JACOBI_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* computes the jacobi c = (a | n) (or Legendre if n is prime)
 * HAC pp. 73 Algorithm 2.149
 * HAC is wrong here, as the special case of (0 | 1) is not
 * handled correctly.
 */
int mp_jacobi(const mp_int *a, const mp_int *n, int *c)
{
   mp_int  a1, p1;
   int     k, s, r, res;
   mp_digit residue;

   /* if a < 0 return MP_VAL */
   if (mp_isneg(a) == MP_YES) {
      return MP_VAL;
   }

   /* if n <= 0 return MP_VAL */
   if (mp_cmp_d(n, 0) != MP_GT) {
   if (mp_cmp_d(n, 0uL) != MP_GT) {
      return MP_VAL;
   }

   /* step 1. handle case of a == 0 */
   if (mp_iszero(a) == MP_YES) {
      /* special case of a == 0 and n == 1 */
      if (mp_cmp_d(n, 1) == MP_EQ) {
      if (mp_cmp_d(n, 1uL) == MP_EQ) {
         *c = 1;
      } else {
         *c = 0;
      }
      return MP_OKAY;
   }

   /* step 2.  if a == 1, return 1 */
   if (mp_cmp_d(a, 1) == MP_EQ) {
   if (mp_cmp_d(a, 1uL) == MP_EQ) {
      *c = 1;
      return MP_OKAY;
   }

   /* default */
   s = 0;

68
69
70
71
72
73
74
75

76
77
78
79

80
81

82
83

84
85
86
87
88
89

90
91
92
93
94

95
96
97
98
99
100
101
66
67
68
69
70
71
72

73
74
75
76

77
78

79
80

81
82
83
84
85
86

87
88
89
90
91

92
93
94
95
96
97
98
99







-
+



-
+

-
+

-
+





-
+




-
+







   /* divide out larger power of two */
   k = mp_cnt_lsb(&a1);
   if ((res = mp_div_2d(&a1, k, &a1, NULL)) != MP_OKAY) {
      goto LBL_P1;
   }

   /* step 4.  if e is even set s=1 */
   if ((k & 1) == 0) {
   if (((unsigned)k & 1u) == 0u) {
      s = 1;
   } else {
      /* else set s=1 if p = 1/7 (mod 8) or s=-1 if p = 3/5 (mod 8) */
      residue = n->dp[0] & 7;
      residue = n->dp[0] & 7u;

      if ((residue == 1) || (residue == 7)) {
      if ((residue == 1u) || (residue == 7u)) {
         s = 1;
      } else if ((residue == 3) || (residue == 5)) {
      } else if ((residue == 3u) || (residue == 5u)) {
         s = -1;
      }
   }

   /* step 5.  if p == 3 (mod 4) *and* a1 == 3 (mod 4) then s = -s */
   if (((n->dp[0] & 3) == 3) && ((a1.dp[0] & 3) == 3)) {
   if (((n->dp[0] & 3u) == 3u) && ((a1.dp[0] & 3u) == 3u)) {
      s = -s;
   }

   /* if a1 == 1 we're done */
   if (mp_cmp_d(&a1, 1) == MP_EQ) {
   if (mp_cmp_d(&a1, 1uL) == MP_EQ) {
      *c = s;
   } else {
      /* n1 = n mod a1 */
      if ((res = mp_mod(n, &a1, &p1)) != MP_OKAY) {
         goto LBL_P1;
      }
      if ((res = mp_jacobi(&p1, &a1, &r)) != MP_OKAY) {

Changes to libtommath/bn_mp_karatsuba_mul.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_KARATSUBA_MUL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* c = |a| * |b| using Karatsuba Multiplication using
 * three half size multiplications
 *
 * Let B represent the radix [e.g. 2**DIGIT_BIT] and
 * let n represent half of the number of digits in
56
57
58
59
60
61
62
63

64
65
66
67
68
69
70
54
55
56
57
58
59
60

61
62
63
64
65
66
67
68







-
+







   B = MIN(a->used, b->used);

   /* now divide in two */
   B = B >> 1;

   /* init copy all the temps */
   if (mp_init_size(&x0, B) != MP_OKAY)
      goto ERR;
      goto LBL_ERR;
   if (mp_init_size(&x1, a->used - B) != MP_OKAY)
      goto X0;
   if (mp_init_size(&y0, B) != MP_OKAY)
      goto X1;
   if (mp_init_size(&y1, b->used - B) != MP_OKAY)
      goto Y0;

160
161
162
163
164
165
166
167

168
169
170
171
172
173
174
158
159
160
161
162
163
164

165
166
167
168
169
170
171
172







-
+







   mp_clear(&y1);
Y0:
   mp_clear(&y0);
X1:
   mp_clear(&x1);
X0:
   mp_clear(&x0);
ERR:
LBL_ERR:
   return err;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_karatsuba_sqr.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_KARATSUBA_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* Karatsuba squaring, computes b = a*a using three
 * half size squarings
 *
 * See comments of karatsuba_mul for details.  It
 * is essentially the same algorithm but merely
33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
31
32
33
34
35
36
37

38
39
40
41
42
43
44
45







-
+







   B = a->used;

   /* now divide in two */
   B = B >> 1;

   /* init copy all the temps */
   if (mp_init_size(&x0, B) != MP_OKAY)
      goto ERR;
      goto LBL_ERR;
   if (mp_init_size(&x1, a->used - B) != MP_OKAY)
      goto X0;

   /* init temps */
   if (mp_init_size(&t1, a->used * 2) != MP_OKAY)
      goto X1;
   if (mp_init_size(&t2, a->used * 2) != MP_OKAY)
113
114
115
116
117
118
119
120

121
122
123
124
125
126
127
111
112
113
114
115
116
117

118
119
120
121
122
123
124
125







-
+







   mp_clear(&t2);
T1:
   mp_clear(&t1);
X1:
   mp_clear(&x1);
X0:
   mp_clear(&x0);
ERR:
LBL_ERR:
   return err;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_lcm.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_LCM_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* computes least common multiple as |a*b|/(a, b) */
int mp_lcm(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     res;
   mp_int  t1, t2;

Changes to libtommath/bn_mp_lshd.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25




26
27
28
29
30
31
32

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
-
+












-
-










+
+
+
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_LSHD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* shift left a certain amount of digits */
int mp_lshd(mp_int *a, int b)
{
   int     x, res;

   /* if its less than zero return */
   if (b <= 0) {
      return MP_OKAY;
   }
   /* no need to shift 0 around */
   if (mp_iszero(a) == MP_YES) {
      return MP_OKAY;
   }

   /* grow to fit the new digits */
   if (a->alloc < (a->used + b)) {
      if ((res = mp_grow(a, a->used + b)) != MP_OKAY) {
         return res;
      }

Changes to libtommath/bn_mp_mod.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* c = a mod b, 0 <= c < b if b > 0, b < c <= 0 if b < 0 */
int mp_mod(const mp_int *a, const mp_int *b, mp_int *c)
{
   mp_int  t;
   int     res;

Changes to libtommath/bn_mp_mod_2d.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
51
52
-
+












-
-














-
+















-
+








#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MOD_2D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* calc a value mod 2**b */
int mp_mod_2d(const mp_int *a, int b, mp_int *c)
{
   int     x, res;

   /* if b is <= 0 then zero the int */
   if (b <= 0) {
      mp_zero(c);
      return MP_OKAY;
   }

   /* if the modulus is larger than the value than return */
   if (b >= (int)(a->used * DIGIT_BIT)) {
   if (b >= (a->used * DIGIT_BIT)) {
      res = mp_copy(a, c);
      return res;
   }

   /* copy */
   if ((res = mp_copy(a, c)) != MP_OKAY) {
      return res;
   }

   /* zero digits above the last digit of the modulus */
   for (x = (b / DIGIT_BIT) + (((b % DIGIT_BIT) == 0) ? 0 : 1); x < c->used; x++) {
      c->dp[x] = 0;
   }
   /* clear the digit that is not completely outside/inside the modulus */
   c->dp[b / DIGIT_BIT] &=
      (mp_digit)((((mp_digit) 1) << (((mp_digit) b) % DIGIT_BIT)) - ((mp_digit) 1));
      ((mp_digit)1 << (mp_digit)(b % DIGIT_BIT)) - (mp_digit)1;
   mp_clamp(c);
   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_mod_d.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MOD_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

int mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c)
{
   return mp_div_d(a, b, NULL, c);
}
#endif

Changes to libtommath/bn_mp_montgomery_calc_normalization.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

34
35
36
37
38
39
40
41
-
+












-
-




















-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MONTGOMERY_CALC_NORMALIZATION_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/*
 * shifts with subtractions when the result is greater than b.
 *
 * The method is slightly modified to shift B unconditionally upto just under
 * the leading bit of b.  This saves alot of multiple precision shifting.
 */
int mp_montgomery_calc_normalization(mp_int *a, const mp_int *b)
{
   int     x, bits, res;

   /* how many bits of last digit does b use */
   bits = mp_count_bits(b) % DIGIT_BIT;

   if (b->used > 1) {
      if ((res = mp_2expt(a, ((b->used - 1) * DIGIT_BIT) + bits - 1)) != MP_OKAY) {
         return res;
      }
   } else {
      mp_set(a, 1);
      mp_set(a, 1uL);
      bits = 1;
   }


   /* now compute C = A * B mod b */
   for (x = bits - 1; x < (int)DIGIT_BIT; x++) {
      if ((res = mp_mul_2(a, a)) != MP_OKAY) {

Changes to libtommath/bn_mp_montgomery_reduce.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

31

32
33

34
35
36
37
38
39
40

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31

32
33
34
35
36
37
38
39
-
+












-
-















+
-
+

-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MONTGOMERY_REDUCE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* computes xR**-1 == x (mod N) via Montgomery Reduction */
int mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho)
{
   int     ix, res, digs;
   mp_digit mu;

   /* can the fast reduction [comba] method be used?
    *
    * Note that unlike in mul you're safely allowed *less*
    * than the available columns [255 per default] since carries
    * are fixed up in the inner loop.
    */
   digs = (n->used * 2) + 1;
   if ((digs < (int)MP_WARRAY) &&
   if ((digs < MP_WARRAY) &&
       (x->used <= (int)MP_WARRAY) &&
       (n->used <
        (1 << ((CHAR_BIT * sizeof(mp_word)) - (2 * DIGIT_BIT))))) {
        (int)(1u << (((size_t)CHAR_BIT * sizeof(mp_word)) - (2u * (size_t)DIGIT_BIT))))) {
      return fast_mp_montgomery_reduce(x, n, rho);
   }

   /* grow the input as required */
   if (x->alloc < digs) {
      if ((res = mp_grow(x, digs)) != MP_OKAY) {
         return res;
68
69
70
71
72
73
74
75

76
77
78

79
80
81

82
83
84
85
86
87

88
89
90
91
92
93
94
67
68
69
70
71
72
73

74
75
76

77
78
79

80
81
82
83
84
85

86
87
88
89
90
91
92
93







-
+


-
+


-
+





-
+







         /* set the carry to zero */
         u = 0;

         /* Multiply and add in place */
         for (iy = 0; iy < n->used; iy++) {
            /* compute product and sum */
            r       = ((mp_word)mu * (mp_word)*tmpn++) +
                      (mp_word) u + (mp_word) *tmpx;
                      (mp_word)u + (mp_word)*tmpx;

            /* get carry */
            u       = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
            u       = (mp_digit)(r >> (mp_word)DIGIT_BIT);

            /* fix digit */
            *tmpx++ = (mp_digit)(r & ((mp_word) MP_MASK));
            *tmpx++ = (mp_digit)(r & (mp_word)MP_MASK);
         }
         /* At this point the ix'th digit of x should be zero */


         /* propagate carries upwards as required*/
         while (u != 0) {
         while (u != 0u) {
            *tmpx   += u;
            u        = *tmpx >> DIGIT_BIT;
            *tmpx++ &= MP_MASK;
         }
      }
   }

Changes to libtommath/bn_mp_montgomery_setup.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

34
35
36
37
38


39
40

41
42
43

44
45
46

47
48
49
50

51
52
53
54
55
56
57
58

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

31
32
33
34


35
36
37

38
39
40

41
42
43

44
45
46
47

48
49
50
51
52
53
54
55
56
-
+












-
-

















-
+



-
-
+
+

-
+


-
+


-
+



-
+








#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MONTGOMERY_SETUP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* setups the montgomery reduction stuff */
int mp_montgomery_setup(const mp_int *n, mp_digit *rho)
{
   mp_digit x, b;

   /* fast inversion mod 2**k
    *
    * Based on the fact that
    *
    * XA = 1 (mod 2**n)  =>  (X(2-XA)) A = 1 (mod 2**2n)
    *                    =>  2*X*A - X*X*A*A = 1
    *                    =>  2*(1) - (1)     = 1
    */
   b = n->dp[0];

   if ((b & 1) == 0) {
   if ((b & 1u) == 0u) {
      return MP_VAL;
   }

   x = (((b + 2) & 4) << 1) + b; /* here x*a==1 mod 2**4 */
   x *= 2 - (b * x);             /* here x*a==1 mod 2**8 */
   x = (((b + 2u) & 4u) << 1) + b; /* here x*a==1 mod 2**4 */
   x *= 2u - (b * x);              /* here x*a==1 mod 2**8 */
#if !defined(MP_8BIT)
   x *= 2 - (b * x);             /* here x*a==1 mod 2**16 */
   x *= 2u - (b * x);              /* here x*a==1 mod 2**16 */
#endif
#if defined(MP_64BIT) || !(defined(MP_8BIT) || defined(MP_16BIT))
   x *= 2 - (b * x);             /* here x*a==1 mod 2**32 */
   x *= 2u - (b * x);              /* here x*a==1 mod 2**32 */
#endif
#ifdef MP_64BIT
   x *= 2 - (b * x);             /* here x*a==1 mod 2**64 */
   x *= 2u - (b * x);              /* here x*a==1 mod 2**64 */
#endif

   /* rho = -1/m mod b */
   *rho = (mp_digit)(((mp_word)1 << ((mp_word) DIGIT_BIT)) - x) & MP_MASK;
   *rho = (mp_digit)(((mp_word)1 << (mp_word)DIGIT_BIT) - x) & MP_MASK;

   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_mul.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MUL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* high level multiplication (handles sign) */
int mp_mul(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     res, neg;
   neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG;
39
40
41
42
43
44
45
46

47
48

49
50
51
52
53
54
55
37
38
39
40
41
42
43

44
45

46
47
48
49
50
51
52
53







-
+

-
+







          * The fast multiplier can be used if the output will
          * have less than MP_WARRAY digits and the number of
          * digits won't affect carry propagation
          */
         int     digs = a->used + b->used + 1;

#ifdef BN_FAST_S_MP_MUL_DIGS_C
         if ((digs < MP_WARRAY) &&
         if ((digs < (int)MP_WARRAY) &&
             (MIN(a->used, b->used) <=
              (1 << ((CHAR_BIT * sizeof(mp_word)) - (2 * DIGIT_BIT))))) {
              (int)(1u << (((size_t)CHAR_BIT * sizeof(mp_word)) - (2u * (size_t)DIGIT_BIT))))) {
            res = fast_s_mp_mul_digs(a, b, c, digs);
         } else
#endif
         {
#ifdef BN_S_MP_MUL_DIGS_C
            res = s_mp_mul(a, b, c); /* uses s_mp_mul_digs */
#else

Changes to libtommath/bn_mp_mul_2.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MUL_2_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* b = a*2 */
int mp_mul_2(const mp_int *a, mp_int *b)
{
   int     x, res, oldused;

42
43
44
45
46
47
48
49

50
51
52

53
54
55
56
57
58
59
60
61

62
63
64
65
66
67
68
40
41
42
43
44
45
46

47
48
49

50
51
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66







-
+


-
+








-
+







      /* carry */
      r = 0;
      for (x = 0; x < a->used; x++) {

         /* get what will be the *next* carry bit from the
          * MSB of the current digit
          */
         rr = *tmpa >> ((mp_digit)(DIGIT_BIT - 1));
         rr = *tmpa >> (mp_digit)(DIGIT_BIT - 1);

         /* now shift up this digit, add in the carry [from the previous] */
         *tmpb++ = ((*tmpa++ << ((mp_digit)1)) | r) & MP_MASK;
         *tmpb++ = ((*tmpa++ << 1uL) | r) & MP_MASK;

         /* copy the carry that would be from the source
          * digit into the next iteration
          */
         r = rr;
      }

      /* new leading digit? */
      if (r != 0) {
      if (r != 0u) {
         /* add a MSB which is always 1 at this point */
         *tmpb = 1;
         ++(b->used);
      }

      /* now zero any excess digits on the destination
       * that we didn't write to

Changes to libtommath/bn_mp_mul_2d.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38

39
40
41
42
43
44
45
46

47
48
49
50
51

52
53
54

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35

36
37
38
39
40
41
42
43

44
45
46
47
48

49
50
51

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

72
73
74
75
76
77
78
79
80
81
82
83
-
+












-
-















-
+






-
+







-
+




-
+


-
+



















-
+











#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MUL_2D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* shift left by a certain bit count */
int mp_mul_2d(const mp_int *a, int b, mp_int *c)
{
   mp_digit d;
   int      res;

   /* copy */
   if (a != c) {
      if ((res = mp_copy(a, c)) != MP_OKAY) {
         return res;
      }
   }

   if (c->alloc < (int)(c->used + (b / DIGIT_BIT) + 1)) {
   if (c->alloc < (c->used + (b / DIGIT_BIT) + 1)) {
      if ((res = mp_grow(c, c->used + (b / DIGIT_BIT) + 1)) != MP_OKAY) {
         return res;
      }
   }

   /* shift by as many digits in the bit count */
   if (b >= (int)DIGIT_BIT) {
   if (b >= DIGIT_BIT) {
      if ((res = mp_lshd(c, b / DIGIT_BIT)) != MP_OKAY) {
         return res;
      }
   }

   /* shift any bit count < DIGIT_BIT */
   d = (mp_digit)(b % DIGIT_BIT);
   if (d != 0) {
   if (d != 0u) {
      mp_digit *tmpc, shift, mask, r, rr;
      int x;

      /* bitmask for carries */
      mask = (((mp_digit)1) << d) - 1;
      mask = ((mp_digit)1 << d) - (mp_digit)1;

      /* shift for msbs */
      shift = DIGIT_BIT - d;
      shift = (mp_digit)DIGIT_BIT - d;

      /* alias */
      tmpc = c->dp;

      /* carry */
      r    = 0;
      for (x = 0; x < c->used; x++) {
         /* get the higher bits of the current word */
         rr = (*tmpc >> shift) & mask;

         /* shift the current word and OR in the carry */
         *tmpc = ((*tmpc << d) | r) & MP_MASK;
         ++tmpc;

         /* set the carry to the carry bits of the current word */
         r = rr;
      }

      /* set final carry */
      if (r != 0) {
      if (r != 0u) {
         c->dp[(c->used)++] = r;
      }
   }
   mp_clamp(c);
   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_mul_d.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MUL_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* multiply by a digit */
int mp_mul_d(const mp_int *a, mp_digit b, mp_int *c)
{
   mp_digit u, *tmpa, *tmpc;
   mp_word  r;
46
47
48
49
50
51
52
53

54
55
56

57
58
59
60
61
62
63
44
45
46
47
48
49
50

51
52
53

54
55
56
57
58
59
60
61







-
+


-
+








   /* compute columns */
   for (ix = 0; ix < a->used; ix++) {
      /* compute product and carry sum for this term */
      r       = (mp_word)u + ((mp_word)*tmpa++ * (mp_word)b);

      /* mask off higher bits to get a single digit */
      *tmpc++ = (mp_digit)(r & ((mp_word)MP_MASK));
      *tmpc++ = (mp_digit)(r & (mp_word)MP_MASK);

      /* send carry into next iteration */
      u       = (mp_digit)(r >> ((mp_word)DIGIT_BIT));
      u       = (mp_digit)(r >> (mp_word)DIGIT_BIT);
   }

   /* store final carry [if any] and increment ix offset  */
   *tmpc++ = u;
   ++ix;

   /* now zero digits above the top */

Changes to libtommath/bn_mp_mulmod.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_MULMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* d = a * b (mod c) */
int mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d)
{
   int     res;
   mp_int  t;

Changes to libtommath/bn_mp_n_root.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_N_ROOT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* wrapper function for mp_n_root_ex()
 * computes c = (a)**(1/b) such that (c)**b <= a and (c+1)**b > a
 */
int mp_n_root(const mp_int *a, mp_digit b, mp_int *c)
{

Changes to libtommath/bn_mp_n_root_ex.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

56
57
58
59
60
61
62
63
64
65
66

67
68
69
70
71
72
73

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

53
54
55
56
57
58
59
60
61
62
63

64
65
66
67
68
69
70
71
-
+












-
-


















-
+




















-
+










-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_N_ROOT_EX_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* find the n'th root of an integer
 *
 * Result found such that (c)**b <= a and (c+1)**b > a
 *
 * This algorithm uses Newton's approximation
 * x[i+1] = x[i] - f(x[i])/f'(x[i])
 * which will find the root in log(N) time where
 * each step involves a fair bit.  This is not meant to
 * find huge roots [square and cube, etc].
 */
int mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast)
{
   mp_int  t1, t2, t3, a_;
   int     res;

   /* input must be positive if b is even */
   if (((b & 1) == 0) && (a->sign == MP_NEG)) {
   if (((b & 1u) == 0u) && (a->sign == MP_NEG)) {
      return MP_VAL;
   }

   if ((res = mp_init(&t1)) != MP_OKAY) {
      return res;
   }

   if ((res = mp_init(&t2)) != MP_OKAY) {
      goto LBL_T1;
   }

   if ((res = mp_init(&t3)) != MP_OKAY) {
      goto LBL_T2;
   }

   /* if a is negative fudge the sign but keep track */
   a_ = *a;
   a_.sign = MP_ZPOS;

   /* t2 = 2 */
   mp_set(&t2, 2);
   mp_set(&t2, 2uL);

   do {
      /* t1 = t2 */
      if ((res = mp_copy(&t2, &t1)) != MP_OKAY) {
         goto LBL_T3;
      }

      /* t2 = t1 - ((t1**b - a) / (b * t1**(b-1))) */

      /* t3 = t1**(b-1) */
      if ((res = mp_expt_d_ex(&t1, b - 1, &t3, fast)) != MP_OKAY) {
      if ((res = mp_expt_d_ex(&t1, b - 1u, &t3, fast)) != MP_OKAY) {
         goto LBL_T3;
      }

      /* numerator */
      /* t2 = t1**b */
      if ((res = mp_mul(&t3, &t1, &t2)) != MP_OKAY) {
         goto LBL_T3;
97
98
99
100
101
102
103
104

105
106
107
108
109
110
111
95
96
97
98
99
100
101

102
103
104
105
106
107
108
109







-
+







   /* result can be off by a few so check */
   for (;;) {
      if ((res = mp_expt_d_ex(&t1, b, &t2, fast)) != MP_OKAY) {
         goto LBL_T3;
      }

      if (mp_cmp(&t2, &a_) == MP_GT) {
         if ((res = mp_sub_d(&t1, 1, &t1)) != MP_OKAY) {
         if ((res = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY) {
            goto LBL_T3;
         }
      } else {
         break;
      }
   }

Changes to libtommath/bn_mp_neg.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_NEG_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* b = -a */
int mp_neg(const mp_int *a, mp_int *b)
{
   int     res;
   if (a != b) {

Changes to libtommath/bn_mp_or.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_OR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* OR two ints together */
int mp_or(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     res, ix, px;
   mp_int  t;

Changes to libtommath/bn_mp_prime_fermat.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
-
+












-
-



















-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_PRIME_FERMAT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* performs one Fermat test.
 *
 * If "a" were prime then b**a == b (mod a) since the order of
 * the multiplicative sub-group would be phi(a) = a-1.  That means
 * it would be the same as b**(a mod (a-1)) == b**1 == b (mod a).
 *
 * Sets result to 1 if the congruence holds, or zero otherwise.
 */
int mp_prime_fermat(const mp_int *a, const mp_int *b, int *result)
{
   mp_int  t;
   int     err;

   /* default to composite  */
   *result = MP_NO;

   /* ensure b > 1 */
   if (mp_cmp_d(b, 1) != MP_GT) {
   if (mp_cmp_d(b, 1uL) != MP_GT) {
      return MP_VAL;
   }

   /* init t */
   if ((err = mp_init(&t)) != MP_OKAY) {
      return err;
   }

Changes to libtommath/bn_mp_prime_is_divisible.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_PRIME_IS_DIVISIBLE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* determines if an integers is divisible by one
 * of the first PRIME_SIZE primes or not
 *
 * sets result to 0 if not, 1 if yes
 */
31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
46
47
48
49
50
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43
44
45
46
47
48







-
+












   for (ix = 0; ix < PRIME_SIZE; ix++) {
      /* what is a mod LBL_prime_tab[ix] */
      if ((err = mp_mod_d(a, ltm_prime_tab[ix], &res)) != MP_OKAY) {
         return err;
      }

      /* is the residue zero? */
      if (res == 0) {
      if (res == 0u) {
         *result = MP_YES;
         return MP_OKAY;
      }
   }

   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_prime_is_prime.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_PRIME_IS_PRIME_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* performs a variable number of rounds of Miller-Rabin
 *
 * Probability of error after t rounds is no more than

 *

Changes to libtommath/bn_mp_prime_miller_rabin.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42

43
44
45
46
47
48
49

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
-
+












-
-


















-
+







-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_PRIME_MILLER_RABIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* Miller-Rabin test of "a" to the base of "b" as described in
 * HAC pp. 139 Algorithm 4.24
 *
 * Sets result to 0 if definitely composite or 1 if probably prime.
 * Randomly the chance of error is no more than 1/4 and often
 * very much lower.
 */
int mp_prime_miller_rabin(const mp_int *a, const mp_int *b, int *result)
{
   mp_int  n1, y, r;
   int     s, j, err;

   /* default */
   *result = MP_NO;

   /* ensure b > 1 */
   if (mp_cmp_d(b, 1) != MP_GT) {
   if (mp_cmp_d(b, 1uL) != MP_GT) {
      return MP_VAL;
   }

   /* get n1 = a - 1 */
   if ((err = mp_init_copy(&n1, a)) != MP_OKAY) {
      return err;
   }
   if ((err = mp_sub_d(&n1, 1, &n1)) != MP_OKAY) {
   if ((err = mp_sub_d(&n1, 1uL, &n1)) != MP_OKAY) {
      goto LBL_N1;
   }

   /* set 2**s * r = n1 */
   if ((err = mp_init_copy(&r, &n1)) != MP_OKAY) {
      goto LBL_N1;
   }
63
64
65
66
67
68
69
70

71
72
73
74
75
76
77
78
79

80
81
82
83
84
85
86
61
62
63
64
65
66
67

68
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
84







-
+








-
+







      goto LBL_R;
   }
   if ((err = mp_exptmod(b, &r, a, &y)) != MP_OKAY) {
      goto LBL_Y;
   }

   /* if y != 1 and y != n1 do */
   if ((mp_cmp_d(&y, 1) != MP_EQ) && (mp_cmp(&y, &n1) != MP_EQ)) {
   if ((mp_cmp_d(&y, 1uL) != MP_EQ) && (mp_cmp(&y, &n1) != MP_EQ)) {
      j = 1;
      /* while j <= s-1 and y != n1 */
      while ((j <= (s - 1)) && (mp_cmp(&y, &n1) != MP_EQ)) {
         if ((err = mp_sqrmod(&y, a, &y)) != MP_OKAY) {
            goto LBL_Y;
         }

         /* if y == 1 then composite */
         if (mp_cmp_d(&y, 1) == MP_EQ) {
         if (mp_cmp_d(&y, 1uL) == MP_EQ) {
            goto LBL_Y;
         }

         ++j;
      }

      /* if y != n1 then composite */

Changes to libtommath/bn_mp_prime_next_prime.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_PRIME_NEXT_PRIME_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* finds the next prime after the number "a" using "t" trials
 * of Miller-Rabin.
 *
 * bbs_style = 1 means the prime must be congruent to 3 mod 4
 */
42
43
44
45
46
47
48
49

50
51
52

53
54
55
56
57
58
59
60
61
62
63
64
65
66


67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84


85
86
87
88
89
90
91

92
93
94
95
96
97
98
40
41
42
43
44
45
46

47
48
49

50
51
52
53
54
55
56
57
58
59
60
61
62


63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80


81
82
83
84
85
86
87
88

89
90
91
92
93
94
95
96







-
+


-
+












-
-
+
+
















-
-
+
+






-
+







            if (bbs_style == 1) {
               /* ok we found a prime smaller or
                * equal [so the next is larger]
                *
                * however, the prime must be
                * congruent to 3 mod 4
                */
               if ((ltm_prime_tab[x + 1] & 3) != 3) {
               if ((ltm_prime_tab[x + 1] & 3u) != 3u) {
                  /* scan upwards for a prime congruent to 3 mod 4 */
                  for (y = x + 1; y < PRIME_SIZE; y++) {
                     if ((ltm_prime_tab[y] & 3) == 3) {
                     if ((ltm_prime_tab[y] & 3u) == 3u) {
                        mp_set(a, ltm_prime_tab[y]);
                        return MP_OKAY;
                     }
                  }
               }
            } else {
               mp_set(a, ltm_prime_tab[x + 1]);
               return MP_OKAY;
            }
         }
      }
      /* at this point a maybe 1 */
      if (mp_cmp_d(a, 1) == MP_EQ) {
         mp_set(a, 2);
      if (mp_cmp_d(a, 1uL) == MP_EQ) {
         mp_set(a, 2uL);
         return MP_OKAY;
      }
      /* fall through to the sieve */
   }

   /* generate a prime congruent to 3 mod 4 or 1/3 mod 4? */
   if (bbs_style == 1) {
      kstep   = 4;
   } else {
      kstep   = 2;
   }

   /* at this point we will use a combination of a sieve and Miller-Rabin */

   if (bbs_style == 1) {
      /* if a mod 4 != 3 subtract the correct value to make it so */
      if ((a->dp[0] & 3) != 3) {
         if ((err = mp_sub_d(a, (a->dp[0] & 3) + 1, a)) != MP_OKAY) {
      if ((a->dp[0] & 3u) != 3u) {
         if ((err = mp_sub_d(a, (a->dp[0] & 3u) + 1u, a)) != MP_OKAY) {
            return err;
         };
      }
   } else {
      if (mp_iseven(a) == MP_YES) {
         /* force odd */
         if ((err = mp_sub_d(a, 1, a)) != MP_OKAY) {
         if ((err = mp_sub_d(a, 1uL, a)) != MP_OKAY) {
            return err;
         }
      }
   }

   /* generate the restable */
   for (x = 1; x < PRIME_SIZE; x++) {
123
124
125
126
127
128
129
130

131
132
133
134

135
136
137
138
139
140
141
142

143
144
145
146
147
148
149
121
122
123
124
125
126
127

128
129
130
131

132
133
134
135
136
137
138
139

140
141
142
143
144
145
146
147







-
+



-
+







-
+








            /* subtract the modulus [instead of using division] */
            if (res_tab[x] >= ltm_prime_tab[x]) {
               res_tab[x]  -= ltm_prime_tab[x];
            }

            /* set flag if zero */
            if (res_tab[x] == 0) {
            if (res_tab[x] == 0u) {
               y = 1;
            }
         }
      } while ((y == 1) && (step < ((((mp_digit)1) << DIGIT_BIT) - kstep)));
      } while ((y == 1) && (step < (((mp_digit)1 << DIGIT_BIT) - kstep)));

      /* add the step */
      if ((err = mp_add_d(a, step, a)) != MP_OKAY) {
         goto LBL_ERR;
      }

      /* if didn't pass sieve and step == MAX then skip test */
      if ((y == 1) && (step >= ((((mp_digit)1) << DIGIT_BIT) - kstep))) {
      if ((y == 1) && (step >= (((mp_digit)1 << DIGIT_BIT) - kstep))) {
         continue;
      }

      /* is this prime? */
      for (x = 0; x < t; x++) {
         mp_set(&b, ltm_prime_tab[x]);
         if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) {

Changes to libtommath/bn_mp_prime_rabin_miller_trials.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_PRIME_RABIN_MILLER_TRIALS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */


static const struct {
   int k, t;
} sizes[] = {
   {   128,    28 },

Changes to libtommath/bn_mp_prime_random_ex.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_PRIME_RANDOM_EX_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* makes a truly random prime of a given size (bits),
 *
 * Flags are as follows:
 *
 *   LTM_PRIME_BBS      - make prime congruent to 3 mod 4
45
46
47
48
49
50
51
52

53
54
55
56
57
58
59
43
44
45
46
47
48
49

50
51
52
53
54
55
56
57







-
+







      flags |= LTM_PRIME_BBS;
   }

   /* calc the byte size */
   bsize = (size>>3) + ((size&7)?1:0);

   /* we need a buffer of bsize bytes */
   tmp = OPT_CAST(unsigned char) XMALLOC(bsize);
   tmp = OPT_CAST(unsigned char) XMALLOC((size_t)bsize);
   if (tmp == NULL) {
      return MP_MEM;
   }

   /* calc the maskAND value for the MSbyte*/
   maskAND = ((size&7) == 0) ? 0xFF : (0xFF >> (8 - (size & 7)));

82
83
84
85
86
87
88
89

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
128
129
80
81
82
83
84
85
86

87
88
89
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







-
+




-
+








-
+


-
+




-
+







-
+


-
+







      tmp[0]    |= 1 << ((size - 1) & 7);

      /* mix in the maskORs */
      tmp[maskOR_msb_offset]   |= maskOR_msb;
      tmp[bsize-1]             |= maskOR_lsb;

      /* read it in */
      if ((err = mp_read_unsigned_bin(a, tmp, bsize)) != MP_OKAY)     {
      if ((err = mp_read_unsigned_bin(a, tmp, bsize)) != MP_OKAY) {
         goto error;
      }

      /* is it prime? */
      if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY)           {
      if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) {
         goto error;
      }
      if (res == MP_NO) {
         continue;
      }

      if ((flags & LTM_PRIME_SAFE) != 0) {
         /* see if (a-1)/2 is prime */
         if ((err = mp_sub_d(a, 1, a)) != MP_OKAY)                    {
         if ((err = mp_sub_d(a, 1uL, a)) != MP_OKAY) {
            goto error;
         }
         if ((err = mp_div_2(a, a)) != MP_OKAY)                       {
         if ((err = mp_div_2(a, a)) != MP_OKAY) {
            goto error;
         }

         /* is it prime? */
         if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY)        {
         if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) {
            goto error;
         }
      }
   } while (res == MP_NO);

   if ((flags & LTM_PRIME_SAFE) != 0) {
      /* restore a to the original value */
      if ((err = mp_mul_2(a, a)) != MP_OKAY)                          {
      if ((err = mp_mul_2(a, a)) != MP_OKAY) {
         goto error;
      }
      if ((err = mp_add_d(a, 1, a)) != MP_OKAY)                       {
      if ((err = mp_add_d(a, 1uL, a)) != MP_OKAY) {
         goto error;
      }
   }

   err = MP_OKAY;
error:
   XFREE(tmp);

Changes to libtommath/bn_mp_radix_size.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_RADIX_SIZE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* returns size of ASCII reprensentation */
int mp_radix_size(const mp_int *a, int radix, int *size)
{
   int     res, digs;
   mp_int  t;

Changes to libtommath/bn_mp_radix_smap.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19















20
21
22
23
24

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
-
+












-
-



-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_RADIX_SMAP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* chars used in radix conversions */
const char *mp_s_rmap = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/";
const char *const mp_s_rmap = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/";
const unsigned char mp_s_rmap_reverse[] = {
   0xff, 0xff, 0xff, 0x3e, 0xff, 0xff, 0xff, 0x3f, /* ()*+,-./ */
   0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, /* 01234567 */
   0x08, 0x09, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, /* 89:;<=>? */
   0xff, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, /* @ABCDEFG */
   0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, /* HIJKLMNO */
   0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, /* PQRSTUVW */
   0x21, 0x22, 0x23, 0xff, 0xff, 0xff, 0xff, 0xff, /* XYZ[\]^_ */
   0xff, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2a, /* `abcdefg */
   0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, /* hijklmno */
   0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, /* pqrstuvw */
   0x3b, 0x3c, 0x3d, 0xff, 0xff, 0xff, 0xff, 0xff, /* xyz{|}~. */
};
const size_t mp_s_rmap_reverse_sz = sizeof(mp_s_rmap_reverse);
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_rand.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15





16
17

18
19

20
21
22

23
24
25

26
27
28
29
30
31

32
33
34
35
36

37
38
39

















































































































































40
41


42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57




58
59
60
61
62
63
64
65
66
67



68

69
70
71
72
73
74
75
76
77
78
79

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19

20


21



22



23



24


25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178


179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194


195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

212
213
214
215
216
217
218
219
220
221
222
223
-
+












-
-
+
+
+
+
+

-
+
-
-
+
-
-
-
+
-
-
-
+
-
-
-

-
-
+




-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+














-
-
+
+
+
+










+
+
+
-
+











#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_RAND_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* First the OS-specific special cases
 * - *BSD
 * - Windows
 */

#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__)
#if MP_GEN_RANDOM_MAX == 0xffffffff
#define MP_GEN_RANDOM_SHIFT  32
#define MP_ARC4RANDOM
#elif MP_GEN_RANDOM_MAX == 32767
/* SHRT_MAX */
#define MP_GEN_RANDOM_SHIFT  15
#define MP_GEN_RANDOM_MAX     0xffffffffu
#elif MP_GEN_RANDOM_MAX == 2147483647
/* INT_MAX */
#define MP_GEN_RANDOM_SHIFT  31
#define MP_GEN_RANDOM_SHIFT   32
#elif !defined(MP_GEN_RANDOM_SHIFT)
#error Thou shalt define their own valid MP_GEN_RANDOM_SHIFT
#endif

/* makes a pseudo-random int of a given size */
static mp_digit s_gen_random(void)
static int s_read_arc4random(mp_digit *p)
{
   mp_digit d = 0, msk = 0;
   do {
      d <<= MP_GEN_RANDOM_SHIFT;
      d |= ((mp_digit) MP_GEN_RANDOM());
      d |= ((mp_digit) arc4random());
      msk <<= MP_GEN_RANDOM_SHIFT;
      msk |= (MP_MASK & MP_GEN_RANDOM_MAX);
   } while ((MP_MASK & msk) != MP_MASK);
   *p = d;
   return MP_OKAY;
}
#endif

#if defined(_WIN32) || defined(_WIN32_WCE)
#define MP_WIN_CSP

#ifndef _WIN32_WINNT
#define _WIN32_WINNT 0x0400
#endif
#ifdef _WIN32_WCE
#define UNDER_CE
#define ARM
#endif

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <wincrypt.h>

static HCRYPTPROV hProv = 0;

static void s_cleanup_win_csp(void)
{
   CryptReleaseContext(hProv, 0);
   hProv = 0;
}

static int s_read_win_csp(mp_digit *p)
{
   int ret = -1;
   if (hProv == 0) {
      if (!CryptAcquireContext(&hProv, NULL, MS_DEF_PROV, PROV_RSA_FULL,
                               (CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET)) &&
          !CryptAcquireContext(&hProv, NULL, MS_DEF_PROV, PROV_RSA_FULL,
                               CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET | CRYPT_NEWKEYSET)) {
         hProv = 0;
         return ret;
      }
      atexit(s_cleanup_win_csp);
   }
   if (CryptGenRandom(hProv, sizeof(*p), (void *)p) == TRUE) {
      ret = MP_OKAY;
   }
   return ret;
}
#endif /* WIN32 */

#if !defined(MP_WIN_CSP) && defined(__linux__) && defined(__GLIBC_PREREQ)
#if __GLIBC_PREREQ(2, 25)
#define MP_GETRANDOM
#include <sys/random.h>
#include <errno.h>

static int s_read_getrandom(mp_digit *p)
{
   int ret;
   do {
      ret = getrandom(p, sizeof(*p), 0);
   } while ((ret == -1) && (errno == EINTR));
   if (ret == sizeof(*p)) return MP_OKAY;
   return -1;
}
#endif
#endif

/* We assume all platforms besides windows provide "/dev/urandom".
 * In case yours doesn't, define MP_NO_DEV_URANDOM at compile-time.
 */
#if !defined(MP_WIN_CSP) && !defined(MP_NO_DEV_URANDOM)
#ifndef MP_DEV_URANDOM
#define MP_DEV_URANDOM "/dev/urandom"
#endif
#include <fcntl.h>
#include <errno.h>
#include <unistd.h>

static int s_read_dev_urandom(mp_digit *p)
{
   ssize_t r;
   int fd;
   do {
      fd = open(MP_DEV_URANDOM, O_RDONLY);
   } while ((fd == -1) && (errno == EINTR));
   if (fd == -1) return -1;
   do {
      r = read(fd, p, sizeof(*p));
   } while ((r == -1) && (errno == EINTR));
   close(fd);
   if (r != sizeof(*p)) return -1;
   return MP_OKAY;
}
#endif

#if defined(MP_PRNG_ENABLE_LTM_RNG)
unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
void (*ltm_rng_callback)(void);

static int s_read_ltm_rng(mp_digit *p)
{
   unsigned long ret;
   if (ltm_rng == NULL) return -1;
   ret = ltm_rng((void *)p, sizeof(*p), ltm_rng_callback);
   if (ret != sizeof(*p)) return -1;
   return MP_OKAY;
}
#endif

static int s_rand_digit(mp_digit *p)
{
   int ret = -1;

#if defined(MP_ARC4RANDOM)
   ret = s_read_arc4random(p);
   if (ret == MP_OKAY) return ret;
#endif

#if defined(MP_WIN_CSP)
   ret = s_read_win_csp(p);
   if (ret == MP_OKAY) return ret;
#else

#if defined(MP_GETRANDOM)
   ret = s_read_getrandom(p);
   if (ret == MP_OKAY) return ret;
#endif
#if defined(MP_DEV_URANDOM)
   ret = s_read_dev_urandom(p);
   if (ret == MP_OKAY) return ret;
#endif

#endif /* MP_WIN_CSP */

#if defined(MP_PRNG_ENABLE_LTM_RNG)
   ret = s_read_ltm_rng(p);
   if (ret == MP_OKAY) return ret;
#endif

   return ret;
}

/* makes a pseudo-random int of a given size */
static int s_gen_random(mp_digit *r)
{
   int ret = s_rand_digit(r);
   d &= MP_MASK;
   return d;
   *r &= MP_MASK;
   return ret;
}

int mp_rand(mp_int *a, int digits)
{
   int     res;
   mp_digit d;

   mp_zero(a);
   if (digits <= 0) {
      return MP_OKAY;
   }

   /* first place a random non-zero digit */
   do {
      d = s_gen_random();
   } while (d == 0);
      if (s_gen_random(&d) != MP_OKAY) {
         return MP_VAL;
      }
   } while (d == 0u);

   if ((res = mp_add_d(a, d, a)) != MP_OKAY) {
      return res;
   }

   while (--digits > 0) {
      if ((res = mp_lshd(a, 1)) != MP_OKAY) {
         return res;
      }

      if (s_gen_random(&d) != MP_OKAY) {
         return MP_VAL;
      }
      if ((res = mp_add_d(a, s_gen_random(), a)) != MP_OKAY) {
      if ((res = mp_add_d(a, d, a)) != MP_OKAY) {
         return res;
      }
   }

   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_read_radix.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

22
23
24
25
26
27
28

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
-
+












-
-






+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_READ_RADIX_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* read a string [ASCII] in a given radix */
int mp_read_radix(mp_int *a, const char *str, int radix)
{
   int     y, res, neg;
   unsigned pos;
   char    ch;

   /* zero the digit bignum */
   mp_zero(a);

   /* make sure the radix is ok */
   if ((radix < 2) || (radix > 64)) {
45
46
47
48
49
50
51
52
53
54
55




56

57
58
59
60
61
62
63
64
65
66
67








68
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
44
45
46
47
48
49
50




51
52
53
54

55
56
57
58
59
60






61
62
63
64
65
66
67
68



69
70
71
72
73

74
75
76
77
78
79
80
81







-
-
-
-
+
+
+
+
-
+





-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-





-
+







   /* process each digit of the string */
   while (*str != '\0') {
      /* if the radix <= 36 the conversion is case insensitive
       * this allows numbers like 1AB and 1ab to represent the same  value
       * [e.g. in hex]
       */
      ch = (radix <= 36) ? (char)toupper((int)*str) : *str;
      for (y = 0; y < 64; y++) {
         if (ch == mp_s_rmap[y]) {
            break;
         }
      pos = (unsigned)(ch - '(');
      if (mp_s_rmap_reverse_sz < pos) {
         break;
      }
      }
      y = (int)mp_s_rmap_reverse[pos];

      /* if the char was found in the map
       * and is less than the given radix add it
       * to the number, otherwise exit the loop.
       */
      if (y < radix) {
         if ((res = mp_mul_d(a, (mp_digit)radix, a)) != MP_OKAY) {
            return res;
         }
         if ((res = mp_add_d(a, (mp_digit)y, a)) != MP_OKAY) {
            return res;
      if ((y == 0xff) || (y >= radix)) {
         break;
      }
      if ((res = mp_mul_d(a, (mp_digit)radix, a)) != MP_OKAY) {
         return res;
      }
      if ((res = mp_add_d(a, (mp_digit)y, a)) != MP_OKAY) {
         return res;
         }
      } else {
         break;
      }
      ++str;
   }

   /* if an illegal character was found, fail. */
   if (!(*str == '\0' || *str == '\r' || *str == '\n')) {
   if (!((*str == '\0') || (*str == '\r') || (*str == '\n'))) {
      mp_zero(a);
      return MP_VAL;
   }

   /* set the sign only if a != 0 */
   if (mp_iszero(a) != MP_YES) {
      a->sign = neg;

Changes to libtommath/bn_mp_read_signed_bin.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
-
+












-
-













-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_READ_SIGNED_BIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* read signed bin, big endian, first byte is 0==positive or 1==negative */
int mp_read_signed_bin(mp_int *a, const unsigned char *b, int c)
{
   int     res;

   /* read magnitude */
   if ((res = mp_read_unsigned_bin(a, b + 1, c - 1)) != MP_OKAY) {
      return res;
   }

   /* first byte is 0 for positive, non-zero for negative */
   if (b[0] == 0) {
   if (b[0] == (unsigned char)0) {
      a->sign = MP_ZPOS;
   } else {
      a->sign = MP_NEG;
   }

   return MP_OKAY;
}

Changes to libtommath/bn_mp_read_unsigned_bin.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_READ_UNSIGNED_BIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* reads a unsigned char array, assumes the msb is stored first [big endian] */
int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c)
{
   int     res;

37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
52
53
54
55
35
36
37
38
39
40
41

42
43
44
45
46
47
48
49
50
51
52
53







-
+











      }

#ifndef MP_8BIT
      a->dp[0] |= *b++;
      a->used += 1;
#else
      a->dp[0] = (*b & MP_MASK);
      a->dp[1] |= ((*b++ >> 7U) & 1);
      a->dp[1] |= ((*b++ >> 7) & 1u);
      a->used += 2;
#endif
   }
   mp_clamp(a);
   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_reduce.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

34
35
36
37
38
39
40
41
-
+












-
-




















-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_REDUCE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* reduces x mod m, assumes 0 < x < m**2, mu is
 * precomputed via mp_reduce_setup.
 * From HAC pp.604 Algorithm 14.42
 */
int mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu)
{
   mp_int  q;
   int     res, um = m->used;

   /* q = x */
   if ((res = mp_init_copy(&q, x)) != MP_OKAY) {
      return res;
   }

   /* q1 = x / b**(k-1)  */
   mp_rshd(&q, um - 1);

   /* according to HAC this optimization is ok */
   if (((mp_digit) um) > (((mp_digit)1) << (DIGIT_BIT - 1))) {
   if ((mp_digit)um > ((mp_digit)1 << (DIGIT_BIT - 1))) {
      if ((res = mp_mul(&q, mu, &q)) != MP_OKAY) {
         goto CLEANUP;
      }
   } else {
#ifdef BN_S_MP_MUL_HIGH_DIGS_C
      if ((res = s_mp_mul_high_digs(&q, mu, &q, um)) != MP_OKAY) {
         goto CLEANUP;
69
70
71
72
73
74
75
76
77


78
79
80
81
82
83
84
67
68
69
70
71
72
73


74
75
76
77
78
79
80
81
82







-
-
+
+








   /* x = x - q */
   if ((res = mp_sub(x, &q, x)) != MP_OKAY) {
      goto CLEANUP;
   }

   /* If x < 0, add b**(k+1) to it */
   if (mp_cmp_d(x, 0) == MP_LT) {
      mp_set(&q, 1);
   if (mp_cmp_d(x, 0uL) == MP_LT) {
      mp_set(&q, 1uL);
      if ((res = mp_lshd(&q, um + 1)) != MP_OKAY)
         goto CLEANUP;
      if ((res = mp_add(x, &q, x)) != MP_OKAY)
         goto CLEANUP;
   }

   /* Back off if it's too big */

Changes to libtommath/bn_mp_reduce_2k.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35

36
37
38

39
40
41
42
43
44

45
46
47
48
49

50
51
52
53
54

55
56
57
58
59
60
61
62
63

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32

33
34
35

36
37
38
39
40
41

42
43
44
45
46

47
48
49
50
51

52
53
54
55
56
57
58
59
60
61
-
+












-
-
















-
+


-
+


-
+





-
+




-
+




-
+









#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_REDUCE_2K_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* reduces a modulo n where n is of the form 2**p - d */
int mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d)
{
   mp_int q;
   int    p, res;

   if ((res = mp_init(&q)) != MP_OKAY) {
      return res;
   }

   p = mp_count_bits(n);
top:
   /* q = a/2**p, a = a mod 2**p */
   if ((res = mp_div_2d(a, p, &q, a)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if (d != 1) {
   if (d != 1u) {
      /* q = q * d */
      if ((res = mp_mul_d(&q, d, &q)) != MP_OKAY) {
         goto ERR;
         goto LBL_ERR;
      }
   }

   /* a = a + q */
   if ((res = s_mp_add(a, &q, a)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if (mp_cmp_mag(a, n) != MP_LT) {
      if ((res = s_mp_sub(a, n, a)) != MP_OKAY) {
         goto ERR;
         goto LBL_ERR;
      }
      goto top;
   }

ERR:
LBL_ERR:
   mp_clear(&q);
   return res;
}

#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_reduce_2k_l.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40

41
42
43
44
45

46
47
48
49
50

51
52
53
54
55

56
57
58
59
60
61
62
63
64

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37

38
39
40
41
42

43
44
45
46
47

48
49
50
51
52

53
54
55
56
57
58
59
60
61
62
-
+












-
-



















-
+




-
+




-
+




-
+




-
+









#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_REDUCE_2K_L_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* reduces a modulo n where n is of the form 2**p - d
   This differs from reduce_2k since "d" can be larger
   than a single digit.
*/
int mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d)
{
   mp_int q;
   int    p, res;

   if ((res = mp_init(&q)) != MP_OKAY) {
      return res;
   }

   p = mp_count_bits(n);
top:
   /* q = a/2**p, a = a mod 2**p */
   if ((res = mp_div_2d(a, p, &q, a)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* q = q * d */
   if ((res = mp_mul(&q, d, &q)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* a = a + q */
   if ((res = s_mp_add(a, &q, a)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if (mp_cmp_mag(a, n) != MP_LT) {
      if ((res = s_mp_sub(a, n, a)) != MP_OKAY) {
         goto ERR;
         goto LBL_ERR;
      }
      goto top;
   }

ERR:
LBL_ERR:
   mp_clear(&q);
   return res;
}

#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_reduce_2k_setup.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_REDUCE_2K_SETUP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* determines the setup value */
int mp_reduce_2k_setup(const mp_int *a, mp_digit *d)
{
   int res, p;
   mp_int tmp;

Changes to libtommath/bn_mp_reduce_2k_setup_l.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33

34
35
36

37
38
39
40
41
42
43

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30

31
32
33

34
35
36
37
38
39
40
41
-
+












-
-













-
+



-
+


-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_REDUCE_2K_SETUP_L_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* determines the setup value */
int mp_reduce_2k_setup_l(const mp_int *a, mp_int *d)
{
   int    res;
   mp_int tmp;

   if ((res = mp_init(&tmp)) != MP_OKAY) {
      return res;
   }

   if ((res = mp_2expt(&tmp, mp_count_bits(a))) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = s_mp_sub(&tmp, a, d)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

ERR:
LBL_ERR:
   mp_clear(&tmp);
   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */

Changes to libtommath/bn_mp_reduce_is_2k.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
-
+












-
-



















-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_REDUCE_IS_2K_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* determines if mp_reduce_2k can be used */
int mp_reduce_is_2k(const mp_int *a)
{
   int ix, iy, iw;
   mp_digit iz;

   if (a->used == 0) {
      return MP_NO;
   } else if (a->used == 1) {
      return MP_YES;
   } else if (a->used > 1) {
      iy = mp_count_bits(a);
      iz = 1;
      iw = 1;

      /* Test every bit from the second digit up, must be 1 */
      for (ix = DIGIT_BIT; ix < iy; ix++) {
         if ((a->dp[iw] & iz) == 0) {
         if ((a->dp[iw] & iz) == 0u) {
            return MP_NO;
         }
         iz <<= 1;
         if (iz > (mp_digit)MP_MASK) {
            ++iw;
            iz = 1;
         }

Changes to libtommath/bn_mp_reduce_is_2k_l.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_REDUCE_IS_2K_L_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* determines if reduce_2k_l can be used */
int mp_reduce_is_2k_l(const mp_int *a)
{
   int ix, iy;

Changes to libtommath/bn_mp_reduce_setup.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_REDUCE_SETUP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* pre-calculate the value required for Barrett reduction
 * For a given modulus "b" it calulates the value required in "a"
 */
int mp_reduce_setup(mp_int *a, const mp_int *b)
{

Changes to libtommath/bn_mp_rshd.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_RSHD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* shift right a certain amount of digits */
void mp_rshd(mp_int *a, int b)
{
   int     x;

Changes to libtommath/bn_mp_set.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

24
25
26
27
28
29

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20

21
22
23
24
25
26
27
-
+












-
-







-
+






#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SET_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* set to a digit */
void mp_set(mp_int *a, mp_digit b)
{
   mp_zero(a);
   a->dp[0] = b & MP_MASK;
   a->used  = (a->dp[0] != 0) ? 1 : 0;
   a->used  = (a->dp[0] != 0u) ? 1 : 0;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_set_int.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

34
35
36
37
38
39
40

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38
-
+












-
-

















-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SET_INT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* set a 32-bit const */
int mp_set_int(mp_int *a, unsigned long b)
{
   int     x, res;

   mp_zero(a);

   /* set four bits at a time */
   for (x = 0; x < 8; x++) {
      /* shift the number up four bits */
      if ((res = mp_mul_2d(a, 4, a)) != MP_OKAY) {
         return res;
      }

      /* OR in the top four bits of the source */
      a->dp[0] |= (b >> 28) & 15;
      a->dp[0] |= (mp_digit)(b >> 28) & 15uL;

      /* shift the source up to the next four bits */
      b <<= 4;

      /* ensure that digits are not clamped off */
      a->used += 1;
   }

Changes to libtommath/bn_mp_set_long.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SET_LONG_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* set a platform dependent unsigned long int */
MP_SET_XLONG(mp_set_long, unsigned long)
#endif

/* ref:         $Format:%D$ */

Changes to libtommath/bn_mp_set_long_long.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SET_LONG_LONG_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* set a platform dependent unsigned long long int */
MP_SET_XLONG(mp_set_long_long, Tcl_WideUInt)
#endif

/* ref:         $Format:%D$ */

Changes to libtommath/bn_mp_shrink.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
-
+












-
-













-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SHRINK_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* shrink a bignum */
int mp_shrink(mp_int *a)
{
   mp_digit *tmp;
   int used = 1;

   if (a->used > 0) {
      used = a->used;
   }

   if (a->alloc != used) {
      if ((tmp = OPT_CAST(mp_digit) XREALLOC(a->dp, sizeof(mp_digit) * used)) == NULL) {
      if ((tmp = OPT_CAST(mp_digit) XREALLOC(a->dp, sizeof(mp_digit) * (size_t)used)) == NULL) {
         return MP_MEM;
      }
      a->dp    = tmp;
      a->alloc = used;
   }
   return MP_OKAY;
}

Changes to libtommath/bn_mp_signed_bin_size.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SIGNED_BIN_SIZE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* get the size for an signed equivalent */
int mp_signed_bin_size(const mp_int *a)
{
   return 1 + mp_unsigned_bin_size(a);
}

Changes to libtommath/bn_mp_sqr.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* computes b = a*a */
int mp_sqr(const mp_int *a, mp_int *b)
{
   int     res;

31
32
33
34
35
36
37
38

39
40

41
42
43
44
45
46
47
29
30
31
32
33
34
35

36
37

38
39
40
41
42
43
44
45







-
+

-
+







      if (a->used >= KARATSUBA_SQR_CUTOFF) {
         res = mp_karatsuba_sqr(a, b);
      } else
#endif
      {
#ifdef BN_FAST_S_MP_SQR_C
         /* can we use the fast comba multiplier? */
         if ((((a->used * 2) + 1) < MP_WARRAY) &&
         if ((((a->used * 2) + 1) < (int)MP_WARRAY) &&
             (a->used <
              (1 << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) - 1)))) {
              (int)(1u << (((sizeof(mp_word) * (size_t)CHAR_BIT) - (2u * (size_t)DIGIT_BIT)) - 1u)))) {
            res = fast_s_mp_sqr(a, b);
         } else
#endif
         {
#ifdef BN_S_MP_SQR_C
            res = s_mp_sqr(a, b);
#else

Changes to libtommath/bn_mp_sqrmod.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SQRMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* c = a * a (mod b) */
int mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     res;
   mp_int  t;

Changes to libtommath/bn_mp_sqrt.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31
-
+












-
-










-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SQRT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

#ifndef NO_FLOATING_POINT
#include <math.h>
#endif

/* this function is less generic than mp_n_root, simpler and faster */
int mp_sqrt(const mp_int *arg, mp_int *ret)
{
   int res;
   mp_int t1,t2;
   mp_int t1, t2;
   int i, j, k;
#ifndef NO_FLOATING_POINT
   volatile double d;
   mp_digit dig;
#endif

   /* must be positive */
104
105
106
107
108
109
110
111

112
113
114

115
116
117

118
119
120
121
122

123
124
125

126
127
128

129
130
131
132

133
134

135
136
137
138
139
140
141
142
143
144
145
146
147
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
128
129

130
131

132
133
134
135
136
137
138
139
140
141
142
143
144
145







-
+


-
+


-
+




-
+


-
+


-
+



-
+

-
+













   t1.used = i + 2;
   t1.dp[i+1] = (mp_digit) 1;
   t1.dp[i] = (mp_digit) 0;

#endif

   /* t1 > 0  */
   if ((res = mp_div(arg,&t1,&t2,NULL)) != MP_OKAY) {
   if ((res = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) {
      goto E1;
   }
   if ((res = mp_add(&t1,&t2,&t1)) != MP_OKAY) {
   if ((res = mp_add(&t1, &t2, &t1)) != MP_OKAY) {
      goto E1;
   }
   if ((res = mp_div_2(&t1,&t1)) != MP_OKAY) {
   if ((res = mp_div_2(&t1, &t1)) != MP_OKAY) {
      goto E1;
   }
   /* And now t1 > sqrt(arg) */
   do {
      if ((res = mp_div(arg,&t1,&t2,NULL)) != MP_OKAY) {
      if ((res = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) {
         goto E1;
      }
      if ((res = mp_add(&t1,&t2,&t1)) != MP_OKAY) {
      if ((res = mp_add(&t1, &t2, &t1)) != MP_OKAY) {
         goto E1;
      }
      if ((res = mp_div_2(&t1,&t1)) != MP_OKAY) {
      if ((res = mp_div_2(&t1, &t1)) != MP_OKAY) {
         goto E1;
      }
      /* t1 >= sqrt(arg) >= t2 at this point */
   } while (mp_cmp_mag(&t1,&t2) == MP_GT);
   } while (mp_cmp_mag(&t1, &t2) == MP_GT);

   mp_exch(&t1,ret);
   mp_exch(&t1, ret);

E1:
   mp_clear(&t2);
E2:
   mp_clear(&t1);
   return res;
}

#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_sqrtmod_prime.c.

1

2
3
4
5
6
7
8

1
2
3
4
5
6
7
8
-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SQRTMOD_PRIME_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library is free for all purposes without any express
18
19
20
21
22
23
24
25

26
27
28
29

30
31
32
33
34
35
36
37
38
39
40
41
42
43



44
45
46
47
48
49
50
51
52
53
54
55

56
57
58
59
60
61
62

63
64
65
66
67

68
69
70
71
72

73
74
75
76
77
78

79
80
81
82
83
84
85
86
87

88
89
90
91
92
93
94

95
96
97
98

99
100
101
102
103
104

105
106
107
108
109
110
111
18
19
20
21
22
23
24

25
26
27
28

29
30
31
32
33
34
35
36
37
38
39
40



41
42
43
44
45
46
47
48
49
50
51
52
53
54

55
56
57
58
59
60
61

62
63
64
65
66

67
68
69
70
71

72
73
74
75
76
77

78
79
80
81
82
83
84
85
86

87
88
89
90
91
92
93

94
95
96
97

98
99
100
101
102
103

104
105
106
107
108
109
110
111







-
+



-
+











-
-
-
+
+
+











-
+






-
+




-
+




-
+





-
+








-
+






-
+



-
+





-
+







int mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret)
{
   int res, legendre;
   mp_int t1, C, Q, S, Z, M, T, R, two;
   mp_digit i;

   /* first handle the simple cases */
   if (mp_cmp_d(n, 0) == MP_EQ) {
   if (mp_cmp_d(n, 0uL) == MP_EQ) {
      mp_zero(ret);
      return MP_OKAY;
   }
   if (mp_cmp_d(prime, 2) == MP_EQ)                              return MP_VAL; /* prime must be odd */
   if (mp_cmp_d(prime, 2uL) == MP_EQ)                            return MP_VAL; /* prime must be odd */
   if ((res = mp_jacobi(n, prime, &legendre)) != MP_OKAY)        return res;
   if (legendre == -1)                                           return MP_VAL; /* quadratic non-residue mod prime */

   if ((res = mp_init_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, NULL)) != MP_OKAY) {
      return res;
   }

   /* SPECIAL CASE: if prime mod 4 == 3
    * compute directly: res = n^(prime+1)/4 mod prime
    * Handbook of Applied Cryptography algorithm 3.36
    */
   if ((res = mp_mod_d(prime, 4, &i)) != MP_OKAY)                goto cleanup;
   if (i == 3) {
      if ((res = mp_add_d(prime, 1, &t1)) != MP_OKAY)             goto cleanup;
   if ((res = mp_mod_d(prime, 4uL, &i)) != MP_OKAY)               goto cleanup;
   if (i == 3u) {
      if ((res = mp_add_d(prime, 1uL, &t1)) != MP_OKAY)           goto cleanup;
      if ((res = mp_div_2(&t1, &t1)) != MP_OKAY)                  goto cleanup;
      if ((res = mp_div_2(&t1, &t1)) != MP_OKAY)                  goto cleanup;
      if ((res = mp_exptmod(n, &t1, prime, ret)) != MP_OKAY)      goto cleanup;
      res = MP_OKAY;
      goto cleanup;
   }

   /* NOW: Tonelli-Shanks algorithm */

   /* factor out powers of 2 from prime-1, defining Q and S as: prime-1 = Q*2^S */
   if ((res = mp_copy(prime, &Q)) != MP_OKAY)                    goto cleanup;
   if ((res = mp_sub_d(&Q, 1, &Q)) != MP_OKAY)                   goto cleanup;
   if ((res = mp_sub_d(&Q, 1uL, &Q)) != MP_OKAY)                 goto cleanup;
   /* Q = prime - 1 */
   mp_zero(&S);
   /* S = 0 */
   while (mp_iseven(&Q) != MP_NO) {
      if ((res = mp_div_2(&Q, &Q)) != MP_OKAY)                    goto cleanup;
      /* Q = Q / 2 */
      if ((res = mp_add_d(&S, 1, &S)) != MP_OKAY)                 goto cleanup;
      if ((res = mp_add_d(&S, 1uL, &S)) != MP_OKAY)               goto cleanup;
      /* S = S + 1 */
   }

   /* find a Z such that the Legendre symbol (Z|prime) == -1 */
   if ((res = mp_set_int(&Z, 2)) != MP_OKAY)                     goto cleanup;
   if ((res = mp_set_int(&Z, 2uL)) != MP_OKAY)                    goto cleanup;
   /* Z = 2 */
   while (1) {
      if ((res = mp_jacobi(&Z, prime, &legendre)) != MP_OKAY)     goto cleanup;
      if (legendre == -1) break;
      if ((res = mp_add_d(&Z, 1, &Z)) != MP_OKAY)                 goto cleanup;
      if ((res = mp_add_d(&Z, 1uL, &Z)) != MP_OKAY)               goto cleanup;
      /* Z = Z + 1 */
   }

   if ((res = mp_exptmod(&Z, &Q, prime, &C)) != MP_OKAY)         goto cleanup;
   /* C = Z ^ Q mod prime */
   if ((res = mp_add_d(&Q, 1, &t1)) != MP_OKAY)                  goto cleanup;
   if ((res = mp_add_d(&Q, 1uL, &t1)) != MP_OKAY)                goto cleanup;
   if ((res = mp_div_2(&t1, &t1)) != MP_OKAY)                    goto cleanup;
   /* t1 = (Q + 1) / 2 */
   if ((res = mp_exptmod(n, &t1, prime, &R)) != MP_OKAY)         goto cleanup;
   /* R = n ^ ((Q + 1) / 2) mod prime */
   if ((res = mp_exptmod(n, &Q, prime, &T)) != MP_OKAY)          goto cleanup;
   /* T = n ^ Q mod prime */
   if ((res = mp_copy(&S, &M)) != MP_OKAY)                       goto cleanup;
   /* M = S */
   if ((res = mp_set_int(&two, 2)) != MP_OKAY)                   goto cleanup;
   if ((res = mp_set_int(&two, 2uL)) != MP_OKAY)                 goto cleanup;

   res = MP_VAL;
   while (1) {
      if ((res = mp_copy(&T, &t1)) != MP_OKAY)                    goto cleanup;
      i = 0;
      while (1) {
         if (mp_cmp_d(&t1, 1) == MP_EQ) break;
         if (mp_cmp_d(&t1, 1uL) == MP_EQ) break;
         if ((res = mp_exptmod(&t1, &two, prime, &t1)) != MP_OKAY) goto cleanup;
         i++;
      }
      if (i == 0) {
      if (i == 0u) {
         if ((res = mp_copy(&R, ret)) != MP_OKAY)                  goto cleanup;
         res = MP_OKAY;
         goto cleanup;
      }
      if ((res = mp_sub_d(&M, i, &t1)) != MP_OKAY)                goto cleanup;
      if ((res = mp_sub_d(&t1, 1, &t1)) != MP_OKAY)               goto cleanup;
      if ((res = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY)             goto cleanup;
      if ((res = mp_exptmod(&two, &t1, prime, &t1)) != MP_OKAY)   goto cleanup;
      /* t1 = 2 ^ (M - i - 1) */
      if ((res = mp_exptmod(&C, &t1, prime, &t1)) != MP_OKAY)     goto cleanup;
      /* t1 = C ^ (2 ^ (M - i - 1)) mod prime */
      if ((res = mp_sqrmod(&t1, prime, &C)) != MP_OKAY)           goto cleanup;
      /* C = (t1 * t1) mod prime */
      if ((res = mp_mulmod(&R, &t1, prime, &R)) != MP_OKAY)       goto cleanup;

Changes to libtommath/bn_mp_sub.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SUB_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* high level subtraction (handles signs) */
int mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     sa, sb, res;

Changes to libtommath/bn_mp_sub_d.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SUB_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* single digit subtraction */
int mp_sub_d(const mp_int *a, mp_digit b, mp_int *c)
{
   mp_digit *tmpa, *tmpc, mu;
   int       res, ix, oldused;
63
64
65
66
67
68
69
70

71
72
73
74
75
76

77
78
79
80
81
82
83
61
62
63
64
65
66
67

68
69
70
71
72
73

74
75
76
77
78
79
80
81







-
+





-
+







   } else {
      /* positive/size */
      c->sign = MP_ZPOS;
      c->used = a->used;

      /* subtract first digit */
      *tmpc    = *tmpa++ - b;
      mu       = *tmpc >> ((sizeof(mp_digit) * CHAR_BIT) - 1);
      mu       = *tmpc >> ((sizeof(mp_digit) * (size_t)CHAR_BIT) - 1u);
      *tmpc++ &= MP_MASK;

      /* handle rest of the digits */
      for (ix = 1; ix < a->used; ix++) {
         *tmpc    = *tmpa++ - mu;
         mu       = *tmpc >> ((sizeof(mp_digit) * CHAR_BIT) - 1);
         mu       = *tmpc >> ((sizeof(mp_digit) * (size_t)CHAR_BIT) - 1u);
         *tmpc++ &= MP_MASK;
      }
   }

   /* zero excess digits */
   while (ix++ < oldused) {
      *tmpc++ = 0;

Changes to libtommath/bn_mp_submod.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_SUBMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* d = a - b (mod c) */
int mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d)
{
   int     res;
   mp_int  t;

Added libtommath/bn_mp_tc_and.c.


























































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include "tommath_private.h"
#ifdef BN_MP_TC_AND_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 */

/* two complement and */
int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c)
{
   int res = MP_OKAY, bits;
   int as = mp_isneg(a), bs = mp_isneg(b);
   mp_int *mx = NULL, _mx, acpy, bcpy;

   if ((as != MP_NO) || (bs != MP_NO)) {
      bits = MAX(mp_count_bits(a), mp_count_bits(b));
      res = mp_init_set_int(&_mx, 1uL);
      if (res != MP_OKAY) {
         goto end;
      }

      mx = &_mx;
      res = mp_mul_2d(mx, bits + 1, mx);
      if (res != MP_OKAY) {
         goto end;
      }

      if (as != MP_NO) {
         res = mp_init(&acpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, a, &acpy);
         if (res != MP_OKAY) {
            mp_clear(&acpy);
            goto end;
         }
         a = &acpy;
      }
      if (bs != MP_NO) {
         res = mp_init(&bcpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, b, &bcpy);
         if (res != MP_OKAY) {
            mp_clear(&bcpy);
            goto end;
         }
         b = &bcpy;
      }
   }

   res = mp_and(a, b, c);

   if ((as != MP_NO) && (bs != MP_NO) && (res == MP_OKAY)) {
      res = mp_sub(c, mx, c);
   }

end:
   if (a == &acpy) {
      mp_clear(&acpy);
   }

   if (b == &bcpy) {
      mp_clear(&bcpy);
   }

   if (mx == &_mx) {
      mp_clear(mx);
   }

   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Added libtommath/bn_mp_tc_div_2d.c.





































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include "tommath_private.h"
#ifdef BN_MP_TC_DIV_2D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 */

/* two complement right shift */
int mp_tc_div_2d(const mp_int *a, int b, mp_int *c)
{
   int res;
   if (mp_isneg(a) == MP_NO) {
      return mp_div_2d(a, b, c, NULL);
   }

   res = mp_add_d(a, 1uL, c);
   if (res != MP_OKAY) {
      return res;
   }

   res = mp_div_2d(c, b, c, NULL);
   return (res == MP_OKAY) ? mp_sub_d(c, 1uL, c) : res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Added libtommath/bn_mp_tc_or.c.


























































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include "tommath_private.h"
#ifdef BN_MP_TC_OR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 */

/* two complement or */
int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)
{
   int res = MP_OKAY, bits;
   int as = mp_isneg(a), bs = mp_isneg(b);
   mp_int *mx = NULL, _mx, acpy, bcpy;

   if ((as != MP_NO) || (bs != MP_NO)) {
      bits = MAX(mp_count_bits(a), mp_count_bits(b));
      res = mp_init_set_int(&_mx, 1uL);
      if (res != MP_OKAY) {
         goto end;
      }

      mx = &_mx;
      res = mp_mul_2d(mx, bits + 1, mx);
      if (res != MP_OKAY) {
         goto end;
      }

      if (as != MP_NO) {
         res = mp_init(&acpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, a, &acpy);
         if (res != MP_OKAY) {
            mp_clear(&acpy);
            goto end;
         }
         a = &acpy;
      }
      if (bs != MP_NO) {
         res = mp_init(&bcpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, b, &bcpy);
         if (res != MP_OKAY) {
            mp_clear(&bcpy);
            goto end;
         }
         b = &bcpy;
      }
   }

   res = mp_or(a, b, c);

   if (((as != MP_NO) || (bs != MP_NO)) && (res == MP_OKAY)) {
      res = mp_sub(c, mx, c);
   }

end:
   if (a == &acpy) {
      mp_clear(&acpy);
   }

   if (b == &bcpy) {
      mp_clear(&bcpy);
   }

   if (mx == &_mx) {
      mp_clear(mx);
   }

   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Added libtommath/bn_mp_tc_xor.c.


























































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include "tommath_private.h"
#ifdef BN_MP_TC_XOR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 */

/* two complement xor */
int mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c)
{
   int res = MP_OKAY, bits;
   int as = mp_isneg(a), bs = mp_isneg(b);
   mp_int *mx = NULL, _mx, acpy, bcpy;

   if ((as != MP_NO) || (bs != MP_NO)) {
      bits = MAX(mp_count_bits(a), mp_count_bits(b));
      res = mp_init_set_int(&_mx, 1uL);
      if (res != MP_OKAY) {
         goto end;
      }

      mx = &_mx;
      res = mp_mul_2d(mx, bits + 1, mx);
      if (res != MP_OKAY) {
         goto end;
      }

      if (as != MP_NO) {
         res = mp_init(&acpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, a, &acpy);
         if (res != MP_OKAY) {
            mp_clear(&acpy);
            goto end;
         }
         a = &acpy;
      }
      if (bs != MP_NO) {
         res = mp_init(&bcpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, b, &bcpy);
         if (res != MP_OKAY) {
            mp_clear(&bcpy);
            goto end;
         }
         b = &bcpy;
      }
   }

   res = mp_xor(a, b, c);

   if ((as != bs) && (res == MP_OKAY)) {
      res = mp_sub(c, mx, c);
   }

end:
   if (a == &acpy) {
      mp_clear(&acpy);
   }

   if (b == &bcpy) {
      mp_clear(&bcpy);
   }

   if (mx == &_mx) {
      mp_clear(mx);
   }

   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_to_signed_bin.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_TO_SIGNED_BIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* store in signed [big endian] format */
int mp_to_signed_bin(const mp_int *a, unsigned char *b)
{
   int     res;

Changes to libtommath/bn_mp_to_signed_bin_n.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
-
+












-
-








-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_TO_SIGNED_BIN_N_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* store in signed [big endian] format */
int mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen)
{
   if (*outlen < (unsigned long)mp_signed_bin_size(a)) {
      return MP_VAL;
   }
   *outlen = mp_signed_bin_size(a);
   *outlen = (unsigned long)mp_signed_bin_size(a);
   return mp_to_signed_bin(a, b);
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_to_unsigned_bin.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33

34
35
36
37
38
39
40

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
30

31
32
33
34
35
36
37
38
-
+












-
-















-
+

-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_TO_UNSIGNED_BIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* store in unsigned [big endian] format */
int mp_to_unsigned_bin(const mp_int *a, unsigned char *b)
{
   int     x, res;
   mp_int  t;

   if ((res = mp_init_copy(&t, a)) != MP_OKAY) {
      return res;
   }

   x = 0;
   while (mp_iszero(&t) == MP_NO) {
#ifndef MP_8BIT
      b[x++] = (unsigned char)(t.dp[0] & 255);
      b[x++] = (unsigned char)(t.dp[0] & 255u);
#else
      b[x++] = (unsigned char)(t.dp[0] | ((t.dp[1] & 0x01) << 7));
      b[x++] = (unsigned char)(t.dp[0] | ((t.dp[1] & 1u) << 7));
#endif
      if ((res = mp_div_2d(&t, 8, &t, NULL)) != MP_OKAY) {
         mp_clear(&t);
         return res;
      }
   }
   bn_reverse(b, x);

Changes to libtommath/bn_mp_to_unsigned_bin_n.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
-
+












-
-








-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_TO_UNSIGNED_BIN_N_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* store in unsigned [big endian] format */
int mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen)
{
   if (*outlen < (unsigned long)mp_unsigned_bin_size(a)) {
      return MP_VAL;
   }
   *outlen = mp_unsigned_bin_size(a);
   *outlen = (unsigned long)mp_unsigned_bin_size(a);
   return mp_to_unsigned_bin(a, b);
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_toom_mul.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_TOOM_MUL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* multiplication using the Toom-Cook 3-way algorithm
 *
 * Much more complicated than Karatsuba but has a lower
 * asymptotic running time of O(N**1.464).  This algorithm is
 * only particularly useful on VERY large inputs
35
36
37
38
39
40
41
42

43
44
45
46

47
48
49
50

51
52
53
54

55
56
57
58
59
60

61
62
63
64

65
66
67
68
69
70

71
72
73
74
75
76

77
78
79
80
81

82
83
84
85
86

87
88
89

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
128
129
130

131
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
161

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178

179
180
181
182

183
184
185
186

187
188
189
190

191
192
193
194

195
196
197

198
199
200
201

202
203
204
205

206
207
208
209

210
211
212

213
214
215
216

217
218
219

220
221
222
223


224
225
226

227
228
229

230
231
232
233

234
235
236
237

238
239
240
241

242
243
244
245

246
247
248
249
250

251
252
253

254
255
256

257
258
259

260
261
262
263

264
265
266

267
268
269

270
271
272

273
274
275

276
277
278
279
280
281
282
283
284
285
286
33
34
35
36
37
38
39

40
41
42
43

44
45
46
47

48
49
50
51

52
53
54
55
56
57

58
59
60
61

62
63
64
65
66
67

68
69
70
71
72
73

74
75
76
77
78

79
80
81
82
83

84
85
86

87
88
89

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

128
129
130

131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175

176
177
178
179

180
181
182
183

184
185
186
187

188
189
190
191

192
193
194

195
196
197
198

199
200
201
202

203
204
205
206

207
208
209

210
211
212
213

214
215
216

217
218
219


220
221
222
223

224
225
226

227
228
229
230

231
232
233
234

235
236
237
238

239
240
241
242

243
244
245
246
247

248
249
250

251
252
253

254
255
256

257
258
259
260

261
262
263

264
265
266

267
268
269

270
271
272

273
274
275
276
277
278
279
280
281
282
283
284







-
+



-
+



-
+



-
+





-
+



-
+





-
+





-
+




-
+




-
+


-
+


-
+


-
+



-
+


-
+


-
+


-
+



-
+




-
+


-
+


-
+


-
+



-
+


-
+


-
+


-
+



-
+





-
+


-
+


-
+


-
+


-
+
















-
+



-
+



-
+



-
+



-
+


-
+



-
+



-
+



-
+


-
+



-
+


-
+


-
-
+
+


-
+


-
+



-
+



-
+



-
+



-
+




-
+


-
+


-
+


-
+



-
+


-
+


-
+


-
+


-
+











   }

   /* B */
   B = MIN(a->used, b->used) / 3;

   /* a = a2 * B**2 + a1 * B + a0 */
   if ((res = mp_mod_2d(a, DIGIT_BIT * B, &a0)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_copy(a, &a1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   mp_rshd(&a1, B);
   if ((res = mp_mod_2d(&a1, DIGIT_BIT * B, &a1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_copy(a, &a2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   mp_rshd(&a2, B*2);

   /* b = b2 * B**2 + b1 * B + b0 */
   if ((res = mp_mod_2d(b, DIGIT_BIT * B, &b0)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_copy(b, &b1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   mp_rshd(&b1, B);
   (void)mp_mod_2d(&b1, DIGIT_BIT * B, &b1);

   if ((res = mp_copy(b, &b2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   mp_rshd(&b2, B*2);

   /* w0 = a0*b0 */
   if ((res = mp_mul(&a0, &b0, &w0)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* w4 = a2 * b2 */
   if ((res = mp_mul(&a2, &b2, &w4)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* w1 = (a2 + 2(a1 + 2a0))(b2 + 2(b1 + 2b0)) */
   if ((res = mp_mul_2(&a0, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, &a2, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_mul_2(&b0, &tmp2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp2, &b1, &tmp2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_mul_2(&tmp2, &tmp2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp2, &b2, &tmp2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_mul(&tmp1, &tmp2, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* w3 = (a0 + 2(a1 + 2a2))(b0 + 2(b1 + 2b2)) */
   if ((res = mp_mul_2(&a2, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_mul_2(&b2, &tmp2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp2, &b1, &tmp2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_mul_2(&tmp2, &tmp2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp2, &b0, &tmp2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_mul(&tmp1, &tmp2, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }


   /* w2 = (a2 + a1 + a0)(b2 + b1 + b0) */
   if ((res = mp_add(&a2, &a1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&b2, &b1, &tmp2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp2, &b0, &tmp2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_mul(&tmp1, &tmp2, &w2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* now solve the matrix

      0  0  0  0  1
      1  2  4  8  16
      1  1  1  1  1
      16 8  4  2  1
      1  0  0  0  0

      using 12 subtractions, 4 shifts,
             2 small divisions and 1 small multiplication
    */

   /* r1 - r4 */
   if ((res = mp_sub(&w1, &w4, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3 - r0 */
   if ((res = mp_sub(&w3, &w0, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r1/2 */
   if ((res = mp_div_2(&w1, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3/2 */
   if ((res = mp_div_2(&w3, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r2 - r0 - r4 */
   if ((res = mp_sub(&w2, &w0, &w2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_sub(&w2, &w4, &w2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r1 - r2 */
   if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3 - r2 */
   if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r1 - 8r0 */
   if ((res = mp_mul_2d(&w0, 3, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_sub(&w1, &tmp1, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3 - 8r4 */
   if ((res = mp_mul_2d(&w4, 3, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_sub(&w3, &tmp1, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* 3r2 - r1 - r3 */
   if ((res = mp_mul_d(&w2, 3, &w2)) != MP_OKAY) {
      goto ERR;
   if ((res = mp_mul_d(&w2, 3uL, &w2)) != MP_OKAY) {
      goto LBL_ERR;
   }
   if ((res = mp_sub(&w2, &w1, &w2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_sub(&w2, &w3, &w2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r1 - r2 */
   if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3 - r2 */
   if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r1/3 */
   if ((res = mp_div_3(&w1, &w1, NULL)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3/3 */
   if ((res = mp_div_3(&w3, &w3, NULL)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* at this point shift W[n] by B*n */
   if ((res = mp_lshd(&w1, 1*B)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_lshd(&w2, 2*B)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_lshd(&w3, 3*B)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_lshd(&w4, 4*B)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_add(&w0, &w1, c)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&w2, &w3, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&w4, &tmp1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, c, c)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

ERR:
LBL_ERR:
   mp_clear_multi(&w0, &w1, &w2, &w3, &w4,
                  &a0, &a1, &a2, &b0, &b1,
                  &b2, &tmp1, &tmp2, NULL);
   return res;
}

#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_toom_sqr.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

35
36
37
38

39
40
41
42

43
44
45
46

47
48
49
50
51
52

53
54
55
56
57

58
59
60
61
62

63
64
65

66
67
68

69
70
71

72
73
74
75

76
77
78
79
80

81
82
83

84
85
86

87
88
89

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
128
129

130
131
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
161
162

163
164
165
166


167
168
169

170
171
172

173
174
175
176

177
178
179
180

181
182
183
184

185
186
187
188

189
190
191
192
193

194
195
196

197
198
199

200
201
202

203
204
205
206

207
208
209

210
211
212

213
214
215

216
217
218

219
220
221
222
223
224
225
226
227

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35

36
37
38
39

40
41
42
43

44
45
46
47
48
49

50
51
52
53
54

55
56
57
58
59

60
61
62

63
64
65

66
67
68

69
70
71
72

73
74
75
76
77

78
79
80

81
82
83

84
85
86

87
88
89
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
128
129
130

131
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
161
162


163
164
165
166

167
168
169

170
171
172
173

174
175
176
177

178
179
180
181

182
183
184
185

186
187
188
189
190

191
192
193

194
195
196

197
198
199

200
201
202
203

204
205
206

207
208
209

210
211
212

213
214
215

216
217
218
219
220
221
222
223
224
225
-
+












-
-


















-
+



-
+



-
+



-
+





-
+




-
+




-
+


-
+


-
+


-
+



-
+




-
+


-
+


-
+


-
+



-
+





-
+


-
+


-
+















-
+



-
+



-
+



-
+



-
+


-
+



-
+



-
+



-
+


-
+



-
+


-
+


-
-
+
+


-
+


-
+



-
+



-
+



-
+



-
+




-
+


-
+


-
+


-
+



-
+


-
+


-
+


-
+


-
+









#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_TOOM_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* squaring using Toom-Cook 3-way algorithm */
int mp_toom_sqr(const mp_int *a, mp_int *b)
{
   mp_int w0, w1, w2, w3, w4, tmp1, a0, a1, a2;
   int res, B;

   /* init temps */
   if ((res = mp_init_multi(&w0, &w1, &w2, &w3, &w4, &a0, &a1, &a2, &tmp1, NULL)) != MP_OKAY) {
      return res;
   }

   /* B */
   B = a->used / 3;

   /* a = a2 * B**2 + a1 * B + a0 */
   if ((res = mp_mod_2d(a, DIGIT_BIT * B, &a0)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_copy(a, &a1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   mp_rshd(&a1, B);
   if ((res = mp_mod_2d(&a1, DIGIT_BIT * B, &a1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_copy(a, &a2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   mp_rshd(&a2, B*2);

   /* w0 = a0*a0 */
   if ((res = mp_sqr(&a0, &w0)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* w4 = a2 * a2 */
   if ((res = mp_sqr(&a2, &w4)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* w1 = (a2 + 2(a1 + 2a0))**2 */
   if ((res = mp_mul_2(&a0, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, &a2, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_sqr(&tmp1, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* w3 = (a0 + 2(a1 + 2a2))**2 */
   if ((res = mp_mul_2(&a2, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_sqr(&tmp1, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }


   /* w2 = (a2 + a1 + a0)**2 */
   if ((res = mp_add(&a2, &a1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_sqr(&tmp1, &w2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* now solve the matrix

      0  0  0  0  1
      1  2  4  8  16
      1  1  1  1  1
      16 8  4  2  1
      1  0  0  0  0

      using 12 subtractions, 4 shifts, 2 small divisions and 1 small multiplication.
    */

   /* r1 - r4 */
   if ((res = mp_sub(&w1, &w4, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3 - r0 */
   if ((res = mp_sub(&w3, &w0, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r1/2 */
   if ((res = mp_div_2(&w1, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3/2 */
   if ((res = mp_div_2(&w3, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r2 - r0 - r4 */
   if ((res = mp_sub(&w2, &w0, &w2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_sub(&w2, &w4, &w2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r1 - r2 */
   if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3 - r2 */
   if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r1 - 8r0 */
   if ((res = mp_mul_2d(&w0, 3, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_sub(&w1, &tmp1, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3 - 8r4 */
   if ((res = mp_mul_2d(&w4, 3, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_sub(&w3, &tmp1, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* 3r2 - r1 - r3 */
   if ((res = mp_mul_d(&w2, 3, &w2)) != MP_OKAY) {
      goto ERR;
   if ((res = mp_mul_d(&w2, 3uL, &w2)) != MP_OKAY) {
      goto LBL_ERR;
   }
   if ((res = mp_sub(&w2, &w1, &w2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_sub(&w2, &w3, &w2)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r1 - r2 */
   if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3 - r2 */
   if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r1/3 */
   if ((res = mp_div_3(&w1, &w1, NULL)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   /* r3/3 */
   if ((res = mp_div_3(&w3, &w3, NULL)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   /* at this point shift W[n] by B*n */
   if ((res = mp_lshd(&w1, 1*B)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_lshd(&w2, 2*B)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_lshd(&w3, 3*B)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_lshd(&w4, 4*B)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

   if ((res = mp_add(&w0, &w1, b)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&w2, &w3, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&w4, &tmp1, &tmp1)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }
   if ((res = mp_add(&tmp1, b, b)) != MP_OKAY) {
      goto ERR;
      goto LBL_ERR;
   }

ERR:
LBL_ERR:
   mp_clear_multi(&w0, &w1, &w2, &w3, &w4, &a0, &a1, &a2, &tmp1, NULL);
   return res;
}

#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_toradix.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_TORADIX_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* stores a bignum as a ASCII string in a given radix (2..64) */
int mp_toradix(const mp_int *a, char *str, int radix)
{
   int     res, digs;
   mp_int  t;

Changes to libtommath/bn_mp_toradix_n.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_TORADIX_N_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* stores a bignum as a ASCII string in a given radix (2..64)
 *
 * Stores upto maxlen-1 chars and always a NULL byte
 */
int mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)

Changes to libtommath/bn_mp_unsigned_bin_size.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19

20
21
22
23
24
25
26
-
+












-
-






-
+






#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_UNSIGNED_BIN_SIZE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* get the size for an unsigned equivalent */
int mp_unsigned_bin_size(const mp_int *a)
{
   int     size = mp_count_bits(a);
   return (size / 8) + (((size & 7) != 0) ? 1 : 0);
   return (size / 8) + ((((unsigned)size & 7u) != 0u) ? 1 : 0);
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_mp_xor.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_XOR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* XOR two ints together */
int mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     res, ix, px;
   mp_int  t;

Changes to libtommath/bn_mp_zero.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_MP_ZERO_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* set to zero */
void mp_zero(mp_int *a)
{
   int       n;
   mp_digit *tmp;

Changes to libtommath/bn_prime_tab.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18
19
20
21
22
23

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15

16
17
18
19
20
21
22
-
+












-
-
+
+
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_PRIME_TAB_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

 */
const mp_digit ltm_prime_tab[] = {
   0x0002, 0x0003, 0x0005, 0x0007, 0x000B, 0x000D, 0x0011, 0x0013,
   0x0017, 0x001D, 0x001F, 0x0025, 0x0029, 0x002B, 0x002F, 0x0035,
   0x003B, 0x003D, 0x0043, 0x0047, 0x0049, 0x004F, 0x0053, 0x0059,
   0x0061, 0x0065, 0x0067, 0x006B, 0x006D, 0x0071, 0x007F,
#ifndef MP_8BIT
   0x0083,

Changes to libtommath/bn_reverse.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_REVERSE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* reverse an array, used for radix code */
void bn_reverse(unsigned char *s, int len)
{
   int     ix, iy;
   unsigned char t;

Changes to libtommath/bn_s_mp_add.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_S_MP_ADD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* low level addition, based on HAC pp.594, Algorithm 14.7 */
int s_mp_add(const mp_int *a, const mp_int *b, mp_int *c)
{
   const mp_int *x;
   int     olduse, res, min, max;
63
64
65
66
67
68
69
70

71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
61
62
63
64
65
66
67

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

83
84
85
86
87
88
89
90







-
+














-
+







      /* zero the carry */
      u = 0;
      for (i = 0; i < min; i++) {
         /* Compute the sum at one digit, T[i] = A[i] + B[i] + U */
         *tmpc = *tmpa++ + *tmpb++ + u;

         /* U = carry bit of T[i] */
         u = *tmpc >> ((mp_digit)DIGIT_BIT);
         u = *tmpc >> (mp_digit)DIGIT_BIT;

         /* take away carry bit from T[i] */
         *tmpc++ &= MP_MASK;
      }

      /* now copy higher words if any, that is in A+B
       * if A or B has more digits add those in
       */
      if (min != max) {
         for (; i < max; i++) {
            /* T[i] = X[i] + U */
            *tmpc = x->dp[i] + u;

            /* U = carry bit of T[i] */
            u = *tmpc >> ((mp_digit)DIGIT_BIT);
            u = *tmpc >> (mp_digit)DIGIT_BIT;

            /* take away carry bit from T[i] */
            *tmpc++ &= MP_MASK;
         }
      }

      /* add carry */

Changes to libtommath/bn_s_mp_exptmod.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18
19
20
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15

16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
-
+












-
-
+
+
-











-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_S_MP_EXPTMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

 */
#ifdef MP_LOW_MEM
#   define TAB_SIZE 32
#else
#   define TAB_SIZE 256
#endif

int s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode)
{
   mp_int  M[TAB_SIZE], res, mu;
   mp_digit buf;
   int     err, bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize;
   int (*redux)(mp_int *, const mp_int *, const mp_int *);
   int (*redux)(mp_int *x, const mp_int *m, const mp_int *mu);

   /* find window size */
   x = mp_count_bits(X);
   if (x <= 7) {
      winsize = 2;
   } else if (x <= 36) {
      winsize = 3;
129
130
131
132
133
134
135
136

137
138
139
140
141
142
143
128
129
130
131
132
133
134

135
136
137
138
139
140
141
142







-
+







      }
   }

   /* setup result */
   if ((err = mp_init(&res)) != MP_OKAY) {
      goto LBL_MU;
   }
   mp_set(&res, 1);
   mp_set(&res, 1uL);

   /* set initial mode and bit cnt */
   mode   = 0;
   bitcnt = 1;
   buf    = 0;
   digidx = X->used - 1;
   bitcpy = 0;

Changes to libtommath/bn_s_mp_mul_digs.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33

34
35
36
37
38
39
40

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
30

31
32
33
34
35
36
37
38
-
+












-
-















-
+

-
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_S_MP_MUL_DIGS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* multiplies |a| * |b| and only computes upto digs digits of result
 * HAC pp. 595, Algorithm 14.12  Modified so you can control how
 * many digits of output are created.
 */
int s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
{
   mp_int  t;
   int     res, pa, pb, ix, iy;
   mp_digit u;
   mp_word r;
   mp_digit tmpx, *tmpt, *tmpy;

   /* can we use the fast multiplier? */
   if (((digs) < MP_WARRAY) &&
   if ((digs < (int)MP_WARRAY) &&
       (MIN(a->used, b->used) <
        (1 << ((CHAR_BIT * sizeof(mp_word)) - (2 * DIGIT_BIT))))) {
        (int)(1u << (((size_t)CHAR_BIT * sizeof(mp_word)) - (2u * (size_t)DIGIT_BIT))))) {
      return fast_s_mp_mul_digs(a, b, c, digs);
   }

   if ((res = mp_init_size(&t, digs)) != MP_OKAY) {
      return res;
   }
   t.used = digs;
62
63
64
65
66
67
68
69

70
71
72

73
74
75
76
77
78
79
60
61
62
63
64
65
66

67
68
69

70
71
72
73
74
75
76
77







-
+


-
+







      for (iy = 0; iy < pb; iy++) {
         /* compute the column as a mp_word */
         r       = (mp_word)*tmpt +
                   ((mp_word)tmpx * (mp_word)*tmpy++) +
                   (mp_word)u;

         /* the new column is the lower part of the result */
         *tmpt++ = (mp_digit)(r & ((mp_word) MP_MASK));
         *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK);

         /* get the carry word from the result */
         u       = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
         u       = (mp_digit)(r >> (mp_word)DIGIT_BIT);
      }
      /* set carry if it is placed below digs */
      if ((ix + iy) < digs) {
         *tmpt = u;
      }
   }

Changes to libtommath/bn_s_mp_mul_high_digs.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32


33
34
35
36
37
38
39

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27
28


29
30
31
32
33
34
35
36
37
-
+












-
-















-
-
+
+







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_S_MP_MUL_HIGH_DIGS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* multiplies |a| * |b| and does not compute the lower digs digits
 * [meant to get the higher part of the product]
 */
int s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
{
   mp_int  t;
   int     res, pa, pb, ix, iy;
   mp_digit u;
   mp_word r;
   mp_digit tmpx, *tmpt, *tmpy;

   /* can we use the fast multiplier? */
#ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C
   if (((a->used + b->used + 1) < MP_WARRAY)
       && (MIN(a->used, b->used) < (1 << ((CHAR_BIT * sizeof(mp_word)) - (2 * DIGIT_BIT))))) {
   if (((a->used + b->used + 1) < (int)MP_WARRAY)
       && (MIN(a->used, b->used) < (int)(1u << (((size_t)CHAR_BIT * sizeof(mp_word)) - (2u * (size_t)DIGIT_BIT))))) {
      return fast_s_mp_mul_high_digs(a, b, c, digs);
   }
#endif

   if ((res = mp_init_size(&t, a->used + b->used + 1)) != MP_OKAY) {
      return res;
   }
57
58
59
60
61
62
63
64

65
66
67

68
69
70
71
72
73
74
75
76
77
78
79
80
55
56
57
58
59
60
61

62
63
64

65
66
67
68
69
70
71
72
73
74
75
76
77
78







-
+


-
+













      for (iy = digs - ix; iy < pb; iy++) {
         /* calculate the double precision result */
         r       = (mp_word)*tmpt +
                   ((mp_word)tmpx * (mp_word)*tmpy++) +
                   (mp_word)u;

         /* get the lower part */
         *tmpt++ = (mp_digit)(r & ((mp_word) MP_MASK));
         *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK);

         /* carry the carry */
         u       = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
         u       = (mp_digit)(r >> (mp_word)DIGIT_BIT);
      }
      *tmpt = u;
   }
   mp_clamp(&t);
   mp_exch(&t, c);
   mp_clear(&t);
   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_s_mp_sqr.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_S_MP_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* low level squaring, b = a*a, HAC pp.596-597, Algorithm 14.16 */
int s_mp_sqr(const mp_int *a, mp_int *b)
{
   mp_int  t;
   int     res, ix, iy, pa;
34
35
36
37
38
39
40
41

42
43
44

45
46
47
48
49
50
51
52
53
54

55
56
57
58
59

60
61
62

63
64
65

66
67
68
69
70
71




72
73
74
75
76
77
78
79
80
81
82
83
84
32
33
34
35
36
37
38

39
40
41

42
43
44
45
46
47
48
49
50
51

52
53
54
55
56

57
58
59

60
61
62

63
64
65




66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82







-
+


-
+









-
+




-
+


-
+


-
+


-
-
-
-
+
+
+
+













   for (ix = 0; ix < pa; ix++) {
      /* first calculate the digit at 2*ix */
      /* calculate double precision result */
      r = (mp_word)t.dp[2*ix] +
          ((mp_word)a->dp[ix] * (mp_word)a->dp[ix]);

      /* store lower part in result */
      t.dp[ix+ix] = (mp_digit)(r & ((mp_word)MP_MASK));
      t.dp[ix+ix] = (mp_digit)(r & (mp_word)MP_MASK);

      /* get the carry */
      u           = (mp_digit)(r >> ((mp_word)DIGIT_BIT));
      u           = (mp_digit)(r >> (mp_word)DIGIT_BIT);

      /* left hand side of A[ix] * A[iy] */
      tmpx        = a->dp[ix];

      /* alias for where to store the results */
      tmpt        = t.dp + ((2 * ix) + 1);

      for (iy = ix + 1; iy < pa; iy++) {
         /* first calculate the product */
         r       = ((mp_word)tmpx) * ((mp_word)a->dp[iy]);
         r       = (mp_word)tmpx * (mp_word)a->dp[iy];

         /* now calculate the double precision result, note we use
          * addition instead of *2 since it's easier to optimize
          */
         r       = ((mp_word) *tmpt) + r + r + ((mp_word) u);
         r       = (mp_word)*tmpt + r + r + (mp_word)u;

         /* store lower part */
         *tmpt++ = (mp_digit)(r & ((mp_word) MP_MASK));
         *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK);

         /* get carry */
         u       = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
         u       = (mp_digit)(r >> (mp_word)DIGIT_BIT);
      }
      /* propagate upwards */
      while (u != ((mp_digit) 0)) {
         r       = ((mp_word) *tmpt) + ((mp_word) u);
         *tmpt++ = (mp_digit)(r & ((mp_word) MP_MASK));
         u       = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
      while (u != 0uL) {
         r       = (mp_word)*tmpt + (mp_word)u;
         *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK);
         u       = (mp_digit)(r >> (mp_word)DIGIT_BIT);
      }
   }

   mp_clamp(&t);
   mp_exch(&t, b);
   mp_clear(&t);
   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

Changes to libtommath/bn_s_mp_sub.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BN_S_MP_SUB_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* low level subtraction (assumes |a| > |b|), HAC pp.595 Algorithm 14.9 */
int s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     olduse, res, min, max;

49
50
51
52
53
54
55
56

57
58
59
60
61
62
63
64
65
66
67
68

69
70
71
72
73
74
75
47
48
49
50
51
52
53

54
55
56
57
58
59
60
61
62
63
64
65

66
67
68
69
70
71
72
73







-
+











-
+







         *tmpc = (*tmpa++ - *tmpb++) - u;

         /* U = carry bit of T[i]
          * Note this saves performing an AND operation since
          * if a carry does occur it will propagate all the way to the
          * MSB.  As a result a single shift is enough to get the carry
          */
         u = *tmpc >> ((mp_digit)((CHAR_BIT * sizeof(mp_digit)) - 1));
         u = *tmpc >> (((size_t)CHAR_BIT * sizeof(mp_digit)) - 1u);

         /* Clear carry from T[i] */
         *tmpc++ &= MP_MASK;
      }

      /* now copy higher words if any, e.g. if A has more digits than B  */
      for (; i < max; i++) {
         /* T[i] = A[i] - U */
         *tmpc = *tmpa++ - u;

         /* U = carry bit of T[i] */
         u = *tmpc >> ((mp_digit)((CHAR_BIT * sizeof(mp_digit)) - 1));
         u = *tmpc >> (((size_t)CHAR_BIT * sizeof(mp_digit)) - 1u);

         /* Clear carry from T[i] */
         *tmpc++ &= MP_MASK;
      }

      /* clear digits above used (since we may not have grown result above) */
      for (i = c->used; i < olduse; i++) {

Changes to libtommath/bncore.c.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
-
+












-
-







#include <tommath_private.h>
#include "tommath_private.h"
#ifdef BNCORE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://libtom.org
 */

/* Known optimal configurations

 CPU                    /Compiler     /MUL CUTOFF/SQR CUTOFF
-------------------------------------------------------------
 Intel P4 Northwood     /GCC v3.4.1   /        88/       128/LTM 0.32 ;-)

Changes to libtommath/callgraph.txt.

232
233
234
235
236
237
238











239
240
241
242
243
244
245
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256







+
+
+
+
+
+
+
+
+
+
+









BN_MP_CMP_MAG_C


BN_MP_CNT_LSB_C


BN_MP_COMPLEMENT_C
+--->BN_MP_NEG_C
|   +--->BN_MP_COPY_C
|   |   +--->BN_MP_GROW_C
+--->BN_MP_SUB_D_C
|   +--->BN_MP_GROW_C
|   +--->BN_MP_ADD_D_C
|   |   +--->BN_MP_CLAMP_C
|   +--->BN_MP_CLAMP_C


BN_MP_COPY_C
+--->BN_MP_GROW_C


BN_MP_COUNT_BITS_C

12377
12378
12379
12380
12381
12382
12383






































































































































































12384
12385
12386
12387
12388
12389
12390
12388
12389
12390
12391
12392
12393
12394
12395
12396
12397
12398
12399
12400
12401
12402
12403
12404
12405
12406
12407
12408
12409
12410
12411
12412
12413
12414
12415
12416
12417
12418
12419
12420
12421
12422
12423
12424
12425
12426
12427
12428
12429
12430
12431
12432
12433
12434
12435
12436
12437
12438
12439
12440
12441
12442
12443
12444
12445
12446
12447
12448
12449
12450
12451
12452
12453
12454
12455
12456
12457
12458
12459
12460
12461
12462
12463
12464
12465
12466
12467
12468
12469
12470
12471
12472
12473
12474
12475
12476
12477
12478
12479
12480
12481
12482
12483
12484
12485
12486
12487
12488
12489
12490
12491
12492
12493
12494
12495
12496
12497
12498
12499
12500
12501
12502
12503
12504
12505
12506
12507
12508
12509
12510
12511
12512
12513
12514
12515
12516
12517
12518
12519
12520
12521
12522
12523
12524
12525
12526
12527
12528
12529
12530
12531
12532
12533
12534
12535
12536
12537
12538
12539
12540
12541
12542
12543
12544
12545
12546
12547
12548
12549
12550
12551
12552
12553
12554
12555
12556
12557
12558
12559
12560
12561
12562
12563
12564
12565
12566
12567







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








BN_MP_SUB_D_C
+--->BN_MP_GROW_C
+--->BN_MP_ADD_D_C
|   +--->BN_MP_CLAMP_C
+--->BN_MP_CLAMP_C


BN_MP_TC_AND_C
+--->BN_MP_COUNT_BITS_C
+--->BN_MP_INIT_SET_INT_C
|   +--->BN_MP_INIT_C
|   +--->BN_MP_SET_INT_C
|   |   +--->BN_MP_ZERO_C
|   |   +--->BN_MP_MUL_2D_C
|   |   |   +--->BN_MP_COPY_C
|   |   |   |   +--->BN_MP_GROW_C
|   |   |   +--->BN_MP_GROW_C
|   |   |   +--->BN_MP_LSHD_C
|   |   |   |   +--->BN_MP_RSHD_C
|   |   |   +--->BN_MP_CLAMP_C
|   |   +--->BN_MP_CLAMP_C
+--->BN_MP_MUL_2D_C
|   +--->BN_MP_COPY_C
|   |   +--->BN_MP_GROW_C
|   +--->BN_MP_GROW_C
|   +--->BN_MP_LSHD_C
|   |   +--->BN_MP_RSHD_C
|   |   |   +--->BN_MP_ZERO_C
|   +--->BN_MP_CLAMP_C
+--->BN_MP_INIT_C
+--->BN_MP_ADD_C
|   +--->BN_S_MP_ADD_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C
|   +--->BN_MP_CMP_MAG_C
|   +--->BN_S_MP_SUB_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C
+--->BN_MP_CLEAR_C
+--->BN_MP_AND_C
|   +--->BN_MP_INIT_COPY_C
|   |   +--->BN_MP_INIT_SIZE_C
|   |   +--->BN_MP_COPY_C
|   |   |   +--->BN_MP_GROW_C
|   +--->BN_MP_CLAMP_C
|   +--->BN_MP_EXCH_C
+--->BN_MP_SUB_C
|   +--->BN_S_MP_ADD_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C
|   +--->BN_MP_CMP_MAG_C
|   +--->BN_S_MP_SUB_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C


BN_MP_TC_DIV_2D_C
+--->BN_MP_DIV_2D_C
|   +--->BN_MP_COPY_C
|   |   +--->BN_MP_GROW_C
|   +--->BN_MP_ZERO_C
|   +--->BN_MP_MOD_2D_C
|   |   +--->BN_MP_CLAMP_C
|   +--->BN_MP_RSHD_C
|   +--->BN_MP_CLAMP_C
+--->BN_MP_ADD_D_C
|   +--->BN_MP_GROW_C
|   +--->BN_MP_SUB_D_C
|   |   +--->BN_MP_CLAMP_C
|   +--->BN_MP_CLAMP_C
+--->BN_MP_SUB_D_C
|   +--->BN_MP_GROW_C
|   +--->BN_MP_CLAMP_C


BN_MP_TC_OR_C
+--->BN_MP_COUNT_BITS_C
+--->BN_MP_INIT_SET_INT_C
|   +--->BN_MP_INIT_C
|   +--->BN_MP_SET_INT_C
|   |   +--->BN_MP_ZERO_C
|   |   +--->BN_MP_MUL_2D_C
|   |   |   +--->BN_MP_COPY_C
|   |   |   |   +--->BN_MP_GROW_C
|   |   |   +--->BN_MP_GROW_C
|   |   |   +--->BN_MP_LSHD_C
|   |   |   |   +--->BN_MP_RSHD_C
|   |   |   +--->BN_MP_CLAMP_C
|   |   +--->BN_MP_CLAMP_C
+--->BN_MP_MUL_2D_C
|   +--->BN_MP_COPY_C
|   |   +--->BN_MP_GROW_C
|   +--->BN_MP_GROW_C
|   +--->BN_MP_LSHD_C
|   |   +--->BN_MP_RSHD_C
|   |   |   +--->BN_MP_ZERO_C
|   +--->BN_MP_CLAMP_C
+--->BN_MP_INIT_C
+--->BN_MP_ADD_C
|   +--->BN_S_MP_ADD_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C
|   +--->BN_MP_CMP_MAG_C
|   +--->BN_S_MP_SUB_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C
+--->BN_MP_CLEAR_C
+--->BN_MP_OR_C
|   +--->BN_MP_INIT_COPY_C
|   |   +--->BN_MP_INIT_SIZE_C
|   |   +--->BN_MP_COPY_C
|   |   |   +--->BN_MP_GROW_C
|   +--->BN_MP_CLAMP_C
|   +--->BN_MP_EXCH_C
+--->BN_MP_SUB_C
|   +--->BN_S_MP_ADD_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C
|   +--->BN_MP_CMP_MAG_C
|   +--->BN_S_MP_SUB_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C


BN_MP_TC_XOR_C
+--->BN_MP_COUNT_BITS_C
+--->BN_MP_INIT_SET_INT_C
|   +--->BN_MP_INIT_C
|   +--->BN_MP_SET_INT_C
|   |   +--->BN_MP_ZERO_C
|   |   +--->BN_MP_MUL_2D_C
|   |   |   +--->BN_MP_COPY_C
|   |   |   |   +--->BN_MP_GROW_C
|   |   |   +--->BN_MP_GROW_C
|   |   |   +--->BN_MP_LSHD_C
|   |   |   |   +--->BN_MP_RSHD_C
|   |   |   +--->BN_MP_CLAMP_C
|   |   +--->BN_MP_CLAMP_C
+--->BN_MP_MUL_2D_C
|   +--->BN_MP_COPY_C
|   |   +--->BN_MP_GROW_C
|   +--->BN_MP_GROW_C
|   +--->BN_MP_LSHD_C
|   |   +--->BN_MP_RSHD_C
|   |   |   +--->BN_MP_ZERO_C
|   +--->BN_MP_CLAMP_C
+--->BN_MP_INIT_C
+--->BN_MP_ADD_C
|   +--->BN_S_MP_ADD_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C
|   +--->BN_MP_CMP_MAG_C
|   +--->BN_S_MP_SUB_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C
+--->BN_MP_CLEAR_C
+--->BN_MP_XOR_C
|   +--->BN_MP_INIT_COPY_C
|   |   +--->BN_MP_INIT_SIZE_C
|   |   +--->BN_MP_COPY_C
|   |   |   +--->BN_MP_GROW_C
|   +--->BN_MP_CLAMP_C
|   +--->BN_MP_EXCH_C
+--->BN_MP_SUB_C
|   +--->BN_S_MP_ADD_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C
|   +--->BN_MP_CMP_MAG_C
|   +--->BN_S_MP_SUB_C
|   |   +--->BN_MP_GROW_C
|   |   +--->BN_MP_CLAMP_C


BN_MP_TOOM_MUL_C
+--->BN_MP_INIT_MULTI_C
|   +--->BN_MP_INIT_C
|   +--->BN_MP_CLEAR_C
+--->BN_MP_MOD_2D_C
|   +--->BN_MP_ZERO_C

Changes to libtommath/makefile.

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42











43
44
45
46
47
48
49
50
51





52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71


72
73
74
75
76
77
78
79
80



81
82
83
84
85
86
87
25
26
27
28
29
30
31











32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47




48
49
50
51
52

53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69


70
71
72
73
74
75
76
77



78
79
80
81
82
83
84
85
86
87







-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
+
+
+
+
+
-

















-
-
+
+






-
-
-
+
+
+








LCOV_ARGS=--directory .

#START_INS
OBJECTS=bncore.o bn_error.o bn_fast_mp_invmod.o bn_fast_mp_montgomery_reduce.o bn_fast_s_mp_mul_digs.o \
bn_fast_s_mp_mul_high_digs.o bn_fast_s_mp_sqr.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o \
bn_mp_addmod.o bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o \
bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div_2.o bn_mp_div_2d.o bn_mp_div_3.o \
bn_mp_div.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o bn_mp_exch.o \
bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o bn_mp_exptmod_fast.o bn_mp_exteuclid.o \
bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_int.o bn_mp_get_long.o bn_mp_get_long_long.o \
bn_mp_grow.o bn_mp_import.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_invmod.o bn_mp_invmod_slow.o bn_mp_is_square.o \
bn_mp_jacobi.o bn_mp_karatsuba_mul.o bn_mp_karatsuba_sqr.o bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod_2d.o \
bn_mp_mod.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \
bn_mp_montgomery_setup.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \
bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_or.o bn_mp_prime_fermat.o bn_mp_prime_is_divisible.o \
bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o \
bn_mp_dr_setup.o bn_mp_exch.o bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o \
bn_mp_exptmod_fast.o bn_mp_exteuclid.o bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_int.o \
bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_import.o bn_mp_init.o bn_mp_init_copy.o \
bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_invmod.o \
bn_mp_invmod_slow.o bn_mp_is_square.o bn_mp_jacobi.o bn_mp_karatsuba_mul.o bn_mp_karatsuba_sqr.o \
bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod_2d.o bn_mp_mod.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \
bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul.o bn_mp_mul_d.o \
bn_mp_mulmod.o bn_mp_neg.o bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_or.o bn_mp_prime_fermat.o \
bn_mp_prime_is_divisible.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_prime_rabin_miller_trials.o bn_mp_prime_random_ex.o bn_mp_radix_size.o bn_mp_radix_smap.o \
bn_mp_rand.o bn_mp_read_radix.o bn_mp_read_signed_bin.o bn_mp_read_unsigned_bin.o bn_mp_reduce_2k.o \
bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce.o \
bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o bn_mp_signed_bin_size.o bn_mp_sqr.o bn_mp_sqrmod.o \
bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o bn_mp_toom_mul.o \
bn_mp_toom_sqr.o bn_mp_toradix.o bn_mp_toradix_n.o bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o \
bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o \
bn_prime_tab.o bn_reverse.o bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o bn_s_mp_mul_high_digs.o \
bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o bn_mp_tc_and.o \
bn_mp_tc_div_2d.o bn_mp_tc_or.o bn_mp_tc_xor.o bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix.o \
bn_mp_toradix_n.o bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin.o \
bn_mp_to_unsigned_bin_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_reverse.o \
bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o bn_s_mp_mul_high_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
bn_s_mp_sqr.o bn_s_mp_sub.o

#END_INS

$(OBJECTS): $(HEADERS)

$(LIBNAME):  $(OBJECTS)
	$(AR) $(ARFLAGS) $@ $(OBJECTS)
	$(RANLIB) $@

#make a profiled library (takes a while!!!)
#
# This will build the library with profile generation
# then run the test demo and rebuild the library.
#
# So far I've seen improvements in the MP math
profiled:
	make CFLAGS="$(CFLAGS) -fprofile-arcs -DTESTING" timing
	./ltmtest
	rm -f *.a *.o ltmtest
	./timing
	rm -f *.a *.o timing
	make CFLAGS="$(CFLAGS) -fbranch-probabilities"

#make a single object profiled library
profiled_single:
	perl gen.pl
	$(CC) $(CFLAGS) -fprofile-arcs -DTESTING -c mpi.c -o mpi.o
	$(CC) $(CFLAGS) -DTESTING -DTIMER demo/timing.c mpi.o -lgcov -o ltmtest
	./ltmtest
	rm -f *.o ltmtest
	$(CC) $(CFLAGS) -DTESTING -DTIMER demo/timing.c mpi.o -lgcov -o timing
	./timing
	rm -f *.o timing
	$(CC) $(CFLAGS) -fbranch-probabilities -DTESTING -c mpi.c -o mpi.o
	$(AR) $(ARFLAGS) $(LIBNAME) mpi.o
	ranlib $(LIBNAME)

install: $(LIBNAME)
	install -d $(DESTDIR)$(LIBPATH)
	install -d $(DESTDIR)$(INCPATH)
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
128
129

130
131
132
133
134
135
136
137


138
139

140
141
142
143
144
145
146
147
148
149
150
151

152
153
154

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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150

151
152
153

154







-
-
-
-
-
-
+
+














+




-
+








+
+


+











-
+


-
+
test_standalone: $(LIBNAME) demo/demo.o
	$(CC) $(CFLAGS) demo/demo.o $(LIBNAME) $(LFLAGS) -o test

.PHONY: mtest
mtest:
	cd mtest ; $(CC) $(CFLAGS) -O0 mtest.c $(LFLAGS) -o mtest

travis_mtest: test mtest
	@ for i in `seq 1 10` ; do sleep 500 && echo alive; done &
	./mtest/mtest 666666 | ./test > test.log

timing: $(LIBNAME)
	$(CC) $(CFLAGS) -DTIMER demo/timing.c $(LIBNAME) $(LFLAGS) -o ltmtest
timing: $(LIBNAME) demo/timing.c
	$(CC) $(CFLAGS) -DTIMER demo/timing.c $(LIBNAME) $(LFLAGS) -o timing

# You have to create a file .coveralls.yml with the content "repo_token: <the token>"
# in the base folder to be able to submit to coveralls
coveralls: lcov
	coveralls-lcov

docdvi poster docs mandvi manual:
	$(MAKE) -C doc/ $@ V=$(V)

pretty:
	perl pretty.build

.PHONY: pre_gen
pre_gen:
	mkdir -p pre_gen
	perl gen.pl
	sed -e 's/[[:blank:]]*$$//' mpi.c > pre_gen/mpi.c
	rm mpi.c

zipup: clean pre_gen new_file manual poster docs
zipup: clean astyle new_file manual poster docs
	@# Update the index, so diff-index won't fail in case the pdf has been created.
	@#   As the pdf creation modifies the tex files, git sometimes detects the
	@#   modified files, but misses that it's put back to its original version.
	@git update-index --refresh
	@git diff-index --quiet HEAD -- || ( echo "FAILURE: uncommited changes or not a git" && exit 1 )
	rm -rf libtommath-$(VERSION) ltm-$(VERSION).*
	@# files/dirs excluded from "git archive" are defined in .gitattributes
	git archive --format=tar --prefix=libtommath-$(VERSION)/ HEAD | tar x
	@echo 'fixme check'
	-@(find libtommath-$(VERSION)/ -type f | xargs grep 'FIXM[E]') && echo '############## BEWARE: the "fixme" marker was found !!! ##############' || true
	mkdir -p libtommath-$(VERSION)/doc
	cp doc/bn.pdf doc/tommath.pdf doc/poster.pdf libtommath-$(VERSION)/doc/
	$(MAKE) -C libtommath-$(VERSION)/ pre_gen
	tar -c libtommath-$(VERSION)/ | xz -6e -c - > ltm-$(VERSION).tar.xz
	zip -9rq ltm-$(VERSION).zip libtommath-$(VERSION)
	rm -rf libtommath-$(VERSION)
	gpg -b -a ltm-$(VERSION).tar.xz
	gpg -b -a ltm-$(VERSION).zip

new_file:
	bash updatemakes.sh
	perl dep.pl

perlcritic:
	perlcritic *.pl
	perlcritic *.pl doc/*.pl

astyle:
	astyle --options=astylerc $(OBJECTS:.o=.c)
	astyle --options=astylerc $(OBJECTS:.o=.c) tommath*.h demo/*.c etc/*.c mtest/mtest.c

Changes to libtommath/makefile.bcc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24











25
26
27
28
29
30
31
32
33





34
35
36
37
38
39
40
41
1
2
3
4
5
6
7
8
9
10
11
12
13











14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29




30
31
32
33
34

35
36
37
38
39
40
41













-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
+
+
+
+
+
-







#
# Borland C++Builder Makefile (makefile.bcc)
#


LIB = tlib
CC = bcc32
CFLAGS = -c -O2 -I.

#START_INS
OBJECTS=bncore.obj bn_error.obj bn_fast_mp_invmod.obj bn_fast_mp_montgomery_reduce.obj bn_fast_s_mp_mul_digs.obj \
bn_fast_s_mp_mul_high_digs.obj bn_fast_s_mp_sqr.obj bn_mp_2expt.obj bn_mp_abs.obj bn_mp_add.obj bn_mp_add_d.obj \
bn_mp_addmod.obj bn_mp_and.obj bn_mp_clamp.obj bn_mp_clear.obj bn_mp_clear_multi.obj bn_mp_cmp.obj bn_mp_cmp_d.obj \
bn_mp_cmp_mag.obj bn_mp_cnt_lsb.obj bn_mp_copy.obj bn_mp_count_bits.obj bn_mp_div_2.obj bn_mp_div_2d.obj bn_mp_div_3.obj \
bn_mp_div.obj bn_mp_div_d.obj bn_mp_dr_is_modulus.obj bn_mp_dr_reduce.obj bn_mp_dr_setup.obj bn_mp_exch.obj \
bn_mp_export.obj bn_mp_expt_d.obj bn_mp_expt_d_ex.obj bn_mp_exptmod.obj bn_mp_exptmod_fast.obj bn_mp_exteuclid.obj \
bn_mp_fread.obj bn_mp_fwrite.obj bn_mp_gcd.obj bn_mp_get_int.obj bn_mp_get_long.obj bn_mp_get_long_long.obj \
bn_mp_grow.obj bn_mp_import.obj bn_mp_init.obj bn_mp_init_copy.obj bn_mp_init_multi.obj bn_mp_init_set.obj \
bn_mp_init_set_int.obj bn_mp_init_size.obj bn_mp_invmod.obj bn_mp_invmod_slow.obj bn_mp_is_square.obj \
bn_mp_jacobi.obj bn_mp_karatsuba_mul.obj bn_mp_karatsuba_sqr.obj bn_mp_lcm.obj bn_mp_lshd.obj bn_mp_mod_2d.obj \
bn_mp_mod.obj bn_mp_mod_d.obj bn_mp_montgomery_calc_normalization.obj bn_mp_montgomery_reduce.obj \
bn_mp_montgomery_setup.obj bn_mp_mul_2.obj bn_mp_mul_2d.obj bn_mp_mul.obj bn_mp_mul_d.obj bn_mp_mulmod.obj bn_mp_neg.obj \
bn_mp_n_root.obj bn_mp_n_root_ex.obj bn_mp_or.obj bn_mp_prime_fermat.obj bn_mp_prime_is_divisible.obj \
bn_mp_prime_is_prime.obj bn_mp_prime_miller_rabin.obj bn_mp_prime_next_prime.obj \
bn_mp_cmp_mag.obj bn_mp_cnt_lsb.obj bn_mp_complement.obj bn_mp_copy.obj bn_mp_count_bits.obj bn_mp_div_2.obj \
bn_mp_div_2d.obj bn_mp_div_3.obj bn_mp_div.obj bn_mp_div_d.obj bn_mp_dr_is_modulus.obj bn_mp_dr_reduce.obj \
bn_mp_dr_setup.obj bn_mp_exch.obj bn_mp_export.obj bn_mp_expt_d.obj bn_mp_expt_d_ex.obj bn_mp_exptmod.obj \
bn_mp_exptmod_fast.obj bn_mp_exteuclid.obj bn_mp_fread.obj bn_mp_fwrite.obj bn_mp_gcd.obj bn_mp_get_int.obj \
bn_mp_get_long.obj bn_mp_get_long_long.obj bn_mp_grow.obj bn_mp_import.obj bn_mp_init.obj bn_mp_init_copy.obj \
bn_mp_init_multi.obj bn_mp_init_set.obj bn_mp_init_set_int.obj bn_mp_init_size.obj bn_mp_invmod.obj \
bn_mp_invmod_slow.obj bn_mp_is_square.obj bn_mp_jacobi.obj bn_mp_karatsuba_mul.obj bn_mp_karatsuba_sqr.obj \
bn_mp_lcm.obj bn_mp_lshd.obj bn_mp_mod_2d.obj bn_mp_mod.obj bn_mp_mod_d.obj bn_mp_montgomery_calc_normalization.obj \
bn_mp_montgomery_reduce.obj bn_mp_montgomery_setup.obj bn_mp_mul_2.obj bn_mp_mul_2d.obj bn_mp_mul.obj bn_mp_mul_d.obj \
bn_mp_mulmod.obj bn_mp_neg.obj bn_mp_n_root.obj bn_mp_n_root_ex.obj bn_mp_or.obj bn_mp_prime_fermat.obj \
bn_mp_prime_is_divisible.obj bn_mp_prime_is_prime.obj bn_mp_prime_miller_rabin.obj bn_mp_prime_next_prime.obj \
bn_mp_prime_rabin_miller_trials.obj bn_mp_prime_random_ex.obj bn_mp_radix_size.obj bn_mp_radix_smap.obj \
bn_mp_rand.obj bn_mp_read_radix.obj bn_mp_read_signed_bin.obj bn_mp_read_unsigned_bin.obj bn_mp_reduce_2k.obj \
bn_mp_reduce_2k_l.obj bn_mp_reduce_2k_setup.obj bn_mp_reduce_2k_setup_l.obj bn_mp_reduce.obj \
bn_mp_reduce_is_2k.obj bn_mp_reduce_is_2k_l.obj bn_mp_reduce_setup.obj bn_mp_rshd.obj bn_mp_set.obj bn_mp_set_int.obj \
bn_mp_set_long.obj bn_mp_set_long_long.obj bn_mp_shrink.obj bn_mp_signed_bin_size.obj bn_mp_sqr.obj bn_mp_sqrmod.obj \
bn_mp_sqrt.obj bn_mp_sqrtmod_prime.obj bn_mp_sub.obj bn_mp_sub_d.obj bn_mp_submod.obj bn_mp_toom_mul.obj \
bn_mp_toom_sqr.obj bn_mp_toradix.obj bn_mp_toradix_n.obj bn_mp_to_signed_bin.obj bn_mp_to_signed_bin_n.obj \
bn_mp_to_unsigned_bin.obj bn_mp_to_unsigned_bin_n.obj bn_mp_unsigned_bin_size.obj bn_mp_xor.obj bn_mp_zero.obj \
bn_prime_tab.obj bn_reverse.obj bn_s_mp_add.obj bn_s_mp_exptmod.obj bn_s_mp_mul_digs.obj bn_s_mp_mul_high_digs.obj \
bn_mp_sqrt.obj bn_mp_sqrtmod_prime.obj bn_mp_sub.obj bn_mp_sub_d.obj bn_mp_submod.obj bn_mp_tc_and.obj \
bn_mp_tc_div_2d.obj bn_mp_tc_or.obj bn_mp_tc_xor.obj bn_mp_toom_mul.obj bn_mp_toom_sqr.obj bn_mp_toradix.obj \
bn_mp_toradix_n.obj bn_mp_to_signed_bin.obj bn_mp_to_signed_bin_n.obj bn_mp_to_unsigned_bin.obj \
bn_mp_to_unsigned_bin_n.obj bn_mp_unsigned_bin_size.obj bn_mp_xor.obj bn_mp_zero.obj bn_prime_tab.obj bn_reverse.obj \
bn_s_mp_add.obj bn_s_mp_exptmod.obj bn_s_mp_mul_digs.obj bn_s_mp_mul_high_digs.obj bn_s_mp_sqr.obj bn_s_mp_sub.obj
bn_s_mp_sqr.obj bn_s_mp_sub.obj

#END_INS

HEADERS=tommath.h tommath_class.h tommath_superclass.h

TARGET = libtommath.lib

Changes to libtommath/makefile.cygwin_dll.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29











30
31
32
33
34
35
36
37
38





39
40
41
42
43
44
45
46
12
13
14
15
16
17
18











19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34




35
36
37
38
39

40
41
42
43
44
45
46







-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
+
+
+
+
+
-








default: windll

#START_INS
OBJECTS=bncore.o bn_error.o bn_fast_mp_invmod.o bn_fast_mp_montgomery_reduce.o bn_fast_s_mp_mul_digs.o \
bn_fast_s_mp_mul_high_digs.o bn_fast_s_mp_sqr.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o \
bn_mp_addmod.o bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o \
bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div_2.o bn_mp_div_2d.o bn_mp_div_3.o \
bn_mp_div.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o bn_mp_exch.o \
bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o bn_mp_exptmod_fast.o bn_mp_exteuclid.o \
bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_int.o bn_mp_get_long.o bn_mp_get_long_long.o \
bn_mp_grow.o bn_mp_import.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_invmod.o bn_mp_invmod_slow.o bn_mp_is_square.o \
bn_mp_jacobi.o bn_mp_karatsuba_mul.o bn_mp_karatsuba_sqr.o bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod_2d.o \
bn_mp_mod.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \
bn_mp_montgomery_setup.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \
bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_or.o bn_mp_prime_fermat.o bn_mp_prime_is_divisible.o \
bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o \
bn_mp_dr_setup.o bn_mp_exch.o bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o \
bn_mp_exptmod_fast.o bn_mp_exteuclid.o bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_int.o \
bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_import.o bn_mp_init.o bn_mp_init_copy.o \
bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_invmod.o \
bn_mp_invmod_slow.o bn_mp_is_square.o bn_mp_jacobi.o bn_mp_karatsuba_mul.o bn_mp_karatsuba_sqr.o \
bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod_2d.o bn_mp_mod.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \
bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul.o bn_mp_mul_d.o \
bn_mp_mulmod.o bn_mp_neg.o bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_or.o bn_mp_prime_fermat.o \
bn_mp_prime_is_divisible.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_prime_rabin_miller_trials.o bn_mp_prime_random_ex.o bn_mp_radix_size.o bn_mp_radix_smap.o \
bn_mp_rand.o bn_mp_read_radix.o bn_mp_read_signed_bin.o bn_mp_read_unsigned_bin.o bn_mp_reduce_2k.o \
bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce.o \
bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o bn_mp_signed_bin_size.o bn_mp_sqr.o bn_mp_sqrmod.o \
bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o bn_mp_toom_mul.o \
bn_mp_toom_sqr.o bn_mp_toradix.o bn_mp_toradix_n.o bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o \
bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o \
bn_prime_tab.o bn_reverse.o bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o bn_s_mp_mul_high_digs.o \
bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o bn_mp_tc_and.o \
bn_mp_tc_div_2d.o bn_mp_tc_or.o bn_mp_tc_xor.o bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix.o \
bn_mp_toradix_n.o bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin.o \
bn_mp_to_unsigned_bin_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_reverse.o \
bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o bn_s_mp_mul_high_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
bn_s_mp_sqr.o bn_s_mp_sub.o

#END_INS

HEADERS=tommath.h tommath_class.h tommath_superclass.h

# make a Windows DLL via Cygwin
windll:  $(OBJECTS)

Changes to libtommath/makefile.icc.

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55











56
57
58
59
60
61
62
63
64





65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84


85
86
87
88
89
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
38
39
40
41
42
43
44











45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60




61
62
63
64
65

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82


83
84
85
86
87
88
89
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







-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
+
+
+
+
+
-

















-
-
+
+






-
-
-
+
+
+
















-
-
+
+


-
+



INCPATH=/usr/include
DATAPATH=/usr/share/doc/libtommath/pdf

#START_INS
OBJECTS=bncore.o bn_error.o bn_fast_mp_invmod.o bn_fast_mp_montgomery_reduce.o bn_fast_s_mp_mul_digs.o \
bn_fast_s_mp_mul_high_digs.o bn_fast_s_mp_sqr.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o \
bn_mp_addmod.o bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o \
bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div_2.o bn_mp_div_2d.o bn_mp_div_3.o \
bn_mp_div.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o bn_mp_exch.o \
bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o bn_mp_exptmod_fast.o bn_mp_exteuclid.o \
bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_int.o bn_mp_get_long.o bn_mp_get_long_long.o \
bn_mp_grow.o bn_mp_import.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_invmod.o bn_mp_invmod_slow.o bn_mp_is_square.o \
bn_mp_jacobi.o bn_mp_karatsuba_mul.o bn_mp_karatsuba_sqr.o bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod_2d.o \
bn_mp_mod.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \
bn_mp_montgomery_setup.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \
bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_or.o bn_mp_prime_fermat.o bn_mp_prime_is_divisible.o \
bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o \
bn_mp_dr_setup.o bn_mp_exch.o bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o \
bn_mp_exptmod_fast.o bn_mp_exteuclid.o bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_int.o \
bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_import.o bn_mp_init.o bn_mp_init_copy.o \
bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_invmod.o \
bn_mp_invmod_slow.o bn_mp_is_square.o bn_mp_jacobi.o bn_mp_karatsuba_mul.o bn_mp_karatsuba_sqr.o \
bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod_2d.o bn_mp_mod.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \
bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul.o bn_mp_mul_d.o \
bn_mp_mulmod.o bn_mp_neg.o bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_or.o bn_mp_prime_fermat.o \
bn_mp_prime_is_divisible.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_prime_rabin_miller_trials.o bn_mp_prime_random_ex.o bn_mp_radix_size.o bn_mp_radix_smap.o \
bn_mp_rand.o bn_mp_read_radix.o bn_mp_read_signed_bin.o bn_mp_read_unsigned_bin.o bn_mp_reduce_2k.o \
bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce.o \
bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o bn_mp_signed_bin_size.o bn_mp_sqr.o bn_mp_sqrmod.o \
bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o bn_mp_toom_mul.o \
bn_mp_toom_sqr.o bn_mp_toradix.o bn_mp_toradix_n.o bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o \
bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o \
bn_prime_tab.o bn_reverse.o bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o bn_s_mp_mul_high_digs.o \
bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o bn_mp_tc_and.o \
bn_mp_tc_div_2d.o bn_mp_tc_or.o bn_mp_tc_xor.o bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix.o \
bn_mp_toradix_n.o bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin.o \
bn_mp_to_unsigned_bin_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_reverse.o \
bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o bn_s_mp_mul_high_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
bn_s_mp_sqr.o bn_s_mp_sub.o

#END_INS

HEADERS=tommath.h tommath_class.h tommath_superclass.h

libtommath.a:  $(OBJECTS)
	$(AR) $(ARFLAGS) libtommath.a $(OBJECTS)
	ranlib libtommath.a

#make a profiled library (takes a while!!!)
#
# This will build the library with profile generation
# then run the test demo and rebuild the library.
#
# So far I've seen improvements in the MP math
profiled:
	make -f makefile.icc CFLAGS="$(CFLAGS) -prof_gen -DTESTING" timing
	./ltmtest
	rm -f *.a *.o ltmtest
	./timing
	rm -f *.a *.o timing
	make -f makefile.icc CFLAGS="$(CFLAGS) -prof_use"

#make a single object profiled library
profiled_single:
	perl gen.pl
	$(CC) $(CFLAGS) -prof_gen -DTESTING -c mpi.c -o mpi.o
	$(CC) $(CFLAGS) -DTESTING -DTIMER demo/demo.c mpi.o -o ltmtest
	./ltmtest
	rm -f *.o ltmtest
	$(CC) $(CFLAGS) -DTESTING -DTIMER demo/demo.c mpi.o -o timing
	./timing
	rm -f *.o timing
	$(CC) $(CFLAGS) -prof_use -ip -DTESTING -c mpi.c -o mpi.o
	$(AR) $(ARFLAGS) libtommath.a mpi.o
	ranlib libtommath.a

install: libtommath.a
	install -d -g $(GROUP) -o $(USER) $(DESTDIR)$(LIBPATH)
	install -d -g $(GROUP) -o $(USER) $(DESTDIR)$(INCPATH)
	install -g $(GROUP) -o $(USER) $(LIBNAME) $(DESTDIR)$(LIBPATH)
	install -g $(GROUP) -o $(USER) $(HEADERS) $(DESTDIR)$(INCPATH)

test: libtommath.a demo/demo.o
	$(CC) demo/demo.o libtommath.a -o test

mtest: test
	cd mtest ; $(CC) $(CFLAGS) mtest.c -o mtest

timing: libtommath.a
	$(CC) $(CFLAGS) -DTIMER demo/timing.c libtommath.a -o ltmtest
timing: libtommath.a demo/timing.c
	$(CC) $(CFLAGS) -DTIMER demo/timing.c libtommath.a -o timing

clean:
	rm -f *.bat *.pdf *.o *.a *.obj *.lib *.exe *.dll etclib/*.o demo/demo.o test ltmtest mpitest mtest/mtest mtest/mtest.exe \
	rm -f *.bat *.pdf *.o *.a *.obj *.lib *.exe *.dll etclib/*.o demo/demo.o test timing mpitest mtest/mtest mtest/mtest.exe \
        *.idx *.toc *.log *.aux *.dvi *.lof *.ind *.ilg *.ps *.log *.s mpi.c *.il etc/*.il *.dyn
	cd etc ; make clean
	cd pics ; make clean

Changes to libtommath/makefile.msvc.

1
2
3
4
5

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23











24
25
26
27
28
29
30
31
32





33
34
35
36
37

38
39
40



1
2
3
4

5
6
7
8
9
10
11
12











13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28




29
30
31
32
33

34
35
36

37
38
39
40
41
42
43




-
+







-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
+
+
+
+
+
-



-
+



+
+
+
#MSVC Makefile
#
#Tom St Denis

CFLAGS = /I. /Ox /DWIN32 /W3 /Fo$@
LTM_CFLAGS  = /Ox /nologo /I. /D_CRT_SECURE_NO_WARNINGS /D_CRT_NONSTDC_NO_DEPRECATE /W3 $(CFLAGS)

default: library

#START_INS
OBJECTS=bncore.obj bn_error.obj bn_fast_mp_invmod.obj bn_fast_mp_montgomery_reduce.obj bn_fast_s_mp_mul_digs.obj \
bn_fast_s_mp_mul_high_digs.obj bn_fast_s_mp_sqr.obj bn_mp_2expt.obj bn_mp_abs.obj bn_mp_add.obj bn_mp_add_d.obj \
bn_mp_addmod.obj bn_mp_and.obj bn_mp_clamp.obj bn_mp_clear.obj bn_mp_clear_multi.obj bn_mp_cmp.obj bn_mp_cmp_d.obj \
bn_mp_cmp_mag.obj bn_mp_cnt_lsb.obj bn_mp_copy.obj bn_mp_count_bits.obj bn_mp_div_2.obj bn_mp_div_2d.obj bn_mp_div_3.obj \
bn_mp_div.obj bn_mp_div_d.obj bn_mp_dr_is_modulus.obj bn_mp_dr_reduce.obj bn_mp_dr_setup.obj bn_mp_exch.obj \
bn_mp_export.obj bn_mp_expt_d.obj bn_mp_expt_d_ex.obj bn_mp_exptmod.obj bn_mp_exptmod_fast.obj bn_mp_exteuclid.obj \
bn_mp_fread.obj bn_mp_fwrite.obj bn_mp_gcd.obj bn_mp_get_int.obj bn_mp_get_long.obj bn_mp_get_long_long.obj \
bn_mp_grow.obj bn_mp_import.obj bn_mp_init.obj bn_mp_init_copy.obj bn_mp_init_multi.obj bn_mp_init_set.obj \
bn_mp_init_set_int.obj bn_mp_init_size.obj bn_mp_invmod.obj bn_mp_invmod_slow.obj bn_mp_is_square.obj \
bn_mp_jacobi.obj bn_mp_karatsuba_mul.obj bn_mp_karatsuba_sqr.obj bn_mp_lcm.obj bn_mp_lshd.obj bn_mp_mod_2d.obj \
bn_mp_mod.obj bn_mp_mod_d.obj bn_mp_montgomery_calc_normalization.obj bn_mp_montgomery_reduce.obj \
bn_mp_montgomery_setup.obj bn_mp_mul_2.obj bn_mp_mul_2d.obj bn_mp_mul.obj bn_mp_mul_d.obj bn_mp_mulmod.obj bn_mp_neg.obj \
bn_mp_n_root.obj bn_mp_n_root_ex.obj bn_mp_or.obj bn_mp_prime_fermat.obj bn_mp_prime_is_divisible.obj \
bn_mp_prime_is_prime.obj bn_mp_prime_miller_rabin.obj bn_mp_prime_next_prime.obj \
bn_mp_cmp_mag.obj bn_mp_cnt_lsb.obj bn_mp_complement.obj bn_mp_copy.obj bn_mp_count_bits.obj bn_mp_div_2.obj \
bn_mp_div_2d.obj bn_mp_div_3.obj bn_mp_div.obj bn_mp_div_d.obj bn_mp_dr_is_modulus.obj bn_mp_dr_reduce.obj \
bn_mp_dr_setup.obj bn_mp_exch.obj bn_mp_export.obj bn_mp_expt_d.obj bn_mp_expt_d_ex.obj bn_mp_exptmod.obj \
bn_mp_exptmod_fast.obj bn_mp_exteuclid.obj bn_mp_fread.obj bn_mp_fwrite.obj bn_mp_gcd.obj bn_mp_get_int.obj \
bn_mp_get_long.obj bn_mp_get_long_long.obj bn_mp_grow.obj bn_mp_import.obj bn_mp_init.obj bn_mp_init_copy.obj \
bn_mp_init_multi.obj bn_mp_init_set.obj bn_mp_init_set_int.obj bn_mp_init_size.obj bn_mp_invmod.obj \
bn_mp_invmod_slow.obj bn_mp_is_square.obj bn_mp_jacobi.obj bn_mp_karatsuba_mul.obj bn_mp_karatsuba_sqr.obj \
bn_mp_lcm.obj bn_mp_lshd.obj bn_mp_mod_2d.obj bn_mp_mod.obj bn_mp_mod_d.obj bn_mp_montgomery_calc_normalization.obj \
bn_mp_montgomery_reduce.obj bn_mp_montgomery_setup.obj bn_mp_mul_2.obj bn_mp_mul_2d.obj bn_mp_mul.obj bn_mp_mul_d.obj \
bn_mp_mulmod.obj bn_mp_neg.obj bn_mp_n_root.obj bn_mp_n_root_ex.obj bn_mp_or.obj bn_mp_prime_fermat.obj \
bn_mp_prime_is_divisible.obj bn_mp_prime_is_prime.obj bn_mp_prime_miller_rabin.obj bn_mp_prime_next_prime.obj \
bn_mp_prime_rabin_miller_trials.obj bn_mp_prime_random_ex.obj bn_mp_radix_size.obj bn_mp_radix_smap.obj \
bn_mp_rand.obj bn_mp_read_radix.obj bn_mp_read_signed_bin.obj bn_mp_read_unsigned_bin.obj bn_mp_reduce_2k.obj \
bn_mp_reduce_2k_l.obj bn_mp_reduce_2k_setup.obj bn_mp_reduce_2k_setup_l.obj bn_mp_reduce.obj \
bn_mp_reduce_is_2k.obj bn_mp_reduce_is_2k_l.obj bn_mp_reduce_setup.obj bn_mp_rshd.obj bn_mp_set.obj bn_mp_set_int.obj \
bn_mp_set_long.obj bn_mp_set_long_long.obj bn_mp_shrink.obj bn_mp_signed_bin_size.obj bn_mp_sqr.obj bn_mp_sqrmod.obj \
bn_mp_sqrt.obj bn_mp_sqrtmod_prime.obj bn_mp_sub.obj bn_mp_sub_d.obj bn_mp_submod.obj bn_mp_toom_mul.obj \
bn_mp_toom_sqr.obj bn_mp_toradix.obj bn_mp_toradix_n.obj bn_mp_to_signed_bin.obj bn_mp_to_signed_bin_n.obj \
bn_mp_to_unsigned_bin.obj bn_mp_to_unsigned_bin_n.obj bn_mp_unsigned_bin_size.obj bn_mp_xor.obj bn_mp_zero.obj \
bn_prime_tab.obj bn_reverse.obj bn_s_mp_add.obj bn_s_mp_exptmod.obj bn_s_mp_mul_digs.obj bn_s_mp_mul_high_digs.obj \
bn_mp_sqrt.obj bn_mp_sqrtmod_prime.obj bn_mp_sub.obj bn_mp_sub_d.obj bn_mp_submod.obj bn_mp_tc_and.obj \
bn_mp_tc_div_2d.obj bn_mp_tc_or.obj bn_mp_tc_xor.obj bn_mp_toom_mul.obj bn_mp_toom_sqr.obj bn_mp_toradix.obj \
bn_mp_toradix_n.obj bn_mp_to_signed_bin.obj bn_mp_to_signed_bin_n.obj bn_mp_to_unsigned_bin.obj \
bn_mp_to_unsigned_bin_n.obj bn_mp_unsigned_bin_size.obj bn_mp_xor.obj bn_mp_zero.obj bn_prime_tab.obj bn_reverse.obj \
bn_s_mp_add.obj bn_s_mp_exptmod.obj bn_s_mp_mul_digs.obj bn_s_mp_mul_high_digs.obj bn_s_mp_sqr.obj bn_s_mp_sub.obj
bn_s_mp_sqr.obj bn_s_mp_sub.obj

#END_INS

HEADERS=tommath.h tommath_class.h tommath_superclass.h
HEADERS=tommath.h tommath_class.h tommath_private.h tommath_superclass.h

library: $(OBJECTS)
	lib /out:tommath.lib $(OBJECTS)

.c.obj:
	$(CC) $(LTM_CFLAGS) /c $< /Fo$@

Changes to libtommath/makefile.shared.

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15

16
17

18
19
20

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38











39
40
41
42
43
44
45
46
47





48
49
50
51
52
53
54
55
56
57
58
59
60

61
62
63
64
65

66
67
68
69
70
71
72

73
74
75
76
77
78

79
80
81
82

83
84
85
86
87
88


1
2
3
4
5
6
7
8
9
10
11
12

13
14

15
16

17
18
19

20
21
22
23
24
25
26
27











28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43




44
45
46
47
48

49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64

65
66
67
68
69
70
71

72
73
74
75
76
77

78
79
80
81

82
83
84
85
86


87
88












-
+

-
+

-
+


-
+







-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
+
+
+
+
+
-











-
+




-
+






-
+





-
+



-
+




-
-
+
+
#Makefile for GCC
#
#Tom St Denis

#default files to install
ifndef LIBNAME
   LIBNAME=libtommath.la
endif

include makefile_include.mk


ifndef LT
ifndef LIBTOOL
  ifeq ($(PLATFORM), Darwin)
    LT:=glibtool
    LIBTOOL:=glibtool
  else
    LT:=libtool
    LIBTOOL:=libtool
  endif
endif
LTCOMPILE = $(LT) --mode=compile --tag=CC $(CC)
LTCOMPILE = $(LIBTOOL) --mode=compile --tag=CC $(CC)

LCOV_ARGS=--directory .libs --directory .

#START_INS
OBJECTS=bncore.o bn_error.o bn_fast_mp_invmod.o bn_fast_mp_montgomery_reduce.o bn_fast_s_mp_mul_digs.o \
bn_fast_s_mp_mul_high_digs.o bn_fast_s_mp_sqr.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o \
bn_mp_addmod.o bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o \
bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div_2.o bn_mp_div_2d.o bn_mp_div_3.o \
bn_mp_div.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o bn_mp_exch.o \
bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o bn_mp_exptmod_fast.o bn_mp_exteuclid.o \
bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_int.o bn_mp_get_long.o bn_mp_get_long_long.o \
bn_mp_grow.o bn_mp_import.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_invmod.o bn_mp_invmod_slow.o bn_mp_is_square.o \
bn_mp_jacobi.o bn_mp_karatsuba_mul.o bn_mp_karatsuba_sqr.o bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod_2d.o \
bn_mp_mod.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \
bn_mp_montgomery_setup.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \
bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_or.o bn_mp_prime_fermat.o bn_mp_prime_is_divisible.o \
bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o \
bn_mp_dr_setup.o bn_mp_exch.o bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o \
bn_mp_exptmod_fast.o bn_mp_exteuclid.o bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_int.o \
bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_import.o bn_mp_init.o bn_mp_init_copy.o \
bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_invmod.o \
bn_mp_invmod_slow.o bn_mp_is_square.o bn_mp_jacobi.o bn_mp_karatsuba_mul.o bn_mp_karatsuba_sqr.o \
bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod_2d.o bn_mp_mod.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \
bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul.o bn_mp_mul_d.o \
bn_mp_mulmod.o bn_mp_neg.o bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_or.o bn_mp_prime_fermat.o \
bn_mp_prime_is_divisible.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_prime_rabin_miller_trials.o bn_mp_prime_random_ex.o bn_mp_radix_size.o bn_mp_radix_smap.o \
bn_mp_rand.o bn_mp_read_radix.o bn_mp_read_signed_bin.o bn_mp_read_unsigned_bin.o bn_mp_reduce_2k.o \
bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce.o \
bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o bn_mp_signed_bin_size.o bn_mp_sqr.o bn_mp_sqrmod.o \
bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o bn_mp_toom_mul.o \
bn_mp_toom_sqr.o bn_mp_toradix.o bn_mp_toradix_n.o bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o \
bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o \
bn_prime_tab.o bn_reverse.o bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o bn_s_mp_mul_high_digs.o \
bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o bn_mp_tc_and.o \
bn_mp_tc_div_2d.o bn_mp_tc_or.o bn_mp_tc_xor.o bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix.o \
bn_mp_toradix_n.o bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin.o \
bn_mp_to_unsigned_bin_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_reverse.o \
bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o bn_s_mp_mul_high_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
bn_s_mp_sqr.o bn_s_mp_sub.o

#END_INS

objs: $(OBJECTS)

.c.o:
	$(LTCOMPILE) $(CFLAGS) $(LDFLAGS) -o $@ -c $<

LOBJECTS = $(OBJECTS:.o=.lo)

$(LIBNAME):  $(OBJECTS)
	$(LT) --mode=link --tag=CC $(CC) $(LDFLAGS) $(LOBJECTS) -o $(LIBNAME) -rpath $(LIBPATH) -version-info $(VERSION_SO)
	$(LIBTOOL) --mode=link --tag=CC $(CC) $(LDFLAGS) $(LOBJECTS) -o $(LIBNAME) -rpath $(LIBPATH) -version-info $(VERSION_SO)

install: $(LIBNAME)
	install -d $(DESTDIR)$(LIBPATH)
	install -d $(DESTDIR)$(INCPATH)
	$(LT) --mode=install install -m 644 $(LIBNAME) $(DESTDIR)$(LIBPATH)/$(LIBNAME)
	$(LIBTOOL) --mode=install install -m 644 $(LIBNAME) $(DESTDIR)$(LIBPATH)/$(LIBNAME)
	install -m 644 $(HEADERS_PUB) $(DESTDIR)$(INCPATH)
	sed -e 's,^prefix=.*,prefix=$(PREFIX),' -e 's,^Version:.*,Version: $(VERSION_PC),' libtommath.pc.in > libtommath.pc
	install -d $(DESTDIR)$(LIBPATH)/pkgconfig
	install -m 644 libtommath.pc $(DESTDIR)$(LIBPATH)/pkgconfig/

uninstall:
	$(LT) --mode=uninstall rm $(DESTDIR)$(LIBPATH)/$(LIBNAME)
	$(LIBTOOL) --mode=uninstall rm $(DESTDIR)$(LIBPATH)/$(LIBNAME)
	rm $(HEADERS_PUB:%=$(DESTDIR)$(INCPATH)/%)
	rm $(DESTDIR)$(LIBPATH)/pkgconfig/libtommath.pc

test: $(LIBNAME) demo/demo.o
	$(CC) $(CFLAGS) -c demo/demo.c -o demo/demo.o
	$(LT) --mode=link $(CC) $(LDFLAGS) -o test demo/demo.o $(LIBNAME)
	$(LIBTOOL) --mode=link $(CC) $(LDFLAGS) -o test demo/demo.o $(LIBNAME)

test_standalone: $(LIBNAME) demo/demo.o
	$(CC) $(CFLAGS) -c demo/demo.c -o demo/demo.o
	$(LT) --mode=link $(CC) $(LDFLAGS) -o test demo/demo.o $(LIBNAME)
	$(LIBTOOL) --mode=link $(CC) $(LDFLAGS) -o test demo/demo.o $(LIBNAME)

mtest:
	cd mtest ; $(CC) $(CFLAGS) $(LDFLAGS) mtest.c -o mtest

timing: $(LIBNAME)
	$(LT) --mode=link $(CC) $(CFLAGS) $(LDFLAGS) -DTIMER demo/timing.c $(LIBNAME) -o ltmtest
timing: $(LIBNAME) demo/timing.c
	$(LIBTOOL) --mode=link $(CC) $(CFLAGS) $(LDFLAGS) -DTIMER demo/timing.c $(LIBNAME) -o timing

Changes to libtommath/makefile_include.mk.

13
14
15
16
17
18
19





20
21
22












23
24
25
26
27




28


29
30
31
32
33
34
35
13
14
15
16
17
18
19
20
21
22
23
24



25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
53
54







+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+





+
+
+
+
-
+
+







default: ${LIBNAME}

# Compiler and Linker Names
ifndef CROSS_COMPILE
  CROSS_COMPILE=
endif

# We only need to go through this dance of determining the right compiler if we're using
# cross compilation, otherwise $(CC) is fine as-is.
ifneq (,$(CROSS_COMPILE))
ifeq ($(origin CC),default)
CSTR := "\#ifdef __clang__\nCLANG\n\#endif\n"
ifeq ($(CC),cc)
  CC = $(CROSS_COMPILE)gcc
endif
ifeq ($(PLATFORM),FreeBSD)
  # XXX: FreeBSD needs extra escaping for some reason
  CSTR := $$$(CSTR)
endif
ifneq (,$(shell echo $(CSTR) | $(CC) -E - | grep CLANG))
  CC := $(CROSS_COMPILE)clang
else
  CC := $(CROSS_COMPILE)gcc
endif # Clang
endif # cc is Make's default
endif # CROSS_COMPILE non-empty

LD=$(CROSS_COMPILE)ld
AR=$(CROSS_COMPILE)ar
RANLIB=$(CROSS_COMPILE)ranlib

ifndef MAKE
# BSDs refer to GNU Make as gmake
ifneq (,$(findstring $(PLATFORM),FreeBSD OpenBSD DragonFly NetBSD))
  MAKE=gmake
else
   MAKE=make
  MAKE=make
endif
endif

CFLAGS += -I./ -Wall -Wsign-compare -Wextra -Wshadow

ifndef NO_ADDTL_WARNINGS
# additional warnings
CFLAGS += -Wsystem-headers -Wdeclaration-after-statement -Wbad-function-cast -Wcast-align
55
56
57
58
59
60
61



62
63
64
65
66






67
68

69
70

71
72
73
74
75
76
77
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

96
97

98
99
100
101
102
103
104
105







+
+
+





+
+
+
+
+
+

-
+

-
+







endif

endif # COMPILE_SIZE
endif # COMPILE_DEBUG

ifneq ($(findstring clang,$(CC)),)
CFLAGS += -Wno-typedef-redefinition -Wno-tautological-compare -Wno-builtin-requires-header
endif
ifneq ($(findstring mingw,$(CC)),)
CFLAGS += -Wno-shadow
endif
ifeq ($(PLATFORM), Darwin)
CFLAGS += -Wno-nullability-completeness
endif

ifeq ($(PLATFORM),FreeBSD)
  _ARCH := $(shell sysctl -b hw.machine_arch)
else
  _ARCH := $(shell arch)
endif

# adjust coverage set
ifneq ($(filter $(shell arch), i386 i686 x86_64 amd64 ia64),)
ifneq ($(filter $(_ARCH), i386 i686 x86_64 amd64 ia64),)
   COVERAGE = test_standalone timing
   COVERAGE_APP = ./test && ./ltmtest
   COVERAGE_APP = ./test && ./timing
else
   COVERAGE = test_standalone
   COVERAGE_APP = ./test
endif

HEADERS_PUB=tommath.h tommath_class.h tommath_superclass.h
HEADERS=tommath_private.h $(HEADERS_PUB)
106
107
108
109
110
111
112
113

114
115
116
117
134
135
136
137
138
139
140

141
142
143
144
145







-
+




	rm -f `find . -type f -name "*.info" | xargs`
	rm -rf coverage/

# cleans everything - coverage output and standard 'clean'
cleancov: cleancov-clean clean

clean:
	rm -f *.gcda *.gcno *.gcov *.bat *.o *.a *.obj *.lib *.exe *.dll etclib/*.o demo/demo.o test ltmtest mpitest mtest/mtest mtest/mtest.exe \
	rm -f *.gcda *.gcno *.gcov *.bat *.o *.a *.obj *.lib *.exe *.dll etclib/*.o demo/demo.o test timing mpitest mtest/mtest mtest/mtest.exe \
        *.idx *.toc *.log *.aux *.dvi *.lof *.ind *.ilg *.ps *.log *.s mpi.c *.da *.dyn *.dpi tommath.tex `find . -type f | grep [~] | xargs` *.lo *.la
	rm -rf .libs/
	${MAKE} -C etc/ clean MAKE=${MAKE}
	${MAKE} -C doc/ clean MAKE=${MAKE}

Changes to libtommath/tommath.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27





28
29
30
31
32
33
34
35
36
37








38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53


54
55
56
57
58
59
60


61
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
77
78
79
80
81
82
83
84


85
86
87
88
89
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
1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16
17

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37


38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59


60
61
62
63
64
65
66


67
68
69
70
71
72
73
74



75

76






77
78
79
80
81


82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97

98
99
100
101
102












103
104
105
106
107
108
109











-
-






-







+
+
+
+
+








-
-
+
+
+
+
+
+
+
+














-
-
+
+





-
-
+
+






-
-
-
+
-

-
-
-
-
-
-





-
-
+
+














-
+




-
-
-
-
-
-
-
-
-
-
-
-







/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://math.libtomcrypt.com
 */
#ifndef BN_H_
#define BN_H_

#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
#include <limits.h>

#include <tommath_class.h>

#ifdef __cplusplus
extern "C" {
#endif

/* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */
#if defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)
#   define MP_32BIT
#endif

/* detect 64-bit mode if possible */
#if defined(__x86_64__) || defined(_M_X64) || defined(_M_AMD64) || \
    defined(__powerpc64__) || defined(__ppc64__) || defined(__PPC64__) || \
    defined(__s390x__) || defined(__arch64__) || defined(__aarch64__) || \
    defined(__sparcv9) || defined(__sparc_v9__) || defined(__sparc64__) || \
    defined(__ia64) || defined(__ia64__) || defined(__itanium__) || defined(_M_IA64) || \
    defined(__LP64__) || defined(_LP64) || defined(__64BIT__)
#   if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT) || defined(_MSC_VER))
#      define MP_64BIT
#   if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
#      if defined(__GNUC__)
/* we support 128bit integers only via: __attribute__((mode(TI))) */
#         define MP_64BIT
#      else
/* otherwise we fall back to MP_32BIT even on 64bit platforms */
#         define MP_32BIT
#      endif
#   endif
#endif

typedef unsigned long long Tcl_WideUInt;

/* some default configurations.
 *
 * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits
 * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits
 *
 * At the very least a mp_digit must be able to hold 7 bits
 * [any size beyond that is ok provided it doesn't overflow the data type]
 */
#ifdef MP_8BIT
typedef uint8_t              mp_digit;
typedef uint16_t             mp_word;
typedef unsigned char        mp_digit;
typedef unsigned short       mp_word;
#   define MP_SIZEOF_MP_DIGIT 1
#   ifdef DIGIT_BIT
#      error You must not define DIGIT_BIT when using MP_8BIT
#   endif
#elif defined(MP_16BIT)
typedef uint16_t             mp_digit;
typedef uint32_t             mp_word;
typedef unsigned short       mp_digit;
typedef unsigned int         mp_word;
#   define MP_SIZEOF_MP_DIGIT 2
#   ifdef DIGIT_BIT
#      error You must not define DIGIT_BIT when using MP_16BIT
#   endif
#elif defined(MP_64BIT)
/* for GCC only on supported platforms */
typedef uint64_t mp_digit;
#   if defined(_WIN32)
typedef unsigned __int128    mp_word;
typedef unsigned long long   mp_digit;
#   elif defined(__GNUC__)
typedef unsigned long        mp_word __attribute__((mode(TI)));
#   else
/* it seems you have a problem
 * but we assume you can somewhere define your own uint128_t */
typedef uint128_t            mp_word;
#   endif

#   define DIGIT_BIT 60
#else
/* this is the default case, 28-bit digits */

/* this is to make porting into LibTomCrypt easier :-) */
typedef uint32_t             mp_digit;
typedef uint64_t             mp_word;
typedef unsigned int         mp_digit;
typedef unsigned long long   mp_word;

#   ifdef MP_31BIT
/* this is an extension that uses 31-bit digits */
#      define DIGIT_BIT 31
#   else
/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
#      define DIGIT_BIT 28
#      define MP_28BIT
#   endif
#endif

/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
#ifndef DIGIT_BIT
#   define DIGIT_BIT (((CHAR_BIT * MP_SIZEOF_MP_DIGIT) - 1))  /* bits per digit */
typedef uint_least32_t mp_min_u32;
typedef unsigned long mp_min_u32;
#else
typedef mp_digit mp_min_u32;
#endif

/* use arc4random on platforms that support it */
#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__)
#   define MP_GEN_RANDOM()    arc4random()
#   define MP_GEN_RANDOM_MAX  0xffffffff
#endif

/* use rand() as fall-back if there's no better rand function */
#ifndef MP_GEN_RANDOM
#   define MP_GEN_RANDOM()    rand()
#   define MP_GEN_RANDOM_MAX  RAND_MAX
#endif

#define MP_DIGIT_BIT     DIGIT_BIT
#define MP_MASK          ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
#define MP_DIGIT_MAX     MP_MASK

/* equalities */
#define MP_LT        -1   /* less than */
#define MP_EQ         0   /* equal to */
155
156
157
158
159
160
161
162

163
164
165
166
167
168
169
142
143
144
145
146
147
148

149
150
151
152
153
154
155
156







-
+







#      define MP_PREC 32        /* default digits of precision */
#   else
#      define MP_PREC 8         /* default digits of precision */
#   endif
#endif

/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
#define MP_WARRAY               (1 << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1))
#define MP_WARRAY               (1u << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1))

/* the infamous mp_int structure */
typedef struct  {
   int used, alloc, sign;
   mp_digit *dp;
} mp_int;

218
219
220
221
222
223
224
225

226
227
228
229
230
231
232
233
234

235
236
237
238
239
240
241
205
206
207
208
209
210
211

212
213
214
215
216
217
218
219
220

221
222
223
224
225
226
227
228







-
+








-
+







/* set a 32-bit const */
int mp_set_int(mp_int *a, unsigned long b);

/* set a platform dependent unsigned long value */
int mp_set_long(mp_int *a, unsigned long b);

/* set a platform dependent unsigned long long value */
int mp_set_long_long(mp_int *a, Tcl_WideUInt b);
int mp_set_long_long(mp_int *a, unsigned long long b);

/* get a 32-bit value */
unsigned long mp_get_int(const mp_int *a);

/* get a platform dependent unsigned long value */
unsigned long mp_get_long(const mp_int *a);

/* get a platform dependent unsigned long long value */
Tcl_WideUInt mp_get_long_long(const mp_int *a);
unsigned long long mp_get_long_long(const mp_int *a);

/* initialize and set a digit */
int mp_init_set(mp_int *a, mp_digit b);

/* initialize and set 32-bit value */
int mp_init_set_int(mp_int *a, unsigned long b);

283
284
285
286
287
288
289








290
291
292
293
294
295
296
297
298
299
300












301
302



303
304
305
306
307
308
309
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319







+
+
+
+
+
+
+
+











+
+
+
+
+
+
+
+
+
+
+
+


+
+
+







/* Counts the number of lsbs which are zero before the first zero bit */
int mp_cnt_lsb(const mp_int *a);

/* I Love Earth! */

/* makes a pseudo-random int of a given size */
int mp_rand(mp_int *a, int digits);

#ifdef MP_PRNG_ENABLE_LTM_RNG
/* as last resort we will fall back to libtomcrypt's rng_get_bytes()
 * in case you don't use libtomcrypt or use it w/o rng_get_bytes()
 * you have to implement it somewhere else, as it's required */
extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
extern void (*ltm_rng_callback)(void);
#endif

/* ---> binary operations <--- */
/* c = a XOR b  */
int mp_xor(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a OR b */
int mp_or(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a AND b */
int mp_and(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a XOR b (two complement) */
int mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a OR b (two complement) */
int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a AND b (two complement) */
int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c);

/* right shift (two complement) */
int mp_tc_div_2d(const mp_int *a, int b, mp_int *c);

/* ---> Basic arithmetic <--- */

/* b = ~a */
int mp_complement(const mp_int *a, mp_int *b);

/* b = -a */
int mp_neg(const mp_int *a, mp_int *b);

/* b = |a| */
int mp_abs(const mp_int *a, mp_int *b);

/* compare a to b */
390
391
392
393
394
395
396
397

398
399
400
401
402
403
404
405
406
407
408
409
410
411


412
413

414
415
416

417
418
419
420
421
422
423
424

425
426
427
428
429
430
431
432
433


434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454


455
456
457
458
459
460
461
400
401
402
403
404
405
406

407
408
409
410
411
412
413
414
415
416
417
418
419


420
421
422

423
424
425

426
427
428
429
430
431
432
433

434
435
436
437
438
439
440
441


442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462


463
464
465
466
467
468
469
470
471







-
+












-
-
+
+

-
+


-
+







-
+







-
-
+
+



















-
-
+
+







int mp_n_root(const mp_int *a, mp_digit b, mp_int *c);
int mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast);

/* special sqrt algo */
int mp_sqrt(const mp_int *arg, mp_int *ret);

/* special sqrt (mod prime) */
int mp_sqrtmod_prime(const mp_int *arg, const mp_int *prime, mp_int *ret);
int mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret);

/* is number a square? */
int mp_is_square(const mp_int *arg, int *ret);

/* computes the jacobi c = (a | n) (or Legendre if b is prime)  */
int mp_jacobi(const mp_int *a, const mp_int *n, int *c);

/* used to setup the Barrett reduction for a given modulus b */
int mp_reduce_setup(mp_int *a, const mp_int *b);

/* Barrett Reduction, computes a (mod b) with a precomputed value c
 *
 * Assumes that 0 < a <= b*b, note if 0 > a > -(b*b) then you can merely
 * compute the reduction as -1 * mp_reduce(mp_abs(a)) [pseudo code].
 * Assumes that 0 < x <= m*m, note if 0 > x > -(m*m) then you can merely
 * compute the reduction as -1 * mp_reduce(mp_abs(x)) [pseudo code].
 */
int mp_reduce(mp_int *a, const mp_int *b, const mp_int *c);
int mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu);

/* setups the montgomery reduction */
int mp_montgomery_setup(const mp_int *a, mp_digit *mp);
int mp_montgomery_setup(const mp_int *n, mp_digit *rho);

/* computes a = B**n mod b without division or multiplication useful for
 * normalizing numbers in a Montgomery system.
 */
int mp_montgomery_calc_normalization(mp_int *a, const mp_int *b);

/* computes x/R == x (mod N) via Montgomery Reduction */
int mp_montgomery_reduce(mp_int *a, const mp_int *m, mp_digit mp);
int mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho);

/* returns 1 if a is a valid DR modulus */
int mp_dr_is_modulus(const mp_int *a);

/* sets the value of "d" required for mp_dr_reduce */
void mp_dr_setup(const mp_int *a, mp_digit *d);

/* reduces a modulo b using the Diminished Radix method */
int mp_dr_reduce(mp_int *a, const mp_int *b, mp_digit mp);
/* reduces a modulo n using the Diminished Radix method */
int mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k);

/* returns true if a can be reduced with mp_reduce_2k */
int mp_reduce_is_2k(const mp_int *a);

/* determines k value for 2k reduction */
int mp_reduce_2k_setup(const mp_int *a, mp_digit *d);

/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
int mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d);

/* returns true if a can be reduced with mp_reduce_2k_l */
int mp_reduce_is_2k_l(const mp_int *a);

/* determines k value for 2k reduction */
int mp_reduce_2k_setup_l(const mp_int *a, mp_int *d);

/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
int mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d);

/* d = a**b (mod c) */
int mp_exptmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);
/* Y = G**X (mod P) */
int mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y);

/* ---> Primes <--- */

/* number of primes */
#ifdef MP_8BIT
#  define PRIME_SIZE 31
#else

Changes to libtommath/tommath_class.h.

23
24
25
26
27
28
29

30
31
32
33
34
35
36
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37







+







#   define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_CMP_C
#   define BN_MP_CMP_D_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_CNT_LSB_C
#   define BN_MP_COMPLEMENT_C
#   define BN_MP_COPY_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_DIV_C
#   define BN_MP_DIV_2_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_DIV_3_C
#   define BN_MP_DIV_D_C
112
113
114
115
116
117
118




119
120
121
122
123
124
125
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130







+
+
+
+







#   define BN_MP_SQR_C
#   define BN_MP_SQRMOD_C
#   define BN_MP_SQRT_C
#   define BN_MP_SQRTMOD_PRIME_C
#   define BN_MP_SUB_C
#   define BN_MP_SUB_D_C
#   define BN_MP_SUBMOD_C
#   define BN_MP_TC_AND_C
#   define BN_MP_TC_DIV_2D_C
#   define BN_MP_TC_OR_C
#   define BN_MP_TC_XOR_C
#   define BN_MP_TO_SIGNED_BIN_C
#   define BN_MP_TO_SIGNED_BIN_N_C
#   define BN_MP_TO_UNSIGNED_BIN_C
#   define BN_MP_TO_UNSIGNED_BIN_N_C
#   define BN_MP_TOOM_MUL_C
#   define BN_MP_TOOM_SQR_C
#   define BN_MP_TORADIX_C
143
144
145
146
147
148
149

150
151
152
153
154
155
156
157
158
159
160
161
162
148
149
150
151
152
153
154
155
156
157
158
159
160

161
162
163
164
165
166
167







+





-







#endif

#if defined(BN_FAST_MP_INVMOD_C)
#   define BN_MP_ISEVEN_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_COPY_C
#   define BN_MP_MOD_C
#   define BN_MP_ISZERO_C
#   define BN_MP_SET_C
#   define BN_MP_DIV_2_C
#   define BN_MP_ISODD_C
#   define BN_MP_SUB_C
#   define BN_MP_CMP_C
#   define BN_MP_ISZERO_C
#   define BN_MP_CMP_D_C
#   define BN_MP_ADD_C
#   define BN_MP_EXCH_C
#   define BN_MP_CLEAR_MULTI_C
#endif

#if defined(BN_FAST_MP_MONTGOMERY_REDUCE_C)
236
237
238
239
240
241
242





243
244
245
246
247
248
249
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259







+
+
+
+
+








#if defined(BN_MP_CMP_MAG_C)
#endif

#if defined(BN_MP_CNT_LSB_C)
#   define BN_MP_ISZERO_C
#endif

#if defined(BN_MP_COMPLEMENT_C)
#   define BN_MP_NEG_C
#   define BN_MP_SUB_D_C
#endif

#if defined(BN_MP_COPY_C)
#   define BN_MP_GROW_C
#endif

#if defined(BN_MP_COUNT_BITS_C)
#endif
386
387
388
389
390
391
392
393


394
395
396
397
398
399
400
396
397
398
399
400
401
402

403
404
405
406
407
408
409
410
411







-
+
+







#   define BN_MP_NEG_C
#   define BN_MP_EXCH_C
#   define BN_MP_CLEAR_MULTI_C
#endif

#if defined(BN_MP_FREAD_C)
#   define BN_MP_ZERO_C
#   define BN_MP_S_RMAP_C
#   define BN_MP_S_RMAP_REVERSE_SZ_C
#   define BN_MP_S_RMAP_REVERSE_C
#   define BN_MP_MUL_D_C
#   define BN_MP_ADD_D_C
#   define BN_MP_CMP_D_C
#endif

#if defined(BN_MP_FWRITE_C)
#   define BN_MP_RADIX_SIZE_C
458
459
460
461
462
463
464
465

466
467
468
469
470
471
472
473
474
469
470
471
472
473
474
475

476
477

478
479
480
481
482
483
484







-
+

-







#endif

#if defined(BN_MP_INIT_SIZE_C)
#   define BN_MP_INIT_C
#endif

#if defined(BN_MP_INVMOD_C)
#   define BN_MP_ISZERO_C
#   define BN_MP_CMP_D_C
#   define BN_MP_ISODD_C
#   define BN_MP_CMP_D_C
#   define BN_FAST_MP_INVMOD_C
#   define BN_MP_INVMOD_SLOW_C
#endif

#if defined(BN_MP_INVMOD_SLOW_C)
#   define BN_MP_ISZERO_C
#   define BN_MP_INIT_MULTI_C
537
538
539
540
541
542
543

544
545
546
547
548
549
550
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561







+







#   define BN_MP_CMP_MAG_C
#   define BN_MP_DIV_C
#   define BN_MP_MUL_C
#   define BN_MP_CLEAR_MULTI_C
#endif

#if defined(BN_MP_LSHD_C)
#   define BN_MP_ISZERO_C
#   define BN_MP_GROW_C
#   define BN_MP_RSHD_C
#endif

#if defined(BN_MP_MOD_C)
#   define BN_MP_INIT_SIZE_C
#   define BN_MP_DIV_C
710
711
712
713
714
715
716


717
718
719
720
721
722
723
724
725
726
727


728
729
730
731
732
733
734
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739

740
741
742
743
744
745
746
747
748







+
+










-
+
+







#   define BN_MP_INIT_COPY_C
#   define BN_MP_DIV_D_C
#   define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_RADIX_SMAP_C)
#   define BN_MP_S_RMAP_C
#   define BN_MP_S_RMAP_REVERSE_C
#   define BN_MP_S_RMAP_REVERSE_SZ_C
#endif

#if defined(BN_MP_RAND_C)
#   define BN_MP_ZERO_C
#   define BN_MP_ADD_D_C
#   define BN_MP_LSHD_C
#endif

#if defined(BN_MP_READ_RADIX_C)
#   define BN_MP_ZERO_C
#   define BN_MP_S_RMAP_C
#   define BN_MP_S_RMAP_REVERSE_SZ_C
#   define BN_MP_S_RMAP_REVERSE_C
#   define BN_MP_MUL_D_C
#   define BN_MP_ADD_D_C
#   define BN_MP_ISZERO_C
#endif

#if defined(BN_MP_READ_SIGNED_BIN_C)
#   define BN_MP_READ_UNSIGNED_BIN_C
899
900
901
902
903
904
905











































906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








#if defined(BN_MP_SUBMOD_C)
#   define BN_MP_INIT_C
#   define BN_MP_SUB_C
#   define BN_MP_CLEAR_C
#   define BN_MP_MOD_C
#endif

#if defined(BN_MP_TC_AND_C)
#   define BN_MP_ISNEG_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_INIT_SET_INT_C
#   define BN_MP_MUL_2D_C
#   define BN_MP_INIT_C
#   define BN_MP_ADD_C
#   define BN_MP_CLEAR_C
#   define BN_MP_AND_C
#   define BN_MP_SUB_C
#endif

#if defined(BN_MP_TC_DIV_2D_C)
#   define BN_MP_ISNEG_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_ADD_D_C
#   define BN_MP_SUB_D_C
#endif

#if defined(BN_MP_TC_OR_C)
#   define BN_MP_ISNEG_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_INIT_SET_INT_C
#   define BN_MP_MUL_2D_C
#   define BN_MP_INIT_C
#   define BN_MP_ADD_C
#   define BN_MP_CLEAR_C
#   define BN_MP_OR_C
#   define BN_MP_SUB_C
#endif

#if defined(BN_MP_TC_XOR_C)
#   define BN_MP_ISNEG_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_INIT_SET_INT_C
#   define BN_MP_MUL_2D_C
#   define BN_MP_INIT_C
#   define BN_MP_ADD_C
#   define BN_MP_CLEAR_C
#   define BN_MP_XOR_C
#   define BN_MP_SUB_C
#endif

#if defined(BN_MP_TO_SIGNED_BIN_C)
#   define BN_MP_TO_UNSIGNED_BIN_C
#endif

#if defined(BN_MP_TO_SIGNED_BIN_N_C)
#   define BN_MP_SIGNED_BIN_SIZE_C

Changes to libtommath/tommath_private.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16
17
18











-
-







/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, [email protected], http://math.libtomcrypt.com
 */
#ifndef TOMMATH_PRIV_H_
#define TOMMATH_PRIV_H_

#include <tommath.h>
#include <ctype.h>

71
72
73
74
75
76
77
78



79
80
81
82
83
84
85
69
70
71
72
73
74
75

76
77
78
79
80
81
82
83
84
85







-
+
+
+







int fast_mp_invmod(const mp_int *a, const mp_int *b, mp_int *c);
int mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c);
int fast_mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho);
int mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode);
int s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode);
void bn_reverse(unsigned char *s, int len);

extern const char *mp_s_rmap;
extern const char *const mp_s_rmap;
extern const unsigned char mp_s_rmap_reverse[];
extern const size_t mp_s_rmap_reverse_sz;

/* Fancy macro to set an MPI from another type.
 * There are several things assumed:
 *  x is the counter and unsigned
 *  a is the pointer to the MPI
 *  b is the original value that should be set in the MPI.
 */
95
96
97
98
99
100
101
102

103
104
105
106
107
108
109
95
96
97
98
99
100
101

102
103
104
105
106
107
108
109







-
+







  for (x = 0; x < (sizeof(type) * 2u); x++) {            \
    /* shift the number up four bits */                  \
    if ((res = mp_mul_2d (a, 4, a)) != MP_OKAY) {        \
      return res;                                        \
    }                                                    \
                                                         \
    /* OR in the top four bits of the source */          \
    a->dp[0] |= (b >> ((sizeof(type) * 8u) - 4u)) & 15u; \
    a->dp[0] |= (mp_digit)(b >> ((sizeof(type) * 8u) - 4u)) & 15uL;\
                                                         \
    /* shift the source up to the next four bits */      \
    b <<= 4;                                             \
                                                         \
    /* ensure that digits are not clamped off */         \
    a->used += 1;                                        \
  }                                                      \

Changes to macosx/GNUmakefile.

128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
128
129
130
131
132
133
134

135
136
137
138
139
140
141
142







-
+







	${MAKE} install-${PROJECT} INSTALL_ROOT="${OBJ_DIR}/"

${objdir}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \
		     ${UNIX_DIR}/tclConfig.sh.in Tcl-Info.plist.in
	mkdir -p "${OBJ_DIR}" && cd "${OBJ_DIR}" && \
	if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \
	--prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \
	--mandir="${MANDIR}" --enable-threads --enable-framework --enable-dtrace \
	--mandir="${MANDIR}" --enable-framework --enable-dtrace \
	${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi

build-${PROJECT}: ${objdir}/Makefile
	${DO_MAKE}
ifeq (${INSTALL_BUILD},)
# symolic link hackery to trick
# 'make install INSTALL_ROOT=${OBJ_DIR}'

Changes to macosx/README.

109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
109
110
111
112
113
114
115

116
117
118
119
120
121
122
123







-
+







	ReleaseUniversal10.5SDK:    build against the 10.5 SDK (with 10.5
				    deployment target).
	Note that the non-SDK configurations have their deployment target set to
	10.5 (Tcl.xcode) resp. 10.6 (Tcl.xcodeproj).
The Xcode projects refer to the toplevel tcl source directory via the
TCL_SRCROOT user build setting, by default this is set to the project-relative
path '../../tcl', if your tcl source directory is named differently, e.g.
'../../tcl9.0', you need to manually change the TCL_SRCROOT setting by editing
'../../tcl8.7', you need to manually change the TCL_SRCROOT setting by editing
your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory)
with a text editor.

- To build universal binaries outside of the Xcode IDE, set CFLAGS as follows:
	export CFLAGS="-arch i386 -arch x86_64 -arch ppc"
This requires Mac OS X 10.4 and Xcode 2.4 (or Xcode 2.2 if -arch x86_64 is
omitted, but _not_ Xcode 2.1) and will work on any architecture (on PowerPC
137
138
139
140
141
142
143
144

145
146

147
148
149
150
151
152
153
137
138
139
140
141
142
143

144
145

146
147
148
149
150
151
152
153







-
+

-
+








Detailed Instructions for building with macosx/GNUmakefile
----------------------------------------------------------

- Unpack the Tcl source release archive.

- The following instructions assume the Tcl source tree is named "tcl${ver}",
(where ${ver} is a shell variable containing the Tcl version number e.g. '9.0').
(where ${ver} is a shell variable containing the Tcl version number e.g. '8.7').
Setup this shell variable as follows:
	ver="9.0"
	ver="8.7"
If you are building from CVS, omit this step (CVS source tree names usually do
not contain a version number).

- Setup environment variables as desired, e.g. for a universal build on 10.5:
	CFLAGS="-arch i386 -arch x86_64 -arch ppc -mmacosx-version-min=10.5"
	export CFLAGS

Changes to macosx/Tcl-Common.xcconfig.

26
27
28
29
30
31
32
33

34
35
36
37

26
27
28
29
30
31
32

33
34
35
36

37







-
+



-
+
FRAMEWORK_INSTALL_PATH = /Library/Frameworks
INCLUDEDIR = $(PREFIX)/include
LIBDIR = $(PREFIX)/lib
MANDIR = $(PREFIX)/man
PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc)
PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64)
PREFIX = /usr/local
TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace
TCL_CONFIGURE_ARGS = --enable-dtrace
TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION)
TCL_PACKAGE_PATH = "$(LIBDIR)"
TCL_DEFS = HAVE_TCL_CONFIG_H
VERSION = 9.0
VERSION = 8.7

Changes to macosx/tclMacOSXNotify.c.

27
28
29
30
31
32
33



34
35
36
37
38
39
40
41
42
43
44

45
46
47
48
49

50
51
52

53
54
55
56
57
58
59
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65







+
+
+











+





+



+







 * overhead. Note that these are not pure spinlocks, they employ various
 * strategies to back off and relinquish the processor, making them immune to
 * most priority-inversion livelocks (c.f. 'man 3 OSSpinLockLock' and Darwin
 * sources: xnu/osfmk/{ppc,i386}/commpage/spinlocks.s).
 */

#if defined(HAVE_LIBKERN_OSATOMIC_H) && defined(HAVE_OSSPINLOCKLOCK)
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
#pragma GCC diagnostic ignored "-Wunused-function"
/*
 * Use OSSpinLock API where available (Tiger or later).
 */

#include <libkern/OSAtomic.h>

#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
/*
 * Support for weakly importing spinlock API.
 */
#define WEAK_IMPORT_SPINLOCKLOCK

#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1050
#define VOLATILE volatile
#else
#define VOLATILE
#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1050 */

#ifndef bool
#define bool int
#endif

extern void		OSSpinLockLock(VOLATILE OSSpinLock *lock)
			    WEAK_IMPORT_ATTRIBUTE;
extern void		OSSpinLockUnlock(VOLATILE OSSpinLock *lock)
			    WEAK_IMPORT_ATTRIBUTE;
extern bool		OSSpinLockTry(VOLATILE OSSpinLock *lock)
			    WEAK_IMPORT_ATTRIBUTE;
extern void		_spin_lock(VOLATILE OSSpinLock *lock)
73
74
75
76
77
78
79






80
81
82
83
84
85
86










































87
88
89
90
91
92
93
94
95





96
97
98
99
100
101























102
103

104
105
106
107
108
109
110
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180







+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+







    lockLock   = OSSpinLockLock   != NULL ? OSSpinLockLock   : _spin_lock;
    lockUnlock = OSSpinLockUnlock != NULL ? OSSpinLockUnlock : _spin_unlock;
    lockTry    = OSSpinLockTry    != NULL ? OSSpinLockTry    : _spin_lock_try;
    if (lockLock == NULL || lockUnlock == NULL) {
	Tcl_Panic("SpinLockLockInit: no spinlock API available");
    }
}

/*
 * Wrappers so that we get warnings in just one small part of this file.
 */

static inline void
#define SpinLockLock(p) 	lockLock(p)
#define SpinLockUnlock(p)	lockUnlock(p)
#define SpinLockTry(p)		lockTry(p)
#else
#define SpinLockLock(p) 	OSSpinLockLock(p)
#define SpinLockUnlock(p)	OSSpinLockUnlock(p)
#define SpinLockTry(p)		OSSpinLockTry(p)
SpinLockLock(
    VOLATILE OSSpinLock *lock)
{
    lockLock(lock);
}
static inline void
SpinLockUnlock(
    VOLATILE OSSpinLock *lock)
{
    lockUnlock(lock);
}
static inline bool
SpinLockTry(
    VOLATILE OSSpinLock *lock)
{
    return lockTry(lock);
}

#else /* !HAVE_WEAK_IMPORT */

/*
 * Wrappers so that we get warnings in just one small part of this file.
 */

static inline void
SpinLockLock(
    OSSpinLock *lock)
{
    OSSpinLockLock(lock);
}
static inline void
SpinLockUnlock(
    OSSpinLock *lock)
{
    OSSpinLockUnlock(lock);
}
static inline bool
SpinLockTry(
    OSSpinLock *lock)
{
    return OSSpinLockTry(lock);
}
#endif /* HAVE_WEAK_IMPORT */
#define SPINLOCK_INIT		OS_SPINLOCK_INIT

#else
/*
 * Otherwise, use commpage spinlock SPI directly.
 */

typedef uint32_t OSSpinLock;

static inline void
SpinLockLock(
    OSSpinLock *lock)
{
extern void		_spin_lock(OSSpinLock *lock);
extern void		_spin_unlock(OSSpinLock *lock);
extern int		_spin_lock_try(OSSpinLock *lock);
#define SpinLockLock(p) 	_spin_lock(p)
#define SpinLockUnlock(p)	_spin_unlock(p)
#define SpinLockTry(p)		_spin_lock_try(p)
    extern void _spin_lock(OSSpinLock *lock);

    _spin_lock(lock);
}

static inline void
SpinLockUnlock(
    OSSpinLock *lock)
{
    extern void _spin_unlock(OSSpinLock *lock);

    _spin_unlock(lock);
}

static inline int
SpinLockTry(
    OSSpinLock *lock)
{
    extern int _spin_lock_try(OSSpinLock *lock);

    return _spin_lock_try(lock);
}

#define SPINLOCK_INIT		0

#pragma GCC diagnostic pop
#endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */

/*
 * These spinlocks lock access to the global notifier state.
 */

static OSSpinLock notifierInitLock = SPINLOCK_INIT;
1407
1408
1409
1410
1411
1412
1413

1414



1415
1416
1417
1418
1419
1420
1421
1477
1478
1479
1480
1481
1482
1483
1484

1485
1486
1487
1488
1489
1490
1491
1492
1493
1494







+
-
+
+
+







	tsdPtr->runLoopNestingLevel--;
	break;
    case kCFRunLoopBeforeWaiting:
	if (tsdPtr->runLoopTimer && !tsdPtr->runLoopServicingEvents &&
		(tsdPtr->runLoopNestingLevel > 1
			|| !tsdPtr->runLoopRunning)) {
	    tsdPtr->runLoopServicingEvents = 1;
            /*
            /* This call seems to simply force event processing through and prevents hangups that have long been observed with Tk-Cocoa.  */
	     * This call seems to simply force event processing through and
	     * prevents hangups that have long been observed with Tk-Cocoa.
	     */
	    Tcl_ServiceAll();
	    tsdPtr->runLoopServicingEvents = 0;
	}
	break;
    default:
	break;
    }

Changes to tests/all.tcl.

9
10
11
12
13
14
15
16
17





18
19
20



21

22
9
10
11
12
13
14
15


16
17
18
19
20
21
22
23
24
25
26

27
28







-
-
+
+
+
+
+



+
+
+
-
+

#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package prefer latest
package require Tcl 8.5-
package require tcltest 2.2
namespace import tcltest::*
configure {*}$argv -testdir [file dir [info script]]
namespace import ::tcltest::*

configure {*}$argv -testdir [file dirname [file dirname [file normalize [
    info script]/...]]]

if {[singleProcess]} {
    interp debug {} -frame 1
}

set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)]
unset -nocomplain env(ERROR_ON_FAILURES)
runAllTests
if {[runAllTests] && $ErrorOnFailures} {exit 1}
proc exit args {}

Changes to tests/assemble.test.

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22







-
+







# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#-----------------------------------------------------------------------------

# Commands covered: assemble

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.2
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
namespace eval tcl::unsupported {namespace export assemble}
namespace import tcl::unsupported::assemble

# Procedure to make code that fills the literal and local variable tables, to
# force instructions to spill to four bytes.
777
778
779
780
781
782
783
784

785
786
787
788
789
790
791
777
778
779
780
781
782
783

784
785
786
787
788
789
790
791







-
+







test assemble-7.43 {uplus} {
    -body {
	assemble {
	    push NaN; uplus
	}
    }
    -returnCodes error
    -result {can't use non-numeric floating-point value "NaN" as operand of "+"}
    -result {can't use non-numeric floating-point value as operand of "+"}
}
test assemble-7.43.1 {tryCvtToNumeric} {
    -body {
	assemble {
	    push NaN; tryCvtToNumeric
	}
    }
848
849
850
851
852
853
854
855

856
857
858


859
860
861
862
863
864
865
848
849
850
851
852
853
854

855
856
857

858
859
860
861
862
863
864
865
866







-
+


-
+
+







    -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
    -cleanup {unset result}
}
test assemble-8.5 {bad context} {
    -body {
	namespace eval assem {
	    set x 1
	    list [catch {assemble {load x}} result opts] $result [dict get $opts -errorcode]
	    assemble {load x}
	}
    }
    -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
    -result {cannot use this instruction to create a variable in a non-proc context}
    -errorCode {TCL ASSEM LVT}
    -cleanup {namespace delete assem}
}
test assemble-8.6 {load1} {
    -body {
	proc x {a} {
	    assemble {
		load a
1106
1107
1108
1109
1110
1111
1112
1113

1114
1115
1116


1117
1118
1119
1120
1121
1122
1123
1107
1108
1109
1110
1111
1112
1113

1114
1115


1116
1117
1118
1119
1120
1121
1122
1123
1124







-
+

-
-
+
+







    -body {
	assemble {push h; push e; push l; push l; push o; concat 5}
    }
    -result hello
}
test assemble-9.7 {concat} {
    -body {
	list [catch {assemble {concat 0}} result] $result $::errorCode
	assemble {concat 0}
    }
    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
    -cleanup {unset result}
    -result {operand must be positive}
    -errorCode {TCL ASSEM POSITIVE}
}

# assemble-10 -- eval and expr

test assemble-10.1 {eval - wrong # args} {
    -body {
	assemble {eval}
1580
1581
1582
1583
1584
1585
1586






1587
1588
1589
1590
1591
1592
1593
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600







+
+
+
+
+
+







}
test assemble-15.7 {listIndexImm} {
    -body {
	assemble {push {a b c}; listIndexImm end}
    }
    -result c
}
test assemble-15.8 {listIndexImm} {
    assemble {push {a b c}; listIndexImm end+2}
} {}
test assemble-15.9 {listIndexImm} {
    assemble {push {a b c}; listIndexImm -1-1}
} {}

# assemble-16 - invokeStk

test assemble-16.1 {invokeStk - wrong # args} {
    -body {
	assemble {invokeStk}
    }

Changes to tests/async.test.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
16
17
18
19
20
21
22

23
24
25
26
27
28
29







-







    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testasync [llength [info commands testasync]]
testConstraint threaded [::tcl::pkgconfig get threaded]

proc async1 {result code} {
    global aresult acode
    set aresult $result
    set acode $code
    return "new result"
}
145
146
147
148
149
150
151
152

153
154
155
156
157
158
159
160
161
162
163
164
165
166
167












168
169
170



171
172
173
174

175
176
177
178
179
180
181

182
183
184







185
186
187



188
189
190
191

192
193
194
195
196
197
198
199
200
201
202
203



204
205
206
207
208
209
210
211
212
213
214
215
216
144
145
146
147
148
149
150

151
152
153
154
155
156
157
158








159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179

180
181
182
183
184
185
186
187
188



189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204

205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233







-
+







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+



+
+
+



-
+







+
-
-
-
+
+
+
+
+
+
+



+
+
+



-
+












+
+
+














test async-3.1 {deleting handlers} testasync {
    set x {}
    list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}

test async-4.1 {async interrupting bytecode sequence} -constraints {
    testasync threaded
    testasync
} -setup {
    set hm [testasync create async3]
    proc nothing {} {
	# empty proc
    }
} -body {
    apply {{handle} {
	global aresult
	set aresult {Async event not delivered}
	testasync marklater $handle
	for {set i 0} {
	    $i < 2500000  &&  $aresult eq "Async event not delivered"
	} {incr i} {
	    nothing
	}
    global aresult
    set aresult {Async event not delivered}
    testasync marklater $handle
    # allow plenty of time to pass in case valgrind is running
    set start [clock seconds]
    while {
	[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
    } {
	# be less busy
	after 100
	nothing
    }
	return $aresult
    }} $hm
} -result {test pattern} -cleanup {
    # give other threads some time to go way so that valgrind doesn't pick up
    # "still reachable" cases from early thread termination
    after 100
    testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
    testasync threaded
    testasync
} -setup {
    set hm [testasync create async3]
} -body {
    apply {{handle} {
	global aresult
	set aresult {Async event not delivered}
	testasync marklater $handle
	# allow plenty of time to pass in case valgrind is running
	for {set i 0} {
	    $i < 2500000  &&  $aresult eq "Async event not delivered"
	} {incr i} {}
	set start [clock seconds]
	while {
		[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
	} {
		# be less busy
	    after 100
	}
	return $aresult
    }} $hm
} -result {test pattern} -cleanup {
    # give other threads some time to go way so that valgrind doesn't pick up
    # "still reachable" cases from early thread termination
    after 100
    testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
    testasync threaded
    testasync
} -setup {
    set hm [testasync create async3]
} -body {
    apply [list {handle} [concat {
	global aresult
	set aresult {Async event not delivered}
	testasync marklater $handle
	set i 0
    } "[string repeat {;incr i;} 1500000]after 10;" {
	return $aresult
    }]] $hm
} -result {test pattern} -cleanup {
    # give other threads some time to go way so that valgrind doesn't pick up
    # "still reachable" cases from early thread termination
    after 100
    testasync delete $hm
}

# cleanup
if {[testConstraint testasync]} {
    testasync delete
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/basic.test.

666
667
668
669
670
671
672
673

674
675
676
677
678
679
680
666
667
668
669
670
671
672

673
674
675
676
677
678
679
680







-
+







set l1 [list a {b b} c d]
set l2 [list e f {g g} h]
proc l3 {} {
    list i j k {l l}
}

# Do all tests once byte compiled and once with direct string evaluation
for {set noComp 0} {$noComp <= 1} {incr noComp} {
foreach noComp {0 1} {

if $noComp {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
889
890
891
892
893
894
895
896

897
898
899
900
901
902
903

904
905
906
907
908
909
910

911
912
913
914
915
916
917
889
890
891
892
893
894
895

896



897
898
899

900
901
902
903
904
905


906
907
908
909
910
911
912
913







-
+
-
-
-



-
+





-
-
+







        set leak [expr {$end - $tmp}]
    } -cleanup {
	unset end i tmp
	rename getbytes {}
	rename stress {}
} -result 0

test basic-48.17.$noComp {expansion: object safety} -setup {
test basic-48.17.$noComp {expansion: object safety} -constraints $constraints -body {
        set old_precision $::tcl_precision
        set ::tcl_precision 4
    } -constraints $constraints -body {
            set third [expr {1.0/3.0}]
            set l [list $third $third]
            set x [run {list $third {*}$l $third}]
	    set res [list]
            set res [list]
            foreach t $x {
                lappend res [expr {$t * 3.0}]
            }
            set res
    } -cleanup {
        set ::tcl_precision $old_precision
        unset old_precision res t l x third
        unset res t l x third
} -result {1.0 1.0 1.0 1.0}

test basic-48.18.$noComp {expansion: list semantics} -constraints $constraints -body {
        set badcmd {
            list a b
            set apa 10
        }
979
980
981
982
983
984
985










986
987
988
989
990
991
992
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998







+
+
+
+
+
+
+
+
+
+







    namespace eval ns {
	variable x namespace
	testevalex {set ::context $x} global
    }
    namespace delete ns
    set ::context
} {global}

test basic-50.1 {[586e71dce4] EvalObjv level #0 exception handling} -setup {
    interp create slave
    interp alias {} foo slave return
} -body {
    list [catch foo m] $m
} -cleanup {
    unset -nocomplain m
    interp delete slave
} -result {0 {}}

# Clean up after expand tests
unset noComp l1 l2 constraints
rename l3 {}
rename run {}

 #cleanup

Changes to tests/binary.test.

1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685

























1686
1687
1688
1689
1690
1691
1692
1643
1644
1645
1646
1647
1648
1649
















1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} {
    binary format w 7810179016327718216
} HelloTcl
test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} {
    binary format W 7810179016327718216
} lcTolleH

test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan HelloTcl W x
    set x
} 5216694956358656876
test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan lcTolleH w x
    set x
} 5216694956358656876
test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format w [expr {wide(3) << 31}]] w x
    set x
} 6442450944
test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format W [expr {wide(3) << 31}]] W x
    set x
} 6442450944
test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
    unset -nocomplain arg1
    list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
} {1 -9223372036854775808}
test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1
    list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1
    list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1 arg2
    list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}
test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1 arg2
    list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}

test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan HelloTcl W x
    set x
} 5216694956358656876
test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan lcTolleH w x
    set x
} 5216694956358656876
test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format w [expr {wide(3) << 31}]] w x
    set x
} 6442450944
test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format W [expr {wide(3) << 31}]] W x
    set x
} 6442450944
test binary-44.5 {Tcl_BinaryObjCmd: scan wide int with bit 31 and 64 set} {} {
    binary scan [binary format w [expr {(wide(3) << 31) + (wide(3) << 64)}]] w x
    set x
} 6442450944
test binary-44.6 {Tcl_BinaryObjCmd: scan wide int with bit 31 and 64 set} {} {
    binary scan [binary format W [expr {(wide(3) << 31) + (wide(3) << 64)}]] W x
    set x
} 6442450944

test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sws 16450 -1 19521] c* x
    set x
} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76}
test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sWs 16450 0x7fffffff 19521] c* x

Changes to tests/chanio.test.

9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

39

40

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
9
10
11
12
13
14
15
16
17
18

19
20





21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38

39


40
41
42

43
44
45
46
47
48
49







+


-


-
-
-
-
-












-
+

+

+

-

-
-



-







# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# TODO: This test is likely worthless. Confirm and remove
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testbytestring [llength [info commands testbytestring]]

namespace eval ::tcl::test::io {
    namespace import ::tcltest::*

    variable umaskValue
    variable path
    variable f
    variable i
    variable n
    variable v
    variable msg
    variable expected

    ::tcltest::loadTestedCommands
    loadTestedCommands
    catch [list package require -exact Tcltest [info patchlevel]]
    package require tcltests

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint exec             [llength [info commands exec]]
    testConstraint openpipe         1
    testConstraint fileevent        [llength [info commands fileevent]]
    testConstraint fcopy            [llength [info commands fcopy]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
    testConstraint testmainthread   [llength [info commands testmainthread]]
    testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]

    # You need a *very* special environment to do some tests.  In particular,
    # many file systems do not support large-files...
    testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]

    # some tests can only be run is umask is 2 if "umask" cannot be run, the
    # tests will be skipped.
5341
5342
5343
5344
5345
5346
5347
5348

5349
5350
5351
5352
5353
5354
5355
5356

5357
5358
5359
5360
5361
5362
5363
5334
5335
5336
5337
5338
5339
5340

5341
5342
5343
5344
5345
5346
5347
5348

5349
5350
5351
5352
5353
5354
5355
5356







-
+







-
+







    set x [format "%#o" [expr $stats(mode)&0o777]]
    chan puts $f "line 1"
    chan close $f
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
} -result {0600 {line 1}}
} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix umask} -body {
    # This test only works if your umask is 2, like ouster's.
    chan close [open $path(test3) {WRONLY CREAT}]
    file stat $path(test3) stats
    format "%#o" [expr $stats(mode)&0o777]
} -result [format %#4o [expr {0o666 & ~ $umaskValue}]]
} -result [format %#5o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan configure $f -eofchar {}
    chan puts $f xyzzy
    chan close $f
5862
5863
5864
5865
5866
5867
5868


5869
5870
5871
5872
5873
5874
5875
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870







+
+







    chan event $f readable {script 2}
    chan event $f readable {}
    list [testfevent cmd "chan event $f readable"] [chan event $f readable]
} -constraints {testfevent fileevent} -cleanup {
    testfevent delete
    chan close $f
} -result {{script 1} {}}
unset path(foo)
removeFile foo

set path(bar) [makeFile {} bar]

test chan-io-48.1 {testing readability conditions} {fileevent} {
    set f [open $path(bar) w]
    chan puts $f abcdefg
    chan puts $f abcdefg
5957
5958
5959
5960
5961
5962
5963



5964
5965
5966
5967
5968
5969
5970
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968







+
+
+







    chan puts $f {copy_slowly $f}
    chan puts $f {exit}
    vwait [namespace which -variable x]
    list $x $l
} -cleanup {
    chan close $f
} -result {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
unset path(bar)
removeFile bar

test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} -setup {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800
6801
6784
6785
6786
6787
6788
6789
6790


6791
6792
6793
6794
6795
6796
6797







-
-







    # -translation binary is also -encoding binary
    chan configure $in  -translation binary
    chan configure $out -encoding koi8-r -translation lf
    chan copy $in $out
    chan close $in
    chan close $out
    file size $path(kyrillic.txt)
} -cleanup {
    file delete $path(utf8-fcopy.txt)
} -result 3

test chan-io-53.1 {CopyData} -setup {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]

Changes to tests/cmdAH.test.

19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
19
20
21
22
23
24
25

26
27
28
29
30
31
32
33







-
+







catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testchmod       [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype  [llength [info commands testvolumetype]]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ([string index $tcl_platform(osVersion) 0] >= 5
    ($::tcl_platform(osVersion) >= 5.0
     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]

global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

1036
1037
1038
1039
1040
1041
1042
1043

1044
1045
1046
1047
1048
1049
1050
1036
1037
1038
1039
1040
1041
1042

1043
1044
1045
1046
1047
1048
1049
1050







-
+







} -constraints {win} -body {
    file atime con
} -result "could not get access time for file \"con\"" -returnCodes error
test cmdAH-20.7.1 {
    Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    file atime [file join [temporaryDirectory] CON.txt]
} -result "could not get access time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
} -match regexp -result {could not (?:get access time|read)} -returnCodes error

if {[testConstraint unix] && [file exists /tmp]} {
    removeFile touch.me /tmp
} else {
    removeFile touch.me
}

1277
1278
1279
1280
1281
1282
1283
1284

1285
1286
1287
1288
1289
1290
1291
1277
1278
1279
1280
1281
1282
1283

1284
1285
1286
1287
1288
1289
1290
1291







-
+







} -constraints {win} -body {
    file mtime con
} -result "could not get modification time for file \"con\"" -returnCodes error
test cmdAH-24.14.1 {
    Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    file mtime [file join [temporaryDirectory] CON.txt]
} -result "could not get modification time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
} -match regexp -result {could not (?:get modification time|read)} -returnCodes error

# owned
test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
    file owned a b
} -result {wrong # args: should be "file owned name"}
test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -body {
    file owned $gorpfile
1341
1342
1343
1344
1345
1346
1347

1348





1349
1350
1351
1352
1353
1354
1355
1341
1342
1343
1344
1345
1346
1347
1348

1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360







+
-
+
+
+
+
+







    Tcl_FileObjCmd: size (built-in Windows names)
} -constraints {win} -body {
    file size con
} -result 0
test cmdAH-27.4.1 {
    Tcl_FileObjCmd: size (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    try {
    file size [file join [temporaryDirectory] con.txt]
	set res [file size [file join [temporaryDirectory] con.txt]]
    } trap {POSIX ENOENT} {} {
	set res 0
    }
    set res
} -result 0

catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0765}

1443
1444
1445
1446
1447
1448
1449

1450
1451






1452
1453
1454
1455
1456
1457
1458
1448
1449
1450
1451
1452
1453
1454
1455


1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468







+
-
-
+
+
+
+
+
+







} -body {
    file stat con stat
    lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
    unset -nocomplain stat
} -body {
    try {
    file stat [file join [temporaryDirectory] CON.txt] stat
    lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
	file stat [file join [temporaryDirectory] CON.txt] stat
	set res [lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}]
    } trap {POSIX ENOENT} {} {
	set res {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
    }
    set res
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
unset -nocomplain stat

# type
test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
    file type a b
} -result {wrong # args: should be "file type name"}
1494
1495
1496
1497
1498
1499
1500

1501





1502
1503
1504
1505
1506
1507
1508
1504
1505
1506
1507
1508
1509
1510
1511

1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523







+
-
+
+
+
+
+







    Tcl_FileObjCmd: type (built-in Windows names)
} -constraints {win} -body {
    file type con
} -result "characterSpecial"
test cmdAH-29.6.1 {
    Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension)
} -constraints {win} -body {
    try {
    file type [file join [temporaryDirectory] CON.txt]
	set res [file type [file join [temporaryDirectory] CON.txt]]
    } trap {POSIX ENOENT} {} {
	set res {characterSpecial}
    }
    set res
} -result "characterSpecial"

# Error conditions
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file gorp x
} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {

Changes to tests/cmdIL.test.

143
144
145
146
147
148
149


















150
151
152
153
154
155
156
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







} -result {when used with "-stride", the leading "-index" value must be within the group}
test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
    lsort -stride 2 -index {0 1} {
	{{c o d e} 54321} {{b l a h} 94729}
	{{b i g} 12345} {{d e m o} 34512}
    }
} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
test cmdIL-1.37 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii [list \0 \x7f \x80 \uffff]
} [list \0 \x7f \x80 \uffff]
test cmdIL-1.38 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii -nocase [list \0 \x7f \x80 \uffff]
} [list \0 \x7f \x80 \uffff]
test cmdIL-1.39 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii [list \0 \x7f \x80 \U01ffff \uffff]
} [list \0 \x7f \x80 \uffff \U01ffff]
test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii -nocase [list \0 \x7f \x80 \U01ffff \uffff]
} [list \0 \x7f \x80 \uffff \U01ffff]
test cmdIL-1.41 {lsort -stride and -index} -body {
    lsort -stride 2 -index -2 {a 2 b 1}
} -returnCodes error -result {index "-2" cannot select an element from any list}
test cmdIL-1.42 {lsort -stride and-index} -body {
    lsort -stride 2 -index -1-1 {a 2 b 1}
} -returnCodes error -result {index "-1-1" cannot select an element from any list}

# Can't think of any good tests for the MergeSort and MergeLists procedures,
# except a bunch of random lists to sort.

test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup {
    set result {}
    set r 1435753299
199
200
201
202
203
204
205



























206
207
208
209
210
211
212
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







} -returnCodes error -result {expected integer but got "c"}
test cmdIL-3.4.1 {SortCompare procedure, -index option} -body {
    lsort -integer -index 2 "{1 2 3} \\\{"
} -returnCodes error -result {unmatched open brace in list}
test cmdIL-3.5 {SortCompare procedure, -index option} -body {
    lsort -integer -index 2 {{20 10 13} {15}}
} -returnCodes error -result {element 2 missing from sublist "15"}
test cmdIL-3.5.1 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index 1+3 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {element 4 missing from sublist "1 . c"}
test cmdIL-3.5.2 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index -1-1 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "-1-1" cannot select an element from any list}
test cmdIL-3.5.3 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index -2 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "-2" cannot select an element from any list}
test cmdIL-3.5.4 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index end-4 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {element -2 missing from sublist "1 . c"}
test cmdIL-3.5.5 {SortCompare procedure, -index option} {
    lsort -index {} {a b}
} {a b}
test cmdIL-3.5.6 {SortCompare procedure, -index option} {
    lsort -index {} [list a \{]
} {a \{}
test cmdIL-3.5.7 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index end--1 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "end--1" cannot select an element from any list}
test cmdIL-3.5.8 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index end+1 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "end+1" cannot select an element from any list}
test cmdIL-3.5.9 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index end+2 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "end+2" cannot select an element from any list}
test cmdIL-3.6 {SortCompare procedure, -index option} {
    lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}}
} {{3 25 20} {2 5 25} {1 15 30}}
test cmdIL-3.7 {SortCompare procedure, -ascii option} {
    lsort -ascii {d e c b a d35 d300 100 20}
} {100 20 a b c d d300 d35 e}
test cmdIL-3.8 {SortCompare procedure, -dictionary option} {

Changes to tests/compExpr-old.test.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
16
17
18
19
20
21
22






23
24
25
26
27
28
29







-
-
-
-
-
-







    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
    testConstraint testmathfunctions 0
} else {
    testConstraint testmathfunctions 1
}

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
80
81
82
83
84
85
86
87
88


89
90
91
92
93
94
95
74
75
76
77
78
79
80


81
82
83
84
85
86
87
88
89







-
-
+
+







	default {
	    return 0
	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]

testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

# procedures used below

proc put_hello_char {c} {
    global a
    append a [format %c $c]
    return $c
281
282
283
284
285
286
287
288

289
290
291

292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312

313
314
315

316
317
318
319
320
321
322
275
276
277
278
279
280
281

282
283
284

285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305

306
307
308

309
310
311
312
313
314
315
316







-
+


-
+




















-
+


-
+







    expr 2***3|6
} -returnCodes error -match glob -result *
test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
    expr 2^x
} -returnCodes error -match glob -result *
test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
    list [catch {expr {24.0^3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "^"}}
} {1 {can't use floating-point value as operand of "^"}}
test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
    list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "^"}}
} {1 {can't use non-numeric string as operand of "^"}}

test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
test compExpr-old-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
test compExpr-old-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
test compExpr-old-7.5 {CompileBitAndExpr: error in equality expr} -body {
    expr x==3
} -returnCodes error -match glob -result *
test compExpr-old-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
test compExpr-old-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
test compExpr-old-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
test compExpr-old-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
test compExpr-old-7.10 {CompileBitAndExpr: error compiling bitand arm} -body {
    expr 2***3&6
} -returnCodes error -match glob -result *
test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
    expr 2&x
} -returnCodes error -match glob -result *
test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
    list [catch {expr {24.0&3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "&"}}
} {1 {can't use floating-point value as operand of "&"}}
test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
    list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "&"}}
} {1 {can't use non-numeric string as operand of "&"}}

test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1
test compExpr-old-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1
test compExpr-old-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0
test compExpr-old-8.5 {CompileEqualityExpr: error in relational expr} -body {
    expr x>3
333
334
335
336
337
338
339
340

341
342
343
344
345
346

347
348
349
350
351
352
353
354
355
356
327
328
329
330
331
332
333

334




335

336



337
338
339
340
341
342
343







-
+
-
-
-
-

-
+
-
-
-







} -returnCodes error -match glob -result *


test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test compExpr-old-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test compExpr-old-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8

test compExpr-old-9.5 {CompileRelationalExpr: large shift expr} {
# The following test is different for 32-bit versus 64-bit
# architectures because LONG_MIN is different

test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
    expr {int(1<<63)}
} -9223372036854775808
} 9223372036854775808
test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
    expr {int(1<<31)}
} -2147483648

test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
373
374
375
376
377
378
379
380

381
382
383

384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402

403
404
405

406
407
408
409
410
411
412
360
361
362
363
364
365
366

367
368
369

370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388

389
390
391

392
393
394
395
396
397
398
399







-
+


-
+


















-
+


-
+







    expr 2***3>>6
} -returnCodes error -match glob -result *
test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body {
    expr 2<<x
} -returnCodes error -match glob -result *
test compExpr-old-10.10 {CompileShiftExpr: runtime error} {
    list [catch {expr {24.0>>43}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
} {1 {can't use floating-point value as operand of ">>"}}
test compExpr-old-10.11 {CompileShiftExpr: runtime error} {
    list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "<<"}}
} {1 {can't use non-numeric string as operand of "<<"}}

test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
test compExpr-old-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
test compExpr-old-11.5 {CompileAddExpr: error in multiply expr} -body {
    expr x*3
} -returnCodes error -match glob -result *
test compExpr-old-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
test compExpr-old-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
test compExpr-old-11.8 {CompileAddExpr: error compiling add arm} -body {
    expr 2***3+6
} -returnCodes error -match glob -result *
test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body {
    expr 2-x
} -returnCodes error -match glob -result *
test compExpr-old-11.10 {CompileAddExpr: runtime error} {
    list [catch {expr {24.0+"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test compExpr-old-11.11 {CompileAddExpr: runtime error} {
    list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}
test compExpr-old-11.12 {CompileAddExpr: runtime error} {
    list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
test compExpr-old-11.13a {CompileAddExpr: runtime error} ieeeFloatingPoint {
    list [catch {expr {2.3/0.0}} msg] $msg
} {0 Inf}
test compExpr-old-11.13b {CompileAddExpr: runtime error} !ieeeFloatingPoint {
426
427
428
429
430
431
432
433

434
435
436

437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454

455
456
457

458
459
460
461
462
463
464
413
414
415
416
417
418
419

420
421
422

423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440

441
442
443

444
445
446
447
448
449
450
451







-
+


-
+

















-
+


-
+







    expr 2*3%%6
} -returnCodes error -match glob -result *
test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
    expr 2*x
} -returnCodes error -match glob -result *
test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} {
    list [catch {expr {24.0*"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "*"}}
} {1 {can't use non-numeric string as operand of "*"}}
test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}

test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
test compExpr-old-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
test compExpr-old-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
test compExpr-old-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
test compExpr-old-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
test compExpr-old-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
test compExpr-old-13.8 {CompileUnaryExpr: error compiling unary expr} -body {
    expr ~x
} -returnCodes error -match glob -result *
test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
    expr !1.x
    set msg
} -returnCodes error -match glob -result *
test compExpr-old-13.10 {CompileUnaryExpr: runtime error} {
    list [catch {expr {~"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "~"}}
} {1 {can't use non-numeric string as operand of "~"}}
test compExpr-old-13.11 {CompileUnaryExpr: runtime error} {
    list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "~"}}
} {1 {can't use floating-point value as operand of "~"}}
test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} {
    set a 27
    expr $a
} 27
test compExpr-old-13.14 {CompileUnaryExpr: just primary expr} {
    expr double(27)
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
585
586
587
588
589
590
591
















592
593
594
595
596
597
598







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    set ::errorInfo
} -match glob -result {too few arguments for math function*
    while *ing
"expr pow(1)"}
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
    expr sin(1
} -returnCodes error -match glob -result *
test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr 2*T1()
} 246
test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T2()*3
} 1035
test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T3(21, 37)
} 37
test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T3(21.2, 37)
} 37.0
test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T3(-21.2, -17.5)
} -17.5

test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
    catch {unset a}
    set a(VALUE) ff15
    set i 123
    if {[expr 0x$a(VALUE)] & 16} {
        set i {}
    }

Changes to tests/compExpr.test.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
12
13
14
15
16
17
18






19
20
21
22
23
24
25







-
-
-
-
-
-







    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
    testConstraint testmathfunctions 0
} else {
    testConstraint testmathfunctions 1
}

# Constrain memory leak tests
testConstraint memory [llength [info commands memory]]

catch {unset a}

test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {
    expr 1+2
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
309
310
311
312
313
314
315






316
317
318
319
320
321
322







-
-
-
-
-
-








test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
    format %.6g [expr atan2(1.0, 2.0)]
} 0.463648
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
    expr {do_it()}
} -returnCodes error -match glob -result {* "*do_it"}
test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr 3*T1()-1
} 368
test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T2()*3
} 1035
test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body {
    expr {atan2(1.0)}
} -returnCodes error -match glob -result {too few arguments for math function*}
test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
    format %.6g [expr pow(2.1, 27.5-(24.4*(5%2)))]
} 9.97424
test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body {

Changes to tests/compile.test.

319
320
321
322
323
324
325
326

327
328
329
330
331
332
333
319
320
321
322
323
324
325

326
327
328
329
330
331
332
333







-
+







    }}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; string index a bogus }}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; string index a 0o9 }}
} -returnCodes error -match glob -result {*}
} -returnCodes error -match glob -result {*invalid octal number*}
test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; array set var {one two many} }}
} -returnCodes error -result {list must have an even number of elements}
test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; incr foo bar baz}}
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
495
496
497
498
499
500
501

502

503
504
505
506
507
508
509
495
496
497
498
499
500
501
502

503
504
505
506
507
508
509
510







+
-
+







test compile-15.4 {proper TCL_RETURN code from [return]} {
    apply {{} {catch {return [info library]}}}
} 2
test compile-15.5 {proper TCL_RETURN code from [return]} {
    apply {{} {catch {set a 1}; return}}
} ""

# Do all tests once byte compiled and once with direct string evaluation
for {set noComp 0} {$noComp <= 1} {incr noComp} {
foreach noComp {0 1} {

if $noComp {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}

Changes to tests/config.test.

15
16
17
18
19
20
21
22

23
24
25
26
27
28
29
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29







-
+







if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test pkgconfig-1.1 {query keys} {
    lsort [::tcl::pkgconfig list]
} {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded}
} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime}
test pkgconfig-1.2 {query keys multiple times} {
    string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
} 0
test pkgconfig-1.3 {query value multiple times} {
    string compare \
	    [::tcl::pkgconfig get bindir,install] \
	    [::tcl::pkgconfig get bindir,install]

Changes to tests/coroutine.test.

735
736
737
738
739
740
741


742
743
744
745
746
747
748
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750







+
+







    }
    proc boom {} {
	cc ; # coro created at level 2
	C  ; # and called at level 1
    }
    boom   ; # does not crash: the coro floor is a good insulator
    list
} -cleanup {
    rename boom {}; rename cc {}; rename c {}
} -result {}

test coroutine-8.0.0 {coro inject executed} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    demo
    set ::result none
    tcl::unsupported::inject demo set ::result inject-executed

Changes to tests/dict.test.

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20












-
+







# This test file covers the dictionary object type and the dict command used
# to work with values of that type.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
#
# Copyright (c) 2003-2009 Donal K. Fellows
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc memtest script {
171
172
173
174
175
176
177
178

179
180
181
182
183
184
185
186
187
188
189
171
172
173
174
175
176
177

178




179
180
181
182
183
184
185







-
+
-
-
-
-







    dict replace { a b  c d }
} {a b c d}
test dict-4.12 {dict replace command: canonicality is forced} {
    dict replace {a b c d a e}
} {a e c d}
test dict-4.13 {dict replace command: type check is mandatory} -body {
    dict replace { a b c d e }
} -returnCodes error -result {missing value to go with key}
} -errorCode {TCL VALUE DICTIONARY} -result {missing value to go with key}
test dict-4.13a {dict replace command: type check is mandatory} {
    catch {dict replace { a b c d e }} -> opt
    dict get $opt -errorcode
} {TCL VALUE DICTIONARY}
test dict-4.14 {dict replace command: type check is mandatory} -body {
    dict replace { a b {}c d }
} -returnCodes error -result {dict element in braces followed by "c" instead of space}
test dict-4.14a {dict replace command: type check is mandatory} {
    catch {dict replace { a b {}c d }} -> opt
    dict get $opt -errorcode
} {TCL VALUE DICTIONARY JUNK}
199
200
201
202
203
204
205
206

207
208
209
210
211
212
213
214
215
216
217
195
196
197
198
199
200
201

202




203
204
205
206
207
208
209







-
+
-
-
-
-







} -returnCodes error -result {unmatched open quote in dict}
test dict-4.16a {dict replace command: type check is mandatory} {
    catch {dict replace " a b \"c d "} -> opt
    dict get $opt -errorcode
} {TCL VALUE DICTIONARY QUOTE}
test dict-4.17 {dict replace command: type check is mandatory} -body {
    dict replace " a b \{c d "
} -returnCodes error -result {unmatched open brace in dict}
} -errorCode {TCL VALUE DICTIONARY BRACE} -result {unmatched open brace in dict}
test dict-4.17a {dict replace command: type check is mandatory} {
    catch {dict replace " a b \{c d "} -> opt
    dict get $opt -errorcode
} {TCL VALUE DICTIONARY BRACE}
test dict-4.18 {dict replace command: canonicality forcing doesn't leak} {
    set example { a b  c d }
    list $example [dict replace $example]
} {{ a b  c d } {a b c d}}

test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d}
test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}

Changes to tests/encoding.test.

32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
32
33
34
35
36
37
38

39
40
41
42
43
44
45
46







-
+







proc runtests {} {
    variable x

# Some tests require the testencoding command
testConstraint testencoding [llength [info commands testencoding]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint teststringbytes [llength [info commands teststringbytes]]
testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]
testConstraint tip389 [expr {[string length \U010000] == 2}]
testConstraint exec [llength [info commands exec]]
testConstraint testgetencpath [llength [info commands testgetencpath]]

# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested

test encoding-1.1 {Tcl_GetEncoding: system encoding} -setup {
319
320
321
322
323
324
325
326

327
328
329
330


331
332
333
334
335

336
337
338
339
340
341
342
319
320
321
322
323
324
325

326
327
328


329
330
331
332
333
334

335
336
337
338
339
340
341
342







-
+


-
-
+
+




-
+







} 00
test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
    set y [encoding convertfrom utf-8 [encoding convertto utf-8 \u0000]]
    binary scan [teststringbytes $y] H* z
    set z
} c080

test encoding-16.1 {UnicodeToUtfProc} {
test encoding-16.1 {UnicodeToUtfProc} -constraints tip389 -body {
    set val [encoding convertfrom unicode NN]
    list $val [format %x [scan $val %c]]
} "\u4e4e 4e4e"
test encoding-16.2 {UnicodeToUtfProc} -constraints fullutf -body {
} -result "\u4e4e 4e4e"
test encoding-16.2 {UnicodeToUtfProc} -constraints tip389 -body {
    set val [encoding convertfrom unicode "\xd8\xd8\xdc\xdc"]
    list $val [format %x [scan $val %c]]
} -result "\U460dc 460dc"

test encoding-17.1 {UtfToUnicodeProc} -constraints fullutf -body {
test encoding-17.1 {UtfToUnicodeProc} -constraints tip389 -body {
    encoding convertto unicode "\U460dc"
} -result "\xd8\xd8\xdc\xdc"

test encoding-18.1 {TableToUtfProc} {
} {}

test encoding-19.1 {TableFromUtfProc} {

Changes to tests/env.test.

12
13
14
15
16
17
18


19
20
21
22
23
24
25
26



















27
28
29
30
31
32
33
34
35
36
37
38

























39
40
41
42
43
44
45
46
47





















48
49
50
51
52
53
54










55
56
57
58
59
60
61














62
63
64
65
66
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81
82
83
84
85
86
87

88
89
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
128





129
130
131
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
161
162

163
164
165

166
167
168
169
170
171

172
173
174


175
176

177
178
179
180
181

182
183
184
185

186
187
188
189




190
191
192
193

194
195

196
197
198
199


200
201

202
203
204
205

206
207

208
209
210
211
212
213





214
215

216
217
218
219
220
221





222


223
224
225
226
227
228
229
230
231

232

233


234
235
236
237
238
239





240
241

242
243
244
245
246
247
248
249
250
251



252
253
254
255
256
257
258
259
260
261
262
263
264


265

266
267
268
269
270

271
272
273
274

275
276


277

278
279
280
281
282

283
284
285
286

287
288



289


290
291
292

293
294

295
296
297
298
299
300

301
302
303
304
305
306
307
308
309
310
311
312

313


314
315
316
317
318
319
320

321

322


323
324
325
326
327
328
329
330
331
332
333

334
335
336
337
338
339
340









341
342






343
344
345
346
347
348
349
12
13
14
15
16
17
18
19
20








21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39












40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64









65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86






87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168

169
170
171


172
173
174
175
176












177
178
179
180
181
182




183
184


185
186






187
188
189
190
191
192
193
194


195
196
197


198

199
200

201
202
203



204
205
206
207


208
209
210
211
212
213

214
215
216

217

218
219
220
221

222



223
224


225
226
227
228
229

230
231
232
233

234
235



236
237
238
239
240



241
242

243




244
245


246




247


248
249
250




251
252
253
254
255


256
257
258




259
260
261
262
263

264
265
266
267
268
269
270




271
272
273

274
275
276
277




278
279
280
281
282


283
284
285
286
287
288
289
290



291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314

315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330

331
332
333
334
335
336
337
338
339
340
341

342
343
344
345

346
347

348
349
350
351
352
353

354
355
356
357
358
359
360
361
362
363
364
365
366
367

368
369
370
371
372
373
374
375

376
377
378

379
380
381
382
383
384
385
386
387
388
389
390

391
392






393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416







+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+













-
+
-
-
-
-
-
-



-
+


-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-

+
+
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
-
-
+

-
-
-
-
-
-
+
+
+
+
+
+


-
-
+
+
+
-
-
+
-
+

-
+


-
-
-
+

+
+
-
-
+
+
+
+


-
+


-
+
-




-
+
-
-
-
+
+
-
-
+




-
+



-
+

-
-
-
+
+
+
+

-
-
-
+

-
+
-
-
-
-
+
+
-
-
+
-
-
-
-
+
-
-
+


-
-
-
-
+
+
+
+
+
-
-
+


-
-
-
-
+
+
+
+
+
-
+
+





-
-
-
-
+

+
-
+
+


-
-
-
-
+
+
+
+
+
-
-
+







-
-
-
+
+
+













+
+

+




-
+




+


+
+

+




-
+




+


+
+
+
-
+
+


-
+

-
+





-
+












+
-
+
+






-
+

+
-
+
+










-
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+







# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
# Some tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]

#
# These tests will run on any platform (and indeed crashed on the Mac). So put
# them before you test for the existance of exec.
#
package require tcltests

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {
	set out {}
    }
    return $out
}


proc envrestore {} {
    # Restore the environment variables at the end of the test.
    global env
    variable env2

test env-1.1 {propagation of env values to child interpreters} -setup {
    catch {interp delete child}
    catch {unset env(test)}
} -body {
    interp create child
    set env(test) garbage
    child eval {set env(test)}
} -cleanup {
    interp delete child
    unset env(test)
} -result {garbage}
#
    foreach name [array names env] {
	unset env($name)
    }
    array set env $env2
    return
}


proc envprep {} {
    # Save the current environment variables at the start of the test.
    global env
    variable keep
    variable env2

    set env2 [array get env]
    foreach name [array names env] {
	# Keep some environment variables that support operation of the tcltest
	# package.
	if {[string toupper $name] ni [string toupper $keep]} {
	    unset env($name)
	}
    }
    return
}

# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
# runs.
#
test env-1.2 {lappend to env value} -setup {
    catch {unset env(test)}
} -body {
    set env(test) aaaaaaaaaaaaaaaa
    append env(test) bbbbbbbbbbbbbb
    unset env(test)

proc encodingrestore {} {
    variable sysenc
    encoding system $sysenc
    return
}


proc encodingswitch encoding {
    variable sysenc
    # Need to run [getenv] in known encoding, so save the current one here...
    set sysenc [encoding system]
    encoding system $encoding
    return
}


proc setup1 {} {
    global env
    envprep
    encodingswitch iso8859-1
}
test env-1.3 {reflection of env by "array names"} -setup {
    catch {interp delete child}
    catch {unset env(test)}
} -body {
    interp create child
    child eval {set env(test) garbage}

proc setup2 {} {
    global env
    setup1
    set env(NAME1) {test string}
    set env(NAME2) {new value}
    set env(XYZZY) {garbage}
}


    expr {"test" in [array names env]}
} -cleanup {
    interp delete child
    catch {unset env(test)}
} -result {1}

set printenvScript [makeFile {
proc cleanup1 {} {
    encodingrestore
    envrestore
}

variable keep {
    TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
    SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
    DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
    __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
    CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
}

variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
    encoding system iso8859-1
    proc lrem {listname name} {
	upvar $listname list
	set i [lsearch -nocase $list $name]
	if {$i >= 0} {
	    set list [lreplace $list $i $i]
	}
	return $list
    }
    proc mangle s {
	regsub -all {\[|\\|\]} $s {\\&} s
	regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s
	regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar {&}]} s
	return [subst -novariables $s]
    }
    proc manglechar c {
	return [format {\u%04x} [scan $c %c]]
    }

    set names [lsort [array names env]]
    if {$tcl_platform(platform) eq "windows"} {
	lrem names HOME
        lrem names COMSPEC
	lrem names ComSpec
	lrem names ""
    }
    foreach name {
    foreach name @keep@ {
	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
	SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
	__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
	CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
    } {
	lrem names $name
    }
    foreach p $names {
	puts "[mangle $p]=[mangle $env($p)]"
	puts [mangle $p]=[mangle $env($p)]
    }
    exit
} printenv]
}] printenv]

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript tcltest
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {
	set out {}
    }
    return $out

test env-1.1 {propagation of env values to child interpreters} -setup {
    catch {interp delete child}
    catch {unset env(test)}
} -body {
    interp create child
    set env(test) garbage
    child eval {set env(test)}
} -cleanup {
    interp delete child
    unset env(test)
} -result {garbage}


# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
# runs.
test env-1.2 {lappend to env value} -setup {
    catch {unset env(test)}
} -body {
    set env(test) aaaaaaaaaaaaaaaa
    append env(test) bbbbbbbbbbbbbb
    unset env(test)
}

# Save the current environment variables at the start of the test.

test env-1.3 {reflection of env by "array names"} -setup {
    catch {interp delete child}
set env2 [array get env]
foreach name [array names env] {
    catch {unset env(test)}
} -body {
    interp create child
    child eval {set env(test) garbage}
    expr {"test" in [array names env]}
    # Keep some environment variables that support operation of the tcltest
    # package.
    if {[string toupper $name] ni {
	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
	SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
	SECURITYSESSIONID LANG WINDIR TERM
	CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432
    }} {
	unset env($name)
    }
}
} -cleanup {
    interp delete child
    catch {unset env(test)}
} -result 1


# Need to run 'getenv' in known encoding, so save the current one here...
set sysenc [encoding system]

test env-2.1 {adding environment variables} -setup {
test env-2.1 {
    adding environment variables
    encoding system iso8859-1
} -constraints {exec} -body {
} -constraints exec -setup setup1 -body {
    getenv
} -cleanup {
    encoding system $sysenc
} -result {}
test env-2.2 {adding environment variables} -setup {
    encoding system iso8859-1
} -constraints {exec} -body {
} -cleanup cleanup1 -result {}


test env-2.2 {
    adding environment variables
} -constraints exec -setup setup1 -body {
    set env(NAME1) "test string"
    getenv
} -cleanup {
    encoding system $sysenc
} -cleanup cleanup1 -result {NAME1=test string}


} -result {NAME1=test string}
test env-2.3 {adding environment variables} -setup {
test env-2.3 {adding environment variables} -constraints exec -setup {
    encoding system iso8859-1
    setup1
    set env(NAME1) "test string"
} -constraints {exec} -body {
} -body {
    set env(NAME2) "more"
    getenv
} -cleanup {
    encoding system $sysenc
} -result {NAME1=test string
} -cleanup cleanup1 -result {NAME1=test string
NAME2=more}


test env-2.4 {adding environment variables} -setup {
    encoding system iso8859-1
test env-2.4 {
    adding environment variables
} -constraints exec -setup {
    setup1
    set env(NAME1) "test string"
    set env(NAME2) "more"
} -constraints {exec} -body {
} -body {
    set env(XYZZY) "garbage"
    getenv
} -cleanup {
} -cleanup { cleanup1
    encoding system $sysenc
} -result {NAME1=test string
NAME2=more
XYZZY=garbage}

set env(NAME1) "test string"

set env(NAME2) "new value"
set env(XYZZY) "garbage"
test env-3.1 {changing environment variables} -setup {
test env-3.1 {
    changing environment variables
    encoding system iso8859-1
} -constraints {exec} -body {
} -constraints exec -setup setup2 -body {
    set result [getenv]
    unset env(NAME2)
    set result
} -cleanup {
    encoding system $sysenc
    cleanup1
} -result {NAME1=test string
NAME2=new value
XYZZY=garbage}
unset -nocomplain env(NAME2)


test env-4.1 {unsetting environment variables: default} -setup {
    encoding system iso8859-1
} -constraints {exec} -body {
test env-4.1 {
    unsetting environment variables
} -constraints exec -setup setup2 -body {
    unset -nocomplain env(NAME2)
    getenv
} -cleanup {
    encoding system $sysenc
} -result {NAME1=test string
} -cleanup cleanup1 -result {NAME1=test string
XYZZY=garbage}
test env-4.2 {unsetting environment variables} -setup {

    encoding system iso8859-1
} -constraints {exec} -body {
    unset env(NAME1)
    getenv
# env-4.2 is deleted

} -cleanup {
    unset env(XYZZY)
test env-4.3 {
    encoding system $sysenc
} -result {XYZZY=garbage}
unset -nocomplain env(NAME1) env(XYZZY)
test env-4.3 {setting international environment variables} -setup {
    setting international environment variables
    encoding system iso8859-1
} -constraints {exec} -body {
} -constraints exec -setup setup1 -body {
    set env(\ua7) \ub6
    getenv
} -cleanup {
    encoding system $sysenc
} -result {\u00a7=\u00b6}
test env-4.4 {changing international environment variables} -setup {
} -cleanup cleanup1 -result {\u00a7=\u00b6}


test env-4.4 {
    changing international environment variables
    encoding system iso8859-1
} -constraints {exec} -body {
} -constraints exec -setup setup1 -body {
    set env(\ua7) \ua7
    getenv
} -cleanup {
    encoding system $sysenc
} -result {\u00a7=\u00a7}
test env-4.5 {unsetting international environment variables} -setup {
} -cleanup cleanup1 -result {\u00a7=\u00a7}


test env-4.5 {
    unsetting international environment variables
    encoding system iso8859-1
} -constraints exec -setup {
    setup1
    set env(\ua7) \ua7
} -body {
    set env(\ub6) \ua7
    unset env(\ua7)
    getenv
} -constraints {exec} -cleanup {
    unset env(\ub6)
    encoding system $sysenc
} -result {\u00b6=\u00a7}
} -cleanup cleanup1 -result {\u00b6=\u00a7}

test env-5.0 {
test env-5.0 {corner cases - set a value, it should exist} -body {
    corner cases - set a value, it should exist
} -setup setup1 -body {
    set env(temp) a
    set env(temp)
} -cleanup {
    unset env(temp)
} -result {a}
test env-5.1 {corner cases - remove one elem at a time} -setup {
} -cleanup cleanup1 -result a


test env-5.1 {
    corner cases - remove one elem at a time
    set x [array get env]
} -body {
} -setup setup1 -body {
    # When no environment variables exist, the env var will contain no
    # entries. The "array names" call synchs up the C-level environ array with
    # the Tcl level env array. Make sure an empty Tcl array is created.
    foreach e [array names env] {
	unset env($e)
    }
    array size env
} -cleanup {
    array set env $x
} -result {0}
} -cleanup cleanup1 -result 0


test env-5.2 {corner cases - unset the env array} -setup {
    interp create i
} -body {
    # Unsetting a variable in an interp detaches the C-level traces from the
    # Tcl "env" variable.
    i eval {
	unset env
	set env(THIS_SHOULDNT_EXIST) a
    }
    info exists env(THIS_SHOULDNT_EXIST)
} -cleanup {
    interp delete i
} -result {0}


test env-5.3 {corner cases: unset the env in master should unset child} -setup {
    setup1
    interp create i
} -body {
    # Variables deleted in a master interp should be deleted in child interp
    # too.
    i eval { set env(THIS_SHOULD_EXIST) a}
    i eval {set env(THIS_SHOULD_EXIST) a}
    set result [set env(THIS_SHOULD_EXIST)]
    unset env(THIS_SHOULD_EXIST)
    lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}]
} -cleanup {
    cleanup1
    interp delete i
} -result {a 1}


test env-5.4 {corner cases - unset the env array} -setup {
    setup1
    interp create i
} -body {
    # The info exists command should be in synch with the env array.
    # Know Bug: 1737
    i eval { set env(THIS_SHOULD_EXIST) a}
    i eval {set env(THIS_SHOULD_EXIST) a}
    set     result [info exists env(THIS_SHOULD_EXIST)]
    lappend result [set env(THIS_SHOULD_EXIST)]
    lappend result [info exists env(THIS_SHOULD_EXIST)]
} -cleanup {
    cleanup1
    interp delete i
} -result {1 a 1}


test env-5.5 {
test env-5.5 {corner cases - cannot have null entries on Windows} -constraints win -body {
    corner cases - cannot have null entries on Windows
} -constraints win -body {
    set env() a
    catch {set env()}
} -result 1
} -cleanup cleanup1 -result 1

test env-6.1 {corner cases - add lots of env variables} -body {
test env-6.1 {corner cases - add lots of env variables} -setup setup1 -body {
    set size [array size env]
    for {set i 0} {$i < 100} {incr i} {
	set env(BOGUS$i) $i
    }
    expr {[array size env] - $size}
} -result 100
} -cleanup cleanup1 -result 100

test env-7.1 {[219226]: whole env array should not be unset by read} -body {
    set n [array size env]
    set s [array startsearch env]
    while {[array anymore env $s]} {
	array nextelement env $s
	incr n -1
    }
    array donesearch env $s
    return $n
} -result 0

test env-7.2 {
test env-7.2 {[219226]: links to env elements should not be removed by read} -body {
    [219226]: links to env elements should not be removed by read
} -setup setup1 -body {
    apply {{} {
	set ::env(test7_2) ok
	upvar env(test7_2) elem
	set ::env(PATH)
	return $elem
    }}
} -result ok
} -cleanup cleanup1 -result ok

test env-7.3 {
test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body {
    [9b4702]: testing existence of env(some_thing) should not destroy trace
} -setup setup1 -body {
    apply {{} {
      catch {unset ::env(test7_3)}
      proc foo args {
        set ::env(test7_3) ok
      }
      trace add variable ::env(not_yet_existent) write foo
      info exists ::env(not_yet_existent)
      set ::env(not_yet_existent) "Now I'm here";
      return [info exists ::env(test7_3)]
    }}
} -result 1
} -cleanup cleanup1 -result 1

# Restore the environment variables at the end of the test.

foreach name [array names env] {
    unset env($name)
}
array set env $env2
test env-8.0 {
    memory usage - valgrind does not report reachable memory
} -body {
    set res [set env(__DUMMY__) {i'm with dummy}]
    unset env(__DUMMY__)
    return $res
} -result {i'm with dummy}



# cleanup
rename getenv {}
rename envrestore {}
rename envprep {}
rename encodingrestore {}
rename encodingswitch {}

removeFile $printenvScript
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/exec.test.

1
2
3
4
5
6
7
8
9
10
11
12
13



14
15
16




17
18
19
20
21
22
23
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30













+
+
+



+
+
+
+







# Commands covered:  exec
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.

package require tcltest 2
namespace import -force ::tcltest::*

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
unset -nocomplain path

# Utilities that are like bourne shell stalwarts, but cross-platform.
set path(echo) [makeFile {
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
303
304
305
306
307
308
309

310
311
312
313
314
315
316







-







    exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \
	|& [interpreter] $path(sh) -c "\"$path(echo)\" second msg 1>&2 ; \"$path(cat)\"" |& [interpreter] $path(cat)
} "second msg\nfoo bar"

# I/O redirection: combinations.

set path(gorp.file2) [makeFile {} gorp.file2]
file delete $path(gorp.file2)

test exec-7.1 {multiple I/O redirections} {exec} {
    exec << "command input" > $path(gorp.file2) [interpreter] $path(cat) < $path(gorp.file)
    exec [interpreter] $path(cat) $path(gorp.file2)
} {Just a few thoughts}
test exec-7.2 {multiple I/O redirections} {exec} {
    exec < $path(gorp.file) << "command input" [interpreter] $path(cat)
322
323
324
325
326
327
328
329

330
331
332
333

334
335
336
337
338
339
340
341
342
343

344
345
346
347
348
349
350
328
329
330
331
332
333
334

335
336
337
338

339
340
341
342
343
344
345
346
347
348

349
350
351
352
353
354
355
356







-
+



-
+









-
+







# More than 20 arguments to exec.
test exec-8.2 {long input and output} {exec} {
    exec [interpreter] $path(echo) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
} {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23}

# Commands that return errors.

test exec-9.1 {commands returning errors} {exec} {
test exec-9.1 {commands returning errors} {exec notValgrind} {
    set x [catch {exec gorp456} msg]
    list $x [string tolower $msg] [string tolower $errorCode]
} {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}}
test exec-9.2 {commands returning errors} {exec} {
test exec-9.2 {commands returning errors} {exec notValgrind} {
    string tolower [list [catch {exec [interpreter] echo foo | foo123} msg] $msg $errorCode]
} {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
test exec-9.3 {commands returning errors} -constraints {exec stdio} -body {
    exec [interpreter] $path(sleep) 1 | [interpreter] $path(exit) 43 | [interpreter] $path(sleep) 1
} -returnCodes error -result {child process exited abnormally}
test exec-9.4 {commands returning errors} -constraints {exec stdio} -body {
    exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar"
} -returnCodes error -result {foo bar
child process exited abnormally}
test exec-9.5 {commands returning errors} -constraints {exec stdio} -body {
test exec-9.5 {commands returning errors} -constraints {exec stdio notValgrind} -body {
    exec gorp456 | [interpreter] echo a b c
} -returnCodes error -result {couldn't execute "gorp456": no such file or directory}
test exec-9.6 {commands returning errors} -constraints {exec} -body {
    exec [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2"
} -returnCodes error -result {error msg}
test exec-9.7 {commands returning errors} -constraints {exec stdio nonPortable} -body {
    # This test can fail easily on multiprocessor machines
425
426
427
428
429
430
431
432

433
434
435

436
437
438

439
440
441
442
443
444
445
431
432
433
434
435
436
437

438
439
440

441
442
443

444
445
446
447
448
449
450
451







-
+


-
+


-
+







} -returnCodes error -result "channel \"$f\" wasn't opened for reading"
close $f
set f [open $path(gorp.file) r]
test exec-10.19 {errors in exec invocation} -constraints {exec} -body {
    exec cat >@ $f
} -returnCodes error -result "channel \"$f\" wasn't opened for writing"
close $f
test exec-10.20 {errors in exec invocation} -constraints {exec} -body {
test exec-10.20 {errors in exec invocation} -constraints {exec notValgrind} -body {
    exec ~non_existent_user/foo/bar
} -returnCodes error -result {user "non_existent_user" doesn't exist}
test exec-10.21 {errors in exec invocation} -constraints {exec} -body {
test exec-10.21 {errors in exec invocation} -constraints {exec notValgrind} -body {
    exec [interpreter] true | ~xyzzy_bad_user/x | false
} -returnCodes error -result {user "xyzzy_bad_user" doesn't exist}
test exec-10.22 {errors in exec invocation} -constraints exec -body {
test exec-10.22 {errors in exec invocation} -constraints {exec notValgrind} -body {
    exec echo test > ~non_existent_user/foo/bar
} -returnCodes error -result {user "non_existent_user" doesn't exist}
# Commands in background.

test exec-11.1 {commands in background} {exec} {
    set time [time {exec [interpreter] $path(sleep) 2 &}]
    expr {[lindex $time 0] < 1000000}
507
508
509
510
511
512
513
514

515
516
517
518
519
520
521
513
514
515
516
517
518
519

520
521
522
523
524
525
526
527







-
+








test exec-13.1 {setting errorCode variable} {exec} {
    list [catch {exec [interpreter] $path(cat) < a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
test exec-13.2 {setting errorCode variable} {exec} {
    list [catch {exec [interpreter] $path(cat) > a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
test exec-13.3 {setting errorCode variable} {exec} {
test exec-13.3 {setting errorCode variable} {exec notValgrind} {
    set x [catch {exec _weird_cmd_} msg]
    list $x [string tolower $msg] [lindex $errorCode 0] \
	    [string tolower [lrange $errorCode 2 end]]
} {1 {couldn't execute "_weird_cmd_": no such file or directory} POSIX {{no such file or directory}}}
test exec-13.4 {extended exit result codes} -setup {
    set tmp [makeFile {exit 0x00000101} tmpfile.exec-13.4]
} -constraints {win} -body {
545
546
547
548
549
550
551
552

553
554
555
556
557
558
559
551
552
553
554
555
556
557

558
559
560
561
562
563
564
565







-
+







} "foo\n"
test exec-14.2 {-keepnewline switch} -constraints {exec} -body {
    exec -keepnewline
} -returnCodes error -result {wrong # args: should be "exec ?-option ...? arg ?arg ...?"}
test exec-14.3 {unknown switch} -constraints {exec} -body {
    exec -gorp
} -returnCodes error -result {bad option "-gorp": must be -ignorestderr, -keepnewline, or --}
test exec-14.4 {-- switch} -constraints {exec} -body {
test exec-14.4 {-- switch} -constraints {exec notValgrind} -body {
    exec -- -gorp
} -returnCodes error -result {couldn't execute "-gorp": no such file or directory}
test exec-14.5 {-ignorestderr switch} {exec} {
    # Alas, the use of -ignorestderr is buried here :-(
    exec [interpreter] $path(sh2) -c [list $path(echo2) foo bar] 2>@1
} "foo bar\nbar"

659
660
661
662
663
664
665
666

667
668
669
670
671
672
673
674
675
676
677
678
679

680
681
682
683
684
685
686
665
666
667
668
669
670
671

672
673
674
675
676
677
678
679
680
681
682
683
684

685
686
687
688
689
690
691
692







-
+












-
+







} -constraints {exec tempNotWin} -cleanup {
    removeFile $path(fooblah)
} -result contents

# Note that this test cannot be adapted to work on Windows; that platform has
# no kernel support for an analog of O_APPEND. OTOH, that means we can assume
# that there is a POSIX shell...
test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind} -setup {
    set tmpfile [makeFile {0} tmpfile.exec-19.1]
} -body {
    # Note that we have to allow for the current contents of the temporary
    # file, which is why the result is 14 and not 12
    exec /bin/sh -c \
	    {for a in 1 2 3; do sleep 1; echo $a; done} >>$tmpfile &
    exec /bin/sh -c \
	    {for a in 4 5 6; do sleep 1; echo $a >&2; done} 2>>$tmpfile &
    exec /bin/sh -c \
	    {for a in a b c; do sleep 1; echo $a; done} >>$tmpfile &
    exec /bin/sh -c \
	    {for a in d e f; do sleep 1; echo $a >&2; done} 2>>$tmpfile &
    # The above four shell invokations take about 3 seconds to finish, so allow
    # The above four shell invocations take about 3 seconds to finish, so allow
    # 5s (in case the machine is busy)
    after 5000
    # Check that no bytes have got lost through mixups with overlapping
    # appends, which is only guaranteed to work when we set O_APPEND on the
    # file descriptor in the [exec >>...]
    file size $tmpfile
} -cleanup {

Changes to tests/execute.test.

30
31
32
33
34
35
36
37

38
39
40
41
42
43
44
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44







-
+








testConstraint testobj [expr {
    [llength [info commands testobj]]
    && [llength [info commands testdoubleobj]]
    && [llength [info commands teststringobj]]
}]

testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint testexprlongobj [llength [info commands testexprlongobj]]

# Tests for the omnibus TclExecuteByteCode function:

# INST_DONE not tested
# INST_PUSH1 not tested
# INST_PUSH4 not tested
170
171
172
173
174
175
176
177

178
179
180
181
182
183
184
170
171
172
173
174
175
176

177
178
179
180
181
182
183
184







-
+







test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {$x + 1}
} 2.0
test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {$x + 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
    set x [testintobj set 0 1]
    expr {1 + $x}
} 2
test execute-3.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} {
    set x [testdoubleobj set 0 1]
    expr {1 + $x}
195
196
197
198
199
200
201
202

203
204
205
206
207
208
209
195
196
197
198
199
200
201

202
203
204
205
206
207
208
209







-
+







test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {1 + $x}
} 2.0
test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {1 + $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}

# INST_SUB is partially tested:
test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
    set x [testintobj set 0 1]
    expr {$x - 1}
} 0
test execute-3.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} {
222
223
224
225
226
227
228
229

230
231
232
233
234
235
236
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236







-
+







test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {$x - 1}
} 0.0
test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {$x - 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}
test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
    set x [testintobj set 0 1]
    expr {1 - $x}
} 0
test execute-3.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} {
    set x [testdoubleobj set 0 1]
    expr {1 - $x}
247
248
249
250
251
252
253
254

255
256
257
258
259
260
261
247
248
249
250
251
252
253

254
255
256
257
258
259
260
261







-
+







test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {1 - $x}
} 0.0
test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {1 - $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}

# INST_MULT is partially tested:
test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {$x * 1}
} 1
test execute-3.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} {
274
275
276
277
278
279
280
281

282
283
284
285
286
287
288
274
275
276
277
278
279
280

281
282
283
284
285
286
287
288







-
+







test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {$x * 1}
} 1.0
test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {$x * 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "*"}}
} {1 {can't use non-numeric string as operand of "*"}}
test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {1 * $x}
} 1
test execute-3.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} {
    set x [testdoubleobj set 1 2.0]
    expr {1 * $x}
299
300
301
302
303
304
305
306

307
308
309
310
311
312
313
299
300
301
302
303
304
305

306
307
308
309
310
311
312
313







-
+







test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {1 * $x}
} 1.0
test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {1 * $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "*"}}
} {1 {can't use non-numeric string as operand of "*"}}

# INST_DIV is partially tested:
test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {$x / 1}
} 1
test execute-3.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} {
326
327
328
329
330
331
332
333

334
335
336
337
338
339
340
326
327
328
329
330
331
332

333
334
335
336
337
338
339
340







-
+







test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {$x / 1}
} 1.0
test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {$x / 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}
test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {2 / $x}
} 2
test execute-3.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {2 / $x}
351
352
353
354
355
356
357
358

359
360
361
362
363
364
365
351
352
353
354
355
356
357

358
359
360
361
362
363
364
365







-
+







test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {2 / $x}
} 2.0
test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {1 / $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}

# INST_UPLUS is partially tested:
test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {+ $x}
} 1
test execute-3.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {
378
379
380
381
382
383
384
385

386
387
388
389
390
391
392
378
379
380
381
382
383
384

385
386
387
388
389
390
391
392







-
+







test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {+ $x}
} 1.0
test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {+ $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}

# INST_UMINUS is partially tested:
test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {- $x}
} -1
test execute-3.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {
405
406
407
408
409
410
411
412

413
414
415
416
417
418
419
405
406
407
408
409
410
411

412
413
414
415
416
417
418
419







-
+







test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {- $x}
} -1.0
test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {- $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}

# INST_LNOT is partially tested:
test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
    set x [testintobj set 1 2]
    expr {! $x}
} 0
test execute-3.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
453
454
455
456
457
458
459
460

461
462
463
464
465
466
467
453
454
455
456
457
458
459

460
461
462
463
464
465
466
467







-
+







test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
    set x [teststringobj set 1 0.0]
    expr {! $x}
} 1
test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {! $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}

# INST_BITNOT not tested
# INST_CALL_BUILTIN_FUNC1 not tested
# INST_CALL_FUNC1 not tested

# INST_TRY_CVT_TO_NUMERIC is partially tested:
test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {
801
802
803
804
805
806
807
808
809
810



811
812
813
814
815
816
817
801
802
803
804
805
806
807



808
809
810
811
812
813
814
815
816
817







-
-
-
+
+
+







} 1
# wide ints have more bits of precision than doubles, but we convert anyway
test execute-7.7 {Wide int handling in INST_EQ and [incr]} {
    set x [expr {wide(1)<<62}]
    set y [expr {$x+1}]
    expr {double($x) == double($y)}
} 1
test execute-7.8 {Wide int conversions can change sign} longIs32bit {
    set x 0x80000000
    expr {int($x) < wide($x)}
test execute-7.8 {Wide int conversions can change sign} {
    set x 0x8000000000000000
    expr {wide($x) < 0}
} 1
test execute-7.9 {Wide int handling in INST_MOD} {
    expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
} 316659348800185
test execute-7.10 {Wide int handling in INST_MOD} {
    expr {((wide(1)<<60)-1) % 0x400000000}
} 17179869183
883
884
885
886
887
888
889
890

891
892
893


894
895

896
897
898
899
900
901
902
883
884
885
886
887
888
889

890
891


892
893
894

895
896
897
898
899
900
901
902







-
+

-
-
+
+

-
+







} 1
test execute-7.31 {Wide int handling in abs()} {
    set x 0xa23456871234568
    incr x
    set y 0x123456871234568
    concat [expr {abs($x)}] [expr {abs($y)}]
} {730503879441204585 81985533099853160}
test execute-7.32 {Wide int handling} longIs32bit {
test execute-7.32 {Wide int handling} {
    expr {int(1024 * 1024 * 1024 * 1024)}
} 0
test execute-7.33 {Wide int handling} longIs32bit {
} 1099511627776
test execute-7.33 {Wide int handling} {
    expr {int(0x1 * 1024 * 1024 * 1024 * 1024)}
} 0
} 1099511627776
test execute-7.34 {Wide int handling} {
    expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
} 1099511627776

test execute-8.1 {Stack protection} -setup {
    # If [Bug #804681] has not been properly taken care of, this should
    # segfault

Changes to tests/expr-old.test.

18
19
20
21
22
23
24
25
26


27
28
29
30
31
32
33
34
35
36
37
38
18
19
20
21
22
23
24


25
26





27
28
29
30
31
32
33







-
-
+
+
-
-
-
-
-








::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit    [expr {int(0x80000000) < 0}]

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
    testConstraint testmathfunctions 0
} else {
    testConstraint testmathfunctions 1
}

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
193
194
195
196
197
198
199
200

201
202
203

204
205
206

207
208
209

210
211
212

213
214
215

216
217
218

219
220
221

222
223
224

225
226
227

228
229
230
231
232
233
234
188
189
190
191
192
193
194

195
196
197

198
199
200

201
202
203

204
205
206

207
208
209

210
211
212

213
214
215

216
217
218

219
220
221

222
223
224
225
226
227
228
229







-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+







    list [catch {expr 028.1 + 09.2} msg] $msg
} {0 37.3}

# Operators that aren't legal on floating-point numbers

test expr-old-3.1 {illegal floating-point operations} {
    list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "~"}}
} {1 {can't use floating-point value as operand of "~"}}
test expr-old-3.2 {illegal floating-point operations} {
    list [catch {expr 27%4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "%"}}
} {1 {can't use floating-point value as operand of "%"}}
test expr-old-3.3 {illegal floating-point operations} {
    list [catch {expr 27.0%4} msg] $msg
} {1 {can't use floating-point value "27.0" as operand of "%"}}
} {1 {can't use floating-point value as operand of "%"}}
test expr-old-3.4 {illegal floating-point operations} {
    list [catch {expr 1.0<<3} msg] $msg
} {1 {can't use floating-point value "1.0" as operand of "<<"}}
} {1 {can't use floating-point value as operand of "<<"}}
test expr-old-3.5 {illegal floating-point operations} {
    list [catch {expr 3<<1.0} msg] $msg
} {1 {can't use floating-point value "1.0" as operand of "<<"}}
} {1 {can't use floating-point value as operand of "<<"}}
test expr-old-3.6 {illegal floating-point operations} {
    list [catch {expr 24.0>>3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
} {1 {can't use floating-point value as operand of ">>"}}
test expr-old-3.7 {illegal floating-point operations} {
    list [catch {expr 24>>3.0} msg] $msg
} {1 {can't use floating-point value "3.0" as operand of ">>"}}
} {1 {can't use floating-point value as operand of ">>"}}
test expr-old-3.8 {illegal floating-point operations} {
    list [catch {expr 24&3.0} msg] $msg
} {1 {can't use floating-point value "3.0" as operand of "&"}}
} {1 {can't use floating-point value as operand of "&"}}
test expr-old-3.9 {illegal floating-point operations} {
    list [catch {expr 24.0|3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "|"}}
} {1 {can't use floating-point value as operand of "|"}}
test expr-old-3.10 {illegal floating-point operations} {
    list [catch {expr 24.0^3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "^"}}
} {1 {can't use floating-point value as operand of "^"}}

# Check the string operators individually.

test expr-old-4.1 {string operators} {expr {"abc" > "def"}} 0
test expr-old-4.2 {string operators} {expr {"def" > "def"}} 0
test expr-old-4.3 {string operators} {expr {"g" > "def"}} 1
test expr-old-4.4 {string operators} {expr {"abc" < "abd"}} 1
261
262
263
264
265
266
267
268

269
270
271

272
273
274

275
276
277

278
279
280

281
282
283

284
285
286

287
288
289

290
291
292

293
294
295

296
297
298

299
300
301

302
303
304

305
306
307

308
309
310
311
312
313
314
256
257
258
259
260
261
262

263
264
265

266
267
268

269
270
271

272
273
274

275
276
277

278
279
280

281
282
283

284
285
286

287
288
289

290
291
292

293
294
295

296
297
298

299
300
301

302
303
304
305
306
307
308
309







-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+







test expr-old-4.31 {string operators} {expr {1?"foo":"bar"}} foo
test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar

# Operators that aren't legal on string operands.

test expr-old-5.1 {illegal string operations} {
    list [catch {expr {-"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}
test expr-old-5.2 {illegal string operations} {
    list [catch {expr {+"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-5.3 {illegal string operations} {
    list [catch {expr {~"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "~"}}
} {1 {can't use non-numeric string as operand of "~"}}
test expr-old-5.4 {illegal string operations} {
    list [catch {expr {!"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-old-5.5 {illegal string operations} {
    list [catch {expr {"a"*"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "*"}}
} {1 {can't use non-numeric string as operand of "*"}}
test expr-old-5.6 {illegal string operations} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}
test expr-old-5.7 {illegal string operations} {
    list [catch {expr {"a"%"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "%"}}
} {1 {can't use non-numeric string as operand of "%"}}
test expr-old-5.8 {illegal string operations} {
    list [catch {expr {"a"+"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-5.9 {illegal string operations} {
    list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}
test expr-old-5.10 {illegal string operations} {
    list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "<<"}}
} {1 {can't use non-numeric string as operand of "<<"}}
test expr-old-5.11 {illegal string operations} {
    list [catch {expr {"a">>"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of ">>"}}
} {1 {can't use non-numeric string as operand of ">>"}}
test expr-old-5.12 {illegal string operations} {
    list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "&"}}
} {1 {can't use non-numeric string as operand of "&"}}
test expr-old-5.13 {illegal string operations} {
    list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "^"}}
} {1 {can't use non-numeric string as operand of "^"}}
test expr-old-5.14 {illegal string operations} {
    list [catch {expr {"a"|"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "|"}}
} {1 {can't use non-numeric string as operand of "|"}}
test expr-old-5.15 {illegal string operations} {
    list [catch {expr {"a"&&"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-old-5.16 {illegal string operations} {
    list [catch {expr {"a"||"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-old-5.17 {illegal string operations} {
489
490
491
492
493
494
495
496

497
498
499
500
501
502
503
504
505
506
507
508
509
510

511
512
513

514
515
516
517
518
519
520
484
485
486
487
488
489
490

491
492
493
494
495
496
497
498
499
500
501
502
503
504

505
506
507

508
509
510
511
512
513
514
515







-
+













-
+


-
+







test expr-old-25.19 {type conversions} {expr 2.0e15} 2000000000000000.0
test expr-old-25.20 {type conversions} {expr 10.0} 10.0

# Various error conditions.

test expr-old-26.1 {error conditions} {
    list [catch {expr 2+"a"} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-26.2 {error conditions} -body {
    expr 2+4*
} -returnCodes error -match glob -result *
test expr-old-26.3 {error conditions} -body {
    expr 2+4*(
} -returnCodes error -match glob -result *
unset -nocomplain _non_existent_
test expr-old-26.4 {error conditions} {
    list [catch {expr 2+$_non_existent_} msg] $msg
} {1 {can't read "_non_existent_": no such variable}}
set a xx
test expr-old-26.5 {error conditions} {
    list [catch {expr {2+$a}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-26.6 {error conditions} {
    list [catch {expr {2+[set a]}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-26.7 {error conditions} -body {
    expr {2+(4}
} -returnCodes error -match glob -result *
test expr-old-26.8 {error conditions} {
    list [catch {expr 2/0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.9 {error conditions} {
530
531
532
533
534
535
536
537

538
539
540
541
542
543
544
525
526
527
528
529
530
531

532
533
534
535
536
537
538
539







-
+







    expr 2#
} -returnCodes error -match glob -result *
test expr-old-26.12 {error conditions} -body {
    expr a.b
} -returnCodes error -match glob -result *
test expr-old-26.13 {error conditions} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}
test expr-old-26.14 {error conditions} -body {
    expr 2:3
} -returnCodes error -match glob -result *
test expr-old-26.15 {error conditions} -body {
    expr a@b
} -returnCodes error -match glob -result *
test expr-old-26.16 {error conditions} {
815
816
817
818
819
820
821
822

823
824
825

826
827
828
829
830
831
832
810
811
812
813
814
815
816

817
818
819

820
821
822
823
824
825
826
827







-
+


-
+







    expr int(-1.4)
} {-1}
test expr-old-32.32 {math functions in expressions} {
    expr int(-1.6)
} {-1}
test expr-old-32.33 {math functions in expressions} {
    expr int(1e60)
} 0
} 999999999999999949387135297074018866963645011013410073083904
test expr-old-32.34 {math functions in expressions} {
    expr int(-1e60)
} 0
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.35 {math functions in expressions} {
    expr round(1.49)
} {1}
test expr-old-32.36 {math functions in expressions} {
    expr round(1.51)
} {2}
test expr-old-32.37 {math functions in expressions} {
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
838
839
840
841
842
843
844






845
846
847
848
849
850
851







-
-
-
-
-
-







} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.41 {math functions in expressions} {
    list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
} {0 16.0}
test expr-old-32.42 {math functions in expressions} {
    list [catch {expr hypot(5*.8,3)} msg] $msg
} {0 5.0}
test expr-old-32.43 {math functions in expressions} testmathfunctions {
    expr 2*T1()
} 246
test expr-old-32.44 {math functions in expressions} testmathfunctions {
    expr T2()*3
} 1035
test expr-old-32.45 {math functions in expressions} {
    expr (0 <= rand()) && (rand() < 1)
} {1}
test expr-old-32.46 {math functions in expressions} -body {
    list [catch {expr rand(24)} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-32.47 {math functions in expressions} -body {
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966

967
968
969
970
971
972
973
937
938
939
940
941
942
943





944
945
946
947
948
949

950
951
952
953
954
955
956
957







-
-
-
-
-






-
+







} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
    expr round(1.0e30)
} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
    expr round(-1.0e30)
} -1000000000000000019884624838656
test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \
    -body {
        list [catch {expr T1(4)} msg] $msg
    } -match glob -result {1 {too many arguments for math function*}}

test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
    expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
    set x 0o289
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "0o289" as operand of "+"}}
} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
    list [catch {expr 0289.1} msg] $msg
} {0 289.1}
test expr-old-36.4 {ExprLooksLikeInt procedure} {
    set x 0289.1
    list [catch {expr {$x+1}} msg] $msg
} {0 290.1}
999
1000
1001
1002
1003
1004
1005
1006

1007
1008
1009
1010

1011
1012
1013
1014
1015
1016
1017
1018

1019
1020
1021
1022
1023
1024
1025
983
984
985
986
987
988
989

990
991
992
993

994
995
996
997
998
999
1000
1001

1002
1003
1004
1005
1006
1007
1008
1009







-
+



-
+







-
+







    expr {$x+1}
} 665802003400000000000001

# tests for [Bug #587140]
test expr-old-36.12 {ExprLooksLikeInt procedure} {
    set x "10;"
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "10;" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-36.13 {ExprLooksLikeInt procedure} {
    set x " +"
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string " +" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-36.14 {ExprLooksLikeInt procedure} {
    set x "123456789012345678901234567890 "
    expr {$x+1}
} 123456789012345678901234567891
test expr-old-36.15 {ExprLooksLikeInt procedure} {
    set x "0o99 "
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "0o99 " as operand of "+"}}
} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.16 {ExprLooksLikeInt procedure} {
    set x " 0xffffffffffffffffffffffffffffffffffffff  "
    expr {$x+1}
} [expr 0x100000000000000000000000000000000000000]

test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
    testexprlong 4+1
1048
1049
1050
1051
1052
1053
1054
1055
1056


1057
1058
1059
1060
1061
1062
1063
1032
1033
1034
1035
1036
1037
1038


1039
1040
1041
1042
1043
1044
1045
1046
1047







-
-
+
+







	list [catch {testexprlong 0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong {
    testexprlong -0x80000000
} {This is a result: -2147483648}
test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
    testexprlong -0xffffffff
} {This is a result: 1}
    testexprlong -0x7fffffff
} {This is a result: -2147483647}
test expr-old-37.10 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlong -0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082







1083
1084
1085
1086
1087
1088
1089
1057
1058
1059
1060
1061
1062
1063



1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077







-
-
-
+
+
+
+
+
+
+







    -body {
	list [catch {testexprlong 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong {
    testexprlong -2147483648.
} {This is a result: -2147483648}
test expr-old-37.15 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
    testexprlong -4294967295.
} {This is a result: 1}
test expr-old-37.15 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlong -2147483649.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-old-37.16 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlong 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
1155
1156
1157
1158
1159
1160
1161
1162
1163


1164
1165
1166
1167
1168
1169
1170
1171
1172






1173
1174
1175
1176
1177
1178
1179
1180
1181
1182


1183
1184
1185
1186
1187
1188
1189
1190
1191






1192
1193
1194
1195
1196
1197
1198
1143
1144
1145
1146
1147
1148
1149


1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174


1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198







-
-
+
+









+
+
+
+
+
+








-
-
+
+









+
+
+
+
+
+







test expr-old-40.1 {min math function} -body {
    expr {min(0)}
} -result 0
test expr-old-40.2 {min math function} -body {
    expr {min(0.0)}
} -result 0.0
test expr-old-40.3 {min math function} -body {
    list [catch {expr {min()}} msg] $msg
} -result {1 {too few arguments to math function "min"}}
    expr {min()}
} -returnCodes error -result {too few arguments for math function "min"}
test expr-old-40.4 {min math function} -body {
    expr {min(wide(-1) << 30, 4.5, -10)}
} -result [expr {wide(-1) << 30}]
test expr-old-40.5 {min math function} -body {
    expr {min("a", 0)}
} -returnCodes error -match glob -result *
test expr-old-40.6 {min math function} -body {
    expr {min(300, "0xFF")}
} -result 255
test expr-old-40.7 {min math function} -body {
    expr min(1[string repeat 0 10000], 1e300)
} -result 1e+300
test expr-old-40.8 {min math function} -body {
    expr {min(0, "a")}
} -returnCodes error -match glob -result *

test expr-old-41.1 {max math function} -body {
    expr {max(0)}
} -result 0
test expr-old-41.2 {max math function} -body {
    expr {max(0.0)}
} -result 0.0
test expr-old-41.3 {max math function} -body {
    list [catch {expr {max()}} msg] $msg
} -result {1 {too few arguments to math function "max"}}
    expr {max()}
} -returnCodes error -result {too few arguments for math function "max"}
test expr-old-41.4 {max math function} -body {
    expr {max(wide(1) << 30, 4.5, -10)}
} -result [expr {wide(1) << 30}]
test expr-old-41.5 {max math function} -body {
    expr {max("a", 0)}
} -returnCodes error -match glob -result *
test expr-old-41.6 {max math function} -body {
    expr {max(200, "0xFF")}
} -result 255
test expr-old-41.7 {max math function} -body {
    expr max(1[string repeat 0 10000], 1e300)
} -result 1[string repeat 0 10000]
test expr-old-41.8 {max math function} -body {
    expr {max(0, "a")}
} -returnCodes error -match glob -result *

# Special test for Pentium arithmetic bug of 1994:

if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
    puts "Warning: this machine contains a defective Pentium processor"
    puts "that performs arithmetic incorrectly.  I recommend that you"
    puts "call Intel customer service immediately at 1-800-628-8686"

Changes to tests/expr.test.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30



31
32
33
34
35
36
37
38
14
15
16
17
18
19
20




21
22
23



24
25
26

27
28
29
30
31
32
33







-
-
-
-



-
-
-
+
+
+
-







    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testmathfunctions [expr {
    ([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"})
}]

# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.

testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
253
254
255
256
257
258
259
260

261
262
263
264
265
266
267
248
249
250
251
252
253
254

255
256
257
258
259
260
261
262







-
+







test expr-4.9 {CompileLorExpr: long lor arm} {
    set a "abcdefghijkl"
    set i 7
    expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
} 1
test expr-4.10 {CompileLorExpr: error compiling ! operand} {
    list [catch {expr {!"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-4.11 {CompileLorExpr: error compiling land arms} {
    list [catch {expr {"a"||0}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-4.12 {CompileLorExpr: error compiling land arms} {
    list [catch {expr {0||"a"}} msg] $msg
} {1 {expected boolean value but got "a"}}

300
301
302
303
304
305
306
307

308
309
310

311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331

332
333
334

335
336
337
338
339
340
341
295
296
297
298
299
300
301

302
303
304

305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325

326
327
328

329
330
331
332
333
334
335
336







-
+


-
+




















-
+


-
+







    expr 2***3|6
} -returnCodes error -match glob -result *
test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
    expr 2^x
} -returnCodes error -match glob -result *
test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
    list [catch {expr {24.0^3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "^"}}
} {1 {can't use floating-point value as operand of "^"}}
test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
    list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "^"}}
} {1 {can't use non-numeric string as operand of "^"}}

test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
test expr-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
test expr-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
test expr-7.5 {CompileBitAndExpr: error in equality expr} -body {
    expr x==3
} -returnCodes error -match glob -result *
test expr-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
test expr-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
test expr-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
test expr-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
test expr-7.10 {CompileBitAndExpr: error compiling bitand arm} -body {
    expr 2***3&6
} -returnCodes error -match glob -result *
test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
    expr 2&x
} -returnCodes error -match glob -result *
test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
    list [catch {expr {24.0&3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "&"}}
} {1 {can't use floating-point value as operand of "&"}}
test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
    list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "&"}}
} {1 {can't use non-numeric string as operand of "&"}}
test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
test expr-7.20 {CompileBitAndExpr: error in equality expr} -body {
    expr xne3
} -returnCodes error -match glob -result *

test expr-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
417
418
419
420
421
422
423
424

425
426

427
428
429
430
431
432
433
434
435
436
412
413
414
415
416
417
418

419
420

421



422
423
424
425
426
427
428







-
+

-
+
-
-
-







    expr {1ea}
} -returnCodes error -match glob -result *

test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {
    expr {int(1<<63)}
} -9223372036854775808
} 9223372036854775808
test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
    expr {int(1<<31)}
} -2147483648
test expr-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test expr-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
    expr 2***3>6
452
453
454
455
456
457
458
459

460
461
462

463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481

482
483
484

485
486
487
488
489
490
491
444
445
446
447
448
449
450

451
452
453

454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472

473
474
475

476
477
478
479
480
481
482
483







-
+


-
+


















-
+


-
+







    expr 2***3>>6
} -returnCodes error -match glob -result *
test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body {
    expr 2<<x
} -returnCodes error -match glob -result *
test expr-10.10 {CompileShiftExpr: runtime error} {
    list [catch {expr {24.0>>43}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
} {1 {can't use floating-point value as operand of ">>"}}
test expr-10.11 {CompileShiftExpr: runtime error} {
    list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "<<"}}
} {1 {can't use non-numeric string as operand of "<<"}}

test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
test expr-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
test expr-11.5 {CompileAddExpr: error in multiply expr} -body {
    expr x*3
} -returnCodes error -match glob -result *
test expr-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
test expr-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
test expr-11.8 {CompileAddExpr: error compiling add arm} -body {
    expr 2***3+6
} -returnCodes error -match glob -result *
test expr-11.9 {CompileAddExpr: error compiling add arm} -body {
    expr 2-x
} -returnCodes error -match glob -result *
test expr-11.10 {CompileAddExpr: runtime error} {
    list [catch {expr {24.0+"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-11.11 {CompileAddExpr: runtime error} {
    list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}
test expr-11.12 {CompileAddExpr: runtime error} {
    list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
test expr-11.13a {CompileAddExpr: runtime error} !ieeeFloatingPoint {
    list [catch {expr {2.3/0.0}} msg] $msg
} {1 {divide by zero}}
test expr-11.13b {CompileAddExpr: runtime error} ieeeFloatingPoint {
505
506
507
508
509
510
511
512

513
514
515

516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532

533
534
535

536
537
538
539
540
541
542
497
498
499
500
501
502
503

504
505
506

507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523

524
525
526

527
528
529
530
531
532
533
534







-
+


-
+
















-
+


-
+







    expr 2*3%%6
} -returnCodes error -match glob -result *
test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
    expr 2*x
} -returnCodes error -match glob -result *
test expr-12.10 {CompileMultiplyExpr: runtime error} {
    list [catch {expr {24.0*"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "*"}}
} {1 {can't use non-numeric string as operand of "*"}}
test expr-12.11 {CompileMultiplyExpr: runtime error} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}

test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
test expr-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
test expr-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
test expr-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
test expr-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
test expr-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
test expr-13.8 {CompileUnaryExpr: error compiling unary expr} -body {
    expr ~x
} -returnCodes error -match glob -result *
test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
    expr !1.x
} -returnCodes error -match glob -result *
test expr-13.10 {CompileUnaryExpr: runtime error} {
    list [catch {expr {~"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "~"}}
} {1 {can't use non-numeric string as operand of "~"}}
test expr-13.11 {CompileUnaryExpr: runtime error} {
    list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "~"}}
} {1 {can't use floating-point value as operand of "~"}}
test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
test expr-13.13 {CompileUnaryExpr: just primary expr} {
    set a 27
    expr $a
} 27
test expr-13.14 {CompileUnaryExpr: just primary expr} {
    expr double(27)
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
673
674
675
676
677
678
679



































680
681
682
683
684
685
686







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    set ::errorInfo
} -match glob -result {too few arguments for math function*
    while *ing
"expr pow(1)"}
test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
    expr sin(1
} -returnCodes error -match glob -result *
test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr 2*T1()
} 246
test expr-15.8 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T2()*3
} 1035
test expr-15.9 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T3(21, 37)
} 37
test expr-15.10 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T3(21.2, 37)
} 37.0
test expr-15.11 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T3(-21.2, -17.5)
} -17.5
test expr-15.12 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(21, wide(37))
} 37
test expr=15.13 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(wide(21), 37)
} 37
test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(wide(21), wide(37))
} 37
test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(21.0, wide(37))
} 37.0
test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(wide(21), 37.0)
} 37.0
test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints {
    testmathfunctions
} -body {
    expr T3(0,"a")
} -returnCodes error -result {argument to math function didn't have numeric value}


test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
    catch {unset a}
    set a(VALUE) ff15
    set i 123
    if {[expr 0x$a(VALUE)] & 16} {
840
841
842
843
844
845
846
847

848
849
850
851

852
853
854
855

856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875

876
877
878
879

880
881
882
883
884

885
886
887
888
889
890
891

892
893
894
895
896
897
898
899
900
901
902
903
904

905
906
907
908
909
910
911
797
798
799
800
801
802
803

804
805
806
807

808
809
810
811

812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831

832
833
834
835

836
837
838
839
840

841
842
843
844
845
846
847

848
849
850
851
852
853
854
855
856
857
858
859
860

861
862
863
864
865
866
867
868







-
+



-
+



-
+



















-
+



-
+




-
+






-
+












-
+







test expr-21.11 {non-numeric boolean literals} {expr !no   } 1
test expr-21.12 {non-numeric boolean literals} {expr !yes  } 0
test expr-21.13 {non-numeric boolean literals} -body {
    expr !truef
} -returnCodes error -match glob -result *
test expr-21.14 {non-numeric boolean literals} {
    list [catch {expr !"truef"} err] $err
} {1 {can't use non-numeric string "truef" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.15 {non-numeric boolean variables} {
    set v truef
    list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "truef" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.16 {non-numeric boolean variables} {
    set v "true "
    list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "true " as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.17 {non-numeric boolean variables} {
    set v "tru"
    list [catch {expr {!$v}} err] $err
} {0 0}
test expr-21.18 {non-numeric boolean variables} {
    set v "fal"
    list [catch {expr {!$v}} err] $err
} {0 1}
test expr-21.19 {non-numeric boolean variables} {
    set v "y"
    list [catch {expr {!$v}} err] $err
} {0 0}
test expr-21.20 {non-numeric boolean variables} {
    set v "of"
    list [catch {expr {!$v}} err] $err
} {0 1}
test expr-21.21 {non-numeric boolean variables} {
    set v "o"
    list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "o" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.22 {non-numeric boolean variables} {
    set v ""
    list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "" as operand of "!"}}
} {1 {can't use empty string as operand of "!"}}

# Test for non-numeric float handling.
test expr-22.1 {non-numeric floats} {
    list [catch {expr {NaN + 1}} msg] $msg
} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
} {1 {can't use non-numeric floating-point value as operand of "+"}}
test expr-22.2 {non-numeric floats} !ieeeFloatingPoint {
    list [catch {expr {Inf + 1}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "+"}}
test expr-22.3 {non-numeric floats} {
    set nan NaN
    list [catch {expr {$nan + 1}} msg] $msg
} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
} {1 {can't use non-numeric floating-point value as operand of "+"}}
test expr-22.4 {non-numeric floats} !ieeeFloatingPoint {
    set inf Inf
    list [catch {expr {$inf + 1}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "+"}}
test expr-22.5 {non-numeric floats} {
    list [catch {expr NaN} msg] $msg
} {1 {domain error: argument not in valid range}}
test expr-22.6 {non-numeric floats} !ieeeFloatingPoint {
    list [catch {expr Inf} msg] $msg
} {1 {floating-point value too large to represent}}
test expr-22.7 {non-numeric floats} {
    list [catch {expr {1 / NaN}} msg] $msg
} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}}
} {1 {can't use non-numeric floating-point value as operand of "/"}}
test expr-22.8 {non-numeric floats} !ieeeFloatingPoint {
    list [catch {expr {1 / Inf}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "/"}}
# Make sure [Bug 761471] stays fixed.
test expr-22.9 {non-numeric floats: shared object equality and NaN} {
    set x NaN
    expr {$x == $x}
933
934
935
936
937
938
939
940

941
942
943

944
945
946
947
948
949
950
890
891
892
893
894
895
896

897
898
899

900
901
902
903
904
905
906
907







-
+


-
+







    expr (-3-)**6
} -returnCodes error -match glob -result *
test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body {
    expr 2**x
} -returnCodes error -match glob -result *
test expr-23.9 {CompileExponentialExpr: runtime error} {
    list [catch {expr {24.0**"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "**"}}
} {1 {can't use non-numeric string as operand of "**"}}
test expr-23.10 {CompileExponentialExpr: runtime error} {
    list [catch {expr {"a"**2}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "**"}}
} {1 {can't use non-numeric string as operand of "**"}}
test expr-23.11 {CompileExponentialExpr: runtime error} {
    list [catch {expr {0**-1}} msg] $msg
} {1 {exponentiation of zero by negative power}}
test expr-23.12 {CompileExponentialExpr: runtime error} {
    list [catch {expr {0.0**-1.0}} msg] $msg
} {1 {exponentiation of zero by negative power}}
test expr-23.13 {CompileExponentialExpr: runtime error} {
1440
1441
1442
1443
1444
1445
1446
1447
1448


1449
1450
1451
1452
1453
1454
1455
1397
1398
1399
1400
1401
1402
1403


1404
1405
1406
1407
1408
1409
1410
1411
1412







-
-
+
+









# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0
test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0
test expr-24.5 {expr edge cases; shifting} {expr int(5<<32)} 21474836480
test expr-24.6 {expr edge cases; shifting} {expr int(5<<63)} 46116860184273879040
test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0

test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000

# List membership tests
5834
5835
5836
5837
5838
5839
5840









5841
5842

5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856

5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876

5877
5878
5879
5880
5881
5882
5883
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807

5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821

5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841

5842
5843
5844
5845
5846
5847
5848
5849







+
+
+
+
+
+
+
+
+

-
+













-
+



















-
+







} [expr (1<<63)-1]
test expr-32.5 {Bug 1585704} {
    expr (1<<32)%(1<<63)
} [expr 1<<32]
test expr-32.6 {Bug 1585704} {
    expr -(1<<32)%(1<<63)
} [expr (1<<63)-(1<<32)]
test expr-32.7 {bignum regression} {
    expr {0%(1<<63)}
} 0
test expr-32.8 {bignum regression} {
    expr {0%-(1<<63)}
} 0
test expr-32.9 {bignum regression} {
    expr {0%-(1+(1<<63))}
} 0

test expr-33.1 {parse largest long value} longIs32bit {
test expr-33.1 {parse largest long value} {
    set max_long_str 2147483647
    set max_long_hex "0x7FFFFFFF "

    # Convert to integer (long, not wide) internal rep
    set max_long 2147483647
    string is integer $max_long

    list \
        [expr {" $max_long_str "}] \
        [expr {$max_long_str + 0}] \
        [expr {$max_long + 0}] \
        [expr {2147483647 + 0}] \
        [expr {$max_long == $max_long_hex}] \
        [expr {int(2147483647 + 1) < 0}] \
        [expr {int(2147483647 + 1) > 0}] \

} {2147483647 2147483647 2147483647 2147483647 1 1}
test expr-33.2 {parse smallest long value} longIs32bit {
    set min_long_str -2147483648
    set min_long_hex "-0x80000000 "

    set min_long -2147483648
    # This will convert to integer (not wide) internal rep
    string is integer $min_long

    # Note: If the final expression returns 0 then the
    # expression literal is being promoted to a wide type
    # when it should be parsed as a long type.
    list \
        [expr {" $min_long_str "}] \
        [expr {$min_long_str + 0}] \
        [expr {$min_long + 0}] \
        [expr {-2147483648 + 0}] \
        [expr {$min_long == $min_long_hex}] \
        [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \
        [expr {int(-2147483648 - 1) == -0x80000001}] \

} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
test expr-33.3 {parse largest wide value} wideIs64bit {
    set max_wide_str 9223372036854775807
    set max_wide_hex "0x7FFFFFFFFFFFFFFF "

    # Convert to wide integer
5949
5950
5951
5952
5953
5954
5955
5956

5957
5958

5959
5960
5961
5962
5963


5964
5965
5966


5967
5968
5969
5970
5971
5972
5973
5915
5916
5917
5918
5919
5920
5921

5922
5923

5924
5925
5926
5927


5928
5929
5930


5931
5932
5933
5934
5935
5936
5937
5938
5939







-
+

-
+



-
-
+
+

-
-
+
+







} {-2}
test expr-34.11 {expr edge cases} {
    expr {$min / -2}
} {1073741824}
test expr-34.12 {expr edge cases} {
    expr {$min % -2}
} {0}
test expr-34.13 {expr edge cases} longIs32bit {
test expr-34.13 {expr edge cases} {
    expr {int($min / -1)}
} {-2147483648}
} {2147483648}
test expr-34.14 {expr edge cases} {
    expr {$min % -1}
} {0}
test expr-34.15 {expr edge cases} longIs32bit {
    expr {int($min * -1)}
test expr-34.15 {expr edge cases} {
    expr {-int($min * -1)}
} $min
test expr-34.16 {expr edge cases} longIs32bit {
    expr {int(-$min)}
test expr-34.16 {expr edge cases} {
    expr {-int(-$min)}
} $min
test expr-34.17 {expr edge cases} {
    expr {$min / 1}
} $min
test expr-34.18 {expr edge cases} {
    expr {$min % 1}
} {0}
6746
6747
6748
6749
6750
6751
6752
6753
6754


6755
6756
6757
6758
6759
6760
6761
6712
6713
6714
6715
6716
6717
6718


6719
6720
6721
6722
6723
6724
6725
6726
6727







-
-
+
+







	list [catch {testexprlongobj 0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -0x80000000
} {This is a result: -2147483648}
test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -0xffffffff
} {This is a result: 1}
    testexprlongobj -0x7fffffff
} {This is a result: -2147483647}
test expr-39.10 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj -0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
6772
6773
6774
6775
6776
6777
6778
6779
6780


6781
6782
6783
6784
6785
6786
6787
6738
6739
6740
6741
6742
6743
6744


6745
6746
6747
6748
6749
6750
6751
6752
6753







-
-
+
+







	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -4294967295.
} {This is a result: 1}
    testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.16 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
7182
7183
7184
7185
7186
7187
7188









7189
7190
7191
7192
7193
7194
7195
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
7169
7170







+
+
+
+
+
+
+
+
+







test expr-50.1 {test sqrt() of bignums with non-Inf answer} {
    expr {sqrt("1[string repeat 0 616]") == 1e308}
} 1

test expr-51.1 {test round-to-even on input} {
    expr 6.9294956446009195e15
} 6929495644600920.0

test expr-52.1 {
	comparison with empty string does not generate string representation
} {
	set a [list one two three]
	list [expr {$a eq {}}] [expr {$a < {}}] [expr {$a > {}}] [
		string match {*no string representation*} [
		::tcl::unsupported::representation $a]]
} {0 0 1 1}



# cleanup
if {[info exists a]} {
    unset a
}

Changes to tests/fCmd.test.

61
62
63
64
65
66
67
68

69
70
71
72
73
74
75
76
77
78
79

80
81
82
83
84
85
86
61
62
63
64
65
66
67

68

69
70
71
72
73
74
75
76
77

78
79
80
81
82
83
84
85







-
+
-









-
+







    if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
    }
}

# Also used in winFCmd...
if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]
    if {$::tcl_platform(osVersion) >= 5.0} {
    if {$major > 5} {
	testConstraint winVista 1
    } else {
	testConstraint winXP 1
    }
}

testConstraint darwin9 [expr {
    [testConstraint unix]
    && $tcl_platform(os) eq "Darwin"
    && [package vsatisfies 1.$tcl_platform(osVersion) 1.9]
    && [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]
}]
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]

testConstraint fileSharing 0
testConstraint notFileSharing 1
testConstraint linkFile 1
testConstraint linkDirectory 1
2303
2304
2305
2306
2307
2308
2309
2310

2311
2312
2313
2314
2315
2316
2317
2302
2303
2304
2305
2306
2307
2308

2309
2310
2311
2312
2313
2314
2315
2316







-
+







    file attributes foo.tmp {*}[lrange $attrs 0 3]
} -cleanup {
    file delete -force -- foo.tmp
} -result {}

if {
    [testConstraint win] &&
    ([string index $tcl_platform(osVersion) 0] < 5
    ($::tcl_platform(osVersion) < 5.0
     || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
} then {
    testConstraint linkDirectory 0
    testConstraint linkFile 0
}

test fCmd-28.1 {file link} -returnCodes error -body {

Changes to tests/fileName.test.

19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
19
20
21
22
23
24
25

26
27
28
29
30
31
32
33







-
+







catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
    if {[string index $tcl_platform(osVersion) 0] < 5 \
    if {$::tcl_platform(osVersion) < 5.0 \
	    || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
	testConstraint linkDirectory 0
    }
    testConstraint symbolicLinkFile 0
    testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
}
# This match compares the first two words of the result. If the wanted result
774
775
776
777
778
779
780


781
782
783
784
785
786
787
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789







+
+







    glob ~\\/globTest
} [list [file join $env(HOME) globTest]]
test filename-11.16 {Tcl_GlobCmd} {
    glob globTest
} {globTest}
set globname "globTest"
set horribleglobname "glob\[\{Test"
set tildeglobname "./~test.txt"

test filename-11.17 {Tcl_GlobCmd} {unix} {
    lsort [glob -directory $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
913
914
915
916
917
918
919
920
921

922
923
924



925
926
927
928
929
930
931
915
916
917
918
919
920
921


922

923
924
925
926
927
928
929
930
931
932
933
934







-
-
+
-


+
+
+







    touch {[tcl].testremains}
    lsort [glob -path {[tcl]} *]
} -cleanup {
    file delete -force {[tcl].testremains}
} -result {{[tcl].testremains}}
# Get rid of file/dir if it exists, since it will have been left behind by a
# previous failed run.
if {[file exists $horribleglobname]} {
    file delete -force $horribleglobname
file delete -force $horribleglobname
}
file rename globTest $horribleglobname
set globname $horribleglobname
file delete -force $tildeglobname
close [open $tildeglobname w]

test filename-11.22 {Tcl_GlobCmd} {unix} {
    lsort [glob -dir $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
1036
1037
1038
1039
1040
1041
1042


1043

1044
1045
1046
1047
1048
1049
1050
1039
1040
1041
1042
1043
1044
1045
1046
1047

1048
1049
1050
1051
1052
1053
1054
1055







+
+
-
+







} -match compareWords -result equal
test filename-11.41 {Tcl_GlobCmd} -body {
    list [glob -dir [pwd] -tails *] [glob -dir [pwd] *]
} -match compareWords -result "not equal"
test filename-11.42 {Tcl_GlobCmd} -body {
    set res [list]
    foreach f [glob -dir [pwd] *] {
	set f [file tail $f]
	regsub {^./} $f {} f; # until glob bug [2511011fff] don't fixed (tilde expansion prevention).
	lappend res [file tail $f]
	lappend res $f
    }
    list $res [glob *]
} -match compareWords -result equal
test filename-11.43 {Tcl_GlobCmd} -returnCodes error -body {
    glob -t *
} -result {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
test filename-11.44 {Tcl_GlobCmd} -returnCodes error -body {
1076
1077
1078
1079
1080
1081
1082

1083
1084

1085
1086
1087
1088
1089
1090
1091
1081
1082
1083
1084
1085
1086
1087
1088
1089

1090
1091
1092
1093
1094
1095
1096
1097







+

-
+







    glob -types abcde -dir foo -join * *
} -result {bad argument to "-types": abcde}
test filename-11.49 {Tcl_GlobCmd} -returnCodes error -body {
    glob -types abcde -path foo -join * *
} -result {bad argument to "-types": abcde}

file rename $horribleglobname globTest
file delete -force $tildeglobname
set globname globTest
unset horribleglobname
unset horribleglobname tildeglobname

test filename-12.1 {simple globbing} {unixOrPc} {
    glob {}
} {.}
test filename-12.1.1 {simple globbing} -constraints {unixOrPc} -body {
    glob -types f {}
} -returnCodes error -result {no files matched glob pattern ""}

Changes to tests/fileSystem.test.

260
261
262
263
264
265
266






267
268
269
270
271
272
273
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279







+
+
+
+
+
+







file delete -force [file join dir.dir dirinside.link]
removeFile [file join dir.dir inside.file]
removeDirectory [file join dir.dir dirinside.dir]
removeDirectory dir.dir
test filesystem-1.30 {normalisation of nonexistent user} -body {
    file normalize ~noonewiththisname
} -returnCodes error -result {user "noonewiththisname" doesn't exist}
test filesystem-1.30.1 {normalisation of existing user} -body {
    catch {file normalize ~$::tcl_platform(user)}
} -result {0}
test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} -body {
    file normalize ~nonexistentuser@nonexistentdomain
} -returnCodes error -result {user "nonexistentuser@nonexistentdomain" doesn't exist}
test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /foo/../bar
} {/bar}
test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /../bar
373
374
375
376
377
378
379
















380
381
382
383
384
385
386
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    file join $x bar
} -result /foo/bar
test filesystem-1.52.1 {bug f9f390d0fa: file join where strep is not canonical} -body {
    set x //foo
    file normalize $x
    file join $x
} -result /foo
test filesystem-1.53 {[Bug 3559678] - normalize when tail is empty} {
  string match */ [file normalize [lindex [glob -dir [pwd] {{}}] 0]]
} 0
test filesystem-1.54 {[Bug ce3a211dcb] - normalize when tail is empty} -setup {
    set save [pwd]
    cd [set home [makeDirectory ce3a211dcb]]
    makeDirectory A $home
    cd [lindex [glob */] 0]
} -body {
    string match */A [pwd]
} -cleanup {
    cd $home
    removeDirectory A $home
    cd $save
    removeDirectory ce3a211dcb
} -result 1

test filesystem-2.0 {new native path} {unix} {
   foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
       catch {file readlink $f}
   }
   # If we reach here we've succeeded. We used to crash above.
   return ok

Changes to tests/foreach.test.

208
209
210
211
212
213
214
215

216
217
218
219
220
221
222



223
224
225
226
227
228
229
208
209
210
211
212
213
214

215
216
217
218
219
220
221

222
223
224
225
226
227
228
229
230
231







-
+






-
+
+
+







} {a b}
test foreach-6.3 {break tests} {catch {break foo} msg} 1
test foreach-6.4 {break tests} {
    catch {break foo} msg
    set msg
} {wrong # args: should be "break"}
# Check for bug #406709
test foreach-6.5 {break tests} {
test foreach-6.5 {break tests} -body {
    proc a {} {
	set a 1
	foreach b b {list [concat a; break]; incr a}
	incr a
    }
    a
} {2}
} -cleanup {
    rename a {}
} -result {2}

# Test for incorrect "double evaluation" semantics
test foreach-7.1 {delayed substitution of body} {
    proc foo {} {
       set a 0
       foreach a [list 1 2 3] "
           set x $a

Changes to tests/format.test.

12
13
14
15
16
17
18
19
20
21



22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
12
13
14
15
16
17
18



19
20
21


22
23
24
25
26
27
28

29
30
31
32
33
34
35
36







-
-
-
+
+
+
-
-







-
+








if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# %u output depends on word length, so this test is not portable.
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]

test format-1.1 {integer formatting} {
    format "%*d %d %d %d" 6 34 16923 -12 -1
} {    34 16923 -12 -1}
test format-1.2 {integer formatting} {
    format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
} {   6   34 16923  -12 -1 0xe 0XC}
} {   6   34 16923  -12 -1 0xe 0xC}
test format-1.3 {integer formatting} longIs32bit {
    format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0
} {   6   34 16923 4294967284 -1 0}
test format-1.3.1 {integer formatting} longIs64bit {
    format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0
} {   6   34 16923 18446744073709551604 -1 0}
test format-1.4 {integer formatting} {
50
51
52
53
54
55
56
57

58
59
60

61
62
63

64
65
66

67
68
69

70
71
72

73
74
75

76
77
78

79
80
81

82
83
84


85
86
87


88
89
90


91
92
93
94
95
96
97
48
49
50
51
52
53
54

55
56
57

58
59
60

61
62
63

64
65
66

67
68
69

70
71
72

73
74
75

76
77
78

79
80


81
82
83


84
85
86


87
88
89
90
91
92
93
94
95







-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+

-
-
+
+

-
-
+
+

-
-
+
+







    format "%4x %4x %4x %4x" 6 34 16923 -12 -1
} {   6   22 421b fffffff4}
test format-1.7.1 {integer formatting} longIs64bit {
    format "%4x %4x %4x %4x" 6 34 16923 -12 -1
} {   6   22 421b fffffffffffffff4}
test format-1.8 {integer formatting} longIs32bit {
    format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1
} {0x0 0x6 0X22 0X421B 0xfffffff4}
} {0 0x6 0x22 0x421B 0xfffffff4}
test format-1.8.1 {integer formatting} longIs64bit {
    format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1
} {0x0 0x6 0X22 0X421B 0xfffffffffffffff4}
} {0 0x6 0x22 0x421B 0xfffffffffffffff4}
test format-1.9 {integer formatting} longIs32bit {
    format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1
} {  0x0                  0x6                 0x22               0x421b           0xfffffff4}
} {    0                  0x6                 0x22               0x421b           0xfffffff4}
test format-1.9.1 {integer formatting} longIs64bit {
    format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1
} {  0x0                  0x6                 0x22               0x421b   0xfffffffffffffff4}
} {    0                  0x6                 0x22               0x421b   0xfffffffffffffff4}
test format-1.10 {integer formatting} longIs32bit {
    format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1
} {0x0   0x6                  0x22                 0x421b               0xfffffff4          }
} {0     0x6                  0x22                 0x421b               0xfffffff4          }
test format-1.10.1 {integer formatting} longIs64bit {
    format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1
} {0x0   0x6                  0x22                 0x421b               0xfffffffffffffff4  }
} {0     0x6                  0x22                 0x421b               0xfffffffffffffff4  }
test format-1.11 {integer formatting} longIs32bit {
    format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1
} {0     06                   042                  041033               037777777764        }
} {0     0o6                  0o42                 0o41033              0o37777777764       }
test format-1.11.1 {integer formatting} longIs64bit {
    format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1
} {0     06                   042                  041033               01777777777777777777764}
} {0     0o6                  0o42                 0o41033              0o1777777777777777777764}
test format-1.12 {integer formatting} {
    format "%b %#b %#b %llb" 5 0 5 [expr {2**100}]
} {101 0b0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
} {101 0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
test format-1.13 {integer formatting} {
    format "%#d %#d %#d %#d %#d" 0 6 34 16923 -12 -1
} {0d0 0d6 0d34 0d16923 -0d12}
    format "%#0d %#0d %#0d %#0d %#0d" 0 6 34 16923 -12 -1
} {0 0d6 0d34 0d16923 -0d12}
test format-1.14 {integer formatting} {
    format "%#5d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1
} {  0d0                  0d6                 0d34              0d16923                -0d12}
    format "%#05d %#020d %#020d %#020d %#020d" 0 6 34 16923 -12 -1
} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012}
test format-1.15 {integer formatting} {
    format "%-#5d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1
} {0d0   0d6                  0d34                 0d16923              -0d12               }
    format "%-#05d %-#020d %-#020d %-#020d %-#020d" 0 6 34 16923 -12 -1
} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012}


test format-2.1 {string formatting} {
    format "%s %s %c %s" abcd {This is a very long test string.} 120 x
} {abcd This is a very long test string. x x}
test format-2.2 {string formatting} {
    format "%20s %20s %20c %20s" abcd {This is a very long test string.} 120 x
543
544
545
546
547
548
549
550

551
552
553
554
555
556
557
558
559
560
561
562
563
564

565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583

584
585
586
587
588
589
590
591
592
593
594
595
596
597
598














599
600
601
602
603
604
605
541
542
543
544
545
546
547

548
549
550
551
552
553
554
555
556
557
558
559
560
561

562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580

581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617







-
+













-
+


















-
+















+
+
+
+
+
+
+
+
+
+
+
+
+
+







for {set i 290} {$i < 400} {incr i} {
    test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
        format {%s} $b
    } $b
    append b "x"
}

test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} {
test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} {
    format %d 7810179016327718216
} 1819043144
test format-17.2 {testing %ld with wide} {wideIs64bit} {
    format %ld 7810179016327718216
} 7810179016327718216
test format-17.3 {testing %ld with non-wide} {wideIs64bit} {
    format %ld 42
} 42
test format-17.4 {testing %l with non-integer} {
    format %lf 1
} 1.000000
test format-17.5 {testing %llu with positive bignum} -body {
    format %llu 0xabcdef0123456789abcdef
} -returnCodes 1 -result {unsigned bignum format is invalid}
} -result 207698809136909011942886895
test format-17.6 {testing %llu with negative number} -body {
    format %llu -1
} -returnCodes 1 -result {unsigned bignum format is invalid}

test format-18.1 {do not demote existing numeric values} {
    set a 0xaaaaaaaa
    # Ensure $a and $b are separate objects
    set b 0xaaaa
    append b aaaa
    set result [expr {$a == $b}]
    format %08lx $b
    lappend result [expr {$a == $b}]
    set b 0xaaaa
    append b aaaa
    lappend result [expr {$a == $b}]
    format %08x $b
    lappend result [expr {$a == $b}]
} {1 1 1 1}
test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} {
test format-18.2 {do not demote existing numeric values} {longIs32bit wideIs64bit} {
    set a [expr {0xaaaaaaaaaa + 1}]
    set b 0xaaaaaaaaab
    list [format %08x $a] [expr {$a == $b}]
} {aaaaaaab 1}

test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body {
    set x 0x8fedc654
    list [expr { ~ $x }] [format %08x [expr { ~$x }]]
} -match regexp -result {-2414724693 f*701239ab}
test format-19.2 {Bug 1867855} {
    format %llx 0
} 0
test format-19.3 {Bug 2830354} {
    string length [format %340f 0]
} 340

test format-19.4.1 {Bug d498578df4: width overflow should cause limit exceeded} \
-constraints {longIs32bit} -body {
    # in case of overflow into negative, it produces width -2 (and limit exceeded),
    # in case of width will be unsigned, it will be outside limit (2GB for 32bit)...
    # and it don't throw an error in case the bug is not fixed (and probably no segfault).
    format %[expr {0xffffffff - 1}]g 0
} -returnCodes error -result "max size for a Tcl value exceeded"

test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded} -body {
    # limit should exceeds in any case,
    # and it don't throw an error in case the bug is not fixed (and probably no segfault).
    format %[expr {0xffffffffffffffff - 1}]g 0
} -returnCodes error -result "max size for a Tcl value exceeded"

# Note that this test may fail in future versions
test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
    set x [dict create a b c d]
    format %s $x
    # After this, obj in $x should be a dict
    # We are testing to make sure it has not been shimmered to a

Changes to tests/get.test.

16
17
18
19
20
21
22
23
24


25
26
27
28
29
30
31
16
17
18
19
20
21
22


23
24
25
26
27
28
29
30
31







-
-
+
+







}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testgetint [llength [info commands testgetint]]
testConstraint testdoubleobj [llength [info commands testdoubleobj]]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

test get-1.1 {Tcl_GetInt procedure} testgetint {
    testgetint 44 { 	  22}
} {66}
test get-1.2 {Tcl_GetInt procedure} testgetint {
    testgetint 44 -3
} {41}
41
42
43
44
45
46
47
48
49


50
51
52


53
54
55


56
57
58
59
60
61
62
63
64
65
66
67

68
69
70
71
72
73
74
41
42
43
44
45
46
47


48
49
50


51
52
53


54
55
56
57
58
59
60
61
62
63
64
65
66

67
68
69
70
71
72
73
74







-
-
+
+

-
-
+
+

-
-
+
+











-
+







test get-1.6 {Tcl_GetInt procedure} testgetint {
    list [catch {testgetint 44 {16	 x}} msg] $msg
} {1 {expected integer but got "16	 x"}}
test get-1.7 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint 44 18446744073709551616} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.8 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint 18446744073709551614} msg] $msg
} {0 -2}
    testgetint 18446744073709551614
} {-2}
test get-1.9 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint +18446744073709551614} msg] $msg
} {0 -2}
    testgetint +18446744073709551614
} {-2}
test get-1.10 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint -18446744073709551614} msg] $msg
} {0 2}
    list [catch {testgetint -18446744073709551614} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.11 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint 44 4294967296} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.12 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint 4294967294} msg] $msg
} {0 -2}
test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint +4294967294} msg] $msg
} {0 -2}
test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint -4294967294} msg] $msg
} {0 2}
} {1 {integer value too large to represent}}

test get-2.1 {Tcl_GetInt procedure} {
    format %g 1.23
} {1.23}
test get-2.2 {Tcl_GetInt procedure} {
    format %g { 	 1.23 	}
} {1.23}
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
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







-
+



-
+

-
+



-
+








    foreach num $numbers {
	lappend result [catch {format %g $num} msg] $msg
    }
    set result
} {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}}
# Bug 7114ac6141
test get-3.3 {tcl_GetInt with iffy numbers} testgetint {
    lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} {
    lmap x {0 " 0" "0 " " 0 " " 0xa " " 007 " " 0o10 " " 0b10 "} {
	catch {testgetint 44 $x} x
	set x
    }
} {44 44 44 44 54 54 52 46}
} {44 44 44 44 54 51 52 46}
test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj {
    lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} {
    lmap x {0 0.0 " .0" ".0 " " 0e0 " "07" "- 0" "-0" "0o12" "0b10"} {
	catch {testdoubleobj set 1 $x} x
	set x
    }
} {0.0 0.0 0.0 0.0 0.0 9.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0}
} {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/http.test.

78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

101
102
103

104
105
106
107
108
109
110
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92
93
94
95
96
97
98
99

100
101
102

103
104
105
106
107
108
109
110







-
+














-
+


-
+







	return
    }
}

test http-1.1 {http::config} {
    http::config -useragent UserAgent
    http::config
} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"]
} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
test http-1.2 {http::config} {
    http::config -proxyfilter
} http::ProxyRequired
test http-1.3 {http::config} {
    catch {http::config -junk}
} 1
test http-1.4 {http::config} {
    set savedconf [http::config]
    http::config -proxyhost nowhere.come -proxyport 8080 \
	-proxyfilter myFilter -useragent "Tcl Test Suite" \
	-urlencoding iso8859-1
    set x [http::config]
    http::config {*}$savedconf
    set x
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
} {-accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1}
test http-1.5 {http::config} -returnCodes error -body {
    http::config -proxyhost {} -junk 8080
} -result {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}
} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
test http-1.6 {http::config} -setup {
    set oldenc [http::config -urlencoding]
} -body {
    set enc [list [http::config -urlencoding]]
    http::config -urlencoding iso8859-1
    lappend enc [http::config -urlencoding]
} -cleanup {
665
666
667
668
669
670
671





























































































































































































































































































































































































































































672
673
674
675
676
677
678
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    # this would be reverting to http <=2.4 behavior w/o errors
    # (unknown chars become '?')
    http::config -urlencoding "iso8859-1"
    http::mapReply "\u2208"
} -cleanup {
    http::config -urlencoding $enc
} -result {%3F}

package require -exact tcl::idna 1.0

test http-idna-1.1 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna
} -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"}
test http-idna-1.2 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna ?
} -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version}
test http-idna-1.3 {IDNA package: basics} -body {
    ::tcl::idna version
} -result 1.0
test http-idna-1.4 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna version what
} -result {wrong # args: should be "::tcl::idna version"}
test http-idna-1.5 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny
} -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"}
test http-idna-1.6 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny ?
} -result {unknown or ambiguous subcommand "?": must be decode, or encode}
test http-idna-1.7 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny encode
} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"}
test http-idna-1.8 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny encode a b c
} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"}
test http-idna-1.9 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny decode
} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"}
test http-idna-1.10 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny decode a b c
} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"}
test http-idna-1.11 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna decode
} -result {wrong # args: should be "::tcl::idna decode hostname"}
test http-idna-1.12 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna encode
} -result {wrong # args: should be "::tcl::idna encode hostname"}

test http-idna-2.1 {puny encode: functional test} {
    ::tcl::idna puny encode abc
} abc-
test http-idna-2.2 {puny encode: functional test} {
    ::tcl::idna puny encode a\u20acb\u20acc
} abc-k50ab
test http-idna-2.3 {puny encode: functional test} {
    ::tcl::idna puny encode ABC
} ABC-
test http-idna-2.4 {puny encode: functional test} {
    ::tcl::idna puny encode A\u20ACB\u20ACC
} ABC-k50ab
test http-idna-2.5 {puny encode: functional test} {
    ::tcl::idna puny encode ABC 0
} abc-
test http-idna-2.6 {puny encode: functional test} {
    ::tcl::idna puny encode A\u20ACB\u20ACC 0
} abc-k50ab
test http-idna-2.7 {puny encode: functional test} {
    ::tcl::idna puny encode ABC 1
} ABC-
test http-idna-2.8 {puny encode: functional test} {
    ::tcl::idna puny encode A\u20ACB\u20ACC 1
} ABC-k50ab
test http-idna-2.9 {puny encode: functional test} {
    ::tcl::idna puny encode abc 0
} abc-
test http-idna-2.10 {puny encode: functional test} {
    ::tcl::idna puny encode a\u20ACb\u20ACc 0
} abc-k50ab
test http-idna-2.11 {puny encode: functional test} {
    ::tcl::idna puny encode abc 1
} ABC-
test http-idna-2.12 {puny encode: functional test} {
    ::tcl::idna puny encode a\u20ACb\u20ACc 1
} ABC-k50ab
test http-idna-2.13 {puny encode: edge cases} {
    ::tcl::idna puny encode ""
} ""
test http-idna-2.14-A {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644
	u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F
    }]] ""]
} egbpdaj6bu4bxfgehfvwxn
test http-idna-2.14-B {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587
    }]] ""]
} ihqwcrb4cv8a8dqg056pqjye
test http-idna-2.14-C {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587
    }]] ""]
} ihqwctvzc91f659drss3x8bo0yb
test http-idna-2.14-D {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074
	u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D
	u+0065 u+0073 u+006B u+0079
    }]] ""]
} Proprostnemluvesky-uyb24dma41a
test http-idna-2.14-E {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8
	u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2
	u+05D1 u+05E8 u+05D9 u+05EA
    }]] ""]
} 4dbcagdahymbxekheh6e0a7fei0b
test http-idna-2.14-F {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D
	u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939
	u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947
	u+0939 u+0948 u+0902
    }]] ""]
} i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd
test http-idna-2.14-G {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092
	u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B
    }]] ""]
} n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa
test http-idna-2.14-H {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
	u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
	u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
    }]] ""]
} 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c
test http-idna-2.14-I {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E
	u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440
	u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A
	u+0438
    }]] ""]
} b1abfaaepdrnnbgefbadotcwatmq2g4l
test http-idna-2.14-J {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070
	u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070
	u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061
	u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070
	u+0061 u+00F1 u+006F u+006C
    }]] ""]
} PorqunopuedensimplementehablarenEspaol-fmd56a
test http-idna-2.14-K {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B
	u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068
	u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067
	u+0056 u+0069 u+1EC7 u+0074
    }]] ""]
} TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g
test http-idna-2.14-L {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F
    }]] ""]
} 3B-ww4c5e180e575a65lsy2b
test http-idna-2.14-M {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074
	u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D
	u+004F u+004E u+004B u+0045 u+0059 u+0053
    }]] ""]
} -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n
test http-idna-2.14-N {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F
	u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D
	u+305D u+308C u+305E u+308C u+306E u+5834 u+6240
    }]] ""]
} Hello-Another-Way--fc4qua05auwb3674vfr0b
test http-idna-2.14-O {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032
    }]] ""]
} 2-u9tlzr9756bt3uc0v
test http-idna-2.14-P {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059
	u+308B u+0035 u+79D2 u+524D
    }]] ""]
} MajiKoi5-783gue6qz075azm5e
test http-idna-2.14-Q {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0
    }]] ""]
} de-jg4avhby1noc0d
test http-idna-2.14-R {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067
    }]] ""]
} d9juau41awczczp
test http-idna-2.14-S {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode {-> $1.00 <-}
} {-> $1.00 <--}

test http-idna-3.1 {puny decode: functional test} {
    ::tcl::idna puny decode abc-
} abc
test http-idna-3.2 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab
} a\u20acb\u20acc
test http-idna-3.3 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-
} ABC
test http-idna-3.4 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-k50ab
} A\u20ACB\u20ACC
test http-idna-3.5 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB
} A\u20ACB\u20ACC
test http-idna-3.6 {puny decode: functional test} {
    ::tcl::idna puny decode abc-K50AB
} a\u20ACb\u20ACc
test http-idna-3.7 {puny decode: functional test} {
    ::tcl::idna puny decode ABC- 0
} abc
test http-idna-3.8 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB 0
} a\u20ACb\u20ACc
test http-idna-3.9 {puny decode: functional test} {
    ::tcl::idna puny decode ABC- 1
} ABC
test http-idna-3.10 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB 1
} A\u20ACB\u20ACC
test http-idna-3.11 {puny decode: functional test} {
    ::tcl::idna puny decode abc- 0
} abc
test http-idna-3.12 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab 0
} a\u20ACb\u20ACc
test http-idna-3.13 {puny decode: functional test} {
    ::tcl::idna puny decode abc- 1
} ABC
test http-idna-3.14 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab 1
} A\u20ACB\u20ACC
test http-idna-3.15 {puny decode: edge cases and errors} {
    # Is this case actually correct?
    binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]]
} c282c281c280
test http-idna-3.16 {puny decode: edge cases and errors} -returnCodes error -body {
    ::tcl::idna puny decode abc!
} -result {bad decode character "!"}
test http-idna-3.17 {puny decode: edge cases and errors} {
    catch {::tcl::idna puny decode abc!} -> opt
    dict get $opt -errorcode
} {PUNYCODE BAD_INPUT CHAR}
test http-idna-3.18 {puny decode: edge cases and errors} {
    ::tcl::idna puny decode ""
} {}
# A helper so we don't get lots of crap in failures
proc hexify s {lmap c [split $s ""] {format u+%04X [scan $c %c]}}
test http-idna-3.19-A {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode egbpdaj6bu4bxfgehfvwxn]
} [list {*}{
    u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644
    u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F
}]
test http-idna-3.19-B {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode ihqwcrb4cv8a8dqg056pqjye]
} {u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587}
test http-idna-3.19-C {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode ihqwctvzc91f659drss3x8bo0yb]
} {u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587}
test http-idna-3.19-D {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode Proprostnemluvesky-uyb24dma41a]
} [list {*}{
    u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074
    u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D
    u+0065 u+0073 u+006B u+0079
}]
test http-idna-3.19-E {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode 4dbcagdahymbxekheh6e0a7fei0b]
} [list {*}{
    u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8
    u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2
    u+05D1 u+05E8 u+05D9 u+05EA
}]
test http-idna-3.19-F {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd]
} [list {*}{
    u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D
    u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939
    u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947
    u+0939 u+0948 u+0902
}]
test http-idna-3.19-G {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa]
} [list {*}{
    u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092
    u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B
}]
test http-idna-3.19-H {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c]
} [list {*}{
    u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
    u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
    u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
}]
test http-idna-3.19-I {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode b1abfaaepdrnnbgefbadotcwatmq2g4l]
} [list {*}{
    u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E
    u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440
    u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A
    u+0438
}]
test http-idna-3.19-J {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	PorqunopuedensimplementehablarenEspaol-fmd56a]
} [list {*}{
    u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070
    u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070
    u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061
    u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070
    u+0061 u+00F1 u+006F u+006C
}]
test http-idna-3.19-K {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g]
} [list {*}{
    u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B
    u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068
    u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067
    u+0056 u+0069 u+1EC7 u+0074
}]
test http-idna-3.19-L {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode 3B-ww4c5e180e575a65lsy2b]
} {u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F}
test http-idna-3.19-M {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n]
} [list {*}{
    u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074
    u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D
    u+004F u+004E u+004B u+0045 u+0059 u+0053
}]
test http-idna-3.19-N {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode Hello-Another-Way--fc4qua05auwb3674vfr0b]
} [list {*}{
    u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F
    u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D
    u+305D u+308C u+305E u+308C u+306E u+5834 u+6240
}]
test http-idna-3.19-O {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode 2-u9tlzr9756bt3uc0v]
} {u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032}
test http-idna-3.19-P {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode MajiKoi5-783gue6qz075azm5e]
} [list {*}{
    u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059
    u+308B u+0035 u+79D2 u+524D
}]
test http-idna-3.19-Q {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode de-jg4avhby1noc0d]
} {u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0}
test http-idna-3.19-R {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode d9juau41awczczp]
} {u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067}
test http-idna-3.19-S {puny decode: examples from RFC 3492} {
    ::tcl::idna puny decode {-> $1.00 <--}
} {-> $1.00 <-}
rename hexify ""

test http-idna-4.1 {IDNA encoding} {
    ::tcl::idna encode abc.def
} abc.def
test http-idna-4.2 {IDNA encoding} {
    ::tcl::idna encode a\u20acb\u20acc.def
} xn--abc-k50ab.def
test http-idna-4.3 {IDNA encoding} {
    ::tcl::idna encode def.a\u20acb\u20acc
} def.xn--abc-k50ab
test http-idna-4.4 {IDNA encoding} {
    ::tcl::idna encode ABC.DEF
} ABC.DEF
test http-idna-4.5 {IDNA encoding} {
    ::tcl::idna encode A\u20acB\u20acC.def
} xn--ABC-k50ab.def
test http-idna-4.6 {IDNA encoding: invalid edge case} {
    # Should this be an error?
    ::tcl::idna encode abc..def
} abc..def
test http-idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body {
    ::tcl::idna encode abc.$.def
} -result {bad character "$" in DNS name}
test http-idna-4.7.1 {IDNA encoding: invalid char} {
    catch {::tcl::idna encode abc.$.def} -> opt
    dict get $opt -errorcode
} {IDNA INVALID_NAME_CHARACTER {$}}
test http-idna-4.8 {IDNA encoding: empty} {
    ::tcl::idna encode ""
} {}
set overlong www.[join [subst [string map {u+ \\u} {
    u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
    u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
    u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
}]] ""].com
test http-idna-4.9 {IDNA encoding: max lengths from RFC 5890} -body {
    ::tcl::idna encode $overlong
} -returnCodes error -result "hostname part too long"
test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} {
    catch {::tcl::idna encode $overlong} -> opt
    dict get $opt -errorcode
} {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c}
unset overlong
test http-idna-4.10 {IDNA encoding: edge cases} {
    ::tcl::idna encode pass\u00e9.example.com
} xn--pass-epa.example.com

test http-idna-5.1 {IDNA decoding} {
    ::tcl::idna decode abc.def
} abc.def
test http-idna-5.2 {IDNA decoding} {
    # Invalid entry that's just a wrapper
    ::tcl::idna decode xn--abc-.def
} abc.def
test http-idna-5.3 {IDNA decoding} {
    # Invalid entry that's just a wrapper
    ::tcl::idna decode xn--abc-.xn--def-
} abc.def
test http-idna-5.4 {IDNA decoding} {
    # Invalid entry that's just a wrapper
    ::tcl::idna decode XN--abc-.XN--def-
} abc.def
test http-idna-5.5 {IDNA decoding: error cases} -returnCodes error -body {
    ::tcl::idna decode xn--$$$.example.com
} -result {bad decode character "$"}
test http-idna-5.5.1 {IDNA decoding: error cases} {
    catch {::tcl::idna decode xn--$$$.example.com} -> opt
    dict get $opt -errorcode
} {PUNYCODE BAD_INPUT CHAR}
test http-idna-5.6 {IDNA decoding: error cases} -returnCodes error -body {
    ::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def
} -result {exceeded input data}
test http-idna-5.6.1 {IDNA decoding: error cases} {
    catch {::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def} -> opt
    dict get $opt -errorcode
} {PUNYCODE BAD_INPUT LENGTH}

# cleanup
catch {unset url}
catch {unset badurl}
catch {unset port}
catch {unset data}
if {[info exists httpthread]} {

Changes to tests/http11.test.

511
512
513
514
515
516
517
518

519
520
521
522
523
524
525
526
527
528
511
512
513
514
515
516
517

518



519
520
521
522
523
524
525







-
+
-
-
-







# returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1

proc handler {var sock token} {
    upvar #0 $var data
    set chunk [read $sock]
    append data $chunk
    #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
    if {[eof $sock]} {
    return [string length $chunk]
        #::http::Log "handler eof $sock"
	chan event $sock readable {}
    }
}

test http11-3.0 "-handler,close,identity" -setup {
    variable httpd [create_httpd]
    set testdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
661
662
663
664
665
666
667







668
669
670
671
672
673
674
675
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679







+
+
+
+
+
+
+








    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 122880}

# -------------------------------------------------------------------------

# Eliminate valgrind "still reachable" reports on outstanding "Detached"
# structures in the detached list which stem from PipeClose2Proc not waiting
# around for background processes to complete, meaning that previous calls to
# Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
after 10
exec [info nameofexecutable] << {}

foreach p {create_httpd httpd_read halt_httpd meta check_crc} {
    if {[llength [info proc $p]]} {rename $p {}}
}
removeFile testdoc.html
unset -nocomplain httpd_port httpd p

::tcltest::cleanupTests

Added tests/httpPipeline.test.



































































































































































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# httpPipeline.test
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2
namespace import -force ::tcltest::*

package require http 2.8

set sourcedir [file normalize [file dirname [info script]]]
source [file join $sourcedir httpTest.tcl]
source [file join $sourcedir httpTestScript.tcl]

# ------------------------------------------------------------------------------
# (1) Define the test scripts that will be used to generate logs for analysis -
#     and also define the "correct" results.
# ------------------------------------------------------------------------------

proc ReturnTestScriptAndResult {ca cb delay te} {

    switch -- $ca {
	1     {set start {
	    START
	    KEEPALIVE 0
	    PIPELINE  0
	}}

	2     {set start {
	    START
	    KEEPALIVE 0
	    PIPELINE  1
	}}

	3     {set start {
	    START
	    KEEPALIVE 1
	    PIPELINE  0
	}}

	4     {set start {
	    START
	    KEEPALIVE 1
	    PIPELINE  1
	}}

	default {
	    return -code error {no matching script}
	}
    }

    set middle "
	    [list DELAY $delay]
    "

    switch -- $cb {
	1     {set end {
	    GET a
	    GET b
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 ? ? ?}
	    set resLong  {1 2 3 4}
	}

	2     {set end {
	    GET a
	    HEAD b
	    GET c
	    HEAD a
	    HEAD c
	    STOP
	    }
	    set resShort {1 ? ? ? ?}
	    set resLong  {1 2 3 4 5}
	}

	3     {set end {
	    HEAD a
	    GET b
	    HEAD c
	    HEAD b
	    GET a
	    GET b
	    STOP
	    }
	    set resShort {1 ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6}
	}

	4     {set end {
	    GET a
	    GET b
	    GET c
	    GET a
	    POST b address=home code=brief paid=yes
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? ? ? 5 ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	5     {set end {
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 3 4 5 6 7 8 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	6     {set end {
	    POST a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    GET a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 ? 3 ? ? 6 7 ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	7     {set end {
	    GET b address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    GET a address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 ? 4 ? ? 7 8 ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	8     {set end {
	    # Telling the server to close the connection.
	    GET a
	    GET b close=y
	    GET c
	    GET a
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? 3 ? ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	9     {set end {
	    # Telling the server to close the connection.
	    GET a
	    POST b close=y address=home code=brief paid=yes
	    GET c
	    GET a
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 2 3 ? ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	10     {set end {
	    # Telling the server to close the connection.
	    GET a
	    GET b close=y
	    POST c address=home code=brief paid=yes
	    GET a
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? 3 ? ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	11    {set end {
	    # Telling the server to close the connection twice.
	    GET a
	    GET b close=y
	    GET c
	    GET a
	    GET b close=y
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? 3 ? ? 6 ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	12    {set end {
	    # Telling the server to delay before sending the response.
	    GET a
	    GET b delay=1
	    GET c
	    GET a
	    GET b
	    STOP
	    }
	    set resShort {1 ? ? ? ?}
	    set resLong  {1 2 3 4 5}
	}

	13    {set end {
	    # Making the server close the connection (time out).
	    GET a
	    WAIT 2000
	    GET b
	    GET c
	    GET a
	    GET b
	    STOP
	    }
	    set resShort {1 2 ? ? ?}
	    set resLong  {1 2 3 4 5}
	}

	14    {set end {
	    # Making the server close the connection (time out) twice.
	    GET a
	    WAIT 2000
	    GET b
	    GET c
	    GET a
	    WAIT 2000
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 2 ? ? 5 ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	15    {set end {
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes close=y delay=1
	    POST c address=home code=brief paid=yes delay=1
	    POST a address=home code=brief paid=yes close=y
	    WAIT 2000
	    POST b address=home code=brief paid=yes delay=1
	    POST c address=home code=brief paid=yes close=y
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes close=y
	    POST c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 3 4 5 6 7 8 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	16    {set end {
	    POST a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes close=y
	    GET a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes close=y
	    POST c address=home code=brief paid=yes
	    WAIT 2000
	    POST a address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes close=y
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 ? 3 4 ? 6 7 ? 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	17    {set end {
	    GET b address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    GET a address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes close=y
	    GET b address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes close=y
	    POST c address=home code=brief paid=yes
	    WAIT 2000
	    POST a address=home code=brief paid=yes
	    WAIT 2000
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 3 4 5 ? 7 8 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}


	18    {set end {
	    REPOST 0
	    GET a
	    WAIT 2000
	    POST b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 2 ? ?}
	    set resLong  {1 2 3 4}
	    # resShort is overwritten below for the case ($te == 1).
	}


	19    {set end {
	    REPOST 0
	    GET a
	    WAIT 2000
	    GET b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 2 ? ?}
	    set resLong  {1 2 3 4}
	}


	20    {set end {
	    POSTFRESH 1
	    GET a
	    WAIT 2000
	    POST b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 3 ?}
	    set resLong  {1 3 4}
	}


	21    {set end {
	    POSTFRESH 1
	    GET a
	    WAIT 2000
	    GET b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 2 ? ?}
	    set resLong  {1 2 3 4}
	}

	22    {set end {
	    GET a
	    WAIT 2000
	    KEEPALIVE 0
	    POST b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 3 ?}
	    set resLong  {1 3 4}
	}


	23    {set end {
	    GET a
	    WAIT 2000
	    KEEPALIVE 0
	    GET b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 3 ?}
	    set resLong  {1 3 4}
	}

	24    {set end {
	    GET a
	    KEEPALIVE 0
	    POST b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 ? ?}
	    set resLong  {1 3 4}
	}


	25    {set end {
	    GET a
	    KEEPALIVE 0
	    GET b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 ? ?}
	    set resLong  {1 3 4}
	}

	default {
	    return -code error {no matching script}
	}
    }


    if {$ca < 3} {
	# Not Keep-Alive.
        set result "Passed all sanity checks."

    } elseif {$ca == 3} {
        # Keep-Alive, not pipelined.
        set result {}
        append result "Passed all sanity checks.\n"
        append result "Have overlaps including response body:\n"

    } else {
        # Keep-Alive, pipelined: ($ca == 4)
        set result {}
        append result "Passed all sanity checks.\n"
        append result "Overlap-free without response body:\n"
        append result "$resShort"
    }

    # - The special case of test *.18*-testEof needs test results to be
    #   individually written.
    # - These test -repost 0 when there is a POST to apply it to, and the server
    #   timeout has not been detected.
    if {($cb == 18) && ($te == 1)} {
        if {$ca < 3} {
	    # Not Keep-Alive.
	    set result "Passed all sanity checks."

	} elseif {$ca == 3 && $delay == 0} {
	    # Keep-Alive, not pipelined.
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|Wrong sequence for token ::http::3 - {A X X}
		|- and error(s) X
		|Wrong sequence for token ::http::4 - {A X X X}
		|- and error(s) X
		|
		|Have overlaps including response body:
		|
	    }]

	} elseif {$ca == 3} {
	    # Keep-Alive, not pipelined.
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|
		|Have overlaps including response body:
		|
	    }]

	} elseif {$delay == 0} {
	    # Keep-Alive, pipelined: ($ca == 4)
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|Wrong sequence for token ::http::3 - {A X X}
		|- and error(s) X
		|Wrong sequence for token ::http::4 - {A X X X}
		|- and error(s) X
		|
		|Overlap-free without response body:
		|
	    }]

	} else {
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|
		|Overlap-free without response body:
		|
	    }]

        }
    }

    return [list "$start$middle$end" $result]
}

# ------------------------------------------------------------------------------
#  Proc MakeMessage
# ------------------------------------------------------------------------------
# WHD's one-line command to generate multi-line strings from readable code.
#
# Example:
#   set blurb [MakeMessage {
#            |This command allows multi-line strings to be created with readable
#            |code, and without breaking the rules for indentation.
#            |
#            |The command shifts the entire block of text to the left, omitting
#            |the pipe character and the spaces to its left.
#   }]
# ------------------------------------------------------------------------------

proc MakeMessage {in} {
    regsub -all -line {^\s*\|} [string trim $in] {}
    # N.B. Implicit Return.
}


proc ReturnTestScript {ca cb delay te} {
    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
    return $script
}

proc ReturnTestResult {ca cb delay te} {
    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
    return $result
}


# ------------------------------------------------------------------------------
# (2) Command to run a test script and use httpTest to analyse the logs.
# ------------------------------------------------------------------------------

namespace import httpTestScript::runHttpTestScript
namespace import httpTestScript::cleanupHttpTestScript
namespace import httpTest::cleanupHttpTest
namespace import httpTest::logAnalyse
namespace import httpTest::setHttpTestOptions

proc RunTest {header footer delay te} {
    set num [runHttpTestScript [ReturnTestScript $header $footer $delay $te]]
    set skipOverlaps 0
    set notPiped    {}
    set notIncluded {}

    # --------------------------------------------------------------------------
    # Custom code for specific tests
    # --------------------------------------------------------------------------
    if {$header < 3} {
        set skipOverlaps 1
        for {set i 1} {$i <= $num} {incr i} {
	    lappend notPiped $i
        }
    } elseif {$header > 2 && $footer == 18 && $te == 1} {
        set skipOverlaps 1
        if {$delay == 0} {
	    # Transaction 1 is conventional.
	    # Check that transactions 2,3,4 are cancelled.
	    set notPiped {1}
	    set notIncluded $notPiped
        } else {
	    # Transaction 1 is conventional.
	    # Check that transaction 2 is cancelled.
	    # The timing of transactions 3 and 4 is uncertain.
	    set notPiped {1 3 4}
	    set notIncluded $notPiped
	}
    } elseif {$footer in {20 22 23 24 25}} {
	# Transaction 2 uses its own socket.
	set notPiped    2
	set notIncluded $notPiped
    } else {
    }
    # --------------------------------------------------------------------------
    # End of custom code for specific tests
    # --------------------------------------------------------------------------


    set Results [logAnalyse $num $skipOverlaps $notIncluded $notPiped]
    lassign $Results msg cleanE cleanF dirtyE dirtyF
    if {$msg eq {}} {
        set msg "Passed all sanity checks."
    } else {
        set msg "Problems with sanity checks:\n$msg"
    }

    if 0 {
        puts $msg
        puts "Overlap-free including response body:\n$cleanF"
        puts "Have overlaps including response body:\n$dirtyF"
        puts "Overlap-free without response body:\n$cleanE"
        puts "Have overlaps without response body:\n$dirtyE"
    }

    if {$header < 3} {
        # No ordering, just check that transactions all finish
        set result $msg
    } elseif {$header == 3} {
        # Not pipelined - check overlaps with response body.
        set result "$msg\nHave overlaps including response body:\n$dirtyF"
    } else {
        # Pipelined - check overlaps without response body.  Check that the
        # first request, the first requests after replay, and POSTs are clean.
        set result "$msg\nOverlap-free without response body:\n$cleanE"
    }
    set ::nTokens $num
    return $result
}


# ------------------------------------------------------------------------------
# (3) VERBOSITY CONTROL
# ------------------------------------------------------------------------------
# If tests fail, run an individual test with -verbose 1 or 2 for diagnosis.
# If still obscure, uncomment #Log and ##Log lines in the http package.
# ------------------------------------------------------------------------------

setHttpTestOptions -verbose 0

# ------------------------------------------------------------------------------
# (4) Define the base URLs used for testing.  Each must have a query string.
# ------------------------------------------------------------------------------
# - A HTTP/1.1 server is required.  It should be configured to provide
#   persistent connections when requested to do so, and to close these
#   connections if they are idle for one second.
# - The resource must be served with status 200 in response to a valid GET or
#   POST.
# - The value of "page" is always specified in the query-string. Different
#   resources for the three values of "page" allow testing of both chunked and
#   unchunked transfer encoding.
# - The variables "close" and "delay" may be specified in the query-string (for
#   a GET) or the request body (for a POST).
#   - "delay" is a numerical value in seconds, and causes the server to delay
#     the response, including headers.
#   - "close", if it has the value "y", instructs the server to close the
#     connection ater the current request.
# - Any other variables should be ignored.
# ------------------------------------------------------------------------------

namespace eval ::httpTestScript {
    variable URL
    array set URL {
        a  http://test-tcl-http.kerlin.org/index.html?page=privacy
        b  http://test-tcl-http.kerlin.org/index.html?page=conditions
        c  http://test-tcl-http.kerlin.org/index.html?page=welcome
    }
}


# ------------------------------------------------------------------------------
# (5) Define the tests
# ------------------------------------------------------------------------------
# Constraints:
# - serverNeeded - the URLs defined at (4) must be available, and must have the
#                  properties specified there.
# - duplicate    - the value of -pipeline does not matter if -keepalive 0
# - timeout1s    - tests that work correctly only if the server closes
#                  persistent connections after one second.
#
# Server timeout of persistent connections should be 1s.  Delays of 2s are
# intended to cause timeout.
# Servers are usually configured to use a longer timeout: this will cause the
# tests to fail.  The "2000" could be replaced with a larger number, but the
# tests will then be inconveniently slow.
# ------------------------------------------------------------------------------

#testConstraint serverNeeded 1
#testConstraint timeout1s 1
#testConstraint duplicate 1

# ------------------------------------------------------------------------------
#  Proc SetTestEof - to edit the command ::http::KeepSocket
# ------------------------------------------------------------------------------
# The usual line in command ::http::KeepSocket is "    set TEST_EOF 0".
# Whether the value set in the file is 0 or 1, change it here to the value
# specified by the argument.
#
# It is worth doing all tests for both values of the argument.
#
# test 0  - ::http::KeepSocket is unchanged, detects server eof where possible
#           and closes the connection.
# test 1  - ::http::KeepSocket is edited, does not detect server eof, so the
#           reaction to finding server eof can be tested without the difficulty
#           of testing in the few milliseconds of an asynchronous close event.
# ------------------------------------------------------------------------------

proc SetTestEof {test} {
    set body [info body ::http::KeepSocket]
    set subs "    set TEST_EOF $test"
    set count [regsub -line -all -- {^\s*set TEST_EOF .*$} $body $subs newBody]
    if {$count != 1} {
        return -code error {proc ::http::KeepSocket has unexpected form}
    }
    proc ::http::KeepSocket {token} $newBody
    return
}

for {set header 1} {$header <= 4} {incr header} {
    if {$header == 4} {
	setHttpTestOptions -dotted 1
	set match glob
    } else {
	setHttpTestOptions -dotted 0
	set match exact
    }

    if {$header == 2} {
        set cons0 {serverNeeded duplicate}
    } else {
        set cons0 serverNeeded
    }

    for {set footer 1} {$footer <= 25} {incr footer} {
        foreach {delay label} {
	       0 a
	       1 b
	       2 c
	       3 d
	       5 e
	       8 f
	      12 g
	     100 h
	     500 i
	    2000 j
	} {
	  foreach te {0 1} {
	    if {$te} {
	        set tag testEof
	    } else {
	        set tag normal
	    }
	    set suffix {}
	    set cons $cons0

	    # ------------------------------------------------------------------
	    # Custom code for individual tests
	    # ------------------------------------------------------------------
	    if {$footer in {18}} {
		# Custom code:
		if {($label eq "j") && ($te == 1)} {
		    continue
		}
		if {$te == 1} {
		    # The test (of REPOST 0) is useful if tag is "testEof"
		    # (server timeout without client reaction).  The same test
		    # has a different result if tag is "normal".

		    set suffix " - extra test for -repost 0 - ::http::2 must be"
		    append suffix " cancelled"
		    if {($delay == 0)} {
			append suffix ", along with  ::http::3  ::http::4 if"
			append suffix " the test creates these before ::http::2"
			append suffix " is cancelled"
		    }
		} else {
		}
	    } elseif {$footer in {19}} {
		set suffix " - extra test for -repost 0"
	    } elseif {$footer in {20 21}} {
		set suffix " - extra test for -postfresh 1"
		if {($footer == 20)} {
		    append suffix " - ::http::2 uses a separate socket"
		    append suffix ", other requests use a persistent connection"
		}
	    } elseif {$footer in {22 23 24 25}} {
		append suffix " - ::http::2 uses a separate socket"
		append suffix ", other requests use a persistent connection"
	    } else {
	    }

	    if {($footer >= 13 && $footer <= 23)} {
		# Test use WAIT and depend on server timeout before this time.
		lappend cons timeout1s
	    }
	    # ------------------------------------------------------------------
	    # End of custom code.
	    # ------------------------------------------------------------------

            set name "pipeline test header $header footer $footer delay $delay $tag$suffix"


	    # Here's the test:
            test httpPipeline-${header}.${footer}${label}-${tag} $name \
            -constraints $cons \
            -setup [string map [list TE $te] {
		# Restore default values for tests:
		http::config -pipeline 1 -postfresh 0 -repost 1
                http::init
                set http::http(uid) 0
		SetTestEof {TE}
	    }] -body [list RunTest $header $footer $delay $te] -cleanup {
		# Restore default values for tests:
		http::config -pipeline 1 -postfresh 0 -repost 1
		cleanupHttpTestScript
		SetTestEof 0
		cleanupHttpTest
		after 2000
		# Wait for persistent sockets on the server to time out.
	    } -result [ReturnTestResult $header $footer $delay $te] -match $match


	  }

	}
    }
}

# ------------------------------------------------------------------------------
# (*) Notes on tests *.18*-testEof, *.19*-testEof - these test -repost 0
# ------------------------------------------------------------------------------
# These tests are a bit awkward because the main test kit analyses whether all
# requests are satisfied, with retries if necessary, and it has result analysis
# for processing retry logs.
# - *.18*-testEof tests that certain requests are NOT satisfied, so the analysis
#   is a one-off.
# - Tests *.18a-testEof depend on client/server timing - the test needs to call
#   http::geturl for all requests before the POST (request 2) is cancelled.
#   We test that requests 2, 3, 4 are all cancelled.
# - Other tests *.18*-testEof may not request 3 and 4 in time for the to be
#   added to the write queue before request 2 is completed. We simply check that
#   request 2 is cancelled.
# - The behaviour is different if all connections are allowed to time out
#   (label "j").  This case is not needed to test -repost 0, and is omitted.
# - Tests *.18*-normal and *.19* are conventional (-repost 0 should have no
#   effect).
# ------------------------------------------------------------------------------


unset header footer delay label suffix match cons name te
namespace delete ::httpTest
namespace delete ::httpTestScript

::tcltest::cleanupTests

Added tests/httpTest.tcl.


























































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# httpTest.tcl
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------------
# "Package" httpTest for analysis of Log output of http requests.
# ------------------------------------------------------------------------------
# This is a specialised test kit for examining the presence, ordering, and
# overlap of multiple HTTP transactions over a persistent ("Keep-Alive")
# connection; and also for testing reconnection in accordance with RFC 7230 when
# the connection is lost.
#
# This kit is probably not useful for other purposes.  It depends on the
# presence of specific Log commands in the http library, and it interprets the
# logs that these commands create.
# ------------------------------------------------------------------------------

package require http

namespace eval ::http {
    variable TestStartTimeInMs [clock milliseconds]
#    catch {puts stdout "Start time (zero ms) is $TestStartTimeInMs"}
}

namespace eval ::httpTest {
    variable testResults {}
    variable testOptions
    array set testOptions {
        -verbose 0
        -dotted  1
    }
    # -verbose - 0 quiet 1 write to stdout 2 write more
    # -dotted  - (boolean) use dots for absences in lists of transactions
}

proc httpTest::Puts {txt} {
    variable testOptions
    if {$testOptions(-verbose) > 0} {
        puts stdout $txt
        flush stdout
    }
    return
}

# http::Log
#
# A special-purpose logger used for running tests.
# - Processes Log calls that have "^" in their arguments, and records them in
#   variable ::httpTest::testResults.
# - Also writes them to stdout (using Puts) if ($testOptions(-verbose) > 0).
# - Also writes Log calls that do not have "^", if ($testOptions(-verbose) > 1).

proc http::Log {args} {
    variable TestStartTimeInMs
    set time [expr {[clock milliseconds] - $TestStartTimeInMs}]
    set txt [list $time {*}$args]
    if {[string first ^ $txt] != -1} {
        ::httpTest::LogRecord $txt
        ::httpTest::Puts $txt
    } elseif {$::httpTest::testOptions(-verbose) > 1} {
        ::httpTest::Puts $txt
    }
    return
}


# Called by http::Log (the "testing" version) to record logs for later analysis.

proc httpTest::LogRecord {txt} {
    variable testResults

    set pos [string first ^ $txt]
    set len [string length  $txt]
    if {$pos > $len - 3} {
        puts stdout "Logging Error: $txt"
        puts stdout "Fix this call to Log in http-*.tm so it has ^ then\
		a letter then a numeral."
        flush stdout
    } elseif {$pos == -1} {
        # Called by mistake.
    } else {
        set letter [string index $txt [incr pos]]
        set number [string index $txt [incr pos]]
        # Max 9 requests!
        lappend testResults [list $letter $number]
    }

    return
}


# ------------------------------------------------------------------------------
# Commands for analysing the logs recorded when calling http::geturl.
# ------------------------------------------------------------------------------

# httpTest::TestOverlaps --
#
# The main test for correct behaviour of pipelined and sequential
# (non-pipelined) transactions.  Other tests should be run first to detect
# any inconsistencies in the data (e.g. absence of the elements that are
# examined here).
#
# Examine the sequence $someResults for each transaction from 1 to $n,
# ignoring any that are listed in $badTrans.
# Determine whether the elements "B" to $term for one transaction overlap
# elements "B" to $term for the previous and following transactions.
#
# Transactions in the list $badTrans are not included in "clean" or
# "dirty", but their possible overlap with other transactions is noted.
# Transactions in the list $notPiped are a subset of $badTrans, and
# their possible overlap with other transactions is NOT noted.
#
# Arguments:
# someResults - list of results, each of the form {letter numeral}
# n           - number of HTTP transactions
# term        - letter that indicated end of search range. "E" for testing
#               overlaps from start of request to end of response headers.
#               "F" to extend to the end of the response body.
# msg         - the cumulative message from sanity checks.  Append to it only
#               to report a test failure.
# badTrans    - list of transaction numbers not to be assessed as "clean" or
#               "dirty"
# notPiped    - subset of badTrans.  List of transaction numbers that cannot
#               taint another transaction by overlapping with it, because it
#               used a different socket.
#
# Return value: [list $msg $clean $dirty]
# msg   - warning messages: nothing will be appended to argument $msg if there
#         is an error with the test.
# clean - list of transactions that have no overlap with other transactions
# dirty - list of transactions that have YES overlap with other transactions

proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} {
    variable testOptions

    # Check whether transactions overlap:
    set clean {}
    set dirty {}
    for {set i 1} {$i <= $n} {incr i} {
        if {$i in $badTrans} {
            continue
        }
        set myStart   [lsearch -exact $someResults [list B $i]]
        set myEnd     [lsearch -exact $someResults [list $term $i]]

        if {($myStart == -1 || $myEnd == -1)} {
            set res "Cannot find positions of transaction $i"
	    append msg $res \n
	    Puts $res
        }

	set overlaps {}
	for {set j $myStart} {$j <= $myEnd} {incr j} {
	    lassign [lindex $someResults $j] letter number
	    if {$number != $i && $letter ne "A" && $number ni $notPiped} {
		lappend overlaps $number
	    }
	}

        if {[llength $overlaps] == 0} {
	    set res "Transaction $i has no overlaps"
	    Puts $res
	    lappend clean $i
	    if {$testOptions(-dotted)} {
		# N.B. results from different segments are concatenated.
		lappend dirty .
	    } else {
	    }
        } else {
	    set res "Transaction $i overlaps with [join $overlaps { }]"
	    Puts $res
	    lappend dirty $i
	    if {$testOptions(-dotted)} {
		# N.B. results from different segments are concatenated.
		lappend clean .
	    } else {
	    }
        }
    }
    return [list $msg $clean $dirty]
}

# httpTest::PipelineNext --
#
# Test whether prevPair, pair are valid as consecutive elements of a pipelined
# sequence (Start 1), (End 1), (Start 2), (End 2) ...
# Numbers are integers increasing (by 1 if argument "any" is false), and need
# not begin with 1.
# The first element of the sequence has prevPair {} and is always passed as
# valid.
#
# Arguments;
# Start        - string that labels the start of a segment
# End          - string that labels the end of a segment
# prevPair     - previous "pair" (list of string and number) element of a
#                sequence, or {} if argument "pair" is the first in the
#                sequence.
# pair         - current "pair" (list of string and number) element of a
#                sequence
# any          - (boolean) iff true, accept any increasing sequence of integers.
#                If false, integers must increase by 1.
#
# Return value - boolean, true iff the two pairs are valid consecutive elements.

proc httpTest::PipelineNext {Start End prevPair pair any} {
    if {$prevPair eq {}} {
        return 1
    }

    lassign $prevPair letter number
    lassign $pair newLetter newNumber
    if {$letter eq $Start} {
	return [expr {($newLetter eq $End) && ($newNumber == $number)}]
    } elseif {$any} {
        set nxt [list $Start [expr {$number + 1}]]
	return [expr {($newLetter eq $Start) && ($newNumber > $number)}]
    } else {
        set nxt [list $Start [expr {$number + 1}]]
	return [expr {($newLetter eq $Start) && ($newNumber == $number + 1)}]
    }
}

# httpTest::TestPipeline --
#
# Given a sequence of "pair" elements, check that the elements whose string is
# $Start or $End form a valid pipeline. Ignore other elements.
#
# Return value: {} if valid pipeline, otherwise a non-empty error message.

proc httpTest::TestPipeline {someResults n Start End msg desc badTrans} {
    set sequence {}
    set prevPair {}
    set ok 1
    set any [llength $badTrans]
    foreach pair $someResults {
        lassign $pair letter number
        if {($letter in [list $Start $End]) && ($number ni $badTrans)} {
            lappend sequence $pair
            if {![PipelineNext $Start $End $prevPair $pair $any]} {
		set ok 0
		break
            }
            set prevPair $pair
        }
    }

    if {!$ok} {
        set res "$desc are not pipelined: {$sequence}"
        append msg $res \n
        Puts $res
    }
    return $msg
}

# httpTest::TestSequence --
#
# Examine each transaction from 1 to $n, ignoring any that are listed
# in $badTrans.
# Check that each transaction has elements A to F, in alphabetical order.

proc httpTest::TestSequence {someResults n msg badTrans} {
    variable testOptions

    for {set i 1} {$i <= $n} {incr i} {
        if {$i in $badTrans} {
	    continue
        }
        set sequence {}
        foreach pair $someResults {
            lassign $pair letter number
            if {$number == $i} {
                lappend sequence $letter
            }
        }
        if {$sequence eq {A B C D E F}} {
        } else {
            set res "Wrong sequence for token ::http::$i - {$sequence}"
	    append msg $res \n
	    Puts $res
            if {"X" in $sequence} {
                set res "- and error(s) X"
		append msg $res \n
		Puts $res
            }
            if {"Y" in $sequence} {
                set res "- and warnings(s) Y"
		append msg $res \n
		Puts $res
            }
        }
    }
    return $msg
}

#
# Arguments:
# someResults  - list of elements, each a list of a letter and a number
# n            - (positive integer) the number of HTTP requests
# msg          - accumulated warning messages
# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
# badTrans     - list of transaction numbers not to be assessed as "clean" or
#                "dirty" by their overlaps
#   for 1/2 includes all transactions
#   for 3/4 includes an increasing (with recursion) set that will not be included in the list because they are already handled.
# notPiped     - subset of badTrans.  List of transaction numbers that cannot
#                taint another transaction by overlapping with it, because it
#                used a different socket.
#
# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
# msg    - warning messages: nothing will be appended to argument $msg if there
#          is no error with the test.
# cleanE - list of transactions that have no overlap with other transactions
#          (not considering response body)
# dirtyE - list of transactions that have YES overlap with other transactions
#          (not considering response body)
# cleanF - list of transactions that have no overlap with other transactions
#          (including response body)
# dirtyF - list of transactions that have YES overlap with other transactions
#          (including response body)

proc httpTest::MostAnalysis {someResults n msg skipOverlaps badTrans notPiped} {
    variable testOptions

    # Check that stages for "good" transactions are all present and correct:
    set msg [TestSequence $someResults $n $msg $badTrans]

    # Check that requests are pipelined:
    set msg [TestPipeline $someResults $n B C $msg Requests $notPiped]

    # Check that responses are pipelined:
    set msg [TestPipeline $someResults $n D F $msg Responses $notPiped]

    if {$skipOverlaps} {
	set cleanE {}
	set dirtyE {}
	set cleanF {}
	set dirtyF {}
    } else {
	Puts "Overlaps including response body (test for non-pipelined case)"
	lassign [TestOverlaps $someResults $n F $msg $badTrans $notPiped] msg cleanF dirtyF

	Puts "Overlaps without response body (test for pipelined case)"
	lassign [TestOverlaps $someResults $n E $msg $badTrans $notPiped] msg cleanE dirtyE
    }

    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
}

# httpTest::ProcessRetries --
#
# Command to examine results for socket-changing records [PQR],
# divide the results into segments for each connection, and analyse each segment
# individually.
# (Could add $sock to the logging to simplify this, but never mind.)
#
# In each segment, identify any transactions that are not included, and
# any that are aborted, to assist subsequent testing.
#
# Prepend A records (socket-independent) to each segment for transactions that
# were scheduled (by A) but not completed (by F).  Pass each segment to
# MostAnalysis for processing.

proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPiped} {
    variable testOptions

    set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}]
    if {$nextRetry == -1} {
        return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped]
    }
    set badTrans $notIncluded
    set tryCount 0
    set try $nextRetry
    incr tryCount
    lassign [lindex $someResults $try] letter number
    Puts "Processing retry [lindex $someResults $try]"
    set beforeTry [lrange $someResults 0 $try-1]
    Puts [join $beforeTry \n]
    set afterTry [lrange $someResults $try+1 end]

    set dummyTry   {}
    for {set i 1} {$i <= $n} {incr i} {
        set first [lsearch -exact $beforeTry [list A $i]]
        set last  [lsearch -exact $beforeTry [list F $i]]
        if {$first == -1} {
	    set res "Transaction $i was not started in connection number $tryCount"
	    # So lappend it to badTrans and don't include it in the call below of MostAnalysis.
	    # append msg $res \n
	    Puts $res
	    if {$i ni $badTrans} {
		lappend badTrans $i
	    } else {
	    }
        } elseif {$last == -1} {
	    set res "Transaction $i was started but unfinished in connection number $tryCount"
	    # So lappend it to badTrans and don't include it in the call below of MostAnalysis.
	    # append msg $res \n
	    Puts $res
	    lappend badTrans $i
	    lappend dummyTry [list A $i]
        } else {
	    set res "Transaction $i was started and finished in connection number $tryCount"
	    # So include it in the call below of MostAnalysis.
	    # So lappend it to notIncluded and don't include it in the recursive call of
	    # ProcessRetries which handles the later connections.
	    # append msg $res \n
	    Puts $res
	    lappend notIncluded $i
        }
    }

    # Analyse the part of the results before the first replay:
    set HeadResults [MostAnalysis $beforeTry $n $msg $skipOverlaps $badTrans $notPiped]
    lassign $HeadResults msg cleanE1 cleanF1 dirtyE1 dirtyF1

    # Pass the rest of the results to be processed recursively.
    set afterTry [concat $dummyTry $afterTry]
    set TailResults [ProcessRetries $afterTry $n $msg $skipOverlaps $notIncluded $notPiped]
    lassign $TailResults msg cleanE2 cleanF2 dirtyE2 dirtyF2

    set cleanE [concat $cleanE1 $cleanE2]
    set cleanF [concat $cleanF1 $cleanF2]
    set dirtyE [concat $dirtyE1 $dirtyE2]
    set dirtyF [concat $dirtyF1 $dirtyF2]
    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
}

# httpTest::logAnalyse --
#
#	The main command called to analyse logs for a single test.
#
# Arguments:
# n            - (positive integer) the number of HTTP requests
# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
# notIncluded  - list of transaction numbers not to be assessed as "clean" or
#                "dirty" by their overlaps
# notPiped     - subset of notIncluded.  List of transaction numbers that cannot
#                taint another transaction by overlapping with it, because it
#                used a different socket.
#
# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
# msg    - warning messages: {} if there is no error with the test.
# cleanE - list of transactions that have no overlap with other transactions
#          (not considering response body)
# dirtyE - list of transactions that have YES overlap with other transactions
#          (not considering response body)
# cleanF - list of transactions that have no overlap with other transactions
#          (including response body)
# dirtyF - list of transactions that have YES overlap with other transactions
#          (including response body)

proc httpTest::logAnalyse {n skipOverlaps notIncluded notPiped} {
    variable testResults
    variable testOptions

    # Check that each data item has the correct form {letter numeral}.
    set ii 0
    set ok 1
    foreach pair $testResults {
	lassign $pair letter number
	if {    [string match {[A-Z]} $letter]
	     && [string match {[0-9]} $number]
	} {
	    # OK
	} else {
	    set ok 0
	    set res "Error: testResults has bad element {$pair} at position $ii"
	    append msg $res \n
	    Puts $res
	}
	incr ii
    }

    if {!$ok} {
	return $msg
    }
    set msg {}

    Puts [join $testResults \n]
    ProcessRetries $testResults $n $msg $skipOverlaps $notIncluded $notPiped
    # N.B. Implicit Return.
}

proc httpTest::cleanupHttpTest {} {
    variable testResults
    set testResults {}
    return
}

proc httpTest::setHttpTestOptions {key args} {
    variable testOptions
    if {$key ni {-dotted -verbose}} {
        return -code error {valid options are -dotted, -verbose}
    }
    set testOptions($key) {*}$args
}

namespace eval httpTest {
    namespace export cleanupHttpTest logAnalyse setHttpTestOptions
}

Added tests/httpTestScript.tcl.






























































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# httpTestScript.tcl
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------------
# "Package" httpTestScript for executing test scripts written in a convenient
# shorthand.
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
# Documentation for "package" httpTestScript.
# ------------------------------------------------------------------------------
# To use the package:
# (a) define URLs as the values of elements in the array ::httpTestScript
# (b) define a script in terms of the commands
#         START STOP DELAY KEEPALIVE WAIT PIPELINE GET HEAD POST
#     referring to URLs by the name of the corresponding array element.  The
#     script can include any other Tcl commands, and evaluates in the
#     httpTestScript namespace.
# (c) Use the command httpTestScript::runHttpTestScript to evaluate the script.
# (d) For tcltest tests, wrap the runHttpTestScript call in a suitable "test"
#     command.
# ------------------------------------------------------------------------------
# START
# Must be the first command of the script.
#
# STOP
# Must be present in the script to avoid waiting for client timeout.
# Usually the last command, but can be elsewhere to end a script prematurely.
# Subsequent httpTestScript commands will have no effect.
#
# DELAY ms
# If there are no WAIT commands, this sets the delay in ms between subsequent
# calls to http::geturl.  Default 500ms.
#
# KEEPALIVE
# Set the value passed to http::geturl for the -keepalive option.  The command
# applies to subsequent requests in the script. Default 1.
#
# WAIT ms
# Pause for a time in ms before sending subsequent requests.
#
# PIPELINE boolean
# Set the value of -pipeline using http::config.  The last PIPELINE command
# in the script applies to every request. Default 1.
#
# POSTFRESH boolean
# Set the value of -postfresh using http::config.  The last POSTFRESH command
# in the script applies to every request. Default 0.
#
# REPOST boolean
# Set the value of -repost using http::config.  The last REPOST command
# in the script applies to every request. Default 1 for httpTestScript.
# (Default value in http is 0).
#
# GET uriCode ?arg ...?
# Send a HTTP request using the GET method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will be joined by "&" and appended to the query
#           string with a preceding "&".
#
# HEAD uriCode ?arg ...?
# Send a HTTP request using the HEAD method.
# Arguments: as for GET
#
# POST uriCode ?arg ...?
# Send a HTTP request using the POST method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will be joined by "&" and used as the request body.
# ------------------------------------------------------------------------------

namespace eval ::httpTestScript {
    namespace export runHttpTestScript cleanupHttpTestScript
}

# httpTestScript::START --
# Initialise, and create a long-stop timeout.

proc httpTestScript::START {} {
    variable CountRequestedSoFar
    variable RequestsWhenStopped
    variable KeepAlive
    variable Delay
    variable TimeOutCode
    variable TimeOutDone
    variable StartDone
    variable StopDone
    variable CountFinishedSoFar
    variable RequestList
    variable RequestsMade
    variable ExtraTime
    variable ActualKeepAlive

    if {[info exists StartDone] && ($StartDone == 1)} {
        set msg {START has been called twice without an intervening STOP}
        return -code error $msg
    }

    set StartDone 1
    set StopDone 0
    set TimeOutDone 0
    set CountFinishedSoFar 0
    set CountRequestedSoFar 0
    set RequestList {}
    set RequestsMade {}
    set ExtraTime 0
    set ActualKeepAlive 1

    # Undefined until a STOP command:
    unset -nocomplain RequestsWhenStopped

    # Default values:
    set KeepAlive 1
    set Delay 500

    # Default values for tests:
    KEEPALIVE 1
    PIPELINE  1
    POSTFRESH 0
    REPOST    1

    set TimeOutCode [after 30000 httpTestScript::TimeOutNow]
#    set TimeOutCode [after 4000 httpTestScript::TimeOutNow]
    return
}

# httpTestScript::STOP --
# Do not process any more commands.  The commands will be executed but will
# silently do nothing.

proc httpTestScript::STOP {} {
    variable CountRequestedSoFar
    variable CountFinishedSoFar
    variable RequestsWhenStopped
    variable TimeOutCode
    variable StartDone
    variable StopDone
    variable RequestsMade

    if {$StopDone} {
        # Don't do anything on a second call.
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    set StopDone 1
    set StartDone 0
    set RequestsWhenStopped $CountRequestedSoFar
    unset -nocomplain StartDone

    if {$CountFinishedSoFar == $RequestsWhenStopped} {
        if {[info exists TimeOutCode]} {
            after cancel $TimeOutCode
        }
        set ::httpTestScript::FOREVER 0
    }
    return
}

# httpTestScript::DELAY --
# If there are no WAIT commands, this sets the delay in ms between subsequent
# calls to http::geturl.  Default 500ms.

proc httpTestScript::DELAY {t} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    variable Delay

    set Delay $t
    return
}

# httpTestScript::KEEPALIVE --
# Set the value passed to http::geturl for the -keepalive option.  Default 1.

proc httpTestScript::KEEPALIVE {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    variable KeepAlive
    set KeepAlive $b
    return
}

# httpTestScript::WAIT --
# Pause for a time in ms before processing any more commands.

proc httpTestScript::WAIT {t} {
    variable StartDone
    variable StopDone
    variable ExtraTime

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    if {(![string is integer -strict $t]) || $t < 0} {
        return -code error {argument to WAIT must be a non-negative integer}
    }

    incr ExtraTime $t

    return
}

# httpTestScript::PIPELINE --
# Pass a value to http::config -pipeline.

proc httpTestScript::PIPELINE {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    ::http::config -pipeline $b
    ##::http::Log http(-pipeline) is now [::http::config -pipeline]
    return
}

# httpTestScript::POSTFRESH --
# Pass a value to http::config -postfresh.

proc httpTestScript::POSTFRESH {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    ::http::config -postfresh $b
    ##::http::Log http(-postfresh) is now [::http::config -postfresh]
    return
}

# httpTestScript::REPOST --
# Pass a value to http::config -repost.

proc httpTestScript::REPOST {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    ::http::config -repost $b
    ##::http::Log http(-repost) is now [::http::config -repost]
    return
}

# httpTestScript::GET --
# Send a HTTP request using the GET method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will each be preceded by "&" and appended to the query
#           string.

proc httpTestScript::GET {uriCode args} {
    variable RequestList
    lappend RequestList GET
    RequestAfter $uriCode 0 {} {*}$args
    return
}

# httpTestScript::HEAD --
# Send a HTTP request using the HEAD method.
# Arguments: as for GET

proc httpTestScript::HEAD {uriCode args} {
    variable RequestList
    lappend RequestList HEAD
    RequestAfter $uriCode 1 {} {*}$args
    return
}

# httpTestScript::POST --
# Send a HTTP request using the POST method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will be joined by "&" and used as the request body.

proc httpTestScript::POST {uriCode args} {
    variable RequestList
    lappend RequestList POST
    RequestAfter $uriCode 0 {use} {*}$args
    return
}


proc httpTestScript::RequestAfter {uriCode validate query args} {
    variable CountRequestedSoFar
    variable Delay
    variable ExtraTime
    variable StartDone
    variable StopDone
    variable KeepAlive

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    incr CountRequestedSoFar
    set idelay [expr {($CountRequestedSoFar - 1) * $Delay + 10 + $ExtraTime}]

    # Could pass values of -pipeline, -postfresh, -repost if it were
    # useful to change these mid-script.
    after $idelay [list httpTestScript::Requester $uriCode $KeepAlive $validate $query {*}$args]
    return
}

proc httpTestScript::Requester {uriCode keepAlive validate query args} {
    variable URL

    ::http::config -accept {*/*}

    set absUrl $URL($uriCode)
    if {$query eq {}} {
	if {$args ne {}} {
	    append absUrl & [join $args &]
	}
	set queryArgs {}
    } elseif {$validate} {
        return -code error {cannot have both -validate (HEAD) and -query (POST)}
    } else {
	set queryArgs [list -query [join $args &]]
    }

    if {[catch {
        ::http::geturl     $absUrl        \
                -validate  $validate      \
                -timeout   10000          \
                {*}$queryArgs             \
                -keepalive $keepAlive     \
                -command   ::httpTestScript::WhenFinished
    } token]} {
        set msg $token
        catch {puts stdout "Error: $msg"}
        return
    } else {
        # Request will begin.
    }

    return

}

proc httpTestScript::TimeOutNow {} {
    variable TimeOutDone

    set TimeOutDone 1
    set ::httpTestScript::FOREVER 0
    return
}

proc httpTestScript::WhenFinished {hToken} {
    variable CountFinishedSoFar
    variable RequestsWhenStopped
    variable TimeOutCode
    variable StopDone
    variable RequestList
    variable RequestsMade
    variable ActualKeepAlive

    upvar #0 $hToken state

    if {[catch {
	if {    [info exists state(transfer)]
	     && ($state(transfer) eq "chunked")
	} {
	    set Trans chunked
	} else {
	    set Trans unchunked
	}

	if {    [info exists ::httpTest::testOptions(-verbose)]
	     && ($::httpTest::testOptions(-verbose) > 0)
	} {
	    puts "Token    $hToken
Response $state(http)
Status   $state(status)
Method   $state(method)
Transfer $Trans
Size     $state(currentsize)
URL      $state(url)
"
	}

	if {!$state(-keepalive)} {
	    set ActualKeepAlive 0
	}

	if {[info exists state(method)]} {
	    lappend RequestsMade $state(method)
	} else {
	    lappend RequestsMade UNKNOWN
	}
	set tk [namespace tail $hToken]

	if {    ($state(http) != {HTTP/1.1 200 OK})
	     || ($state(status) != {ok})
	     || (($state(currentsize) == 0) && ($state(method) ne "HEAD"))
	} {
	    ::http::Log ^X$tk unexpected result Response $state(http) Status $state(status) Size $state(currentsize) - token $hToken
	}
    } err]} {
	::http::Log ^X$tk httpTestScript::WhenFinished failed with error status: $err - token $hToken
    }

    incr CountFinishedSoFar
    if {$StopDone && ($CountFinishedSoFar == $RequestsWhenStopped)} {
        if {[info exists TimeOutCode]} {
            after cancel $TimeOutCode
        }
        if {$RequestsMade ne $RequestList && $ActualKeepAlive} {
	    ::http::Log ^X$tk unexpected result - Script asked for "{$RequestList}" but got "{$RequestsMade}" - token $hToken
        }
        set ::httpTestScript::FOREVER 0
    }

    return
}


proc httpTestScript::runHttpTestScript {scr} {
    variable TimeOutDone
    variable RequestsWhenStopped

    after idle [list namespace eval ::httpTestScript $scr]
    vwait ::httpTestScript::FOREVER
    # N.B. does not automatically execute in this namespace, unlike some other events.
    # Release when all requests have been served or have timed out.

    if {$TimeOutDone} {
        return -code error {test script timed out}
    }

    return $RequestsWhenStopped
}


proc httpTestScript::cleanupHttpTestScript {} {
    variable TimeOutDone
    variable RequestsWhenStopped

    if {![info exists RequestsWhenStopped]} {
	return -code error {Cleanup Failed: RequestsWhenStopped is undefined}
    }

    for {set i 1} {$i <= $RequestsWhenStopped} {incr i} {
        http::cleanup ::http::$i
    }

    return
}

Added tests/httpcookie.test.






















































































































































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Commands covered:  http::cookiejar
#
# This file contains a collection of tests for the cookiejar package.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 2014 Donal K. Fellows.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2
namespace import -force ::tcltest::*

testConstraint cookiejar [expr {![catch {
    package require cookiejar
}]}]

test http-cookiejar-1.1 {cookie storage: packaging} cookiejar {
    package require cookiejar
} 0.1
test http-cookiejar-1.2 {cookie storage: packaging} cookiejar {
    package require cookiejar
    package require cookiejar
} 0.1

test http-cookiejar-2.1 {cookie storage: basics} -constraints cookiejar -body {
    http::cookiejar
} -returnCodes error -result {wrong # args: should be "http::cookiejar method ?arg ...?"}
test http-cookiejar-2.2 {cookie storage: basics} -constraints cookiejar -body {
    http::cookiejar ?
} -returnCodes error -result {unknown method "?": must be configure, create, destroy or new}
test http-cookiejar-2.3 {cookie storage: basics} cookiejar {
    http::cookiejar configure
} {-domainfile -domainlist -domainrefresh -loglevel -offline -purgeold -retain -vacuumtrigger}
test http-cookiejar-2.4 {cookie storage: basics} -constraints cookiejar -body {
    http::cookiejar configure a b c d e
} -returnCodes error -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"}
test http-cookiejar-2.5 {cookie storage: basics} -constraints cookiejar -body {
    http::cookiejar configure a
} -returnCodes error -result {bad option "a": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger}
test http-cookiejar-2.6 {cookie storage: basics} -constraints cookiejar -body {
    http::cookiejar configure -d
} -returnCodes error -result {ambiguous option "-d": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger}
test http-cookiejar-2.7 {cookie storage: basics} -setup {
    set old [http::cookiejar configure -loglevel]
} -constraints cookiejar -body {
    list [http::cookiejar configure -loglevel] \
	[http::cookiejar configure -loglevel debug] \
	[http::cookiejar configure -loglevel] \
	[http::cookiejar configure -loglevel error] \
	[http::cookiejar configure -loglevel]
} -cleanup {
    http::cookiejar configure -loglevel $old
} -result {info debug debug error error}
test http-cookiejar-2.8 {cookie storage: basics} -setup {
    set old [http::cookiejar configure -loglevel]
} -constraints cookiejar -body {
    list [http::cookiejar configure -loglevel] \
	[http::cookiejar configure -loglevel d] \
	[http::cookiejar configure -loglevel i] \
	[http::cookiejar configure -loglevel w] \
	[http::cookiejar configure -loglevel e]
} -cleanup {
    http::cookiejar configure -loglevel $old
} -result {info debug info warn error}
test http-cookiejar-2.9 {cookie storage: basics} -constraints cookiejar -body {
    http::cookiejar configure -off
} -match glob -result *
test http-cookiejar-2.10 {cookie storage: basics} -setup {
    set oldval [http::cookiejar configure -offline]
} -constraints cookiejar -body {
    http::cookiejar configure -offline true
} -cleanup {
    catch {http::cookiejar configure -offline $oldval}
} -result 1
test http-cookiejar-2.11 {cookie storage: basics} -setup {
    set oldval [http::cookiejar configure -offline]
} -constraints cookiejar -body {
    http::cookiejar configure -offline nonbool
} -cleanup {
    catch {http::cookiejar configure -offline $oldval}
} -returnCodes error -result {expected boolean value but got "nonbool"}
test http-cookiejar-2.12 {cookie storage: basics} -setup {
    set oldval [http::cookiejar configure -purgeold]
} -constraints cookiejar -body {
    http::cookiejar configure -purge nonint
} -cleanup {
    catch {http::cookiejar configure -purgeold $oldval}
} -returnCodes error -result {expected positive integer but got "nonint"}
test http-cookiejar-2.13 {cookie storage: basics} -setup {
    set oldval [http::cookiejar configure -domainrefresh]
} -constraints cookiejar -body {
    http::cookiejar configure -domainref nonint
} -cleanup {
    catch {http::cookiejar configure -domainrefresh $oldval}
} -returnCodes error -result {expected positive integer but got "nonint"}
test http-cookiejar-2.14 {cookie storage: basics} -setup {
    set oldval [http::cookiejar configure -domainrefresh]
} -constraints cookiejar -body {
    http::cookiejar configure -domainref -42
} -cleanup {
    catch {http::cookiejar configure -domainrefresh $oldval}
} -returnCodes error -result {expected positive integer but got "-42"}
test http-cookiejar-2.15 {cookie storage: basics} -setup {
    set oldval [http::cookiejar configure -domainrefresh]
    set result unset
    set tracer [http::cookiejar create tracer]
} -constraints cookiejar -body {
    oo::objdefine $tracer method PostponeRefresh {} {
	set ::result set
	next
    }
    http::cookiejar configure -domainref 12345
    return $result
} -cleanup {
    $tracer destroy
    catch {http::cookiejar configure -domainrefresh $oldval}
} -result set

test http-cookiejar-3.1 {cookie storage: class} cookiejar {
    info object isa object http::cookiejar
} 1
test http-cookiejar-3.2 {cookie storage: class} cookiejar {
    info object isa class http::cookiejar
} 1
test http-cookiejar-3.3 {cookie storage: class} cookiejar {
    lsort [info object methods http::cookiejar]
} {configure}
test http-cookiejar-3.4 {cookie storage: class} cookiejar {
    lsort [info object methods http::cookiejar -all]
} {configure create destroy new}
test http-cookiejar-3.5 {cookie storage: class} -setup {
    catch {rename ::cookiejar ""}
} -constraints cookiejar -body {
    namespace eval :: {http::cookiejar create cookiejar}
} -cleanup {
    catch {rename ::cookiejar ""}
} -result ::cookiejar
test http-cookiejar-3.6 {cookie storage: class} -setup {
    catch {rename ::cookiejar ""}
} -constraints cookiejar -body {
    list [http::cookiejar create ::cookiejar] [info commands ::cookiejar] \
	    [::cookiejar destroy] [info commands ::cookiejar]
} -cleanup {
    catch {rename ::cookiejar ""}
} -result {::cookiejar ::cookiejar {} {}}
test http-cookiejar-3.7 {cookie storage: class} -setup {
    catch {rename ::cookiejar ""}
} -constraints cookiejar -body {
    http::cookiejar create ::cookiejar foo bar
} -returnCodes error -cleanup {
    catch {rename ::cookiejar ""}
} -result {wrong # args: should be "http::cookiejar create ::cookiejar ?path?"}
test http-cookiejar-3.8 {cookie storage: class} -setup {
    catch {rename ::cookiejar ""}
    set f [makeFile "" cookiejar]
    file delete $f
} -constraints cookiejar -body {
    http::cookiejar create ::cookiejar $f
} -cleanup {
    catch {rename ::cookiejar ""}
    removeFile $f
} -result ::cookiejar
test http-cookiejar-3.9 {cookie storage: class} -setup {
    catch {rename ::cookiejar ""}
    set f [makeFile "bogus content for a database" cookiejar]
} -constraints cookiejar -body {
    http::cookiejar create ::cookiejar $f
} -returnCodes error -cleanup {
    catch {rename ::cookiejar ""}
    removeFile $f
} -result {file is encrypted or is not a database}
test http-cookiejar-3.10 {cookie storage: class} -setup {
    catch {rename ::cookiejar ""}
    set dir [makeDirectory cookiejar]
} -constraints cookiejar -body {
    http::cookiejar create ::cookiejar $dir
} -returnCodes error -cleanup {
    catch {rename ::cookiejar ""}
    removeDirectory $dir
} -result {unable to open database file}

test http-cookiejar-4.1 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
} -constraints cookiejar -body {
    cookiejar
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {wrong # args: should be "cookiejar method ?arg ...?"}
test http-cookiejar-4.2 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
} -constraints cookiejar -body {
    cookiejar ?
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {unknown method "?": must be destroy, forceLoadDomainData, getCookies, lookup or storeCookie}
test http-cookiejar-4.3 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
} -constraints cookiejar -body {
    lsort [info object methods cookiejar -all]
} -cleanup {
    ::cookiejar destroy
} -result {destroy forceLoadDomainData getCookies lookup storeCookie}
test http-cookiejar-4.4 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
} -constraints cookiejar -body {
    cookiejar getCookies
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {wrong # args: should be "cookiejar getCookies proto host path"}
test http-cookiejar-4.5 {cookie storage} -setup {
    http::cookiejar create ::cookiejar
} -constraints cookiejar -body {
    cookiejar getCookies http www.example.com /
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-4.6 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
} -constraints cookiejar -body {
    cookiejar storeCookie
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {wrong # args: should be "cookiejar storeCookie options"}
test http-cookiejar-4.7 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-4.8 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    oo::objdefine ::cookiejar export Database
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    # Poke inside implementation!
    cookiejar Database eval {SELECT count(*) FROM sessionCookies}
} -cleanup {
    ::cookiejar destroy
} -result 1
test http-cookiejar-4.9 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    oo::objdefine ::cookiejar export Database
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    # Poke inside implementation!
    cookiejar Database eval {SELECT count(*) FROM persistentCookies}
} -cleanup {
    ::cookiejar destroy
} -result 0
test http-cookiejar-4.10 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
} -constraints cookiejar -body {
    cookiejar storeCookie [dict replace {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-4.11 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    oo::objdefine ::cookiejar export Database
} -constraints cookiejar -body {
    cookiejar storeCookie [dict replace {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    # Poke inside implementation!
    cookiejar Database eval {SELECT count(*) FROM sessionCookies}
} -cleanup {
    ::cookiejar destroy
} -result 0
test http-cookiejar-4.12 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    oo::objdefine ::cookiejar export Database
} -constraints cookiejar -body {
    cookiejar storeCookie [dict replace {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    # Poke inside implementation!
    cookiejar Database eval {SELECT count(*) FROM persistentCookies}
} -cleanup {
    ::cookiejar destroy
} -result 1
test http-cookiejar-4.13 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints cookiejar -body {
    lappend result [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    lappend result [cookiejar getCookies http www.example.com /]
} -cleanup {
    ::cookiejar destroy
} -result {{} {foo bar}}
test http-cookiejar-4.14 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints cookiejar -body {
    lappend result [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie [dict replace {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    lappend result [cookiejar getCookies http www.example.com /]
} -cleanup {
    ::cookiejar destroy
} -result {{} {foo bar}}
test http-cookiejar-4.15 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints cookiejar -body {
    lappend result [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie [dict replace {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    lappend result [cookiejar getCookies http www.example.com /]
} -cleanup {
    ::cookiejar destroy
} -result {{} {foo bar}}
test http-cookiejar-4.16 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints cookiejar -body {
    lappend result [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo1
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie [dict replace {
	key foo2
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    lappend result [lsort -stride 2 [cookiejar getCookies http www.example.com /]]
} -cleanup {
    ::cookiejar destroy
} -result {{} {foo1 bar foo2 bar}}
test http-cookiejar-4.17 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
} -constraints cookiejar -body {
    cookiejar lookup a b c d
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {wrong # args: should be "cookiejar lookup ?host? ?key?"}
test http-cookiejar-4.18 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints cookiejar -body {
    lappend result [cookiejar lookup]
    lappend result [cookiejar lookup www.example.com]
    lappend result [catch {cookiejar lookup www.example.com foo} value] $value
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    lappend result [cookiejar lookup]
    lappend result [cookiejar lookup www.example.com]
    lappend result [cookiejar lookup www.example.com foo]
} -cleanup {
    ::cookiejar destroy
} -result {{} {} 1 {no such key for that host} www.example.com foo bar}
test http-cookiejar-4.19 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key bar
	value foo
	secure 0
	domain www.example.org
	origin www.example.org
	path /
	hostonly 1
    }
    lappend result [lsort [cookiejar lookup]]
    lappend result [cookiejar lookup www.example.com]
    lappend result [cookiejar lookup www.example.com foo]
    lappend result [cookiejar lookup www.example.org]
    lappend result [cookiejar lookup www.example.org bar]
} -cleanup {
    ::cookiejar destroy
} -result {{www.example.com www.example.org} foo bar bar foo}
test http-cookiejar-4.20 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo1
	value bar1
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie [dict replace {
	key foo2
	value bar2
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    lappend result [cookiejar lookup]
    lappend result [lsort [cookiejar lookup www.example.com]]
    lappend result [cookiejar lookup www.example.com foo1]
    lappend result [cookiejar lookup www.example.com foo2]
} -cleanup {
    ::cookiejar destroy
} -result {www.example.com {foo1 foo2} bar1 bar2}
test http-cookiejar-4.21 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo1
	value bar1
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo2
	value bar2
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    lappend result [cookiejar lookup]
    lappend result [lsort [cookiejar lookup www.example.com]]
    lappend result [cookiejar lookup www.example.com foo1]
    lappend result [cookiejar lookup www.example.com foo2]
} -cleanup {
    ::cookiejar destroy
} -result {www.example.com {foo1 foo2} bar1 bar2}
test http-cookiejar-4.22 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints cookiejar -body {
    cookiejar forceLoadDomainData x y z
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {wrong # args: should be "cookiejar forceLoadDomainData"}
test http-cookiejar-4.23 {cookie storage: instance} -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints cookiejar -body {
    cookiejar forceLoadDomainData
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-4.23.a {cookie storage: instance} -setup {
    set off [http::cookiejar configure -offline]
} -constraints cookiejar -body {
    http::cookiejar configure -offline 1
    [http::cookiejar create ::cookiejar] destroy
} -cleanup {
    catch {::cookiejar destroy}
    http::cookiejar configure -offline $off
} -result {}
test http-cookiejar-4.23.b {cookie storage: instance} -setup {
    set off [http::cookiejar configure -offline]
} -constraints cookiejar -body {
    http::cookiejar configure -offline 0
    [http::cookiejar create ::cookiejar] destroy
} -cleanup {
    catch {::cookiejar destroy}
    http::cookiejar configure -offline $off
} -result {}

test http-cookiejar-5.1 {cookie storage: constraints} -setup {
    http::cookiejar create ::cookiejar
    cookiejar forceLoadDomainData
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain com
	origin com
	path /
	hostonly 1
    }
    cookiejar lookup
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-5.2 {cookie storage: constraints} -setup {
    http::cookiejar create ::cookiejar
    cookiejar forceLoadDomainData
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain foo.example.com
	origin bar.example.org
	path /
	hostonly 1
    }
    cookiejar lookup
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-5.3 {cookie storage: constraints} -setup {
    http::cookiejar create ::cookiejar
    cookiejar forceLoadDomainData
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo1
	value bar
	secure 0
	domain com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo2
	value bar
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar lookup
} -cleanup {
    ::cookiejar destroy
} -result {example.com}
test http-cookiejar-5.4 {cookie storage: constraints} -setup {
    http::cookiejar create ::cookiejar
    cookiejar forceLoadDomainData
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo
	value bar1
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo
	value bar2
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 1
    }
    lsort [cookiejar lookup]
} -cleanup {
    ::cookiejar destroy
} -result {example.com www.example.com}
test http-cookiejar-5.5 {cookie storage: constraints} -setup {
    http::cookiejar create ::cookiejar
    cookiejar forceLoadDomainData
} -constraints cookiejar -body {
    cookiejar storeCookie {
	key foo1
	value 1
	secure 0
	domain com
	origin www.example.com
	path /
	hostonly 0
    }
    cookiejar storeCookie {
	key foo2
	value 2
	secure 0
	domain com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo3
	value 3
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 0
    }
    cookiejar storeCookie {
	key foo4
	value 4
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo5
	value 5
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 0
    }
    cookiejar storeCookie {
	key foo6
	value 6
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo7
	value 7
	secure 1
	domain www.example.com
	origin www.example.com
	path /
	hostonly 0
    }
    cookiejar storeCookie {
	key foo8
	value 8
	secure 1
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo9
	value 9
	secure 0
	domain sub.www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    list [cookiejar getCookies http www.example.com /] \
	[cookiejar getCookies http www2.example.com /] \
	[cookiejar getCookies https www.example.com /] \
	[cookiejar getCookies http sub.www.example.com /]
} -cleanup {
    ::cookiejar destroy
} -result {{foo3 3 foo6 6} {foo3 3} {foo3 3 foo6 6 foo8 8} {foo3 3 foo5 5}}

test http-cookiejar-6.1 {cookie storage: expiry and lookup} -setup {
    http::cookiejar create ::cookiejar
    oo::objdefine cookiejar export PurgeCookies
    set result {}
    proc values cookies {
	global result
	lappend result [lsort [lmap {k v} $cookies {set v}]]
    }
} -constraints cookiejar -body {
    values [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo
	value session
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    values [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie [dict replace {
	key foo
	value cookie
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+1}]]
    values [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo
	value session-global
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 0
    }
    values [cookiejar getCookies http www.example.com /]
    after 2500
    update
    values [cookiejar getCookies http www.example.com /]
    cookiejar PurgeCookies
    values [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo
	value go-away
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 0
	expires 0
    }
    values [cookiejar getCookies http www.example.com /]
} -cleanup {
    ::cookiejar destroy
} -result {{} session cookie {cookie session-global} {cookie session-global} session-global {}}

test http-cookiejar-7.1 {cookie storage: persistence of persistent cookies} -setup {
    catch {rename ::cookiejar ""}
    set f [makeFile "" cookiejar]
    file delete $f
} -constraints cookiejar -body {
    http::cookiejar create ::cookiejar $f
    ::cookiejar destroy
    http::cookiejar create ::cookiejar $f
} -cleanup {
    catch {rename ::cookiejar ""}
    removeFile $f
} -result ::cookiejar
test http-cookiejar-7.2 {cookie storage: persistence of persistent cookies} -setup {
    catch {rename ::cookiejar ""}
    set f [makeFile "" cookiejar]
    file delete $f
    set result {}
} -constraints cookiejar -body {
    http::cookiejar create ::cookiejar $f
    cookiejar storeCookie [dict replace {
	key foo
	value cookie
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+1}]]
    lappend result [::cookiejar getCookies http www.example.com /]
    ::cookiejar destroy
    http::cookiejar create ::cookiejar
    lappend result [::cookiejar getCookies http www.example.com /]
    ::cookiejar destroy
    http::cookiejar create ::cookiejar $f
    lappend result [::cookiejar getCookies http www.example.com /]
} -cleanup {
    catch {rename ::cookiejar ""}
    removeFile $f
} -result {{foo cookie} {} {foo cookie}}

::tcltest::cleanupTests

# Local variables:
# mode: tcl
# End:

Deleted tests/httpold.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300












































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# -*- tcl -*-
# Commands covered:  http_config, http_get, http_wait, http_reset
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

if {[catch {package require http 1.0}]} {
    if {[info exists httpold]} {
	catch {puts "Cannot load http 1.0 package"}
	::tcltest::cleanupTests
	return
    } else {
	catch {puts "Running http 1.0 tests in slave interp"}
	set interp [interp create httpold]
	$interp eval [list set httpold "running"]
	$interp eval [list set argv $argv]
	$interp eval [list source [info script]]
	interp delete $interp
	::tcltest::cleanupTests
	return
    }
}

if {$::tcl_platform(os) eq "Darwin"} {
    # Name resolution often a problem on OSX; not focus of HTTP package anyway
    set HOST localhost
} else {
    set HOST [info hostname]
}

set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
catch {unset data}

##
## The httpd script implement a stub http server
##
source [file join [file dirname [info script]] httpd]

if [catch {httpd_init 0} listen] {
    puts "Cannot start http server, http test skipped"
    catch {unset port}
    ::tcltest::cleanupTests
    return
}

test httpold-1.1 {http_config} {
    http_config
} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}

test httpold-1.2 {http_config} {
    http_config -proxyfilter
} httpProxyRequired

test httpold-1.3 {http_config} {
    catch {http_config -junk}
} 1

test httpold-1.4 {http_config} {
    http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
    set x [http_config]
    http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \
	-useragent "Tcl http client package 1.0"
    set x
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}

test httpold-1.5 {http_config} {
    catch {http_config -proxyhost {} -junk 8080}
} 1

test httpold-2.1 {http_reset} {
    catch {http_reset http#1}
} 0

test httpold-3.1 {http_get} {
    catch {http_get -bogus flag}
} 1
test httpold-3.2 {http_get} {
    catch {http_get http:junk} err
    set err
} {Unsupported URL: http:junk}

set url ${::HOST}:$port
test httpold-3.3 {http_get} {
    set token [http_get $url]
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET /</h2>
</body></html>"

set tail /a/b/c
set url ${::HOST}:$port/a/b/c
set binurl ${::HOST}:$port/binary

test httpold-3.4 {http_get} {
    set token [http_get $url]
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"

proc selfproxy {host} {
    global port
    return [list ${::HOST} $port]
}
test httpold-3.5 {http_get} {
    http_config -proxyfilter selfproxy
    set token [http_get $url]
    http_config -proxyfilter httpProxyRequired
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET http://$url</h2>
</body></html>"

test httpold-3.6 {http_get} {
    http_config -proxyfilter bogus
    set token [http_get $url]
    http_config -proxyfilter httpProxyRequired
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"

test httpold-3.7 {http_get} {
    set token [http_get $url -headers {Pragma no-cache}]
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"

test httpold-3.8 {http_get} {
    set token [http_get $url -query Name=Value&Foo=Bar]
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>POST $tail</h2>
<h2>Query</h2>
<dl>
<dt>Name<dd>Value
<dt>Foo<dd>Bar
</dl>
</body></html>"

test httpold-3.9 {http_get} {
    set token [http_get $url -validate 1]
    http_code $token
} "HTTP/1.0 200 OK"


test httpold-4.1 {httpEvent} {
    set token [http_get $url]
    upvar #0 $token data
    array set meta $data(meta)
    expr ($data(totalsize) == $meta(Content-Length))
} 1

test httpold-4.2 {httpEvent} {
    set token [http_get $url]
    upvar #0 $token data
    array set meta $data(meta)
    string compare $data(type) [string trim $meta(Content-Type)]
} 0

test httpold-4.3 {httpEvent} {
    set token [http_get $url]
    http_code $token
} {HTTP/1.0 200 Data follows}

test httpold-4.4 {httpEvent} {
    set testfile [makeFile "" testfile]
    set out [open $testfile w]
    set token [http_get $url -channel $out]
    close $out
    set in [open $testfile]
    set x [read $in]
    close $in
    removeFile $testfile
    set x
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"

test httpold-4.5 {httpEvent} {
    set testfile [makeFile "" testfile]
    set out [open $testfile w]
    set token [http_get $url -channel $out]
    close $out
    upvar #0 $token data
    removeFile $testfile
    expr $data(currentsize) == $data(totalsize)
} 1

test httpold-4.6 {httpEvent} {
    set testfile [makeFile "" testfile]
    set out [open $testfile w]
    set token [http_get $binurl -channel $out]
    close $out
    set in [open $testfile]
    fconfigure $in -translation binary
    set x [read $in]
    close $in
    removeFile $testfile
    set x
} "$bindata$binurl"

proc myProgress {token total current} {
    global progress httpLog
    if {[info exists httpLog] && $httpLog} {
	puts "progress $total $current"
    }
    set progress [list $total $current]
}
if 0 {
    # This test hangs on Windows95 because the client never gets EOF
    set httpLog 1
    test httpold-4.6 {httpEvent} {
	set token [http_get $url -blocksize 50 -progress myProgress]
	set progress
    } {111 111}
}
test httpold-4.7 {httpEvent} {
    set token [http_get $url -progress myProgress]
    set progress
} {111 111}
test httpold-4.8 {httpEvent} {
    set token [http_get $url]
    http_status $token
} {ok}
test httpold-4.9 {httpEvent} {
    set token [http_get $url -progress myProgress]
    http_code $token
} {HTTP/1.0 200 Data follows}
test httpold-4.10 {httpEvent} {
    set token [http_get $url -progress myProgress]
    http_size $token
} {111}
test httpold-4.11 {httpEvent} {
    set token [http_get $url -timeout 1 -command {#}]
    http_reset $token
    http_status $token
} {reset}
test httpold-4.12 {httpEvent} {
    update
    set x {}
    after 500 {lappend x ok}
    set token [http_get $url -timeout 1 -command {lappend x fail}]
    vwait x
    list [http_status $token] $x
} {timeout ok}

test httpold-5.1 {http_formatQuery} {
    http_formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value+two}

test httpold-5.2 {http_formatQuery} {
    http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
} {name1=%7ebwelch&name2=%a1%a2%a2}

test httpold-5.3 {http_formatQuery} {
    http_formatQuery lines "line1\nline2\nline3"
} {lines=line1%0d%0aline2%0d%0aline3}

test httpold-6.1 {httpProxyRequired} {
    update
    http_config -proxyhost ${::HOST} -proxyport $port
    set token [http_get $url]
    http_wait $token
    http_config -proxyhost {} -proxyport {}
    upvar #0 $token data
    set data(body)
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET http://$url</h2>
</body></html>"

# cleanup
catch {unset url}
catch {unset port}
catch {unset data}
close $listen
::tcltest::cleanupTests
return

Changes to tests/info.test.

15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43







-


+











-
+







#
# DO NOT DELETE THIS LINE

if {{::tcltest} ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint zlib [llength [info commands zlib]]

# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.

catch {namespace delete test_ns_info1 test_ns_info2}

namespace eval test_ns_info1 {
    namespace export *
    proc p {x} {return "x=$x"}
    proc q {{y 27} {z {}}} {return "y=$y"}
}


test info-1.1 {info args option} {
    proc t1 {a bbb c} {return foo}
    info args t1
} {a bbb c}
test info-1.2 {info args option} {
    proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
    info a t1
106
107
108
109
110
111
112
113

114
115
116
117
118
119
120
121
122

123
124
125
126
127
128
129
106
107
108
109
110
111
112

113
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129







-
+








-
+







    list [string bytelength [info body foo]] \
	    [foo; string bytelength [info body foo]]
} {9 9}

proc testinfocmdcount {} {
    set x [info cmdcount]
    set y 12345
    set z [info cm]
    set z [info cmdc]
    expr {$z-$x}
}
test info-3.1 {info cmdcount compiled} {
    testinfocmdcount
} 4
test info-3.2 {info cmdcount evaled} -body {
    set x [info cmdcount]
    set y 12345
    set z [info cm]
    set z [info cmdc]
    expr {$z-$x}
} -cleanup {unset x y z} -result 4
test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4
test info-3.4 {info cmdcount option} -body {
    info cmdcount 1
} -returnCodes error -result {wrong # args: should be "info cmdcount"}

674
675
676
677
678
679
680
681

682
683
684

685
686
687

688
689
690

691
692
693
694
695
696
697
674
675
676
677
678
679
680

681
682
683

684
685
686

687
688
689

690
691
692
693
694
695
696
697







-
+


-
+


-
+


-
+







unset functions msg

test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
    info
} -result {wrong # args: should be "info subcommand ?arg ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
    info gorp
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
    info c
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
    info l
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
    info s
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}

##
# ### ### ### ######### ######### #########
## info frame

## Helper
# For the more complex results we cut the file name down to remove path
2391
2392
2393
2394
2395
2396
2397
2398








































































































































































2399
2400
2401

2402
2403
2404
2405
2406
2407
2408
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568

2569
2570
2571
2572
2573
2574
2575
2576








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+







}
test info-33.35 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval ::testinfocmdtype {
    apply {cmds {
	foreach c $cmds {rename $c {}}
    } ::testinfocmdtype} [info commands ::testinfocmdtype::*]
}
test info-40.1 {info cmdtype: syntax} -body {
    info cmdtype
} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
test info-40.2 {info cmdtype: syntax} -body {
    info cmdtype foo bar
} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
test info-40.3 {info cmdtype: no such command} -body {
    info cmdtype ::testinfocmdtype::foo
} -returnCodes error -result {unknown command "::testinfocmdtype::foo"}
test info-40.4 {info cmdtype: native commands} -body {
    info cmdtype ::if
} -result native
test info-40.5 {info cmdtype: native commands} -body {
    info cmdtype ::puts
} -result native
test info-40.6 {info cmdtype: native commands} -body {
    info cmdtype ::yield
} -result native
test info-40.7 {info cmdtype: procedures} -setup {
    proc ::testinfocmdtype::someproc {} {}
} -body {
    info cmdtype ::testinfocmdtype::someproc
} -cleanup {
    rename ::testinfocmdtype::someproc {}
} -result proc
test info-40.8 {info cmdtype: aliases} -setup {
    interp alias {} ::testinfocmdtype::somealias {} ::puts
} -body {
    info cmdtype ::testinfocmdtype::somealias
} -cleanup {
    rename ::testinfocmdtype::somealias {}
} -result alias
test info-40.9 {info cmdtype: imports} -setup {
    namespace eval ::testinfocmdtype {
	namespace eval foo {
	    proc bar {} {}
	    namespace export bar
	}
	namespace import foo::bar
    }
} -body {
    info cmdtype ::testinfocmdtype::bar
} -cleanup {
    rename ::testinfocmdtype::bar {}
    namespace delete ::testinfocmdtype::foo
} -result import
test info-40.10 {info cmdtype: slaves} -setup {
    apply {i {
	rename $i ::testinfocmdtype::slave
	variable ::testinfocmdtype::slave $i
    }} [interp create]
} -body {
    info cmdtype ::testinfocmdtype::slave
} -cleanup {
    interp delete $::testinfocmdtype::slave
} -result slave
test info-40.11 {info cmdtype: objects} -setup {
    apply {{} {
	oo::object create obj
    } ::testinfocmdtype}
} -body {
    info cmdtype ::testinfocmdtype::obj
} -cleanup {
    ::testinfocmdtype::obj destroy
} -result object
test info-40.12 {info cmdtype: objects} -setup {
    apply {{} {
	oo::object create obj
    } ::testinfocmdtype}
} -body {
    info cmdtype [info object namespace ::testinfocmdtype::obj]::my
} -cleanup {
    ::testinfocmdtype::obj destroy
} -result privateObject
test info-40.13 {info cmdtype: ensembles} -setup {
    namespace eval ::testinfocmdtype {
	namespace eval ensmbl {
	    proc bar {} {}
	    namespace export *
	    namespace ensemble create
	}
    }
} -body {
    info cmdtype ::testinfocmdtype::ensmbl
} -cleanup {
    namespace delete ::testinfocmdtype::ensmbl
} -result ensemble
test info-40.14 {info cmdtype: zlib streams} -constraints zlib -setup {
    namespace eval ::testinfocmdtype {
	rename [zlib stream gzip] zstream
    }
} -body {
    info cmdtype ::testinfocmdtype::zstream
} -cleanup {
    ::testinfocmdtype::zstream close
} -result zlibStream
test info-40.15 {info cmdtype: coroutines} -setup {
    coroutine ::testinfocmdtype::coro eval yield
} -body {
    info cmdtype ::testinfocmdtype::coro
} -cleanup {
    ::testinfocmdtype::coro
} -result coroutine
test info-40.16 {info cmdtype: dynamic behavior} -setup {
    proc ::testinfocmdtype::foo {} {}
} -body {
    namespace eval ::testinfocmdtype {
	list [catch {info cmdtype foo}] [catch {info cmdtype bar}] \
	    [namespace which foo] [rename foo bar] [namespace which bar] \
	    [catch {info cmdtype foo}] [catch {info cmdtype bar}]
    }
} -cleanup {
    namespace eval ::testinfocmdtype {
	catch {rename foo {}}
	catch {rename bar {}}
    }
} -result {0 1 ::testinfocmdtype::foo {} ::testinfocmdtype::bar 1 0}
test info-40.17 {info cmdtype: aliases in slave interpreters} -setup {
    set i [interp create]
} -body {
    $i alias foo gorp
    $i eval {
	info cmdtype foo
    }
} -cleanup {
    interp delete $i
} -result alias
test info-40.18 {info cmdtype: aliases in slave interpreters} -setup {
    set safe [interp create -safe]
} -body {
    $safe alias foo gorp
    $safe eval {
	info cmdtype foo
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
test info-40.19 {info cmdtype: aliases in slave interpreters} -setup {
    set safe [interp create -safe]
} -body {
    set inner [interp create [list $safe bar]]
    interp alias $inner foo $safe gorp
    $safe eval {
	bar eval {
	    info cmdtype foo
	}
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
test info-40.20 {info cmdtype: aliases in slave interpreters} -setup {
    set safe [interp create -safe]
} -body {
    $safe eval {
	interp alias {} foo {} gorp
	info cmdtype foo
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
namespace delete ::testinfocmdtype

# -------------------------------------------------------------------------
unset -nocomplain res

test info-39.0 {Bug 4b61afd660} -setup {
test info-39.2 {Bug 4b61afd660} -setup {
    proc probe {} {
	return [dict get [info frame -1] line]
    }
    set body {
	set cmd probe
	$cmd
    }

Changes to tests/interp.test.

16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30







-
+







}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload}
set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}

foreach i [interp slaves] {
  interp delete $i
}

# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} -returnCodes error -body {
1843
1844
1845
1846
1847
1848
1849
1850

1851
1852
1853
1854
1855
1856
1857
1843
1844
1845
1846
1847
1848
1849

1850
1851
1852
1853
1854
1855
1856
1857







-
+







    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
    a hide bar
    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
    a alias bar {}
    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
} -cleanup {
    interp delete a
} -result [list $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} [lsort [concat $hidden_cmds bar]] {::tcl::mathfunc::max ::tcl::mathfunc::min clock} $hidden_cmds]
} -result [list $hidden_cmds {bar clock} $hidden_cmds {bar clock} [lsort [concat $hidden_cmds bar]] {clock} $hidden_cmds]

test interp-24.1 {result resetting on error} -setup {
    catch {interp delete a}
} -body {
    interp create a
    interp alias a foo {} apply {args {error $args}}
    interp eval a {

Changes to tests/io.test.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37





38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
11
12
13
14
15
16
17

18
19





20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

38


39
40
41

42
43
44
45
46
47
48







-


-
-
-
-
-












+
+
+
+
+

-

-
-



-







# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testbytestring [llength [info commands testbytestring]]

namespace eval ::tcl::test::io {
    namespace import ::tcltest::*

    variable umaskValue
    variable path
    variable f
    variable i
    variable n
    variable v
    variable msg
    variable expected

    loadTestedCommands
    catch [list package require -exact Tcltest [info patchlevel]]
    package require tcltests

testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint exec             [llength [info commands exec]]
testConstraint openpipe         1
testConstraint fileevent        [llength [info commands fileevent]]
testConstraint fcopy            [llength [info commands fcopy]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint testobj		[llength [info commands testobj]]

# You need a *very* special environment to do some tests.  In
# particular, many file systems do not support large-files...
testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]

# some tests can only be run is umask is 2
5634
5635
5636
5637
5638
5639
5640
5641

5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656

5657
5658
5659
5660
5661
5662
5663
5629
5630
5631
5632
5633
5634
5635

5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650

5651
5652
5653
5654
5655
5656
5657
5658







-
+














-
+







    close $f
    set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unix} {
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format "0o%o" [expr $stats(mode)&0o777]]
    set x [format "%#o" [expr $stats(mode)&0o777]]
    puts $f "line 1"
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {0o600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT}]
    close $f
    file stat $path(test3) stats
    format "%#o" [expr $stats(mode)&0o777]
} [format %#4o [expr {0o666 & ~ $umaskValue}]]
} [format %#5o [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
    file delete $path(test3)
    set f [open $path(test3) w]
    fconfigure $f -eofchar {}
    puts $f xyzzy
    close $f
    set f [open $path(test3) {WRONLY CREAT}]
6159
6160
6161
6162
6163
6164
6165


6166
6167
6168
6169
6170
6171
6172
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169







+
+







    fileevent $f readable {}
    set x [list [testfevent cmd "fileevent $f readable"] \
                [fileevent $f readable]]
    testfevent delete
    close $f
    set x
} {{script 1} {}}
unset path(foo)
removeFile foo

set path(bar) [makeFile {} bar]

test io-48.1 {testing readability conditions} {fileevent} {
    set f [open $path(bar) w]
    puts $f abcdefg
    puts $f abcdefg
6261
6262
6263
6264
6265
6266
6267



6268
6269
6270
6271
6272
6273
6274
6258
6259
6260
6261
6262
6263
6264
6265
6266
6267
6268
6269
6270
6271
6272
6273
6274







+
+
+







    puts $f "set f \[[list open $path(bar) r]]"
    puts $f {copy_slowly $f}
    puts $f {exit}
    vwait [namespace which -variable x]
    close $f
    list $x $l
} {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
unset path(bar)
removeFile bar

test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fileevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    variable c [format "abc\ndef\n%c" 26]
    puts -nonewline $f $c
    close $f

Changes to tests/ioCmd.test.

10
11
12
13
14
15
16
17

18
19
20
21
22
23


24
25
26
27
28
29
30
31
32
33
34
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24
25
26

27

28
29
30
31
32
33
34







-
+






+
+

-

-







# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

package require tcltests

# Custom constraints used in this file
testConstraint fcopy		[llength [info commands fcopy]]
testConstraint testchannel	[llength [info commands testchannel]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]

#----------------------------------------------------------------------

test iocmd-1.1 {puts command} {
   list [catch {puts} msg] $msg
} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
test iocmd-1.2 {puts command} {
150
151
152
153
154
155
156
157

158
159
160

161
162
163
164
165
166
167
150
151
152
153
154
155
156

157
158
159

160
161
162
163
164
165
166
167







-
+


-
+







    close $f
    string compare [string tolower $x] \
	[list 1 [format "channel \"%s\" wasn't opened for reading" $f] none]
} 0
test iocmd-4.12 {read command} -setup {
    set f [open $path(test1)]
} -body {
    list [catch {read $f 12z} msg] $msg $::errorCode
    read $f 12z
} -cleanup {
    close $f
} -result {1 {expected non-negative integer but got "12z"} {TCL VALUE NUMBER}}
} -result {expected non-negative integer but got "12z"} -errorCode {TCL VALUE NUMBER}

test iocmd-5.1 {seek command} -returnCodes error -body {
    seek
} -result {wrong # args: should be "seek channelId offset ?origin?"}
test iocmd-5.2 {seek command} -returnCodes error -body {
    seek a b c d e f g
} -result {wrong # args: should be "seek channelId offset ?origin?"}
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399

400
401
402
403
404
405
406
380
381
382
383
384
385
386

387
388
389
390
391
392
393
394
395
396
397

398
399
400
401
402
403
404
405







-











-
+







test iocmd-10.5 {fblocked command} {
    fblocked stdin
} 0

set path(test4) [makeFile {} test4]
set path(test5) [makeFile {} test5]

file delete $path(test5)
test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
    set f [open $path(test4) w]
    close $f
    list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
} {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
    list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
    list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.4 {I/O to command pipelines} unixOrPc {
test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrPc} {
    list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
} {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}

test iocmd-12.1 {POSIX open access modes: RDONLY} {
    file delete $path(test1)
    set f [open $path(test1) w]
    puts $f "Two lines: this one"
2054
2055
2056
2057
2058
2059
2060


2061
2062
2063
2064
2065
2066
2067
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068







+
+







    lappend res [catch {interp eval $idb [list puts  $chan shoo]} msg] $msg
    lappend res [catch {interp eval $idb [list tell  $chan]}      msg] $msg
    lappend res [catch {interp eval $idb [list seek  $chan 1]}    msg] $msg
    lappend res [catch {interp eval $idb [list gets  $chan]}      msg] $msg
    lappend res [catch {interp eval $idb [list close $chan]}      msg] $msg
    set res

} -cleanup {
    interp delete $idb
} -constraints {testchannel} \
    -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}

test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -match glob -body {

    set ida [interp create];#puts <<$ida>>
    set idb [interp create];#puts <<$idb>>
2096
2097
2098
2099
2100
2101
2102


2103
2104
2105
2106
2107
2108
2109
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112







+
+







	# wait a bit, give the main thread the time to start its event
	# loop to wait for the response from B
	after 2000
	catch { puts $chan shoo } res
	set res
    }]
    set res
} -cleanup {
    interp delete $idb
} -constraints {testchannel} -result {Owner lost}

test iocmd-32.2 {delete interp of reflected chan} {
    # Bug 3034840
    # Run this test in an interp with memory debugging to panic
    # on the double free
    interp create slave
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3777
3778
3779
3780
3781
3782
3783

3784
3785
3786
3787
3788
3789
3790







-







# channel operation does not hang.  There's no way to test this without actually
# exiting a thread in mid-operation, and that action is unavoidably leaky (which
# is why [thread::exit] is advised against).
#
# Use constraints to skip this test while valgrinding so this expected leak
# doesn't prevent a finding of "leak-free".
#
testConstraint notValgrind [expr {![testConstraint valgrind]}]
test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body {

    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];#puts <<$tida>>
    thread::send $tida {load {} Tcltest}
    set tidb [thread::create -preserved];#puts <<$tidb>>
    thread::send $tidb {load {} Tcltest}
3827
3828
3829
3830
3831
3832
3833










3834
3835
3836
3837
3838
3839
3840

3841
3842
3843
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850


3851

3852
3853







+
+
+
+
+
+
+
+
+
+





-
-
+
-



# ### ### ### ######### ######### #########

# ### ### ### ######### ######### #########

rename track {}
# cleanup


# Eliminate valgrind "still reachable" reports on outstanding "Detached"
# structures in the detached list which stem from PipeClose2Proc not waiting
# around for background processes to complete, meaning that previous calls to
# Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
after 10
exec [info nameofexecutable] << {}


foreach file [list test1 test2 test3 test4] {
    removeFile $file
}
# delay long enough for background processes to finish
after 500
foreach file [list test5] {
    removeFile $file
removeFile test5
}
cleanupTests
return

Changes to tests/ioTrans.test.

1196
1197
1198
1199
1200
1201
1202

1203
1204
1205
1206
1207
1208
1209
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210







+







	[catch {interp eval $idb [list close $chan]} msg] $msg
    #lappend res [interp eval $ida {set res}]
    # actions: clear|write|clear|write|clear|flush|limit?|drain|flush
    # The 'tell' is ok, as it passed through the transform to the base channel
    # without invoking the transform handler.
} -cleanup {
    tempdone
    interp delete $idb
} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
test iortrans-11.1 {origin interpreter of moved transform destroyed during access} -setup {
    set ida [interp create];	#puts <<$ida>>
    set idb [interp create];	#puts <<$idb>>
    # Magic to get the test* commands in the slaves
    load {} Tcltest $ida
    load {} Tcltest $idb
1235
1236
1237
1238
1239
1240
1241

1242
1243
1244
1245
1246
1247
1248
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250







+







	# Wait a bit, give the main thread the time to start its event loop to
	# wait for the response from B
	after 50
	catch { puts $chan shoo } res
	set res
    }]
} -cleanup {
    interp delete $idb
    tempdone
} -result {Owner lost}
test iortrans-11.2 {delete interp of reflected transform} -setup {
    interp create slave
    # Magic to get the test* commands into the slave
    load {} Tcltest slave
} -constraints {testchannel} -body {

Changes to tests/iogt.test.

604
605
606
607
608
609
610
611

612
613
614
615
616
617
618
604
605
606
607
608
609
610

611
612
613
614
615
616
617
618







-
+







} {}

test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
    proc DoneCopy {n {err {}}} {
	variable copy 1
    }
} -constraints {testchannel knownBug} -body {
    # This test to check the validity of aquired Tcl_Channel references is not
    # This test to check the validity of acquired Tcl_Channel references is not
    # possible because even a backgrounded fcopy will immediately start to
    # copy data, without waiting for the event loop. This is done only in case
    # of an underflow on the read size!. So stacking transforms after the
    # fcopy will miss information, or are not used at all.
    #
    # I was able to circumvent this by using the echo.tcl server with a big
    # delay, causing the fcopy to underflow immediately.

Changes to tests/join.test.

41
42
43
44
45
46
47





48
49
50
51
52
53
54
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59







+
+
+
+
+








test join-3.1 {joinString is binary ok} {
  string length [join {a b c} a\0b]
} 9
test join-3.2 {join is binary ok} {
  string length [join "a\0b a\0b a\0b"]
} 11

test join-4.1 {shimmer segfault prevention} {
    set l {0 0}
    join $l $l
} {00 00}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl

Changes to tests/lindex.test.

66
67
68
69
70
71
72
73

74
75
76
77

78
79
80
81









82
83
84
85
86
87
88
66
67
68
69
70
71
72

73
74
75
76

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97







-
+



-
+




+
+
+
+
+
+
+
+
+







test lindex-3.4 {integer 3} testevalex {
    set x [string range 33 0 0]
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
test lindex-3.5 {bad octal} -constraints testevalex -body {
    set x 0o8
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-3.6 {bad octal} -constraints testevalex -body {
    set x -0o9
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-3.7 {indexes don't shimmer wide ints} {
    set x [expr {(wide(1)<<31) - 2}]
    list $x [lindex {1 2 3} $x] [incr x] [incr x]
} {2147483646 {} 2147483647 2147483648}
test lindex-3.8 {compiled with static indices out of range, negative} {
    list [lindex {a b c} -1] [lindex {a b c} -2] [lindex {a b c} -3]
} [lrepeat 3 {}]
test lindex-3.9 {compiled with calculated indices out of range, negative constant} {
    list [lindex {a b c} -1-1] [lindex {a b c} -2+0] [lindex {a b c} -2+1]
} [lrepeat 3 {}]
test lindex-3.10 {compiled with calculated indices out of range, after end} {
    list [lindex {a b c} end+1] [lindex {a b c} end+2] [lindex {a b c} end+3]
} [lrepeat 3 {}]

# Indices relative to end

test lindex-4.1 {index = end} testevalex {
    set x end
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {c c}
101
102
103
104
105
106
107
108

109
110
111
112

113
114
115
116
117
118
119
110
111
112
113
114
115
116

117
118
119
120

121
122
123
124
125
126
127
128







-
+



-
+







test lindex-4.5 {index = end-3} testevalex {
    set x end-3
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
test lindex-4.6 {bad octal} -constraints testevalex -body {
    set x end-0o8
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-4.7 {bad octal} -constraints testevalex -body {
    set x end--0o9
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-4.8 {bad integer, not octal} testevalex {
    set x end-0a2
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lindex-4.9 {obsolete test} testevalex {
    set x end
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
257
258
259
260
261
262
263
264

265
266
267
268

269
270
271
272
273
274
275
266
267
268
269
270
271
272

273
274
275
276

277
278
279
280
281
282
283
284







-
+



-
+







	list [lindex {a b c} $x] [lindex {a b c} $x]
    } result
    set result
} {{} {}}
test lindex-11.5 {bad octal} -body {
    set x 0o8
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-11.6 {bad octal} -body {
    set x -0o9
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}

# Indices relative to end

test lindex-12.1 {index = end} {
    set x end
    catch {
	list [lindex {a b c} $x] [lindex {a b c} $x]
303
304
305
306
307
308
309
310

311
312
313
314

315
316
317
318
319
320
321
312
313
314
315
316
317
318

319
320
321
322

323
324
325
326
327
328
329
330







-
+



-
+







	list [lindex {a b c} $x] [lindex {a b c} $x]
    } result
    set result
} {{} {}}
test lindex-12.6 {bad octal} -body {
    set x end-0o8
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-12.7 {bad octal} -body {
    set x end--0o9
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-12.8 {bad integer, not octal} {
    set x end-0a2
    list [catch { lindex {a b c} $x } result] $result
} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lindex-12.9 {obsolete test} {
    set x end
    catch {

Changes to tests/lrange.test.

86
87
88
89
90
91
92






















































































































93
94
95
96
97
98
99
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







} {1 {unmatched open brace in list}}

test lrange-3.1 {Bug 3588366: end-offsets before start} {
    apply {l {
	lrange $l 0 end-5
    }} {1 2 3 4 5}
} {}
test lrange-3.2 {compiled with static indices out of range, negative} {
    list [lrange {a b c} -1 -2] [lrange {a b c} -2 -1] [lrange {a b c} -3 -2] [lrange {a b c} -2 -3]
} [lrepeat 4 {}]
test lrange-3.3 {compiled with calculated indices out of range, negative constant} {
    list [lrange {a b c} 0-1 -1-1] [lrange {a b c} -2+0 0-1] [lrange {a b c} -2-1 -2+1] [lrange {a b c} -2+1 -2-1]
} [lrepeat 4 {}]
test lrange-3.4 {compiled with calculated indices out of range, after end} {
    list [lrange {a b c} end+1 end+2] [lrange {a b c} end+2 end+1] [lrange {a b c} end+2 end+3] [lrange {a b c} end+3 end+2]
} [lrepeat 4 {}]

test lrange-3.5 {compiled with calculated indices, start out of range (negative)} {
    list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1]
} [lrepeat 4 {a b}]
test lrange-3.6 {compiled with calculated indices, end out of range (after end)} {
    list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1]
} [lrepeat 4 {b c}]

test lrange-4.1 {lrange pure promise} -body {
    set ll1 [list $tcl_version 2 3 4]
    # Shared
    set ll2 $ll1
    # With string rep
    string length $ll1
    set rep1 [tcl::unsupported::representation $ll1]
    # Get new pure object
    set x [lrange $ll1 0 end]
    set rep2 [tcl::unsupported::representation $x]
    regexp {object pointer at (\S+)} $rep1 -> obj1
    regexp {object pointer at (\S+)} $rep2 -> obj2
    list $rep1 $rep2 [string equal $obj1 $obj2]
    # Check for a new clean object
} -match glob -result {*value is *refcount of 3,*, string rep*value is*refcount of 2,* no string rep* 0}

test lrange-4.2 {lrange pure promise} -body {
    set ll1 [list $tcl_version 2 3 4]
    # Shared
    set ll2 $ll1
    # With string rep
    string length $ll1
    set rep1 [tcl::unsupported::representation $ll1]
    # Get new pure object, not compiled
    set x [[string cat l range] $ll1 0 end]
    set rep2 [tcl::unsupported::representation $x]
    regexp {object pointer at (\S+)} $rep1 -> obj1
    regexp {object pointer at (\S+)} $rep2 -> obj2
    list $rep1 $rep2 [string equal $obj1 $obj2]
    # Check for a new clean object
} -match glob -result {*value is *refcount of 3,*, string rep*value is*refcount of 2,* no string rep* 0}

test lrange-4.3 {lrange pure promise} -body {
    set ll1 [list $tcl_version 2 3 4]
    # With string rep
    string length $ll1
    set rep1 [tcl::unsupported::representation $ll1]
    # Get pure object, unshared
    set ll2 [lrange $ll1[set ll1 {}] 0 end]
    set rep2 [tcl::unsupported::representation $ll2]
    regexp {object pointer at (\S+)} $rep1 -> obj1
    regexp {object pointer at (\S+)} $rep2 -> obj2
    list $rep1 $rep2 [string equal $obj1 $obj2]
    # Internal optimisations should keep the same object
} -match glob -result {*value is *refcount of 2,*, string rep*value is*refcount of 2,* no string rep* 1}

test lrange-4.4 {lrange pure promise} -body {
    set ll1 [list $tcl_version 2 3 4]
    # With string rep
    string length $ll1
    set rep1 [tcl::unsupported::representation $ll1]
    # Get pure object, unshared, not compiled
    set ll2 [[string cat l range] $ll1[set ll1 {}] 0 end]
    set rep2 [tcl::unsupported::representation $ll2]
    regexp {object pointer at (\S+)} $rep1 -> obj1
    regexp {object pointer at (\S+)} $rep2 -> obj2
    list $rep1 $rep2 [string equal $obj1 $obj2]
    # Internal optimisations should keep the same object
} -match glob -result {*value is *refcount of 2,*, string rep*value is*refcount of 2,* no string rep* 1}

# Testing for compiled vs non-compiled behaviour, and shared vs non-shared.
# Far too many variations to check with spelt-out tests.
# Note that this *just* checks whether the different versions are the same
# not whether any of them is correct.
apply {{} {
    set lss     {{} {a} {a b c} {a b c d}}
    set idxs    {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2}
    set lrange  lrange

    foreach ls $lss {
	foreach a $idxs {
	    foreach b $idxs {
                # Shared, uncompiled
                set ls2 $ls
                set expected [list [catch {$lrange $ls $a $b} m] $m]
                # Shared, compiled
                set tester [list lrange $ls $a $b]
                set script [list catch $tester m]
                set script "list \[$script\] \$m"
                test lrange-5.[incr n].1 {lrange shared compiled} \
			[list apply [list {} $script]] $expected
                # Unshared, uncompiled
                set tester [string map [list %l [list $ls] %a $a %b $b] {
                    [string cat l range] [lrange %l 0 end] %a %b
                }]
                set script [list catch $tester m]
                set script "list \[$script\] \$m"
                test lrange-5.$n.2 {lrange unshared uncompiled} \
			[list apply [list {} $script]] $expected
                # Unshared, compiled
                set tester [string map [list %l [list $ls] %a $a %b $b] {
                    lrange [lrange %l 0 end] %a %b
                }]
                set script [list catch $tester m]
                set script "list \[$script\] \$m"
                test lrange-5.$n.3 {lrange unshared compiled} \
			[list apply [list {} $script]] $expected
	    }
	}
    }
}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl

Changes to tests/lreplace.test.

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
128

129
130
131
132
133
134
135
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
128
129
130

131
132
133

134
135
136
137
138
139
140
141







-
+

-
-
+
+

-
+
+
+
+
+
+
+


















-
+


-
+







test lreplace-1.26 {lreplace command} {
    catch {unset foo}
    set foo {a b}
    list [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]]
} {a {} {}}
test lreplace-1.27 {lreplace command} {
test lreplace-1.27 {lreplace command} -body {
    lreplace x 1 1
} x
test lreplace-1.28 {lreplace command} {
} -result x
test lreplace-1.28 {lreplace command} -body {
    lreplace x 1 1 y
} {x y}
} -result {x y}
test lreplace-1.29 {lreplace command} -body {
    lreplace x 1 1 [error foo]
} -returnCodes 1 -result {foo}
test lreplace-1.30 {lreplace command} -body {
    lreplace {not {}alist} 0 0 [error foo]
} -returnCodes 1 -result {foo}

test lreplace-2.1 {lreplace errors} {
    list [catch lreplace msg] $msg
} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.2 {lreplace errors} {
    list [catch {lreplace a b} msg] $msg
} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.3 {lreplace errors} {
    list [catch {lreplace x a 10} msg] $msg
} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.4 {lreplace errors} {
    list [catch {lreplace x 10 x} msg] $msg
} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.5 {lreplace errors} {
    list [catch {lreplace x 10 1x} msg] $msg
} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.6 {lreplace errors} {
    list [catch {lreplace x 3 2} msg] $msg
} {1 {list doesn't contain element 3}}
} {0 x}
test lreplace-2.7 {lreplace errors} {
    list [catch {lreplace x 2 2} msg] $msg
} {1 {list doesn't contain element 2}}
} {0 x}

test lreplace-3.1 {lreplace won't modify shared argument objects} {
    proc p {} {
        lreplace "a b c" 1 1 "x y"
        return "a b c"
    }
    p

Changes to tests/lsearch.test.

55
56
57
58
59
60
61
62

63
64
65
66
67
68
69
55
56
57
58
59
60
61

62
63
64
65
66
67
68
69







-
+







    lsearch -glob {xyz bbcc *bc*} *bc*
} 1
test lsearch-2.9 {search modes} {
    lsearch -glob {b.x ^bc xy bcx} ^bc
} 1
test lsearch-2.10 {search modes} -returnCodes error -body {
    lsearch -glib {b.x bx xy bcx} b.x
} -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
} -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices}
test lsearch-2.11 {search modes with -nocase} {
    lsearch -exact -nocase {a b c A B C} A
} 0
test lsearch-2.12 {search modes with -nocase} {
    lsearch -glob -nocase {a b c A B C} A*
} 0
test lsearch-2.13 {search modes with -nocase} {
83
84
85
86
87
88
89
90

91
92
93

94
95
96
97
98
99
100
83
84
85
86
87
88
89

90
91
92

93
94
95
96
97
98
99
100







-
+


-
+







    lsearch
} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
test lsearch-3.2 {lsearch errors} -returnCodes error -body {
    lsearch a
} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
test lsearch-3.3 {lsearch errors} -returnCodes error -body {
    lsearch a b c
} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices}
test lsearch-3.4 {lsearch errors} -returnCodes error -body {
    lsearch a b c d
} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices}
test lsearch-3.5 {lsearch errors} -returnCodes error -body {
    lsearch "\{" b
} -result {unmatched open brace in list}
test lsearch-3.6 {lsearch errors} -returnCodes error -body {
    lsearch -index a b
} -result {"-index" option must be followed by list index}
test lsearch-3.7 {lsearch errors} -returnCodes error -body {
414
415
416
417
418
419
420




























421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438

439
440
441

442
443
444

445
446
447

448
449
450

451
452









453
454
455
456
457
458
459
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465

466
467
468

469
470
471

472
473
474

475
476
477

478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

















-
+


-
+


-
+


-
+


-
+


+
+
+
+
+
+
+
+
+







} {0 1}
test lsearch-17.6 {lsearch -index option, basic functionality} {
    lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b*
} {1 2}
test lsearch-17.7 {lsearch -index option, basic functionality} {
    lsearch -all -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
} {0 1}
test lsearch-17.8 {lsearch -index option, empty argument} {
    lsearch -index {} a a
} 0
test lsearch-17.9 {lsearch -index option, empty argument} {
    lsearch -index {} a a
} [lsearch a a]
test lsearch-17.10 {lsearch -index option, empty argument} {
    lsearch -index {} [list \{] \{
} 0
test lsearch-17.11 {lsearch -index option, empty argument} {
    lsearch -index {} [list \{] \{
} [lsearch [list \{] \{]
test lsearch-17.12 {lsearch -index option, encoding aliasing} -body {
    lsearch -index -2 a a
} -returnCodes error -result {index "-2" cannot select an element from any list}
test lsearch-17.13 {lsearch -index option, encoding aliasing} -body {
    lsearch -index -1-1 a a
} -returnCodes error -result {index "-1-1" cannot select an element from any list}
test lsearch-17.14 {lsearch -index option, encoding aliasing} -body {
    lsearch -index end--1 a a
} -returnCodes error -result {index "end--1" cannot select an element from any list}
test lsearch-17.15 {lsearch -index option, encoding aliasing} -body {
    lsearch -index end+1 a a
} -returnCodes error -result {index "end+1" cannot select an element from any list}
test lsearch-17.16 {lsearch -index option, encoding aliasing} -body {
    lsearch -index end+2 a a
} -returnCodes error -result {index "end+2" cannot select an element from any list}


test lsearch-18.1 {lsearch -index option, list as index basic functionality} {
    lsearch -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} 1
test lsearch-18.2 {lsearch -index option, list as index basic functionality} {
    lsearch -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} 0
test lsearch-18.3 {lsearch -index option, list as index basic functionality} {
    lsearch -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
} 0
test lsearch-18.4 {lsearch -index option, list as index basic functionality} {
    lsearch -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
} 0
test lsearch-18.5 {lsearch -index option, list as index basic functionality} {
    lsearch -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {0 1}

test lsearch-19.1 {lsearch -sunindices option} {
test lsearch-19.1 {lsearch -subindices option} {
    lsearch -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {1 0 0}
test lsearch-19.2 {lsearch -sunindices option} {
test lsearch-19.2 {lsearch -subindices option} {
    lsearch -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {0 2 0}
test lsearch-19.3 {lsearch -sunindices option} {
test lsearch-19.3 {lsearch -subindices option} {
    lsearch -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
} {0 1 1}
test lsearch-19.4 {lsearch -sunindices option} {
test lsearch-19.4 {lsearch -subindices option} {
    lsearch -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
} {0 0 1}
test lsearch-19.5 {lsearch -sunindices option} {
test lsearch-19.5 {lsearch -subindices option} {
    lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {{0 0 0} {1 0 0}}
test lsearch-19.6 {lsearch -subindices option} {
    lsearch -subindices -all -index {1 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {{0 1 0} {1 1 0}}
test lsearch-19.7 {lsearch -subindices option} {
    lsearch -subindices -index end {{1 a}} a
} {0 1}
test lsearch-19.8 {lsearch -subindices option} {
    lsearch -subindices -all -index end {{1 a}} a
} {{0 1}}

test lsearch-20.1 {lsearch -index option, index larger than sublists} -body {
    lsearch -index 2 {{a c} {a b} {a a}} a
} -returnCodes error -result {element 2 missing from sublist "a c"}
test lsearch-20.2 {lsearch -index option, malformed index} -body {
    lsearch -index foo {{a c} {a b} {a a}} a
} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
505
506
507
508
509
510
511















































































































































512
513
514
515
516
517
518
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







} -result {10 8 5 2}
test lsearch-22.5 {lsearch -bisect, all equal} {
    lsearch -bisect -integer {5 5 5 5} 5
} {3}
test lsearch-22.6 {lsearch -sorted, all equal} {
    lsearch -sorted -integer {5 5 5 5} 5
} {0}

test lsearch-23.1 {lsearch -stride option, errors} -body {
    lsearch -stride {a b} a
} -returnCodes error -result {"-stride" option must be followed by stride length}
test lsearch-23.2 {lsearch -stride option, errors} -body {
    lsearch -stride 0 {a b} a
} -returnCodes error -result {stride length must be at least 1}
test lsearch-23.3 {lsearch -stride option, errors} -body {
    lsearch -stride 2 {a b c} a
} -returnCodes error -result {list size must be a multiple of the stride length}
test lsearch-23.4 {lsearch -stride option, errors} -body {
    lsearch -stride 5 {a b c} a
} -returnCodes error -result {list size must be a multiple of the stride length}
test lsearch-23.5 {lsearch -stride option, errors} -body {
    # Stride equal to length is ok
    lsearch -stride 3 {a b c} a
} -result 0

test lsearch-24.1 {lsearch -stride option} -body {
    lsearch -stride 2 {a b c d e f g h} d
} -result -1
test lsearch-24.2 {lsearch -stride option} -body {
    lsearch -stride 2 {a b c d e f g h} e
} -result 4
test lsearch-24.3 {lsearch -stride option} -body {
    lsearch -stride 3 {a b c d e f g h i} e
} -result -1
test lsearch-24.4 {lsearch -stride option} -body {
    # Result points first in group
    lsearch -stride 3 -index 1 {a b c d e f g h i} e
} -result 3
test lsearch-24.5 {lsearch -stride option} -body {
    lsearch -inline -stride 2 {a b c d e f g h} d
} -result {}
test lsearch-24.6 {lsearch -stride option} -body {
    # Inline result is a "single element" strided list
    lsearch -inline -stride 2 {a b c d e f g h} e
} -result "e f"
test lsearch-24.7 {lsearch -stride option} -body {
    lsearch -inline -stride 3 {a b c d e f g h i} e
} -result {}
test lsearch-24.8 {lsearch -stride option} -body {
    lsearch -inline -stride 3 -index 1 {a b c d e f g h i} e
} -result "d e f"
test lsearch-24.9 {lsearch -stride option} -body {
    lsearch -all -inline -stride 3 -index 1 {a b c d e f g e i} e
} -result "d e f g e i"
test lsearch-24.10 {lsearch -stride option} -body {
    lsearch -all -inline -stride 3 -index 0 {a b c d e f a e i} a
} -result "a b c a e i"
test lsearch-24.11 {lsearch -stride option} -body {
    # Stride 1 is same as no stride
    lsearch -stride 1 {a b c d e f g h} d
} -result 3

# 25* mimics 19* but with -inline added to -subindices
test lsearch-25.1 {lsearch -subindices option} {
    lsearch -inline -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {a}
test lsearch-25.2 {lsearch -subindices option} {
    lsearch -inline -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {a}
test lsearch-25.3 {lsearch -subindices option} {
    lsearch -inline -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
} {bb}
test lsearch-25.4 {lsearch -subindices option} {
    lsearch -inline -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
} {cb}
test lsearch-25.5 {lsearch -subindices option} {
    lsearch -inline -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {a a}
test lsearch-25.6 {lsearch -subindices option} {
    lsearch -inline -subindices -all -index {1 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {a a}

# 26* mimics 19* but with -stride added
test lsearch-26.1 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -index {0 0} {{x x} {x b} {a d} {a c} {a b} {a a}} a
} {3 0}
test lsearch-26.2 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -index {2 0} -exact {{x x} {x b} {a d} {a c} {a b} {a a}} a
} {2 0}
test lsearch-26.3 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -index {1 1} -glob {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} b*
} {1 1}
test lsearch-26.4 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -index {0 1} -regexp {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} {[cb]b}
} {0 1}
test lsearch-26.5 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -all -index {0 0} -exact {{a c} {a b} {d a} {a c} {a b} {d a}} a
} {{0 0} {3 0}}
test lsearch-26.6 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -all -index {1 0} -exact {{a c} {a b} {d a} {x c} {a b} {d a}} a
} {{1 0} {4 0}}

# 27* mimics 25* but with -stride added
test lsearch-27.1 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -index {0 0} {{x x} {x b} {a d} {a c} {a b} {a a}} a
} {a}
test lsearch-27.2 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -index {2 0} -exact {{x x} {x b} {a d} {a c} {a b} {a a}} a
} {a}
test lsearch-27.3 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -index {1 1} -glob {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} b*
} {bb}
test lsearch-27.4 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -index {0 1} -regexp {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} {[cb]b}
} {cb}
test lsearch-27.5 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -all -index {0 0} -exact {{a c} {a b} {d a} {a c} {a b} {d a}} a
} {a a}
test lsearch-27.6 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -all -index {1 0} -exact {{a c} {a b} {d a} {x c} {a b} {d a}} a
} {a a}

test lsearch-28.1 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 5
} -result 0
test lsearch-28.2 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 3
} -result -1
test lsearch-28.3 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 7
} -result 2
test lsearch-28.4 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 8
} -result -1
test lsearch-28.5 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 9
} -result 4
test lsearch-28.6 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 2
} -result -1
test lsearch-28.7 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 0 -subindices {5 3 7 8 9 2} 9
} -result 4
test lsearch-28.8 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 1 -subindices {3 5 8 7 2 9} 9
} -result 5
test lsearch-28.9 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 1 -subindices -inline {3 5 8 7 2 9} 9
} -result 9


# cleanup
catch {unset res}
catch {unset increasingIntegers}
catch {unset decreasingIntegers}
catch {unset increasingDoubles}
catch {unset decreasingDoubles}

Changes to tests/macOSXFCmd.test.

95
96
97
98
99
100
101
102

103
104
105
106
107
108
109
95
96
97
98
99
100
101

102
103
104
105
106
107
108
109







-
+







test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} {
    catch {file delete -force -- foo.test}
    close [open foo.test w]
    list [catch {file attributes foo.test -hidden 1} msg] $msg \
	    [catch {file attributes foo.test -hidden} msg] $msg \
	    [file delete -force -- foo.test]
} {0 {} 0 1 {}}
test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot} {
test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} {
    catch {file delete -force -- foo.test}
    close [open foo.test w]
    catch {
	set f [open foo.test/..namedfork/rsrc w]
	fconfigure $f -translation lf -eofchar {}
	puts -nonewline $f "foo"
	close $f
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163










164
165
166
167
168
169
170
147
148
149
150
151
152
153










154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170







-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+







	file attributes baz.test -creator FOOC -type FOOT
	file attributes foo.test -creator FOOC
	file attributes inv.test -hidden 1
	file attributes inw.test -hidden 1 -type FOOT
	file attributes dir.test -hidden 1
    }
    set res [list \
	    [catch {glob *.test} msg] $msg \
	    [catch {glob -types FOOT *.test} msg] $msg \
	    [catch {glob -types {{macintosh type FOOT}} *.test} msg] $msg \
	    [catch {glob -types FOOTT *.test} msg] $msg \
	    [catch {glob -types {{macintosh type FOOTT}} *.test} msg] $msg \
	    [catch {glob -types {{macintosh type {}}} *.test} msg] $msg \
	    [catch {glob -types {{macintosh creator FOOC}} *.test} msg] $msg \
	    [catch {glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test} msg] $msg \
	    [catch {glob -types hidden *.test} msg] $msg \
	    [catch {glob -types {hidden FOOT} *.test} msg] $msg \
	    [catch {lsort [glob *.test]} msg] $msg \
	    [catch {lsort [glob -types FOOT *.test]} msg] $msg \
	    [catch {lsort [glob -types {{macintosh type FOOT}} *.test]} msg] $msg \
	    [catch {lsort [glob -types FOOTT *.test]} msg] $msg \
	    [catch {lsort [glob -types {{macintosh type FOOTT}} *.test]} msg] $msg \
	    [catch {lsort [glob -types {{macintosh type {}}} *.test]} msg] $msg \
	    [catch {lsort [glob -types {{macintosh creator FOOC}} *.test]} msg] $msg \
	    [catch {lsort [glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test]} msg] $msg \
	    [catch {lsort [glob -types hidden *.test]} msg] $msg \
	    [catch {lsort [glob -types {hidden FOOT} *.test]} msg] $msg \
	]
    cd ..
    file delete -force globtest
    set res
} [list \
	0 {bar.test baz.test dir.test foo.test inv.test inw.test reg.test} \
	0 {bar.test baz.test inw.test} 0 {bar.test baz.test inw.test} \

Changes to tests/main.test.

1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1206
1207
1208
1209
1210
1211
1212


1213
1214
1215
1216
1217
1218
1219







-
-







	file delete result
    } -result "1\nExit MainLoop\n"

    test Tcl_Main-8.13 {
	Bug 1775878
    } -constraints {
	exec Tcltest
    } -setup {
	catch {set f [open "|[list [interpreter]]" w+]}
    } -body {
	exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result

Changes to tests/mathop.test.

110
111
112
113
114
115
116
117

118
119
120

121
122
123

124
125
126

127
128
129

130
131
132

133
134
135
136
137
138
139
110
111
112
113
114
115
116

117
118
119

120
121
122

123
124
125

126
127
128

129
130
131

132
133
134
135
136
137
138
139







-
+


-
+


-
+


-
+


-
+


-
+







    test mathop-1.6 {compiled +} { + 1 2 3.0 } 6.0
    test mathop-1.7 {compiled +} { + 100000000000 2 3 } 100000000005
    test mathop-1.8 {compiled +} { + 1 2 300000000000 } 300000000003
    test mathop-1.9 {compiled +} { + 1000000000000000000000 2 3 } 1000000000000000000005
    test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003
    test mathop-1.11 {compiled +: errors} -returnCodes error -body {
	+ x 0
    } -result {can't use non-numeric string "x" as operand of "+"}
    } -result {can't use non-numeric string as operand of "+"}
    test mathop-1.12 {compiled +: errors} -returnCodes error -body {
	+ nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
    } -result {can't use non-numeric floating-point value as operand of "+"}
    test mathop-1.13 {compiled +: errors} -returnCodes error -body {
	+ 0 x
    } -result {can't use non-numeric string "x" as operand of "+"}
    } -result {can't use non-numeric string as operand of "+"}
    test mathop-1.14 {compiled +: errors} -returnCodes error -body {
	+ 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
    } -result {can't use non-numeric floating-point value as operand of "+"}
    test mathop-1.15 {compiled +: errors} -returnCodes error -body {
	+ 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "+"}
    } -result {can't use invalid octal number as operand of "+"}
    test mathop-1.16 {compiled +: errors} -returnCodes error -body {
	+ 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "+"}
    } -result {can't use invalid octal number as operand of "+"}
    test mathop-1.17 {compiled +: errors} -returnCodes error -body {
	+ 0 [error expectedError]
    } -result expectedError
    test mathop-1.18 {compiled +: argument processing order} -body {
	# Bytecode compilation known hard for 3+ arguments
	list [catch {
	    + [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
148
149
150
151
152
153
154
155

156
157
158

159
160
161

162
163
164

165
166
167

168
169
170

171
172
173
174
175
176
177
148
149
150
151
152
153
154

155
156
157

158
159
160

161
162
163

164
165
166

167
168
169

170
171
172
173
174
175
176
177







-
+


-
+


-
+


-
+


-
+


-
+







    test mathop-1.24 {interpreted +} { $op 1 2 3.0 } 6.0
    test mathop-1.25 {interpreted +} { $op 100000000000 2 3 } 100000000005
    test mathop-1.26 {interpreted +} { $op 1 2 300000000000 } 300000000003
    test mathop-1.27 {interpreted +} { $op 1000000000000000000000 2 3 } 1000000000000000000005
    test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003
    test mathop-1.29 {interpreted +: errors} -returnCodes error -body {
	$op x 0
    } -result {can't use non-numeric string "x" as operand of "+"}
    } -result {can't use non-numeric string as operand of "+"}
    test mathop-1.30 {interpreted +: errors} -returnCodes error -body {
	$op nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
    } -result {can't use non-numeric floating-point value as operand of "+"}
    test mathop-1.31 {interpreted +: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" as operand of "+"}
    } -result {can't use non-numeric string as operand of "+"}
    test mathop-1.32 {interpreted +: errors} -returnCodes error -body {
	$op 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
    } -result {can't use non-numeric floating-point value as operand of "+"}
    test mathop-1.33 {interpreted +: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "+"}
    } -result {can't use invalid octal number as operand of "+"}
    test mathop-1.34 {interpreted +: errors} -returnCodes error -body {
	$op 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "+"}
    } -result {can't use invalid octal number as operand of "+"}
    test mathop-1.35 {interpreted +: errors} -returnCodes error -body {
	$op 0 [error expectedError]
    } -result expectedError
    test mathop-1.36 {interpreted +: argument processing order} -body {
	list [catch {
	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
185
186
187
188
189
190
191
192

193
194
195

196
197
198

199
200
201

202
203
204

205
206
207

208
209
210
211
212
213
214
185
186
187
188
189
190
191

192
193
194

195
196
197

198
199
200

201
202
203

204
205
206

207
208
209
210
211
212
213
214







-
+


-
+


-
+


-
+


-
+


-
+







    test mathop-2.6 {compiled *} { * 1 2 3.0 } 6.0
    test mathop-2.7 {compiled *} { * 100000000000 2 3 } 600000000000
    test mathop-2.8 {compiled *} { * 1 2 300000000000 } 600000000000
    test mathop-2.9 {compiled *} { * 1000000000000000000000 2 3 } 6000000000000000000000
    test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000
    test mathop-2.11 {compiled *: errors} -returnCodes error -body {
	* x 0
    } -result {can't use non-numeric string "x" as operand of "*"}
    } -result {can't use non-numeric string as operand of "*"}
    test mathop-2.12 {compiled *: errors} -returnCodes error -body {
	* nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
    } -result {can't use non-numeric floating-point value as operand of "*"}
    test mathop-2.13 {compiled *: errors} -returnCodes error -body {
	* 0 x
    } -result {can't use non-numeric string "x" as operand of "*"}
    } -result {can't use non-numeric string as operand of "*"}
    test mathop-2.14 {compiled *: errors} -returnCodes error -body {
	* 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
    } -result {can't use non-numeric floating-point value as operand of "*"}
    test mathop-2.15 {compiled *: errors} -returnCodes error -body {
	* 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "*"}
    } -result {can't use invalid octal number as operand of "*"}
    test mathop-2.16 {compiled *: errors} -returnCodes error -body {
	* 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "*"}
    } -result {can't use invalid octal number as operand of "*"}
    test mathop-2.17 {compiled *: errors} -returnCodes error -body {
	* 0 [error expectedError]
    } -result expectedError
    test mathop-2.18 {compiled *: argument processing order} -body {
	# Bytecode compilation known hard for 3+ arguments
	list [catch {
	    * [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
223
224
225
226
227
228
229
230

231
232
233

234
235
236

237
238
239

240
241
242

243
244
245

246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264

265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281

282
283
284
285
286
287
288
289
290

291
292
293

294
295
296
297
298
299
300
301
302
303
304

305
306
307
308
309
310
311
312
313

314
315
316

317
318
319
320
321
322
323
324
325
326
327

328
329
330
331
332
333
334
335
336

337
338
339

340
341
342
343
344
345
346
223
224
225
226
227
228
229

230
231
232

233
234
235

236
237
238

239
240
241

242
243
244

245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263

264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280

281
282
283
284
285
286
287
288
289

290
291
292

293
294
295
296
297
298
299
300
301
302
303

304
305
306
307
308
309
310
311
312

313
314
315

316
317
318
319
320
321
322
323
324
325
326

327
328
329
330
331
332
333
334
335

336
337
338

339
340
341
342
343
344
345
346







-
+


-
+


-
+


-
+


-
+


-
+


















-
+
















-
+








-
+


-
+










-
+








-
+


-
+










-
+








-
+


-
+







    test mathop-2.24 {interpreted *} { $op 1 2 3.0 } 6.0
    test mathop-2.25 {interpreted *} { $op 100000000000 2 3 } 600000000000
    test mathop-2.26 {interpreted *} { $op 1 2 300000000000 } 600000000000
    test mathop-2.27 {interpreted *} { $op 1000000000000000000000 2 3 } 6000000000000000000000
    test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000
    test mathop-2.29 {interpreted *: errors} -returnCodes error -body {
	$op x 0
    } -result {can't use non-numeric string "x" as operand of "*"}
    } -result {can't use non-numeric string as operand of "*"}
    test mathop-2.30 {interpreted *: errors} -returnCodes error -body {
	$op nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
    } -result {can't use non-numeric floating-point value as operand of "*"}
    test mathop-2.31 {interpreted *: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" as operand of "*"}
    } -result {can't use non-numeric string as operand of "*"}
    test mathop-2.32 {interpreted *: errors} -returnCodes error -body {
	$op 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
    } -result {can't use non-numeric floating-point value as operand of "*"}
    test mathop-2.33 {interpreted *: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "*"}
    } -result {can't use invalid octal number as operand of "*"}
    test mathop-2.34 {interpreted *: errors} -returnCodes error -body {
	$op 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "*"}
    } -result {can't use invalid octal number as operand of "*"}
    test mathop-2.35 {interpreted *: errors} -returnCodes error -body {
	$op 0 [error expectedError]
    } -result expectedError
    test mathop-2.36 {interpreted *: argument processing order} -body {
	list [catch {
	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
    } -result {1 expected 2}

    test mathop-3.1 {compiled !} {! 0} 1
    test mathop-3.2 {compiled !} {! 1} 0
    test mathop-3.3 {compiled !} {! false} 1
    test mathop-3.4 {compiled !} {! true} 0
    test mathop-3.5 {compiled !} {! 0.0} 1
    test mathop-3.6 {compiled !} {! 10000000000} 0
    test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0
    test mathop-3.8 {compiled !: errors} -body {
	! foobar
    } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
    } -returnCodes error -result {can't use non-numeric string as operand of "!"}
    test mathop-3.9 {compiled !: errors} -body {
	! 0 0
    } -returnCodes error -result "wrong # args: should be \"! boolean\""
    test mathop-3.10 {compiled !: errors} -body {
	!
    } -returnCodes error -result "wrong # args: should be \"! boolean\""
    set op !
    test mathop-3.11 {interpreted !} {$op 0} 1
    test mathop-3.12 {interpreted !} {$op 1} 0
    test mathop-3.13 {interpreted !} {$op false} 1
    test mathop-3.14 {interpreted !} {$op true} 0
    test mathop-3.15 {interpreted !} {$op 0.0} 1
    test mathop-3.16 {interpreted !} {$op 10000000000} 0
    test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0
    test mathop-3.18 {interpreted !: errors} -body {
	$op foobar
    } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
    } -returnCodes error -result {can't use non-numeric string as operand of "!"}
    test mathop-3.19 {interpreted !: errors} -body {
	$op 0 0
    } -returnCodes error -result "wrong # args: should be \"! boolean\""
    test mathop-3.20 {interpreted !: errors} -body {
	$op
    } -returnCodes error -result "wrong # args: should be \"! boolean\""
    test mathop-3.21 {compiled !: error} -returnCodes error -body {
	! NaN
    } -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
    } -result {can't use non-numeric floating-point value as operand of "!"}
    test mathop-3.22 {interpreted !: error} -returnCodes error -body {
	$op NaN
    } -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
    } -result {can't use non-numeric floating-point value as operand of "!"}

    test mathop-4.1 {compiled ~} {~ 0} -1
    test mathop-4.2 {compiled ~} {~ 1} -2
    test mathop-4.3 {compiled ~} {~ 31} -32
    test mathop-4.4 {compiled ~} {~ -127} 126
    test mathop-4.5 {compiled ~} {~ -0} -1
    test mathop-4.6 {compiled ~} {~ 10000000000} -10000000001
    test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001
    test mathop-4.8 {compiled ~: errors} -body {
	~ foobar
    } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
    } -returnCodes error -result {can't use non-numeric string as operand of "~"}
    test mathop-4.9 {compiled ~: errors} -body {
	~ 0 0
    } -returnCodes error -result "wrong # args: should be \"~ integer\""
    test mathop-4.10 {compiled ~: errors} -body {
	~
    } -returnCodes error -result "wrong # args: should be \"~ integer\""
    test mathop-4.11 {compiled ~: errors} -returnCodes error -body {
	~ 0.0
    } -result {can't use floating-point value "0.0" as operand of "~"}
    } -result {can't use floating-point value as operand of "~"}
    test mathop-4.12 {compiled ~: errors} -returnCodes error -body {
	~ NaN
    } -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
    } -result {can't use non-numeric floating-point value as operand of "~"}
    set op ~
    test mathop-4.13 {interpreted ~} {$op 0} -1
    test mathop-4.14 {interpreted ~} {$op 1} -2
    test mathop-4.15 {interpreted ~} {$op 31} -32
    test mathop-4.16 {interpreted ~} {$op -127} 126
    test mathop-4.17 {interpreted ~} {$op -0} -1
    test mathop-4.18 {interpreted ~} {$op 10000000000} -10000000001
    test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001
    test mathop-4.20 {interpreted ~: errors} -body {
	$op foobar
    } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
    } -returnCodes error -result {can't use non-numeric string as operand of "~"}
    test mathop-4.21 {interpreted ~: errors} -body {
	$op 0 0
    } -returnCodes error -result "wrong # args: should be \"~ integer\""
    test mathop-4.22 {interpreted ~: errors} -body {
	$op
    } -returnCodes error -result "wrong # args: should be \"~ integer\""
    test mathop-4.23 {interpreted ~: errors} -returnCodes error -body {
	$op 0.0
    } -result {can't use floating-point value "0.0" as operand of "~"}
    } -result {can't use floating-point value as operand of "~"}
    test mathop-4.24 {interpreted ~: errors} -returnCodes error -body {
	$op NaN
    } -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
    } -result {can't use non-numeric floating-point value as operand of "~"}

    test mathop-5.1 {compiled eq} {eq {} a} 0
    test mathop-5.2 {compiled eq} {eq a a} 1
    test mathop-5.3 {compiled eq} {eq a {}} 0
    test mathop-5.4 {compiled eq} {eq a b} 0
    test mathop-5.5 {compiled eq} { eq } 1
    test mathop-5.6 {compiled eq} {eq a} 1
373
374
375
376
377
378
379
380

381
382
383

384
385
386
387
388
389
390

391
392
393

394
395
396

397
398
399

400
401
402

403
404
405

406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422

423
424
425

426
427
428
429
430
431
432

433
434
435

436
437
438

439
440
441

442
443
444

445
446
447

448
449
450
451
452
453
454
373
374
375
376
377
378
379

380
381
382

383
384
385
386
387
388
389

390
391
392

393
394
395

396
397
398

399
400
401

402
403
404

405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421

422
423
424

425
426
427
428
429
430
431

432
433
434

435
436
437

438
439
440

441
442
443

444
445
446

447
448
449
450
451
452
453
454







-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+
















-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+








    test mathop-6.1 {compiled &} { & } -1
    test mathop-6.2 {compiled &} { & 1 } 1
    test mathop-6.3 {compiled &} { & 1 2 } 0
    test mathop-6.4 {compiled &} { & 3 7 6 } 2
    test mathop-6.5 {compiled &} -returnCodes error -body {
	& 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "&"}
    } -result {can't use floating-point value as operand of "&"}
    test mathop-6.6 {compiled &} -returnCodes error -body {
	& 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "&"}
    } -result {can't use floating-point value as operand of "&"}
    test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2
    test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85
    test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2
    test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85
    test mathop-6.11 {compiled &: errors} -returnCodes error -body {
	& x 0
    } -result {can't use non-numeric string "x" as operand of "&"}
    } -result {can't use non-numeric string as operand of "&"}
    test mathop-6.12 {compiled &: errors} -returnCodes error -body {
	& nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
    } -result {can't use non-numeric floating-point value as operand of "&"}
    test mathop-6.13 {compiled &: errors} -returnCodes error -body {
	& 0 x
    } -result {can't use non-numeric string "x" as operand of "&"}
    } -result {can't use non-numeric string as operand of "&"}
    test mathop-6.14 {compiled &: errors} -returnCodes error -body {
	& 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
    } -result {can't use non-numeric floating-point value as operand of "&"}
    test mathop-6.15 {compiled &: errors} -returnCodes error -body {
	& 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "&"}
    } -result {can't use invalid octal number as operand of "&"}
    test mathop-6.16 {compiled &: errors} -returnCodes error -body {
	& 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "&"}
    } -result {can't use invalid octal number as operand of "&"}
    test mathop-6.17 {compiled &: errors} -returnCodes error -body {
	& 0 [error expectedError]
    } -result expectedError
    test mathop-6.18 {compiled &: argument processing order} -body {
	# Bytecode compilation known hard for 3+ arguments
	list [catch {
	    & [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
    } -result {1 expected 2}
    set op &
    test mathop-6.19 {interpreted &} { $op } -1
    test mathop-6.20 {interpreted &} { $op 1 } 1
    test mathop-6.21 {interpreted &} { $op 1 2 } 0
    test mathop-6.22 {interpreted &} { $op 3 7 6 } 2
    test mathop-6.23 {interpreted &} -returnCodes error -body {
	$op 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "&"}
    } -result {can't use floating-point value as operand of "&"}
    test mathop-6.24 {interpreted &} -returnCodes error -body {
	$op 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "&"}
    } -result {can't use floating-point value as operand of "&"}
    test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2
    test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85
    test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2
    test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85
    test mathop-6.29 {interpreted &: errors} -returnCodes error -body {
	$op x 0
    } -result {can't use non-numeric string "x" as operand of "&"}
    } -result {can't use non-numeric string as operand of "&"}
    test mathop-6.30 {interpreted &: errors} -returnCodes error -body {
	$op nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
    } -result {can't use non-numeric floating-point value as operand of "&"}
    test mathop-6.31 {interpreted &: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" as operand of "&"}
    } -result {can't use non-numeric string as operand of "&"}
    test mathop-6.32 {interpreted &: errors} -returnCodes error -body {
	$op 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
    } -result {can't use non-numeric floating-point value as operand of "&"}
    test mathop-6.33 {interpreted &: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "&"}
    } -result {can't use invalid octal number as operand of "&"}
    test mathop-6.34 {interpreted &: errors} -returnCodes error -body {
	$op 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "&"}
    } -result {can't use invalid octal number as operand of "&"}
    test mathop-6.35 {interpreted &: errors} -returnCodes error -body {
	$op 0 [error expectedError]
    } -result expectedError
    test mathop-6.36 {interpreted &: argument processing order} -body {
	list [catch {
	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
483
484
485
486
487
488
489
490

491
492
493

494
495
496
497
498
499
500

501
502
503

504
505
506

507
508
509

510
511
512

513
514
515

516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532

533
534
535

536
537
538
539
540
541
542

543
544
545

546
547
548

549
550
551

552
553
554

555
556
557

558
559
560
561
562
563
564
483
484
485
486
487
488
489

490
491
492

493
494
495
496
497
498
499

500
501
502

503
504
505

506
507
508

509
510
511

512
513
514

515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531

532
533
534

535
536
537
538
539
540
541

542
543
544

545
546
547

548
549
550

551
552
553

554
555
556

557
558
559
560
561
562
563
564







-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+
















-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+








    test mathop-7.1 {compiled |} { | } 0
    test mathop-7.2 {compiled |} { | 1 } 1
    test mathop-7.3 {compiled |} { | 1 2 } 3
    test mathop-7.4 {compiled |} { | 3 7 6 } 7
    test mathop-7.5 {compiled |} -returnCodes error -body {
	| 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "|"}
    } -result {can't use floating-point value as operand of "|"}
    test mathop-7.6 {compiled |} -returnCodes error -body {
	| 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "|"}
    } -result {can't use floating-point value as operand of "|"}
    test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110
    test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503
    test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110
    test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503
    test mathop-7.11 {compiled |: errors} -returnCodes error -body {
	| x 0
    } -result {can't use non-numeric string "x" as operand of "|"}
    } -result {can't use non-numeric string as operand of "|"}
    test mathop-7.12 {compiled |: errors} -returnCodes error -body {
	| nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
    } -result {can't use non-numeric floating-point value as operand of "|"}
    test mathop-7.13 {compiled |: errors} -returnCodes error -body {
	| 0 x
    } -result {can't use non-numeric string "x" as operand of "|"}
    } -result {can't use non-numeric string as operand of "|"}
    test mathop-7.14 {compiled |: errors} -returnCodes error -body {
	| 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
    } -result {can't use non-numeric floating-point value as operand of "|"}
    test mathop-7.15 {compiled |: errors} -returnCodes error -body {
	| 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "|"}
    } -result {can't use invalid octal number as operand of "|"}
    test mathop-7.16 {compiled |: errors} -returnCodes error -body {
	| 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "|"}
    } -result {can't use invalid octal number as operand of "|"}
    test mathop-7.17 {compiled |: errors} -returnCodes error -body {
	| 0 [error expectedError]
    } -result expectedError
    test mathop-7.18 {compiled |: argument processing order} -body {
	# Bytecode compilation known hard for 3+ arguments
	list [catch {
	    | [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
    } -result {1 expected 2}
    set op |
    test mathop-7.19 {interpreted |} { $op } 0
    test mathop-7.20 {interpreted |} { $op 1 } 1
    test mathop-7.21 {interpreted |} { $op 1 2 } 3
    test mathop-7.22 {interpreted |} { $op 3 7 6 } 7
    test mathop-7.23 {interpreted |} -returnCodes error -body {
	$op 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "|"}
    } -result {can't use floating-point value as operand of "|"}
    test mathop-7.24 {interpreted |} -returnCodes error -body {
	$op 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "|"}
    } -result {can't use floating-point value as operand of "|"}
    test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110
    test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503
    test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110
    test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503
    test mathop-7.29 {interpreted |: errors} -returnCodes error -body {
	$op x 0
    } -result {can't use non-numeric string "x" as operand of "|"}
    } -result {can't use non-numeric string as operand of "|"}
    test mathop-7.30 {interpreted |: errors} -returnCodes error -body {
	$op nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
    } -result {can't use non-numeric floating-point value as operand of "|"}
    test mathop-7.31 {interpreted |: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" as operand of "|"}
    } -result {can't use non-numeric string as operand of "|"}
    test mathop-7.32 {interpreted |: errors} -returnCodes error -body {
	$op 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
    } -result {can't use non-numeric floating-point value as operand of "|"}
    test mathop-7.33 {interpreted |: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "|"}
    } -result {can't use invalid octal number as operand of "|"}
    test mathop-7.34 {interpreted |: errors} -returnCodes error -body {
	$op 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "|"}
    } -result {can't use invalid octal number as operand of "|"}
    test mathop-7.35 {interpreted |: errors} -returnCodes error -body {
	$op 0 [error expectedError]
    } -result expectedError
    test mathop-7.36 {interpreted |: argument processing order} -body {
	list [catch {
	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
593
594
595
596
597
598
599
600

601
602
603

604
605
606
607
608
609
610

611
612
613

614
615
616

617
618
619

620
621
622

623
624
625

626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642

643
644
645

646
647
648
649
650
651
652

653
654
655

656
657
658

659
660
661

662
663
664

665
666
667

668
669
670
671
672
673
674
593
594
595
596
597
598
599

600
601
602

603
604
605
606
607
608
609

610
611
612

613
614
615

616
617
618

619
620
621

622
623
624

625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641

642
643
644

645
646
647
648
649
650
651

652
653
654

655
656
657

658
659
660

661
662
663

664
665
666

667
668
669
670
671
672
673
674







-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+
















-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+








    test mathop-8.1 {compiled ^} { ^ } 0
    test mathop-8.2 {compiled ^} { ^ 1 } 1
    test mathop-8.3 {compiled ^} { ^ 1 2 } 3
    test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2
    test mathop-8.5 {compiled ^} -returnCodes error -body {
	^ 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "^"}
    } -result {can't use floating-point value as operand of "^"}
    test mathop-8.6 {compiled ^} -returnCodes error -body {
	^ 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "^"}
    } -result {can't use floating-point value as operand of "^"}
    test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110
    test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333
    test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110
    test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333
    test mathop-8.11 {compiled ^: errors} -returnCodes error -body {
	^ x 0
    } -result {can't use non-numeric string "x" as operand of "^"}
    } -result {can't use non-numeric string as operand of "^"}
    test mathop-8.12 {compiled ^: errors} -returnCodes error -body {
	^ nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
    } -result {can't use non-numeric floating-point value as operand of "^"}
    test mathop-8.13 {compiled ^: errors} -returnCodes error -body {
	^ 0 x
    } -result {can't use non-numeric string "x" as operand of "^"}
    } -result {can't use non-numeric string as operand of "^"}
    test mathop-8.14 {compiled ^: errors} -returnCodes error -body {
	^ 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
    } -result {can't use non-numeric floating-point value as operand of "^"}
    test mathop-8.15 {compiled ^: errors} -returnCodes error -body {
	^ 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "^"}
    } -result {can't use invalid octal number as operand of "^"}
    test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
	^ 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "^"}
    } -result {can't use invalid octal number as operand of "^"}
    test mathop-8.17 {compiled ^: errors} -returnCodes error -body {
	^ 0 [error expectedError]
    } -result expectedError
    test mathop-8.18 {compiled ^: argument processing order} -body {
	# Bytecode compilation known hard for 3+ arguments
	list [catch {
	    ^ [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
    } -result {1 expected 2}
    set op ^
    test mathop-8.19 {interpreted ^} { $op } 0
    test mathop-8.20 {interpreted ^} { $op 1 } 1
    test mathop-8.21 {interpreted ^} { $op 1 2 } 3
    test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2
    test mathop-8.23 {interpreted ^} -returnCodes error -body {
	$op 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "^"}
    } -result {can't use floating-point value as operand of "^"}
    test mathop-8.24 {interpreted ^} -returnCodes error -body {
	$op 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "^"}
    } -result {can't use floating-point value as operand of "^"}
    test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110
    test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333
    test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110
    test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333
    test mathop-8.29 {interpreted ^: errors} -returnCodes error -body {
	$op x 0
    } -result {can't use non-numeric string "x" as operand of "^"}
    } -result {can't use non-numeric string as operand of "^"}
    test mathop-8.30 {interpreted ^: errors} -returnCodes error -body {
	$op nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
    } -result {can't use non-numeric floating-point value as operand of "^"}
    test mathop-8.31 {interpreted ^: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" as operand of "^"}
    } -result {can't use non-numeric string as operand of "^"}
    test mathop-8.32 {interpreted ^: errors} -returnCodes error -body {
	$op 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
    } -result {can't use non-numeric floating-point value as operand of "^"}
    test mathop-8.33 {interpreted ^: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "^"}
    } -result {can't use invalid octal number as operand of "^"}
    test mathop-8.34 {interpreted ^: errors} -returnCodes error -body {
	$op 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "^"}
    } -result {can't use invalid octal number as operand of "^"}
    test mathop-8.35 {interpreted ^: errors} -returnCodes error -body {
	$op 0 [error expectedError]
    } -result expectedError
    test mathop-8.36 {interpreted ^: argument processing order} -body {
	list [catch {
	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
771
772
773
774
775
776
777
778

779
780
781
782
783
784

785
786
787
788
789
790
791
771
772
773
774
775
776
777

778
779
780
781
782
783

784
785
786
787
788
789
790
791







-
+





-
+







test mathop-20.6 { one arg, error } {
    set res {}
    set exp {}
    foreach vals {x {1 x} {1 1 x} {1 x 1}} {
        # skipping - for now, knownbug...
        foreach op {+ * / & | ^ **} {
            lappend res [TestOp $op {*}$vals]
            lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\
            lappend exp "can't use non-numeric string as operand of \"$op\"\
		ARITH DOMAIN {non-numeric string}"
        }
    }
    foreach op {+ * / & | ^ **} {
	lappend res [TestOp $op NaN 1]
	lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\
	lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\
	    ARITH DOMAIN {non-numeric floating-point value}"
    }
    expr {$res eq $exp ? 0 : $res}
} 0
test mathop-20.7 { multi arg } {
    set res {}
    foreach vals {{1 2} {3 4 5} {4 3 2 1}} {
846
847
848
849
850
851
852
853

854
855

856
857

858
859

860
861

862
863
864
865
866
867
868
846
847
848
849
850
851
852

853
854

855
856

857
858

859
860

861
862
863
864
865
866
867
868







-
+

-
+

-
+

-
+

-
+







    set res
} [list 1.0 0.2 0.17857142857142858 -0.125 \
           2.8196218755553604e-15 8.10000006561e-27]
test mathop-21.5 { unary ops, bad values } {
    set res {}
    set exp {}
    lappend res [TestOp / x]
    lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp - x]
    lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp ~ x]
    lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp ! x]
    lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp ~ 5.0]
    lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}"
    lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}"
    expr {$res eq $exp ? 0 : $res}
} 0
test mathop-21.6 { unary ops, too many } {
    set exp {}
    foreach op {~ !} {
        set res [TestOp $op 7 8]
        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
961
962
963
964
965
966
967
968

969
970

971
972
973
974
975
976
977
961
962
963
964
965
966
967

968
969

970
971
972
973
974
975
976
977







-
+

-
+







           70720 \
          ]
test mathop-22.4 { unary ops, bad values } {
    set res {}
    set exp {}
    foreach op {& | ^} {
        lappend res [TestOp $op x 5]
        lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend res [TestOp $op 5 x]
        lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
    }
    expr {$res eq $exp ? 0 : $res}
} 0

test mathop-23.1 { comparison ops, numerical } {
    set res {}
    set todo {5 {1 6} {1 2 2 3} {4 3 2 1} {5.0 5.0} {6 3 3 1} {5.0 5}}
1076
1077
1078
1079
1080
1081
1082
1083

1084
1085

1086
1087
1088
1089

1090
1091

1092
1093
1094
1095
1096
1097
1098
1076
1077
1078
1079
1080
1081
1082

1083
1084

1085
1086
1087
1088

1089
1090

1091
1092
1093
1094
1095
1096
1097
1098







-
+

-
+



-
+

-
+







                                              0 \
          ]
test mathop-24.3 { binary ops, bad values } {
    set res {}
    set exp {}
    foreach op {% << >>} {
        lappend res [TestOp $op x 1]
        lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend res [TestOp $op 1 x]
        lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
    }
    foreach op {% << >>} {
        lappend res [TestOp $op 5.0 1]
        lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
        lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
        lappend res [TestOp $op 1 5.0]
        lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
        lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
    }
    foreach op {in ni} {
        lappend res [TestOp $op 5 "a b \{ c"]
        lappend exp "unmatched open brace in list TCL VALUE LIST BRACE"
    }
    lappend res [TestOp % 5 0]
    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
1236
1237
1238
1239
1240
1241
1242
1243

1244
1245

1246
1247
1248
1249
1250
1251
1252
1236
1237
1238
1239
1240
1241
1242

1243
1244

1245
1246
1247
1248
1249
1250
1251
1252







-
+

-
+







    lappend res [TestOp ** $small $wide]
    lappend exp "exponent too large NONE"
    lappend res [TestOp ** 2 $big]
    lappend exp "exponent too large NONE"
    lappend res [TestOp ** $huge 2.1]
    lappend exp "Inf"
    lappend res [TestOp ** 2 foo]
    lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp ** foo 2]
    lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"

    expr {$res eq $exp ? 0 : $res}
} 0

test mathop-26.1 { misc ops, size combinations } {
    set big1      12135435435354435435342423948763867876
    set big2       2746237174783836746262564892918327847

Changes to tests/msgcat.test.

51
52
53
54
55
56
57

58



59

60
61
62
63
64
65
66
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71







+

+
+
+

+







    variable body
    variable result
    variable setVars
    foreach setVars [PowerSet $envVars] {
	set result [string tolower [lindex $setVars 0]]
	if {[string length $result] == 0} {
	    if {[info exists ::tcl::mac::locale]} {
if {[package vsatisfies [package provide msgcat] 1.7]} {
		set result [string tolower \
			[msgcat::mcutil::ConvertLocale $::tcl::mac::locale]]
} else {
		set result [string tolower \
			[msgcat::ConvertLocale $::tcl::mac::locale]]
}
	    } else {
		if {([info sharedlibextension] eq ".dll")
			&& ![catch {package require registry}]} {
		    # Windows and Cygwin have other ways to determine the
		    # locale when the environment variables are missing
		    # and the registry package is present
		    continue
189
190
191
192
193
194
195






















196
197
198
199
200
201
202
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    test msgcat-1.13 {mclocale set, reject evil input} -setup {
	variable locale [mclocale]
    } -cleanup {
	mclocale $locale
    } -body {
	mclocale looks/ok/../../../../but/is/path/to/evil/code
    } -returnCodes error -match glob -result {invalid newLocale value *}

    test msgcat-1.14 {mcpreferences, custom locale preferences} -setup {
	variable locale [mclocale]
	mclocale en
	mcpreferences fr en {}
    } -cleanup {
	mclocale $locale
    } -body {
	mcpreferences
    } -result {fr en {}}

    test msgcat-1.15 {mcpreferences, overwrite custom locale preferences}\
    -setup {
	variable locale [mclocale]
	mcpreferences fr en {}
	mclocale en
    } -cleanup {
	mclocale $locale
    } -body {
	mcpreferences
    } -result {en {}}


    # Tests msgcat-2.*: [mcset], [mcmset], namespace partitioning

    test msgcat-2.1 {mcset, global scope} {
	namespace eval :: ::msgcat::mcset  foo_BAR text1 text2
    } {text2}

684
685
686
687
688
689
690
691

692
693
694
695
696
697
698
711
712
713
714
715
716
717

718
719
720
721
722
723
724
725







-
+







    removeDirectory msgdir3

    # Tests msgcat-9.*: [mcexists]

	test msgcat-9.1 {mcexists no parameter} -body {
	    mcexists
	} -returnCodes 1\
	-result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? src"}
	-result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? ?-namespace ns? src"}

	test msgcat-9.2 {mcexists unknown option} -body {
	    mcexists -unknown src
	} -returnCodes 1\
	-result {unknown option "-unknown"}

	test msgcat-9.3 {mcexists} -setup {
720
721
722
723
724
725
726

727
728

729
730

731
732






















733
734
735
736
737
738
739
747
748
749
750
751
752
753
754
755

756
757

758
759

760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788







+

-
+

-
+

-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	test msgcat-9.5 {mcexists parent namespace} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	    namespace delete ::foo
	} -body {
	    namespace eval ::msgcat::test::sub {
	    namespace eval ::foo {
		list [::msgcat::mcexists k1]\
			[::msgcat::mcexists -exactnamespace k1]
			[::msgcat::mcexists -namespace ::msgcat::test k1]
	    }
	} -result {1 0}
	} -result {0 1}

	test msgcat-9.6 {mcexists -namespace ns parameter} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	    namespace delete ::foo
	} -body {
	    namespace eval ::foo {
		list [::msgcat::mcexists k1]\
			[::msgcat::mcexists -namespace ::msgcat::test k1]
	    }
	} -result {0 1}

	test msgcat-9.7 {mcexists -namespace - ns argument missing} -body {
	    mcexists -namespace src
	} -returnCodes 1\
	-result {Argument missing for switch "-namespace"}


    # Tests msgcat-10.*: [mcloadedlocales]

	test msgcat-10.1 {mcloadedlocales no arg} -body {
	    mcloadedlocales
	} -returnCodes 1\
	-result {wrong # args: should be "mcloadedlocales subcommand"}
807
808
809
810
811
812
813
814

815
816
817
818
819
820





821
822
823
824
825
826
827
856
857
858
859
860
861
862

863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881







-
+






+
+
+
+
+







	} -result {1 0}

    # Tests msgcat-12.*: [mcpackagelocale]

	test msgcat-12.1 {mcpackagelocale no subcommand} -body {
	    mcpackagelocale
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackagelocale subcommand ?locale?"}
	-result {wrong # args: should be "mcpackagelocale subcommand ?arg ...?"}

	test msgcat-12.2 {mclpackagelocale wrong subcommand} -body {
	    mcpackagelocale junk
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be clear, get, isset, loaded, present, set, or unset}

	test msgcat-12.2.1 {mclpackagelocale set multiple args} -body {
	    mcpackagelocale set a b
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackagelocale set ?locale?"}

	test msgcat-12.3 {mcpackagelocale set} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
917
918
919
920
921
922
923
























924
925
926
927
928
929
930
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    mcpackagelocale set bar
	    mcpackagelocale clear
	    list [mcpackagelocale present foo] [mcpackagelocale present bar]
	} -result {0 1}

	test msgcat-12.11 {mcpackagelocale custom preferences} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [list [mcpackagelocale preferences]]
	    mcpackagelocale preferences bar {}
	    lappend res [mcpackagelocale preferences]
	} -result {{foo {}} {bar {}}}

	test msgcat-12.12 {mcpackagelocale preferences -> no isset} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    mcpackagelocale preferences
	    mcpackagelocale isset
	} -result {0}


    # Tests msgcat-13.*: [mcpackageconfig subcmds]

	test msgcat-13.1 {mcpackageconfig no subcommand} -body {
	    mcpackageconfig
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackageconfig subcommand option ?value?"}
1068
1069
1070
1071
1072
1073
1074
1075




































































































































































1076








































1077
1078
1079
1080
1081
1082
1083
1084
1085
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









	    mcforgetpackage
	} -body {
	    mcpackageconfig set unknowncmd [namespace code callbackfailproc]
	    mclocale foo_bar
	    mc k1
	} -returnCodes 1\
	-result {fail}


    # Tests msgcat-15.*: tcloo coverage

    # There are 4 use-cases, where 3 must be tested now:
    # - namespace defined, in class definition, class defined oo, classless

    test msgcat-15.1 {mc in class setup} -setup {
	# full namespace is ::msgcat::test:bar
	namespace eval bar {
	    ::msgcat::mcset foo_BAR con2 con2bar
	    oo::class create ClassCur
	}
	variable locale [mclocale]
	mclocale foo_BAR
    } -cleanup {
	mclocale $locale
	namespace eval bar {::msgcat::mcforgetpackage}
	namespace delete bar
    } -body {
	oo::define bar::ClassCur msgcat::mc con2
    } -result con2bar

    test msgcat-15.2 {mc in class} -setup {
	# full namespace is ::msgcat::test:bar
	namespace eval bar {
	    ::msgcat::mcset foo_BAR con2 con2bar
	    oo::class create ClassCur
	    oo::define ClassCur method method1 {} {::msgcat::mc con2}
	}
	# full namespace is ::msgcat::test:baz
	namespace eval baz {
            set ObjCur [::msgcat::test::bar::ClassCur new]
	}
	variable locale [mclocale]
	mclocale foo_BAR
    } -cleanup {
	mclocale $locale
	namespace eval bar {::msgcat::mcforgetpackage}
	namespace delete bar baz
    } -body {
	$baz::ObjCur method1
    } -result con2bar

    test msgcat-15.3 {mc in classless object} -setup {
	# full namespace is ::msgcat::test:bar
	namespace eval bar {
	    ::msgcat::mcset foo_BAR con2 con2bar
	    oo::object create ObjCur
	    oo::objdefine ObjCur method method1 {} {::msgcat::mc con2}
	}
	variable locale [mclocale]
	mclocale foo_BAR
    } -cleanup {
	mclocale $locale
	namespace eval bar {::msgcat::mcforgetpackage}
	namespace delete bar
    } -body {
	bar::ObjCur method1
    } -result con2bar

    test msgcat-15.4 {mc in classless object with explicite namespace eval}\
    -setup {
	# full namespace is ::msgcat::test:bar
	namespace eval bar {
	    ::msgcat::mcset foo_BAR con2 con2bar
	    oo::object create ObjCur
	    oo::objdefine ObjCur method method1 {} {
		namespace eval ::msgcat::test::baz {
		    ::msgcat::mc con2
		}
	    }
	}
	namespace eval baz {
	    ::msgcat::mcset foo_BAR con2 con2baz
	}
	variable locale [mclocale]
	mclocale foo_BAR
    } -cleanup {
	mclocale $locale
	namespace eval bar {::msgcat::mcforgetpackage}
	namespace eval baz {::msgcat::mcforgetpackage}
	namespace delete bar baz
    } -body {
	bar::ObjCur method1
    } -result con2baz

    # Test msgcat-16.*: command mcpackagenamespaceget

    test msgcat-16.1 {mcpackagenamespaceget in namespace procedure} -body {
	namespace eval baz {msgcat::mcpackagenamespaceget}
    } -result ::msgcat::test::baz

    test msgcat-16.2 {mcpackagenamespaceget in class setup} -setup {
	namespace eval bar {
	    oo::class create ClassCur
	    oo::define ClassCur variable a
	}
    } -cleanup {
	namespace delete bar
    } -body {
	oo::define bar::ClassCur msgcat::mcpackagenamespaceget
    } -result ::msgcat::test::bar

    test msgcat-16.3 {mcpackagenamespaceget in class} -setup {
	namespace eval bar {
	    oo::class create ClassCur
	    oo::define ClassCur method method1 {} {msgcat::mcpackagenamespaceget}
	}
	namespace eval baz {
            set ObjCur [::msgcat::test::bar::ClassCur new]
	}
    } -cleanup {
	namespace delete bar baz
    } -body {
	$baz::ObjCur method1
    } -result ::msgcat::test::bar

    test msgcat-16.4 {mcpackagenamespaceget in classless object} -setup {
	namespace eval bar {
	    oo::object create ObjCur
	    oo::objdefine ObjCur method method1 {} {msgcat::mcpackagenamespaceget}
	}
    } -cleanup {
	namespace delete bar
    } -body {
	bar::ObjCur method1
    } -result ::msgcat::test::bar

    test msgcat-16.5\
    {mcpackagenamespaceget in classless object with explicite namespace eval}\
    -setup {
	namespace eval bar {
	    oo::object create ObjCur
	    oo::objdefine ObjCur method method1 {} {
		namespace eval ::msgcat::test::baz {
		    msgcat::mcpackagenamespaceget
		}
	    }
	}
    } -cleanup {
	namespace delete bar baz
    } -body {
	bar::ObjCur method1
    } -result ::msgcat::test::baz


    # Test msgcat-17.*: mcn command

    test msgcat-17.1 {mcn no parameters} -body {
	mcn
    } -returnCodes 1\
    -result {wrong # args: should be "mcn ns src ?arg ...?"}

    test msgcat-17.2 {mcn} -setup {
	namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar}
	variable locale [mclocale]
	mclocale foo_BAR
    } -cleanup {
	mclocale $locale
    } -body {
	::msgcat::mcn [namespace current]::bar con1
    } -result con1bar


    interp bgerror {} $bgerrorsaved

    # Tests msgcat-18.*: [mcutil]

    test msgcat-18.1 {mcutil - no argument} -body {
	mcutil
    } -returnCodes 1\
    -result {wrong # args: should be "mcutil subcommand ?arg ...?"}

    test msgcat-18.2 {mcutil - wrong argument} -body {
	mcutil junk
    } -returnCodes 1\
    -result {unknown subcommand "junk": must be getpreferences, or getsystemlocale}

    test msgcat-18.3 {mcutil - partial argument} -body {
	mcutil getsystem
    } -returnCodes 1\
    -result {unknown subcommand "getsystem": must be getpreferences, or getsystemlocale}

    test msgcat-18.4 {mcutil getpreferences - no argument} -body {
	mcutil getpreferences
    } -returnCodes 1\
    -result {wrong # args: should be "mcutil getpreferences locale"}

    test msgcat-18.5 {mcutil getpreferences - DE_de} -body {
	mcutil getpreferences DE_de
    } -result {de_de de {}}

    test msgcat-18.6 {mcutil getsystemlocale - wrong argument} -body {
	mcutil getsystemlocale DE_de
    } -returnCodes 1\
    -result {wrong # args: should be "mcutil getsystemlocale"}

    # The result is system dependent
    # So just test if it runs
    # The environment variable version was test with test 0.x
    test msgcat-18.7 {mcutil getsystemlocale} -body {
	mcutil getsystemlocale
	set ok ok
    } -result {ok}


    cleanupTests
}
namespace delete ::msgcat::test
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/namespace-old.test.

289
290
291
292
293
294
295
296
297
298

299
300

301
302

303
304
305
306
307
308
309
289
290
291
292
293
294
295

296

297
298

299
300

301
302
303
304
305
306
307
308







-

-
+

-
+

-
+







        proc test_ns_show {} {return "[namespace current]: 2"}
	namespace eval test_ns_hier3a {}
	namespace eval test_ns_hier3b {}
    }
    namespace eval test_ns_hier2a {}
    namespace eval test_ns_hier2b {}
}
# TIP 278: secondary lookup disabled for vars, tests disabled with #
test namespace-old-5.4 {nested namespaces can access global namespace} {
    list [namespace eval test_ns_hier1 {#set test_ns_var_global}] \
    list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
         [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {#set test_ns_var_global}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
} {{} {cmd in ::} {} {cmd in ::}}
} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
test namespace-old-5.5 {variables in different namespaces don't conflict} {
    list [set test_ns_hier1::test_ns_level] \
         [set test_ns_hier1::test_ns_hier2::test_ns_level]
} {1 2}
test namespace-old-5.6 {commands in different namespaces don't conflict} {
    list [test_ns_hier1::test_ns_show] \
         [test_ns_hier1::test_ns_hier2::test_ns_show]
465
466
467
468
469
470
471
472
473
474
475
476
477


478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494


495
496
497
498
499
500
501
502
503



504
505
506
507
508
509
510
464
465
466
467
468
469
470

471
472
473


474
475
476
477
478
479
480
481
482
483

484
485
486
487
488
489


490
491

492
493
494
495
496



497
498
499
500
501
502
503
504
505
506







-



-
-
+
+








-






-
-
+
+
-





-
-
-
+
+
+







}
test namespace-old-6.11 {commands affect all parent namespaces} {
    proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
        return "cache2 version"
    }
    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{cache2 version} {cache2 version}}
# TIP 278: secondary lookup disabled, catch added, result changed from {global version}
test namespace-old-6.12 {define test variables} {
    variable test_ns_cache_var "global version"
    set trigger {set test_ns_cache_var}
    list [catch {namespace eval test_ns_cache1 $trigger} msg] $msg
} {1 {can't read "test_ns_cache_var": no such variable}}
    namespace eval test_ns_cache1 $trigger
} {global version}
    set trigger {set test_ns_cache_var}
test namespace-old-6.13 {one-level check for variable shadowing} {
    namespace eval test_ns_cache1 {
        variable test_ns_cache_var "cache1 version"
    }
    namespace eval test_ns_cache1 $trigger
} {cache1 version}
variable ::test_ns_cache_var "global version"
# TIP 278: secondary lookup disabled, catch added, result changed from {global version}
test namespace-old-6.14 {deleting variables changes variable epoch} {
    namespace eval test_ns_cache1 {
        variable test_ns_cache_var "cache1 version"
    }
    list [namespace eval test_ns_cache1 $trigger] \
	[namespace eval test_ns_cache1 {unset test_ns_cache_var}] \
	[catch {namespace eval test_ns_cache1 $trigger}]
} {{cache1 version} {} 1}
	[namespace eval test_ns_cache1 $trigger]
} {{cache1 version} {} {global version}}
# TIP 278: secondary lookup disabled, catch added, result changed
test namespace-old-6.15 {define test namespaces} {
    namespace eval test_ns_cache2 {
        variable test_ns_cache_var "global cache2 version"
    }
    set trigger2 {set test_ns_cache2::test_ns_cache_var}
    catch {list [namespace eval test_ns_cache1 $trigger2] \
	       [namespace eval test_ns_cache1::test_ns_cache2 $trigger]}
} 1
    list [namespace eval test_ns_cache1 $trigger2] \
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{global cache2 version} {global version}}
set trigger2 {set test_ns_cache2::test_ns_cache_var}
test namespace-old-6.16 {public variables affect all parent namespaces} {
    variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
    list [namespace eval test_ns_cache1 $trigger2] \
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{cache2 version} {cache2 version}}
test namespace-old-6.17 {usage for "namespace which"} {

Changes to tests/namespace.test.

42
43
44
45
46
47
48
49

50
51

52
53
54
55
56
57
58
42
43
44
45
46
47
48

49
50

51
52
53
54
55
56
57
58







-
+

-
+







    list [namespace current] [namespace eval {} {namespace current}] \
        [namespace eval {} {namespace current}]
} {:: :: ::}
test namespace-2.2 {Tcl_GetCurrentNamespace} {
    set l {}
    lappend l [namespace current]
    namespace eval test_ns_1 {
        lappend ::l [namespace current]
        lappend l [namespace current]
        namespace eval foo {
            lappend ::l [namespace current]
            lappend l [namespace current]
        }
    }
    lappend l [namespace current]
} {:: ::test_ns_1 ::test_ns_1::foo ::}

test namespace-3.1 {Tcl_GetGlobalNamespace} {
    namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
191
192
193
194
195
196
197













198
199
200
201
202
203
204
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217







+
+
+
+
+
+
+
+
+
+
+
+
+







    }
} -body {
    slave eval foo
    slave invokehidden infocommands
} -cleanup {
    interp delete slave
} -result {}

test namespace-7.8 {Bug ba1419303b4c} -setup {
    namespace eval ns1 {
	namespace ensemble create
    }

    trace add command ns1 delete {
	namespace delete ns1
    }
} -body {
    # No segmentation fault given --enable-symbols=mem.
    namespace delete ns1
} -result {}

test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
    catch {interp delete test_interp}
    interp create test_interp
    interp eval test_interp {
        namespace eval test_ns_1 {
            namespace export p
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649

650
651
652

653
654
655
656
657
658
659
660
642
643
644
645
646
647
648


649
650
651
652
653
654
655
656
657
658
659

660

661

662

663
664
665
666
667
668
669







-
-











-
+
-

-
+
-







    }
} -body {
    namespace eval test_ns_1 {
        list [catch {set ::test_ns_777::v} msg] $msg \
             [catch {namespace children test_ns_777} msg] $msg
    }
} -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}

# TIP 278: secondary lookup disabled, results changed from {10 20}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    variable v 10
    namespace eval test_ns_1::test_ns_2 {
        variable v 20
    }
    namespace eval test_ns_2 {
        variable v 30
    }
} -body {
    namespace eval test_ns_1 {
        # list $v $test_ns_2::v
        list $v $test_ns_2::v
        list [catch {set v} msg] $msg  [catch {set test_ns_2::v} msg] $msg
    }
} -result {1 {can't read "v": no such variable} 0 20}
} -result {10 20}

test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721

722
723
724


725
726
727
728
729
730
731
716
717
718
719
720
721
722


723
724
725
726
727

728
729


730
731
732
733
734
735
736
737
738







-
-





-
+

-
-
+
+







    catch {rename test_ns_1::test_ns_2:: {}}
    set l {}
} -body {
    lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
    proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
    lappend l [test_ns_1::test_ns_2:: hello]
} -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}

# TIP 278: secondary lookup disabled, added catch, result changed from y
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        variable {}
        catch {set test_ns_1::(x) y} ::msg
        set test_ns_1::(x) y
    }
    list $::msg [catch {set test_ns_1::(x)} msg] $msg
} -result {{can't set "test_ns_1::(x)": parent namespace doesn't exist} 1 {can't read "test_ns_1::(x)": no such variable}}
    set test_ns_1::(x)
} -result y
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -returnCodes error -body {
    namespace eval test_ns_1 {
	proc {} {} {}
	namespace eval {} {}
	{}
890
891
892
893
894
895
896
897
898
899
900
901
902
903

904
905

906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932

933
934
935
936
937
938
939
897
898
899
900
901
902
903


904
905
906
907

908
909

910
911
912
913
914
915
916
917
918
919
920
921


922
923
924
925
926
927
928
929
930
931
932
933
934

935
936
937
938
939
940
941
942







-
-




-
+

-
+











-
-













-
+







        variable x 777
    }
} -body {
    namespace eval test_ns_1 {
        set x
    }
} -result {777}

# TIP 278: secondary lookup disabled, catch added, result changed from 314159
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
    namespace eval test_ns_1 {
	variable x 777
        unset x
        list [catch {set x} msg] $msg  ;# must not be global x now
        set x  ;# must be global x now
    }
} {1 {can't read "x": no such variable}}
} {314159}
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
    namespace eval test_ns_1 {
        set wuzzat
    }
} -returnCodes error -result {can't read "wuzzat": no such variable}
test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
    namespace eval test_ns_1 {
        variable a hello
    }
    set test_ns_1::a
} {hello}

# TIP 278: secondary lookup disabled, result changed from 1
test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup {
    namespace eval test_ns_1 {}
} -body {
    proc test_ns {} {
	set ::test_ns_1::a 0
    }
    test_ns
    rename test_ns {}
    namespace eval test_ns_1 unset a
    set a 0
    namespace eval test_ns_1 set a 1
    namespace delete test_ns_1
    return $a
} -result 0
} -result 1
catch {unset a}
catch {unset x}

catch {unset l}
catch {rename foo {}}
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574

1575
1576
1577
1578
1579

1580
1581
1582
1583
1584
1585
1586
1549
1550
1551
1552
1553
1554
1555


1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574

1575
1576
1577
1578
1579

1580
1581
1582
1583
1584
1585
1586
1587







-
-



















-
+




-
+







    namespace eval test_ns_3 {
        list [namespace which foreach] \
             [namespace which p] \
             [namespace which cmd1] \
             [namespace which ::test_ns_2::cmd2]
    }
} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}

# TIP 278: secondary lookup disabled, catch added, result changed
test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        namespace export cmd*
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace export *
        namespace import ::test_ns_1::*
        variable v2 222
        proc p {} {}
    }
    namespace eval test_ns_3 {
        variable v3 333
        namespace import ::test_ns_2::*
    }
} -body {
    namespace eval test_ns_3 {
        list [catch {namespace which -variable env } msg] $msg \
        list [namespace which -variable env] \
             [namespace which -variable v3] \
             [namespace which -variable ::test_ns_2::v2] \
             [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
    }
} -result {0 {} ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}

test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
1792
1793
1794
1795
1796
1797
1798
1799
1800





1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814




























1815
1816
1817
1818
1819
1820
1821
1793
1794
1795
1796
1797
1798
1799


1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853







-
-
+
+
+
+
+














+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	proc x2 {} {format 2}
	proc x3 {} {format 3}
	namespace ensemble create
    }
    list [ns x0 z] [ns x1] [ns x2] [ns x3]
} -cleanup {
    namespace delete ns
} -result {{1 ::ns::x0::z} 1 2 3}
test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
} -result {{1 z} 1 2 3}
test namespace-42.8 {
    ensembles: [Bug 1670091], panic due to pointer to a deallocated List
    struct.
} -setup {
    proc demo args {}
    variable target [list [namespace which demo] x]
    proc trial args {variable target; string length $target}
    trace add execution demo enter [namespace code trial]
    namespace ensemble create -command foo -map [list bar $target]
} -body {
    foo bar
} -cleanup {
    unset target
    rename demo {}
    rename trial {}
    rename foo {}
} -result {}

test namespace-42.9 {
    ensembles: [Bug 4f6a1ebd64], segmentation fault due to pointer to a
    deallocated List struct.
} -setup {
    namespace eval n {namespace ensemble create}
    set lst [dict create one ::two]
    namespace ensemble configure n -subcommands $lst -map $lst
} -body {
    n one
} -cleanup {
    namespace delete n
    unset -nocomplain lst
} -returnCodes error -match glob -result {invalid command name*}

test namespace-42.10 {
    ensembles: [Bug 4f6a1ebd64] segmentation fault due to pointer to a
    deallocated List struct (this time with duplicate of one in "dict").
} -setup {
    namespace eval n {namespace ensemble create}
    set lst [list one ::two one ::three]
    namespace ensemble configure n -subcommands $lst -map $lst
} -body {
    n one
} -cleanup {
    namespace delete n
    unset -nocomplain lst
} -returnCodes error -match glob -result {invalid command name *three*}

test namespace-43.1 {ensembles: dict-driven} {
    namespace eval ns {
	namespace export x*
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	namespace ensemble create -map {a x1 b x2}
    }
1928
1929
1930
1931
1932
1933
1934
1935

1936
1937
1938
1939
1940
1941
1942
1960
1961
1962
1963
1964
1965
1966

1967
1968
1969
1970
1971
1972
1973
1974







-
+







} {1 {ensemble subcommand implementations must be non-empty lists}}
test namespace-44.5 {ensemble: errors} -setup {
    namespace ensemble create -command foobar -subcommands {foobarcget foobarconfigure}
} -body {
    foobar foobarcon
} -cleanup {
    rename foobar {}
} -returnCodes error -result {invalid command name "::foobarconfigure"}
} -returnCodes error -result {invalid command name "foobarconfigure"}
test namespace-44.6 {ensemble: errors} -returnCodes error -body {
    namespace ensemble create gorp
} -result {wrong # args: should be "namespace ensemble create ?option value ...?"}

test namespace-45.1 {ensemble: introspection} {
    namespace eval ns {
	namespace export x
2092
2093
2094
2095
2096
2097
2098
2099

2100
2101
2102
2103
2104
2105
2106
2124
2125
2126
2127
2128
2129
2130

2131
2132
2133
2134
2135
2136
2137
2138







-
+







    set result {}
    lappend result [catch {ns a b c} msg] $msg
    lappend result [catch {ns a b c} msg] $msg
    lappend result [catch {ns b c d} msg] $msg
    lappend result [catch {ns c d e} msg] $msg
    lappend result [catch {ns Magic foo bar spong wibble} msg] $msg
    list $result [lsort [info commands ::ns::*]] $log [namespace delete ns]
} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}}
} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running a b c} {running a b c} {making b} {running b c d} {making c} {running c d e} {unknown Magic - args = foo bar spong wibble}} {}}
test namespace-47.2 {ensemble: unknown handler} {
    namespace eval ns {
	namespace export {[a-z]*}
	proc Magic {ensemble subcmd args} {
	    error foobar
	}
	namespace ensemble create -unknown ::ns::Magic
3191
3192
3193
3194
3195
3196
3197
3198

3199
3200
3201
3202
3203
3204
3205
3223
3224
3225
3226
3227
3228
3229

3230
3231
3232
3233
3234
3235
3236
3237







-
+







} -cleanup {
    namespace delete ns
} -result\
   {0 0\
    1 {wrong # args: should be "ns z1 x a1"}\
    1 {wrong # args: should be "ns z2 x a1 a2"}\
    1 {wrong # args: should be "ns z2 x a1 a2"}\
    1 {wrong # args: should be "::ns::x::z0"}\
    1 {wrong # args: should be "z0"}\
    0 {1 v}\
    1 {wrong # args: should be "ns v x z2 a2"}\
    0 {2 v v2}}
test namespace-53.11 {ensembles: nested rewrite} -setup {
    namespace eval ns {
	namespace export x
	namespace eval x {
3275
3276
3277
3278
3279
3280
3281












3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338







+
+
+
+
+
+
+
+
+
+
+
+













	try {
	    return [lsort $gone]
	} finally {
	    namespace delete ::testing
	}
    }
} {::testing::abc::def ::testing::abc::ghi}

test namespace-56.4 {bug 16fe1b5807: names starting with ":"} {
namespace eval : {
    namespace ensemble create
    namespace export *
    proc p1 {} {
	    return 16fe1b5807
    }
}

: p1
} 16fe1b5807

# cleanup
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
namespace delete {*}[namespace children :: test_ns_*]
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/obj.test.

16
17
18
19
20
21
22
23
24


25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
16
17
18
19
20
21
22


23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39







-
-
+
+








-







    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit	[expr {int(0x80000000) < 0}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
    set r 1
    foreach {t} {
	bytearray
	bytecode
	cmdName
	dict
	end-offset
	regexp
	string
    } {
        set first [string first $t [testobj types]]
        set r [expr {$r && ($first != -1)}]
    }
    set result $r
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
47
48
49
50
51
52
53









54
55
56
57
58
59
60







-
-
-
-
-
-
-
-
-







    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 12]
    lappend result [testobj convert 1 bytearray]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 12 12 bytearray 3}

test obj-3.1 {Tcl_ConvertToType error} testobj {
    list [testdoubleobj set 1 12.34] \
	[catch {testobj convert 1 end-offset} msg] \
	 $msg
} {12.34 1 {bad index "12.34": must be end?[+-]integer?}}
test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj {
    list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg
} {{} 1 {bad index "": must be end?[+-]integer?}}

test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} {} string 2}
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599

600
601
602
603

604
605
606
607
608
609
610
611


612
613
614
615

616
617
618
619

620
621
622
623
624
625
626

627
628
629
630
631
632
633
537
538
539
540
541
542
543





































544
545
546
547
548
549
550
551

552
553
554
555

556
557
558
559
560
561
562


563
564
565
566
567

568
569
570
571

572
573
574
575
576
577
578

579
580
581
582
583
584
585
586







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
+



-
+






-
-
+
+



-
+



-
+






-
+







    lappend result [testbooleanobj set 2 0] ;# must copy on write, now 2 objs
    lappend result [testobj type 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
} {{} 1024 1024 int 4 4 0 int 3 2}


test obj-31.1 {regenerate string rep of "end"} testobj {
    testobj freeallvars
    teststringobj set 1 end
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end
test obj-31.2 {regenerate string rep of "end-1"} testobj {
    testobj freeallvars
    teststringobj set 1 end-0x1
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end-1
test obj-31.3 {regenerate string rep of "end--1"} testobj {
    testobj freeallvars
    teststringobj set 1 end--0x1
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end--1
test obj-31.4 {regenerate string rep of "end-bigInteger"} testobj {
    testobj freeallvars
    teststringobj set 1 end-0x7fffffff
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end-2147483647
test obj-31.5 {regenerate string rep of "end--bigInteger"} testobj {
    testobj freeallvars
    teststringobj set 1 end--0x7fffffff
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end--2147483647
test obj-31.6 {regenerate string rep of "end--bigInteger"} {testobj longIs32bit} {
    testobj freeallvars
    teststringobj set 1 end--0x80000000
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end--2147483648

test obj-32.1 {freeing very large object trees} {
    set x {}
    for {set i 0} {$i<100000} {incr i} {
	set x [list $x {}]
    }
    unset x
} {}

test obj-33.1 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
test obj-33.1 {integer overflow on input} {longIs32bit wideIs64bit} {
    set x 0x8000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 2147483648}
test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
test obj-33.2 {integer overflow on input} {longIs32bit wideIs64bit} {
    set x 0xffff; append x ffff
    list [string is integer $x] [expr { wide($x) }]
} {1 4294967295}
test obj-33.3 {integer overflow on input} {
    set x 0x10000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {0 4294967296}
test obj-33.4 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
} {1 4294967296}
test obj-33.4 {integer overflow on input} {longIs32bit wideIs64bit} {
    set x -0x8000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 -2147483648}
test obj-33.5 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
test obj-33.5 {integer overflow on input} {longIs32bit wideIs64bit} {
    set x -0x8000; append x 0001
    list [string is integer $x] [expr { wide($x) }]
} {1 -2147483649}
test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
test obj-33.6 {integer overflow on input} {longIs32bit wideIs64bit} {
    set x -0xffff; append x ffff
    list [string is integer $x] [expr { wide($x) }]
} {1 -4294967295}
test obj-33.7 {integer overflow on input} {
    set x -0x10000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {0 -4294967296}
} {1 -4294967296}

test obj-34.1 {mp_iseven} testobj {
    set result ""
    lappend result [testbignumobj set 1 0]
    lappend result [testbignumobj iseven 1]    ;
    lappend result [testobj type 1]
} {0 1 int}

Changes to tests/oo.test.

8
9
10
11
12
13
14





15
16
17
18
19
20
21
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26







+
+
+
+
+







# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0.3
package require tcltest 2
if {"::tcltest" in [namespace children]} {
    namespace import -force ::tcltest::*
}

# The foundational objects oo::object and oo::class are sensitive to reference
# counting errors and are deallocated only when an interp is deleted, so in
# this test suite, interp creation and interp deletion are often used in
# leaktests in order to leverage this sensitivity.

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
43
44
45
46
47
48
49
50

51
52
53
54
55
56
57
58
59






60

61
62
63
64
65
66
67
48
49
50
51
52
53
54

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

71
72
73
74
75
76
77
78







-
+









+
+
+
+
+
+
-
+







	package require TclOO
	namespace delete ::
    }
    interp delete $i
} {}
test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
	[oo::object new] destroy
        [oo::object new] destroy
    }
} -constraints memory -result 0
test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
	oo::class create foo
	foo new
	foo destroy
    }
} -constraints memory -result 0
test oo-0.5.1 {testing object foundation cleanup} memory {
    leaktest {
	interp create foo
	interp delete foo
    }
} 0
test oo-0.5 {testing literal leak on interp delete} memory {
test oo-0.5.2 {testing literal leak on interp delete} memory {
    leaktest {
	interp create foo
	foo eval {oo::object new}
	interp delete foo
    }
} 0
test oo-0.6 {cleaning the core class pair; way #1} -setup {
124
125
126
127
128
129
130







131
132
133
134
135
136
137
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155







+
+
+
+
+
+
+







    set errorInfo
} "wrong # args: should be \"oo::define oo::object method name args body\"
    while executing
\"oo::define oo::object method missingArgs\""
test oo-1.4 {basic test of OO functionality} -body {
    oo::object create {}
} -returnCodes 1 -result {object name must not be empty}
test oo-1.4.1 {fully-qualified nested name} -body {
    oo::object create ::one::two::three
} -result {::one::two::three}
test oo-1.4.2 {automatic command name has same name as namespace} -body {
    set obj [oo::object new]
    expr {[info object namespace $obj] == $obj}
} -result 1
test oo-1.5 {basic test of OO functionality} -body {
    oo::object doesnotexist
} -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new}
test oo-1.5.1 {basic test of OO functionality} -setup {
    oo::object create aninstance
} -returnCodes error -body {
    aninstance
254
255
256
257
258
259
260














261

262
263
264
265
266
267
268
269
270
271
272
273
274

275
276
277
278
279
280
281
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292

293
294
295
296
297
298
299
300
301
302
303
304
305

306
307
308
309
310
311
312
313







+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+












-
+







} -body {
    oo::define B constructor {} {A create test-oo-1.18}
    B create C
} -cleanup {
    rename test-oo-1.18 {}
    A destroy
} -result ::C
test oo-1.18.1 {no memory leak: superclass} -setup {
} -constraints memory -body {

    leaktest {
	interp create t
	t eval {
	    oo::class create A {
		superclass oo::class
	    }
	}
	interp delete t
    }
} -cleanup {
} -result 0
test oo-1.18.1 {Bug 75b8433707: memory leak in oo-1.18} -setup {
test oo-1.18.2 {Bug 75b8433707: memory leak in oo-1.18} -setup {
    proc test-oo-1.18 {} return
} -constraints memory -body {
    leaktest {
	oo::class create A
	oo::class create B {superclass A}
	oo::define B constructor {} {A create test-oo-1.18}
	B create C
	A destroy
    }
} -cleanup {
    rename test-oo-1.18 {}
} -result 0
test oo-1.18.2 {Bug 21c144f0f5} -setup {
test oo-1.18.3 {Bug 21c144f0f5} -setup {
    interp create slave
} -body {
    slave eval {
	oo::define [oo::class create foo] superclass oo::class
	oo::class destroy
    }
} -cleanup {
302
303
304
305
306
307
308
309

310
311
312

313
314
315
316
317
318
319
334
335
336
337
338
339
340

341
342
343

344
345
346
347
348
349
350
351







-
+


-
+







		lappend x [info class $cmd ::oo::$initial]
	    }
	}
	foreach initial {object class Slot} {
	    lappend x [info object class ::oo::$initial]
	}
	return $x
    }] {lsort $x}
    }] {lsort [lmap y $x {if {[string match *::delegate $y]} continue; set y}]}
} -cleanup {
    interp delete $fresh
} -result {{} {::oo::Slot ::oo::class ::oo::object} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}
} -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}

test oo-2.1 {basic test of OO functionality: constructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as
    # we're modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require TclOO
1491
1492
1493
1494
1495
1496
1497
1498














1499
1500

1501




































1502
1503
1504
1505
1506
1507
1508
1509

1510
1511
1512
1513
1514



1515
1516
1517
1518
1519
1520
1521
1523
1524
1525
1526
1527
1528
1529

1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546

1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589

1590
1591
1592
1593
1594

1595
1596
1597
1598
1599
1600
1601
1602
1603
1604







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+




-
+
+
+







    }}}

    rename obj1 {}
    # No segmentation fault
    return done
} done

test oo-11.6 {
test oo-11.6.1 {
    OO: cleanup of when an class is mixed into itself
} -constraints memory -body {
    leaktest {
	interp create interp1
	oo::class create obj1
	::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]}
	rename obj1 {}
	interp delete interp1
    }
} -result 0 -cleanup {
}

test oo-11.6.2 {
    OO: cleanup ReleaseClassContents() where class is mixed into one of its
    instances
} -constraints memory -body {
} {
    leaktest {
	interp create interp1
	interp1 eval {
	    oo::class create obj1
	    ::oo::copy obj1 obj2
	    rename obj2 {}
	    rename obj1 {}
	}
	interp delete interp1
    }
} -result 0 -cleanup {
}

test oo-11.6.3 {
    OO: cleanup ReleaseClassContents() where class is mixed into one of its
    instances
} -constraints memory -body {
    leaktest {
	interp create interp1
	interp1 eval {
	    oo::class create obj1
	    ::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]}

	    ::oo::copy obj1 obj2
	    rename obj2 {}
	    rename obj1 {}
	}
	interp delete interp1
    }
} -result 0 -cleanup {
}

test oo-11.6.4 {
    OO: cleanup ReleaseClassContents() where class is mixed into one of its
    instances
} -body {
    oo::class create obj1
    ::oo::define obj1 {self mixin [self]}

    ::oo::copy obj1 obj2
    ::oo::objdefine obj2 {mixin [self]}

    ::oo::copy obj2 obj3
    trace add command obj3 delete [list obj3 dying]
    rename obj3 {}
    rename obj2 {}

    # No segmentation fault
    return done
} done
} -result done -cleanup {
    rename obj1 {}
}

test oo-12.1 {OO: filters} {
    oo::class create Aclass
    Aclass create Aobject
    oo::define Aclass {
	method concatenate args {
	    global result
1694
1695
1696
1697
1698
1699
1700
1701

1702
1703
1704
1705
1706
1707

1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721




































































































1722
1723
1724
1725
1726
1727
1728
1777
1778
1779
1780
1781
1782
1783

1784
1785
1786
1787
1788
1789

1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911







-
+





-
+














+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    return $result
} {::foo {in A ::foo} {in B ::foo} foo}
test oo-13.2 {OO: changing an object's class} -body {
    oo::object create foo
    oo::objdefine foo class oo::class
} -cleanup {
    foo destroy
} -returnCodes 1 -result {may not change a non-class object into a class object}
} -result {}
test oo-13.3 {OO: changing an object's class} -body {
    oo::class create foo
    oo::objdefine foo class oo::object
} -cleanup {
    foo destroy
} -returnCodes 1 -result {may not change a class object into a non-class object}
} -result {}
test oo-13.4 {OO: changing an object's class} -body {
    oo::class create foo {
	method m {} {
	    set result [list [self class] [info object class [self]]]
	    oo::objdefine [self] class ::bar
	    lappend result [self class] [info object class [self]]
	}
    }
    oo::class create bar
    [foo new] m
} -cleanup {
    foo destroy
    bar destroy
} -result {::foo ::foo ::foo ::bar}
test oo-13.5 {OO: changing an object's class: non-class to class} -setup {
    oo::object create fooObj
} -body {
    oo::objdefine fooObj {
	class oo::class
    }
    oo::define fooObj {
	method x {} {expr 1+2+3}
    }
    [fooObj new] x
} -cleanup {
    fooObj destroy
} -result 6
test oo-13.6 {OO: changing an object's class: class to non-class} -setup {
    oo::class create foo
    unset -nocomplain ::result
} -body {
    set result dangling
    oo::define foo {
	method x {} {expr 1+2+3}
    }
    oo::class create boo {
	superclass foo
	destructor {set ::result "ok"}
    }
    boo new
    foo create bar
    oo::objdefine foo {
	class oo::object
    }
    list $result [catch {bar x} msg] $msg
} -cleanup {
    catch {bar destroy}
    foo destroy
} -result {ok 1 {invalid command name "bar"}}
test oo-13.7 {OO: changing an object's class} -setup {
    oo::class create foo
    oo::class create bar
    unset -nocomplain result
} -body {
    oo::define bar method x {} {return ok}
    oo::define foo {
	method x {} {expr 1+2+3}
	self mixin foo
    }
    lappend result [foo x]
    oo::objdefine foo class bar
    lappend result [foo x]
} -cleanup {
    foo destroy
    bar destroy
} -result {6 ok}
test oo-13.8 {OO: changing an object's class to itself} -setup {
    oo::class create foo
} -body {
    oo::define foo {
	method x {} {expr 1+2+3}
    }
    oo::objdefine foo class foo
} -cleanup {
    foo destroy
} -returnCodes error -result {may not change classes into an instance of themselves}
test oo-13.9 {OO: changing an object's class: roots are special} -setup {
    set i [interp create]
} -body {
    $i eval {
	oo::objdefine oo::object {
	    class oo::class
	}
    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {may not modify the class of the root object class}
test oo-13.10 {OO: changing an object's class: roots are special} -setup {
    set i [interp create]
} -body {
    $i eval {
	oo::objdefine oo::class {
	    class oo::object
	}
    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {may not modify the class of the class of classes}
test oo-13.11 {OO: changing an object's class in a tricky place} -setup {
    oo::class create cls
    unset -nocomplain result
} -body {
    set result gorp
    list [catch {
	oo::define cls {
	    method x {} {return}
	    self class oo::object
	    ::set ::result ok
	    method y {} {return}; # I'm sorry, Dave. I'm afraid I can't do that.
	}
    } msg] $msg $result
} -cleanup {
    cls destroy
} -result {1 {attempt to misuse API} ok}
# todo: changing a class subtype (metaclass) to another class subtype

test oo-14.1 {OO: mixins} {
    oo::class create Aclass
    oo::define Aclass method bar {} {lappend ::result "[self object] in bar"}
    oo::class create Bclass
    oo::define Bclass method boo {} {lappend ::result "[self object] in boo"}
2052
2053
2054
2055
2056
2057
2058













2059

2060
2061
2062
2063
2064
2065
2066
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254

2255
2256
2257
2258
2259
2260
2261
2262







+
+
+
+
+
+
+
+
+
+
+
+
+
-
+







} -body {
    namespace eval ::existing {}
    oo::copy Cls {} ::existing
} -returnCodes error -cleanup {
    Super destroy
    catch {namespace delete ::existing}
} -result {::existing refers to an existing namespace}
test oo-15.13.1 {
    OO: object cloning with target NS
    Valgrind will report a leak if the reference count of the namespace isn't
    properly incremented.
} -setup {
    oo::class create Cls {}
} -body {
    oo::copy Cls Cls2 ::dupens
    return done
} -cleanup {
    Cls destroy
    Cls2 destroy
} -result done
test oo-15.13 {OO: object cloning with target NS} -setup {
test oo-15.13.2 {OO: object cloning with target NS} -setup {
    oo::class create Super
    oo::class create Cls {superclass Super}
} -body {
    list [namespace exist ::dupens] [oo::copy Cls Cls2 ::dupens] [namespace exist ::dupens]
} -cleanup {
    Super destroy
} -result {0 ::Cls2 1}
2100
2101
2102
2103
2104
2105
2106
2107

2108
2109
2110
2111
2112
2113
2114
2296
2297
2298
2299
2300
2301
2302

2303
2304
2305
2306
2307
2308
2309
2310







-
+







    while executing
\"info object\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
test oo-16.3 {OO: object introspection} -body {
    info object gorp oo::object
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, creationid, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
test oo-16.4 {OO: object introspection} -setup {
    oo::class create meta { superclass oo::class }
    [meta create instance1] create instance2
} -body {
    list [list [info object class oo::object] \
	      [info object class oo::class] \
	      [info object class meta] \
2230
2231
2232
2233
2234
2235
2236



































































2237
2238
2239
2240
2241
2242
2243
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		 [info object isa mixin list NOTANOBJECT] \
		 [info object isa mixin NOTANOBJECT list] \
		 [info object isa mixin oo::object list] \
		 [info object isa mixin list oo::object]]
} -cleanup {
    meta destroy
} -result {class {0 0} meta {0 0 0} type {0 0 0 0 0 0} mix {0 0 0 0 0 0}}
test oo-16.15 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    info object creationid [cls new]
} -cleanup {
    cls destroy
} -result {^\d+$} -match regexp
test oo-16.16 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set obj [cls new]
    set id [info object creationid $obj]
    rename $obj gorp
    set id2 [info object creationid gorp]
    list $id $id2
} -cleanup {
    cls destroy
} -result {^(\d+) \1$} -match regexp
test oo-16.17 {OO: object introspection: creationid #500} -body {
    info object creationid nosuchobject
} -returnCodes error -result {nosuchobject does not refer to an object}
test oo-16.18 {OO: object introspection: creationid #500} -body {
    info object creationid
} -returnCodes error -result {wrong # args: should be "info object creationid objName"}
test oo-16.18 {OO: object introspection: creationid #500} -body {
    info object creationid oo::object gorp
} -returnCodes error -result {wrong # args: should be "info object creationid objName"}
test oo-16.19 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set id1 [info object creationid [set o1 [cls new]]]
    set id2 [info object creationid [set o2 [cls new]]]
    if {$id1 == $id2} {
	format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
    } else {
	string cat not-equal
    }
} -cleanup {
    cls destroy
} -result not-equal
test oo-16.20 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set id1 [info object creationid [set o1 [cls new]]]
    $o1 destroy
    set id2 [info object creationid [set o2 [cls new]]]
    if {$id1 == $id2} {
	format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
    } else {
	string cat not-equal
    }
} -cleanup {
    cls destroy
} -result not-equal
test oo-16.21 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set id1 [info object creationid [set o1 [cls new]]]
    set id2 [info object creationid [set o2 [oo::copy $o1]]]
    if {$id1 == $id2} {
	format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
    } else {
	string cat not-equal
    }
} -cleanup {
    cls destroy
} -result not-equal

test oo-17.1 {OO: class introspection} -body {
    info class
} -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?arg ...?\""
test oo-17.1.1 {OO: class introspection} -body {
    catch {info class} m o
    dict get $o -errorinfo
3648
3649
3650
3651
3652
3653
3654


3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676





































3677
3678

3679
3680

3681
3682
3683


3684
3685

3686
3687
3688

3689
3690
3691


3692
3693

3694
3695
3696

3697
3698
3699


3700
3701

3702
3703
3704

3705
3706
3707


3708
3709

3710
3711
3712

3713
3714

















3715
3716

3717
3718

3719
3720

3721
3722
3723


3724
3725

3726
3727

3728
3729
3730


3731
3732

3733
3734
3735

3736
3737
3738


3739
3740

3741
3742
3743

3744

3745

3746
3747
3748
3749
3750
3751
3752
3753
3754
3911
3912
3913
3914
3915
3916
3917
3918
3919






















3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957

3958
3959

3960
3961


3962
3963
3964

3965
3966
3967

3968
3969


3970
3971
3972

3973
3974
3975

3976
3977


3978
3979
3980

3981
3982
3983

3984
3985


3986
3987
3988

3989
3990
3991

3992
3993

3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011

4012
4013

4014
4015

4016
4017


4018
4019
4020

4021
4022

4023
4024


4025
4026
4027

4028
4029
4030

4031
4032


4033
4034
4035

4036
4037
4038

4039
4040
4041

4042


4043
4044
4045
4046
4047
4048
4049







+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+

-
-
+
+

-
+


-
+

-
-
+
+

-
+


-
+

-
-
+
+

-
+


-
+

-
-
+
+

-
+


-
+

-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+

-
+

-
-
+
+

-
+

-
+

-
-
+
+

-
+


-
+

-
-
+
+

-
+


-
+

+
-
+
-
-







	}
    }
    list [leaktest {[cls new] destroy}] [info class instances cls]
} -cleanup {
    cls destroy
} -result {0 {}}

proc SampleSlotSetup script {
    set script0 {
oo::class create SampleSlot {
    superclass oo::Slot
    constructor {} {
	variable contents {a b c} ops {}
    }
    method contents {} {variable contents; return $contents}
    method ops {} {variable ops; return $ops}
    method Get {} {
	variable contents
	variable ops
	lappend ops [info level] Get
	return $contents
    }
    method Set {lst} {
	variable contents $lst
	variable ops
	lappend ops [info level] Set $lst
	return
    }
}

test oo-32.1 {TIP 380: slots - class test} -setup {
	oo::class create SampleSlot {
	    superclass oo::Slot
	    constructor {} {
		variable contents {a b c} ops {}
	    }
	    method contents {} {variable contents; return $contents}
	    method ops {} {variable ops; return $ops}
	    method Get {} {
		variable contents
		variable ops
		lappend ops [info level] Get
		return $contents
	    }
	    method Set {lst} {
		variable contents $lst
		variable ops
		lappend ops [info level] Set $lst
		return
	    }
	    method Resolve {lst} {
		variable ops
		lappend ops [info level] Resolve $lst
		return $lst
	    }
	}
    }
    append script0 \n$script
}

proc SampleSlotCleanup script {
    set script0 {
	SampleSlot destroy
    }
    append script \n$script0
}

test oo-32.1 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
} -body {
}] -body {
    list [info level] [sampleSlot contents] [sampleSlot ops]
} -cleanup {
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
} -result {0 {a b c} {}}
test oo-32.2 {TIP 380: slots - class test} -setup {
}] -result {0 {a b c} {}}
test oo-32.2 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
} -body {
}] -body {
    list [info level] [sampleSlot -clear] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup {
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
} -result {0 {} {} {1 Set {}}}
test oo-32.3 {TIP 380: slots - class test} -setup {
}] -result {0 {} {} {1 Set {}}}
test oo-32.3 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
} -body {
}] -body {
    list [info level] [sampleSlot -append g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup {
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
} -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}}
test oo-32.4 {TIP 380: slots - class test} -setup {
}] -result {0 {} {a b c g h i} {1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {a b c g h i}}}
test oo-32.4 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
} -body {
}] -body {
    list [info level] [sampleSlot -set d e f] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup {
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
} -result {0 {} {d e f} {1 Set {d e f}}}
test oo-32.5 {TIP 380: slots - class test} -setup {
}] -result {0 {} {d e f} {1 Resolve d 1 Resolve e 1 Resolve f 1 Set {d e f}}}
test oo-32.5 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
} -body {
}] -body {
    list [info level] [sampleSlot -set d e f] [sampleSlot -append g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup {
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
} -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}}
}] -result {0 {} {} {d e f g h i} {1 Resolve d 1 Resolve e 1 Resolve f 1 Set {d e f} 1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {d e f g h i}}}
test oo-32.6 {TIP 516: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -prepend g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {g h i a b c} {1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {g h i a b c}}}
test oo-32.6 {TIP 516: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -remove c a] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} b {1 Resolve c 1 Resolve a 1 Get 1 Set b}}

test oo-33.1 {TIP 380: slots - defaulting} -setup {
test oo-33.1 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
    set s [SampleSlot new]
} -body {
}] -body {
    list [$s x y] [$s contents]
} -cleanup {
} -cleanup [SampleSlotCleanup {
    rename $s {}
} -result {{} {a b c x y}}
test oo-33.2 {TIP 380: slots - defaulting} -setup {
}] -result {{} {a b c x y}}
test oo-33.2 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
    set s [SampleSlot new]
} -body {
}] -body {
    list [$s destroy; $s unknown] [$s contents]
} -cleanup {
} -cleanup [SampleSlotCleanup {
    rename $s {}
} -result {{} {a b c destroy unknown}}
test oo-33.3 {TIP 380: slots - defaulting} -setup {
}] -result {{} {a b c destroy unknown}}
test oo-33.3 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
    set s [SampleSlot new]
} -body {
}] -body {
    oo::objdefine $s forward --default-operation  my -set
    list [$s destroy; $s unknown] [$s contents] [$s ops]
} -cleanup {
} -cleanup [SampleSlotCleanup {
    rename $s {}
} -result {{} unknown {1 Set destroy 1 Set unknown}}
test oo-33.4 {TIP 380: slots - errors} -setup {
}] -result {{} unknown {1 Resolve destroy 1 Set destroy 1 Resolve unknown 1 Set unknown}}
test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
    set s [SampleSlot new]
} -body {
}] -body {
    # Method names beginning with "-" are special to slots
    $s -grill q
} -returnCodes error -cleanup {
} -returnCodes error -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result \
} -result {unknown method "-grill": must be -append, -clear, -set, contents or ops}
    {unknown method "-grill": must be -append, -clear, -prepend, -remove, -set, contents or ops}

SampleSlot destroy

test oo-34.1 {TIP 380: slots - presence} -setup {
    set obj [oo::object new]
    set result {}
} -body {
    oo::define oo::object {
	::lappend ::result [::info object class filter]
3770
3771
3772
3773
3774
3775
3776
3777

3778
3779
3780

3781
3782
3783

3784
3785
3786

3787
3788
3789

3790
3791
3792

3793
3794
3795












































3796
3797
3798
3799
3800
3801
3802
4065
4066
4067
4068
4069
4070
4071

4072
4073
4074

4075
4076
4077

4078
4079
4080

4081
4082
4083

4084
4085
4086

4087
4088
4089

4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140







-
+


-
+


-
+


-
+


-
+


-
+


-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
proc getMethods obj {
    list [lsort [info object methods $obj -all]] \
	[lsort [info object methods $obj -private]]
}
test oo-34.3 {TIP 380: slots - presence} {
    getMethods oo::define::filter
} {{-append -clear -set} {Get Set}}
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.4 {TIP 380: slots - presence} {
    getMethods oo::define::mixin
} {{-append -clear -set} {--default-operation Get Set}}
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.5 {TIP 380: slots - presence} {
    getMethods oo::define::superclass
} {{-append -clear -set} {--default-operation Get Set}}
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.6 {TIP 380: slots - presence} {
    getMethods oo::define::variable
} {{-append -clear -set} {Get Set}}
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.7 {TIP 380: slots - presence} {
    getMethods oo::objdefine::filter
} {{-append -clear -set} {Get Set}}
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.8 {TIP 380: slots - presence} {
    getMethods oo::objdefine::mixin
} {{-append -clear -set} {--default-operation Get Set}}
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.9 {TIP 380: slots - presence} {
    getMethods oo::objdefine::variable
} {{-append -clear -set} {Get Set}}
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.10 {TIP 516: slots - resolution} -setup {
    oo::class create parent
    set result {}
    oo::class create 516a { superclass parent }
    oo::class create 516b { superclass parent }
    oo::class create 516c { superclass parent }
    namespace eval 516test {
	oo::class create 516a { superclass parent }
	oo::class create 516b { superclass parent }
	oo::class create 516c { superclass parent }
    }
} -body {
    # Must find the right classes when making the mixin
    namespace eval 516test {
	oo::define 516a {
	    mixin 516b 516c
	}
    }
    lappend result [info class mixin 516test::516a]
    # Must not remove class with just simple name match
    oo::define 516test::516a {
	mixin -remove 516b
    }
    lappend result [info class mixin 516test::516a]
    # Must remove class with resolved name match
    oo::define 516test::516a {
	mixin -remove 516test::516c
    }
    lappend result [info class mixin 516test::516a]
    # Must remove class with resolved name match even after renaming, but only
    # with the renamed name; it is a slot of classes, not strings!
    rename 516test::516b 516test::516d
    oo::define 516test::516a {
	mixin -remove 516test::516b
    }
    lappend result [info class mixin 516test::516a]
    oo::define 516test::516a {
	mixin -remove 516test::516d
    }
    lappend result [info class mixin 516test::516a]
} -cleanup {
    parent destroy
} -result {{::516test::516b ::516test::516c} {::516test::516b ::516test::516c} ::516test::516b ::516test::516d {}}

test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
    oo::class create fruit {
	method eat {} {}
    }
    set result {}
} -body {
3860
3861
3862
3863
3864
3865
3866






















3867
3868
3869
3870
3871
3872
3873
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	method e {} {}
    }
    E create e1
    list [lsort [info class methods E -all]] [lsort [info object methods e1 -all]]
} -cleanup {
    base destroy
} -result {{c d e} {c d e}}
test oo-35.6 {
    Bug : teardown of an object that is a class that is an instance of itself
} -setup {
    oo::class create obj

    oo::copy obj obj1 obj1
    oo::objdefine obj1 {
	mixin obj1 obj
    }
    oo::copy obj1 obj2
    oo::objdefine obj2 {
	mixin obj2 obj1
    }
} -body {
    rename obj2 {}
    rename obj1 {}
    # doesn't crash
    return done
} -cleanup {
    rename obj {}
} -result done

test oo-36.1 {TIP #470: introspection within oo::define} {
    oo::define oo::object self
} ::oo::object
test oo-36.2 {TIP #470: introspection within oo::define} -setup {
    oo::class create Cls
} -body {
    oo::define Cls self
3967
3968
3969
3970
3971
3972
3973









































































































































































































































































































































































































































































































































































































































































































































































3974
3975
3976
3977
3978
3979
3980
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    }
    Cls create obj
    list [oo::objdefine obj testself] $result
} -cleanup {
    Cls destroy
    catch {rename oo::objdefine::testself {}}
} -result {{} {1 {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command} 0 ::obj}}

test oo-37.1 {TIP 500: private command propagates errors} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private ::error "this is an error"
    }
} -cleanup {
    cls destroy
} -returnCodes error -result {this is an error}
test oo-37.2 {TIP 500: private command propagates errors} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private {
	    ::error "this is an error"
	}
    }
} -cleanup {
    cls destroy
} -returnCodes error -result {this is an error}
test oo-37.3 {TIP 500: private command propagates errors} -setup {
    oo::object create obj
} -body {
    oo::objdefine obj {
	private ::error "this is an error"
    }
} -cleanup {
    obj destroy
} -returnCodes error -result {this is an error}
test oo-37.4 {TIP 500: private command propagates errors} -setup {
    oo::object create obj
} -body {
    oo::objdefine obj {
	private {
	    ::error "this is an error"
	}
    }
} -cleanup {
    obj destroy
} -returnCodes error -result {this is an error}
test oo-37.5 {TIP 500: private command can't be used outside definitions} -body {
    oo::define::private error "xyz"
} -returnCodes error -result {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command}
test oo-37.6 {TIP 500: private command can't be used outside definitions} -body {
    oo::objdefine::private error "xyz"
} -returnCodes error -result {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command}

test oo-38.1 {TIP 500: private variables don't cross-interfere with each other or normal ones} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	private variable x
	constructor {} {
	    set x 1
	}
	method getA {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	private {
	    variable x
	}
	constructor {} {
	    set x 2
	    next
	}
	method getB {} {
	    return $x
	}
    }
    oo::class create clsC {
	superclass clsB
	variable x
	constructor {} {
	    set x 3
	    next
	}
	method getC {} {
	    return $x
	}
    }
    clsC create obj
    oo::objdefine obj {
	private {
	    variable x
	}
	method setup {} {
	    set x 4
	}
	method getO {} {
	    return $x
	}
    }
    obj setup
    list [obj getA] [obj getB] [obj getC] [obj getO] \
	[lsort [string map [list [info object creationid clsA] CLASS-A \
				[info object creationid clsB] CLASS-B \
				[info object creationid obj] OBJ] \
		    [info object vars obj]]]
} -cleanup {
    parent destroy
} -result {1 2 3 4 {{CLASS-A : x} {CLASS-B : x} {OBJ : x} x}}
test oo-38.2 {TIP 500: private variables introspection} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	private {
	    variable x1
	    variable x2
	}
	variable y1 y2
    }
    cls create obj
    oo::objdefine obj {
	private variable a1 a2
	variable b1 b2
    }
    list [lsort [info class variables cls]] \
	[lsort [info class variables cls -private]] \
	[lsort [info object variables obj]] \
	[lsort [info object variables obj -private]]
} -cleanup {
    parent destroy
} -result {{y1 y2} {x1 x2} {b1 b2} {a1 a2}}
test oo-38.3 {TIP 500: private variables and oo::object·varname} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	private {
	    variable x
	}
	method getx {} {
	    set x 1
	    my varname x
	}
	method readx {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	variable x
	method gety {} {
	    set x 1
	    my varname x
	}
	method ready {} {
	    return $x
	}
    }
    clsB create obj
    set [obj getx] 2
    set [obj gety] 3
    list [obj readx] [obj ready]
} -cleanup {
    parent destroy
} -result {2 3}
test oo-38.4 {TIP 500: private variables introspection} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	private {
	    variable x1 x2
	}
	variable y1 y2
	constructor {} {
	    variable z boo
	    set x1 a
	    set y1 c
	}
	method list {} {
	    variable z
	    set ok 1
	    list [info locals] [lsort [info vars]] [info exist x2]
	}
    }
    cls create obj
    oo::objdefine obj {
	private variable a1 a2
	variable b1 b2
	method init {} {
	    # Because we don't have a constructor to do this setup for us
	    set a1 p
	    set b1 r
	}
	method list {} {
	    variable z
	    set yes 1
	    list {*}[next] [info locals] [lsort [info vars]] [info exist a2]
	}
    }
    obj init
    obj list
} -cleanup {
    parent destroy
} -result {ok {ok x1 x2 y1 y2 z} 0 yes {a1 a2 b1 b2 yes z} 0}
test oo-38.5 {TIP 500: private variables and oo::object·variable} -setup {
    oo::class create parent
} -body {
    oo::class create cls1 {
	superclass parent
	private variable x
	method abc val {
	    my variable x
	    set x $val
	}
	method def val {
	    my variable y
	    set y $val
	}
	method get1 {} {
	    my variable x y
	    return [list $x $y]
	}
    }
    oo::class create cls2 {
	superclass cls1
	private variable x
	method x-exists {} {
	    return [info exists x],[uplevel 1 {info exists x}]
	}
	method ghi x {
	    # Additional instrumentation to show that we're not using the
	    # resolved variable until we ask for it; the argument nixed that
	    # happening by default.
	    set val $x
	    set before [my x-exists]
	    unset x
	    set x $val
	    set mid [my x-exists]
	    unset x
	    set mid2 [my x-exists]
	    my variable x
	    set x $val
	    set after [my x-exists]
	    return "$before;$mid;$mid2;$after"
	}
	method jkl val {
	    my variable y
	    set y $val
	}
	method get2 {} {
	    my variable x y
	    return [list $x $y]
	}
    }
    cls2 create a
    a abc 123
    a def 234
    set tmp [a ghi 345]
    a jkl 456
    list $tmp [a get1] [a get2]
} -cleanup {
    parent destroy
} -result {{0,1;0,1;0,0;1,1} {123 456} {345 456}}

test oo-39.1 {TIP 500: private methods internal call; class private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my step
	    my step
	    my step
	    return
	}
	private {
	    method step {} {
		incr x 2
	    }
	}
	method x {} {
	    return $x
	}
    }
    clsA create obj
    obj act
    list [obj x] [catch {obj step} msg] $msg
} -cleanup {
    parent destroy
} -result {7 1 {unknown method "step": must be act, destroy or x}}
test oo-39.2 {TIP 500: private methods internal call; class private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my step
	    my step
	    my step
	    return
	}
	private {
	    method step {} {
		incr x 2
	    }
	}
	method x {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	variable x
	method step {} {
	    incr x 5
	}
    }
    clsB create obj
    obj act
    list [obj x] [obj step]
} -cleanup {
    parent destroy
} -result {7 12}
test oo-39.3 {TIP 500: private methods internal call; class private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my Step
	    my Step
	    my Step
	    return
	}
	method x {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	variable x
	method Step {} {
	    incr x 5
	}
    }
    clsB create obj
    obj act
    set result [obj x]
    oo::define clsA {
	private {
	    method Step {} {
		incr x 2
	    }
	}
    }
    obj act
    lappend result [obj x]
} -cleanup {
    parent destroy
} -result {16 22}
test oo-39.4 {TIP 500: private methods internal call; instance private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my step
	    return
	}
	method step {} {
	    incr x
	}
	method x {} {
	    return $x
	}
    }
    clsA create obj
    obj act
    set result [obj x]
    oo::objdefine obj {
	variable x
	private {
	    method step {} {
		incr x 2
	    }
	}
    }
    obj act
    lappend result [obj x]
    oo::objdefine obj {
	method act {} {
	    my step
	    next
	}
    }
    obj act
    lappend result [obj x]
} -cleanup {
    parent destroy
} -result {2 3 6}
test oo-39.5 {TIP 500: private methods internal call; cross object} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {$x == [$other x]}
	}
    }
    cls create a 1
    cls create b 2
    cls create c 1
    list [a equal b] [b equal c] [c equal a] [catch {a x} msg] $msg
} -cleanup {
    parent destroy
} -result {0 0 1 1 {unknown method "x": must be destroy or equal}}
test oo-39.6 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {$x == [$other y]}
	}
    }
    cls create a 1
    cls create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be destroy, equal or x}
test oo-39.7 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {[[self] y] == [$other x]}
	}
    }
    cls create a 1
    cls create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be destroy, equal or x}
test oo-39.8 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {[my y] == [$other x]}
	}
    }
    cls create a 1
    cls create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be <cloned>, destroy, equal, eval, unknown, variable, varname or x}
test oo-39.9 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
    }
    oo::class create cls2 {
	superclass cls
	method equal {other} {
	    expr {[my y] == [$other x]}
	}
    }
    cls2 create a 1
    cls2 create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be <cloned>, destroy, equal, eval, unknown, variable or varname}
test oo-39.10 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
    }
    oo::class create cls2 {
	superclass cls
	method equal {other} {
	    expr {[my x] == [$other x]}
	}
    }
    cls2 create a 1
    cls2 create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "x": must be <cloned>, destroy, equal, eval, unknown, variable or varname}
test oo-39.11 {TIP 500: private methods; call chain caching and reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method chain {} {
	    return [self call]
	}
    }
    oo::class create cls2 {
	superclass cls
	private method chain {} {
	    next
	}
	method chain2 {} {
	    my chain
	}
	method chain3 {} {
	    [self] chain
	}
    }
    cls create a
    cls2 create b
    list [a chain] [b chain] [b chain2] [b chain3]
} -cleanup {
    parent destroy
} -result {{{{method chain ::cls method}} 0} {{{method chain ::cls method}} 0} {{{private chain ::cls2 method} {method chain ::cls method}} 1} {{{private chain ::cls2 method} {method chain ::cls method}} 1}}
test oo-39.12 {TIP 500: private methods; introspection} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method chain {} {
	    return [self call]
	}
	private method abc {} {}
    }
    oo::class create cls2 {
	superclass cls
	method chain2 {} {
	    my chain
	}
	method chain3 {} {
	    [self] chain
	}
	private method def {} {}
	unexport chain3
    }
    cls create a
    cls2 create b
    oo::objdefine b {
	private method ghi {} {}
	method ABC {} {}
	method foo {} {}
    }
    set scopes {public unexported private}
    list a: [lmap s $scopes {info object methods a -scope $s}] \
	b: [lmap s $scopes {info object methods b -scope $s}] \
	cls: [lmap s $scopes {info class methods cls -scope $s}] \
	cls2: [lmap s $scopes {info class methods cls2 -scope $s}] \
} -cleanup {
    parent destroy
} -result {a: {{} {} {}} b: {foo ABC ghi} cls: {chain {} abc} cls2: {chain2 chain3 def}}

test oo-40.1 {TIP 500: private and self} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	self {
	    private {
		variable a
	    }
	    variable b
	}
	private {
	    self {
		variable c
	    }
	    variable d
	}
	variable e
    }
    list \
	[lsort [info class variables cls]] \
	[lsort [info class variables cls -private]] \
	[lsort [info object variables cls]] \
	[lsort [info object variables cls -private]]
} -cleanup {
    cls destroy
} -result {e d b {a c}}
test oo-40.2 {TIP 500: private and export} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private method foo {} {}
    }
    set result [lmap s {public unexported private} {
	info class methods cls -scope $s}]
    oo::define cls {
	export foo
    }
    lappend result {*}[lmap s {public unexported private} {
	info class methods cls -scope $s}]
} -cleanup {
    cls destroy
} -result {{} {} foo foo {} {}}
test oo-40.3 {TIP 500: private and unexport} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private method foo {} {}
    }
    set result [lmap s {public unexported private} {
	info class methods cls -scope $s}]
    oo::define cls {
	unexport foo
    }
    lappend result {*}[lmap s {public unexported private} {
	info class methods cls -scope $s}]
} -cleanup {
    cls destroy
} -result {{} {} foo {} foo {}}

test oo-41.1 {TIP 478: myclass command, including class morphing} -setup {
    oo::class create parent
    set result {}
} -body {
    oo::class create cls1 {
	superclass parent
	self method count {} {
	    my variable c
	    incr c
	}
	method act {} {
	    myclass count
	}
    }
    cls1 create x
    lappend result [x act] [x act]
    cls1 create y
    lappend result [y act] [y act] [x act]
    oo::class create cls2 {
	superclass cls1
	self method count {} {
	    my variable d
	    expr {1.0 * [incr d]}
	}
    }
    oo::objdefine x {class cls2}
    lappend result [x act] [y act] [x act] [y act]
} -cleanup {
    parent destroy
} -result {1 2 3 4 5 1.0 6 2.0 7}
test oo-41.2 {TIP 478: myclass command cleanup} -setup {
    oo::class create parent
    set result {}
} -body {
    oo::class create cls1 {
	superclass parent
	self method hi {} {
	    return "this is [self]"
	}
	method hi {} {
	    return "this is [self]"
	}
    }
    cls1 create x
    rename [info object namespace x]::my foo
    rename [info object namespace x]::myclass bar
    lappend result [cls1 hi] [x hi] [foo hi] [bar hi]
    x destroy
    lappend result [catch {foo hi}] [catch {bar hi}]
} -cleanup {
    parent destroy
} -result {{this is ::cls1} {this is ::x} {this is ::x} {this is ::cls1} 1 1}
test oo-41.3 {TIP 478: myclass command calls unexported methods, via forward} -setup {
    oo::class create parent
    set result {}
} -body {
    oo::class create cls1 {
	superclass parent
	self method Hi {} {
	    return "this is [self]"
	}
	forward poke myclass Hi
    }
    cls1 create x
    lappend result [catch {cls1 Hi}] [x poke]
} -cleanup {
    parent destroy
} -result {1 {this is ::cls1}}

cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Added tests/ooUtil.test.




















































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# This file contains a collection of tests for functionality originally
# sourced from the ooutil package in Tcllib. Sourcing this file into Tcl runs
# the tests and generates output for errors. No output means no errors were
# found.
#
# Copyright (c) 2014-2016 Andreas Kupries
# Copyright (c) 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0.3
package require tcltest 2
if {"::tcltest" in [namespace children]} {
    namespace import -force ::tcltest::*
}

test ooUtil-1.1 {TIP 478: classmethod} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
        superclass ActiveRecord
    }
    Table find foo bar
} -cleanup {
    parent destroy
} -result {::Table called with arguments: foo bar}
test ooUtil-1.2 {TIP 478: classmethod in namespace} -setup {
    namespace eval ::testns {}
} -body {
    namespace eval ::testns {
	oo::class create ActiveRecord {
	    classmethod find args {
		return "[self] called with arguments: $args"
	    }
	}
	oo::class create Table {
	    superclass ActiveRecord
	}
    }
    testns::Table find foo bar
} -cleanup {
    namespace delete ::testns
} -result {::testns::Table called with arguments: foo bar}
test ooUtil-1.3 {TIP 478: classmethod must not interfere with constructor signatures} -setup {
    oo::class create parent
} -body {
    oo::class create TestClass {
        superclass oo::class parent
        self method create {name ignore body} {
            next $name $body
        }
    }
    TestClass create okay {} {}
} -cleanup {
    parent destroy
} -result {::okay}
test ooUtil-1.4 {TIP 478: classmethod with several inheritance levels} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
        superclass ActiveRecord
    }
    oo::class create SubTable {
        superclass Table
    }
    SubTable find foo bar
} -cleanup {
    parent destroy
} -result {::SubTable called with arguments: foo bar}
test ooUtil-1.5 {TIP 478: classmethod and instances} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
	superclass ActiveRecord
    }
    set t [Table new]
    $t find 1 2 3
} -cleanup {
    parent destroy
} -result {::Table called with arguments: 1 2 3}
test ooUtil-1.6 {TIP 478: classmethod and instances} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
	superclass ActiveRecord
	unexport find
    }
    set t [Table new]
    $t find 1 2 3
} -returnCodes error -cleanup {
    parent destroy
} -match glob -result {unknown method "find": must be *}
test ooUtil-1.7 {} -setup {
    oo::class create parent
} -body {
    oo::class create Foo {
	superclass parent
        classmethod bar {} {
            puts "This is in the class; self is [self]"
            my meee
        }
        classmethod meee {} {
            puts "This is meee"
        }
    }
    oo::class create Grill {
        superclass Foo
        classmethod meee {} {
            puts "This is meee 2"
        }
    }
    list [Foo bar] [Grill bar] [[Foo new] bar] [[Grill new] bar]
} -cleanup {
    parent destroy
} -result {{} {} {} {}} -output "This is in the class; self is ::Foo\nThis is meee\nThis is in the class; self is ::Grill\nThis is meee 2\nThis is in the class; self is ::Foo\nThis is meee\nThis is in the class; self is ::Grill\nThis is meee 2\n"
# Two tests to confirm that we correctly initialise the scripted part of TclOO
# in child interpreters. This is slightly tricky at the implementation level
# because we cannot count on either [source] or [open] being available.
test ooUtil-1.8 {TIP 478: classmethod in child interp} -setup {
    set childinterp [interp create]
} -body {
    $childinterp eval {
	oo::class create ActiveRecord {
	    classmethod find args {
		return "[self] called with arguments: $args"
	    }
	}
	oo::class create Table {
	    superclass ActiveRecord
	}
	# This is confirming that this is not the master interpreter
	list [Table find foo bar] [info globals childinterp]
    }
} -cleanup {
    interp delete $childinterp
} -result {{::Table called with arguments: foo bar} {}}
test ooUtil-1.9 {TIP 478: classmethod in safe child interp} -setup {
    set safeinterp [interp create -safe]
} -body {
    $safeinterp eval {
	oo::class create ActiveRecord {
	    classmethod find args {
		return "[self] called with arguments: $args"
	    }
	}
	oo::class create Table {
	    superclass ActiveRecord
	}
	# This is confirming that this is a (basic) safe interpreter
	list [Table find foo bar] [info commands source]
    }
} -cleanup {
    interp delete $safeinterp
} -result {{::Table called with arguments: foo bar} {}}

test ooUtil-2.1 {TIP 478: callback generation} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {} { return ok,[self] }
	method makeCall {} {
	    return [callback CallMe]
	}
    }
    c create ::context
    set cb [context makeCall]
    {*}$cb
} -cleanup {
    parent destroy
} -result {ok,::context}
test ooUtil-2.2 {TIP 478: callback generation} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {a b c} { return ok,[self],$a,$b,$c }
	method makeCall {b} {
	    return [callback CallMe 123 $b]
	}
    }
    c create ::context
    set cb [context makeCall "a b c"]
    {*}$cb PQR
} -cleanup {
    parent destroy
} -result {ok,::context,123,a b c,PQR}
test ooUtil-2.3 {TIP 478: callback generation, alternate name} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {} { return ok,[self] }
	method makeCall {} {
	    return [mymethod CallMe]
	}
    }
    c create ::context
    set cb [context makeCall]
    {*}$cb
} -cleanup {
    parent destroy
} -result {ok,::context}
test ooUtil-2.4 {TIP 478: callback generation, alternate name} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {a b c} { return ok,[self],$a,$b,$c }
	method makeCall {b} {
	    return [mymethod CallMe 123 $b]
	}
    }
    c create ::context
    set cb [context makeCall "a b c"]
    {*}$cb PQR
} -cleanup {
    parent destroy
} -result {ok,::context,123,a b c,PQR}
test ooUtil-2.5 {TIP 478: callbacks and method lifetime} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method makeCall {b} {
	    return [callback CallMe 123 $b]
	}
    }
    c create ::context
    set cb [context makeCall "a b c"]
    set result [list [catch {{*}$cb PQR} msg] $msg]
    oo::objdefine context {
	method CallMe {a b c} { return ok,[self],$a,$b,$c }
    }
    lappend result [{*}$cb PQR]
} -cleanup {
    parent destroy
} -result {1 {unknown method "CallMe": must be <cloned>, destroy, eval, makeCall, unknown, variable or varname} {ok,::context,123,a b c,PQR}}
test ooUtil-2.6 {TIP 478: callback use case} -setup {
    oo::class create parent
    unset -nocomplain x
} -body {
    oo::class create c {
	superclass parent
	variable count
	constructor {var} {
	    set count 0
	    upvar 1 $var v
	    trace add variable v write [callback TraceCallback]
	}
	method count {} {return $count}
	method TraceCallback {name1 name2 op} {
	    incr count
	}
    }
    set o [c new x]
    for {set x 0} {$x < 5} {incr x} {}
    $o count
} -cleanup {
    unset -nocomplain x
    parent destroy
} -result 6

test ooUtil-3.1 {TIP 478: class initialisation} -setup {
    oo::class create parent
    catch {rename ::foobar-3.1 {}}
} -body {
    oo::class create ::cls {
	superclass parent
	initialise {
	    proc foobar-3.1 {} {return ok}
	}
	method calls {} {
	    list [catch foobar-3.1 msg] $msg \
		[namespace eval [info object namespace [self class]] foobar-3.1]
	}
    }
    [cls new] calls
} -cleanup {
    parent destroy
} -result {1 {invalid command name "foobar-3.1"} ok}
test ooUtil-3.2 {TIP 478: class variables} -setup {
    oo::class create parent
    catch {rename ::foobar-3.1 {}}
} -body {
    oo::class create ::cls {
	superclass parent
	initialise {
	    variable x 123
	}
	method call {} {
	    classvariable x
	    incr x
	}
    }
    cls create a
    cls create b
    cls create c
    list [a call] [b call] [c call] [a call] [b call] [c call]
} -cleanup {
    parent destroy
} -result {124 125 126 127 128 129}
test ooUtil-3.3 {TIP 478: class initialisation} -setup {
    oo::class create parent
    catch {rename ::foobar-3.3 {}}
} -body {
    oo::class create ::cls {
	superclass parent
	initialize {
	    proc foobar-3.3 {} {return ok}
	}
	method calls {} {
	    list [catch foobar-3.3 msg] $msg \
		[namespace eval [info object namespace [self class]] foobar-3.3]
	}
    }
    [cls new] calls
} -cleanup {
    parent destroy
} -result {1 {invalid command name "foobar-3.3"} ok}
test ooUtil-3.4 {TIP 478: class initialisation} -setup {
    oo::class create parent
    catch {rename ::appendToResultVar {}}
    proc ::appendToResultVar args {
	lappend ::result {*}$args
    }
    set result {}
} -body {
    trace add execution oo::define::initialise enter appendToResultVar
    oo::class create ::cls {
	superclass parent
	initialize {proc xyzzy {} {}}
    }
    return $result
} -cleanup {
    catch {
	trace remove execution oo::define::initialise enter appendToResultVar
    }
    rename ::appendToResultVar {}
    parent destroy
} -result {{initialize {proc xyzzy {} {}}} enter}
test ooUtil-3.5 {TIP 478: class initialisation} -body {
    oo::define oo::object {
	::list [::namespace which initialise] [::namespace which initialize] \
	     [::namespace origin initialise] [::namespace origin initialize]
    }
} -result {::oo::define::initialise ::oo::define::initialize ::oo::define::initialise ::oo::define::initialise}

test ooUtil-4.1 {TIP 478: singleton} -setup {
    oo::class create parent
} -body {
    oo::singleton create xyz {
	superclass parent
    }
    set x [xyz new]
    set y [xyz new]
    set z [xyz new]
    set code [catch {$x destroy} msg]
    set p [xyz new]
    lappend code [catch {rename $x ""}]
    set q [xyz new]
    string map [list $x ONE $q TWO] [list {*}$code $x $y $z $p $q [xyz new]]
} -cleanup {
    parent destroy
} -result {1 0 ONE ONE ONE ONE TWO TWO}
test ooUtil-4.2 {TIP 478: singleton errors} -setup {
    oo::class create parent
} -body {
    oo::singleton create xyz {
	superclass parent
    }
    [xyz new] destroy
} -returnCodes error -cleanup {
    parent destroy
} -result {may not destroy a singleton object}
test ooUtil-4.3 {TIP 478: singleton errors} -setup {
    oo::class create parent
} -body {
    oo::singleton create xyz {
	superclass parent
    }
    oo::copy [xyz new]
} -returnCodes error -cleanup {
    parent destroy
} -result {may not clone a singleton object}


test ooUtil-5.1 {TIP 478: abstract} -setup {
    oo::class create parent
} -body {
    oo::abstract create xyz {
	superclass parent
	method foo {} {return 123}
    }
    oo::class create pqr {
	superclass xyz
	method bar {} {return 456}
    }
    set codes [list [catch {xyz new}] [catch {xyz create x}] [catch {xyz createWithNamespace x y}]]
    set x [pqr new]
    set y [pqr create ::y]
    lappend codes [$x foo] [$x bar] $y
} -cleanup {
    parent destroy
} -result {1 1 1 123 456 ::y}

test ooUtil-6.1 {TIP 478: classvarable} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	initialise {
	    variable x 1 y 2
	}
	method a {} {
	    classvariable x
	    incr x
	}
	method b {} {
	    classvariable y
	    incr y
	}
	method c {} {
	    classvariable x y
	    list $x $y
	}
    }
    set p [xyz new]
    set q [xyz new]
    set result [list [$p c] [$q c]]
    $p a
    $q b
    lappend result [[xyz new] c]
} -cleanup {
    parent destroy
} -result {{1 2} {1 2} {2 3}}
test ooUtil-6.2 {TIP 478: classvarable error case} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	method a {} {
	    classvariable x(1)
	    incr x(1)
	}
    }
    set p [xyz new]
    set q [xyz new]
    list [$p a] [$q a]
} -returnCodes error -cleanup {
    parent destroy
} -result {bad variable name "x(1)": can't create a scalar variable that looks like an array element}
test ooUtil-6.3 {TIP 478: classvarable error case} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	method a {} {
	    classvariable ::x
	    incr x
	}
    }
    set p [xyz new]
    set q [xyz new]
    list [$p a] [$q a]
} -returnCodes error -cleanup {
    parent destroy
} -result {bad variable name "::x": can't create a local variable with a namespace separator in it}

test ooUtil-7.1 {TIP 478: link calling pattern} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method foo {} {return "in foo of [self]"}
	method Bar {} {return "in bar of [self]"}
	method Grill {} {return "in grill of [self]"}
	export eval
	constructor {} {
	    link foo
	    link {bar Bar} {grill Grill}
	}
    }
    cls create o
    o eval {list [foo] [bar] [grill]}
} -cleanup {
    parent destroy
} -result {{in foo of ::o} {in bar of ::o} {in grill of ::o}}
test ooUtil-7.2 {TIP 478: link removed when [my] disappears} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method foo {} {return "in foo of [self]"}
	constructor {cmd} {
	    link [list ::$cmd foo]
	}
    }
    cls create o pqr
    list [o foo] [pqr] [rename [info object namespace o]::my {}] [catch pqr msg] $msg
} -cleanup {
    parent destroy
} -result {{in foo of ::o} {in foo of ::o} {} 1 {invalid command name "pqr"}}

# Tests that verify issues detected with the tcllib version of the code
test ooUtil-tcllib-ticket-b3577ed586 {test scoping of delegation in oo::class.Delegate } -setup {
    oo::class create animal {}
    namespace eval ::ooutiltest {
	oo::class create pet { superclass animal }
    }
} -body {
    namespace eval ::ooutiltest {
	oo::class create dog { superclass pet }
    }
} -cleanup {
    namespace delete ooutiltest
    rename animal {}
} -result {::ooutiltest::dog}
test ooUtil-tcllib-ticket-fe7a0e0a3a {classmethod must not interfere with constructor signatures} -setup {
    oo::class create TestClass {
        superclass oo::class
        self method create {name ignore body} {
            next $name $body
        }
    }
} -body {
    TestClass create okay {} {}
} -cleanup {
    rename TestClass {}
} -result {::okay}

cleanupTests
return

# Local Variables:
# fill-column: 78
# mode: tcl
# End:

Changes to tests/package.test.

16
17
18
19
20
21
22
23
24
25
26
27

28
29
30

31
32
33
34


35
36
37
38
39
40
41
16
17
18
19
20
21
22


23
24
25
26
27
28

29
30
31
32
33
34
35
36
37
38
39
40
41
42







-
-



+


-
+




+
+







    package require tcltest 2.3.3
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testpreferstable [llength [info commands testpreferstable]]

# Do all this in a slave interp to avoid garbaging the package list
set i [interp create]
tcltest::loadIntoSlaveInterpreter $i {*}$argv
catch [list load {} Tcltest $i]
interp eval $i {
namespace import -force ::tcltest::*
package forget {*}[package names]
#package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}
set oldPath $auto_path
set auto_path ""

testConstraint testpreferstable [llength [info commands testpreferstable]]

test package-1.1 {pkg::create gives error on insufficient args} -body {
    ::pkg::create
} -returnCodes error -match glob -result {wrong # args: should be "*"}
test package-1.2 {pkg::create gives error on bad args} -body {
    ::pkg::create -foo bar -bar baz -baz boo
} -returnCodes error -match glob -result {unknown option "bar": *}
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
161
162

163
164
165
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180
181
182

183
184
185
186
187
188
189
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
161
162

163
164
165
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180
181
182

183
184
185
186
187
188
189
190







-
+









-
+









-
+









-
+









-
+







    package forget t
    set x xxx
} -body {
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    return $x
    set x
} -result {3.4}
test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    return $x
    set x
} -result {3.5}
test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {3.5 2.1 2.3} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t 2.2
    return $x
    set x
} -result {2.3}
test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require -exact t 2.3
    return $x
    set x
} -result {2.3}
test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t 2.1
    return $x
    set x
} -result {2.4}
test package-3.6 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
    package forget t
} -returnCodes error -body {
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
234
235
236
237
238
239
240
241

242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259

260
261
262
263
264
265
266
235
236
237
238
239
240
241

242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259

260
261
262
263
264
265
266
267







-
+

















-
+







} -match glob -result {1 * invoked}
test package-3.12 {Tcl_PkgRequire procedure, self-deleting script} -setup {
    package forget t
    set x xxx
} -body {
    package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
    package require t 1.2
    return $x
    set x
} -result {1.2}
test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
    package forget t
    set x xxx
} -body {
    proc pkgUnknown args {
	# args = name requirement
	# requirement = v-v (for exact version)
	global x
	set x $args
	package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0]
    }
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package unknown pkgUnknown
    package require -exact t 1.5
    return $x
    set x
} -cleanup {
    package unknown {}
} -result {t 1.5-1.5}
test package-3.14 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
    package forget t
    set x xxx
} -body {
279
280
281
282
283
284
285
286

287
288
289
290
291
292
293
280
281
282
283
284
285
286

287
288
289
290
291
292
293
294







-
+







} -body {
    proc pkgUnknown args {
	global x
	set x $args
	package provide [lindex $args 0] 2.0
    }
    package require {a b}
    return $x
    set x
} -cleanup {
    package unknown {}
} -result {{a b} 0-}
test package-3.16 {Tcl_PkgRequire procedure, "package unknown" error} -setup {
    package forget t
} -body {
    proc pkgUnknown args {
571
572
573
574
575
576
577



578
579
580

581

582
583
584
585
586




587
588
589
590
591
592
593
594
595
596

597
598
599
600
601
602
603
604
605
606

607
























608
609
610
611
612




613
614

615
616







617
618

619



620


621
622

623

624
625
626
627
628
629



630
631


632

633

634
635
636
637
638
639
640



641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659




660
661



662

663


664


665

666
667



668
669


670


671

672
673



674
675


676


677

678
679
680



681
682
683
684
685
686
687
688
689
690
691
692
693




694
695

696



697


698

699

700
701
702
703
704



705
706
707
708
709
710
711
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591

592
593
594
595
596
597
598
599
600
601
602
603
604

605
606
607
608
609
610
611
612
613
614

615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644

645
646
647
648
649
650
651


652
653
654
655
656
657
658
659
660
661

662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717

718
719
720
721
722
723
724
725
726

727
728
729
730

731
732
733
734
735
736
737
738
739
740
741
742
743

744
745
746
747
748
749
750
751
752
753
754
755
756

757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778

779
780
781
782
783
784
785

786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810







+
+
+



+

+




-
+
+
+
+









-
+









-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+
+
+
+


+
-
-
+
+
+
+
+
+
+


+
-
+
+
+

+
+


+

+






+
+
+


+
+

+

+







+
+
+


















-
+
+
+
+


+
+
+
-
+

+
+
-
+
+

+


+
+
+


+
+
-
+
+

+


+
+
+


+
+
-
+
+

+



+
+
+












-
+
+
+
+


+
-
+
+
+

+
+

+

+





+
+
+







    package provide demo 1.2.3
} -body {
    package require -exact demo 1.2
} -returnCodes error -cleanup {
    package forget demo
} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
    interp create child
    load {} Tcltest child
    child eval {
    testpreferstable
    package forget t
    set x xxx
    }
} -body {
    child eval {
    foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    return $x
    set x
    }
} -cleanup {
    interp delete child
} -result {3.4}
test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.2b1 1.2 1.3a2 1.3} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    return $x
    set x
} -result {1.3}
test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.2b1 1.2 1.3 1.3a2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    return $x
    set x
} -result {1.3}
test pkg-3.53 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
    testpreferstable
    package forget t
    set x xxx
} -body {
    foreach i {1.2b1 1.1} {
        package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    set x
} -result {1.1}
test package-3.54 {Tcl_PkgRequire procedure, coroutine support} -setup {
    package forget t
} -body {
    coroutine coro1 apply {{} {
	package ifneeded t 2.1 {
	    yield
	    package provide t 2.1
	}
	package require t 2.1
    }}
    list [catch {coro1} msg] $msg
} -match glob -result {0 2.1}


test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
    package
} -result {wrong # args: should be "package option ?arg ...?"}
test package-4.2 {Tcl_PackageCmd procedure, "forget" option} {
test package-4.2 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    package names
    }
} {}
test package-4.3 {Tcl_PackageCmd procedure, "forget" option} {
} -cleanup {
    interp delete child
} -result {}
test package-4.3 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    package forget foo
    }
} {}
} -cleanup {
    interp delete child
} -result {}
test package-4.4 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    set result {}
    }
} -body {
    child eval {
    package ifneeded t 1.1 {first script}
    package ifneeded t 2.3 {second script}
    package ifneeded x 1.4 {x's script}
    lappend result [lsort [package names]] [package versions t]
    package forget t
    lappend result [lsort [package names]] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {{t x} {1.1 2.3} x {}}
test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded a 1.1 {first script}
    package ifneeded b 2.3 {second script}
    package ifneeded c 1.4 {third script}
    package forget
    set result [list [lsort [package names]]]
    package forget a c
    lappend result [lsort [package names]]
    }
} -cleanup {
    interp delete child
} -result {{a b c} b}
test package-4.5.1 {Tcl_PackageCmd procedure, "forget" option} -body {
    # Test for Bug 415273
    package ifneeded a 1 "I should have been forgotten"
    package forget no-such-package a
    package ifneeded a 1
} -cleanup {
    package forget a
} -result {}
test package-4.6 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
    package ifneeded a
} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
test package-4.7 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
    package ifneeded a b c d
} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
test package-4.8 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
    package ifneeded t xyz
} -returnCodes error -result {expected version number but got "xyz"}
test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    list [package ifneeded foo 1.1] [package names]
    }
} -cleanup {
    interp delete child
} {{} {}}
} -result {{} {}}
test package-4.10 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
    child eval {
    package forget t
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded t 1.4 "script for t 1.4"
    list [package names] [package ifneeded t 1.4] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {t {script for t 1.4} 1.4}
test package-4.11 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
    child eval {
    package forget t
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded t 1.4 "script for t 1.4"
    list [package ifneeded t 1.5] [package names] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {{} t 1.4}
test package-4.12 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
    child eval {
    package forget t
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.4 "second script for t 1.4"
    list [package ifneeded t 1.4] [package names] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {{second script for t 1.4} t 1.4}
test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    package forget t
} -body {
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.2 "second script"
    package ifneeded t 3.1 "last script"
    list [package ifneeded t 1.2] [package versions t]
} -result {{second script} {1.4 1.2 3.1}}
test package-4.14 {Tcl_PackageCmd procedure, "names" option} -body {
    package names a
} -returnCodes error -result {wrong # args: should be "package names"}
test package-4.15 {Tcl_PackageCmd procedure, "names" option} {
test package-4.15 {Tcl_PackageCmd procedure, "names" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    package names
    }
} {}
} -cleanup {
    interp delete child
} -result {}
test package-4.16 {Tcl_PackageCmd procedure, "names" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded x 1.2 {dummy}
    package provide x 1.3
    package provide y 2.4
    catch {package require z 47.16}
    lsort [package names]
    }
} -cleanup {
    interp delete child
} -result {x y}
test package-4.17 {Tcl_PackageCmd procedure, "provide" option} -body {
    package provide
} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
test package-4.18 {Tcl_PackageCmd procedure, "provide" option} -body {
    package provide a b c
} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
1235
1236
1237
1238
1239
1240
1241
1242

1243
1244
1245
1246

1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263

1264
1265
1266

1267
1268
1269

1270
1271
1272
1273
1274



1275
1276
1277
1278
1279



1280
1281
1282
1283
1284
1285
1286
1334
1335
1336
1337
1338
1339
1340

1341


1342

1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359

1360
1361
1362

1363
1364
1365

1366
1367
1368
1369


1370
1371
1372
1373
1374
1375


1376
1377
1378
1379
1380
1381
1382
1383
1384
1385







-
+
-
-

-
+
















-
+


-
+


-
+



-
-
+
+
+



-
-
+
+
+







	}
	return $res
    } finally {
	interp delete $ip
    }
}

test package-13.0 {package prefer defaults} -constraints testpreferstable -setup {
test package-13.0 {package prefer defaults} -body {
    testpreferstable
} -body {
    prefer
} -result stable
} -result [expr {[string match {*[ab]*} [package provide Tcl]] ? "latest" : "stable"}]
test package-13.1 {package prefer defaults} -body {
    set ::env(TCL_PKG_PREFER_LATEST) stable	;# value not relevant!
    prefer
} -cleanup {
    unset -nocomplain ::env(TCL_PKG_PREFER_LATEST)
} -result latest

test package-14.0 {wrong\#args} -returnCodes error -body {
    package prefer foo bar
} -result {wrong # args: should be "package prefer ?latest|stable?"}
test package-14.1 {bogus argument} -returnCodes error -body {
    package prefer foo
} -result {bad preference "foo": must be latest or stable}

test package-15.0 {set, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {package prefer stable} -result stable
} -body {package prefer} -result stable
test package-15.1 {set stable, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {prefer stable} -result {stable stable}
} -body {package prefer stable} -result stable
test package-15.2 {set latest, change} -constraints testpreferstable -setup {
    testpreferstable
} -body {prefer latest} -result {stable latest}
} -body {package prefer latest} -result latest
test package-15.3 {set latest, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    prefer latest latest
} -result {stable latest latest}
    package prefer latest
    package prefer latest
} -result latest
test package-15.4 {set stable, rejected} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    prefer latest stable
} -result {stable latest latest}
    package prefer latest
    package prefer stable
} -result latest

rename prefer {}

set auto_path $oldPath
package unknown $oldPkgUnknown

cleanupTests

Changes to tests/parse.test.

372
373
374
375
376
377
378
379
380


381
382
383
384

385
386
387
388
389
390
391
372
373
374
375
376
377
378


379
380
381
382
383

384
385
386
387
388
389
390
391







-
-
+
+



-
+







	variable ::aresult
	variable ::acode
	set aresult $result
	set acode $code
	return "new result"
    }
    set handler1 [testasync create async1]
    set ::aresult xxx
    set ::acode yyy
    set aresult xxx
    set acode yyy
} -cleanup {
    testasync delete
} -body {
    list [testevalobjv 0 testasync mark $handler1 original 0] $::acode $::aresult
    list [testevalobjv 0 testasync mark $handler1 original 0] $acode $aresult
} -result {{new result} 0 original}
test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv {
    list [catch {testevalobjv 0 error message} msg] $msg
} {1 message}
test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv {
    rename ::unknown unknown.save
    proc ::unknown args {lappend ::info [info level]}

Added tests/pkgIndex.tcl.







1
2
3
4
5
6
+
+
+
+
+
+
#! /usr/bin/env tclsh

package ifneeded tcltests 0.1 "
    source [list $dir/tcltests.tcl]
    package provide tcltests 0.1
"

Changes to tests/platform.test.

18
19
20
21
22
23
24

25
26

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46


47
48
49
50

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70




71
72
73
74
75
76
77
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42






43
44




45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

65
66
67
68
69
70
71
72
73
74
75







+


+














-
-
-
-
-
-
+
+
-
-
-
-
+



















-
+
+
+
+








    # This is not how [variable] works. See TIP 276.
    #variable ::tcl_platform
    namespace upvar :: tcl_platform tcl_platform

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

testConstraint testCPUID [llength [info commands testcpuid]]
testConstraint testlongsize [llength [info commands testlongsize]]

test platform-1.0 {tcl_platform(engine)} {
  set tcl_platform(engine)
} {Tcl}

test platform-1.1 {TclpSetVariables: tcl_platform} {
    interp create i
    i eval {catch {unset tcl_platform(debug)}}
    i eval {catch {unset tcl_platform(threaded)}}
    set result [i eval {lsort [array names tcl_platform]}]
    interp delete i
    set result
} {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize}

# Test assumes twos-complement arithmetic, which is true of virtually
# everything these days.  Note that this does *not* use wide(), and
# this is intentional since that could make Tcl's numbers wider than
# the machine-integer on some platforms...
test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
    set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}]
test platform-2.1 {tcl_platform(wordSize) indicates size of native word} testlongsize {
    expr {$tcl_platform(wordSize) == [testlongsize]}
    # Result must be the largest bit in a machine word, which this checks
    # without assuming how wide the word really is
    list [expr {$result < 0}] [expr {$result ^ int($result - 1)}]
} {1 -1}
} {1}

# On Windows/UNIX, test that the CPU ID works

test platform-3.1 {CPU ID on Windows/UNIX} \
    -constraints testCPUID \
    -body {
	set cpudata [testcpuid 0]
	binary format iii \
	    [lindex $cpudata 1] \
	    [lindex $cpudata 3] \
	    [lindex $cpudata 2]
    } \
    -match regexp \
    -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}

# The platform package makes very few promises, but does promise that the
# format of string it produces consists of two non-empty words separated by a
# hyphen.
package require platform
test platform-4.1 {format of platform::identify result} -match regexp -body {
test platform-4.1 {format of platform::identify result} -constraints notValgrind -match regexp -body {
    # [identify] may attempt to [exec] dpkg-architecture, which may not exist,
    # in which case fork will not be followed by exec, and valgrind will issue
    # "still reachable" reports.
    platform::identify
} -result {^([^-]+-)+[^-]+$}
test platform-4.2 {format of platform::generic result} -match regexp -body {
    platform::generic
} -result {^([^-]+-)+[^-]+$}

# cleanup

Changes to tests/proc.test.

106
107
108
109
110
111
112








113
114
115
116
117
118
119
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127







+
+
+
+
+
+
+
+







} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} {
    }
} -returnCodes error -result {formal parameter "b::a" is not a simple name}
test proc-1.9 {Tcl_ProcObjCmd, arguments via canonical list (string-representation bug [631b4c45df])} -body {
    set v 2
    binary scan AB cc a b
    proc p [list [list a $a] [list b $b] [list v [expr {$v + 2}]]] {expr {$a + $b + $v}}
    p
} -result [expr {65+66+4}] -cleanup {
   rename p {}
}

test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
} -body {
    proc p {} {return "p in [namespace current]"}
    info body p
379
380
381
382
383
384
385








386
387
388
389
390
391
392
393
394
395
396
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412







+
+
+
+
+
+
+
+











    set lambda x
    lappend lambda {set a 1}
    interp create slave
    slave eval [list apply $lambda foo]
    interp delete slave
    unset lambda
} {}

test proc-7.5 {[631b4c45df] Crash in argument processing} {
    binary scan A c val
    proc foo [list  [list from $val]] {}
    rename foo {}
    unset -nocomplain val
} {}


# cleanup
catch {rename p ""}
catch {rename t ""}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Added tests/process.test.





























































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# process.test --
#
# This file contains a collection of tests for the tcl::process ensemble.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 2017 Frederic Bonnet
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Utilities
set path(sleep) [makeFile {
    after [expr $argv*1000]
    exit
} sleep]
set path(exit) [makeFile {
    exit $argv
} exit]

# Basic syntax checking
test process-1.1 {tcl::process command basic syntax} -returnCodes error -body {
    tcl::process
} -result {wrong # args: should be "tcl::process subcommand ?arg ...?"}
test process-1.2 {tcl::process subcommands} -returnCodes error -body {
    tcl::process ?
} -match glob -result {unknown or ambiguous subcommand "?": must be autopurge, list, purge, or status}

# Autopurge flag
# - Default state
test process-2.1 {autopurge default} -body {
    tcl::process autopurge
} -result {1}
# - Enabling autopurge
test process-2.2 {enable autopurge} -body {
    tcl::process autopurge true
    tcl::process autopurge
} -result {1}
# - Disabling autopurge
test process-2.3 {disable autopurge} -body {
    tcl::process autopurge false
    tcl::process autopurge
} -result {0} -cleanup {tcl::process autopurge true}

# Subprocess list & status
test process-3.1 {empty subprocess list} -body {
    llength [tcl::process list]
} -result {0}
test process-3.2 {empty subprocess status} -body {
    dict size [tcl::process status]
} -result {0}

# Spawn subprocesses using [exec]
# - One child
test process-4.1 {exec one child} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) 0 &]
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status [lindex [tcl::process status $pid] 1]
    expr {
           [llength $list] eq 1
        && [lindex $list 0] eq $pid
        && [dict size $statuses] eq 1
        && [dict get $statuses $pid] eq $status
        && $status eq 0
    }
} -result {1} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
# - Two children
test process-4.2 {exec two children in parallel} -body {
    tcl::process autopurge 0
    set pid1 [exec [interpreter] $path(exit) 0 &]
    set pid2 [exec [interpreter] $path(exit) 0 &]
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status1 [lindex [tcl::process status $pid1] 1]
    set status2 [lindex [tcl::process status $pid2] 1]
    expr {
           [llength $list] eq 2
        && [lsearch $list $pid1] >= 0
        && [lsearch $list $pid2] >= 0
        && [dict size $statuses] eq 2
        && [dict get $statuses $pid1] eq $status1
        && [dict get $statuses $pid2] eq $status2
        && $status1 eq 0
        && $status2 eq 0
    }
} -result {1} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
# - 3-stage pipe
test process-4.3 {exec 3-stage pipe} -body {
    tcl::process autopurge 0
    set pids [exec \
          [interpreter] $path(exit) 0 \
        | [interpreter] $path(exit) 0 \
        | [interpreter] $path(exit) 0 \
    &]
    lassign $pids pid1 pid2 pid3
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status1 [lindex [tcl::process status $pid1] 1]
    set status2 [lindex [tcl::process status $pid2] 1]
    set status3 [lindex [tcl::process status $pid3] 1]
    expr {
           [llength $pids] eq 3
        && [llength $list] eq 3
        && [lsearch $list $pid1] >= 0
        && [lsearch $list $pid2] >= 0
        && [lsearch $list $pid3] >= 0
        && [dict size $statuses] eq 3
        && [dict get $statuses $pid1] eq $status1
        && [dict get $statuses $pid2] eq $status2
        && [dict get $statuses $pid3] eq $status3
        && $status1 eq 0
        && $status2 eq 0
        && $status3 eq 0
    }
} -result {1} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}

# Spawn subprocesses using [open "|"]
# - One child
test process-5.1 {exec one child} -body {
    tcl::process autopurge 0
    set f [open "|\"[interpreter]\" \"$path(exit)\" 0"]
    set pid [pid $f]
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status [lindex [tcl::process status $pid] 1]
    expr {
           [llength $list] eq 1
        && [lindex $list 0] eq $pid
        && [dict size $statuses] eq 1
        && [dict get $statuses $pid] eq $status
        && $status eq 0
    }
} -result {1} -cleanup {
    close $f
    tcl::process purge
    tcl::process autopurge 1
}
# - Two children
test process-5.2 {exec two children in parallel} -body {
    tcl::process autopurge 0
    set f1 [open "|\"[interpreter]\" \"$path(exit)\" 0"]
    set f2 [open "|\"[interpreter]\" \"$path(exit)\" 0"]
    set pid1 [pid $f1]
    set pid2 [pid $f2]
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status1 [lindex [tcl::process status $pid1] 1]
    set status2 [lindex [tcl::process status $pid2] 1]
    expr {
           [llength $list] eq 2
        && [lsearch $list $pid1] >= 0
        && [lsearch $list $pid2] >= 0
        && [dict size $statuses] eq 2
        && [dict get $statuses $pid1] eq $status1
        && [dict get $statuses $pid2] eq $status2
        && $status1 eq 0
        && $status2 eq 0
    }
} -result {1} -cleanup {
    close $f1
    close $f2
    tcl::process purge
    tcl::process autopurge 1
}
# - 3-stage pipe
test process-5.3 {exec 3-stage pipe} -body {
    tcl::process autopurge 0
    set f [open "|
          \"[interpreter]\" \"$path(exit)\" 0
        | \"[interpreter]\" \"$path(exit)\" 0
        | \"[interpreter]\" \"$path(exit)\" 0
    "]
    set pids [pid $f]
    lassign $pids pid1 pid2 pid3
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status1 [lindex [tcl::process status $pid1] 1]
    set status2 [lindex [tcl::process status $pid2] 1]
    set status3 [lindex [tcl::process status $pid3] 1]
    expr {
           [llength $pids] eq 3
        && [llength $list] eq 3
        && [lsearch $list $pid1] >= 0
        && [lsearch $list $pid2] >= 0
        && [lsearch $list $pid3] >= 0
        && [dict size $statuses] eq 3
        && [dict get $statuses $pid1] eq $status1
        && [dict get $statuses $pid2] eq $status2
        && [dict get $statuses $pid3] eq $status3
        && $status1 eq 0
        && $status2 eq 0
        && $status3 eq 0
    }
} -result {1} -cleanup {
    close $f
    tcl::process purge
    tcl::process autopurge 1
}

# Async child status
test process-6.1 {async status} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(sleep) 1 &]
    set status1 [lindex [tcl::process status $pid] 1]
    set status2 [lindex [tcl::process status -wait $pid] 1]
    expr {
           $status1 eq {}
        && $status2 eq 0
    }
} -result {1} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
test process-6.2 {selective wait} -body {
    tcl::process autopurge 0
    # Child 1 sleeps 1s
    set pid1 [exec [interpreter] $path(sleep) 1 &]
    # Child 2 sleeps 1s
    set pid2 [exec [interpreter] $path(sleep) 2 &]
    # Initial status
    set status1_1 [lindex [tcl::process status $pid1] 1]
    set status1_2 [lindex [tcl::process status $pid2] 1]
    # Wait until child 1 termination
    set status2_1 [lindex [tcl::process status -wait $pid1] 1]
    set status2_2 [lindex [tcl::process status $pid2] 1]
    # Wait until child 2 termination
    set status3_2 [lindex [tcl::process status -wait $pid2] 1]
    set status3_1 [lindex [tcl::process status $pid1] 1]
    expr {
           $status1_1 eq {}
        && $status1_2 eq {}
        && $status2_1 eq 0
        && $status2_2 eq {}
        && $status3_1 eq 0
        && $status3_2 eq 0
    }
} -result {1} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}

# Error codes
test process-7.1 {normal exit} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) 0 &]
    lindex [tcl::process status -wait $pid] 1
} -result {0} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
test process-7.2 {abnormal exit} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) 1 &]
    lindex [tcl::process status -wait $pid] 1
} -match glob -result {1 {child process exited abnormally} {CHILDSTATUS * 1}} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
test process-7.3 {child killed} -constraints {win} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) -1 &]
    lindex [tcl::process status -wait $pid] 1
} -match glob -result {1 {child killed: unknown signal} {CHILDKILLED * {unknown signal} {unknown signal}}} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}

::tcltest::cleanupTests
return

Changes to tests/registry.test.

15
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43







-
+













-
+







    namespace import -force ::tcltest::*
}

testConstraint reg 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.2]
	    set ::regver [package require registry 1.3.3]
	}]} {
	testConstraint reg 1
    }
}

# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]

test registry-1.0 {check if we are testing the right dll} {win reg} {
    set ::regver
} {1.3.2}
} {1.3.3}
test registry-1.1 {argument parsing for registry command} {win reg} {
    list [catch {registry} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.1a {argument parsing for registry command} {win reg} {
    list [catch {registry -32bit} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.1b {argument parsing for registry command} {win reg} {

Changes to tests/result.test.

27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42
43
44
45
46

47
48
49
50
51
52
53
27
28
29
30
31
32
33

34
35
36
37
38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
53







-
+











-
+







    testsaveresult small {set x 42} 0
} {small result}
test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult append {set x 42} 0
} {append result}
test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult dynamic {set x 42} 0
} {dynamic result freed}
} {dynamic result presentOrFreed}
test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult object {set x 42} 0
} {object result same}
test result-1.5 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult small {set x 42} 1
} {42}
test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult append {set x 42} 1
} {42}
test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult dynamic {set x 42} 1
} {42 freed}
} {42 presentOrFreed}
test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult object {set x 42} 1
} {42 different}

# Tcl_RestoreInterpResult is mostly tested by the previous tests except
# for the following case

Changes to tests/safe.test.

70
71
72
73
74
75
76
77

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

96
97
98
99
100
101
102
70
71
72
73
74
75
76

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102







-
+

















-
+







test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -setup {
    catch {safe::interpDelete a}
} -body {
    interp create a -safe
    lsort [a aliases]
} -cleanup {
    interp delete a
} -result {::tcl::mathfunc::max ::tcl::mathfunc::min clock}
} -result {clock}

test safe-3.1 {calling safe::interpInit is safe} -setup {
    catch {safe::interpDelete a}
    interp create a -safe
} -body {
    safe::interpInit a
    interp eval a exec ls
} -returnCodes error -cleanup {
    safe::interpDelete a
} -result {invalid command name "exec"}
test safe-3.2 {calling safe::interpCreate on trusted interp} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    lsort [a aliases]
} -cleanup {
    safe::interpDelete a
} -result {::tcl::file::atime ::tcl::file::attributes ::tcl::file::copy ::tcl::file::delete ::tcl::file::dirname ::tcl::file::executable ::tcl::file::exists ::tcl::file::extension ::tcl::file::isdirectory ::tcl::file::isfile ::tcl::file::link ::tcl::file::lstat ::tcl::file::mkdir ::tcl::file::mtime ::tcl::file::nativename ::tcl::file::normalize ::tcl::file::owned ::tcl::file::readable ::tcl::file::readlink ::tcl::file::rename ::tcl::file::rootname ::tcl::file::size ::tcl::file::stat ::tcl::file::tail ::tcl::file::tempfile ::tcl::file::type ::tcl::file::volumes ::tcl::file::writable ::tcl::info::nameofexecutable clock encoding exit glob load source}
} -result {::tcl::encoding::system ::tcl::file::dirname ::tcl::file::extension ::tcl::file::rootname ::tcl::file::tail ::tcl::info::nameofexecutable clock encoding exit file glob load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    interp eval a {source [file join $tcl_library init.tcl]}
} -cleanup {
    safe::interpDelete a
176
177
178
179
180
181
182
183

184
185
186
187
188

189
190

191
192
193

194
195
196
197
198
199
200
176
177
178
179
180
181
182

183
184
185
186
187

188
189

190
191
192

193
194
195
196
197
198
199
200







-
+




-
+

-
+


-
+







    lsort $r
} {byteOrder engine pathSeparator platform pointerSize wordSize}

# More test should be added to check that hostname, nameofexecutable, aren't
# leaking infos, but they still do...

# high level general test
test safe-7.1 {tests that everything works at high level} {
test safe-7.1 {tests that everything works at high level} -body {
    set i [safe::interpCreate]
    # no error shall occur:
    # (because the default access_path shall include 1st level sub dirs so
    #  package require in a slave works like in the master)
    set v [interp eval $i {package require http 1}]
    set v [interp eval $i {package require http 2}]
    # no error shall occur:
    interp eval $i {http_config}
    interp eval $i {http::config}
    safe::interpDelete $i
    set v
} 1.0
} -match glob -result 2.*
test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
    # should not add anything (p0)
    set token1 [safe::interpAddToAccessPath $i [info library]]
    # should add as p1
    set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
    # an error shall occur (http is not anymore in the secure 0-level
304
305
306
307
308
309
310
311
312
313
314




315
316
317
318
319
320
321
322
323
324
325
304
305
306
307
308
309
310




311
312
313
314




315
316
317
318
319
320
321







-
-
-
-
+
+
+
+
-
-
-
-







	$i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}
    } msg] $msg $log
} -cleanup {
    safe::setLogCmd $prevlog
    unset log
    safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
test safe-8.8 {safe source forbids -rsrc} -setup {
    catch {safe::interpDelete $i}
    safe::interpCreate $i
} -body {
test safe-8.8 {safe source forbids -rsrc} emptyTest {
    # Disabled this test.  It was only useful for long unsupported
    # Mac OS 9 systems. [Bug 860a9f1945]
} {}
    $i eval {source -rsrc Init}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.9 {safe source and return} -setup {
    set returnScript [makeFile {return "ok"} return.tcl]
    catch {safe::interpDelete $i}
} -body {
    safe::interpCreate $i
    set token [safe::interpAddToAccessPath $i [file dirname $returnScript]]
    $i eval [list source $token/[file tail $returnScript]]
464
465
466
467
468
469
470
471

472
473
474
475
476
477
478

479
480
481
482
483
484
485
460
461
462
463
464
465
466

467
468
469
470
471
472
473

474
475
476
477
478
479
480
481







-
+






-
+








test safe-11.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding option ?arg ...?"}
} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test safe-11.1a {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding foobar
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -match glob -result {bad option "foobar": must be *}
} -match glob -result {unknown or ambiguous subcommand "foobar": must be *}
test safe-11.2 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding system cp775
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding system"}
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
522
523
524
525
526
527
528


529
530
531
532
533
534
535







-
-







} -returnCodes ok -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"
    while executing
"encoding convertfrom"
    invoked from within
"::interp invokehidden interp* encoding convertfrom"
    invoked from within
"encoding convertfrom"
    invoked from within
"interp eval $i encoding convertfrom"}
test safe-11.8 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertto
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
544
545
546
547
548
549
550


551
552
553
554
555
556
557







-
-







} -returnCodes ok -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?encoding? data"
    while executing
"encoding convertto"
    invoked from within
"::interp invokehidden interp* encoding convertto"
    invoked from within
"encoding convertto"
    invoked from within
"interp eval $i encoding convertto"}

test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
    set i [safe::interpCreate]
} -body {
765
766
767
768
769
770
771
772

773
774
775
776
777
778
779
757
758
759
760
761
762
763

764
765
766
767
768
769
770
771







-
+







    interp expose $i file
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
    lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg
} -cleanup {
    unset -nocomplain msg
    interp delete $i
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}
test safe-15.1.1 {safe file ensemble does not surprise code} -setup {
test safe-15.2 {safe file ensemble does not surprise code} -setup {
    set i [interp create -safe]
} -body {
    set result [expr {"file" in [interp hidden $i]}]
    lappend result [interp eval $i {tcl::file::split a/b/c}]
    lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
    lappend result [interp invokehidden $i file split a/b/c]
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg

Changes to tests/scan.test.

15
16
17
18
19
20
21
22
23

24
25

26
27
28
29
30
31
32
33
15
16
17
18
19
20
21


22


23

24
25
26
27
28
29
30







-
-
+
-
-
+
-







    package require tcltest 2
    namespace import -force ::tcltest::*
}

# procedure that returns the range of integers

proc int_range {} {
    for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} {
	set MIN_INT [expr { $MIN_INT << 1 }]
    set MAX_INT [expr {[format %u -2]/2}]
    }
    set MIN_INT [expr {int($MIN_INT)}]
    set MIN_INT [expr { ~ $MAX_INT }]
    set MAX_INT [expr { ~ $MIN_INT }]
    return [list $MIN_INT $MAX_INT]
}

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
81
82
83
84
85
86
87
88

89
90
91
92
93
94
95
96
78
79
80
81
82
83
84

85

86
87
88
89
90
91
92







-
+
-







	default {
	    return 0
	}
    }
}

testConstraint ieeeFloatingPoint [testIEEE]
testConstraint wideIs64bit \
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]

test scan-1.1 {BuildCharSet, CharInSet} {
    list [scan foo {%[^o]} x] $x
} {1 f}
test scan-1.2 {BuildCharSet, CharInSet} {
    list [scan \]foo {%[]f]} x] $x
} {1 \]f}
549
550
551
552
553
554
555
556

557
558
559
560
561


562
563
564
565
566
567
568
545
546
547
548
549
550
551

552
553
554
555


556
557
558
559
560
561
562
563
564







-
+



-
-
+
+







} -result {3 207698809136909011942886895 207698809136909011942886895 207698809136909011942886895}
test scan-5.18 {bigint scanning underflow} -setup {
    set a {};
} -body {
    list [scan "-207698809136909011942886895" \
	    %llu a] $a
} -returnCodes 1 -result {unsigned bignum scans are invalid}
test scan-5.18 {bigint scanning invalid} -setup {
test scan-5.19 {bigint scanning invalid} -setup {
    set a {};
} -body {
    list [scan "207698809136909011942886895" \
	    %llu a] $a
} -returnCodes 1 -result {unsigned bignum scans are invalid}
           %llu a] $a
} -result {1 207698809136909011942886895}

test scan-6.1 {floating-point scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
} -result {3 2.1 -300000000.0 0.99962 {}}
test scan-6.2 {floating-point scanning} -setup {

Changes to tests/set-old.test.

336
337
338
339
340
341
342
343

344
345
346
347
348
349
350
336
337
338
339
340
341
342

343
344
345
346
347
348
349
350







-
+







    }
    foo
} {1 {"x" isn't an array}}
test set-old-8.6 {array command} {
    catch {unset a}
    set a(22) 3
    list [catch {array gorp a} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
} {1 {unknown or ambiguous subcommand "gorp": must be anymore, default, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
test set-old-8.7 {array command, anymore option} {
    catch {unset a}
    list [catch {array anymore a x} msg] $msg
} {1 {"a" isn't an array}}
test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {
696
697
698
699
700
701
702
703

704
705
706
707
708
709
710
696
697
698
699
700
701
702

703
704
705
706
707
708
709
710







-
+







    }}} msg] $msg
} {1 {list must have an even number of elements}}

test set-old-9.1 {ids for array enumeration} {
    catch {unset a}
    set a(a) 1
    list [array star a] [array star a] [array done a s-1-a; array star a] \
	    [array done a s-2-a; array d a s-3-a; array start a]
	    [array done a s-2-a; array do a s-3-a; array start a]
} {s-1-a s-2-a s-3-a s-1-a}
test set-old-9.2 {array enumeration} {
    catch {unset a}
    set a(a) 1
    set a(b) 1
    set a(c) 1
    set x [array startsearch a]

Changes to tests/source.test.

8
9
10
11
12
13
14
15
16


17
18
19
20
21
22
23
8
9
10
11
12
13
14


15
16
17
18
19
20
21
22
23







-
-
+
+







# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
# Contributions from Don Porter, NIST, 2003.  (not subject to US copyright)
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[catch {package require tcltest 2.1}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
if {[catch {package require tcltest 2.5}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.5 required."
    return
}

namespace eval ::tcl::test::source {
    namespace import ::tcltest::*

test source-1.1 {source command} -setup {
99
100
101
102
103
104
105
106

107
108
109


110
111
112
113
114
115
116
99
100
101
102
103
104
105

106



107
108
109
110
111
112
113
114
115







-
+
-
-
-
+
+







} -cleanup {
    removeFile source.file
} -returnCodes continue
test source-2.6 {source error conditions} -setup {
    set sourcefile [makeFile {} _non_existent_]
    removeFile _non_existent_
} -body {
    list [catch {source $sourcefile} msg] $msg $::errorCode
    source $sourcefile
} -match listGlob -result [list 1 \
	{couldn't read file "*_non_existent_": no such file or directory} \
	{POSIX ENOENT {no such file or directory}}]
} -match glob -result {couldn't read file "*_non_existent_": no such file or directory} \
	-errorCode {POSIX ENOENT {no such file or directory}}
test source-2.7 {utf-8 with BOM} -setup {
    set sourcefile [makeFile {} source.file]
} -body {
    set out [open $sourcefile w]
    fconfigure $out -encoding utf-8
    puts $out "\ufeffset y new-y"
    close $out

Changes to tests/split.test.

66
67
68
69
70
71
72



73
74
75
76
77
78
79
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82







+
+
+







} {{} ab cd {} ef {}}
test split-1.13 {basic split commands} {
    split "12,34,56," {,}
} {12 34 56 {}}
test split-1.14 {basic split commands} {
    split ",12,,,34,56," {,}
} {{} 12 {} {} 34 56 {}}
test split-1.15 {basic split commands} -body {
    split "a\U01f4a9b" {}
} -result "a \U01f4a9 b"

test split-2.1 {split errors} {
    list [catch split msg] $msg $errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}
test split-2.2 {split errors} {
    list [catch {split a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}

Changes to tests/string.test.

16
17
18
19
20
21
22






23
24
25
26




27
28
29















30
31
32
33
34
35
36
37


















38
39
40


41






42
43
44






45
46
47


48
49
50


51
52
53


54
55
56


57
58
59


60
61
62


63
64
65


66
67
68


69
70
71


72
73
74


75









76

77
78
79
80

81
82
83
84
85
86


87

88
89




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


128
129
130


131
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
161
162


163
164
165


166
167
168


169
170
171


172
173
174


175
176
177


178
179
180


181





















182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199





























































200

201
202
203
204
205
206
207
208
























































209
210
211


212
213
214


215
216
217


218
219
220


221
222
223


224
225

226
227
228
229
230

231
232

233
234
235
236
237


238
239
240
241


242
243
244


245
246
247


248
249
250


251
252
253


254
255
256


257
258
259


260
261
262


263
264
265


266
267
268


269
270
271


272
273
274


275
276
277


278
279
280


281
282

283
284
285
286



287
288

289
290
291

292
293
294
295
296
297
298
299
300








301
302
303


304



305
306
307
308
309
310
311
312
313
314
315
316
317


318
319
320


321
322
323


324
325
326


327
328
329


330
331
332


333
334
335


336
337
338


339
340

341
342

343
344
345


346
347
348


349
350
351


352
353
354


355
356
357
358



359
360
361


362
363
364


365
366
367


368
369
370


371
372
373


374
375
376


377
378
379


380
381
382


383
384
385


386
387
388


389
390
391


392
393
394


395
396
397


398
399
400


401
402
403


404
405
406


407
408
409


410
411
412


413
414
415


416
417
418


419
420
421


422
423

424
425
426
427
428
429
430

431
432
433

434
435
436
437
438
439
440

441
442
443


444
445
446


447
448
449


450
451
452


453
454
455


456
457
458


459
460

461
462

463
464

465
466

467
468
469


470
471
472


473
474
475


476
477
478


479
480
481


482
483
484


485
486
487


488
489
490
491
492
493





494
495
496


497
498
499


500
501
502


503
504
505


506
507
508


509
510
511


512
513
514


515
516
517


518
519
520


521
522
523


524
525
526


527
528
529


530
531
532


533
534
535


536
537
538


539
540
541


542
543
544


545
546

547
548

549
550

551
552

553
554
555


556
557
558


559
560
561


562
563
564


565
566
567


568
569
570


571
572
573


574
575
576


577
578
579


580
581

582
583
584

585
586
587


588
589

590
591

592
593

594
595

596
597

598
599

600
601
602


603
604
605

606
607
608
609
610

611
612
613
614

615
616
617
618

619
620
621
622

623
624
625
626
627




628
629

630
631
632
633



634
635
636
637
638
639





640
641
642


643
644
645


646
647
648


649
650
651


652
653
654


655
656
657


658
659
660


661
662
663


664
665
666


667
668
669


670
671
672


673
674
675


676
677

678
679
680
681
682

683
684
685
686

687
688
689


690
691
692


693
694
695


696
697
698


699
700
701


702
703
704


705
706
707


708
709
710


711
712
713


714
715
716


717
718
719


720
721
722


723
724
725


726
727
728


729
730
731


732
733

734
735
736
737
738

739
740
741
742
743


744
745
746


747
748
749


750
751
752


753
754
755


756
757
758


759
760
761


762
763
764


765
766
767
768
769
770


771
772
773


774
775
776


777
778
779


780
781
782


783
784
785


786
787
788


789
790
791


792
793
794


795
796
797


798
799
800


801
802
803


804
805

806
807

808
809

810
811

812
813
814


815
816
817


818
819
820
821


822
823
824


825
826
827


828
829
830


831
832
833
834


835
836
837


838
839
840


841
842
843


844
845
846


847
848
849


850
851
852


853
854
855
856


857
858
859


860
861
862


863
864
865


866
867
868


869
870
871


872
873
874


875
876
877


878
879
880


881
882
883


884
885
886


887
888
889


890
891
892


893
894
895


896
897
898


899
900
901


902
903
904


905
906
907


908
909
910


911
912

913
914

915
916

917
918

919
920
921


922
923
924


925
926
927


928
929
930


931
932
933


934
935
936


937
938
939


940
941
942


943
944
945


946
947
948


949
950

951
952

953
954
955
956


957
958
959


960
961
962


963
964
965


966
967
968


969
970
971


972
973
974


975
976
977


978
979
980


981
982
983


984
985
986


987
988
989


990
991
992


993
994
995


996
997
998


999
1000
1001


1002
1003
1004


1005
1006
1007


1008
1009
1010


1011
1012
1013


1014
1015
1016


1017
1018
1019


1020
1021
1022


1023
1024
1025


1026
1027
1028


1029
1030
1031


1032
1033
1034


1035
1036
1037


1038
1039
1040


1041
1042
1043


1044
1045
1046


1047
1048
1049


1050
1051
1052


1053
1054
1055


1056
1057
1058


1059
1060
1061


1062
1063
1064


1065
1066
1067


1068
1069
1070


1071
1072
1073


1074
1075
1076


1077
1078
1079


1080
1081
1082


1083
1084
1085


1086
1087
1088


1089
1090
1091


1092
1093
1094


1095
1096
1097


1098
1099
1100


1101
1102

1103
1104

1105
1106

1107
1108
1109

1110
1111
1112


1113
1114
1115


1116
1117
1118


1119
1120
1121


1122
1123
1124


1125
1126
1127


1128
1129
1130


1131
1132
1133


1134
1135
1136


1137
1138
1139


1140
1141
1142


1143
1144
1145


1146
1147
1148


1149
1150
1151


1152
1153
1154


1155
1156
1157


1158
1159
1160


1161
1162
1163


1164
1165
1166


1167
1168
1169
1170



1171
1172

1173
1174
1175
1176

1177
1178
1179
1180

1181
1182
1183
1184
1185
1186
1187
1188
1189

1190
1191
1192
1193

1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204







1205



1206


1207
1208





1209
1210
1211


1212
1213
1214


1215
1216
1217


1218
1219
1220


1221
1222
1223


1224
1225
1226


1227
1228
1229


1230
1231
1232


1233
1234
1235


1236
1237
1238


1239
1240
1241


1242
1243
1244


1245
1246
1247


1248
1249
1250


1251
1252
1253


1254
1255
1256


1257
1258
1259


1260
1261

1262
1263
1264
1265



1266
1267
1268


1269
1270
1271

1272
1273
1274
1275
1276
1277

1278
1279
1280

1281
1282
1283
1284
1285
1286

1287
1288
1289

1290



1291
1292
1293


1294
1295
1296


1297
1298
1299


1300
1301
1302


1303
1304
1305


1306
1307
1308


1309
1310
1311


1312
1313
1314


1315
1316
1317


1318
1319
1320


1321
1322
1323


1324
1325
1326


1327
1328
1329


1330
1331

1332
1333

1334
1335
1336
1337


1338
1339
1340


1341
1342
1343


1344
1345

1346
1347
1348


1349
1350
1351


1352
1353
1354


1355
1356
1357


1358
1359
1360


1361
1362
1363


1364
1365
1366


1367
1368
1369


1370
1371
1372


1373
1374
1375


1376
1377
1378


1379
1380
1381


1382
1383
1384


1385
1386
1387


1388







1389
1390
1391
1392
1393
1394











1395
1396
1397
1398
1399
1400








































1401
1402
1403


1404
1405
1406


1407
1408
1409


1410
1411
1412


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


1444
1445
1446


1447
1448
1449


1450
1451
1452


1453
1454
1455


1456
1457
1458
1459


1460
1461
1462


1463
1464
1465


1466
1467
1468


1469
1470
1471


1472
1473
1474


1475
1476
1477


1478
1479
1480


1481




1482
1483
1484


1485
1486
1487


1488
1489
1490


1491
1492
1493


1494
1495
1496


1497
1498
1499


1500
1501
1502


1503
1504
1505


1506
1507
1508


1509
1510
1511


1512
1513
1514


1515
1516
1517


1518
1519
1520
1521


1522
1523
1524


1525
1526
1527


1528
1529
1530
1531


1532
1533
1534


1535
1536
1537


1538
1539
1540


1541
1542
1543


1544
1545
1546


1547
1548
1549
1550


1551
1552
1553


1554
1555
1556


1557
1558
1559


1560
1561
1562


1563
1564
1565


1566
1567
1568
1569
1570
1571





1572
1573
1574


1575
1576
1577


1578
1579
1580


1581
1582
1583


1584
1585
1586


1587
1588
1589


1590
1591
1592
1593


1594
1595
1596
1597
1598
1599





1600
1601
1602


1603
1604
1605


1606
1607
1608


1609
1610
1611


1612
1613
1614


1615
1616
1617


1618
1619
1620


1621
1622
1623


1624
1625
1626


1627
1628
1629


1630
1631
1632

1633
1634
1635

1636
1637

1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657


















1658
1659
1660

1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680


















1681
1682
1683
1684
1685


1686
1687
1688


1689
1690

1691
1692

1693
1694

1695
1696
1697

1698
1699

1700
1701

1702
1703

1704
1705
1706

1707
1708
1709


1710
1711
1712


1713
1714
1715


1716
1717

1718
1719

1720
1721

1722
1723
1724

1725
1726

1727
1728
1729

1730
1731
1732


1733
1734
1735


1736
1737
1738
1739


1740
1741
1742
1743
1744


1745
1746
1747


1748
1749
1750


1751
1752
1753


1754
1755
1756


1757
1758
1759


1760
1761
1762


1763
1764
1765


1766
1767

1768
1769

1770
1771

1772
1773

1774
1775

1776
1777

1778
1779

1780
1781

1782
1783

1784
1785

1786
1787

1788
1789

1790
1791
1792

1793
1794
1795

1796
1797
1798

1799
1800
1801

1802
1803
1804

1805
1806
1807

1808
1809
1810

1811
1812
1813

1814
1815
1816

1817
1818
1819

1820
1821
1822

1823
1824
1825

1826
1827
1828

1829
1830
1831

1832
1833
1834
1835
1836
1837
1838
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30


31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57



58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76


77
78
79
80
81
82
83
84
85



86
87
88
89
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
128
129
130
131

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
161


162
163
164


165
166
167


168
169
170

171
172
173

174
175


176
177
178


179
180
181


182
183
184


185
186
187


188
189
190


191
192
193


194
195
196


197
198
199


200
201
202

203
204
205

206
207


208
209

210


211
212

213


214
215

216
217
218
219
220
221
222
223
224
225
226
227
228


229
230
231


232
233
234


235
236
237


238
239
240


241
242
243


244
245
246


247
248
249


250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274

















275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337








338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394


395
396
397


398
399
400


401
402
403


404
405
406


407
408
409

410
411
412
413
414

415
416

417
418
419
420


421
422
423
424


425
426
427


428
429
430


431
432
433


434
435
436


437
438
439


440
441
442


443
444
445


446
447
448


449
450
451


452
453
454


455
456
457


458
459
460


461
462
463


464
465
466

467
468



469
470
471
472

473
474
475

476
477








478
479
480
481
482
483
484
485
486


487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503


504
505
506


507
508
509


510
511
512


513
514
515


516
517
518


519
520
521


522
523
524


525
526
527

528
529

530
531


532
533
534


535
536
537


538
539
540


541
542
543



544
545
546
547


548
549
550


551
552
553


554
555
556


557
558
559


560
561
562


563
564
565


566
567
568


569
570
571


572
573
574


575
576
577


578
579
580


581
582
583


584
585
586


587
588
589


590
591
592


593
594
595


596
597
598


599
600
601


602
603
604


605
606
607


608
609
610

611
612
613
614
615
616
617

618
619
620

621
622
623
624
625
626
627

628
629


630
631
632


633
634
635


636
637
638


639
640
641


642
643
644


645
646
647

648
649

650
651

652
653

654
655


656
657
658


659
660
661


662
663
664


665
666
667


668
669
670


671
672
673


674
675
676





677
678
679
680
681
682


683
684
685


686
687
688


689
690
691


692
693
694


695
696
697


698
699
700


701
702
703


704
705
706


707
708
709


710
711
712


713
714
715


716
717
718


719
720
721


722
723
724


725
726
727


728
729
730


731
732
733

734
735

736
737

738
739

740
741


742
743
744


745
746
747


748
749
750


751
752
753


754
755
756


757
758
759


760
761
762


763
764
765


766
767
768

769
770
771

772
773


774
775
776

777
778

779
780

781
782

783
784

785
786

787
788


789
790
791
792

793
794
795
796
797

798
799
800
801

802
803
804
805

806
807
808
809

810
811




812
813
814
815
816

817
818



819
820
821
822





823
824
825
826
827
828


829
830
831


832
833
834


835
836
837


838
839
840


841
842
843


844
845
846


847
848
849


850
851
852


853
854
855


856
857
858


859
860
861


862
863
864

865
866
867
868
869

870
871
872
873

874
875


876
877
878


879
880
881


882
883
884


885
886
887


888
889
890


891
892
893


894
895
896


897
898
899


900
901
902


903
904
905


906
907
908


909
910
911


912
913
914


915
916
917


918
919
920

921
922
923
924
925

926
927
928
929


930
931
932


933
934
935


936
937
938


939
940
941


942
943
944


945
946
947


948
949
950


951
952
953
954
955
956


957
958
959


960
961
962


963
964
965


966
967
968


969
970
971


972
973
974


975
976
977


978
979
980


981
982
983


984
985
986


987
988
989


990
991
992

993
994

995
996

997
998

999
1000


1001
1002
1003


1004
1005
1006
1007


1008
1009
1010


1011
1012
1013


1014
1015
1016


1017
1018
1019
1020


1021
1022
1023


1024
1025
1026


1027
1028
1029


1030
1031
1032


1033
1034
1035


1036
1037
1038


1039
1040
1041
1042


1043
1044
1045


1046
1047
1048


1049
1050
1051


1052
1053
1054


1055
1056
1057


1058
1059
1060


1061
1062
1063


1064
1065
1066


1067
1068
1069


1070
1071
1072


1073
1074
1075


1076
1077
1078


1079
1080
1081


1082
1083
1084


1085
1086
1087


1088
1089
1090


1091
1092
1093


1094
1095
1096


1097
1098
1099

1100
1101

1102
1103

1104
1105

1106
1107


1108
1109
1110


1111
1112
1113


1114
1115
1116


1117
1118
1119


1120
1121
1122


1123
1124
1125


1126
1127
1128


1129
1130
1131


1132
1133
1134


1135
1136
1137

1138
1139

1140
1141
1142


1143
1144
1145


1146
1147
1148


1149
1150
1151


1152
1153
1154


1155
1156
1157


1158
1159
1160


1161
1162
1163


1164
1165
1166


1167
1168
1169


1170
1171
1172


1173
1174
1175


1176
1177
1178


1179
1180
1181


1182
1183
1184


1185
1186
1187


1188
1189
1190


1191
1192
1193


1194
1195
1196


1197
1198
1199


1200
1201
1202


1203
1204
1205


1206
1207
1208


1209
1210
1211


1212
1213
1214


1215
1216
1217


1218
1219
1220


1221
1222
1223


1224
1225
1226


1227
1228
1229


1230
1231
1232


1233
1234
1235


1236
1237
1238


1239
1240
1241


1242
1243
1244


1245
1246
1247


1248
1249
1250


1251
1252
1253


1254
1255
1256


1257
1258
1259


1260
1261
1262


1263
1264
1265


1266
1267
1268


1269
1270
1271


1272
1273
1274


1275
1276
1277


1278
1279
1280


1281
1282
1283


1284
1285
1286


1287
1288
1289

1290
1291

1292
1293

1294
1295
1296

1297
1298


1299
1300
1301


1302
1303
1304


1305
1306
1307


1308
1309
1310


1311
1312
1313


1314
1315
1316


1317
1318
1319


1320
1321
1322


1323
1324
1325


1326
1327
1328


1329
1330
1331


1332
1333
1334


1335
1336
1337


1338
1339
1340


1341
1342
1343


1344
1345
1346


1347
1348
1349


1350
1351
1352


1353
1354
1355



1356
1357
1358
1359

1360
1361
1362
1363

1364
1365
1366
1367

1368
1369
1370
1371
1372
1373
1374
1375
1376

1377
1378
1379
1380

1381
1382
1383
1384
1385







1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399


1400
1401
1402
1403
1404
1405


1406
1407
1408


1409
1410
1411


1412
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
1444


1445
1446
1447


1448
1449
1450


1451
1452
1453


1454
1455
1456

1457
1458



1459
1460
1461
1462


1463
1464
1465
1466

1467
1468
1469
1470
1471
1472

1473
1474
1475

1476
1477
1478
1479
1480
1481

1482
1483
1484

1485
1486
1487
1488
1489
1490


1491
1492
1493


1494
1495
1496


1497
1498
1499


1500
1501
1502


1503
1504
1505


1506
1507
1508


1509
1510
1511


1512
1513
1514


1515
1516
1517


1518
1519
1520


1521
1522
1523


1524
1525
1526


1527
1528
1529

1530
1531

1532
1533
1534


1535
1536
1537


1538
1539
1540


1541
1542
1543

1544
1545


1546
1547
1548


1549
1550
1551


1552
1553
1554


1555
1556
1557


1558
1559
1560


1561
1562
1563


1564
1565
1566


1567
1568
1569


1570
1571
1572


1573
1574
1575


1576
1577
1578


1579
1580
1581


1582
1583
1584


1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595





1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606






1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647


1648
1649
1650


1651
1652
1653


1654
1655
1656


1657
1658
1659


1660
1661
1662


1663
1664
1665


1666
1667
1668
1669


1670
1671
1672


1673
1674
1675


1676
1677
1678


1679
1680
1681


1682
1683
1684


1685
1686
1687


1688
1689
1690


1691
1692
1693


1694
1695
1696


1697
1698
1699


1700
1701
1702
1703


1704
1705
1706


1707
1708
1709


1710
1711
1712


1713
1714
1715


1716
1717
1718


1719
1720
1721


1722
1723
1724


1725
1726
1727
1728
1729
1730
1731
1732


1733
1734
1735


1736
1737
1738


1739
1740
1741


1742
1743
1744


1745
1746
1747


1748
1749
1750


1751
1752
1753


1754
1755
1756


1757
1758
1759


1760
1761
1762


1763
1764
1765


1766
1767
1768
1769


1770
1771
1772


1773
1774
1775


1776
1777
1778
1779


1780
1781
1782


1783
1784
1785


1786
1787
1788


1789
1790
1791


1792
1793
1794


1795
1796
1797
1798


1799
1800
1801


1802
1803
1804


1805
1806
1807


1808
1809
1810


1811
1812
1813


1814
1815
1816





1817
1818
1819
1820
1821
1822


1823
1824
1825


1826
1827
1828


1829
1830
1831


1832
1833
1834


1835
1836
1837


1838
1839
1840
1841


1842
1843
1844





1845
1846
1847
1848
1849
1850


1851
1852
1853


1854
1855
1856


1857
1858
1859


1860
1861
1862


1863
1864
1865


1866
1867
1868


1869
1870
1871


1872
1873
1874


1875
1876
1877


1878
1879
1880
1881

1882
1883
1884

1885
1886

1887
1888
1889


















1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909

1910
1911
1912


















1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933


1934
1935
1936


1937
1938
1939

1940
1941

1942
1943

1944
1945
1946

1947
1948

1949
1950

1951
1952

1953
1954
1955

1956
1957


1958
1959
1960


1961
1962
1963


1964
1965
1966

1967
1968

1969
1970

1971
1972
1973

1974
1975

1976
1977
1978

1979
1980


1981
1982
1983


1984
1985
1986
1987


1988
1989
1990
1991
1992


1993
1994
1995


1996
1997
1998


1999
2000
2001


2002
2003
2004


2005
2006
2007


2008
2009
2010


2011
2012
2013


2014
2015
2016

2017
2018

2019
2020

2021
2022

2023
2024

2025
2026

2027
2028

2029
2030

2031
2032

2033
2034

2035
2036

2037
2038

2039
2040
2041

2042
2043
2044

2045
2046
2047

2048
2049
2050

2051
2052
2053

2054
2055
2056

2057
2058
2059

2060
2061
2062

2063
2064
2065

2066
2067
2068

2069
2070
2071

2072
2073
2074

2075
2076
2077

2078
2079
2080

2081
2082
2083
2084
2085
2086
2087
2088







+
+
+
+
+
+


-
-
+
+
+
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

+
+
+
+
+
+
-
-
-
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

+
+
+
+
+
+
+
+
+
-
+



-
+




-
-
+
+

+
-
-
+
+
+
+

-
-
+
+

+
+
+
+
+
+
-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+


-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+


-
+

-
-
+
+
-

-
-
+
+
-

-
-
+
+
-

+
+
+
+
+
+
+
+
+



-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+




-
+

-
+



-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
-
-
+
+
+

-
+


-
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+

+
+
+











-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+






-
+


-
+






-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+


-
+

-
-
+
+

-
+

-
+

-
+

-
+

-
+

-
+

-
-
+
+


-
+




-
+



-
+



-
+



-
+

-
-
-
-
+
+
+
+

-
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+




-
+



-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+




-
+



-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+




-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+

-
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+


-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
+
+
+

-
+



-
+



-
+








-
+



-
+




-
-
-
-
-
-
-
+
+
+
+
+
+
+

+
+
+

+
+
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
-
-
+
+
+

-
-
+
+


-
+





-
+


-
+





-
+


-
+

+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+


-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+


-
+


-
+

-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
+
+

-
-
+
+

-
+

-
+

-
+


-
+

-
+

-
+

-
+


-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+


-
+

-
+


-
+

-
-
+
+

-
-
+
+


-
-
+
+



-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+







    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}
proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
proc makeList {args} {return $args}
proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
testConstraint testobj [expr {[info commands testobj] ne {}}]
testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
testConstraint testevalex [expr {[info commands testevalex] ne {}}]
testConstraint tip389 [expr {[string length \U010000] == 2}]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
        set lines [split [memory info] \n]
        return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
        set end [getbytes]
        for {set i 0} {$i < $iterations} {incr i} {
            uplevel 1 $script
            set tmp $end
            set end [getbytes]
        }
        return [expr {$end - $tmp}]
    }
}

proc representationpoke s {
    set r [::tcl::unsupported::representation $s]
    list [lindex $r 3] [string match {*, string representation "*"} $r]
}

test string-1.1 {error conditions} {
    list [catch {string gorp a b} msg] $msg

foreach noComp {0 1} {

if {$noComp} {
    if {[info commands testevalex] eq {}} {
	test string-0.1.$noComp "show testevalex availability" {testevalex} {list} {}
	continue
    }
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} try
    set constraints {}
}


test string-1.1.$noComp {error conditions} {
    list [catch {run {string gorp a b}} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-1.2 {error conditions} {
    list [catch {string} msg] $msg
test string-1.2.$noComp {error conditions} {
    list [catch {run {string}} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
test stringComp-1.3.$noComp {error condition - undefined method during compile} {
    # We don't want this to complain about 'never' because it may never
    # be called, or string may get redefined.  This must compile OK.
    proc foo {str i} {
        if {"yes" == "no"} { string never called but complains here }
        string index $str $i

test string-2.1 {string compare, too few args} {
    list [catch {string compare a} msg] $msg
    }
    foo abc 0
} a

test string-2.1.$noComp {string compare, too few args} {
    list [catch {run {string compare a}} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test string-2.2 {string compare, bad args} {
    list [catch {string compare a b c} msg] $msg
test string-2.2.$noComp {string compare, bad args} {
    list [catch {run {string compare a b c}} msg] $msg
} {1 {bad option "a": must be -nocase or -length}}
test string-2.3 {string compare, bad args} {
    list [catch {string compare -length -nocase str1 str2} msg] $msg
test string-2.3.$noComp {string compare, bad args} {
    list [catch {run {string compare -length -nocase str1 str2}} msg] $msg
} {1 {expected integer but got "-nocase"}}
test string-2.4 {string compare, too many args} {
    list [catch {string compare -length 10 -nocase str1 str2 str3} msg] $msg
test string-2.4.$noComp {string compare, too many args} {
    list [catch {run {string compare -length 10 -nocase str1 str2 str3}} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test string-2.5 {string compare with length unspecified} {
    list [catch {string compare -length 10 10} msg] $msg
test string-2.5.$noComp {string compare with length unspecified} {
    list [catch {run {string compare -length 10 10}} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test string-2.6 {string compare} {
    string compare abcde abdef
test string-2.6.$noComp {string compare} {
    run {string compare abcde abdef}
} -1
test string-2.7 {string compare, shortest method name} {
    string co abcde ABCDE
test string-2.7.$noComp {string compare, shortest method name} {
    run {string co abcde ABCDE}
} 1
test string-2.8 {string compare} {
    string compare abcde abcde
test string-2.8.$noComp {string compare} {
    run {string compare abcde abcde}
} 0
test string-2.9 {string compare with length} {
    string compare -length 2 abcde abxyz
test string-2.9.$noComp {string compare with length} {
    run {string compare -length 2 abcde abxyz}
} 0
test string-2.10 {string compare with special index} {
    list [catch {string compare -length end-3 abcde abxyz} msg] $msg
test string-2.10.$noComp {string compare with special index} {
    list [catch {run {string compare -length end-3 abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-2.11 {string compare, unicode} {
    string compare ab\u7266 ab\u7267
test string-2.11.$noComp {string compare, unicode} {
    run {string compare ab\u7266 ab\u7267}
} -1
test string-2.11.1.$noComp {string compare, unicode} {
    run {string compare \334 \u00dc}
} 0
test string-2.11.2.$noComp {string compare, unicode} {
    run {string compare \334 \u00fc}
} -1
test string-2.11.3.$noComp {string compare, unicode} {
    run {string compare \334\334\334\374\374 \334\334\334\334\334}
} 1
test string-2.12 {string compare, high bit} {
test string-2.12.$noComp {string compare, high bit} {
    # This test will fail if the underlying comparaison
    # is using signed chars instead of unsigned chars.
    # (like SunOS's default memcmp thus the compat/memcmp.c)
    string compare "\x80" "@"
    run {string compare "\x80" "@"}
    # Nb this tests works also in utf8 space because \x80 is
    # translated into a 2 or more bytelength but whose first byte has
    # the high bit set.
} 1
test string-2.13 {string compare -nocase} {
    string compare -nocase abcde abdef
test string-2.13.$noComp {string compare -nocase} {
    run {string compare -nocase abcde abdef}
} -1
test string-2.13.1.$noComp {string compare -nocase} {
test string-2.14 {string compare -nocase} {
    string compare -nocase abcde ABCDE
    run {string compare -nocase abcde Abdef}
} -1
test string-2.14.$noComp {string compare -nocase} {
    run {string compare -nocase abcde ABCDE}
} 0
test string-2.15 {string compare -nocase} {
    string compare -nocase abcde abcde
test string-2.15.$noComp {string compare -nocase} {
    run {string compare -nocase abcde abcde}
} 0
test string-2.15.1.$noComp {string compare -nocase} {
    run {string compare -nocase \334 \u00dc}
} 0
test string-2.15.2.$noComp {string compare -nocase} {
    run {string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334}
} 0
test string-2.16 {string compare -nocase with length} {
    string compare -length 2 -nocase abcde Abxyz
test string-2.16.$noComp {string compare -nocase with length} {
    run {string compare -length 2 -nocase abcde Abxyz}
} 0
test string-2.17 {string compare -nocase with length} {
    string compare -nocase -length 3 abcde Abxyz
test string-2.17.$noComp {string compare -nocase with length} {
    run {string compare -nocase -length 3 abcde Abxyz}
} -1
test string-2.18 {string compare -nocase with length <= 0} {
    string compare -nocase -length -1 abcde AbCdEf
test string-2.18.$noComp {string compare -nocase with length <= 0} {
    run {string compare -nocase -length -1 abcde AbCdEf}
} -1
test string-2.19 {string compare -nocase with excessive length} {
    string compare -nocase -length 50 AbCdEf abcde
test string-2.19.$noComp {string compare -nocase with excessive length} {
    run {string compare -nocase -length 50 AbCdEf abcde}
} 1
test string-2.20 {string compare -len unicode} {
test string-2.20.$noComp {string compare -len unicode} {
    # These are strings that are 6 BYTELENGTH long, but the length
    # shouldn't make a different because there are actually 3 CHARS long
    string compare -len 5 \334\334\334 \334\334\374
    run {string compare -len 5 \334\334\334 \334\334\374}
} -1
test string-2.21 {string compare -nocase with special index} {
    list [catch {string compare -nocase -length end-3 Abcde abxyz} msg] $msg
test string-2.21.$noComp {string compare -nocase with special index} {
    list [catch {run {string compare -nocase -length end-3 Abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-2.22 {string compare, null strings} {
    string compare "" ""
test string-2.22.$noComp {string compare, null strings} {
    run {string compare "" ""}
} 0
test string-2.23 {string compare, null strings} {
    string compare "" foo
test string-2.23.$noComp {string compare, null strings} {
    run {string compare "" foo}
} -1
test string-2.24 {string compare, null strings} {
    string compare foo ""
test string-2.24.$noComp {string compare, null strings} {
    run {string compare foo ""}
} 1
test string-2.25 {string compare -nocase, null strings} {
    string compare -nocase "" ""
test string-2.25.$noComp {string compare -nocase, null strings} {
    run {string compare -nocase "" ""}
} 0
test string-2.26 {string compare -nocase, null strings} {
    string compare -nocase "" foo
test string-2.26.$noComp {string compare -nocase, null strings} {
    run {string compare -nocase "" foo}
} -1
test string-2.27 {string compare -nocase, null strings} {
    string compare -nocase foo ""
test string-2.27.$noComp {string compare -nocase, null strings} {
    run {string compare -nocase foo ""}
} 1
test string-2.28 {string compare with length, unequal strings} {
    string compare -length 2 abc abde
test string-2.28.$noComp {string compare with length, unequal strings} {
    run {string compare -length 2 abc abde}
} 0
test string-2.29 {string compare with length, unequal strings} {
    string compare -length 2 ab abde
test string-2.29.$noComp {string compare with length, unequal strings} {
    run {string compare -length 2 ab abde}
} 0
test string-2.30 {string compare with NUL character vs. other ASCII} {
test string-2.30.$noComp {string compare with NUL character vs. other ASCII} {
    # Be careful here, since UTF-8 rep comparison with memcmp() of
    # these puts chars in the wrong order
    string compare \x00 \x01
    run {string compare \x00 \x01}
} -1
test string-2.31 {string compare, high bit} {
    proc foo {} {string compare "a\x80" "a@"}
test string-2.31.$noComp {string compare, high bit} {
    run {string compare "a\x80" "a@"}
    foo
} 1
test string-2.32 {string compare, high bit} {
    proc foo {} {string compare "a\x00" "a\x01"}
test string-2.32.$noComp {string compare, high bit} {
    run {string compare "a\x00" "a\x01"}
    foo
} -1
test string-2.33 {string compare, high bit} {
    proc foo {} {string compare "\x00\x00" "\x00\x01"}
test string-2.33.$noComp {string compare, high bit} {
    run {string compare "\x00\x00" "\x00\x01"}
    foo
} -1
test string-2.34.$noComp {string compare, binary equal} {
    run {string compare [binary format a100 0] [binary format a100 0]}
} 0
test string-2.35.$noComp {string compare, binary neq} {
    run {string compare [binary format a100a 0 1] [binary format a100a 0 0]}
} 1
test string-2.36.$noComp {string compare, binary neq unequal length} {
    run {string compare [binary format a20a 0 1] [binary format a100a 0 0]}
} 1

# only need a few tests on equal, since it uses the same code as
# string compare, but just modifies the return output
test string-3.1 {string equal} {
    string equal abcde abdef
test string-3.1.$noComp {string equal} {
    run {string equal abcde abdef}
} 0
test string-3.2 {string equal} {
    string eq abcde ABCDE
test string-3.2.$noComp {string equal} {
    run {string e abcde ABCDE}
} 0
test string-3.3 {string equal} {
    string equal abcde abcde
test string-3.3.$noComp {string equal} {
    run {string equal abcde abcde}
} 1
test string-3.4 {string equal -nocase} {
    string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334
test string-3.4.$noComp {string equal -nocase} {
    run {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334}
} 1
test string-3.5 {string equal -nocase} {
    string equal -nocase abcde abdef
test string-3.5.$noComp {string equal -nocase} {
    run {string equal -nocase abcde abdef}
} 0
test string-3.6 {string equal -nocase} {
    string eq -nocase abcde ABCDE
test string-3.6.$noComp {string equal -nocase} {
    run {string eq -nocase abcde ABCDE}
} 1
test string-3.7 {string equal -nocase} {
    string equal -nocase abcde abcde
test string-3.7.$noComp {string equal -nocase} {
    run {string equal -nocase abcde abcde}
} 1
test string-3.8 {string equal with length, unequal strings} {
    string equal -length 2 abc abde
test string-3.8.$noComp {string equal with length, unequal strings} {
    run {string equal -length 2 abc abde}
} 1
test string-3.9.$noComp {string equal, too few args} {
    list [catch {run {string equal a}} msg] $msg
} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}}
test string-3.10.$noComp {string equal, bad args} {
    list [catch {run {string equal a b c}} msg] $msg
} {1 {bad option "a": must be -nocase or -length}}
test string-3.11.$noComp {string equal, bad args} {
    list [catch {run {string equal -length -nocase str1 str2}} msg] $msg
} {1 {expected integer but got "-nocase"}}
test string-3.12.$noComp {string equal, too many args} {
    list [catch {run {string equal -length 10 -nocase str1 str2 str3}} msg] $msg
} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}}
test string-3.13.$noComp {string equal with length unspecified} {
    list [catch {run {string equal -length 10 10}} msg] $msg
} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}}
test string-3.14.$noComp {string equal with length} {
    run {string equal -length 2 abcde abxyz}
} 1
test string-3.15.$noComp {string equal with special index} {
    list [catch {run {string equal -length end-3 abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}

test string-4.1 {string first, too few args} {
    list [catch {string first a} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.2 {string first, bad args} {
    list [catch {string first a b c} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test string-4.3 {string first, too many args} {
    list [catch {string first a b 5 d} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.4 {string first} {
    string first bq abcdefgbcefgbqrs
} 12
test string-4.5 {string first} {
    string fir bcd abcdefgbcefgbqrs
} 1
test string-4.6 {string first} {
    string f b abcdefgbcefgbqrs
test string-3.16.$noComp {string equal, unicode} {
    run {string equal ab\u7266 ab\u7267}
} 0
test string-3.17.$noComp {string equal, unicode} {
    run {string equal \334 \u00dc}
} 1
test string-3.18.$noComp {string equal, unicode} {
    run {string equal \334 \u00fc}
} 0
test string-3.19.$noComp {string equal, unicode} {
    run {string equal \334\334\334\374\374 \334\334\334\334\334}
} 0
test string-3.20.$noComp {string equal, high bit} {
    # This test will fail if the underlying comparaison
    # is using signed chars instead of unsigned chars.
    # (like SunOS's default memcmp thus the compat/memcmp.c)
    run {string equal "\x80" "@"}
    # Nb this tests works also in utf8 space because \x80 is
    # translated into a 2 or more bytelength but whose first byte has
    # the high bit set.
} 0
test string-3.21.$noComp {string equal -nocase} {
    run {string equal -nocase abcde Abdef}
} 0
test string-3.22.$noComp {string equal, -nocase unicode} {
    run {string equal -nocase \334 \u00dc}
} 1
test string-3.23.$noComp {string equal, -nocase unicode} {
    run {string equal -nocase \334\334\334\374\u00fc \334\334\334\334\334}
} 1
test string-3.24.$noComp {string equal -nocase with length} {
    run {string equal -length 2 -nocase abcde Abxyz}
} 1
test string-3.25.$noComp {string equal -nocase with length} {
    run {string equal -nocase -length 3 abcde Abxyz}
} 0
test string-3.26.$noComp {string equal -nocase with length <= 0} {
    run {string equal -nocase -length -1 abcde AbCdEf}
} 0
test string-3.27.$noComp {string equal -nocase with excessive length} {
    run {string equal -nocase -length 50 AbCdEf abcde}
} 0
test string-3.28.$noComp {string equal -len unicode} {
    # These are strings that are 6 BYTELENGTH long, but the length
    # shouldn't make a different because there are actually 3 CHARS long
    run {string equal -len 5 \334\334\334 \334\334\374}
} 0
test string-3.29.$noComp {string equal -nocase with special index} {
    list [catch {run {string equal -nocase -length end-3 Abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-3.30.$noComp {string equal, null strings} {
    run {string equal "" ""}
} 1
test string-3.31.$noComp {string equal, null strings} {
    run {string equal "" foo}
} 0
test string-3.32.$noComp {string equal, null strings} {
    run {string equal foo ""}
} 0
test string-3.33.$noComp {string equal -nocase, null strings} {
    run {string equal -nocase "" ""}
} 1
test string-3.34.$noComp {string equal -nocase, null strings} {
test string-4.7 {string first} {
    string first xxx x123xx345xxx789xxx012
} 9
test string-4.8 {string first} {
    string first "" x123xx345xxx789xxx012
} -1
test string-4.9 {string first, unicode} {
    string first x abc\u7266x
    run {string equal -nocase "" foo}
} 0
test string-3.35.$noComp {string equal -nocase, null strings} {
    run {string equal -nocase foo ""}
} 0
test string-3.36.$noComp {string equal with NUL character vs. other ASCII} {
    # Be careful here, since UTF-8 rep comparison with memcmp() of
    # these puts chars in the wrong order
    run {string equal \x00 \x01}
} 0
test string-3.37.$noComp {string equal, high bit} {
    run {string equal "a\x80" "a@"}
} 0
test string-3.38.$noComp {string equal, high bit} {
    run {string equal "a\x00" "a\x01"}
} 0
test string-3.39.$noComp {string equal, high bit} {
    run {string equal "a\x00\x00" "a\x00\x01"}
} 0
test string-3.40.$noComp {string equal, binary equal} {
    run {string equal [binary format a100 0] [binary format a100 0]}
} 1
test string-3.41.$noComp {string equal, binary neq} {
    run {string equal [binary format a100a 0 1] [binary format a100a 0 0]}
} 0
test string-3.42.$noComp {string equal, binary neq inequal length} {
    run {string equal [binary format a20a 0 1] [binary format a100a 0 0]}
} 0


test string-4.1.$noComp {string first, too few args} {
    list [catch {run {string first a}} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.2.$noComp {string first, bad args} {
    list [catch {run {string first a b c}} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test string-4.3.$noComp {string first, too many args} {
    list [catch {run {string first a b 5 d}} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.4.$noComp {string first} {
    run {string first bq abcdefgbcefgbqrs}
} 12
test string-4.5.$noComp {string first} {
    run {string fir bcd abcdefgbcefgbqrs}
} 1
test string-4.6.$noComp {string first} {
    run {string f b abcdefgbcefgbqrs}
} 1
test string-4.7.$noComp {string first} {
    run {string first xxx x123xx345xxx789xxx012}
} 9
test string-4.8.$noComp {string first} {
    run {string first "" x123xx345xxx789xxx012}
} -1
test string-4.9.$noComp {string first, unicode} {
    run {string first x abc\u7266x}
} 4
test string-4.10 {string first, unicode} {
    string first \u7266 abc\u7266x
test string-4.10.$noComp {string first, unicode} {
    run {string first \u7266 abc\u7266x}
} 3
test string-4.11 {string first, start index} {
    string first \u7266 abc\u7266x 3
test string-4.11.$noComp {string first, start index} {
    run {string first \u7266 abc\u7266x 3}
} 3
test string-4.12 {string first, start index} {
    string first \u7266 abc\u7266x 4
test string-4.12.$noComp {string first, start index} {
    run {string first \u7266 abc\u7266x 4}
} -1
test string-4.13 {string first, start index} {
    string first \u7266 abc\u7266x end-2
test string-4.13.$noComp {string first, start index} {
    run {string first \u7266 abc\u7266x end-2}
} 3
test string-4.14 {string first, negative start index} {
    string first b abc -1
test string-4.14.$noComp {string first, negative start index} {
    run {string first b abc -1}
} 1
test string-4.15 {string first, ability to two-byte encoded utf-8 chars} {
test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} {
    # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded
    # strings was incorrect, leading to an index returned by [string first]
    # which pointed past the end of the string.
    set uchar \u057e    ;# character with two-byte encoding in utf-8
    string first % %#$uchar$uchar#$uchar$uchar#% 3
    run {string first % %#$uchar$uchar#$uchar$uchar#% 3}
} 8
test string-4.16 {string first, normal string vs pure unicode string} {
test string-4.16.$noComp {string first, normal string vs pure unicode string} {
    set s hello
    regexp ll $s m
    # Representation checks are canaries
    list [representationpoke $s] [representationpoke $m] \
	[string first $m $s]
    run {list [representationpoke $s] [representationpoke $m] \
	[string first $m $s]}
} {{string 1} {string 0} 2}

test string-5.1 {string index} {
    list [catch {string index} msg] $msg
test string-5.1.$noComp {string index} {
    list [catch {run {string index}} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test string-5.2 {string index} {
    list [catch {string index a b c} msg] $msg
test string-5.2.$noComp {string index} {
    list [catch {run {string index a b c}} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test string-5.3 {string index} {
    string index abcde 0
test string-5.3.$noComp {string index} {
    run {string index abcde 0}
} a
test string-5.4 {string index} {
    string in abcde 4
test string-5.4.$noComp {string index} {
    run {string ind abcde 4}
} e
test string-5.5 {string index} {
    string index abcde 5
test string-5.5.$noComp {string index} {
    run {string index abcde 5}
} {}
test string-5.6 {string index} {
    list [catch {string index abcde -10} msg] $msg
test string-5.6.$noComp {string index} {
    list [catch {run {string index abcde -10}} msg] $msg
} {0 {}}
test string-5.7 {string index} {
    list [catch {string index a xyz} msg] $msg
test string-5.7.$noComp {string index} {
    list [catch {run {string index a xyz}} msg] $msg
} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}}
test string-5.8 {string index} {
    string index abc end
test string-5.8.$noComp {string index} {
    run {string index abc end}
} c
test string-5.9 {string index} {
    string index abc end-1
test string-5.9.$noComp {string index} {
    run {string index abc end-1}
} b
test string-5.10 {string index, unicode} {
    string index abc\u7266d 4
test string-5.10.$noComp {string index, unicode} {
    run {string index abc\u7266d 4}
} d
test string-5.11 {string index, unicode} {
    string index abc\u7266d 3
test string-5.11.$noComp {string index, unicode} {
    run {string index abc\u7266d 3}
} \u7266
test string-5.12 {string index, unicode over char length, under byte length} {
    string index \334\374\334\374 6
test string-5.12.$noComp {string index, unicode over char length, under byte length} {
    run {string index \334\374\334\374 6}
} {}
test string-5.13 {string index, bytearray object} {
    string index [binary format a5 fuz] 0
test string-5.13.$noComp {string index, bytearray object} {
    run {string index [binary format a5 fuz] 0}
} f
test string-5.14 {string index, bytearray object} {
    string index [binary format I* {0x50515253 0x52}] 3
test string-5.14.$noComp {string index, bytearray object} {
    run {string index [binary format I* {0x50515253 0x52}] 3}
} S
test string-5.15 {string index, bytearray object} {
test string-5.15.$noComp {string index, bytearray object} {
    set b [binary format I* {0x50515253 0x52}]
    set i1 [string index $b end-6]
    set i2 [string index $b 1]
    string compare $i1 $i2
    set i1 [run {string index $b end-6}]
    set i2 [run {string index $b 1}]
    run {string compare $i1 $i2}
} 0
test string-5.16 {string index, bytearray object with string obj shimmering} {
test string-5.16.$noComp {string index, bytearray object with string obj shimmering} {
    set str "0123456789\x00 abcdedfghi"
    binary scan $str H* dump
    string compare [string index $str 10] \x00
    run {string compare [run {string index $str 10}] \x00}
} 0
test string-5.17 {string index, bad integer} -body {
    list [catch {string index "abc" 0o8} msg] $msg
} -match glob -result {1 {*}}
test string-5.18 {string index, bad integer} -body {
    list [catch {string index "abc" end-0o0289} msg] $msg
} -match glob -result {1 {*}}
test string-5.19 {string index, bytearray object out of bounds} {
    string index [binary format I* {0x50515253 0x52}] -1
test string-5.17.$noComp {string index, bad integer} -body {
    list [catch {run {string index "abc" 0o8}} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test string-5.18.$noComp {string index, bad integer} -body {
    list [catch {run {string index "abc" end-0o0289}} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test string-5.19.$noComp {string index, bytearray object out of bounds} {
    run {string index [binary format I* {0x50515253 0x52}] -1}
} {}
test string-5.20 {string index, bytearray object out of bounds} {
    string index [binary format I* {0x50515253 0x52}] 20
test string-5.20.$noComp {string index, bytearray object out of bounds} {
    run {string index [binary format I* {0x50515253 0x52}] 20}
} {}
test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} tip389 {
    run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]}
} [list \U100000 {} b]


proc largest_int {} {
    # This will give us what the largest valid int on this machine is,
    # so we can test for overflow properly below on >32 bit systems
    set int 1
    set exp 7; # assume we get at least 8 bits
    while {wide($int) > 0} { set int [expr {wide(1) << [incr exp]}] }
    return [expr {$int-1}]
}

test string-6.1 {string is, too few args} {
    list [catch {string is} msg] $msg
test string-6.1.$noComp {string is, too few args} {
    list [catch {run {string is}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.2 {string is, too few args} {
    list [catch {string is alpha} msg] $msg
test string-6.2.$noComp {string is, too few args} {
    list [catch {run {string is alpha}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.3 {string is, bad args} {
    list [catch {string is alpha -failin str} msg] $msg
test string-6.3.$noComp {string is, bad args} {
    list [catch {run {string is alpha -failin str}} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
test string-6.4 {string is, too many args} {
    list [catch {string is alpha -failin var -strict str more} msg] $msg
test string-6.4.$noComp {string is, too many args} {
    list [catch {run {string is alpha -failin var -strict str more}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5 {string is, class check} {
    list [catch {string is bogus str} msg] $msg
test string-6.5.$noComp {string is, class check} {
    list [catch {run {string is bogus str}} msg] $msg
} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.6 {string is, ambiguous class} {
    list [catch {string is al str} msg] $msg
test string-6.6.$noComp {string is, ambiguous class} {
    list [catch {run {string is al str}} msg] $msg
} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.7 {string is alpha, all ok} {
    string is alpha -strict -failindex var abc
test string-6.7.$noComp {string is alpha, all ok} {
    run {string is alpha -strict -failindex var abc}
} 1
test string-6.8 {string is, error in var} {
    list [string is alpha -failindex var abc5def] $var
test string-6.8.$noComp {string is, error in var} {
    list [run {string is alpha -failindex var abc5def}] $var
} {0 3}
test string-6.9 {string is, var shouldn't get set} {
test string-6.9.$noComp {string is, var shouldn't get set} {
    catch {unset var}
    list [catch {string is alpha -failindex var abc; set var} msg] $msg
    list [catch {run {string is alpha -failindex var abc; set var}} msg] $msg
} {1 {can't read "var": no such variable}}
test string-6.10 {string is, ok on empty} {
    string is alpha {}
test string-6.10.$noComp {string is, ok on empty} {
    run {string is alpha {}}
} 1
test string-6.11 {string is, -strict check against empty} {
    string is alpha -strict {}
test string-6.11.$noComp {string is, -strict check against empty} {
    run {string is alpha -strict {}}
} 0
test string-6.12 {string is alnum, true} {
    string is alnum abc123
test string-6.12.$noComp {string is alnum, true} {
    run {string is alnum abc123}
} 1
test string-6.13 {string is alnum, false} {
    list [string is alnum -failindex var abc1.23] $var
test string-6.13.$noComp {string is alnum, false} {
    list [run {string is alnum -failindex var abc1.23}] $var
} {0 4}
test string-6.14 {string is alnum, unicode} "string is alnum abc\xfc" 1
test string-6.15 {string is alpha, true} {
    string is alpha abc
test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abc\xfc}" 1
test string-6.15.$noComp {string is alpha, true} {
    run {string is alpha abc}
} 1
test string-6.16 {string is alpha, false} {
    list [string is alpha -fail var a1bcde] $var
test string-6.16.$noComp {string is alpha, false} {
    list [run {string is alpha -fail var a1bcde}] $var
} {0 1}
test string-6.17 {string is alpha, unicode} {
    string is alpha abc\374
test string-6.17.$noComp {string is alpha, unicode} {
    run {string is alpha abc\374}
} 1
test string-6.18 {string is ascii, true} {
    string is ascii abc\u007Fend\u0000
test string-6.18.$noComp {string is ascii, true} {
    run {string is ascii abc\u007Fend\u0000}
} 1
test string-6.19 {string is ascii, false} {
    list [string is ascii -fail var abc\u0000def\u0080more] $var
test string-6.19.$noComp {string is ascii, false} {
    list [run {string is ascii -fail var abc\u0000def\u0080more}] $var
} {0 7}
test string-6.20 {string is boolean, true} {
    string is boolean true
test string-6.20.$noComp {string is boolean, true} {
    run {string is boolean true}
} 1
test string-6.21 {string is boolean, true} {
    string is boolean f
test string-6.21.$noComp {string is boolean, true} {
    run {string is boolean f}
} 1
test string-6.22 {string is boolean, true based on type} {
    string is bool [string compare a a]
test string-6.22.$noComp {string is boolean, true based on type} {
    run {string is bool [run {string compare a a}]}
} 1
test string-6.23 {string is boolean, false} {
    list [string is bool -fail var yada] $var
test string-6.23.$noComp {string is boolean, false} {
    list [run {string is bool -fail var yada}] $var
} {0 0}
test string-6.24 {string is digit, true} {
    string is digit 0123456789
test string-6.24.$noComp {string is digit, true} {
    run {string is digit 0123456789}
} 1
test string-6.25 {string is digit, false} {
    list [string is digit -fail var 0123\u00dc567] $var
test string-6.25.$noComp {string is digit, false} {
    list [run {string is digit -fail var 0123\u00dc567}] $var
} {0 4}
test string-6.26 {string is digit, false} {
    list [string is digit -fail var +123567] $var
test string-6.26.$noComp {string is digit, false} {
    list [run {string is digit -fail var +123567}] $var
} {0 0}
test string-6.27 {string is double, true} {
    string is double 1
test string-6.27.$noComp {string is double, true} {
    run {string is double 1}
} 1
test string-6.28 {string is double, true} {
    string is double [expr double(1)]
test string-6.28.$noComp {string is double, true} {
    run {string is double [expr double(1)]}
} 1
test string-6.29 {string is double, true} {
    string is double 1.0
test string-6.29.$noComp {string is double, true} {
    run {string is double 1.0}
} 1
test string-6.30 {string is double, true} {
    string is double [string compare a a]
test string-6.30.$noComp {string is double, true} {
    run {string is double [run {string compare a a}]}
} 1
test string-6.31 {string is double, true} {
    string is double "   +1.0e-1  "
test string-6.31.$noComp {string is double, true} {
    run {string is double "   +1.0e-1  "}
} 1
test string-6.32 {string is double, true} {
    string is double "\n1.0\v"
test string-6.32.$noComp {string is double, true} {
    run {string is double "\n1.0\v"}
} 1
test string-6.33 {string is double, false} {
    list [string is double -fail var 1abc] $var
test string-6.33.$noComp {string is double, false} {
    list [run {string is double -fail var 1abc}] $var
} {0 1}
test string-6.34 {string is double, false} {
    list [string is double -fail var abc] $var
test string-6.34.$noComp {string is double, false} {
    list [run {string is double -fail var abc}] $var
} {0 0}
test string-6.35 {string is double, false} {
    list [string is double -fail var "   1.0e4e4  "] $var
test string-6.35.$noComp {string is double, false} {
    list [run {string is double -fail var "   1.0e4e4  "}] $var
} {0 8}
test string-6.36 {string is double, false} {
    list [string is double -fail var "\n"] $var
test string-6.36.$noComp {string is double, false} {
    list [run {string is double -fail var "\n"}] $var
} {0 0}
test string-6.37 {string is double, false on int overflow} -setup {
test string-6.37.$noComp {string is double, false on int overflow} -setup {
    set var priorValue
} -body {
    # Make it the largest int recognizable, with one more digit for overflow
    # Since bignums arrived in Tcl 8.5, the sense of this test changed.
    # Now integer values that exceed native limits become bignums, and
    # bignums can convert to doubles without error.
    list [string is double -fail var [largest_int]0] $var
    list [run {string is double -fail var [largest_int]0}] $var
} -result {1 priorValue}
# string-6.38 removed, underflow on input is no longer an error.
test string-6.39 {string is double, false} {
test string-6.39.$noComp {string is double, false} {
    # This test is non-portable because IRIX thinks
    # that .e1 is a valid double - this is really a bug
    # on IRIX as .e1 should NOT be a valid double
    #
    # Portable now. Tcl 8.5 does its own double parsing.

    list [string is double -fail var .e1] $var
    list [run {string is double -fail var .e1}] $var
} {0 0}
test string-6.40 {string is false, true} {
    string is false false
test string-6.40.$noComp {string is false, true} {
    run {string is false false}
} 1
test string-6.41 {string is false, true} {
    string is false FaLsE
test string-6.41.$noComp {string is false, true} {
    run {string is false FaLsE}
} 1
test string-6.42 {string is false, true} {
    string is false N
test string-6.42.$noComp {string is false, true} {
    run {string is false N}
} 1
test string-6.43 {string is false, true} {
    string is false 0
test string-6.43.$noComp {string is false, true} {
    run {string is false 0}
} 1
test string-6.44 {string is false, true} {
    string is false off
test string-6.44.$noComp {string is false, true} {
    run {string is false off}
} 1
test string-6.45 {string is false, false} {
    list [string is false -fail var abc] $var
test string-6.45.$noComp {string is false, false} {
    list [run {string is false -fail var abc}] $var
} {0 0}
test string-6.46 {string is false, false} {
test string-6.46.$noComp {string is false, false} {
    catch {unset var}
    list [string is false -fail var Y] $var
    list [run {string is false -fail var Y}] $var
} {0 0}
test string-6.47 {string is false, false} {
test string-6.47.$noComp {string is false, false} {
    catch {unset var}
    list [string is false -fail var offensive] $var
    list [run {string is false -fail var offensive}] $var
} {0 0}
test string-6.48 {string is integer, true} {
    string is integer +1234567890
test string-6.48.$noComp {string is integer, true} {
    run {string is integer +1234567890}
} 1
test string-6.49 {string is integer, true on type} {
    string is integer [expr int(50.0)]
test string-6.49.$noComp {string is integer, true on type} {
    run {string is integer [expr int(50.0)]}
} 1
test string-6.50 {string is integer, true} {
    string is integer [list -10]
test string-6.50.$noComp {string is integer, true} {
    run {string is integer [list -10]}
} 1
test string-6.51 {string is integer, true as hex} {
    string is integer 0xabcdef
test string-6.51.$noComp {string is integer, true as hex} {
    run {string is integer 0xabcdef}
} 1
test string-6.52 {string is integer, true as octal} {
    string is integer 012345
test string-6.52.$noComp {string is integer, true as octal} {
    run {string is integer 012345}
} 1
test string-6.53 {string is integer, true with whitespace} {
    string is integer "  \n1234\v"
test string-6.53.$noComp {string is integer, true with whitespace} {
    run {string is integer "  \n1234\v"}
} 1
test string-6.54 {string is integer, false} {
    list [string is integer -fail var 123abc] $var
test string-6.54.$noComp {string is integer, false} {
    list [run {string is integer -fail var 123abc}] $var
} {0 3}
test string-6.55 {string is integer, false on overflow} {
    list [string is integer -fail var +[largest_int]0] $var
} {0 -1}
test string-6.56 {string is integer, false} {
    list [string is integer -fail var [expr double(1)]] $var
test string-6.55.$noComp {string is integer, no overflow possible} {
    run {string is integer +[largest_int]0}
} 1
test string-6.56.$noComp {string is integer, false} {
    list [run {string is integer -fail var [expr double(1)]}] $var
} {0 1}
test string-6.57 {string is integer, false} {
    list [string is integer -fail var "    "] $var
test string-6.57.$noComp {string is integer, false} {
    list [run {string is integer -fail var "    "}] $var
} {0 0}
test string-6.58 {string is integer, false on bad octal} {
    list [string is integer -fail var 0o36963] $var
test string-6.58.$noComp {string is integer, false on bad octal} {
    list [run {string is integer -fail var 0o36963}] $var
} {0 4}
test string-6.58.1 {string is integer, false on bad octal} {
    list [string is integer -fail var 0o36963] $var
test string-6.58.1.$noComp {string is integer, false on bad octal} {
    list [run {string is integer -fail var 0o36963}] $var
} {0 4}
test string-6.59 {string is integer, false on bad hex} {
    list [string is integer -fail var 0X345XYZ] $var
test string-6.59.$noComp {string is integer, false on bad hex} {
    list [run {string is integer -fail var 0X345XYZ}] $var
} {0 5}
test string-6.60 {string is lower, true} {
    string is lower abc
test string-6.60.$noComp {string is lower, true} {
    run {string is lower abc}
} 1
test string-6.61 {string is lower, unicode true} {
    string is lower abc\u00fcue
test string-6.61.$noComp {string is lower, unicode true} {
    run {string is lower abc\u00fcue}
} 1
test string-6.62 {string is lower, false} {
    list [string is lower -fail var aBc] $var
test string-6.62.$noComp {string is lower, false} {
    list [run {string is lower -fail var aBc}] $var
} {0 1}
test string-6.63 {string is lower, false} {
    list [string is lower -fail var abc1] $var
test string-6.63.$noComp {string is lower, false} {
    list [run {string is lower -fail var abc1}] $var
} {0 3}
test string-6.64 {string is lower, unicode false} {
    list [string is lower -fail var ab\u00dcUE] $var
test string-6.64.$noComp {string is lower, unicode false} {
    list [run {string is lower -fail var ab\u00dcUE}] $var
} {0 2}
test string-6.65 {string is space, true} {
    string is space " \t\n\v\f"
test string-6.65.$noComp {string is space, true} {
    run {string is space " \t\n\v\f"}
} 1
test string-6.66 {string is space, false} {
    list [string is space -fail var " \t\n\v1\f"] $var
test string-6.66.$noComp {string is space, false} {
    list [run {string is space -fail var " \t\n\v1\f"}] $var
} {0 4}
test string-6.67 {string is true, true} {
    string is true true
test string-6.67.$noComp {string is true, true} {
    run {string is true true}
} 1
test string-6.68 {string is true, true} {
    string is true TrU
test string-6.68.$noComp {string is true, true} {
    run {string is true TrU}
} 1
test string-6.69 {string is true, true} {
    string is true ye
test string-6.69.$noComp {string is true, true} {
    run {string is true ye}
} 1
test string-6.70 {string is true, true} {
    string is true 1
test string-6.70.$noComp {string is true, true} {
    run {string is true 1}
} 1
test string-6.71 {string is true, true} {
    string is true on
test string-6.71.$noComp {string is true, true} {
    run {string is true on}
} 1
test string-6.72 {string is true, false} {
    list [string is true -fail var onto] $var
test string-6.72.$noComp {string is true, false} {
    list [run {string is true -fail var onto}] $var
} {0 0}
test string-6.73 {string is true, false} {
test string-6.73.$noComp {string is true, false} {
    catch {unset var}
    list [string is true -fail var 25] $var
    list [run {string is true -fail var 25}] $var
} {0 0}
test string-6.74 {string is true, false} {
test string-6.74.$noComp {string is true, false} {
    catch {unset var}
    list [string is true -fail var no] $var
    list [run {string is true -fail var no}] $var
} {0 0}
test string-6.75 {string is upper, true} {
    string is upper ABC
test string-6.75.$noComp {string is upper, true} {
    run {string is upper ABC}
} 1
test string-6.76 {string is upper, unicode true} {
    string is upper ABC\u00dcUE
test string-6.76.$noComp {string is upper, unicode true} {
    run {string is upper ABC\u00dcUE}
} 1
test string-6.77 {string is upper, false} {
    list [string is upper -fail var AbC] $var
test string-6.77.$noComp {string is upper, false} {
    list [run {string is upper -fail var AbC}] $var
} {0 1}
test string-6.78 {string is upper, false} {
    list [string is upper -fail var AB2C] $var
test string-6.78.$noComp {string is upper, false} {
    list [run {string is upper -fail var AB2C}] $var
} {0 2}
test string-6.79 {string is upper, unicode false} {
    list [string is upper -fail var ABC\u00fcue] $var
test string-6.79.$noComp {string is upper, unicode false} {
    list [run {string is upper -fail var ABC\u00fcue}] $var
} {0 3}
test string-6.80 {string is wordchar, true} {
    string is wordchar abc_123
test string-6.80.$noComp {string is wordchar, true} {
    run {string is wordchar abc_123}
} 1
test string-6.81 {string is wordchar, unicode true} {
    string is wordchar abc\u00fcab\u00dcAB\u5001
test string-6.81.$noComp {string is wordchar, unicode true} {
    run {string is wordchar abc\u00fcab\u00dcAB\u5001}
} 1
test string-6.82 {string is wordchar, false} {
    list [string is wordchar -fail var abcd.ef] $var
test string-6.82.$noComp {string is wordchar, false} {
    list [run {string is wordchar -fail var abcd.ef}] $var
} {0 4}
test string-6.83 {string is wordchar, unicode false} {
    list [string is wordchar -fail var abc\u0080def] $var
test string-6.83.$noComp {string is wordchar, unicode false} {
    list [run {string is wordchar -fail var abc\u0080def}] $var
} {0 3}
test string-6.84 {string is control} {
test string-6.84.$noComp {string is control} {
    ## Control chars are in the ranges
    ## 00..1F && 7F..9F
    list [string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60] $var
    list [run {string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60}] $var
} {0 7}
test string-6.85 {string is control} {
    string is control \u0100
test string-6.85.$noComp {string is control} {
    run {string is control \u0100}
} 0
test string-6.86 {string is graph} {
test string-6.86.$noComp {string is graph} {
    ## graph is any print char, except space
    list [string is gra -fail var "0123abc!@#\$\u0100\UE0100\UE01EF "] $var
    list [run {string is gra -fail var "0123abc!@#\$\u0100\UE0100\UE01EF "}] $var
} {0 14}
test string-6.87 {string is print} {
test string-6.87.$noComp {string is print} {
    ## basically any printable char
    list [string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\u0010"] $var
    list [run {string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\u0010"}] $var
} {0 15}
test string-6.88 {string is punct} {
test string-6.88.$noComp {string is punct} {
    ## any graph char that isn't alnum
    list [string is punct -fail var "_!@#\u00beq0"] $var
    list [run {string is punct -fail var "_!@#\u00beq0"}] $var
} {0 4}
test string-6.89 {string is xdigit} {
    list [string is xdigit -fail var 0123456789\u0061bcdefABCDEFg] $var
test string-6.89.$noComp {string is xdigit} {
    list [run {string is xdigit -fail var 0123456789\u0061bcdefABCDEFg}] $var
} {0 22}

test string-6.90 {string is integer, bad integers} {
test string-6.90.$noComp {string is integer, bad integers} {
    # SF bug #634856
    set result ""
    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
    foreach num $numbers {
	lappend result [string is int -strict $num]
	lappend result [run {string is int -strict $num}]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.91 {string is double, bad doubles} {
test string-6.91.$noComp {string is double, bad doubles} {
    set result ""
    set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
    foreach num $numbers {
	lappend result [string is double -strict $num]
	lappend result [run {string is double -strict $num}]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.92 {string is integer, 32-bit overflow} {
test string-6.92.$noComp {string is integer, no 64-bit overflow} {
    # Bug 718878
    set x 0x100000000
    list [string is integer -failindex var $x] $var
} {0 -1}
test string-6.93 {string is integer, 32-bit overflow} {
    set x 0x10000000000000000
    run {string is integer $x}
} 1
test string-6.93.$noComp {string is integer, no 64-bit overflow} {
    # Bug 718878
    set x 0x100000000
    set x 0x10000000000000000
    append x ""
    list [string is integer -failindex var $x] $var
} {0 -1}
test string-6.94 {string is integer, 32-bit overflow} {
    run {string is integer $x}
} 1
test string-6.94.$noComp {string is integer, no 64-bit overflow} {
    # Bug 718878
    set x 0x100000000
    list [string is integer -failindex var [expr {$x}]] $var
} {0 -1}
test string-6.95 {string is wideinteger, true} {
    string is wideinteger +1234567890
    set x 0x10000000000000000
    run {string is integer [expr {$x}]}
} 1
test string-6.95.$noComp {string is wideinteger, true} {
    run {string is wideinteger +1234567890}
} 1
test string-6.96 {string is wideinteger, true on type} {
    string is wideinteger [expr wide(50.0)]
test string-6.96.$noComp {string is wideinteger, true on type} {
    run {string is wideinteger [expr wide(50.0)]}
} 1
test string-6.97 {string is wideinteger, true} {
    string is wideinteger [list -10]
test string-6.97.$noComp {string is wideinteger, true} {
    run {string is wideinteger [list -10]}
} 1
test string-6.98 {string is wideinteger, true as hex} {
    string is wideinteger 0xabcdef
test string-6.98.$noComp {string is wideinteger, true as hex} {
    run {string is wideinteger 0xabcdef}
} 1
test string-6.99 {string is wideinteger, true as octal} {
    string is wideinteger 0123456
test string-6.99.$noComp {string is wideinteger, true as octal} {
    run {string is wideinteger 0123456}
} 1
test string-6.100 {string is wideinteger, true with whitespace} {
    string is wideinteger "  \n1234\v"
test string-6.100.$noComp {string is wideinteger, true with whitespace} {
    run {string is wideinteger "  \n1234\v"}
} 1
test string-6.101 {string is wideinteger, false} {
    list [string is wideinteger -fail var 123abc] $var
test string-6.101.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var 123abc}] $var
} {0 3}
test string-6.102 {string is wideinteger, false on overflow} {
    list [string is wideinteger -fail var +[largest_int]0] $var
test string-6.102.$noComp {string is wideinteger, false on overflow} {
    list [run {string is wideinteger -fail var +[largest_int]0}] $var
} {0 -1}
test string-6.103 {string is wideinteger, false} {
    list [string is wideinteger -fail var [expr double(1)]] $var
test string-6.103.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var [expr double(1)]}] $var
} {0 1}
test string-6.104 {string is wideinteger, false} {
    list [string is wideinteger -fail var "    "] $var
test string-6.104.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var "    "}] $var
} {0 0}
test string-6.105 {string is wideinteger, false on bad octal} {
    list [string is wideinteger -fail var 0o36963] $var
test string-6.105.$noComp {string is wideinteger, false on bad octal} {
    list [run {string is wideinteger -fail var 0o36963}] $var
} {0 4}
test string-6.105.1 {string is wideinteger, false on bad octal} {
    list [string is wideinteger -fail var 0o36963] $var
test string-6.105.1.$noComp {string is wideinteger, false on bad octal} {
    list [run {string is wideinteger -fail var 0o36963}] $var
} {0 4}
test string-6.106 {string is wideinteger, false on bad hex} {
    list [string is wideinteger -fail var 0X345XYZ] $var
test string-6.106.$noComp {string is wideinteger, false on bad hex} {
    list [run {string is wideinteger -fail var 0X345XYZ}] $var
} {0 5}
test string-6.107 {string is integer, bad integers} {
test string-6.107.$noComp {string is integer, bad integers} {
    # SF bug #634856
    set result ""
    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
    foreach num $numbers {
	lappend result [string is wideinteger -strict $num]
	lappend result [run {string is wideinteger -strict $num}]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.108 {string is double, Bug 1382287} {
test string-6.108.$noComp {string is double, Bug 1382287} {
    set x 2turtledoves
    string is double $x
    string is double $x
    run {string is double $x}
    run {string is double $x}
} 0
test string-6.109 {string is double, Bug 1360532} {
    string is double 1\u00a0
test string-6.109.$noComp {string is double, Bug 1360532} {
    run {string is double 1\u00a0}
} 0
test string-6.110 {string is entier, true} {
    string is entier +1234567890
test string-6.110.$noComp {string is entier, true} {
    run {string is entier +1234567890}
} 1
test string-6.111 {string is entier, true on type} {
    string is entier [expr wide(50.0)]
test string-6.111.$noComp {string is entier, true on type} {
    run {string is entier [expr wide(50.0)]}
} 1
test string-6.112 {string is entier, true} {
    string is entier [list -10]
test string-6.112.$noComp {string is entier, true} {
    run {string is entier [list -10]}
} 1
test string-6.113 {string is entier, true as hex} {
    string is entier 0xabcdef
test string-6.113.$noComp {string is entier, true as hex} {
    run {string is entier 0xabcdef}
} 1
test string-6.114 {string is entier, true as octal} {
    string is entier 0123456
test string-6.114.$noComp {string is entier, true as octal} {
    run {string is entier 0123456}
} 1
test string-6.115 {string is entier, true with whitespace} {
    string is entier "  \n1234\v"
test string-6.115.$noComp {string is entier, true with whitespace} {
    run {string is entier "  \n1234\v"}
} 1
test string-6.116 {string is entier, false} {
    list [string is entier -fail var 123abc] $var
test string-6.116.$noComp {string is entier, false} {
    list [run {string is entier -fail var 123abc}] $var
} {0 3}
test string-6.117 {string is entier, false} {
    list [string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc] $var
test string-6.117.$noComp {string is entier, false} {
    list [run {string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc}] $var
} {0 84}
test string-6.118 {string is entier, false} {
    list [string is entier -fail var [expr double(1)]] $var
test string-6.118.$noComp {string is entier, false} {
    list [run {string is entier -fail var [expr double(1)]}] $var
} {0 1}
test string-6.119 {string is entier, false} {
    list [string is entier -fail var "    "] $var
test string-6.119.$noComp {string is entier, false} {
    list [run {string is entier -fail var "    "}] $var
} {0 0}
test string-6.120 {string is entier, false on bad octal} {
    list [string is entier -fail var 0o36963] $var
test string-6.120.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o36963}] $var
} {0 4}
test string-6.121.1 {string is entier, false on bad octal} {
    list [string is entier -fail var 0o36963] $var
test string-6.121.1.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o36963}] $var
} {0 4}
test string-6.122 {string is entier, false on bad hex} {
    list [string is entier -fail var 0X345XYZ] $var
test string-6.122.$noComp {string is entier, false on bad hex} {
    list [run {string is entier -fail var 0X345XYZ}] $var
} {0 5}
test string-6.123 {string is entier, bad integers} {
test string-6.123.$noComp {string is entier, bad integers} {
    # SF bug #634856
    set result ""
    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
    foreach num $numbers {
	lappend result [string is entier -strict $num]
	lappend result [run {string is entier -strict $num}]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.124 {string is entier, true} {
    string is entier +1234567890123456789012345678901234567890
test string-6.124.$noComp {string is entier, true} {
    run {string is entier +1234567890123456789012345678901234567890}
} 1
test string-6.125 {string is entier, true} {
    string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000]
test string-6.125.$noComp {string is entier, true} {
    run {string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000]}
} 1
test string-6.126 {string is entier, true as hex} {
    string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef
test string-6.126.$noComp {string is entier, true as hex} {
    run {string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef}
} 1
test string-6.127 {string is entier, true as octal} {
    string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456
test string-6.127.$noComp {string is entier, true as octal} {
    run {string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456}
} 1
test string-6.128 {string is entier, true with whitespace} {
    string is entier "  \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v"
test string-6.128.$noComp {string is entier, true with whitespace} {
    run {string is entier "  \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v"}
} 1
test string-6.129 {string is entier, false on bad octal} {
    list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var
test string-6.129.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var
} {0 87}
test string-6.130.1 {string is entier, false on bad octal} {
    list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var
test string-6.130.1.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var
} {0 87}
test string-6.131 {string is entier, false on bad hex} {
    list [string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ] $var
test string-6.131.$noComp {string is entier, false on bad hex} {
    list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var
} {0 88}

catch {rename largest_int {}}

test string-7.1 {string last, too few args} {
    list [catch {string last a} msg] $msg
test string-7.1.$noComp {string last, too few args} {
    list [catch {run {string last a}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.2 {string last, bad args} {
    list [catch {string last a b c} msg] $msg
test string-7.2.$noComp {string last, bad args} {
    list [catch {run {string last a b c}} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test string-7.3 {string last, too many args} {
    list [catch {string last a b c d} msg] $msg
test string-7.3.$noComp {string last, too many args} {
    list [catch {run {string last a b c d}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.4 {string last} {
    string la xxx xxxx123xx345x678
test string-7.4.$noComp {string last} {
    run {string la xxx xxxx123xx345x678}
} 1
test string-7.5 {string last} {
    string last xx xxxx123xx345x678
test string-7.5.$noComp {string last} {
    run {string last xx xxxx123xx345x678}
} 7
test string-7.6 {string last} {
    string las x xxxx123xx345x678
test string-7.6.$noComp {string last} {
    run {string las x xxxx123xx345x678}
} 12
test string-7.7 {string last, unicode} {
    string las x xxxx12\u7266xx345x678
test string-7.7.$noComp {string last, unicode} {
    run {string las x xxxx12\u7266xx345x678}
} 12
test string-7.8 {string last, unicode} {
    string las \u7266 xxxx12\u7266xx345x678
test string-7.8.$noComp {string last, unicode} {
    run {string las \u7266 xxxx12\u7266xx345x678}
} 6
test string-7.9 {string last, stop index} {
    string las \u7266 xxxx12\u7266xx345x678
test string-7.9.$noComp {string last, stop index} {
    run {string las \u7266 xxxx12\u7266xx345x678}
} 6
test string-7.10 {string last, unicode} {
    string las \u7266 xxxx12\u7266xx345x678
test string-7.10.$noComp {string last, unicode} {
    run {string las \u7266 xxxx12\u7266xx345x678}
} 6
test string-7.11 {string last, start index} {
    string last \u7266 abc\u7266x 3
test string-7.11.$noComp {string last, start index} {
    run {string last \u7266 abc\u7266x 3}
} 3
test string-7.12 {string last, start index} {
    string last \u7266 abc\u7266x 2
test string-7.12.$noComp {string last, start index} {
    run {string last \u7266 abc\u7266x 2}
} -1
test string-7.13 {string last, start index} {
test string-7.13.$noComp {string last, start index} {
    ## Constrain to last 'a' should work
    string last ba badbad end-1
    run {string last ba badbad end-1}
} 3
test string-7.14 {string last, start index} {
test string-7.14.$noComp {string last, start index} {
    ## Constrain to last 'b' should skip last 'ba'
    string last ba badbad end-2
    run {string last ba badbad end-2}
} 0
test string-7.15 {string last, start index} {
    string last \334a \334ad\334ad 0
test string-7.15.$noComp {string last, start index} {
    run {string last \334a \334ad\334ad 0}
} -1
test string-7.16 {string last, start index} {
    string last \334a \334ad\334ad end-1
test string-7.16.$noComp {string last, start index} {
    run {string last \334a \334ad\334ad end-1}
} 3

test string-8.1 {string bytelength} {
    list [catch {string bytelength} msg] $msg
test string-8.1.$noComp {string bytelength} {
    list [catch {run {string bytelength}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.2 {string bytelength} {
    list [catch {string bytelength a b} msg] $msg
test string-8.2.$noComp {string bytelength} {
    list [catch {run {string bytelength a b}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.3 {string bytelength} {
    string bytelength "\u00c7"
test string-8.3.$noComp {string bytelength} {
    run {string bytelength "\u00c7"}
} 2
test string-8.4 {string bytelength} {
    string b ""
test string-8.4.$noComp {string bytelength} {
    run {string b ""}
} 0

test string-9.1 {string length} {
    list [catch {string length} msg] $msg
test string-9.1.$noComp {string length} {
    list [catch {run {string length}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.2 {string length} {
    list [catch {string length a b} msg] $msg
test string-9.2.$noComp {string length} {
    list [catch {run {string length a b}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.3 {string length} {
    string length "a little string"
test string-9.3.$noComp {string length} {
    run {string length "a little string"}
} 15
test string-9.4 {string length} {
    string le ""
test string-9.4.$noComp {string length} {
    run {string le ""}
} 0
test string-9.5 {string length, unicode} {
    string le "abcd\u7266"
test string-9.5.$noComp {string length, unicode} {
    run {string le "abcd\u7266"}
} 5
test string-9.6 {string length, bytearray object} {
    string length [binary format a5 foo]
test string-9.6.$noComp {string length, bytearray object} {
    run {string length [binary format a5 foo]}
} 5
test string-9.7 {string length, bytearray object} {
    string length [binary format I* {0x50515253 0x52}]
test string-9.7.$noComp {string length, bytearray object} {
    run {string length [binary format I* {0x50515253 0x52}]}
} 8

test string-10.1 {string map, too few args} {
    list [catch {string map} msg] $msg
test string-10.1.$noComp {string map, too few args} {
    list [catch {run {string map}} msg] $msg
} {1 {wrong # args: should be "string map ?-nocase? charMap string"}}
test string-10.2 {string map, bad args} {
    list [catch {string map {a b} abba oops} msg] $msg
test string-10.2.$noComp {string map, bad args} {
    list [catch {run {string map {a b} abba oops}} msg] $msg
} {1 {bad option "a b": must be -nocase}}
test string-10.3 {string map, too many args} {
    list [catch {string map -nocase {a b} str1 str2} msg] $msg
test string-10.3.$noComp {string map, too many args} {
    list [catch {run {string map -nocase {a b} str1 str2}} msg] $msg
} {1 {wrong # args: should be "string map ?-nocase? charMap string"}}
test string-10.4 {string map} {
    string map {a b} abba
test string-10.4.$noComp {string map} {
    run {string map {a b} abba}
} {bbbb}
test string-10.5 {string map} {
    string map {a b} a
test string-10.5.$noComp {string map} {
    run {string map {a b} a}
} {b}
test string-10.6 {string map -nocase} {
    string map -nocase {a b} Abba
test string-10.6.$noComp {string map -nocase} {
    run {string map -nocase {a b} Abba}
} {bbbb}
test string-10.7 {string map} {
    string map {abc 321 ab * a A} aabcabaababcab
test string-10.7.$noComp {string map} {
    run {string map {abc 321 ab * a A} aabcabaababcab}
} {A321*A*321*}
test string-10.8 {string map -nocase} {
    string map -nocase {aBc 321 Ab * a A} aabcabaababcab
test string-10.8.$noComp {string map -nocase} {
    run {string map -nocase {aBc 321 Ab * a A} aabcabaababcab}
} {A321*A*321*}
test string-10.9 {string map -nocase} {
    string map -no {abc 321 Ab * a A} aAbCaBaAbAbcAb
test string-10.9.$noComp {string map -nocase} {
    run {string map -no {abc 321 Ab * a A} aAbCaBaAbAbcAb}
} {A321*A*321*}
test string-10.10 {string map} {
    list [catch {string map {a b c} abba} msg] $msg
test string-10.10.$noComp {string map} {
    list [catch {run {string map {a b c} abba}} msg] $msg
} {1 {char map list unbalanced}}
test string-10.11 {string map, nulls} {
    string map {\x00 NULL blah \x00nix} {qwerty}
test string-10.11.$noComp {string map, nulls} {
    run {string map {\x00 NULL blah \x00nix} {qwerty}}
} {qwerty}
test string-10.12 {string map, unicode} {
    string map [list \374 ue UE \334] "a\374ueUE\000EU"
test string-10.12.$noComp {string map, unicode} {
    run {string map [list \374 ue UE \334] "a\374ueUE\000EU"}
} aueue\334\0EU
test string-10.13 {string map, -nocase unicode} {
    string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"
test string-10.13.$noComp {string map, -nocase unicode} {
    run {string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"}
} aue\334\334\0EU
test string-10.14 {string map, -nocase null arguments} {
    string map -nocase {{} abc} foo
test string-10.14.$noComp {string map, -nocase null arguments} {
    run {string map -nocase {{} abc} foo}
} foo
test string-10.15 {string map, one pair case} {
    string map -nocase {abc 32} aAbCaBaAbAbcAb
test string-10.15.$noComp {string map, one pair case} {
    run {string map -nocase {abc 32} aAbCaBaAbAbcAb}
} {a32aBaAb32Ab}
test string-10.16 {string map, one pair case} {
    string map -nocase {ab 4321} aAbCaBaAbAbcAb
test string-10.16.$noComp {string map, one pair case} {
    run {string map -nocase {ab 4321} aAbCaBaAbAbcAb}
} {a4321C4321a43214321c4321}
test string-10.17 {string map, one pair case} {
    string map {Ab 4321} aAbCaBaAbAbcAb
test string-10.17.$noComp {string map, one pair case} {
    run {string map {Ab 4321} aAbCaBaAbAbcAb}
} {a4321CaBa43214321c4321}
test string-10.18 {string map, empty argument} {
    string map -nocase {{} abc} foo
test string-10.18.$noComp {string map, empty argument} {
    run {string map -nocase {{} abc} foo}
} foo
test string-10.19 {string map, empty arguments} {
    string map -nocase {{} abc f bar {} def} foo
test string-10.19.$noComp {string map, empty arguments} {
    run {string map -nocase {{} abc f bar {} def} foo}
} baroo
test string-10.20 {string map, dictionaries don't alter map ordering} {
test string-10.20.$noComp {string map, dictionaries don't alter map ordering} {
    set map {aa X a Y}
    list [string map [dict create aa X a Y] aaa] [string map $map aaa] [dict size $map] [string map $map aaa]
    list [run {string map [dict create aa X a Y] aaa}] [run {string map $map aaa}] [dict size $map] [run {string map $map aaa}]
} {XY XY 2 XY}
test string-10.20.1 {string map, dictionaries don't alter map ordering} {
test string-10.20.1.$noComp {string map, dictionaries don't alter map ordering} {
    set map {a X b Y a Z}
    list [string map [dict create a X b Y a Z] aaa] [string map $map aaa] [dict size $map] [string map $map aaa]
    list [run {string map [dict create a X b Y a Z] aaa}] [run {string map $map aaa}] [dict size $map] [run {string map $map aaa}]
} {ZZZ XXX 2 XXX}
test string-10.21 {string map, ABR checks} {
    string map {longstring foob} long
test string-10.21.$noComp {string map, ABR checks} {
    run {string map {longstring foob} long}
} long
test string-10.22 {string map, ABR checks} {
    string map {long foob} long
test string-10.22.$noComp {string map, ABR checks} {
    run {string map {long foob} long}
} foob
test string-10.23 {string map, ABR checks} {
    string map {lon foob} long
test string-10.23.$noComp {string map, ABR checks} {
    run {string map {lon foob} long}
} foobg
test string-10.24 {string map, ABR checks} {
    string map {lon foob} longlo
test string-10.24.$noComp {string map, ABR checks} {
    run {string map {lon foob} longlo}
} foobglo
test string-10.25 {string map, ABR checks} {
    string map {lon foob} longlon
test string-10.25.$noComp {string map, ABR checks} {
    run {string map {lon foob} longlon}
} foobgfoob
test string-10.26 {string map, ABR checks} {
    string map {longstring foob longstring bar} long
test string-10.26.$noComp {string map, ABR checks} {
    run {string map {longstring foob longstring bar} long}
} long
test string-10.27 {string map, ABR checks} {
    string map {long foob longstring bar} long
test string-10.27.$noComp {string map, ABR checks} {
    run {string map {long foob longstring bar} long}
} foob
test string-10.28 {string map, ABR checks} {
    string map {lon foob longstring bar} long
test string-10.28.$noComp {string map, ABR checks} {
    run {string map {lon foob longstring bar} long}
} foobg
test string-10.29 {string map, ABR checks} {
    string map {lon foob longstring bar} longlo
test string-10.29.$noComp {string map, ABR checks} {
    run {string map {lon foob longstring bar} longlo}
} foobglo
test string-10.30 {string map, ABR checks} {
    string map {lon foob longstring bar} longlon
test string-10.30.$noComp {string map, ABR checks} {
    run {string map {lon foob longstring bar} longlon}
} foobgfoob
test string-10.31 {string map, nasty sharing crash from [Bug 1018562]} {
test string-10.31.$noComp {string map, nasty sharing crash from [Bug 1018562]} {
    set a {a b}
    string map $a $a
    run {string map $a $a}
} {b b}

test string-11.1 {string match, too few args} {
    list [catch {string match a} msg] $msg
test string-11.1.$noComp {string match, too few args} {
    list [catch {run {string match a}} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test string-11.2 {string match, too many args} {
    list [catch {string match a b c d} msg] $msg
test string-11.2.$noComp {string match, too many args} {
    list [catch {run {string match a b c d}} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test string-11.3 {string match} {
    string match abc abc
test string-11.3.$noComp {string match} {
    run {string match abc abc}
} 1
test string-11.4 {string match} {
    string mat abc abd
test string-11.4.$noComp {string match} {
    run {string mat abc abd}
} 0
test string-11.5 {string match} {
    string match ab*c abc
test string-11.5.$noComp {string match} {
    run {string match ab*c abc}
} 1
test string-11.6 {string match} {
    string match ab**c abc
test string-11.6.$noComp {string match} {
    run {string match ab**c abc}
} 1
test string-11.7 {string match} {
    string match ab* abcdef
test string-11.7.$noComp {string match} {
    run {string match ab* abcdef}
} 1
test string-11.8 {string match} {
    string match *c abc
test string-11.8.$noComp {string match} {
    run {string match *c abc}
} 1
test string-11.9 {string match} {
    string match *3*6*9 0123456789
test string-11.9.$noComp {string match} {
    run {string match *3*6*9 0123456789}
} 1
test string-11.9.1 {string match} {
    string match *3*6*89 0123456789
test string-11.9.1.$noComp {string match} {
    run {string match *3*6*89 0123456789}
} 1
test string-11.9.2 {string match} {
    string match *3*456*89 0123456789
test string-11.9.2.$noComp {string match} {
    run {string match *3*456*89 0123456789}
} 1
test string-11.9.3 {string match} {
    string match *3*6* 0123456789
test string-11.9.3.$noComp {string match} {
    run {string match *3*6* 0123456789}
} 1
test string-11.9.4 {string match} {
    string match *3*56* 0123456789
test string-11.9.4.$noComp {string match} {
    run {string match *3*56* 0123456789}
} 1
test string-11.9.5 {string match} {
    string match *3*456*** 0123456789
test string-11.9.5.$noComp {string match} {
    run {string match *3*456*** 0123456789}
} 1
test string-11.9.6 {string match} {
    string match **3*456** 0123456789
test string-11.9.6.$noComp {string match} {
    run {string match **3*456** 0123456789}
} 1
test string-11.9.7 {string match} {
    string match *3***456* 0123456789
test string-11.9.7.$noComp {string match} {
    run {string match *3***456* 0123456789}
} 1
test string-11.9.8 {string match} {
    string match *3***\[456]* 0123456789
test string-11.9.8.$noComp {string match} {
    run {string match *3***\[456]* 0123456789}
} 1
test string-11.9.9 {string match} {
    string match *3***\[4-6]* 0123456789
test string-11.9.9.$noComp {string match} {
    run {string match *3***\[4-6]* 0123456789}
} 1
test string-11.9.10 {string match} {
    string match *3***\[4-6] 0123456789
test string-11.9.10.$noComp {string match} {
    run {string match *3***\[4-6] 0123456789}
} 0
test string-11.9.11 {string match} {
    string match *3***\[4-6] 0123456
test string-11.9.11.$noComp {string match} {
    run {string match *3***\[4-6] 0123456}
} 1
test string-11.10 {string match} {
    string match *3*6*9 01234567890
test string-11.10.$noComp {string match} {
    run {string match *3*6*9 01234567890}
} 0
test string-11.10.1 {string match} {
    string match *3*6*89 01234567890
test string-11.10.1.$noComp {string match} {
    run {string match *3*6*89 01234567890}
} 0
test string-11.10.2 {string match} {
    string match *3*456*89 01234567890
test string-11.10.2.$noComp {string match} {
    run {string match *3*456*89 01234567890}
} 0
test string-11.10.3 {string match} {
    string match **3*456*89 01234567890
test string-11.10.3.$noComp {string match} {
    run {string match **3*456*89 01234567890}
} 0
test string-11.10.4 {string match} {
    string match *3*456***89 01234567890
test string-11.10.4.$noComp {string match} {
    run {string match *3*456***89 01234567890}
} 0
test string-11.11 {string match} {
    string match a?c abc
test string-11.11.$noComp {string match} {
    run {string match a?c abc}
} 1
test string-11.12 {string match} {
    string match a??c abc
test string-11.12.$noComp {string match} {
    run {string match a??c abc}
} 0
test string-11.13 {string match} {
    string match ?1??4???8? 0123456789
test string-11.13.$noComp {string match} {
    run {string match ?1??4???8? 0123456789}
} 1
test string-11.14 {string match} {
    string match {[abc]bc} abc
test string-11.14.$noComp {string match} {
    run {string match {[abc]bc} abc}
} 1
test string-11.15 {string match} {
    string match {a[abc]c} abc
test string-11.15.$noComp {string match} {
    run {string match {a[abc]c} abc}
} 1
test string-11.16 {string match} {
    string match {a[xyz]c} abc
test string-11.16.$noComp {string match} {
    run {string match {a[xyz]c} abc}
} 0
test string-11.17 {string match} {
    string match {12[2-7]45} 12345
test string-11.17.$noComp {string match} {
    run {string match {12[2-7]45} 12345}
} 1
test string-11.18 {string match} {
    string match {12[ab2-4cd]45} 12345
test string-11.18.$noComp {string match} {
    run {string match {12[ab2-4cd]45} 12345}
} 1
test string-11.19 {string match} {
    string match {12[ab2-4cd]45} 12b45
test string-11.19.$noComp {string match} {
    run {string match {12[ab2-4cd]45} 12b45}
} 1
test string-11.20 {string match} {
    string match {12[ab2-4cd]45} 12d45
test string-11.20.$noComp {string match} {
    run {string match {12[ab2-4cd]45} 12d45}
} 1
test string-11.21 {string match} {
    string match {12[ab2-4cd]45} 12145
test string-11.21.$noComp {string match} {
    run {string match {12[ab2-4cd]45} 12145}
} 0
test string-11.22 {string match} {
    string match {12[ab2-4cd]45} 12545
test string-11.22.$noComp {string match} {
    run {string match {12[ab2-4cd]45} 12545}
} 0
test string-11.23 {string match} {
    string match {a\*b} a*b
test string-11.23.$noComp {string match} {
    run {string match {a\*b} a*b}
} 1
test string-11.24 {string match} {
    string match {a\*b} ab
test string-11.24.$noComp {string match} {
    run {string match {a\*b} ab}
} 0
test string-11.25 {string match} {
    string match {a\*\?\[\]\\\x} "a*?\[\]\\x"
test string-11.25.$noComp {string match} {
    run {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
} 1
test string-11.26 {string match} {
    string match ** ""
test string-11.26.$noComp {string match} {
    run {string match ** ""}
} 1
test string-11.27 {string match} {
    string match *. ""
test string-11.27.$noComp {string match} {
    run {string match *. ""}
} 0
test string-11.28 {string match} {
    string match "" ""
test string-11.28.$noComp {string match} {
    run {string match "" ""}
} 1
test string-11.29 {string match} {
    string match \[a a
test string-11.29.$noComp {string match} {
    run {string match \[a a}
} 1
test string-11.30 {string match, bad args} {
    list [catch {string match - b c} msg] $msg
test string-11.30.$noComp {string match, bad args} {
    list [catch {run {string match - b c}} msg] $msg
} {1 {bad option "-": must be -nocase}}
test string-11.31 {string match case} {
    string match a A
test string-11.31.$noComp {string match case} {
    run {string match a A}
} 0
test string-11.32 {string match nocase} {
    string match -n a A
test string-11.32.$noComp {string match nocase} {
    run {string match -n a A}
} 1
test string-11.33 {string match nocase} {
    string match -nocase a\334 A\374
test string-11.33.$noComp {string match nocase} {
    run {string match -nocase a\334 A\374}
} 1
test string-11.34 {string match nocase} {
    string match -nocase a*f ABCDEf
test string-11.34.$noComp {string match nocase} {
    run {string match -nocase a*f ABCDEf}
} 1
test string-11.35 {string match case, false hope} {
test string-11.35.$noComp {string match case, false hope} {
    # This is true because '_' lies between the A-Z and a-z ranges
    string match {[A-z]} _
    run {string match {[A-z]} _}
} 1
test string-11.36 {string match nocase range} {
test string-11.36.$noComp {string match nocase range} {
    # This is false because although '_' lies between the A-Z and a-z ranges,
    # we lower case the end points before checking the ranges.
    string match -nocase {[A-z]} _
    run {string match -nocase {[A-z]} _}
} 0
test string-11.37 {string match nocase} {
    string match -nocase {[A-fh-Z]} g
test string-11.37.$noComp {string match nocase} {
    run {string match -nocase {[A-fh-Z]} g}
} 0
test string-11.38 {string match case, reverse range} {
    string match {[A-fh-Z]} g
test string-11.38.$noComp {string match case, reverse range} {
    run {string match {[A-fh-Z]} g}
} 1
test string-11.39 {string match, *\ case} {
    string match {*\abc} abc
test string-11.39.$noComp {string match, *\ case} {
    run {string match {*\abc} abc}
} 1
test string-11.39.1 {string match, *\ case} {
    string match {*ab\c} abc
test string-11.39.1.$noComp {string match, *\ case} {
    run {string match {*ab\c} abc}
} 1
test string-11.39.2 {string match, *\ case} {
    string match {*ab\*} ab*
test string-11.39.2.$noComp {string match, *\ case} {
    run {string match {*ab\*} ab*}
} 1
test string-11.39.3 {string match, *\ case} {
    string match {*ab\*} abc
test string-11.39.3.$noComp {string match, *\ case} {
    run {string match {*ab\*} abc}
} 0
test string-11.39.4 {string match, *\ case} {
    string match {*ab\\*} {ab\c}
test string-11.39.4.$noComp {string match, *\ case} {
    run {string match {*ab\\*} {ab\c}}
} 1
test string-11.39.5 {string match, *\ case} {
    string match {*ab\\*} {ab\*}
test string-11.39.5.$noComp {string match, *\ case} {
    run {string match {*ab\\*} {ab\*}}
} 1
test string-11.40 {string match, *special case} {
    string match {*[ab]} abc
test string-11.40.$noComp {string match, *special case} {
    run {string match {*[ab]} abc}
} 0
test string-11.41 {string match, *special case} {
    string match {*[ab]*} abc
test string-11.41.$noComp {string match, *special case} {
    run {string match {*[ab]*} abc}
} 1
test string-11.42 {string match, *special case} {
    string match "*\\" "\\"
test string-11.42.$noComp {string match, *special case} {
    run {string match "*\\" "\\"}
} 0
test string-11.43 {string match, *special case} {
    string match "*\\\\" "\\"
test string-11.43.$noComp {string match, *special case} {
    run {string match "*\\\\" "\\"}
} 1
test string-11.44 {string match, *special case} {
    string match "*???" "12345"
test string-11.44.$noComp {string match, *special case} {
    run {string match "*???" "12345"}
} 1
test string-11.45 {string match, *special case} {
    string match "*???" "12"
test string-11.45.$noComp {string match, *special case} {
    run {string match "*???" "12"}
} 0
test string-11.46 {string match, *special case} {
    string match "*\\*" "abc*"
test string-11.46.$noComp {string match, *special case} {
    run {string match "*\\*" "abc*"}
} 1
test string-11.47 {string match, *special case} {
    string match "*\\*" "*"
test string-11.47.$noComp {string match, *special case} {
    run {string match "*\\*" "*"}
} 1
test string-11.48 {string match, *special case} {
    string match "*\\*" "*abc"
test string-11.48.$noComp {string match, *special case} {
    run {string match "*\\*" "*abc"}
} 0
test string-11.49 {string match, *special case} {
    string match "?\\*" "a*"
test string-11.49.$noComp {string match, *special case} {
    run {string match "?\\*" "a*"}
} 1
test string-11.50 {string match, *special case} {
    string match "\\" "\\"
test string-11.50.$noComp {string match, *special case} {
    run {string match "\\" "\\"}
} 0
test string-11.51 {string match; *, -nocase and UTF-8} {
    string match -nocase [binary format I 717316707] \
	    [binary format I 2028036707]
test string-11.51.$noComp {string match; *, -nocase and UTF-8} {
    run {string match -nocase [binary format I 717316707] \
	    [binary format I 2028036707]}
} 1
test string-11.52 {string match, null char in string} {
test string-11.52.$noComp {string match, null char in string} {
    set out ""
    set ptn "*abc*"
    foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] {
	lappend out [string match $ptn $elem]
	lappend out [run {string match $ptn $elem}]
    }
    set out
} {1 1 1 1}
test string-11.53 {string match, null char in pattern} {
test string-11.53.$noComp {string match, null char in pattern} {
    set out ""
    foreach {ptn elem} [list \
	    "*\u0000abc\u0000"  "\u0000abc\u0000" \
	    "*\u0000abc\u0000"  "\u0000abc\u0000ef" \
	    "*\u0000abc\u0000*" "\u0000abc\u0000ef" \
	    "*\u0000abc\u0000"  "@\u0000abc\u0000ef" \
	    "*\u0000abc\u0000*"  "@\u0000abc\u0000ef" \
	    ] {
	lappend out [string match $ptn $elem]
	lappend out [run {string match $ptn $elem}]
    }
    set out
} {1 0 1 0 1}
test string-11.54 {string match, failure} {
test string-11.54.$noComp {string match, failure} {
    set longString ""
    for {set i 0} {$i < 10} {incr i} {
	append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123"
    }
    string first $longString 123
    list [string match *cba* $longString] \
	    [string match *a*l*\u0000* $longString] \
	    [string match *a*l*\u0000*123 $longString] \
	    [string match *a*l*\u0000*123* $longString] \
	    [string match *a*l*\u0000*cba* $longString] \
	    [string match *===* $longString]
    run {string first $longString 123}
    list [run {string match *cba* $longString}] \
	    [run {string match *a*l*\u0000* $longString}] \
	    [run {string match *a*l*\u0000*123 $longString}] \
	    [run {string match *a*l*\u0000*123* $longString}] \
	    [run {string match *a*l*\u0000*cba* $longString}] \
	    [run {string match *===* $longString}]
} {0 1 1 1 0 0}
test string-11.55.$noComp {string match, invalid binary optimization} {
    [format string] match \u0141 [binary format c 65]
} 0

test stringComp-12.1.0.$noComp {Bug 3588366: end-offsets before start} {
    apply {s {
test string-12.1 {string range} {
    list [catch {string range} msg] $msg
        string range $s 0 end-5
    }} 12345
} {}
test string-12.1.$noComp {string range} {
    list [catch {run {string range}} msg] $msg
} {1 {wrong # args: should be "string range string first last"}}
test string-12.2 {string range} {
    list [catch {string range a 1} msg] $msg
test string-12.2.$noComp {string range} {
    list [catch {run {string range a 1}} msg] $msg
} {1 {wrong # args: should be "string range string first last"}}
test string-12.3 {string range} {
    list [catch {string range a 1 2 3} msg] $msg
test string-12.3.$noComp {string range} {
    list [catch {run {string range a 1 2 3}} msg] $msg
} {1 {wrong # args: should be "string range string first last"}}
test string-12.4 {string range} {
    string range abcdefghijklmnop 2 14
test string-12.4.$noComp {string range} {
    run {string range abcdefghijklmnop 2 14}
} {cdefghijklmno}
test string-12.5 {string range, last > length} {
    string range abcdefghijklmnop 7 1000
test string-12.5.$noComp {string range, last > length} {
    run {string range abcdefghijklmnop 7 1000}
} {hijklmnop}
test string-12.6 {string range} {
    string range abcdefghijklmnop 10 end
test string-12.6.$noComp {string range} {
    run {string range abcdefghijklmnop 10 end}
} {klmnop}
test string-12.7 {string range, last < first} {
    string range abcdefghijklmnop 10 9
test string-12.7.$noComp {string range, last < first} {
    run {string range abcdefghijklmnop 10 9}
} {}
test string-12.8 {string range, first < 0} {
    string range abcdefghijklmnop -3 2
test string-12.8.$noComp {string range, first < 0} {
    run {string range abcdefghijklmnop -3 2}
} {abc}
test string-12.9 {string range} {
    string range abcdefghijklmnop -3 -2
test string-12.9.$noComp {string range} {
    run {string range abcdefghijklmnop -3 -2}
} {}
test string-12.10 {string range} {
    string range abcdefghijklmnop 1000 1010
test string-12.10.$noComp {string range} {
    run {string range abcdefghijklmnop 1000 1010}
} {}
test string-12.11 {string range} {
    string range abcdefghijklmnop -100 end
test string-12.11.$noComp {string range} {
    run {string range abcdefghijklmnop -100 end}
} {abcdefghijklmnop}
test string-12.12 {string range} {
    list [catch {string range abc abc 1} msg] $msg
test string-12.12.$noComp {string range} {
    list [catch {run {string range abc abc 1}} msg] $msg
} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
test string-12.13 {string range} {
    list [catch {string range abc 1 eof} msg] $msg
test string-12.13.$noComp {string range} {
    list [catch {run {string range abc 1 eof}} msg] $msg
} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
test string-12.14 {string range} {
    string range abcdefghijklmnop end-1 end
test string-12.14.$noComp {string range} {
    run {string range abcdefghijklmnop end-1 end}
} {op}
test string-12.15 {string range} {
    string range abcdefghijklmnop end 1000
test string-12.15.$noComp {string range} {
    run {string range abcdefghijklmnop end 1000}
} {p}
test string-12.16 {string range} {
    string range abcdefghijklmnop end end-1
test string-12.16.$noComp {string range} {
    run {string range abcdefghijklmnop end end-1}
} {}
test string-12.17 {string range, unicode} {
    string range ab\u7266cdefghijklmnop 5 5
test string-12.17.$noComp {string range, unicode} {
    run {string range ab\u7266cdefghijklmnop 5 5}
} e
test string-12.18 {string range, unicode} {
    string range ab\u7266cdefghijklmnop 2 3
test string-12.18.$noComp {string range, unicode} {
    run {string range ab\u7266cdefghijklmnop 2 3}
} \u7266c
test string-12.19 {string range, bytearray object} {
test string-12.19.$noComp {string range, bytearray object} {
    set b [binary format I* {0x50515253 0x52}]
    set r1 [string range $b 1 end-1]
    set r2 [string range $b 1 6]
    string equal $r1 $r2
    set r1 [run {string range $b 1 end-1}]
    set r2 [run {string range $b 1 6}]
    run {string equal $r1 $r2}
} 1
test string-12.20 {string range, out of bounds indices} {
    string range \u00ff 0 1
test string-12.20.$noComp {string range, out of bounds indices} {
    run {string range \u00ff 0 1}
} \u00ff
# Bug 1410553
test string-12.21 {string range, regenerates correct reps, bug 1410553} {
test string-12.21.$noComp {string range, regenerates correct reps, bug 1410553} {
    set bytes "\x00 \x03 \x41"
    set rxBuffer {}
    foreach ch $bytes {
	append rxBuffer $ch
	if {$ch eq "\x03"} {
	    string length $rxBuffer
	    run {string length $rxBuffer}
	}
    }
    set rxCRC [string range $rxBuffer end-1 end]
    set rxCRC [run {string range $rxBuffer end-1 end}]
    binary scan [join $bytes {}] "H*" input_hex
    binary scan $rxBuffer "H*" rxBuffer_hex
    binary scan $rxCRC "H*" rxCRC_hex
    list $input_hex $rxBuffer_hex $rxCRC_hex
} {000341 000341 0341}
test string-12.22 {string range, shimmering binary/index} {
test string-12.22.$noComp {string range, shimmering binary/index} {
    set s 0000000001
    binary scan $s a* x
    string range $s $s end
    run {string range $s $s end}
} 000000001
test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} tip389 {
    run {list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]}
} [list \U100000 {} b]

test string-13.1 {string repeat} {
    list [catch {string repeat} msg] $msg
test string-13.1.$noComp {string repeat} {
    list [catch {run {string repeat}} msg] $msg
} {1 {wrong # args: should be "string repeat string count"}}
test string-13.2 {string repeat} {
    list [catch {string repeat abc 10 oops} msg] $msg
test string-13.2.$noComp {string repeat} {
    list [catch {run {string repeat abc 10 oops}} msg] $msg
} {1 {wrong # args: should be "string repeat string count"}}
test string-13.3 {string repeat} {
    string repeat {} 100
test string-13.3.$noComp {string repeat} {
    run {string repeat {} 100}
} {}
test string-13.4 {string repeat} {
    string repeat { } 5
test string-13.4.$noComp {string repeat} {
    run {string repeat { } 5}
} {     }
test string-13.5 {string repeat} {
    string repeat abc 3
test string-13.5.$noComp {string repeat} {
    run {string repeat abc 3}
} {abcabcabc}
test string-13.6 {string repeat} {
    string repeat abc -1
test string-13.6.$noComp {string repeat} {
    run {string repeat abc -1}
} {}
test string-13.7 {string repeat} {
    list [catch {string repeat abc end} msg] $msg
test string-13.7.$noComp {string repeat} {
    list [catch {run {string repeat abc end}} msg] $msg
} {1 {expected integer but got "end"}}
test string-13.8 {string repeat} {
    string repeat {} -1000
test string-13.8.$noComp {string repeat} {
    run {string repeat {} -1000}
} {}
test string-13.9 {string repeat} {
    string repeat {} 0
test string-13.9.$noComp {string repeat} {
    run {string repeat {} 0}
} {}
test string-13.10 {string repeat} {
    string repeat def 0
test string-13.10.$noComp {string repeat} {
    run {string repeat def 0}
} {}
test string-13.11 {string repeat} {
    string repeat def 1
test string-13.11.$noComp {string repeat} {
    run {string repeat def 1}
} def
test string-13.12 {string repeat} {
    string repeat ab\u7266cd 3
test string-13.12.$noComp {string repeat} {
    run {string repeat ab\u7266cd 3}
} ab\u7266cdab\u7266cdab\u7266cd
test string-13.13 {string repeat} {
    string repeat \x00 3
test string-13.13.$noComp {string repeat} {
    run {string repeat \x00 3}
} \x00\x00\x00
test string-13.14 {string repeat} {
test string-13.14.$noComp {string repeat} {
    # The string range will ensure us that string repeat gets a unicode string
    string repeat [string range ab\u7266cd 2 3] 3
    run {string repeat [run {string range ab\u7266cd 2 3}] 3}
} \u7266c\u7266c\u7266c

test string-14.1 {string replace} {
    list [catch {string replace} msg] $msg
test string-14.1.$noComp {string replace} {
    list [catch {run {string replace}} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
test string-14.2 {string replace} {
    list [catch {string replace a 1} msg] $msg
test string-14.2.$noComp {string replace} {
    list [catch {run {string replace a 1}} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
test string-14.3 {string replace} {
    list [catch {string replace a 1 2 3 4} msg] $msg
test string-14.3.$noComp {string replace} {
    list [catch {run {string replace a 1 2 3 4}} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
test string-14.4 {string replace} {
test string-14.4.$noComp {string replace} {
} {}
test string-14.5 {string replace} {
    string replace abcdefghijklmnop 2 14
test string-14.5.$noComp {string replace} {
    run {string replace abcdefghijklmnop 2 14}
} {abp}
test string-14.6 {string replace} {
    string replace abcdefghijklmnop 7 1000
test string-14.6.$noComp {string replace} {
    run {string replace abcdefghijklmnop 7 1000}
} {abcdefg}
test string-14.7 {string replace} {
    string replace abcdefghijklmnop 10 end
test string-14.7.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 end}
} {abcdefghij}
test string-14.8 {string replace} {
    string replace abcdefghijklmnop 10 9
test string-14.8.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 9}
} {abcdefghijklmnop}
test string-14.9 {string replace} {
    string replace abcdefghijklmnop -3 2
test string-14.9.$noComp {string replace} {
    run {string replace abcdefghijklmnop -3 2}
} {defghijklmnop}
test string-14.10 {string replace} {
    string replace abcdefghijklmnop -3 -2
test string-14.10.$noComp {string replace} {
    run {string replace abcdefghijklmnop -3 -2}
} {abcdefghijklmnop}
test string-14.11 {string replace} {
    string replace abcdefghijklmnop 1000 1010
test string-14.11.$noComp {string replace} {
    run {string replace abcdefghijklmnop 1000 1010}
} {abcdefghijklmnop}
test string-14.12 {string replace} {
    string replace abcdefghijklmnop -100 end
test string-14.12.$noComp {string replace} {
    run {string replace abcdefghijklmnop -100 end}
} {}
test string-14.13 {string replace} {
    list [catch {string replace abc abc 1} msg] $msg
test string-14.13.$noComp {string replace} {
    list [catch {run {string replace abc abc 1}} msg] $msg
} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
test string-14.14 {string replace} {
    list [catch {string replace abc 1 eof} msg] $msg
test string-14.14.$noComp {string replace} {
    list [catch {run {string replace abc 1 eof}} msg] $msg
} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
test string-14.15 {string replace} {
    string replace abcdefghijklmnop end-10 end-2 NEW
test string-14.15.$noComp {string replace} {
    run {string replace abcdefghijklmnop end-10 end-2 NEW}
} {abcdeNEWop}
test string-14.16 {string replace} {
    string replace abcdefghijklmnop 0 end foo
test string-14.16.$noComp {string replace} {
    run {string replace abcdefghijklmnop 0 end foo}
} {foo}
test string-14.17 {string replace} {
    string replace abcdefghijklmnop end end-1
test string-14.17.$noComp {string replace} {
    run {string replace abcdefghijklmnop end end-1}
} {abcdefghijklmnop}
test string-14.18 {string replace} {
    string replace abcdefghijklmnop 10 9 XXX
test string-14.18.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 9 XXX}
} {abcdefghijklmnop}
test string-14.19.$noComp {string replace} {
    run {string replace {} -1 0 A}
} A
test string-14.20.$noComp {string replace} {
    run {string replace [makeByteArray abcdefghijklmnop] end-10 end-2\
	    [makeByteArray NEW]}
} {abcdeNEWop}

test string-15.1 {string tolower too few args} {
    list [catch {string tolower} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.2 {string tolower bad args} {
    list [catch {string tolower a b} msg] $msg

test stringComp-14.21.$noComp {Bug 82e7f67325} {
    apply {x {
        set a [join $x {}]
        lappend b [string length [string replace ___! 0 2 $a]]
        lappend b [string length [string replace ___! 0 2 $a[unset a]]]
    }} {a b}
} {3 3}
test stringComp-14.22.$noComp {Bug 82e7f67325} memory {
    # As in stringComp-14.1, but make sure we don't retain too many refs
    leaktest {
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
test string-15.3 {string tolower too many args} {
    list [catch {string tolower ABC 1 end oops} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.4 {string tolower} {
    string tolower ABCDeF
        apply {x {
            set a [join $x {}]
            lappend b [string length [string replace ___! 0 2 $a]]
            lappend b [string length [string replace ___! 0 2 $a[unset a]]]
        }} {a b}
    }
} {0}
test stringComp-14.23.$noComp {Bug 0dca3bfa8f} {
    apply {arg {
        set argCopy $arg
        set arg [string replace $arg 1 2 aa]
        # Crashes in comparison before fix
        expr {$arg ne $argCopy}
    }} abcde
} 1
test stringComp-14.24.$noComp {Bug 1af8de570511} {
    apply {{x y} {
        # Generate an unshared string value
        set val ""
        for { set i 0 } { $i < $x } { incr i } {
            set val [format "0%s" $val]
        }
        string replace $val[unset val] 1 1 $y
    }} 4 x
} 0x00
test stringComp-14.25.$noComp {} {
    string length [string replace [string repeat a\u00fe 2] 3 end {}]
} 3

test string-15.1.$noComp {string tolower too few args} {
    list [catch {run {string tolower}} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.2.$noComp {string tolower bad args} {
    list [catch {run {string tolower a b}} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
test string-15.3.$noComp {string tolower too many args} {
    list [catch {run {string tolower ABC 1 end oops}} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.4.$noComp {string tolower} {
    run {string tolower ABCDeF}
} {abcdef}
test string-15.5 {string tolower} {
    string tolower "ABC  XyZ"
test string-15.5.$noComp {string tolower} {
    run {string tolower "ABC  XyZ"}
} {abc  xyz}
test string-15.6 {string tolower} {
    string tolower {123#$&*()}
test string-15.6.$noComp {string tolower} {
    run {string tolower {123#$&*()}}
} {123#$&*()}
test string-15.7 {string tolower} {
    string tolower ABC 1
test string-15.7.$noComp {string tolower} {
    run {string tolower ABC 1}
} AbC
test string-15.8 {string tolower} {
    string tolower ABC 1 end
test string-15.8.$noComp {string tolower} {
    run {string tolower ABC 1 end}
} Abc
test string-15.9 {string tolower} {
    string tolower ABC 0 end-1
test string-15.9.$noComp {string tolower} {
    run {string tolower ABC 0 end-1}
} abC
test string-15.10 {string tolower, unicode} {
     string tolower ABCabc\xc7\xe7
test string-15.10.$noComp {string tolower, unicode} {
     run {string tolower ABCabc\xc7\xe7}
} "abcabc\xe7\xe7"
test string-15.11 {string tolower, compiled} {
    lindex [string tolower [list A B [list C]]] 1
test string-15.11.$noComp {string tolower, compiled} {
    lindex [run {string tolower [list A B [list C]]}] 1
} b

test string-16.1 {string toupper} {
    list [catch {string toupper} msg] $msg
test string-16.1.$noComp {string toupper} {
    list [catch {run {string toupper}} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
test string-16.2 {string toupper} {
    list [catch {string toupper a b} msg] $msg
test string-16.2.$noComp {string toupper} {
    list [catch {run {string toupper a b}} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
test string-16.3 {string toupper} {
    list [catch {string toupper a 1 end oops} msg] $msg
test string-16.3.$noComp {string toupper} {
    list [catch {run {string toupper a 1 end oops}} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
test string-16.4 {string toupper} {
    string toupper abCDEf
test string-16.4.$noComp {string toupper} {
    run {string toupper abCDEf}
} {ABCDEF}
test string-16.5 {string toupper} {
    string toupper "abc xYz"
test string-16.5.$noComp {string toupper} {
    run {string toupper "abc xYz"}
} {ABC XYZ}
test string-16.6 {string toupper} {
    string toupper {123#$&*()}
test string-16.6.$noComp {string toupper} {
    run {string toupper {123#$&*()}}
} {123#$&*()}
test string-16.7 {string toupper} {
    string toupper abc 1
test string-16.7.$noComp {string toupper} {
    run {string toupper abc 1}
} aBc
test string-16.8 {string toupper} {
    string toupper abc 1 end
test string-16.8.$noComp {string toupper} {
    run {string toupper abc 1 end}
} aBC
test string-16.9 {string toupper} {
    string toupper abc 0 end-1
test string-16.9.$noComp {string toupper} {
    run {string toupper abc 0 end-1}
} ABc
test string-16.10 {string toupper, unicode} {
    string toupper ABCabc\xc7\xe7
test string-16.10.$noComp {string toupper, unicode} {
    run {string toupper ABCabc\xc7\xe7}
} "ABCABC\xc7\xc7"
test string-16.11 {string toupper, compiled} {
    lindex [string toupper [list a b [list c]]] 1
test string-16.11.$noComp {string toupper, compiled} {
    lindex [run {string toupper [list a b [list c]]}] 1
} B

test string-17.1 {string totitle} {
    list [catch {string totitle} msg] $msg
test string-17.1.$noComp {string totitle} {
    list [catch {run {string totitle}} msg] $msg
} {1 {wrong # args: should be "string totitle string ?first? ?last?"}}
test string-17.2 {string totitle} {
    list [catch {string totitle a b} msg] $msg
test string-17.2.$noComp {string totitle} {
    list [catch {run {string totitle a b}} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
test string-17.3 {string totitle} {
    string totitle abCDEf
test string-17.3.$noComp {string totitle} {
    run {string totitle abCDEf}
} {Abcdef}
test string-17.4 {string totitle} {
    string totitle "abc xYz"
test string-17.4.$noComp {string totitle} {
    run {string totitle "abc xYz"}
} {Abc xyz}
test string-17.5 {string totitle} {
    string totitle {123#$&*()}
test string-17.5.$noComp {string totitle} {
    run {string totitle {123#$&*()}}
} {123#$&*()}
test string-17.6 {string totitle, unicode} {
    string totitle ABCabc\xc7\xe7
test string-17.6.$noComp {string totitle, unicode} {
    run {string totitle ABCabc\xc7\xe7}
} "Abcabc\xe7\xe7"
test string-17.7 {string totitle, unicode} {
    string totitle \u01f3BCabc\xc7\xe7
test string-17.7.$noComp {string totitle, unicode} {
    run {string totitle \u01f3BCabc\xc7\xe7}
} "\u01f2bcabc\xe7\xe7"
test string-17.8 {string totitle, compiled} {
    lindex [string totitle [list aa bb [list cc]]] 0
test string-17.8.$noComp {string totitle, compiled} {
    lindex [run {string totitle [list aa bb [list cc]]}] 0
} Aa
test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} tip389 {
    run {list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \
	[string totitle a\U118c0c 3 3]}
} [list a\U118a0c a\U118c0C a\U118c0C]

test string-18.1 {string trim} {
    list [catch {string trim} msg] $msg
test string-18.1.$noComp {string trim} {
    list [catch {run {string trim}} msg] $msg
} {1 {wrong # args: should be "string trim string ?chars?"}}
test string-18.2 {string trim} {
    list [catch {string trim a b c} msg] $msg
test string-18.2.$noComp {string trim} {
    list [catch {run {string trim a b c}} msg] $msg
} {1 {wrong # args: should be "string trim string ?chars?"}}
test string-18.3 {string trim} {
    string trim "    XYZ      "
test string-18.3.$noComp {string trim} {
    run {string trim "    XYZ      "}
} {XYZ}
test string-18.4 {string trim} {
    string trim "\t\nXYZ\t\n\r\n"
test string-18.4.$noComp {string trim} {
    run {string trim "\t\nXYZ\t\n\r\n"}
} {XYZ}
test string-18.5 {string trim} {
    string trim "  A XYZ A    "
test string-18.5.$noComp {string trim} {
    run {string trim "  A XYZ A    "}
} {A XYZ A}
test string-18.6 {string trim} {
    string trim "XXYYZZABC XXYYZZ" ZYX
test string-18.6.$noComp {string trim} {
    run {string trim "XXYYZZABC XXYYZZ" ZYX}
} {ABC }
test string-18.7 {string trim} {
    string trim "    \t\r      "
test string-18.7.$noComp {string trim} {
    run {string trim "    \t\r      "}
} {}
test string-18.8 {string trim} {
    string trim {abcdefg} {}
test string-18.8.$noComp {string trim} {
    run {string trim {abcdefg} {}}
} {abcdefg}
test string-18.9 {string trim} {
    string trim {}
test string-18.9.$noComp {string trim} {
    run {string trim {}}
} {}
test string-18.10 {string trim} {
    string trim ABC DEF
test string-18.10.$noComp {string trim} {
    run {string trim ABC DEF}
} {ABC}
test string-18.11 {string trim, unicode} {
    string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8
test string-18.11.$noComp {string trim, unicode} {
    run {string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8}
} " AB\xe7C "
test string-18.12 {string trim, unicode default} {
    string trim \ufeff\x00\u0085\u00a0\u1680\u180eABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000
test string-18.12.$noComp {string trim, unicode default} {
    run {string trim \ufeff\x00\u0085\u00a0\u1680\u180eABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000}
} ABC\u1361

test string-19.1 {string trimleft} {
    list [catch {string trimleft} msg] $msg
test string-19.1.$noComp {string trimleft} {
    list [catch {run {string trimleft}} msg] $msg
} {1 {wrong # args: should be "string trimleft string ?chars?"}}
test string-19.2 {string trimleft} {
    string trimleft "    XYZ      "
test string-19.2.$noComp {string trimleft} {
    run {string trimleft "    XYZ      "}
} {XYZ      }
test string-19.3 {string trimleft, unicode default} {
    string trimleft \ufeff\u0085\u00a0\x00\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000\u1361ABC
test string-19.3.$noComp {string trimleft, unicode default} {
    run {string trimleft \ufeff\u0085\u00a0\x00\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000\u1361ABC}
} \u1361ABC

test string-20.1 {string trimright errors} {
    list [catch {string trimright} msg] $msg
test string-20.1.$noComp {string trimright errors} {
    list [catch {run {string trimright}} msg] $msg
} {1 {wrong # args: should be "string trimright string ?chars?"}}
test string-20.2 {string trimright errors} {
    list [catch {string trimg a} msg] $msg
test string-20.2.$noComp {string trimright errors} {
    list [catch {run {string trimg a}} msg] $msg
} {1 {unknown or ambiguous subcommand "trimg": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-20.3 {string trimright} {
    string trimright "    XYZ      "
test string-20.3.$noComp {string trimright} {
    run {string trimright "    XYZ      "}
} {    XYZ}
test string-20.4 {string trimright} {
    string trimright "   "
test string-20.4.$noComp {string trimright} {
    run {string trimright "   "}
} {}
test string-20.5 {string trimright} {
    string trimright ""
test string-20.5.$noComp {string trimright} {
    run {string trimright ""}
} {}
test string-20.6 {string trimright, unicode default} {
    string trimright ABC\u1361\u0085\x00\u00a0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000
test string-20.6.$noComp {string trimright, unicode default} {
    run {string trimright ABC\u1361\u0085\x00\u00a0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000}
} ABC\u1361

test string-21.1 {string wordend} {
    list [catch {string wordend a} msg] $msg
test string-21.1.$noComp {string wordend} {
    list [catch {run {string wordend a}} msg] $msg
} {1 {wrong # args: should be "string wordend string index"}}
test string-21.2 {string wordend} {
    list [catch {string wordend a b c} msg] $msg
test string-21.2.$noComp {string wordend} {
    list [catch {run {string wordend a b c}} msg] $msg
} {1 {wrong # args: should be "string wordend string index"}}
test string-21.3 {string wordend} {
    list [catch {string wordend a gorp} msg] $msg
test string-21.3.$noComp {string wordend} {
    list [catch {run {string wordend a gorp}} msg] $msg
} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
test string-21.4 {string wordend} {
    string wordend abc. -1
test string-21.4.$noComp {string wordend} {
    run {string wordend abc. -1}
} 3
test string-21.5 {string wordend} {
    string wordend abc. 100
test string-21.5.$noComp {string wordend} {
    run {string wordend abc. 100}
} 4
test string-21.6 {string wordend} {
    string wordend "word_one two three" 2
test string-21.6.$noComp {string wordend} {
    run {string wordend "word_one two three" 2}
} 8
test string-21.7 {string wordend} {
    string wordend "one .&# three" 5
} 6
test string-21.8 {string wordend} {
    string worde "x.y" 0
test string-21.7.$noComp {string wordend} {
    run {string wordend "one .&# three" 5}
} 6
test string-21.8.$noComp {string wordend} {
    run {string worde "x.y" 0}
} 1
test string-21.9 {string wordend} {
    string worde "x.y" end-1
test string-21.9.$noComp {string wordend} {
    run {string worde "x.y" end-1}
} 2
test string-21.10 {string wordend, unicode} {
    string wordend "xyz\u00c7de fg" 0
test string-21.10.$noComp {string wordend, unicode} {
    run {string wordend "xyz\u00c7de fg" 0}
} 6
test string-21.11 {string wordend, unicode} {
    string wordend "xyz\uc700de fg" 0
test string-21.11.$noComp {string wordend, unicode} {
    run {string wordend "xyz\uc700de fg" 0}
} 6
test string-21.12 {string wordend, unicode} {
    string wordend "xyz\u203fde fg" 0
test string-21.12.$noComp {string wordend, unicode} {
    run {string wordend "xyz\u203fde fg" 0}
} 6
test string-21.13 {string wordend, unicode} {
    string wordend "xyz\u2045de fg" 0
test string-21.13.$noComp {string wordend, unicode} {
    run {string wordend "xyz\u2045de fg" 0}
} 3
test string-21.14 {string wordend, unicode} {
    string wordend "\uc700\uc700 abc" 8
test string-21.14.$noComp {string wordend, unicode} {
    run {string wordend "\uc700\uc700 abc" 8}
} 6

test string-22.1 {string wordstart} {
    list [catch {string word a} msg] $msg
test string-22.1.$noComp {string wordstart} {
    list [catch {run {string word a}} msg] $msg
} {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-22.2 {string wordstart} {
    list [catch {string wordstart a} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3 {string wordstart} {
    list [catch {string wordstart a b c} msg] $msg
test string-22.2.$noComp {string wordstart} {
    list [catch {run {string wordstart a}} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3.$noComp {string wordstart} {
    list [catch {run {string wordstart a b c}} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4 {string wordstart} {
    list [catch {string wordstart a gorp} msg] $msg
test string-22.4.$noComp {string wordstart} {
    list [catch {run {string wordstart a gorp}} msg] $msg
} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
test string-22.5 {string wordstart} {
    string wordstart "one two three_words" 400
test string-22.5.$noComp {string wordstart} {
    run {string wordstart "one two three_words" 400}
} 8
test string-22.6 {string wordstart} {
    string wordstart "one two three_words" 2
test string-22.6.$noComp {string wordstart} {
    run {string wordstart "one two three_words" 2}
} 0
test string-22.7 {string wordstart} {
    string wordstart "one two three_words" -2
test string-22.7.$noComp {string wordstart} {
    run {string wordstart "one two three_words" -2}
} 0
test string-22.8 {string wordstart} {
    string wordstart "one .*&^ three" 6
test string-22.8.$noComp {string wordstart} {
    run {string wordstart "one .*&^ three" 6}
} 6
test string-22.9 {string wordstart} {
    string wordstart "one two three" 4
test string-22.9.$noComp {string wordstart} {
    run {string wordstart "one two three" 4}
} 4
test string-22.10 {string wordstart} {
    string wordstart "one two three" end-5
test string-22.10.$noComp {string wordstart} {
    run {string wordstart "one two three" end-5}
} 7
test string-22.11 {string wordstart, unicode} {
    string wordstart "one tw\u00c7o three" 7
test string-22.11.$noComp {string wordstart, unicode} {
    run {string wordstart "one tw\u00c7o three" 7}
} 4
test string-22.12 {string wordstart, unicode} {
    string wordstart "ab\uc700\uc700 cdef ghi" 12
test string-22.12.$noComp {string wordstart, unicode} {
    run {string wordstart "ab\uc700\uc700 cdef ghi" 12}
} 10
test string-22.13 {string wordstart, unicode} {
    string wordstart "\uc700\uc700 abc" 8
test string-22.13.$noComp {string wordstart, unicode} {
    run {string wordstart "\uc700\uc700 abc" 8}
} 3

test string-23.0 {string is boolean, Bug 1187123} testindexobj {
test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj {
    set x 5
    catch {testindexobj $x foo bar soom}
    string is boolean $x
    run {string is boolean $x}
} 0
test string-23.1 {string is command with empty string} {
test string-23.1.$noComp {string is command with empty string} {
    set s ""
    list \
        [string is alnum $s] \
        [string is alpha $s] \
        [string is ascii $s] \
        [string is control $s] \
        [string is boolean $s] \
        [string is digit $s] \
        [string is double $s] \
        [string is false $s] \
        [string is graph $s] \
        [string is integer $s] \
        [string is lower $s] \
        [string is print $s] \
        [string is punct $s] \
        [string is space $s] \
        [string is true $s] \
        [string is upper $s] \
        [string is wordchar $s] \
        [string is xdigit $s] \
        [run {string is alnum $s}] \
        [run {string is alpha $s}] \
        [run {string is ascii $s}] \
        [run {string is control $s}] \
        [run {string is boolean $s}] \
        [run {string is digit $s}] \
        [run {string is double $s}] \
        [run {string is false $s}] \
        [run {string is graph $s}] \
        [run {string is integer $s}] \
        [run {string is lower $s}] \
        [run {string is print $s}] \
        [run {string is punct $s}] \
        [run {string is space $s}] \
        [run {string is true $s}] \
        [run {string is upper $s}] \
        [run {string is wordchar $s}] \
        [run {string is xdigit $s}] \

} {1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1}
test string-23.2 {string is command with empty string} {
test string-23.2.$noComp {string is command with empty string} {
    set s ""
    list \
        [string is alnum -strict $s] \
        [string is alpha -strict $s] \
        [string is ascii -strict $s] \
        [string is control -strict $s] \
        [string is boolean -strict $s] \
        [string is digit -strict $s] \
        [string is double -strict $s] \
        [string is false -strict $s] \
        [string is graph -strict $s] \
        [string is integer -strict $s] \
        [string is lower -strict $s] \
        [string is print -strict $s] \
        [string is punct -strict $s] \
        [string is space -strict $s] \
        [string is true -strict $s] \
        [string is upper -strict $s] \
        [string is wordchar -strict $s] \
        [string is xdigit -strict $s] \
        [run {string is alnum -strict $s}] \
        [run {string is alpha -strict $s}] \
        [run {string is ascii -strict $s}] \
        [run {string is control -strict $s}] \
        [run {string is boolean -strict $s}] \
        [run {string is digit -strict $s}] \
        [run {string is double -strict $s}] \
        [run {string is false -strict $s}] \
        [run {string is graph -strict $s}] \
        [run {string is integer -strict $s}] \
        [run {string is lower -strict $s}] \
        [run {string is print -strict $s}] \
        [run {string is punct -strict $s}] \
        [run {string is space -strict $s}] \
        [run {string is true -strict $s}] \
        [run {string is upper -strict $s}] \
        [run {string is wordchar -strict $s}] \
        [run {string is xdigit -strict $s}] \

} {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}

test string-24.1 {string reverse command} -body {
    string reverse
test string-24.1.$noComp {string reverse command} -body {
    run {string reverse}
} -returnCodes error -result "wrong # args: should be \"string reverse string\""
test string-24.2 {string reverse command} -body {
    string reverse a b
test string-24.2.$noComp {string reverse command} -body {
    run {string reverse a b}
} -returnCodes error -result "wrong # args: should be \"string reverse string\""
test string-24.3 {string reverse command - shared string} {
test string-24.3.$noComp {string reverse command - shared string} {
    set x abcde
    string reverse $x
    run {string reverse $x}
} edcba
test string-24.4 {string reverse command - unshared string} {
test string-24.4.$noComp {string reverse command - unshared string} {
    set x abc
    set y de
    string reverse $x$y
    run {string reverse $x$y}
} edcba
test string-24.5 {string reverse command - shared unicode string} {
test string-24.5.$noComp {string reverse command - shared unicode string} {
    set x abcde\ud0ad
    string reverse $x
    run {string reverse $x}
} \ud0adedcba
test string-24.6 {string reverse command - unshared string} {
test string-24.6.$noComp {string reverse command - unshared string} {
    set x abc
    set y de\ud0ad
    string reverse $x$y
    run {string reverse $x$y}
} \ud0adedcba
test string-24.7 {string reverse command - simple case} {
    string reverse a
test string-24.7.$noComp {string reverse command - simple case} {
    run {string reverse a}
} a
test string-24.8 {string reverse command - simple case} {
    string reverse \ud0ad
test string-24.8.$noComp {string reverse command - simple case} {
    run {string reverse \ud0ad}
} \ud0ad
test string-24.9 {string reverse command - simple case} {
    string reverse {}
test string-24.9.$noComp {string reverse command - simple case} {
    run {string reverse {}}
} {}
test string-24.10 {string reverse command - corner case} {
test string-24.10.$noComp {string reverse command - corner case} {
    set x \ubeef\ud0ad
    string reverse $x
    run {string reverse $x}
} \ud0ad\ubeef
test string-24.11 {string reverse command - corner case} {
test string-24.11.$noComp {string reverse command - corner case} {
    set x \ubeef
    set y \ud0ad
    string reverse $x$y
    run {string reverse $x$y}
} \ud0ad\ubeef
test string-24.12 {string reverse command - corner case} {
test string-24.12.$noComp {string reverse command - corner case} {
    set x \ubeef
    set y \ud0ad
    string is ascii [string reverse $x$y]
    run {string is ascii [run {string reverse $x$y}]}
} 0
test string-24.13 {string reverse command - pure Unicode string} {
    string reverse [string range \ubeef\ud0ad\ubeef\ud0ad\ubeef\ud0ad 1 5]
test string-24.13.$noComp {string reverse command - pure Unicode string} {
    run {string reverse [run {string range \ubeef\ud0ad\ubeef\ud0ad\ubeef\ud0ad 1 5}]}
} \ud0ad\ubeef\ud0ad\ubeef\ud0ad
test string-24.14 {string reverse command - pure bytearray} {
    binary scan [string reverse [binary format H* 010203]] H* x
test string-24.14.$noComp {string reverse command - pure bytearray} {
    binary scan [run {string reverse [binary format H* 010203]}] H* x
    set x
} 030201
test string-24.15 {string reverse command - pure bytearray} {
    binary scan [tcl::string::reverse [binary format H* 010203]] H* x
test string-24.15.$noComp {string reverse command - pure bytearray} {
    binary scan [run {tcl::string::reverse [binary format H* 010203]}] H* x
    set x
} 030201

test string-25.1 {string is list} {
    string is list {a b c}
test string-25.1.$noComp {string is list} {
    run {string is list {a b c}}
} 1
test string-25.2 {string is list} {
    string is list "a \{b c"
test string-25.2.$noComp {string is list} {
    run {string is list "a \{b c"}
} 0
test string-25.3 {string is list} {
    string is list {a {b c}d e}
test string-25.3.$noComp {string is list} {
    run {string is list {a {b c}d e}}
} 0
test string-25.4 {string is list} {
    string is list {}
test string-25.4.$noComp {string is list} {
    run {string is list {}}
} 1
test string-25.5 {string is list} {
    string is list -strict {a b c}
test string-25.5.$noComp {string is list} {
    run {string is list -strict {a b c}}
} 1
test string-25.6 {string is list} {
    string is list -strict "a \{b c"
test string-25.6.$noComp {string is list} {
    run {string is list -strict "a \{b c"}
} 0
test string-25.7 {string is list} {
    string is list -strict {a {b c}d e}
test string-25.7.$noComp {string is list} {
    run {string is list -strict {a {b c}d e}}
} 0
test string-25.8 {string is list} {
    string is list -strict {}
test string-25.8.$noComp {string is list} {
    run {string is list -strict {}}
} 1
test string-25.9 {string is list} {
test string-25.9.$noComp {string is list} {
    set x {}
    list [string is list -failindex x {a b c}] $x
    list [run {string is list -failindex x {a b c}}] $x
} {1 {}}
test string-25.10 {string is list} {
test string-25.10.$noComp {string is list} {
    set x {}
    list [string is list -failindex x "a \{b c"] $x
    list [run {string is list -failindex x "a \{b c"}] $x
} {0 2}
test string-25.11 {string is list} {
test string-25.11.$noComp {string is list} {
    set x {}
    list [string is list -failindex x {a b {b c}d e}] $x
    list [run {string is list -failindex x {a b {b c}d e}}] $x
} {0 4}
test string-25.12 {string is list} {
test string-25.12.$noComp {string is list} {
    set x {}
    list [string is list -failindex x {}] $x
    list [run {string is list -failindex x {}}] $x
} {1 {}}
test string-25.13 {string is list} {
test string-25.13.$noComp {string is list} {
    set x {}
    list [string is list -failindex x {  {b c}d e}] $x
    list [run {string is list -failindex x {  {b c}d e}}] $x
} {0 2}
test string-25.14 {string is list} {
test string-25.14.$noComp {string is list} {
    set x {}
    list [string is list -failindex x "\uabcd {b c}d e"] $x
    list [run {string is list -failindex x "\uabcd {b c}d e"}] $x
} {0 2}

test string-26.1 {tcl::prefix, too few args} -body {
test string-26.1.$noComp {tcl::prefix, too few args} -body {
    tcl::prefix match a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix match ?options? table string"}
test string-26.2 {tcl::prefix, bad args} -body {
test string-26.2.$noComp {tcl::prefix, bad args} -body {
    tcl::prefix match a b c
} -returnCodes 1 -result {bad option "a": must be -error, -exact, or -message}
test string-26.2.1 {tcl::prefix, empty table} -body {
test string-26.2.1.$noComp {tcl::prefix, empty table} -body {
    tcl::prefix match {} foo
} -returnCodes 1 -result {bad option "foo": no valid options}
test string-26.3 {tcl::prefix, bad args} -body {
test string-26.3.$noComp {tcl::prefix, bad args} -body {
    tcl::prefix match -error "{}x" -exact str1 str2
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
test string-26.3.1 {tcl::prefix, bad args} -body {
test string-26.3.1.$noComp {tcl::prefix, bad args} -body {
    tcl::prefix match -error "x" -exact str1 str2
} -returnCodes 1 -result {error options must have an even number of elements}
test string-26.3.2 {tcl::prefix, bad args} -body {
test string-26.3.2.$noComp {tcl::prefix, bad args} -body {
    tcl::prefix match -error str1 str2
} -returnCodes 1 -result {missing value for -error}
test string-26.4 {tcl::prefix, bad args} -body {
test string-26.4.$noComp {tcl::prefix, bad args} -body {
    tcl::prefix match -message str1 str2
} -returnCodes 1 -result {missing value for -message}
test string-26.5 {tcl::prefix} {
test string-26.5.$noComp {tcl::prefix} {
    tcl::prefix match {apa bepa cepa depa} cepa
} cepa
test string-26.6 {tcl::prefix} {
test string-26.6.$noComp {tcl::prefix} {
    tcl::prefix match {apa bepa cepa depa} be
} bepa
test string-26.7 {tcl::prefix} -body {
test string-26.7.$noComp {tcl::prefix} -body {
    tcl::prefix match -exact {apa bepa cepa depa} be
} -returnCodes 1 -result {bad option "be": must be apa, bepa, cepa, or depa}
test string-26.8 {tcl::prefix} -body {
test string-26.8.$noComp {tcl::prefix} -body {
    tcl::prefix match -message wombat {apa bepa bear depa} be
} -returnCodes 1 -result {ambiguous wombat "be": must be apa, bepa, bear, or depa}
test string-26.9 {tcl::prefix} -body {
test string-26.9.$noComp {tcl::prefix} -body {
    tcl::prefix match -error {} {apa bepa bear depa} be
} -returnCodes 0 -result {}
test string-26.10 {tcl::prefix} -body {
test string-26.10.$noComp {tcl::prefix} -body {
    tcl::prefix match -error {-level 1} {apa bepa bear depa} be
} -returnCodes 2 -result {ambiguous option "be": must be apa, bepa, bear, or depa}
test string-26.10.1 {tcl::prefix} -setup {
test string-26.10.1.$noComp {tcl::prefix} -setup {
    proc _testprefix {args} {
        array set opts {-a x -b y -c y}
        foreach {opt val} $args {
            set opt [tcl::prefix match -error {-level 1} {-a -b -c} $opt]
            set opts($opt) $val
        }
        array get opts
1860
1861
1862
1863
1864
1865
1866
1867

1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888

1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906

1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919

1920
1921
1922

1923
1924
1925

1926
1927
1928

1929
1930
1931

1932
1933
1934

1935
1936
1937

1938
1939
1940

1941
1942
1943

1944
1945
1946

1947
1948
1949
1950

1951
1952
1953

1954
1955
1956

1957
1958
1959

1960
1961
1962

1963
1964
1965

1966
1967
1968

1969
1970
1971

1972
1973
1974

1975
1976
1977

1978
1979
1980

1981
1982
1983

1984
1985
1986

1987
1988
1989
1990
1991
1992


1993
1994

1995
1996

1997
1998

1999
2000

2001
2002

2003
2004
2005
2006
2007
2008
2009





2010
2011

2012
2013


2014
2015
2016


2017
2018
2019


2020
2021
2022


2023
2024
2025


2026
2027
2028


2029
2030

2031
2032

2033
2034

2035
2036

2037
2038
2039
2040



2041
2042

2043
2044
2045
2046
2047

2048
2049

2050
2051
2052
2053
2054
2055

2056
2057










2058
2059




2060
2061
2062
2063
2064
2065
2066
2110
2111
2112
2113
2114
2115
2116

2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137

2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155

2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168

2169
2170
2171

2172
2173
2174

2175
2176
2177

2178
2179
2180

2181
2182
2183

2184
2185
2186

2187
2188
2189

2190
2191
2192

2193
2194
2195

2196
2197
2198
2199

2200
2201
2202

2203
2204
2205

2206
2207
2208

2209
2210
2211

2212
2213
2214

2215
2216
2217

2218
2219
2220

2221
2222
2223

2224
2225
2226

2227
2228
2229

2230
2231
2232

2233
2234
2235

2236
2237
2238
2239
2240


2241
2242
2243

2244
2245

2246
2247

2248
2249

2250
2251

2252
2253
2254





2255
2256
2257
2258
2259
2260
2261
2262


2263
2264
2265


2266
2267
2268


2269
2270
2271


2272
2273
2274


2275
2276
2277


2278
2279
2280

2281
2282

2283
2284

2285
2286

2287
2288



2289
2290
2291
2292

2293
2294
2295
2296
2297

2298
2299

2300
2301
2302
2303
2304
2305

2306
2307

2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330







-
+




















-
+

















-
+












-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+



-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+




-
-
+
+

-
+

-
+

-
+

-
+

-
+


-
-
-
-
-
+
+
+
+
+


+
-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+

-
+

-
-
-
+
+
+

-
+




-
+

-
+





-
+

-
+
+
+
+
+
+
+
+
+
+


+
+
+
+







            set end [lindex [lindex [split [memory info] "\n"] 3] 3]
        }
        lappend res [expr {$end - $tmp}]
    }
    return $res
}

test string-26.11 {tcl::prefix: testing for leaks} -body {
test string-26.11.$noComp {tcl::prefix: testing for leaks} -body {
    # This test is made to stress object reference management
    MemStress {
        set table {hejj miff gurk}
        set item [lindex $table 1]
        # If not careful, this can cause a circular reference
        # that will cause a leak.
        tcl::prefix match $table $item
    } {
        # A similar case with nested lists
        set table2 {hejj {miff maff} gurk}
        set item [lindex [lindex $table2 1] 0]
        tcl::prefix match $table2 $item
    } {
        # A similar case with dict
        set table3 {hejj {miff maff} gurk2}
        set item [lindex [dict keys [lindex $table3 1]] 0]
        tcl::prefix match $table3 $item
    }
} -constraints memory -result {0 0 0}

test string-26.12 {tcl::prefix: testing for leaks} -body {
test string-26.12.$noComp {tcl::prefix: testing for leaks} -body {
    # This is a memory leak test in a form that might actually happen
    # in real code.  The shared literal "miff" causes a connection
    # between the item and the table.
    MemStress {
        proc stress1 {item} {
            set table [list hejj miff gurk]
            tcl::prefix match $table $item
        }
        proc stress2 {} {
            stress1 miff
        }
        stress2
        rename stress1 {}
        rename stress2 {}
    }
} -constraints memory -result 0

test string-26.13 {tcl::prefix: testing for leaks} -body {
test string-26.13.$noComp {tcl::prefix: testing for leaks} -body {
    # This test is made to stress object reference management
    MemStress {
        set table [list hejj miff]
        set item $table
        set error $table
        # Use the same objects in all places
        catch {
            tcl::prefix match -error $error $table $item
        }
    }
} -constraints memory -result {0}

test string-27.1 {tcl::prefix all, too few args} -body {
test string-27.1.$noComp {tcl::prefix all, too few args} -body {
    tcl::prefix all a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
test string-27.2 {tcl::prefix all, bad args} -body {
test string-27.2.$noComp {tcl::prefix all, bad args} -body {
    tcl::prefix all a b c
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
test string-27.3 {tcl::prefix all, bad args} -body {
test string-27.3.$noComp {tcl::prefix all, bad args} -body {
    tcl::prefix all "{}x" str2
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
test string-27.4 {tcl::prefix all} {
test string-27.4.$noComp {tcl::prefix all} {
    tcl::prefix all {apa bepa cepa depa} c
} cepa
test string-27.5 {tcl::prefix all} {
test string-27.5.$noComp {tcl::prefix all} {
    tcl::prefix all {apa bepa cepa depa} cepa
} cepa
test string-27.6 {tcl::prefix all} {
test string-27.6.$noComp {tcl::prefix all} {
    tcl::prefix all {apa bepa cepa depa} cepax
} {}
test string-27.7 {tcl::prefix all} {
test string-27.7.$noComp {tcl::prefix all} {
    tcl::prefix all {apa aska appa} a
} {apa aska appa}
test string-27.8 {tcl::prefix all} {
test string-27.8.$noComp {tcl::prefix all} {
    tcl::prefix all {apa aska appa} ap
} {apa appa}
test string-27.9 {tcl::prefix all} {
test string-27.9.$noComp {tcl::prefix all} {
    tcl::prefix all {apa aska appa} p
} {}
test string-27.10 {tcl::prefix all} {
test string-27.10.$noComp {tcl::prefix all} {
    tcl::prefix all {apa aska appa} {}
} {apa aska appa}

test string-28.1 {tcl::prefix longest, too few args} -body {
test string-28.1.$noComp {tcl::prefix longest, too few args} -body {
    tcl::prefix longest a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
test string-28.2 {tcl::prefix longest, bad args} -body {
test string-28.2.$noComp {tcl::prefix longest, bad args} -body {
    tcl::prefix longest a b c
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
test string-28.3 {tcl::prefix longest, bad args} -body {
test string-28.3.$noComp {tcl::prefix longest, bad args} -body {
    tcl::prefix longest "{}x" str2
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
test string-28.4 {tcl::prefix longest} {
test string-28.4.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa bepa cepa depa} c
} cepa
test string-28.5 {tcl::prefix longest} {
test string-28.5.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa bepa cepa depa} cepa
} cepa
test string-28.6 {tcl::prefix longest} {
test string-28.6.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa bepa cepa depa} cepax
} {}
test string-28.7 {tcl::prefix longest} {
test string-28.7.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa aska appa} a
} a
test string-28.8 {tcl::prefix longest} {
test string-28.8.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa aska appa} ap
} ap
test string-28.9 {tcl::prefix longest} {
test string-28.9.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa bska appa} a
} ap
test string-28.10 {tcl::prefix longest} {
test string-28.10.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa bska appa} {}
} {}
test string-28.11 {tcl::prefix longest} {
test string-28.11.$noComp {tcl::prefix longest} {
    tcl::prefix longest {{} bska appa} {}
} {}
test string-28.12 {tcl::prefix longest} {
test string-28.12.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa {} appa} {}
} {}
test string-28.13 {tcl::prefix longest} {
test string-28.13.$noComp {tcl::prefix longest} {
    # Test UTF8 handling
    tcl::prefix longest {ax\x90 bep ax\x91} a
} ax

test string-29.1 {string cat, no arg} {
    string cat
test string-29.1.$noComp {string cat, no arg} {
    run {string cat}
} ""
test string-29.2 {string cat, single arg} {
test string-29.2.$noComp {string cat, single arg} {
    set x FOO
    string compare $x [string cat $x]
    run {string compare $x [run {string cat $x}]}
} 0
test string-29.3 {string cat, two args} {
test string-29.3.$noComp {string cat, two args} {
    set x FOO
    string compare $x$x [string cat $x $x]
    run {string compare $x$x [run {string cat $x $x}]}
} 0
test string-29.4 {string cat, many args} {
test string-29.4.$noComp {string cat, many args} {
    set x FOO
    set n 260
    set xx [string repeat $x $n]
    set vv [string repeat {$x} $n]
    set vvs [string repeat {$x } $n]
    set r1 [string compare $xx [subst $vv]]
    set r2 [string compare $xx [eval "string cat $vvs"]]
    set xx [run {string repeat $x $n}]
    set vv [run {string repeat {$x} $n}]
    set vvs [run {string repeat {$x } $n}]
    set r1 [run {string compare $xx [subst $vv]}]
    set r2 [run {string compare $xx [eval "run {string cat $vvs}"]}]
    list $r1 $r2
} {0 0}
if {$noComp} {
test string-29.5 {string cat, efficiency} -body {
    tcl::unsupported::representation [string cat [list x] [list]]
test string-29.5.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list x] [list]}]
} -match glob -result {*no string representation}
test string-29.6 {string cat, efficiency} -body {
    tcl::unsupported::representation [string cat [list] [list x]]
test string-29.6.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list] [list x]}]
} -match glob -result {*no string representation}
test string-29.7 {string cat, efficiency} -body {
    tcl::unsupported::representation [string cat [list x] [list] [list]]
test string-29.7.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list x] [list] [list]}]
} -match glob -result {*no string representation}
test string-29.8 {string cat, efficiency} -body {
    tcl::unsupported::representation [string cat [list] [list x] [list]]
test string-29.8.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list] [list x] [list]}]
} -match glob -result {*no string representation}
test string-29.9 {string cat, efficiency} -body {
    tcl::unsupported::representation [string cat [list] [list] [list x]]
test string-29.9.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list] [list] [list x]}]
} -match glob -result {*no string representation}
test string-29.10 {string cat, efficiency} -body {
    tcl::unsupported::representation [string cat [list x] [list x]]
test string-29.10.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list x] [list x]}]
} -match glob -result {*, string representation "xx"}
test string-29.11 {string cat, efficiency} -body {
test string-29.11.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation \
	[string cat [list x] [encoding convertto utf-8 {}]]
	[run {string cat [list x] [encoding convertto utf-8 {}]}]
} -match glob -result {*no string representation}
test string-29.12 {string cat, efficiency} -body {
test string-29.12.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation \
	[string cat [encoding convertto utf-8 {}] [list x]]
	[run {string cat [encoding convertto utf-8 {}] [list x]}]
} -match glob -result {*, string representation "x"}
test string-29.13 {string cat, efficiency} -body {
    tcl::unsupported::representation [string cat \
	[encoding convertto utf-8 {}] [encoding convertto utf-8 {}] [list x]]
test string-29.13.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat \
	[encoding convertto utf-8 {}] [encoding convertto utf-8 {}] [list x]}]
} -match glob -result {*, string representation "x"}
test string-29.14 {string cat, efficiency} -setup {
test string-29.14.$noComp {string cat, efficiency} -setup {
    set e [encoding convertto utf-8 {}]
} -cleanup {
    unset e
} -body {
    tcl::unsupported::representation [string cat $e $e [list x]]
    tcl::unsupported::representation [run {string cat $e $e [list x]}]
} -match glob -result {*no string representation}
test string-29.15 {string cat, efficiency} -setup {
test string-29.15.$noComp {string cat, efficiency} -setup {
    set e [encoding convertto utf-8 {}]
    set f [encoding convertto utf-8 {}]
} -cleanup {
    unset e f
} -body {
    tcl::unsupported::representation [string cat $e $f $e $f [list x]]
    tcl::unsupported::representation [run {string cat $e $f $e $f [list x]}]
} -match glob -result {*no string representation}

}
test string-30.1.1.$noComp {[Bug ba921a8d98]: string cat} {
    run {string cat [set data [binary format a* hello]] [encoding convertto $data] [unset data]}
} hellohello
test string-30.1.2.$noComp {[Bug ba921a8d98]: inplace cat by subst (compiled to "strcat" instruction)} {
    run {set x "[set data [binary format a* hello]][encoding convertto $data][unset data]"}
} hellohello

}

# cleanup
rename MemStress {}
rename makeByteArray {}
rename makeUnicode {}
rename makeList {}
rename makeShared {}
catch {rename foo {}}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Deleted tests/stringComp.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801

































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Commands covered:  string
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# This differs from the original string tests in that the tests call
# things in procs, which uses the compiled string code instead of
# the runtime parse string code.  The tests of import should match
# their equivalent number in string.test.
#
# Copyright (c) 2001 by ActiveState Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}

test stringComp-1.1 {error conditions} {
    proc foo {} {string gorp a b}
    list [catch {foo} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test stringComp-1.2 {error conditions} {
    proc foo {} {string}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
test stringComp-1.3 {error condition - undefined method during compile} {
    # We don't want this to complain about 'never' because it may never
    # be called, or string may get redefined.  This must compile OK.
    proc foo {str i} {
        if {"yes" == "no"} { string never called but complains here }
        string index $str $i
    }
    foo abc 0
} a

## Test string compare|equal over equal constraints
## Use result for string compare, and negate it for string equal
## The body will be tested both in and outside a proc
set i 0
foreach {tname tbody tresult tcode} {
    {too few args} {
	string compare a
    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
    {bad args} {
	string compare a b c
    } {bad option "a": must be -nocase or -length} {error}
    {bad args} {
	string compare -length -nocase str1 str2
    } {expected integer but got "-nocase"} {error}
    {too many args} {
	string compare -length 10 -nocase str1 str2 str3
    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
    {compare with length unspecified} {
	string compare -length 10 10
    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
    {basic operation fail} {
	string compare abcde abdef
    } {-1} {}
    {basic operation success} {
	string compare abcde abcde
    } {0} {}
    {with length} {
	string compare -length 2 abcde abxyz
    } {0} {}
    {with special index} {
	string compare -length end-3 abcde abxyz
    } {expected integer but got "end-3"} {error}
    {unicode} {
	string compare ab\u7266 ab\u7267
    } {-1} {}
    {unicode} {string compare \334 \u00dc} 0 {}
    {unicode} {string compare \334 \u00fc} -1 {}
    {unicode} {string compare \334\334\334\374\374 \334\334\334\334\334} 1 {}
    {high bit} {
	# This test will fail if the underlying comparaison
	# is using signed chars instead of unsigned chars.
	# (like SunOS's default memcmp thus the compat/memcmp.c)
	string compare "\x80" "@"
	# Nb this tests works also in utf8 space because \x80 is
	# translated into a 2 or more bytelength but whose first byte has
	# the high bit set.
    } {1} {}
    {-nocase 1} {string compare -nocase abcde abdef} {-1} {}
    {-nocase 2} {string compare -nocase abcde Abdef} {-1} {}
    {-nocase 3} {string compare -nocase abcde ABCDE} {0} {}
    {-nocase 4} {string compare -nocase abcde abcde} {0} {}
    {-nocase unicode} {
	string compare -nocase \334 \u00dc
    } 0 {}
    {-nocase unicode} {
	string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334
    } 0 {}
    {-nocase with length} {
	string compare -length 2 -nocase abcde Abxyz
    } {0} {}
    {-nocase with length} {
	string compare -nocase -length 3 abcde Abxyz
    } {-1} {}
    {-nocase with length <= 0} {
	string compare -nocase -length -1 abcde AbCdEf
    } {-1} {}
    {-nocase with excessive length} {
	string compare -nocase -length 50 AbCdEf abcde
    } {1} {}
    {-len unicode} {
	# These are strings that are 6 BYTELENGTH long, but the length
	# shouldn't make a different because there are actually 3 CHARS long
	string compare -len 5 \334\334\334 \334\334\374
    } -1 {}
    {-nocase with special index} {
	string compare -nocase -length end-3 Abcde abxyz
    } {expected integer but got "end-3"} error
    {null strings} {
	string compare "" ""
    } 0 {}
    {null strings} {
	string compare "" foo
    } -1 {}
    {null strings} {
	string compare foo ""
    } 1 {}
    {-nocase null strings} {
	string compare -nocase "" ""
    } 0 {}
    {-nocase null strings} {
	string compare -nocase "" foo
    } -1 {}
    {-nocase null strings} {
	string compare -nocase foo ""
    } 1 {}
    {with length, unequal strings} {
	string compare -length 2 abc abde
    } 0 {}
    {with length, unequal strings} {
	string compare -length 2 ab abde
    } 0 {}
    {with NUL character vs. other ASCII} {
	# Be careful here, since UTF-8 rep comparison with memcmp() of
	# these puts chars in the wrong order
	string compare \x00 \x01
    } -1 {}
    {high bit} {
	string compare "a\x80" "a@"
    } 1 {}
    {high bit} {
	string compare "a\x00" "a\x01"
    } -1 {}
    {high bit} {
	string compare "\x00\x00" "\x00\x01"
    } -1 {}
    {binary equal} {
	string compare [binary format a100 0] [binary format a100 0]
    } 0 {}
    {binary neq} {
	string compare [binary format a100a 0 1] [binary format a100a 0 0]
    } 1 {}
    {binary neq inequal length} {
	string compare [binary format a20a 0 1] [binary format a100a 0 0]
    } 1 {}
} {
    if {$tname eq ""} { continue }
    if {$tcode eq ""} { set tcode ok }
    test stringComp-2.[incr i] "string compare, $tname" \
	-body [list eval $tbody] \
	-returnCodes $tcode -result $tresult
    test stringComp-2.[incr i] "string compare bc, $tname" \
	-body "[list proc foo {} $tbody];foo" \
	-returnCodes $tcode -result $tresult
    if {"error" ni $tcode} {
	set tresult [expr {!$tresult}]
    } else {
	set tresult [string map {compare equal} $tresult]
    }
    set tbody [string map {compare equal} $tbody]
    test stringComp-2.[incr i] "string equal, $tname" \
	-body [list eval $tbody] \
	-returnCodes $tcode -result $tresult
    test stringComp-2.[incr i] "string equal bc, $tname" \
	-body "[list proc foo {} $tbody];foo" \
	-returnCodes $tcode -result $tresult
}

# need a few extra tests short abbr cmd
test stringComp-3.1 {string compare, shortest method name} {
    proc foo {} {string co abcde ABCDE}
    foo
} 1
test stringComp-3.2 {string equal, shortest method name} {
    proc foo {} {string e abcde ABCDE}
    foo
} 0
test stringComp-3.3 {string equal -nocase} {
    proc foo {} {string eq -nocase abcde ABCDE}
    foo
} 1

test stringComp-4.1 {string first, too few args} {
    proc foo {} {string first a}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test stringComp-4.2 {string first, bad args} {
    proc foo {} {string first a b c}
    list [catch {foo} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test stringComp-4.3 {string first, too many args} {
    proc foo {} {string first a b 5 d}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test stringComp-4.4 {string first} {
    proc foo {} {string first bq abcdefgbcefgbqrs}
    foo
} 12
test stringComp-4.5 {string first} {
    proc foo {} {string fir bcd abcdefgbcefgbqrs}
    foo
} 1
test stringComp-4.6 {string first} {
    proc foo {} {string f b abcdefgbcefgbqrs}
    foo
} 1
test stringComp-4.7 {string first} {
    proc foo {} {string first xxx x123xx345xxx789xxx012}
    foo
} 9
test stringComp-4.8 {string first} {
    proc foo {} {string first "" x123xx345xxx789xxx012}
    foo
} -1
test stringComp-4.9 {string first, unicode} {
    proc foo {} {string first x abc\u7266x}
    foo
} 4
test stringComp-4.10 {string first, unicode} {
    proc foo {} {string first \u7266 abc\u7266x}
    foo
} 3
test stringComp-4.11 {string first, start index} {
    proc foo {} {string first \u7266 abc\u7266x 3}
    foo
} 3
test stringComp-4.12 {string first, start index} {
    proc foo {} {string first \u7266 abc\u7266x 4}
    foo
} -1
test stringComp-4.13 {string first, start index} {
    proc foo {} {string first \u7266 abc\u7266x end-2}
    foo
} 3
test stringComp-4.14 {string first, negative start index} {
    proc foo {} {string first b abc -1}
    foo
} 1

test stringComp-5.1 {string index} {
    proc foo {} {string index}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test stringComp-5.2 {string index} {
    proc foo {} {string index a b c}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test stringComp-5.3 {string index} {
    proc foo {} {string index abcde 0}
    foo
} a
test stringComp-5.4 {string index} {
    proc foo {} {string in abcde 4}
    foo
} e
test stringComp-5.5 {string index} {
    proc foo {} {string index abcde 5}
    foo
} {}
test stringComp-5.6 {string index} {
    proc foo {} {string index abcde -10}
    list [catch {foo} msg] $msg
} {0 {}}
test stringComp-5.7 {string index} {
    proc foo {} {string index a xyz}
    list [catch {foo} msg] $msg
} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}}
test stringComp-5.8 {string index} {
    proc foo {} {string index abc end}
    foo
} c
test stringComp-5.9 {string index} {
    proc foo {} {string index abc end-1}
    foo
} b
test stringComp-5.10 {string index, unicode} {
    proc foo {} {string index abc\u7266d 4}
    foo
} d
test stringComp-5.11 {string index, unicode} {
    proc foo {} {string index abc\u7266d 3}
    foo
} \u7266
test stringComp-5.12 {string index, unicode over char length, under byte length} {
    proc foo {} {string index \334\374\334\374 6}
    foo
} {}
test stringComp-5.13 {string index, bytearray object} {
    proc foo {} {string index [binary format a5 fuz] 0}
    foo
} f
test stringComp-5.14 {string index, bytearray object} {
    proc foo {} {string index [binary format I* {0x50515253 0x52}] 3}
    foo
} S
test stringComp-5.15 {string index, bytearray object} {
    proc foo {} {
	set b [binary format I* {0x50515253 0x52}]
	set i1 [string index $b end-6]
	set i2 [string index $b 1]
	string compare $i1 $i2
    }
    foo
} 0
test stringComp-5.16 {string index, bytearray object with string obj shimmering} {
    proc foo {} {
	set str "0123456789\x00 abcdedfghi"
	binary scan $str H* dump
	string compare [string index $str 10] \x00
    }
    foo
} 0
test stringComp-5.17 {string index, bad integer} -body {
    proc foo {} {string index "abc" 0o8}
    list [catch {foo} msg] $msg
} -match glob -result {1 {*}}
test stringComp-5.18 {string index, bad integer} -body {
    proc foo {} {string index "abc" end-0o0289}
    list [catch {foo} msg] $msg
} -match glob -result {1 {*}}
test stringComp-5.19 {string index, bytearray object out of bounds} {
    proc foo {} {string index [binary format I* {0x50515253 0x52}] -1}
    foo
} {}
test stringComp-5.20 {string index, bytearray object out of bounds} {
    proc foo {} {string index [binary format I* {0x50515253 0x52}] 20}
    foo
} {}


proc largest_int {} {
    # This will give us what the largest valid int on this machine is,
    # so we can test for overflow properly below on >32 bit systems
    set int 1
    set exp 7; # assume we get at least 8 bits
    while {$int > 0} { set int [expr {1 << [incr exp]}] }
    return [expr {$int-1}]
}

## string is
## not yet bc

catch {rename largest_int {}}

## string last
## not yet bc

## string length
## not yet bc
test stringComp-8.1 {string bytelength} {
    proc foo {} {string bytelength}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test stringComp-8.2 {string bytelength} {
    proc foo {} {string bytelength a b}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test stringComp-8.3 {string bytelength} {
    proc foo {} {string bytelength "\u00c7"}
    foo
} 2
test stringComp-8.4 {string bytelength} {
    proc foo {} {string b ""}
    foo
} 0

## string length
##
test stringComp-9.1 {string length} {
    proc foo {} {string length}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test stringComp-9.2 {string length} {
    proc foo {} {string length a b}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test stringComp-9.3 {string length} {
    proc foo {} {string length "a little string"}
    foo
} 15
test stringComp-9.4 {string length} {
    proc foo {} {string le ""}
    foo
} 0
test stringComp-9.5 {string length, unicode} {
    proc foo {} {string le "abcd\u7266"}
    foo
} 5
test stringComp-9.6 {string length, bytearray object} {
    proc foo {} {string length [binary format a5 foo]}
    foo
} 5
test stringComp-9.7 {string length, bytearray object} {
    proc foo {} {string length [binary format I* {0x50515253 0x52}]}
    foo
} 8

## string map
## not yet bc

## string match
##
test stringComp-11.1 {string match, too few args} {
    proc foo {} {string match a}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test stringComp-11.2 {string match, too many args} {
    proc foo {} {string match a b c d}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test stringComp-11.3 {string match} {
    proc foo {} {string match abc abc}
    foo
} 1
test stringComp-11.4 {string match} {
    proc foo {} {string mat abc abd}
    foo
} 0
test stringComp-11.5 {string match} {
    proc foo {} {string match ab*c abc}
    foo
} 1
test stringComp-11.6 {string match} {
    proc foo {} {string match ab**c abc}
    foo
} 1
test stringComp-11.7 {string match} {
    proc foo {} {string match ab* abcdef}
    foo
} 1
test stringComp-11.8 {string match} {
    proc foo {} {string match *c abc}
    foo
} 1
test stringComp-11.9 {string match} {
    proc foo {} {string match *3*6*9 0123456789}
    foo
} 1
test stringComp-11.10 {string match} {
    proc foo {} {string match *3*6*9 01234567890}
    foo
} 0
test stringComp-11.11 {string match} {
    proc foo {} {string match a?c abc}
    foo
} 1
test stringComp-11.12 {string match} {
    proc foo {} {string match a??c abc}
    foo
} 0
test stringComp-11.13 {string match} {
    proc foo {} {string match ?1??4???8? 0123456789}
    foo
} 1
test stringComp-11.14 {string match} {
    proc foo {} {string match {[abc]bc} abc}
    foo
} 1
test stringComp-11.15 {string match} {
    proc foo {} {string match {a[abc]c} abc}
    foo
} 1
test stringComp-11.16 {string match} {
    proc foo {} {string match {a[xyz]c} abc}
    foo
} 0
test stringComp-11.17 {string match} {
    proc foo {} {string match {12[2-7]45} 12345}
    foo
} 1
test stringComp-11.18 {string match} {
    proc foo {} {string match {12[ab2-4cd]45} 12345}
    foo
} 1
test stringComp-11.19 {string match} {
    proc foo {} {string match {12[ab2-4cd]45} 12b45}
    foo
} 1
test stringComp-11.20 {string match} {
    proc foo {} {string match {12[ab2-4cd]45} 12d45}
    foo
} 1
test stringComp-11.21 {string match} {
    proc foo {} {string match {12[ab2-4cd]45} 12145}
    foo
} 0
test stringComp-11.22 {string match} {
    proc foo {} {string match {12[ab2-4cd]45} 12545}
    foo
} 0
test stringComp-11.23 {string match} {
    proc foo {} {string match {a\*b} a*b}
    foo
} 1
test stringComp-11.24 {string match} {
    proc foo {} {string match {a\*b} ab}
    foo
} 0
test stringComp-11.25 {string match} {
    proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
    foo
} 1
test stringComp-11.26 {string match} {
    proc foo {} {string match ** ""}
    foo
} 1
test stringComp-11.27 {string match} {
    proc foo {} {string match *. ""}
    foo
} 0
test stringComp-11.28 {string match} {
    proc foo {} {string match "" ""}
    foo
} 1
test stringComp-11.29 {string match} {
    proc foo {} {string match \[a a}
    foo
} 1
test stringComp-11.30 {string match, bad args} {
    proc foo {} {string match - b c}
    list [catch {foo} msg] $msg
} {1 {bad option "-": must be -nocase}}
test stringComp-11.31 {string match case} {
    proc foo {} {string match a A}
    foo
} 0
test stringComp-11.32 {string match nocase} {
    proc foo {} {string match -n a A}
    foo
} 1
test stringComp-11.33 {string match nocase} {
    proc foo {} {string match -nocase a\334 A\374}
    foo
} 1
test stringComp-11.34 {string match nocase} {
    proc foo {} {string match -nocase a*f ABCDEf}
    foo
} 1
test stringComp-11.35 {string match case, false hope} {
    # This is true because '_' lies between the A-Z and a-z ranges
    proc foo {} {string match {[A-z]} _}
    foo
} 1
test stringComp-11.36 {string match nocase range} {
    # This is false because although '_' lies between the A-Z and a-z ranges,
    # we lower case the end points before checking the ranges.
    proc foo {} {string match -nocase {[A-z]} _}
    foo
} 0
test stringComp-11.37 {string match nocase} {
    proc foo {} {string match -nocase {[A-fh-Z]} g}
    foo
} 0
test stringComp-11.38 {string match case, reverse range} {
    proc foo {} {string match {[A-fh-Z]} g}
    foo
} 1
test stringComp-11.39 {string match, *\ case} {
    proc foo {} {string match {*\abc} abc}
    foo
} 1
test stringComp-11.40 {string match, *special case} {
    proc foo {} {string match {*[ab]} abc}
    foo
} 0
test stringComp-11.41 {string match, *special case} {
    proc foo {} {string match {*[ab]*} abc}
    foo
} 1
test stringComp-11.42 {string match, *special case} {
    proc foo {} {string match "*\\" "\\"}
    foo
} 0
test stringComp-11.43 {string match, *special case} {
    proc foo {} {string match "*\\\\" "\\"}
    foo
} 1
test stringComp-11.44 {string match, *special case} {
    proc foo {} {string match "*???" "12345"}
    foo
} 1
test stringComp-11.45 {string match, *special case} {
    proc foo {} {string match "*???" "12"}
    foo
} 0
test stringComp-11.46 {string match, *special case} {
    proc foo {} {string match "*\\*" "abc*"}
    foo
} 1
test stringComp-11.47 {string match, *special case} {
    proc foo {} {string match "*\\*" "*"}
    foo
} 1
test stringComp-11.48 {string match, *special case} {
    proc foo {} {string match "*\\*" "*abc"}
    foo
} 0
test stringComp-11.49 {string match, *special case} {
    proc foo {} {string match "?\\*" "a*"}
    foo
} 1
test stringComp-11.50 {string match, *special case} {
    proc foo {} {string match "\\" "\\"}
    foo
} 0
test stringComp-11.51 {string match; *, -nocase and UTF-8} {
    proc foo {} {string match -nocase [binary format I 717316707] \
	    [binary format I 2028036707]}
    foo
} 1
test stringComp-11.52 {string match, null char in string} {
    proc foo {} {
	set ptn "*abc*"
	foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] {
	    lappend out [string match $ptn $elem]
	}
	set out
    }
    foo
} {1 1 1 1}
test stringComp-11.53 {string match, null char in pattern} {
    proc foo {} {
	set out ""
	foreach {ptn elem} [list \
		"*\u0000abc\u0000"  "\u0000abc\u0000" \
		"*\u0000abc\u0000"  "\u0000abc\u0000ef" \
		"*\u0000abc\u0000*" "\u0000abc\u0000ef" \
		"*\u0000abc\u0000"  "@\u0000abc\u0000ef" \
		"*\u0000abc\u0000*"  "@\u0000abc\u0000ef" \
		] {
	    lappend out [string match $ptn $elem]
	}
	set out
    }
    foo
} {1 0 1 0 1}
test stringComp-11.54 {string match, failure} {
    proc foo {} {
	set longString ""
	for {set i 0} {$i < 10} {incr i} {
	    append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123"
	}
	list [string match *cba* $longString] \
		[string match *a*l*\u0000* $longString] \
		[string match *a*l*\u0000*123 $longString] \
		[string match *a*l*\u0000*123* $longString] \
		[string match *a*l*\u0000*cba* $longString] \
		[string match *===* $longString]
    }
    foo
} {0 1 1 1 0 0}

## string range
test stringComp-12.1 {Bug 3588366: end-offsets before start} {
    apply {s {
	string range $s 0 end-5
    }} 12345
} {}

## string repeat
## not yet bc

## string replace
test stringComp-14.1 {Bug 82e7f67325} {
    apply {x {
	set a [join $x {}]
	lappend b [string length [string replace ___! 0 2 $a]]
	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
    }} {a b}
} {3 3}
test stringComp-14.2 {Bug 82e7f67325} memory {
    # As in stringComp-14.1, but make sure we don't retain too many refs
    leaktest {
	apply {x {
	    set a [join $x {}]
	    lappend b [string length [string replace ___! 0 2 $a]]
	    lappend b [string length [string replace ___! 0 2 $a[unset a]]]
	}} {a b}
    }
} {0}
test stringComp-14.3 {Bug 0dca3bfa8f} {
    apply {arg {
	set argCopy $arg
	set arg [string replace $arg 1 2 aa]
	# Crashes in comparison before fix
	expr {$arg ne $argCopy}
    }} abcde
} 1
test stringComp-14.4 {Bug 1af8de570511} {
    apply {{x y} {
	# Generate an unshared string value
	set val ""
	for { set i 0 } { $i < $x } { incr i } {
	    set val [format "0%s" $val]
	}
	string replace $val[unset val] 1 1 $y
    }} 4 x
} 0x00
test stringComp-14.5 {} {
    string length [string replace [string repeat a\u00fe 2] 3 end {}]
} 3

## string tolower
## not yet bc

## string toupper
## not yet bc

## string totitle
## not yet bc

## string trim*
## not yet bc

## string word*
## not yet bc

## string cat
test stringComp-29.1 {string cat, no arg} {
    proc foo {} {string cat}
    foo
} ""
test stringComp-29.2 {string cat, single arg} {
    proc foo {} {
	set x FOO
	string compare $x [string cat $x]
    }
    foo
} 0
test stringComp-29.3 {string cat, two args} {
    proc foo {} {
	set x FOO
	string compare $x$x [string cat $x $x]
    }
    foo
} 0
test stringComp-29.4 {string cat, many args} {
    proc foo {} {
	set x FOO
	set n 260
	set xx [string repeat $x $n]
	set vv [string repeat {$x} $n]
	set vvs [string repeat {$x } $n]
	set r1 [string compare $xx [subst $vv]]
	set r2 [string compare $xx [eval "string cat $vvs"]]
	list $r1 $r2
    }
    foo
} {0 0}


# cleanup
catch {rename foo {}}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/tailcall.test.

684
685
686
687
688
689
690




















691
692
693
694
695
696
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






} {0 ok NONE}

if {[testConstraint testnrelevels]} {
    namespace forget testnre::*
    namespace delete testnre
}

test tailcall-14.1 {in a deleted namespace} -body {
    namespace eval ns {
	proc p args {
	    tailcall [namespace current] $args
	}
	namespace delete [namespace current]
	p
    }
} -returnCodes 1 -result {namespace "::ns" not found}

test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body {
    namespace eval ns {
	proc p args {
	    tailcall [namespace current] {*}$args
	}
	namespace delete [namespace current]
	p
    }
} -returnCodes 1 -result {namespace "::ns" not found}

# cleanup
::tcltest::cleanupTests

# Local Variables:
# mode: tcl
# End:

Changes to tests/tcltest.test.

540
541
542
543
544
545
546
547
548
549
550
551
552
553

554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570


571
572

573
574
575
576
577
578
579
540
541
542
543
544
545
546

547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569

570
571
572

573
574
575
576
577
578
579
580







-






+
















-
+
+

-
+







    -match glob
}
# Test non-writeable directories, non-readable directories with directory flags
set notReadableDir [file join [temporaryDirectory] notreadable]
set notWriteableDir [file join [temporaryDirectory] notwriteable]
makeDirectory notreadable
makeDirectory notwriteable

switch -- $::tcl_platform(platform) {
    unix {
	file attributes $notReadableDir -permissions 00333
	file attributes $notWriteableDir -permissions 00555
    }
    default {
	# note in FAT/NTFS we won't be able to protect directory with read-only attribute...
	catch {file attributes $notWriteableDir -readonly 1}
	catch {testchmod 0 $notWriteableDir}
    }
}
test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
    -constraints {unix notRoot}
    -body {
	slave msg $a -tmpdir $notReadableDir
	return $msg
    }
    -result {*not readable*}
    -match glob
}
# This constraint doesn't go at the top of the file so that it doesn't
# interfere with tcltest-5.5
testConstraint notFAT [expr {
    ![string match "FAT*" [lindex [file system $notWriteableDir] 1]]
       ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]]
    || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]]
}]
# FAT permissions are fairly hopeless; ignore this test if that FS is used
# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used
test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
    -constraints {unixOrPc notRoot notFAT}
    -body {
	slave msg $a -tmpdir $notWriteableDir
	return $msg
    }
    -result {*not writeable*}
903
904
905
906
907
908
909

910

911
912
913
914
915
916
917
918
919
920
921





922
923
924
925
926
927
928
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936







+

+











+
+
+
+
+







	set ::tcltest::loadFile $oldf
    }
}
removeFile load.tcl

# [interpreter]
test tcltest-13.1 {interpreter} {
    -constraints notValgrind
    -setup {
	#to do:  Why is $::tcltest::tcltest being saved and restored here?
	set old $::tcltest::tcltest
	set ::tcltest::tcltest tcltest
    }
    -body {
	set f1 [interpreter]
	set f2 [interpreter tclsh]
	set f3 [interpreter]
	list $f1 $f2 $f3
    }
    -result {tcltest tclsh tclsh}
    -cleanup {
	# writing ::tcltest::tcltest triggers a trace that sets up the stdio
	# constraint, which involves a call to [exec] that might fail after
	# "fork" and before "exec", in which case the forked process will not
	# have a chance to clean itself up before exiting, which causes
	# valgrind to issue numerous "still reachable" reports.
	set ::tcltest::tcltest $old
    }
}

# -singleproc, [singleProcess]
set spd [makeDirectory singleprocdir]
makeFile {
1195
1196
1197
1198
1199
1200
1201
1202

1203
1204
1205
1206
1207
1208
1209
1203
1204
1205
1206
1207
1208
1209

1210
1211
1212
1213
1214
1215
1216
1217







-
+







test tcltest-21.2 {force a test command failure} {
    -body {
	test tcltest-21.2.0 {
	    return 2
	} {1}
    }
    -returnCodes 1
    -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
    -result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
}

test tcltest-21.3 {test command with setup} {
    -setup {
	set foo 1
    }
    -body {
1288
1289
1290
1291
1292
1293
1294
1295

1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315

1316
1317
1318
1319
1320
1321
1322
1296
1297
1298
1299
1300
1301
1302

1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322

1323
1324
1325
1326
1327
1328
1329
1330







-
+



















-
+







    -cleanup {set ::tcltest::currentFailure $fail}
    -body {
	test tcltest-21.7.0 {foo-4} {
	    -foobar {}
	}
    }
    -returnCodes 1
    -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
    -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
}

# alternate test command format (these are the same as 21.1-21.6, with the
# exception of being in the all-inline format)

test tcltest-21.7a {expect with glob} \
	-body {list a b c d e} \
	-result {[ab] b c d e} \
	-match glob

test tcltest-21.8 {force a test command failure} \
    -setup {set fail $::tcltest::currentFailure} \
    -body {
        test tcltest-21.8.0 {
            return 2
        } {1}
    } \
    -returnCodes 1 \
    -cleanup {set ::tcltest::currentFailure $fail} \
    -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
    -result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup}

test tcltest-21.9 {test command with setup} \
	-setup {set foo 1} \
	-body {set foo} \
	-cleanup {unset foo} \
	-result {1}

Added tests/tcltests.tcl.












1
2
3
4
5
6
7
8
9
10
11
+
+
+
+
+
+
+
+
+
+
+
#! /usr/bin/env tclsh

package require tcltest 2.2
namespace import ::tcltest::*

testConstraint exec          [llength [info commands exec]]
testConstraint fcopy         [llength [info commands fcopy]]
testConstraint fileevent     [llength [info commands fileevent]]
testConstraint thread        [
    expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint notValgrind   [expr {![testConstraint valgrind]}]

Changes to tests/thread.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18



19
20

21
22
23
24

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29







30
31
32
33
34
35
36













-
-
+
+



+
+
+


+



-
+

-
-
-
-
-
-
-







# Commands covered:  (test)thread
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.2
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

#  when thread::release is used, -wait is passed in order allow the thread to
#  be fully finalized, which avoids valgrind "still reachable" reports.

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] != {}}]
testConstraint testthread [expr {[info commands testthread] ne {}}]

# Some tests require the Thread package

testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]

# Some tests may not work under valgrind

testConstraint notValgrind [expr {![testConstraint valgrind]}]

set threadSuperKillScript {
    rename catch ""
    rename while ""
    rename unknown ""
    rename update ""
    thread::release
67
68
69
70
71
72
73











74
75
76
77
78
79
80
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88







+
+
+
+
+
+
+
+
+
+
+







    if {[string length [getThreadErrorFromInfo $info]] > 0} then {
        global threadId threadError
        set threadId $id
        lappend threadError($id) $info
    }
    set threadSawError($id) true; # signal main thread to exit [vwait].
}

proc threadSuperKill id {
    variable threadSuperKillScript
    try {
	thread::send $id $::threadSuperKillScript
    } on error {tres topts} {
	if {$tres ne {target thread died}} {
	    return -options $topts $tres
	}
    }
}

if {[testConstraint thread]} {
    thread::errorproc ThreadError
}

if {[testConstraint testthread]} {
    proc drainEventQueue {} {
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
128
129
130

131
132
133
134
135
136
137
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
128
129
130
131

132
133
134
135
136
137

138
139
140
141
142
143
144
145







-
+

-
+



-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
+









-
+





-
+








test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {thread} {
    llength [thread::names]
} 1
test thread-1.4 {Tcl_ThreadObjCmd: thread create } {thread} {
    set serverthread [thread::create -preserved]
    set numthreads [llength [thread::names]]
    thread::release $serverthread
    thread::release -wait $serverthread
    set numthreads
} {2}
} 2
test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {thread} {
    thread::create {set x 5}
    foreach try {0 1 2 4 5 6} {
	# Try various ways to yield
	update
	after 10
	set l [llength [thread::names]]
	if {$l == 1} {
	    break
	}
        # Try various ways to yield
        update
        after 10
        set l [llength [thread::names]]
        if {$l == 1} {
            break
        }
    }
    set l
} {1}
} 1
test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} {
    thread::create {{*}{}}
    update
    after 10
    llength [thread::names]
} {1}
test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} {
    set serverthread [thread::create -preserved]
    set five [thread::send $serverthread {set x 5}]
    thread::release $serverthread
    thread::release -wait $serverthread
    set five
} 5
test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} {
    set serverthread [thread::create -preserved {set z 5 ; thread::wait}]
    set five [thread::send $serverthread {set z}]
    thread::release $serverthread
    thread::release -wait $serverthread
    set five
} 5

# The tests above also cover:
# TclCreateThread, except when pthread_create fails
# NewThread, safe and regular
# ThreadErrorProc, except for printing to standard error
155
156
157
158
159
160
161
162

163
164
165
166
167
168
169
163
164
165
166
167
168
169

170
171
172
173
174
175
176
177







-
+







    set l1  {}
    foreach t {0 1 2} {
	lappend l1 [thread::create -preserved]
    }
    set l2 [thread::names]
    set c [string compare [lsort [concat [thread::id] $l1]] [lsort $l2]]
    foreach t $l1 {
	thread::release $t
	thread::release -wait $t
    }
    list $len $c
} {1 0}

test thread-4.1 {TclThreadSend to self} {thread} {
    catch {unset x}
    thread::send [thread::id] {
883
884
885
886
887
888
889
890

891
892
893
894
895
896
897
891
892
893
894
895
896
897

898
899
900
901
902
903
904
905







-
+







	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::cancel $serverthread]
    thread::send $serverthread $::threadSuperKillScript
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
925
926
927
928
929
930
931
932

933
934
935
936
937
938
939
933
934
935
936
937
938
939

940
941
942
943
944
945
946
947







-
+







	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::cancel $serverthread]
    thread::send $serverthread $::threadSuperKillScript
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
1025
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038
1039
1033
1034
1035
1036
1037
1038
1039

1040
1041
1042
1043
1044
1045
1046
1047







-
+







	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {interp cancel}]
    thread::send $serverthread $::threadSuperKillScript
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
1067
1068
1069
1070
1071
1072
1073
1074

1075
1076
1077
1078
1079
1080
1081
1075
1076
1077
1078
1079
1080
1081

1082
1083
1084
1085
1086
1087
1088
1089







-
+







	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {interp cancel}]
    thread::send $serverthread $::threadSuperKillScript
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
1107
1108
1109
1110
1111
1112
1113
1114

1115
1116
1117
1118
1119
1120
1121
1115
1116
1117
1118
1119
1120
1121

1122
1123
1124
1125
1126
1127
1128
1129







-
+







	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
    thread::send $serverthread $::threadSuperKillScript
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
1149
1150
1151
1152
1153
1154
1155
1156

1157
1158
1159
1160
1161
1162
1163
1157
1158
1159
1160
1161
1162
1163

1164
1165
1166
1167
1168
1169
1170
1171







-
+







	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
    thread::send $serverthread $::threadSuperKillScript
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \

Changes to tests/unixFCmd.test.

217
218
219
220
221
222
223
224

225
226
227
228
229

230
231
232
233
234
235
236
217
218
219
220
221
222
223

224
225
226
227
228

229
230
231
232
233
234
235
236







-
+




-
+







} -cleanup {
    cleanup
} -result {fifo fifo}
test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    close [open tf1 a]
    file attributes tf1 -permissions 0472
    file attributes tf1 -permissions 0o472
    file copy tf1 tf2
    file attributes tf2 -permissions
} -cleanup {
    cleanup
} -result 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
} -result 0o472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-

test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} {
} {}

test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unix notRoot} {
} {}

371
372
373
374
375
376
377
378
379
380
381
382





383
384
385
386
387
388
389
371
372
373
374
375
376
377





378
379
380
381
382
383
384
385
386
387
388
389







-
-
-
-
-
+
+
+
+
+







      foreach permstr $permList {
	file attributes foo.test -permissions $permstr
	lappend result [file attributes foo.test -permissions]
      }
      set result
    } $expected
}
permcheck unixFCmd-17.5   rwxrwxrwx	00777
permcheck unixFCmd-17.6   r--r---w-	00442
permcheck unixFCmd-17.7   {0 u+rwx,g+r u-w o+rwx} {00000 00740 00540 00547}
permcheck unixFCmd-17.11  --x--x--x	00111
permcheck unixFCmd-17.12  {0 a+rwx} {00000 00777}
permcheck unixFCmd-17.5   rwxrwxrwx	0o777
permcheck unixFCmd-17.6   r--r---w-	0o442
permcheck unixFCmd-17.7   {0 u+rwx,g+r u-w o+rwx} {00000 0o740 0o540 0o547}
permcheck unixFCmd-17.11  --x--x--x	0o111
permcheck unixFCmd-17.12  {0 a+rwx} {00000 0o777}
file delete -force -- foo.test

test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup {
    set cd [pwd]
} -body {
    # This test is nonPortable because SunOS generates a weird error
    # message when the current directory isn't readable.

Changes to tests/unixNotfy.test.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38
39
40
41

42
43
44
45
46
47
48
14
15
16
17
18
19
20





21
22
23
24

25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43







-
-
-
-
-




-
+










-
+







    package require tcltest 2
    namespace import -force ::tcltest::*
}

# When run in a Tk shell, these tests hang.
testConstraint noTk [expr {0 != [catch {package present Tk}]}]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# Darwin always uses a threaded notifier
testConstraint unthreaded [expr {
    ![::tcl::pkgconfig get threaded]
    && $tcl_platform(os) ne "Darwin"
}]

# The next two tests will hang if threads are enabled because the notifier
# will not necessarily wait for ever in this case, so it does not generate
# an error.
test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints nonPortable -body {
    catch {vwait x}
    set f [open [makeFile "" foo] w]
    fileevent $f writable {set x 1}
    vwait x
    close $f
    list [catch {vwait x} msg] $msg
} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
    catch { close $f }
    catch { removeFile foo }
}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints nonPortable -body {
    catch {vwait x}
    set f1 [open [makeFile "" foo] w]
    set f2 [open [makeFile "" foo2] w]
    fileevent $f1 writable {set x 1}
    fileevent $f2 writable {set y 1}
    vwait x
    close $f1

Changes to tests/uplevel.test.

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

161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178

179
180
181
182
183
184

185
186
187
188
189
190
191
192
193
194
195
196

197
198
199
200
201
202
203
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177

178
179
180
181
182
183

184
185
186
187
188
189
190
191
192
193
194
195

196
197
198
199
200
201
202
203







-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+


-
+





-
+

















-
+





-
+











-
+







} {}
test uplevel-4.15 {level parsing} {
    apply {{} {uplevel [expr 1] {}}}
} {}
test uplevel-4.16 {level parsing} {
    apply {{} {uplevel #[expr 1] {}}}
} {}
test uplevel-4.17 {level parsing} {
test uplevel-4.17 {level parsing} -returnCodes error -body {
    apply {{} {uplevel -0xffffffff {}}}
} {}
test uplevel-4.18 {level parsing} {
} -result {bad level "-0xffffffff"}
test uplevel-4.18 {level parsing} -returnCodes error -body {
    apply {{} {uplevel #-0xffffffff {}}}
} {}
test uplevel-4.19 {level parsing} {
} -result {bad level "#-0xffffffff"}
test uplevel-4.19 {level parsing} -returnCodes error -body {
    apply {{} {uplevel [expr -0xffffffff] {}}}
} {}
test uplevel-4.20 {level parsing} {
} -result {bad level "-4294967295"}
test uplevel-4.20 {level parsing} -returnCodes error -body {
    apply {{} {uplevel #[expr -0xffffffff] {}}}
} {}
} -result {bad level "#-4294967295"}
test uplevel-4.21 {level parsing} -body {
    apply {{} {uplevel -1 {}}}
} -returnCodes error -result {invalid command name "-1"}
} -returnCodes error -result {bad level "-1"}
test uplevel-4.22 {level parsing} -body {
    apply {{} {uplevel #-1 {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.23 {level parsing} -body {
    apply {{} {uplevel [expr -1] {}}}
} -returnCodes error -result {invalid command name "-1"}
} -returnCodes error -result {bad level "-1"}
test uplevel-4.24 {level parsing} -body {
    apply {{} {uplevel #[expr -1] {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.25 {level parsing} -body {
    apply {{} {uplevel 0xffffffff {}}}
} -returnCodes error -result {bad level "0xffffffff"}
test uplevel-4.26 {level parsing} -body {
    apply {{} {uplevel #0xffffffff {}}}
} -returnCodes error -result {bad level "#0xffffffff"}
test uplevel-4.27 {level parsing} -body {
    apply {{} {uplevel [expr 0xffffffff] {}}}
} -returnCodes error -result {bad level "4294967295"}
test uplevel-4.28 {level parsing} -body {
    apply {{} {uplevel #[expr 0xffffffff] {}}}
} -returnCodes error -result {bad level "#4294967295"}
test uplevel-4.29 {level parsing} -body {
    apply {{} {uplevel 0.2 {}}}
} -returnCodes error -result {bad level "0.2"}
} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.30 {level parsing} -body {
    apply {{} {uplevel #0.2 {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.31 {level parsing} -body {
    apply {{} {uplevel [expr 0.2] {}}}
} -returnCodes error -result {bad level "0.2"}
} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.32 {level parsing} -body {
    apply {{} {uplevel #[expr 0.2] {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.33 {level parsing} -body {
    apply {{} {uplevel .2 {}}}
} -returnCodes error -result {invalid command name ".2"}
test uplevel-4.34 {level parsing} -body {
    apply {{} {uplevel #.2 {}}}
} -returnCodes error -result {bad level "#.2"}
test uplevel-4.35 {level parsing} -body {
    apply {{} {uplevel [expr .2] {}}}
} -returnCodes error -result {bad level "0.2"}
} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.36 {level parsing} -body {
    apply {{} {uplevel #[expr .2] {}}}
} -returnCodes error -result {bad level "#0.2"}




Changes to tests/utf.test.

17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

45
46












47
48
49
50
51
52
53
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65







-
+



















-
+


+
+
+
+
+
+
+
+
+
+
+
+







catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testbytestring [llength [info commands testbytestring]]

catch {unset x}

# Some tests require support for 4-byte UTF-8 sequences
testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]
testConstraint tip389 [expr {[string length \U010000] == 2}]

test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring {
    expr {"\x01" eq [testbytestring "\x01"]}
} 1
test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
    expr {"\x00" eq [testbytestring "\xc0\x80"]}
} 1
test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring {
    expr {"\xe0" eq [testbytestring "\xc3\xa0"]}
} 1
test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring {
    expr {"\u4e4e" eq [testbytestring "\xe4\xb9\x8e"]}
} 1
test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {
    expr {[format %c 0x110000] eq [testbytestring "\xef\xbf\xbd"]}
} 1
test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
    expr {[format %c -1] eq [testbytestring "\xef\xbf\xbd"]}
} 1
test utf-1.7 {Tcl_UniCharToUtf: 4 byte sequences} -constraints {fullutf testbytestring} -body {
test utf-1.7 {Tcl_UniCharToUtf: 4 byte sequences} -constraints testbytestring -body {
    expr {"\U014e4e" eq [testbytestring "\xf0\x94\xb9\x8e"]}
} -result 1
test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, upper surrogate} testbytestring {
    expr {"\ud842" eq [testbytestring "\xed\xa1\x82"]}
} 1
test utf-1.9 {Tcl_UniCharToUtf: 3 byte sequence, lower surrogate} testbytestring {
    expr {"\udc42" eq [testbytestring "\xed\xb1\x82"]}
} 1
test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, upper surrogate} testbytestring {
    expr {[format %c 0xd842] eq [testbytestring "\xed\xa1\x82"]}
} 1
test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, lower surrogate} testbytestring {
    expr {[format %c 0xdc42] eq [testbytestring "\xed\xb1\x82"]}
} 1

test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
    string length "abc"
} {3}
test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} testbytestring {
    string length [testbytestring "\x82\x83\x84"]
} {3}
62
63
64
65
66
67
68
69

70
71
72

73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88



89
90
91
92
93
94
95
74
75
76
77
78
79
80

81
82
83

84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110







-
+


-
+
















+
+
+







} {1}
test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestring {
    string length [testbytestring "\xE2\xA2"]
} {2}
test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring {
    string length [testbytestring "\xE4\xb9\x8e"]
} {1}
test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {fullutf testbytestring} -body {
test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {tip389 testbytestring} -body {
    string length [testbytestring "\xF0\x90\x80\x80"]
} -result {2}
test utf-2.9 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {fullutf testbytestring} -body {
test utf-2.9 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {tip389 testbytestring} -body {
    string length [testbytestring "\xF4\x8F\xBF\xBF"]
} -result {2}
test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring {
    string length [testbytestring "\xF0\x8F\xBF\xBF"]
} {4}
test utf-2.11 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, overflow} testbytestring {
    string length [testbytestring "\xF4\x90\x80\x80"]
} {4}
test utf-2.12 {Tcl_UtfToUniChar: longer UTF sequences not supported} testbytestring {
    string length [testbytestring "\xF8\xA2\xA2\xA2\xA2"]
} {5}

test utf-3.1 {Tcl_UtfCharComplete} {
} {}

testConstraint testnumutfchars [llength [info commands testnumutfchars]]
testConstraint testfindfirst [llength [info commands testfindfirst]]
testConstraint testfindlast [llength [info commands testfindlast]]

test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars {
    testnumutfchars ""
} {0}
test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC2\xA2"]
} {1}
test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} {
114
115
116
117
118
119
120
121
122






123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141






142
143
144
145
146
147
148
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173







-
-
+
+
+
+
+
+



















+
+
+
+
+
+







test utf-4.9 {Tcl_NumUtfChars: #u20AC, calc len, incomplete} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xE2\x82\xAC"] 2
} {2}
test utf-4.10 {Tcl_NumUtfChars: #u0000, calc len, overcomplete} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\x00"] 2
} {2}

test utf-5.1 {Tcl_UtfFindFirsts} {
} {}
test utf-5.1 {Tcl_UtfFindFirst} {testfindfirst testbytestring} {
    testfindfirst [testbytestring "abcbc"] 98
} {bcbc}
test utf-5.2 {Tcl_UtfFindLast} {testfindlast testbytestring} {
    testfindlast [testbytestring "abcbc"] 98
} {bc}

test utf-6.1 {Tcl_UtfNext} {
} {}

test utf-7.1 {Tcl_UtfPrev} {
} {}

test utf-8.1 {Tcl_UniCharAtIndex: index = 0} {
    string index abcd 0
} {a}
test utf-8.2 {Tcl_UniCharAtIndex: index = 0} {
    string index \u4e4e\u25a 0
} "\u4e4e"
test utf-8.3 {Tcl_UniCharAtIndex: index > 0} {
    string index abcd 2
} {c}
test utf-8.4 {Tcl_UniCharAtIndex: index > 0} {
    string index \u4e4e\u25a\xff\u543 2
} "\uff"
test utf-8.5 {Tcl_UniCharAtIndex: upper surrogate} {
    string index \ud842 0
} "\ud842"
test utf-8.5 {Tcl_UniCharAtIndex: lower surrogate} {
    string index \udc42 0
} "\udc42"

test utf-9.1 {Tcl_UtfAtIndex: index = 0} {
    string range abcd 0 2
} {abc}
test utf-9.2 {Tcl_UtfAtIndex: index > 0} {
    string range \u4e4e\u25a\xff\u543klmnop 1 5
} "\u25a\xff\u543kl"
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231







232
233
234
235
236
237
238
239
240
241
242
243
244
245






246
247
248
249
250
251
252
253
254
255
256
257
258






259
260
261
262
263
264
265
266
267
268
269
270
271









272
273
274
275
276
277
278
242
243
244
245
246
247
248








249
250
251
252
253
254
255

256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-













+
+
+
+
+
+













+
+
+
+
+
+













+
+
+
+
+
+
+
+
+







bsCheck \Ua	10
bsCheck \UA	10
bsCheck \Ua1	161
bsCheck \U4e21	20001
bsCheck \U004e21	20001
bsCheck \U00004e21	20001
bsCheck \U0000004e21	78
if {[testConstraint fullutf]} {
    bsCheck \U00110000	69632
    bsCheck \U01100000	69632
    bsCheck \U11000000	69632
    bsCheck \U0010FFFF	1114111
    bsCheck \U010FFFF0	1114111
    bsCheck \U10FFFF00	1114111
    bsCheck \UFFFFFFFF	1048575
bsCheck \U00110000	69632
bsCheck \U01100000	69632
bsCheck \U11000000	69632
bsCheck \U0010FFFF	1114111
bsCheck \U010FFFF0	1114111
bsCheck \U10FFFF00	1114111
bsCheck \UFFFFFFFF	1048575
}

test utf-11.1 {Tcl_UtfToUpper} {
    string toupper {}
} {}
test utf-11.2 {Tcl_UtfToUpper} {
    string toupper abc
} ABC
test utf-11.3 {Tcl_UtfToUpper} {
    string toupper \u00e3ab
} \u00c3AB
test utf-11.4 {Tcl_UtfToUpper} {
    string toupper \u01e3ab
} \u01e2AB
test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} {
    string toupper \u10d0\u1c90
} \u1c90\u1c90
test utf-11.6 {Tcl_UtfToUpper low/high surrogate)} {
    string toupper \udc24\ud824
} \udc24\ud824

test utf-12.1 {Tcl_UtfToLower} {
    string tolower {}
} {}
test utf-12.2 {Tcl_UtfToLower} {
    string tolower ABC
} abc
test utf-12.3 {Tcl_UtfToLower} {
    string tolower \u00c3AB
} \u00e3ab
test utf-12.4 {Tcl_UtfToLower} {
    string tolower \u01e2AB
} \u01e3ab
test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} {
    string tolower \u10d0\u1c90
} \u10d0\u10d0
test utf-12.6 {Tcl_UtfToUpper low/high surrogate)} {
    string tolower \udc24\ud824
} \udc24\ud824

test utf-13.1 {Tcl_UtfToTitle} {
    string totitle {}
} {}
test utf-13.2 {Tcl_UtfToTitle} {
    string totitle abc
} Abc
test utf-13.3 {Tcl_UtfToTitle} {
    string totitle \u00e3ab
} \u00c3ab
test utf-13.4 {Tcl_UtfToTitle} {
    string totitle \u01f3ab
} \u01f2ab
test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
    string totitle \u10d0\u1c90
} \u10d0\u1c90
test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
    string totitle \u1c90\u10d0
} \u1c90\u10d0
test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} {
    string totitle \udc24\ud824
} \udc24\ud824

test utf-14.1 {Tcl_UtfNcasecmp} {
    string compare -nocase a b
} -1
test utf-14.2 {Tcl_UtfNcasecmp} {
    string compare -nocase b a
} 1

Changes to tests/util.test.

582
583
584
585
586
587
588
589

590
591
592
593


594
595
596

597
598
599
600
601
602
603
582
583
584
585
586
587
588

589
590
591


592
593
594
595

596
597
598
599
600
601
602
603







-
+


-
-
+
+


-
+







} d
test util-9.2.1 {TclGetIntForIndex} -body {
    string index abcd { end}
} -returnCodes error -match glob -result *
test util-9.2.2 {TclGetIntForIndex} -body {
    string index abcd {end }
} -returnCodes error -match glob -result *
test util-9.3 {TclGetIntForIndex} {
test util-9.3 {TclGetIntForIndex} -body {
    # Deprecated
    string index abcd en
} d
test util-9.4 {TclGetIntForIndex} {
} -returnCodes error -match glob -result *
test util-9.4 {TclGetIntForIndex} -body {
    # Deprecated
    string index abcd e
} d
} -returnCodes error -match glob -result *
test util-9.5.0 {TclGetIntForIndex} {
    string index abcd end-1
} c
test util-9.5.1 {TclGetIntForIndex} {
    string index abcd {end-1 }
} c
test util-9.5.2 {TclGetIntForIndex} -body {
685
686
687
688
689
690
691
692

693
694
695

696
697
698

699
700
701
702
703
704
705
685
686
687
688
689
690
691

692
693
694

695
696
697

698
699
700
701
702
703
704
705







-
+


-
+


-
+







    string index a 0x
} -returnCodes error -match glob -result *
test util-9.31.1 {TclGetIntForIndex} -body {
    string index a 0d
} -returnCodes error -match glob -result *
test util-9.32 {TclGetIntForIndex} -body {
    string index a 0x1FFFFFFFF+0
} -returnCodes error -match glob -result *
} -result {}
test util-9.33 {TclGetIntForIndex} -body {
    string index a 100000000000+0
} -returnCodes error -match glob -result *
} -result {}
test util-9.33.1 {TclGetIntForIndex} -body {
    string index a 0d100000000000+0
} -returnCodes error -match glob -result *
} -result {}
test util-9.34 {TclGetIntForIndex} -body {
    string index a 1.0
} -returnCodes error -match glob -result *
test util-9.35 {TclGetIntForIndex} -body {
    string index a 1e23
} -returnCodes error -match glob -result *
test util-9.36 {TclGetIntForIndex} -body {
724
725
726
727
728
729
730
















731



























732
733
734
735
736
737
738
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    string index a 0+1e2
} -returnCodes error -match glob -result *
test util-9.43 {TclGetIntForIndex} -body {
    string index a 0+1.5e1
} -returnCodes error -match glob -result *
test util-9.44 {TclGetIntForIndex} -body {
    string index a 0+1000000000000
} -result {}
test util-9.45 {TclGetIntForIndex} {
    string index abcd end+2305843009213693950
} {}
test util-9.46 {TclGetIntForIndex} {
    string index abcd end+4294967294
} {}
# TIP 502
test util-9.47 {TclGetIntForIndex} {
    string index abcd 0x10000000000000000
} {}
test util-9.48 {TclGetIntForIndex} {
    string index abcd -0x10000000000000000
} {}
test util-9.49 {TclGetIntForIndex} -body {
    string index abcd end*1
} -returnCodes error -match glob -result *
test util-9.50 {TclGetIntForIndex} -body {
    string index abcd {end- 1}
} -returnCodes error -match glob -result *
test util-9.51 {TclGetIntForIndex} -body {
    string index abcd end-end
} -returnCodes error -match glob -result *
test util-9.52 {TclGetIntForIndex} -body {
    string index abcd end-x
} -returnCodes error -match glob -result *
test util-9.53 {TclGetIntForIndex} -body {
    string index abcd end-0.1
} -returnCodes error -match glob -result *
test util-9.54 {TclGetIntForIndex} {
    string index abcd end-0x10000000000000000
} {}
test util-9.55 {TclGetIntForIndex} {
    string index abcd end+0x10000000000000000
} {}
test util-9.56 {TclGetIntForIndex} {
    string index abcd end--0x10000000000000000
} {}
test util-9.57 {TclGetIntForIndex} {
    string index abcd end+-0x10000000000000000
} {}
test util-9.58 {TclGetIntForIndex} {
    string index abcd end--0x8000000000000000
} {}

test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
    convertDouble 0x0000000000000000
} {0.0}
test util-10.2 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
    convertDouble 0x8000000000000000
} {-0.0}

Changes to tests/var.test.

243
244
245
246
247
248
249
250

251
252
253
254
255
256
257
258
259
260
261
243
244
245
246
247
248
249

250
251
252
253

254
255
256
257
258
259
260







-
+



-







    catch {unset a}
} -constraints testupvar -body {
    set a 456
    namespace eval test_ns_var {
	catch {unset ::test_ns_var::vv}
	proc p {} {
	    # create namespace var vv linked to global a
	    testupvar 2 a {} vv namespace 
	    testupvar 1 a {} vv namespace
	}
	p
    }
    # Modified: that should create a global var according to the docs!
    list $test_ns_var::vv [set test_ns_var::vv 123] $a
} -result {456 123 123}
test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup {
    catch {unset aaaaa}
    catch {unset xxxxx}
} -body {
    set aaaaa 77777
439
440
441
442
443
444
445
446

447
448
449
450
451
452
453
438
439
440
441
442
443
444

445
446
447
448
449
450
451
452







-
+







    catch {unset six}
} -body {
    set a ""
    set five 555
    set six  666
    namespace eval test_ns_var {
        variable five 5 six
        lappend ::a $five
        lappend a $five
    }
    lappend a $test_ns_var::five \
        [set test_ns_var::six 6] [set test_ns_var::six] $six
} -cleanup {
    catch {unset five}
    catch {unset six}
} -result {5 5 6 6 666}
466
467
468
469
470
471
472
473

474
475

476
477
478
479
480
481
482
465
466
467
468
469
470
471

472
473

474
475
476
477
478
479
480
481







-
+

-
+







        variable sev:::en 7
    }
} -result {can't define "sev:::en": parent namespace doesn't exist}
test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
    set a ""
    namespace eval test_ns_var {
        variable eight 8
        lappend ::a $eight
        lappend a $eight
        variable eight
        lappend ::a $eight
        lappend a $eight
    }
    set a
} {8 8}
test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} -setup {
    catch {namespace delete test_ns_var2}
} -body {
    set a ""
774
775
776
777
778
779
780
















781
782
783
784
785
786
787
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    namespace eval :: {
	set t(1) 1
	trace variable t(1) u foo
	unset t
    }
    set x "If you see this, it worked"
} -result "If you see this, it worked"
test var-13.2 {unset array with search, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
	set s [array startsearch a]
	unset a([array nextelement a $s])
	array nextelement a $s
    }}
} -returnCodes error -result {couldn't find search "s-1-a"}
test var-13.3 {unset array with search, SIGSEGV, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
	set s [array startsearch a]
        unset a(ff)
	array nextelement a $s
    }}
} -returnCodes error -result {couldn't find search "s-1-a"}

test var-14.1 {array names syntax} -body {
    array names foo bar baz snafu
} -returnCodes 1 -match glob -result *
test var-14.2 {array names -glob} -body {
    array names tcl_platform -glob os
} -result os
817
818
819
820
821
822
823












824
825
826
827
828
829
830
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857







+
+
+
+
+
+
+
+
+
+
+
+







	set elements {1 2 3 4}
	trace add variable a write "string length \$elements ;#"
	array set a $elements
    }
} -cleanup {
    unset -nocomplain ::a ::elements
} -result {}
test var-17.2 {TclArraySet Dict shortcut only on pure value} -setup {
    unset -nocomplain a d
    set d {p 1 p 2}
    dict get $d p
    set foo 0
} -body {
    trace add variable a write "[list incr [namespace which -variable foo]];#"
    array set a $d
    set foo
} -cleanup {
    unset -nocomplain a d foo
} -result 2

test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
    set already 0
    unset -nocomplain x
} -body {
    array set x {e 1 i 1}
    trace add variable x unset {apply {args {
928
929
930
931
932
933
934






















935
936
937
938
939
940
941
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    vwait [namespace which -variable foo]
} -cleanup {
    unset -nocomplain lambda foo
} -result {}
test var-20.10 {[bc1a96407a] array set don't compile bad varname} -body {
    apply {{} {set name foo(bar); array set $name {a 1}}}
} -returnCodes error -match glob -result *
test var-20.11 {array set don't compile bad initializer} -setup {
    unset -nocomplain foo
    trace add variable foo array {set foo(bar) baz;#}
} -body {
    catch {array set foo bad}
    set foo(bar)
} -cleanup {
    unset -nocomplain foo
} -result baz
test var-20.12 {array set don't compile bad initializer} -setup {
    unset -nocomplain ::foo
    trace add variable ::foo array {set ::foo(bar) baz;#}
} -body {
    catch {apply {{} {
	set value bad
	array set ::foo $value

    }}}
    set ::foo(bar)
} -cleanup {
    unset -nocomplain ::foo
} -result baz

test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
    proc linenumber {} {dict get [info frame -1] line}
} -body {
    apply {n {
	set foo bar
        unset foo {*}{
994
995
996
997
998
999
1000


























































































































































































































































































































































































































1001
1002
1003
1004
1005
1006
1007
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
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
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







test var-22.2 {leak in parsedVarName} -constraints memory -body {
    set i 0
    leaktest {lappend x($i)}
} -cleanup {
    unset -nocomplain i x
} -result 0

unset -nocomplain a k v
test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
    array for {k v} c d e {}
} -result {wrong # args: should be "array for {key value} arrayName script"}
test var-23.2 {array command, for loop, not enough args} -returnCodes error -body {
    array for {k v} {}
} -result {wrong # args: should be "array for {key value} arrayName script"}
test var-23.3 {array command, for loop, too many list args} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k v w} a {}
} -result {must have two variable names}
test var-23.4 {array command, for loop, not enough list args} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k} a {}
} -result {must have two variable names}
test var-23.5 {array command, for loop, no array} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k v} a {}
} -result {"a" isn't an array}
test var-23.6 {array command, for loop, array doesn't exist yet but has compiler-allocated procedure slot} -setup {
    catch {rename p ""}
} -returnCodes error -body {
    apply {{x} {
        if {$x==1} {
            return [array for {k v} a {}]
        }
        set a(x) 123
    }} 1
} -result {"a" isn't an array}
test var-23.7 {array enumeration} -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k v} a {
	lappend reslist $k $v
    }
    lsort -stride 2 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1 b 2 c 3}
test var-23.9 {array enumeration, nested} -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k1 v1} a {
	lappend reslist $k1 $v1
	set r2 {}
	array for {k2 v2} a {
	    lappend r2 $k2 $v2
	}
	lappend reslist [lsort -stride 2 -index 0 $r2]
    }
    # there is no guarantee in which order the array contents will be
    # returned.
    lsort -stride 3 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1 {a 1 b 2 c 3} b 2 {a 1 b 2 c 3} c 3 {a 1 b 2 c 3}}
test var-23.10 {array enumeration, delete key} -match glob -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    set retval {}
    try {
      array set a {a 1 b 2 c 3 d 4}
      array for {k v} a {
  	lappend reslist $k $v
          if { $k eq "a" } {
            unset a(c)
          }
      }
      lsort -stride 2 -index 0 $reslist
    } on error {err res} {
      set retval [dict get $res -errorinfo]
    }
    set retval
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
    unset -nocomplain retval
} -result {array changed during iteration*}
test var-23.11 {array enumeration, insert key} -match glob -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    set retval {}
    try {
      array set a {a 1 b 2 c 3 d 4}
      array for {k v} a {
  	lappend reslist $k $v
          if { $k eq "a" } {
            set a(e) 5
          }
      }
      lsort -stride 2 -index 0 $reslist
    } on error {err res} {
      set retval [dict get $res -errorinfo]
    }
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {array changed during iteration*}
test var-23.12 {array enumeration, change value} -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k v} a {
	lappend reslist $k $v
        if { $k eq "a" } {
          set a(c) 9
        }
    }
    lsort -stride 2 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1 b 2 c 9}
test var-23.13 {array enumeration, number of traces} -setup {
    set ::countarrayfor 0
    proc ::tracearrayfor { args } {
      incr ::countarrayfor
    }
    unset -nocomplain ::a
    set reslist [list]
} -body {
    array set ::a {a 1 b 2 c 3}
    foreach {k} [array names a] {
      trace add variable ::a($k) read ::tracearrayfor
    }
    array for {k v} ::a {
	lappend reslist $k $v
    }
    set ::countarrayfor
} -cleanup {
    unset -nocomplain ::countarrayfor
    unset -nocomplain ::a
    unset -nocomplain reslist
} -result 3
test var-23.14 {array for, shared arguments} -setup {
    set vn {k v}
    unset -nocomplain $vn
} -body {
    array set $vn {a 1 b 2 c 3}
    array for $vn $vn {}
} -cleanup {
    unset -nocomplain $vn vn
} -result {}

test var-24.1 {array default set and get: interpreted} -setup {
    unset -nocomplain ary
} -body {
    array set ary {a 3}
    array default set ary 7
    list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
	[array default get ary]
} -cleanup {
    unset -nocomplain ary
} -result {3 7 1 0 7}
test var-24.2 {array default set and get: compiled} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
	    [array default get ary]
    }}
} {3 7 1 0 7}
test var-24.3 {array default unset: interpreted} -setup {
    unset -nocomplain ary
} -body {
    array set ary {a 3}
    array default set ary 7
    list $ary(a) $ary(b) [array default unset ary] $ary(a) [catch {set ary(b)}]
} -cleanup {
    unset -nocomplain ary
} -result {3 7 {} 3 1}
test var-24.4 {array default unset: compiled} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	list $ary(a) $ary(b) [array default unset ary] $ary(a) \
	    [catch {set ary(b)}]
    }}
} {3 7 {} 3 1}
test var-24.5 {array default exists: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array set ary {a 3}
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default set ary 7
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default unset ary
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    unset ary
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default set ary 11
    lappend result [info exists ary],[array exists ary],[array default exists ary]
} -cleanup {
    unset -nocomplain ary result
} -result {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
test var-24.6 {array default exists: compiled} {
    apply {{} {
	array set ary {a 3}
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default set ary 7
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default unset ary
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	unset ary
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default set ary 11
	lappend result [info exists ary],[array exists ary],[array default exists ary]
    }}
} {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
test var-24.7 {array default and append: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary grill
    lappend result [array size ary] [info exist ary(x)]
    append ary(x) abc
    lappend result [array size ary] $ary(x)
    array default unset ary
    append ary(x) def
    append ary(y) ghi
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 grillabc 2 grillabcdef ghi}
test var-24.8 {array default and append: compiled} {
    apply {{} {
	array default set ary grill
	lappend result [array size ary] [info exist ary(x)]
	append ary(x) abc
	lappend result [array size ary] $ary(x)
	array default unset ary
	append ary(x) def
	append ary(y) ghi
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 grillabc 2 grillabcdef ghi}
test var-24.9 {array default and lappend: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary grill
    lappend result [array size ary] [info exist ary(x)]
    lappend ary(x) abc
    lappend result [array size ary] $ary(x)
    array default unset ary
    lappend ary(x) def
    lappend ary(y) ghi
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 {grill abc} 2 {grill abc def} ghi}
test var-24.10 {array default and lappend: compiled} {
    apply {{} {
	array default set ary grill
	lappend result [array size ary] [info exist ary(x)]
	lappend ary(x) abc
	lappend result [array size ary] $ary(x)
	array default unset ary
	lappend ary(x) def
	lappend ary(y) ghi
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 {grill abc} 2 {grill abc def} ghi}
test var-24.11 {array default and incr: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary 7
    lappend result [array size ary] [info exist ary(x)]
    incr ary(x) 11
    lappend result [array size ary] $ary(x)
    array default unset ary
    incr ary(x)
    incr ary(y)
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 18 2 19 1}
test var-24.12 {array default and incr: compiled} {
    apply {{} {
	array default set ary 7
	lappend result [array size ary] [info exist ary(x)]
	incr ary(x) 11
	lappend result [array size ary] $ary(x)
	array default unset ary
	incr ary(x)
	incr ary(y)
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 18 2 19 1}
test var-24.13 {array default and dict: interpreted} -setup {
    unset -nocomplain ary x y z
} -body {
    array default set ary {x y}
    dict lappend ary(p) x z
    dict update ary(q) x y {
	set y z
    }
    dict with ary(r) {
	set x 123
    }
    lsort -stride 2 -index 0 [array get ary]
} -cleanup {
    unset -nocomplain ary x y z
} -result {p {x {y z}} q {x z} r {x 123}}
test var-24.14 {array default and dict: compiled} {
    lsort -stride 2 -index 0 [apply {{} {
	array default set ary {x y}
	dict lappend ary(p) x z
	dict update ary(q) x y {
	    set y z
	}
	dict with ary(r) {
	    set x 123
	}
	array get ary
    }}]
} {p {x {y z}} q {x z} r {x 123}}
test var-24.15 {array default set and get: two-level} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	apply {{} {
	    upvar 1 ary ary ary(c) c
	    lappend result $ary(a) $ary(b) $c
	    lappend result [info exist ary(a)] [info exist ary(b)] [info exist c]
	    lappend result [array default get ary]
	}}
    }}
} {3 7 7 1 0 0 7}
test var-24.16 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default set ary 7
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {can't array default set "ary": variable isn't array}
test var-24.17 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    array default set ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.18 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    array default set ary x y
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.19 {array default get: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default get ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.20 {array default get: errors} -setup {
    unset -nocomplain ary
} -body {
    array default get ary x y
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.21 {array default exists: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default exists ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.22 {array default exists: errors} -setup {
    unset -nocomplain ary
} -body {
    array default exists ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.23 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default unset ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.24 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    array default unset ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob

catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
catch {rename p ""}

Changes to tests/while-old.test.

88
89
90
91
92
93
94
95

96
97
98
99
100
101
102
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102







-
+







test while-old-4.3 {errors in while loops} {
    set err [catch {while 1 2 3} msg]
    list $err $msg
} {1 {wrong # args: should be "while test command"}}
test while-old-4.4 {errors in while loops} {
    set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
    list $err $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test while-old-4.5 {errors in while loops} {
    catch {unset x}
    set x 1
    set err [catch {while {$x} {set x foo}} msg]
    list $err $msg
} {1 {expected boolean value but got "foo"}}
test while-old-4.6 {errors in while loops} {

Changes to tests/while.test.

28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42







-
+







    catch {while {$i<} break}
    return $::errorInfo
} -cleanup {
    unset i
} -match glob -result {*"while {$i<} break"}
test while-1.3 {TclCompileWhileCmd: error in test expression} -body {
    while {"a"+"b"} {error "loop aborted"}
} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
} -returnCodes error -result {can't use non-numeric string as operand of "+"}
test while-1.4 {TclCompileWhileCmd: multiline test expr} -body {
    set value 1
    while {($tcl_platform(platform) != "foobar1") && \
	    ($tcl_platform(platform) != "foobar2")} {
        incr value
        break
    }
339
340
341
342
343
344
345
346

347
348
349
350
351
352
353
339
340
341
342
343
344
345

346
347
348
349
350
351
352
353







-
+







    return $::errorInfo
} -match glob -cleanup {
    unset i z
} -result {*"$z {$i<} {set x 1}"}
test while-4.4 {while (not compiled): error in test expression} -body {
    set z while
    $z {"a"+"b"} {error "loop aborted"}
} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
} -returnCodes error -result {can't use non-numeric string as operand of "+"}
test while-4.5 {while (not compiled): multiline test expr} -body {
    set value 1
    set z while
    $z {($tcl_platform(platform) != "foobar1") && \
	    ($tcl_platform(platform) != "foobar2")} {
        incr value
        break

Changes to tests/winDde.test.

16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30







-
+







}

testConstraint debug [::tcl::pkgconfig get debug]
testConstraint dde 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::ddever [package require dde 1.4.0]
	    set ::ddever [package require dde 1.4.1]
	    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
	testConstraint dde 1
    }
}


# -------------------------------------------------------------------------
100
101
102
103
104
105
106
107

108
109
110
111
112
113
114
100
101
102
103
104
105
106

107
108
109
110
111
112
113
114







-
+







    gets $f line
    return $f
}

# -------------------------------------------------------------------------
test winDde-1.0 {check if we are testing the right dll} {win dde} {
    set ::ddever
} {1.4.0}
} {1.4.1}

test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
    list [dde servername foobar] [dde servername] [dde servername self]
} -result {foobar foobar self}

test winDde-2.1 {Checking for other services} -constraints dde -body {
    expr [llength [dde services {} {}]] >= 0

Changes to tests/winFCmd.test.

52
53
54
55
56
57
58
59

60
61
62

63
64
65
66
67
68
69
52
53
54
55
56
57
58

59

60

61
62
63
64
65
66
67
68







-
+
-

-
+







	if {$x != ""} {
	    catch {file delete -force -- {*}$x}
	}
    }
}

if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]
    if {$::tcl_platform(osVersion) >= 5.0} {
    if {$major > 5} {
	testConstraint winVista 1
    } elseif {$major == 5} {
    } else {
	testConstraint winXP 1
    }
}

# find a CD-ROM so we can test read-only filesystems.

proc findfile {dir} {
1052
1053
1054
1055
1056
1057
1058









1059
1060
1061
1062
1063
1064
1065
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073







+
+
+
+
+
+
+
+
+







    catch {file delete -force -- c:/td1}
} -constraints {win winXP} -body {
    createfile c:/td1 {}
    string tolower [file attributes c:/td1 -longname]
} -cleanup {
    file delete -force -- c:/td1
} -result {c:/td1}
test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup {
    catch {file delete -force -- $::env(TEMP)/td1}
} -constraints {win} -body {
    createfile $::env(TEMP)/td1 {}
    string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \
	    [string tolower [file normalize $::env(TEMP)]/td1]
} -cleanup {
    file delete -force -- $::env(TEMP)/td1
} -result 1
test winFCmd-12.7 {ConvertFileNameFormat} -body {
    string tolower [file attributes //bisque/tcl/ws -longname]
} -constraints {nonPortable win} -result {//bisque/tcl/ws}
test winFCmd-12.8 {ConvertFileNameFormat} -setup {
    cleanup
} -constraints {win longFileNames} -body {
    createfile td1 {}

Changes to tests/winPipe.test.

26
27
28
29
30
31
32

33
34
35
36
37
38
39
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40







+







set cat32 [file join $bindir cat32.exe]

testConstraint exec         [llength [info commands exec]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]
testConstraint testexcept   [llength [info commands testexcept]]
testConstraint slowTest     0


set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
append big $big
append big $big
append big $big
304
305
306
307
308
309
310



311
312
313













































314
315
316
317
318
319
320
305
306
307
308
309
310
311
312
313
314



315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366







+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    puts -nonewline $f $big$big$big$big
    flush $f
    after 100 { lappend x timeout }
    vwait x
    lappend x [catch {close $f} msg] $msg
} {writable timeout 0 {}}

proc _testExecArgs {single args} {
    variable path
    if {![info exists path(echoArgs.tcl)] || ![file exists $path(echoArgs.tcl)]} {
set path(echoArgs.tcl) [makeFile {
    puts "[list $argv0 $argv]"
} echoArgs.tcl]
	set path(echoArgs.tcl) [makeFile {
	    puts "[list [file tail $argv0] {*}$argv]"
	} echoArgs.tcl]
    }
    if {![info exists path(echoArgs.bat)] || ![file exists $path(echoArgs.bat)]} {
	set path(echoArgs.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" "echoArgs.bat"]
    }
    set cmds [list [list [interpreter] $path(echoArgs.tcl)]]
    if {!($single & 2)} {
	lappend cmds [list $path(echoArgs.bat)]
    } else {
	if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} {
	    set path(echoArgs2.bat) [makeFile \
		"@[file native [interpreter]] $path(echoArgs.tcl) %*" \
		"echo(Cmd)Test Args & Batch.bat" [makeDirectory test(Dir)Check]]
	}
	lappend cmds [list $path(echoArgs2.bat)]
    }
    set broken {}
    foreach args $args {
	if {$single & 1} {
	    # enclose single test-arg between 1st/3rd to be sure nothing is truncated
	    # (e. g. to cover unexpected trim by nts-zero case, and args don't recombined):
	    set args [list "1st" $args "3rd"]
	}
	set args [list {*}$args]; # normalized canonical list
	foreach cmd $cmds {
	    set e [linsert $args 0 [file tail $path(echoArgs.tcl)]]
	    tcltest::DebugPuts 4 "  ## test exec [file extension [lindex $cmd 0]] ($cmd) for\n  ##   $args"
	    if {[catch {
		exec {*}$cmd {*}$args
	    } r]} {
		set r "ERROR: $r"
	    }
	    if {$r ne $e} {
		append broken "\[ERROR\]: exec [file extension [lindex $cmd 0]] on $args\n  -- result:\n$r\n  -- expected:\n$e\n"
	    }
	    if {$single & 8} {
		# if test exe only:
		break
	    }
	}
    }
    return $broken
}

### validate the raw output of BuildCommandLine().
###
test winpipe-7.1 {BuildCommandLine: null arguments} {win exec} {
    exec $env(COMSPEC) /c echo foo "" bar
} {foo "" bar}
test winpipe-7.2 {BuildCommandLine: null arguments} {win exec} {
364
365
366
367
368
369
370


































































371
372
373
374
375
376





377
378
379


380
381
382
383
384
385
386
387
388
389























390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406



























407
408
409














410
411
412






413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430



























431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448



449
450
451
452
453
454
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485



486
487
488
489
490



491
492










493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515

















516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542



543
544
545
546
547
548
549
550
551
552
553
554
555
556



557
558
559
560
561
562


















563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606

607
608
609
610
611
612
613
614
615







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

















-
+
+
+






} {foo "\ \\\\\\\"" bar}
test winpipe-7.17 {BuildCommandLine: special chars #4} {win exec} {
    exec $env(COMSPEC) /c echo foo \{ bar
} "foo \{ bar"
test winpipe-7.18 {BuildCommandLine: special chars #5} {win exec} {
    exec $env(COMSPEC) /c echo foo \} bar
} "foo \} bar"

set injectList {
    {test"whoami}     {test""whoami}
    {test"""whoami}   {test""""whoami}

    "test\"whoami\\"     "test\"\"whoami\\"
    "test\"\"\"whoami\\" "test\"\"\"\"whoami\\"

    {test\\&\\test}    {test"\\&\\test}
    {"test\\&\\test}   {"test"\\&\\"test"}
    {test\\"&"\\test}  {test"\\"&"\\test}
    {"test\\"&"\\test} {"test"\\"&"\\"test"}

    {test\"&whoami}    {test"\"&whoami}
    {test""\"&whoami}  {test"""\"&whoami}
    {test\"\&whoami}   {test"\"\&whoami}
    {test""\"\&whoami} {test"""\"\&whoami}

    {test&whoami}    {test|whoami}
    {"test&whoami}   {"test|whoami}
    {test"&whoami}   {test"|whoami}
    {"test"&whoami}  {"test"|whoami}
    {""test"&whoami} {""test"|whoami}

    {test&echo "}    {test|echo "}
    {"test&echo "}   {"test|echo "}
    {test"&echo "}   {test"|echo "}
    {"test"&echo "}  {"test"|echo "}
    {""test"&echo "} {""test"|echo "}

    {test&echo ""}    {test|echo ""}
    {"test&echo ""}   {"test|echo ""}
    {test"&echo ""}   {test"|echo ""}
    {"test"&echo ""}  {"test"|echo ""}
    {""test"&echo ""} {""test"|echo ""}

    {test>whoami}    {test<whoami}
    {"test>whoami}   {"test<whoami}
    {test">whoami}   {test"<whoami}
    {"test">whoami}  {"test"<whoami}
    {""test">whoami} {""test"<whoami}
    {test(whoami)}   {test(whoami)}
    {test"(whoami)}  {test"(whoami)}
    {test^whoami}    {test^^echo ^^^}
    {test"^whoami}   {test"^^echo ^^^}
    {test"^echo ^^^"} {test""^echo" ^^^"}

    {test%USERDOMAIN%\%USERNAME%}
    {test" %USERDOMAIN%\%USERNAME%}
    {test%USERDOMAIN%\\%USERNAME%}
    {test" %USERDOMAIN%\\%USERNAME%}
    {test%USERDOMAIN%&%USERNAME%}
    {test" %USERDOMAIN%&%USERNAME%}
    {test%USERDOMAIN%\&\%USERNAME%}
    {test" %USERDOMAIN%\&\%USERNAME%}

    {test%USERDOMAIN%\&\test}
    {test" %USERDOMAIN%\&\test}
    {test%USERDOMAIN%\\&\\test}
    {test" %USERDOMAIN%\\&\\test}

    {test%USERDOMAIN%\&\"test}
    {test" %USERDOMAIN%\&\"test}
    {test%USERDOMAIN%\\&\\"test}
    {test" %USERDOMAIN%\\&\\"test}
}

### validate the pass-thru from BuildCommandLine() to the crt's parse_cmdline().
###
test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo "" bar
} [list $path(echoArgs.tcl) [list foo {} bar]]
test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: dumped arguments are equal original} \
-constraints {win exec} -body {
    _testExecArgs 0 \
	[list foo "" bar] \
	[list foo {} bar] \
test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo {} bar
} [list $path(echoArgs.tcl) [list foo {} bar]]
	[list foo "\"" bar] \
	[list foo {""} bar] \
test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #1} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo "\"" bar
} [list $path(echoArgs.tcl) [list foo "\"" bar]]
test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #2} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo {""} bar
} [list $path(echoArgs.tcl) [list foo {""} bar]]
test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #3} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo "\" " bar
} [list $path(echoArgs.tcl) [list foo "\" " bar]]
test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #4} {win exec} {
	[list foo "\" " bar] \
	[list foo {a="b"} bar] \
	[list foo {a = "b"} bar] \
	[list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}] \
	[list foo \\ bar] \
	[list foo \\\\ bar] \
	[list foo \\\ \\ bar] \
	[list foo \\\ \\\\ bar] \
	[list foo \\\ \\\\\\ bar] \
	[list foo \\\ \\\" bar] \
	[list foo \\\ \\\\\" bar] \
	[list foo \\\ \\\\\\\" bar] \
	[list foo \{ bar] \
	[list foo \} bar] \
	[list foo * makefile.?c bar]
} -result {}

test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (particular)} \
-constraints {win exec slowTest} -body {
    _testExecArgs 1 {*}$injectList
} -result {}

test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (jointly)} \
    exec [interpreter] $path(echoArgs.tcl) foo {a="b"} bar
} [list $path(echoArgs.tcl) [list foo {a="b"} bar]]
test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #5} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo {a = "b"} bar
} [list $path(echoArgs.tcl) [list foo {a = "b"} bar]]
test winpipe-8.8 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #6} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}
} [list $path(echoArgs.tcl) [list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}]]
test winpipe-8.9 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #1} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\ bar
} [list $path(echoArgs.tcl) [list foo \\ bar]]
test winpipe-8.10 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #2} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\\ bar
} [list $path(echoArgs.tcl) [list foo \\\\ bar]]
test winpipe-8.11 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #3} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\ bar
} [list $path(echoArgs.tcl) [list foo \\\ \\ bar]]
-constraints {win exec} -body {
    _testExecArgs 0 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (command/jointly args)} \
-constraints {win exec} -body {
    _testExecArgs 2 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (random mix)} \
-constraints {win exec} -body {
    set lst {}
    set maps {
	{\&|^<>!()%}
	{\&|^<>!()% }
	{"\&|^<>!()%}
	{"\&|^<>!()% }
	{"""""\\\\\&|^<>!()%}
	{"""""\\\\\&|^<>!()% }
test winpipe-8.12 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #4} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\ bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\\ bar]]
    }
    set i 0
    time {
	set args {[incr i].}
	time {
	    set map [lindex $maps [expr {int(rand()*[llength $maps])}]]
	    # be sure arg has some prefix (avoid special handling, like |& etc)
	    set a {x}
	    while {[string length $a] < 50} {
		append a [string index $map [expr {int(rand()*[string length $map])}]]
	    }
	    lappend args $a
	} 20
	lappend lst $args
test winpipe-8.13 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #5} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\ bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\\\\ bar]]
    } 10
    _testExecArgs 0 {*}$lst
} -result {} -cleanup {
    unset -nocomplain lst args a map maps
}

test winpipe-8.14 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #6} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\" bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\" bar]]
test winpipe-8.15 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #7} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\" bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\\\" bar]]
test winpipe-8.16 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #8} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\\" bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\\\\\" bar]]
test winpipe-8.17 {BuildCommandLine/parse_cmdline pass-thru: special chars #1} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \{ bar
} [list $path(echoArgs.tcl) [list foo \{ bar]]
test winpipe-8.18 {BuildCommandLine/parse_cmdline pass-thru: special chars #2} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo \} bar
} [list $path(echoArgs.tcl) [list foo \} bar]]
test winpipe-8.19 {ensure parse_cmdline isn't doing wildcard replacement} {win exec} {
    exec [interpreter] $path(echoArgs.tcl) foo * makefile.?c bar
} [list $path(echoArgs.tcl) [list foo * makefile.?c bar]]
set injectList {
    "test\"\nwhoami"     "test\"\"\nwhoami"
    "test\"\"\"\nwhoami" "test\"\"\"\"\nwhoami"
    "test;\n&echo \""    "\"test;\n&echo \""
    "test\";\n&echo \""  "\"test\";\n&echo \""
    "\"\"test\";\n&echo \""
}

test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args} \
-constraints {win exec} -body {
    # test exe only, because currently there is no proper way to escape a new-line char resp.
    # to supply a new-line to the batch-files within arguments (command line is truncated).
    _testExecArgs 8 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args (batch)} \
-constraints {win exec knownBug} -body {
    # this will fail if executed batch-file, because currently there is no proper way to escape a new-line char.
    _testExecArgs 0 $injectList
} -result {}


rename _testExecArgs {}

# restore old values for env(TMP) and env(TEMP)

if {[catch {set env(TMP) $env_tmp}]} {
    unset env(TMP)
}
if {[catch {set env(TEMP) $env_temp}]} {
    unset env(TEMP)
}

# cleanup
removeFile little
removeFile big
removeFile more
removeFile stdout
removeFile stderr
removeFile nothing
removeFile echoArgs.tcl
if {[info exists path(echoArgs.tcl)]} { removeFile echoArgs.tcl }
if {[info exists path(echoArgs.bat)]} { removeFile echoArgs.bat }
if {[info exists path(echoArgs2.bat)]} { removeDirectory test(Dir)Check }
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Added tests/zipfs.test.





























































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# The file tests the tclZlib.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

testConstraint zipfs [expr {
    [llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]
}]
testConstraint zipfslib 1

# Removed in tip430 - zipfs is no longer a static package
#test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
#    load {} zipfs
#} -result {}

set ziproot [zipfs root]
set CWD [pwd]
set tmpdir  [file join $CWD tmp]
file mkdir $tmpdir

test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
    package require zipfs
} -result {2.0}
test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
    expr {${ziproot} in [file volumes]}
} -result 1

if {![string match ${ziproot}* $tcl_library]} {
    ###
    # "make test" does not map tcl_library from the dynamic library on Unix
    #
    # Hack the environment to pretend we did pull tcl_library from a zip
    # archive
    ###
    set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]]
    testConstraint zipfslib [file exists $tclzip]
    if {[testConstraint zipfslib]} {
        zipfs mount /lib/tcl $tclzip
        set ::tcl_library ${ziproot}lib/tcl/tcl_library
    }
}

test zipfs-0.2 {zipfs basics} -constraints zipfslib -body {
    string match ${ziproot}* $tcl_library
} -result 1
test zipfs-0.3 {zipfs basics: glob} -constraints zipfslib -setup {
    set pwd [pwd]
} -body {
    cd $tcl_library
    lsort [glob -dir . http*]
} -cleanup {
    cd $pwd
} -result {./http}
test zipfs-0.4 {zipfs basics: glob} -constraints zipfslib -setup {
    set pwd [pwd]
} -body {
    cd $tcl_library
    lsort [glob -dir [pwd] http*]
} -cleanup {
    cd $pwd
} -result [list $tcl_library/http]
test zipfs-0.5 {zipfs basics: glob} -constraints zipfslib -body {
    lsort [glob -dir $tcl_library http*]
} -result [list $tcl_library/http]
test zipfs-0.6 {zipfs basics: glob} -constraints zipfslib -body {
    lsort [glob $tcl_library/http*]
} -result [list $tcl_library/http]
test zipfs-0.7 {zipfs basics: glob} -constraints zipfslib -body {
    lsort [glob -tails -dir $tcl_library http*]
} -result {http}
test zipfs-0.8 {zipfs basics: glob} -constraints zipfslib -body {
    lsort [glob -nocomplain -tails -types d -dir $tcl_library http*]
} -result {http}
test zipfs-0.9 {zipfs basics: glob} -constraints zipfslib -body {
    lsort [glob -nocomplain -tails -types f -dir $tcl_library http*]
} -result {}
test zipfs-0.10 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
    file join [zipfs root] bar baz
} -result "[zipfs root]bar/baz"
test zipfs-0.11 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
    file normalize [zipfs root]
} -result "[zipfs root]"
test zipfs-0.12 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
    file normalize [zipfs root]//bar/baz//qux/../
} -result "[zipfs root]bar/baz"

test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mount a b c d e f
} -result {wrong # args: should be "zipfs mount ?mountpoint? ?zipfile? ?password?"}
test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs unmount a b c d e f
} -result {wrong # args: should be "zipfs unmount zipfile"}
test zipfs-1.5 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkkey a b c d e f
} -result {wrong # args: should be "zipfs mkkey password"}
test zipfs-1.6 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkimg a b c d e f
} -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"}
test zipfs-1.7 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkzip a b c d e f
} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
test zipfs-1.8 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs exists a b c d e f
} -result {wrong # args: should be "zipfs exists filename"}
test zipfs-1.9 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs info a b c d e f
} -result {wrong # args: should be "zipfs info filename"}
test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs list a b c d e f
} -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"}

file mkdir tmp
test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body {
    zipfs mkzip [file join $tmpdir empty.zip] $tcl_library/xxxx
} -result {empty archive}
###
# The next series of tests operate within a zipfile created a temporary
# directory.
###
set zipfile [file join $tmpdir abc.zip]
if {[file exists $zipfile]} {
   file delete $zipfile
}
test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body {
    cd $tcl_library/encoding
    zipfs mkzip $zipfile .
    zipfs mount ${ziproot}abc $zipfile
    zipfs list -glob ${ziproot}abc/cp850.*
} -cleanup {
    cd $CWD
} -result "[zipfs root]abc/cp850.enc"
testConstraint zipfsenc [zipfs exists /abc/cp850.enc]
test zipfs-2.3 {zipfs info} -constraints {zipfs zipfsenc} -body {
    set r [zipfs info ${ziproot}abc/cp850.enc]
    lrange $r 0 2
} -result [list $zipfile 1090 527] ;# NOTE: Only the first 3 results are stable
test zipfs-2.4 {zipfs data} -constraints {zipfs zipfsenc} -body {
    set zipfd [open ${ziproot}/abc/cp850.enc]	;# FIXME: leave open - see later test
    read $zipfd
} -result {# Encoding file: cp850, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
2591259225932502252400C100C200C000A9256325512557255D00A200A52510
25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
} ;# FIXME: result depends on content of encodings dir
test zipfs-2.5 {zipfs exists} -constraints {zipfs zipfsenc} -body {
    zipfs exists /abc/cp850.enc
} -result 1
test zipfs-2.6 {zipfs unmount while busy} -constraints {zipfs zipfsenc} -body {
    zipfs unmount /abc
} -returnCodes error -result {filesystem is busy}
test zipfs-2.7 {zipfs unmount} -constraints {zipfs zipfsenc} -body {
    close $zipfd
    zipfs unmount /abc
    zipfs exists /abc/cp850.enc
} -result 0
###
# Repeat the tests for a buffer mounted archive
###
test zipfs-2.8 {zipfs mkzip} -constraints zipfs -body {
    cd $tcl_library/encoding
    zipfs mkzip $zipfile .
    set fin [open $zipfile r]
    fconfigure $fin -translation binary
    set dat [read $fin]
    close $fin
    zipfs mount_data def $dat
    zipfs list -glob ${ziproot}def/cp850.*
} -cleanup {
    cd $CWD
} -result "[zipfs root]def/cp850.enc"
testConstraint zipfsencbuf [zipfs exists /def/cp850.enc]
test zipfs-2.9 {zipfs info} -constraints {zipfs zipfsencbuf} -body {
    set r [zipfs info ${ziproot}def/cp850.enc]
    lrange $r 0 2
} -result [list {Memory Buffer} 1090 527] ;# NOTE: Only the first 3 results are stable
test zipfs-2.10 {zipfs data} -constraints {zipfs zipfsencbuf} -body {
    set zipfd [open ${ziproot}/def/cp850.enc]	;# FIXME: leave open - see later test
    read $zipfd
} -result {# Encoding file: cp850, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
2591259225932502252400C100C200C000A9256325512557255D00A200A52510
25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
} ;# FIXME: result depends on content of encodings dir
test zipfs-2.11 {zipfs exists} -constraints {zipfs zipfsencbuf} -body {
    zipfs exists /def/cp850.enc
} -result 1
test zipfs-2.12 {zipfs unmount while busy} -constraints {zipfs zipfsencbuf} -body {
    zipfs unmount /def
} -returnCodes error -result {filesystem is busy}
test zipfs-2.13 {zipfs unmount} -constraints {zipfs zipfsencbuf} -body {
    close $zipfd
    zipfs unmount /def
    zipfs exists /def/cp850.enc
} -result 0

catch {file delete -force $tmpdir}

test zipfs-3.1 {zipfs in child interpreters} -constraints zipfs -setup {
    set interp [interp create]
} -body {
    interp eval $interp {
	zipfs ?
    }
} -returnCodes error -cleanup {
    interp delete $interp
} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount}
test zipfs-3.2 {zipfs in child interpreters} -constraints zipfs -setup {
    set interp [interp create]
} -body {
    interp eval $interp {
	zipfs mkzip
    }
} -returnCodes error -cleanup {
    interp delete $interp
} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
test zipfs-3.3 {zipfs in child interpreters} -constraints zipfs -setup {
    set safe [interp create -safe]
} -body {
    interp eval $safe {
	zipfs ?
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount}
test zipfs-3.4 {zipfs in child interpreters} -constraints zipfs -setup {
    set safe [interp create -safe]
} -body {
    interp eval $safe {
	zipfs mkzip
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand mkzip of zipfs}

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tools/README.

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22







-
+







uniClass.tcl -- Script for generating regexp class tables from the Tcl
	"string is" classes

Generating HTML files.
The tcl-tk-man-html.tcl script from Robert Critchlow
generates a nice set of HTML with good cross references.
Use it like
    tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl9.0
    tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl8.2
This script is very picky about the organization of man pages,
effectively acting as a style enforcer.

Generating Windows Help Files:
1) Build tcl in the ../unix directory
2) On UNIX, (after autoconf and configure), do
	make

Changes to tools/checkLibraryDoc.tcl.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







# checkLibraryDoc.tcl --
#
# This script attempts to determine what APIs exist in the source base that
# have not been documented.  By grepping through all of the doc/*.3 man
# pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list
# against the list of Pkg_ APIs found in the source (e.g., tcl9.0/*/*.[ch])
# against the list of Pkg_ APIs found in the source (e.g., tcl8.2/*/*.[ch])
# we create six lists:
#      1) APIs in Source not in Docs.
#      2) APIs in Docs not in Source.
#      3) Internal APIs and structs.
#      4) Misc APIs and structs that we are not documenting.
#      5) Command APIs (e.g., Tcl_ArrayObjCmd.)
#      6) Proc pointers (e.g., Tcl_CloseProc.)
102
103
104
105
106
107
108
109

110
111
112
113
114
115
116
102
103
104
105
106
107
108

109
110
111
112
113
114
115
116







-
+







    global argv0
    global argv

    set len [llength $argv]
    if {($len != 2) && ($len != 3)} {
	puts "usage: $argv0 pkgName pkgDir \[outFile\]"
	puts "   pkgName == Tcl,Tk"
	puts "   pkgDir  == /home/surles/cvs/tcl9.0"
	puts "   pkgDir  == /home/surles/cvs/tcl8.2"
	exit 1
    }

    set pkg [lindex $argv 0]
    set dir [lindex $argv 1]
    if {[llength $argv] == 3} {
	set file [open [lindex $argv 2] w]

Changes to tools/configure.

1677
1678
1679
1680
1681
1682
1683
1684

1685
1686
1687
1688
1689
1690
1691
1677
1678
1679
1680
1681
1682
1683

1684
1685
1686
1687
1688
1689
1690
1691







-
+







# Recover information that Tcl computed with its configure script.

#--------------------------------------------------------------------
#       See if there was a command-line option for where Tcl is;  if
#       not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------

DEF_VER=9.0
DEF_VER=8.7


# Check whether --with-tcl was given.
if test "${with_tcl+set}" = set; then :
  withval=$with_tcl; TCL_BIN_DIR=$withval
else
  TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`

Changes to tools/configure.ac.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21













-
+







dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run to configure the
dnl	Makefile in this directory.
AC_INIT(man2tcl.c)
AC_PREREQ(2.69)

# Recover information that Tcl computed with its configure script.

#--------------------------------------------------------------------
#       See if there was a command-line option for where Tcl is;  if
#       not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------

DEF_VER=9.0
DEF_VER=8.7

AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`)
if test ! -d $TCL_BIN_DIR; then
    AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
    AC_MSG_ERROR(There's no tclConfig.sh in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)

Changes to tools/genStubs.tcl.

194
195
196
197
198
199
200







201
202
203
204
205
206
207
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214







+
+
+
+
+
+
+







    if {([lindex $platformList 0] eq "deprecated")} {
	set stubs($curName,deprecated,$index) [lindex $platformList 1]
	set stubs($curName,generic,$index) $decl
	if {![info exists stubs($curName,generic,lastNum)] \
		|| ($index > $stubs($curName,generic,lastNum))} {
	    set stubs($curName,generic,lastNum) $index
	}
    } elseif {([lindex $platformList 0] eq "nostub")} {
	set stubs($curName,nostub,$index) [lindex $platformList 1]
	set stubs($curName,generic,$index) $decl
	if {![info exists stubs($curName,generic,lastNum)] \
		|| ($index > $stubs($curName,generic,lastNum))} {
	    set stubs($curName,generic,lastNum) $index
	}
    } else {
	foreach platform $platformList {
	    if {$decl ne ""} {
		set stubs($curName,$platform,$index) $decl
		    if {![info exists stubs($curName,$platform,lastNum)] \
			    || ($index > $stubs($curName,$platform,lastNum))} {
			set stubs($curName,$platform,lastNum) $index
589
590
591
592
593
594
595


596
597
598
599
600
601
602
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611







+
+








    set lfname [string tolower [string index $fname 0]]
    append lfname [string range $fname 1 end]

    set text "    "
    if {[info exists stubs($name,deprecated,$index)]} {
	append text "TCL_DEPRECATED_API(\"$stubs($name,deprecated,$index)\") "
    } elseif {[info exists stubs($name,nostub,$index)]} {
	append text "TCL_DEPRECATED_API(\"$stubs($name,nostub,$index)\") "
    }
    if {$args eq ""} {
	append text $rtype " *" $lfname "; /* $index */\n"
	return $text
    }
    if {[string range $rtype end-8 end] eq "__stdcall"} {
	append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
701
702
703
704
705
706
707



708
709
710
711
712
713
714
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726







+
+
+







	}
	for {set i 0} {$i <= $lastNum} {incr i} {
	    set slots [array names stubs $name,*,$i]
	    set emit 0
	    if {[info exists stubs($name,deprecated,$i)]} {
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1
	    } elseif {[info exists stubs($name,nostub,$i)]} {
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1
	    } elseif {[info exists stubs($name,generic,$i)]} {
		if {[llength $slots] > 1} {
		    puts stderr "conflicting generic and platform entries:\
			    $name $i"
		}
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1

Added tools/makeHeader.tcl.























































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# makeHeader.tcl --
#
#	This script generates embeddable C source (in a .h file) from a .tcl
#	script.
#
# Copyright (c) 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6

namespace eval makeHeader {

    ####################################################################
    #
    # mapSpecial --
    #	Transform a single line so that it is able to be put in a C string.
    #
    proc mapSpecial {str} {
	# All Tcl metacharacters and key C backslash sequences
	set MAP {
	    \" \\\\\" \\ \\\\\\\\ $ \\$ [ \\[ ] \\] ' \\\\' ? \\\\?
	    \a \\\\a \b \\\\b \f \\\\f \n \\\\n \r \\\\r \t \\\\t \v \\\\v
	}
	set XFORM {[format \\\\\\\\u%04x {*}[scan & %c]]}

	subst [regsub -all {[^\u0020-\u007e]} [string map $MAP $str] $XFORM]
    }

    ####################################################################
    #
    # compactLeadingSpaces --
    #	Converts the leading whitespace on a line into a more compact form.
    #
    proc compactLeadingSpaces {line} {
	set line [string map {\t {        }} [string trimright $line]]
	if {[regexp {^[ ]+} $line spaces]} {
	    regsub -all {[ ]{4}} $spaces \t replace
	    set len [expr {[string length $spaces] - 1}]
	    set line [string replace $line 0 $len $replace]
	}
	return $line
    }

    ####################################################################
    #
    # processScript --
    #	Transform a whole sequence of lines with [mapSpecial].
    #
    proc processScript {scriptLines} {
	lmap line $scriptLines {
	    # Skip blank and comment lines; they're there in the original
	    # sources so we don't need to copy them over.
	    if {[regexp {^\s*(?:#|$)} $line]} continue
	    format {"%s"} [mapSpecial [compactLeadingSpaces $line]\n]
	}
    }

    ####################################################################
    #
    # updateTemplate --
    #	Rewrite a template to contain the content from the input script.
    #
    proc updateTemplate {dataVar scriptLines} {
	set BEGIN "*!BEGIN!: Do not edit below this line.*"
	set END "*!END!: Do not edit above this line.*"

	upvar 1 $dataVar data

	set from [lsearch -glob $data $BEGIN]
	set to [lsearch -glob $data $END]
	if {$from == -1 || $to == -1 || $from >= $to} {
	    throw BAD "not a template"
	}

	set data [lreplace $data $from+1 $to-1 {*}[processScript $scriptLines]]
    }

    ####################################################################
    #
    # stripSurround --
    #	Removes the header and footer comments from a (line-split list of
    #	lines of) Tcl script code.
    #
    proc stripSurround {lines} {
	set RE {^\s*$|^#}
	set state 0
	set lines [lmap line [lreverse $lines] {
	    if {!$state && [regexp $RE $line]} continue {
		set state 1
		set line
	    }
	}]
	return [lmap line [lreverse $lines] {
	    if {$state && [regexp $RE $line]} continue {
		set state 0
		set line
	    }
	}]
    }

    ####################################################################
    #
    # updateTemplateFile --
    #	Rewrites a template file with the lines of the given script.
    #
    proc updateTemplateFile {headerFile scriptLines} {
	set f [open $headerFile "r+"]
	try {
	    set content [split [chan read -nonewline $f] "\n"]
	    updateTemplate content [stripSurround $scriptLines]
	    chan seek $f 0
	    chan puts $f [join $content \n]
	    chan truncate $f
	} trap BAD msg {
	    # Add the filename to the message
	    throw BAD "${headerFile}: $msg"
	} finally {
	    chan close $f
	}
    }

    ####################################################################
    #
    # readScript --
    #	Read a script from a file and return its lines.
    #
    proc readScript {script} {
	set f [open $script]
	try {
	    chan configure $f -encoding utf-8
	    return [split [string trim [chan read $f]] "\n"]
	} finally {
	    chan close $f
	}
    }

    ####################################################################
    #
    # run --
    #	The main program of this script.
    #
    proc run {args} {
	try {
	    if {[llength $args] != 2} {
		throw ARGS "inputTclScript templateFile"
	    }
	    lassign $args inputTclScript templateFile

	    puts "Inserting $inputTclScript into $templateFile"
	    set scriptLines [readScript $inputTclScript]
	    updateTemplateFile $templateFile $scriptLines
	    exit 0
	} trap ARGS msg {
	    puts stderr "wrong # args: should be \"[file tail $::argv0] $msg\""
	    exit 2
	} trap BAD msg {
	    puts stderr $msg
	    exit 1
	} trap POSIX msg {
	    puts stderr $msg
	    exit 1
	} on error {- opts} {
	    puts stderr [dict get $opts -errorinfo]
	    exit 3
	}
    }
}

########################################################################
#
# Launch the main program
#
if {[info script] eq $::argv0} {
    makeHeader::run {*}$::argv
}

# Local-Variables:
# mode: tcl
# fill-column: 78
# End:

Added tools/mkVfs.tcl.




































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
proc cat fname {
    set fname [open $fname r]
    set data [read $fname]
    close $fname
    return $data
}

proc pkgIndexDir {root fout d1} {

    puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \
	      [file tail $d1]]
    set idx [string length $root]
    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
        set f [file join $d1 $ftail]
        if {[file isdirectory $f] && [string compare CVS $ftail]} {
            pkgIndexDir $root $fout $f
        } elseif {[file tail $f] eq "pkgIndex.tcl"} {
      	    puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]"
	          puts $fout [cat $f]
	      }
    }
}

###
# Script to build the VFS file system
###
proc copyDir {d1 d2} {

    puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \
	      [file tail $d2]]

    file delete -force -- $d2
    file mkdir $d2

    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
        set f [file join $d1 $ftail]
        if {[file isdirectory $f] && [string compare CVS $ftail]} {
            copyDir $f [file join $d2 $ftail]
        } elseif {[file isfile $f]} {
      	    file copy -force $f [file join $d2 $ftail]
	          if {$::tcl_platform(platform) eq {unix}} {
            		file attributes [file join $d2 $ftail] -permissions 0644
      	    } else {
            		file attributes [file join $d2 $ftail] -readonly 1
	          }
	      }
    }

    if {$::tcl_platform(platform) eq {unix}} {
      	file attributes $d2 -permissions 0755
    } else {
	      file attributes $d2 -readonly 1
    }
}

if {[llength $argv] < 3} {
    puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM"
    exit 1
}
set TCL_SCRIPT_DIR [lindex $argv 0]
set TCLSRC_ROOT    [lindex $argv 1]
set PLATFORM       [lindex $argv 2]
set TKDLL          [lindex $argv 3]
set TKVER          [lindex $argv 4]

puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM"
copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR}

if {$PLATFORM == "windows"} {
    set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll]
    puts "DDE DLL $ddedll"
    if {$ddedll != {}} {
      	file copy $ddedll ${TCL_SCRIPT_DIR}/dde
    }
    set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll]
    puts "REG DLL $ddedll"
    if {$regdll != {}} {
      	file copy $regdll ${TCL_SCRIPT_DIR}/reg
    }
} else {
    # Remove the dde and reg package paths
    file delete -force ${TCL_SCRIPT_DIR}/dde
    file delete -force ${TCL_SCRIPT_DIR}/reg
}

# For the following packages, cat their pkgIndex files to tclIndex
file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0
set fout [open ${TCL_SCRIPT_DIR}/tclIndex a]
puts $fout {#
# MANIFEST OF INCLUDED PACKAGES
#
set VFSROOT $dir
}
if {$TKDLL ne {} && [file exists $TKDLL]} {
  file copy $TKDLL ${TCL_SCRIPT_DIR}
  puts $fout [list package ifneeded Tk $TKVER "load \$dir $TKDLL"]
}
pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR}
close $fout

Changes to tools/tcl.hpj.in.

1
2
3
4
5
6
7
8

9
10

11
12
13
14
15
16
17
1
2
3
4
5
6
7

8
9

10
11
12
13
14
15
16
17







-
+

-
+







; This file is maintained by HCW. Do not modify this file directly.

[OPTIONS]
HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
CNT=tcl90.cnt
CNT=tcl87.cnt
COPYRIGHT=Copyright � 2000 Ajuba Solutions
HLP=tcl90.hlp
HLP=tcl87.hlp

[FILES]
tcl.rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,0

Changes to tools/tcltk-man2html.tcl.

1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32






-
+

















-
+







#!/usr/bin/env tclsh

if {[catch {package require Tcl 8.6-} msg]} {
    puts stderr "ERROR: $msg"
    puts stderr "If running this script from 'make html', set the\
	NATIVE_TCLSH environment\nvariable to point to an installed\
	tclsh9.0 (or the equivalent tclsh90.exe\non Windows)."
	tclsh8.7 (or the equivalent tclsh87.exe\non Windows)."
    exit 1
}

# Convert Ousterhout format man pages into highly crosslinked hypertext.
#
# Along the way detect many unmatched font changes and other odd things.
#
# Note well, this program is a hack rather than a piece of software
# engineering.  In that sense it's probably a good example of things
# that a scripting language, like Tcl, can do well.  It is offered as
# an example of how someone might convert a specific set of man pages
# into hypertext, not as a general solution to the problem.  If you
# try to use this, you'll be very much on your own.
#
# Copyright (c) 1995-1997 Roger E. Critchlow Jr
# Copyright (c) 2004-2010 Donal K. Fellows

set ::Version "50/9.0"
set ::Version "50/8.7"
set ::CSSFILE "docs.css"

##
## Source the utility functions that provide most of the
## implementation of the transformation from nroff to html.
##
source [file join [file dirname [info script]] tcltk-man2html-utils.tcl]

Changes to tools/uniClass.tcl.

16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43







-
+












-
+







    global ranges numranges chars numchars extchars extranges

    if {$first < ($last-1)} {
	if {!$extranges && ($first) > 0xffff} {
	    set extranges 1
	    set numranges 0
	    set ranges [string trimright $ranges " \n\r\t,"]
	    append ranges "\n#if TCL_UTF_MAX > 4\n    ,"
	    append ranges "\n#if CHRBITS > 16\n    ,"
	}
	append ranges [format "{0x%x, 0x%x}, " \
		$first $last]
	if {[incr numranges] % 4 == 0} {
	    set ranges [string trimright $ranges]
	    append ranges "\n    "
	}
    } else {
	if {!$extchars && ($first) > 0xffff} {
	    set extchars 1
	    set numchars 0
	    set chars [string trimright $chars " \n\r\t,"]
	    append chars "\n#if TCL_UTF_MAX > 4\n    ,"
	    append chars "\n#if CHRBITS > 16\n    ,"
	}
	append chars [format "0x%x, " $first]
	incr numchars
	if {$numchars % 9 == 0} {
	    set chars [string trimright $chars]
	    append chars "\n    "
	}
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
62
63
64
65
66
67
68

69
70
71
72
73
74
75
76







-
+







    set numchars 0
    set extchars 0
    set extranges 0

    for {set i 0} {$i <= 0x10ffff} {incr i} {
    if {$i == 0xd800} {
	# Skip surrogates
	set i 0xdc00
	set i 0xe000
    }
	if {[string is $type [format %c $i]]} {
	    if {$i == ($last + 1)} {
		set last $i
	    } else {
		if {$first >= 0} {
		    emitRange $first $last

Changes to tools/uniParse.tcl.

268
269
270
271
272
273
274

275
276
277
278
279
280
281
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282







+







 *
 * Bits 5-7	Case delta type: 000 = identity
 *				 010 = add delta for lower
 *				 011 = add delta for lower, add 1 for title
 *				 100 = subtract delta for title/upper
 *				 101 = sub delta for upper, sub 1 for title
 *				 110 = sub delta for upper, add delta for lower
 *				 111 = subtract delta for upper
 *
 * Bits 8-31	Case delta: delta for case conversions.  This should be the
 *			    highest field so we can easily sign extend.
 */

static const int groups\[\] = {"
    set line "    "
305
306
307
308
309
310
311


312
313
314
315






316
317
318
319
320
321
322
306
307
308
309
310
311
312
313
314




315
316
317
318
319
320
321
322
323
324
325
326
327







+
+
-
-
-
-
+
+
+
+
+
+







		set case 3
		set delta $tolower
		if {$totitle != -1} {
		    error "New case conversion type needed: $toupper $tolower $totitle"
		}
	    }
	} elseif {$toupper} {
	    set delta $toupper
	    if {$tolower == $toupper} {
	    # subtract delta for upper, add delta for lower
	    set case 6
	    set delta $toupper
	    if {$tolower != $toupper} {
		# subtract delta for upper, add delta for lower
		set case 6
	    } elseif {!$tolower} {
		# subtract delta for upper
		set case 7
	    } else {
		error "New case conversion type needed: $toupper $tolower $totitle"
	    }
	} elseif {$tolower} {
	    # add delta for lower
	    set case 2
	    set delta $tolower
	} else {

Added tools/valgrind_suppress.































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
{
   TclCreatesocketAddress/getaddrinfo/calloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:getaddrinfo
   fun:TclCreateSocketAddress
}

{
   TclCreatesocketAddress/getaddrinfo/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:getaddrinfo
   fun:TclCreateSocketAddress
}

{
   TclpDlopen/load
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:dlopen
   fun:TclpDlopen
}

{
   TclpDlopen/load
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:dlopen
   fun:TclpDlopen
}

{
   TclpGetGrNam/__nss_next2/calloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:__nss_next2
   ...
   fun:TclpGetGrNam
}

{
   TclpGetGrNam/__nss_next2/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:__nss_next2
   ...
   fun:TclpGetGrNam
}

{
   TclpGetGrNam/__nss_systemd_getfrname_r/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:_nss_systemd_getgrnam_r
   ...
   fun:TclpGetGrNam
}

{
   TclpGetPwNam/getpwname_r/__nss_next2/calloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:__nss_next2
   ...
   fun:TclpGetPwNam
}

{
   TclpGetPwNam/getpwname_r/__nss_next2/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:__nss_next2
   ...
   fun:TclpGetPwNam
}

{
   TclpGetPwNam/getpwname_r/_nss_systemd_getpwnam_r/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:_nss_systemd_getpwnam_r
   ...
   fun:TclpGetPwNam
}

{
	TclpThreadExit/pthread_exit/calloc
    Memcheck:Leak
    match-leak-kinds: reachable
	fun:calloc
	...
	fun:pthread_exit
	fun:TclpThreadExit
}

{
	TclpThreadExit/pthread_exit/malloc
    Memcheck:Leak
    match-leak-kinds: reachable
	fun:malloc
	...
	fun:pthread_exit
	fun:TclpThreadExit
}

Changes to unix/Makefile.in.

79
80
81
82
83
84
85
86

87
88
89
90
91
92
93
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93







-
+







# Directory in which to install html documentation:
HTML_INSTALL_DIR	= $(INSTALL_ROOT)$(HTML_DIR)

# Directory in which to install the configuration file tclConfig.sh
CONFIG_INSTALL_DIR	= $(INSTALL_ROOT)$(libdir)

# Directory in which to install bundled packages:
PACKAGE_DIR             = @PACKAGE_DIR@
PACKAGE_DIR		= @PACKAGE_DIR@

# Package search path.
TCL_PACKAGE_PATH	= @TCL_PACKAGE_PATH@

# Tcl Module default path roots (TIP189).
TCL_MODULE_PATH		= @TCL_MODULE_PATH@

147
148
149
150
151
152
153
154
155


156
157
158
159
160
161
162
147
148
149
150
151
152
153


154
155
156
157
158
159
160
161
162







-
-
+
+







SHELL			= @MAKEFILE_SHELL@

# Tcl used to let the configure script choose which program to use for
# installing, but there are just too many different versions of "install"
# around; better to use the install-sh script that comes with the
# distribution, which is slower but guaranteed to work.

INSTALL_STRIP_PROGRAM   = -s
INSTALL_STRIP_LIBRARY   = -S -x
INSTALL_STRIP_PROGRAM	= -s
INSTALL_STRIP_LIBRARY	= -S -x

INSTALL			= $(SHELL) $(UNIX_DIR)/install-sh -c
INSTALL_PROGRAM		= ${INSTALL}
INSTALL_LIBRARY		= ${INSTALL}
INSTALL_DATA		= ${INSTALL} -m 644
INSTALL_DATA_DIR	= ${INSTALL} -d -m 755

238
239
240
241
242
243
244


245
246
247
248
249

250
251
252
253
254
255
256
257
258
259
260
261

262
263
264
265



266
267
268
269
270
271
272
273
274



275
276
277
278
279
280
281
282
283

284
285
286
287
288
289
290
238
239
240
241
242
243
244
245
246
247
248
249
250

251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267

268
269
270
271
272
273
274
275
276
277


278
279
280
281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296







+
+




-
+












+



-
+
+
+







-
-
+
+
+








-
+







# Must be absolute to so the corresponding tcltest's tcl_library is absolute.
TCL_BUILDTIME_LIBRARY	= @TCL_SRC_DIR@/library

ZLIB_DIR		= ${COMPAT_DIR}/zlib
ZLIB_INCLUDE		= @ZLIB_INCLUDE@

CC			= @CC@
OBJEXT			= @OBJEXT@

#CC			= purify -best-effort @CC@ -DPURIFY

# Flags to be passed to installManPage to control how the manpages should be
# installed (symlinks, compression, package name suffix).
MAN_FLAGS               = @MAN_FLAGS@
MAN_FLAGS		= @MAN_FLAGS@

# If non-empty, install the timezone files that are included with Tcl,
# otherwise use the ones that ship with the OS.
INSTALL_TZDATA		= @INSTALL_TZDATA@

#--------------------------------------------------------------------------
# The information below is usually usable as is. The configure script won't
# modify it and it only exists to make working around selected rare system
# configurations easier.
#--------------------------------------------------------------------------

GDB			= gdb
LLDB			= lldb
TRACE			= strace
TRACE_OPTS		=
VALGRIND		= valgrind
VALGRINDARGS		= --tool=memcheck --num-callers=8 --leak-resolution=high --leak-check=yes --show-reachable=yes -v
VALGRINDARGS		= --tool=memcheck --num-callers=24 \
	--leak-resolution=high --leak-check=yes --show-reachable=yes -v \
	--suppressions=$(TOOL_DIR)/valgrind_suppress

#--------------------------------------------------------------------------
# The information below should be usable as is. The configure script won't
# modify it and you shouldn't need to modify it either.
#--------------------------------------------------------------------------

STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
-I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@
	-I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
	${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \
	@EXTRA_CC_SWITCHES@

CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS}

APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@

LIBS		= @TCL_LIBS@

DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@
	${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@

TCLSH_OBJS = tclAppInit.o

TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o

XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
299
300
301
302
303
304
305
306

307
308
309
310
311

312
313
314
315
316
317
318
319


320
321
322
323


324
325
326
327
328


329
330

331
332
333

334
335
336

337
338
339
340
341
342
343
305
306
307
308
309
310
311

312
313
314
315
316

317
318
319
320
321
322
323


324
325
326
327
328

329
330
331
332
333


334
335
336

337
338
339

340
341
342

343
344
345
346
347
348
349
350







-
+




-
+






-
-
+
+



-
+
+



-
-
+
+

-
+


-
+


-
+







	tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
	tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
	tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \
	tclLink.o tclListObj.o \
	tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \
	tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \
	tclPkg.o tclPkgConfig.o tclPosixStr.o \
	tclPreserve.o tclProc.o tclRegexp.o \
	tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \
	tclResolve.o tclResult.o tclScan.o tclStringObj.o \
	tclStrToD.o tclThread.o \
	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
	tclTomMathInterface.o
	tclTomMathInterface.o tclZipfs.o

OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
	tclOOMethod.o tclOOStubInit.o

TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
	bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \
        bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
        bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
	bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
	bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
	bn_mp_cnt_lsb.o bn_mp_copy.o \
	bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \
	bn_mp_div_2d.o bn_mp_div_3.o \
        bn_mp_exch.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_get_int.o bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_init.o \
	bn_mp_exch.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_get_int.o \
	bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_init.o \
	bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
	bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_karatsuba_mul.o \
	bn_mp_karatsuba_sqr.o \
        bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
        bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
	bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
	bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
	bn_mp_radix_size.o bn_mp_radix_smap.o \
        bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
	bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
	bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \
	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
        bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
	bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
	bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
        bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
	bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o

STUB_LIB_OBJS = tclStubLib.o \
	tclTomMathStubLib.o \
	tclOOStubLib.o \
	${COMPAT_OBJS}

UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
440
441
442
443
444
445
446

447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466


467
468
469
470
471
472
473
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473

474
475
476
477
478
479
480
481
482







+



















-
+
+







	$(GENERIC_DIR)/tclPathObj.c \
	$(GENERIC_DIR)/tclPipe.c \
	$(GENERIC_DIR)/tclPkg.c \
	$(GENERIC_DIR)/tclPkgConfig.c \
	$(GENERIC_DIR)/tclPosixStr.c \
	$(GENERIC_DIR)/tclPreserve.c \
	$(GENERIC_DIR)/tclProc.c \
	$(GENERIC_DIR)/tclProcess.c \
	$(GENERIC_DIR)/tclRegexp.c \
	$(GENERIC_DIR)/tclResolve.c \
	$(GENERIC_DIR)/tclResult.c \
	$(GENERIC_DIR)/tclScan.c \
	$(GENERIC_DIR)/tclStubInit.c \
	$(GENERIC_DIR)/tclStringObj.c \
	$(GENERIC_DIR)/tclStrToD.c \
	$(GENERIC_DIR)/tclTest.c \
	$(GENERIC_DIR)/tclTestObj.c \
	$(GENERIC_DIR)/tclTestProcBodyObj.c \
	$(GENERIC_DIR)/tclThread.c \
	$(GENERIC_DIR)/tclThreadAlloc.c \
	$(GENERIC_DIR)/tclThreadJoin.c \
	$(GENERIC_DIR)/tclThreadStorage.c \
	$(GENERIC_DIR)/tclTimer.c \
	$(GENERIC_DIR)/tclTrace.c \
	$(GENERIC_DIR)/tclUtil.c \
	$(GENERIC_DIR)/tclVar.c \
	$(GENERIC_DIR)/tclAssembly.c \
	$(GENERIC_DIR)/tclZlib.c
	$(GENERIC_DIR)/tclZlib.c \
	$(GENERIC_DIR)/tclZipfs.c

OO_SRCS = \
	$(GENERIC_DIR)/tclOO.c \
	$(GENERIC_DIR)/tclOOBasic.c \
	$(GENERIC_DIR)/tclOOCall.c \
	$(GENERIC_DIR)/tclOODefineCmds.c \
	$(GENERIC_DIR)/tclOOInfo.c \
612
613
614
615
616
617
618






































619
620
621
622
623
624
625
626
627
628
629
630









631
632
633

634
635




636
637
638
639


640
641
642
643
644
645
646
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688

689
690
691
692
693
694
695
696
697


698
699
700
701
702
703
704
705
706







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












+
+
+
+
+
+
+
+
+


-
+


+
+
+
+


-
-
+
+







# Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those files
# won't compile on the current machine, and they will cause problems for
# things like "make depend".

SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \
	$(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@

###
# Tip 430 - ZipFS Modifications
###

TCL_ZIP_FILE		= @TCL_ZIP_FILE@
TCL_VFS_ROOT		= libtcl.vfs
TCL_VFS_PATH		= ${TCL_VFS_ROOT}/tcl_library

HOST_CC			= @CC_FOR_BUILD@
HOST_EXEEXT		= @EXEEXT_FOR_BUILD@
HOST_OBJEXT		= @OBJEXT_FOR_BUILD@
ZIPFS_BUILD		= @ZIPFS_BUILD@
NATIVE_ZIP		= @ZIP_PROG@
ZIP_PROG_OPTIONS	= @ZIP_PROG_OPTIONS@
ZIP_PROG_VFSSEARCH	= @ZIP_PROG_VFSSEARCH@
SHARED_BUILD		= @SHARED_BUILD@
INSTALL_LIBRARIES	= @INSTALL_LIBRARIES@
INSTALL_MSGS		= @INSTALL_MSGS@

# Minizip
MINIZIP_OBJS = \
	adler32.$(HOST_OBJEXT) \
	compress.$(HOST_OBJEXT) \
	crc32.$(HOST_OBJEXT) \
	deflate.$(HOST_OBJEXT) \
	infback.$(HOST_OBJEXT) \
	inffast.$(HOST_OBJEXT) \
	inflate.$(HOST_OBJEXT) \
	inftrees.$(HOST_OBJEXT) \
	ioapi.$(HOST_OBJEXT) \
	trees.$(HOST_OBJEXT) \
	uncompr.$(HOST_OBJEXT) \
	zip.$(HOST_OBJEXT) \
	zutil.$(HOST_OBJEXT) \
	minizip.$(HOST_OBJEXT)

ZIP_INSTALL_OBJS	= @ZIP_INSTALL_OBJS@

#--------------------------------------------------------------------------
# Start of rules
#--------------------------------------------------------------------------

all: binaries libraries doc packages

binaries: ${LIB_FILE} ${TCL_EXE}

libraries:

doc:

tclzipfile: ${TCL_ZIP_FILE}

${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS}
	@rm -rf ${TCL_VFS_ROOT}
	@mkdir -p ${TCL_VFS_PATH}
	cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}
	-find ${TCL_VFS_ROOT} -type d -empty -delete
	( cd ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH})

# The following target is configured by autoconf to generate either a shared
# library or non-shared library for Tcl.
${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS}
${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} ${TCL_ZIP_FILE}
	rm -f $@
	@MAKE_LIB@
ifeq (${ZIPFS_BUILD},1)
	cat ${TCL_ZIP_FILE} >> ${LIB_FILE}
	${NATIVE_ZIP} -A ${LIB_FILE}
endif

${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
	@if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \
	    (cd ${TOP_DIR}/win; ${MAKE} winextensions); \
	@if [ "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll" ] ; then \
	    ( cd ${TOP_DIR}/win; ${MAKE} winextensions ); \
	fi
	rm -f $@
	@MAKE_STUB_LIB@

# Make target which outputs the list of the .o contained in the Tcl lib useful
# to build a single big shared library containing Tcl and other extensions.
# Used for the Tcl Plugin.  -- dl
662
663
664
665
666
667
668
669
670



671
672
673
674
675

676
677
678
679
680
681
682
722
723
724
725
726
727
728


729
730
731
732
733
734
735

736
737
738
739
740
741
742
743







-
-
+
+
+




-
+







Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
	$(SHELL) config.status
#tclConfig.h: $(UNIX_DIR)/tclConfig.h.in
#	$(SHELL) config.status

clean: clean-packages
	rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@
	cd dltest ; $(MAKE) clean
		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \
		minizip${HOST_EXEEXT} *.${HOST_OBJEXT} *.zip *.vfs
	(cd dltest ; $(MAKE) clean)

distclean: distclean-packages clean
	rm -rf Makefile config.status config.cache config.log tclConfig.sh \
		tclConfig.h *.plist Tcl.framework tcl.pc
	cd dltest ; $(MAKE) distclean
	(cd dltest ; $(MAKE) distclean)

depend:
	makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)

#--------------------------------------------------------------------------
# The following target outputs the name of the top-level source directory for
# Tcl (it is used by Tk's configure script, for example). The .NO_PARALLEL
723
724
725
726
727
728
729
730








731
732
733
734
735
736
737
784
785
786
787
788
789
790

791
792
793
794
795
796
797
798
799
800
801
802
803
804
805







-
+
+
+
+
+
+
+
+







	$(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)

gdb-test: ${TCLTEST_EXE}
	@echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run
	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
	@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
	rm gdb.run
	@rm gdb.run

lldb-test: ${TCLTEST_EXE}
	@echo "settings set target.env-vars @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > lldb.run
	@echo "settings set target.env-vars TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> lldb.run
	$(LLDB) --source lldb.run ./${TCLTEST_EXE} -- $(TOP_DIR)/tests/all.tcl \
		$(TESTFLAGS) -singleproc 1
	@rm lldb.run

# Useful target to launch a built tcltest with the proper path,...
runtest: ${TCLTEST_EXE}
	$(SHELL_ENV) ./${TCLTEST_EXE}

# Useful target for running the test suite with an unwritable current
# directory...
757
758
759
760
761
762
763
764



765
766
767
768
769
770
771
772
773
774
775
776
777
778
779

780
781
782
783
784
785
786
787
788
789
790
791

792
793
794
795
796

797
798
799
800
801
802
803


804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825



















826
827
828
829
830
831
832



833
834
835
836
837
838
839
840



841
842

843
844
845

846
847
848
849
850
851
852
853
854





855
856
857
858
859
860
861
862
863
864
865
866
867
868














869
870
871
872


873
874
875
876
877
878
879

880
881
882
883
884
885
886


887
888
889
890
891
892
893
825
826
827
828
829
830
831

832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848

849
850
851
852
853
854
855
856
857
858
859
860

861

862
863
864

865

866
867
868



869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889



890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911




912
913
914

915
916
917




918
919
920
921

922

923

924









925
926
927
928
929

930












931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946


947
948
949
950
951
952
953
954

955

956
957
958



959
960
961
962
963
964
965
966
967







-
+
+
+














-
+











-
+
-



-
+
-



-
-
-
+
+



















-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
+
+
+
-



-
-
-
-
+
+
+

-
+
-

-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+






-
+
-



-
-
-
+
+







	$(SHELL_ENV) ./${TCL_EXE} $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: ${TCL_EXE}
	$(SHELL_ENV) $(GDB) ./${TCL_EXE}

valgrind: ${TCL_EXE} ${TCLTEST_EXE}
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind $(TESTFLAGS)
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \
		$(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \
		$(TESTFLAGS)

valgrindshell: ${TCL_EXE}
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT)

trace-shell: ${TCL_EXE}
	$(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCL_EXE} $(SCRIPT)

trace-test: ${TCLTEST_EXE}
	$(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 $(TESTFLAGS)

#--------------------------------------------------------------------------
# Installation rules
#--------------------------------------------------------------------------

INSTALL_BASE_TARGETS = install-binaries install-libraries install-msgs $(INSTALL_TZDATA)
INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA)
INSTALL_DOC_TARGETS = install-doc
INSTALL_PACKAGE_TARGETS = install-packages
INSTALL_DEV_TARGETS = install-headers
INSTALL_EXTRA_TARGETS = @EXTRA_INSTALL@
INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \
		  $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS)

install: $(INSTALL_TARGETS)

install-strip:
	$(MAKE) $(INSTALL_TARGETS) \
		INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \
		INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}"
		INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}"

install-binaries: binaries
	@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" \
		"$(CONFIG_INSTALL_DIR)"; \
		"$(CONFIG_INSTALL_DIR)" ; do \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	    fi; \
	done
	@echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/"
	@@INSTALL_LIB@
	@chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"
	@echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
	@$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
	@echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/"
	@$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh"
	@echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/"
	@$(INSTALL_DATA) $(UNIX_DIR)/tclooConfig.sh \
		"$(CONFIG_INSTALL_DIR)/tclooConfig.sh"
	@if test "$(STUB_LIB_FILE)" != "" ; then \
	    echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
	    @INSTALL_STUB_LIB@ ; \
	fi
	@EXTRA_INSTALL_BINARIES@
	@echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/"
	@$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig
	@$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc

install-libraries: libraries
	@for i in "$(SCRIPT_INSTALL_DIR)"; \
	    do \
install-libraries-zipfs-shared: libraries
	@for i in "$(SCRIPT_INSTALL_DIR)" ; do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
	    fi; \
	done
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"
	@for i in $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	done

install-libraries-zipfs-static: install-libraries-zipfs-shared
	$(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"

MODULE_INSTALL_DIR=$(SCRIPT_INSTALL_DIR)/..

install-libraries: libraries
	@for i in "$(SCRIPT_INSTALL_DIR)" ; do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	@for i in opt0.4 http1.0 encoding ../tcl9 ../tcl9/9.0  ../tcl9/9.0/platform; \
	    fi; \
	done
	@for i in opt0.4 encoding ../tcl8 ../tcl8/8.4  ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6 ../tcl8/8.7 ; do \
	    do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/";
	    fi; \
	done
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"
	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
		$(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \
		$(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	done
	@echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/";
	@for i in $(TOP_DIR)/library/http1.0/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
	    done;
	@echo "Installing package http 2.8.12 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/http-2.8.12.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	@echo "Installing package http 2.9.0 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
		"$(MODULE_INSTALL_DIR)"/tcl8/8.6/http-2.9.0.tm
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"
	@for i in $(TOP_DIR)/library/opt/*.tcl ; do \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.6.1 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/msgcat-1.6.1.tm;
	@echo "Installing package tcltest 2.4.1 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/tcltest-2.4.1.tm;

	@echo "Installing package platform 1.0.14 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/platform-1.0.14.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/platform/shell-1.1.4.tm;

	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/";
	done
	@echo "Installing package msgcat 1.7.0 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
		"$(MODULE_INSTALL_DIR)"/tcl8/8.7/msgcat-1.7.0.tm
	@echo "Installing package tcltest 2.5.0 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
		"$(MODULE_INSTALL_DIR)"/tcl8/8.5/tcltest-2.5.0.tm
	@echo "Installing package platform 1.0.14 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
		"$(MODULE_INSTALL_DIR)"/tcl8/8.4/platform-1.0.14.tm
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \
		"$(MODULE_INSTALL_DIR)"/tcl8/8.4/platform/shell-1.1.4.tm
	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/"
	@for i in $(TOP_DIR)/library/encoding/*.enc ; do \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \
	done;
	@if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ]; then \
	done
	@if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ] ; then \
	    echo "Customizing tcl module path"; \
	    echo "if {![interp issafe]} { ::tcl::tm::roots {$(TCL_MODULE_PATH)} }" >> \
	        "$(SCRIPT_INSTALL_DIR)"/tm.tcl; \
	fi

install-tzdata:
	@for i in tzdata; \
	@for i in tzdata ; do \
	    do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
		else true; \
		fi; \
	    done;
	    fi; \
	done
	@echo "Installing time zone files to $(SCRIPT_INSTALL_DIR)/tzdata/"
	@for i in $(TOP_DIR)/library/tzdata/* ; do \
	    if [ -d $$i ] ; then \
		ii=`basename $$i`; \
		if [ ! -d "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii ] ; then \
		    $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii; \
		fi; \
903
904
905
906
907
908
909
910

911
912
913

914
915
916
917
918
919
920


921
922
923
924


925
926
927

928
929
930
931
932
933
934
935
936




937
938
939
940
941


942
943
944
945
946

947
948
949













950
951

952
953
954
955
956
957
958


959
960

961
962
963
964
965
966
967

968
969
970
971

972
973
974
975
976
977
978


979
980

981
982
983
984
985
986
987


988
989

990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008

1009
1010
1011
1012

1013
1014
1015
1016

1017
1018
1019
1020
1021
1022

1023
1024
1025
1026

1027
1028
1029
1030

1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043













1044
1045
1046
1047
1048
1049
1050
977
978
979
980
981
982
983

984
985
986

987

988
989
990



991
992
993
994


995
996
997
998

999

1000
1001
1002





1003
1004
1005
1006
1007
1008



1009
1010
1011
1012

1013

1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031

1032

1033
1034
1035



1036
1037
1038

1039





1040

1041
1042
1043
1044

1045

1046
1047
1048



1049
1050
1051

1052




1053


1054
1055
1056

1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075

1076
1077
1078
1079

1080
1081
1082
1083

1084
1085
1086
1087
1088
1089

1090
1091
1092
1093

1094
1095
1096
1097

1098
1099
1100
1101










1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121







-
+


-
+
-



-
-
-
+
+


-
-
+
+


-
+
-



-
-
-
-
-
+
+
+
+


-
-
-
+
+


-

-
+



+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-



-
-
-
+
+

-
+
-
-
-
-
-

-
+



-
+
-



-
-
-
+
+

-
+
-
-
-
-

-
-
+
+

-
+


















-
+



-
+



-
+





-
+



-
+



-
+



-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







		    else \
			$(INSTALL_DATA) $$j "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii; \
		    fi; \
		done; \
	    else \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/tzdata; \
	    fi; \
	done;
	done

install-msgs:
	@for i in msgs; \
	@for i in msgs ; do \
	    do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
		else true; \
		fi; \
	    done;
	    fi; \
	done
	@echo "Installing message catalog files to $(SCRIPT_INSTALL_DIR)/msgs/"
	@for i in $(TOP_DIR)/library/msgs/*.msg ; do \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/msgs; \
	done;
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/msgs; \
	done

install-doc: doc
	@for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)" ; \
	@for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)" ; do \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	@echo "Installing and cross-linking top-level (.1) docs to $(MAN1_INSTALL_DIR)/";
	@for i in $(TOP_DIR)/doc/*.1; do \
	    fi; \
	done
	@echo "Installing and cross-linking top-level (.1) docs to $(MAN1_INSTALL_DIR)/"
	@for i in $(TOP_DIR)/doc/*.1 ; do \
	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN1_INSTALL_DIR)"; \
	done

	@echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/";
	@for i in $(TOP_DIR)/doc/*.3; do \
	@echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/"
	@for i in $(TOP_DIR)/doc/*.3 ; do \
	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN3_INSTALL_DIR)"; \
	done

	@echo "Installing and cross-linking command (.n) docs to $(MANN_INSTALL_DIR)/";
	@for i in $(TOP_DIR)/doc/*.n; do \
	@for i in $(TOP_DIR)/doc/*.n ; do \
	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MANN_INSTALL_DIR)"; \
	done

# Public headers that define Tcl's API
TCL_PUBLIC_HEADERS = $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
	$(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
	$(GENERIC_DIR)/tclPlatDecls.h $(GENERIC_DIR)/tclTomMath.h \
	$(GENERIC_DIR)/tclTomMathDecls.h
# Private headers that define Tcl's internal API
TCL_PRIVATE_HEADERS = $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \
	$(GENERIC_DIR)/tclIntPlatDecls.h $(GENERIC_DIR)/tclPort.h \
	$(GENERIC_DIR)/tclOOInt.h $(GENERIC_DIR)/tclOOIntDecls.h \
	$(UNIX_DIR)/tclUnixPort.h
# Any other headers you find in the Tcl sources are purely part of Tcl's
# implementation, and aren't to be installed.

install-headers:
	@for i in "$(INCLUDE_INSTALL_DIR)"; \
	@for i in "$(INCLUDE_INSTALL_DIR)" ; do \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	    fi; \
	done
	@echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
	@for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
	@for i in $(TCL_PUBLIC_HEADERS) ; do \
		$(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
		$(GENERIC_DIR)/tclPlatDecls.h \
		$(GENERIC_DIR)/tclTomMath.h \
		$(GENERIC_DIR)/tclTomMathDecls.h ; \
	    do \
	    $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \
	    done;
	done

# Optional target to install private headers
install-private-headers:
	@for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	@for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)" ; do \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	    fi; \
	done
	@echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/";
	@for i in $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \
	@for i in $(TCL_PRIVATE_HEADERS) ; do \
		$(GENERIC_DIR)/tclIntPlatDecls.h $(GENERIC_DIR)/tclPort.h \
		$(GENERIC_DIR)/tclOOInt.h $(GENERIC_DIR)/tclOOIntDecls.h \
		$(UNIX_DIR)/tclUnixPort.h; \
	    do \
	    $(INSTALL_DATA) $$i "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	    done;
	@if test -f tclConfig.h; then\
	done
	@if test -f tclConfig.h ; then \
	    $(INSTALL_DATA) tclConfig.h "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	    fi;
	fi

#--------------------------------------------------------------------------
# Rules for how to compile C files
#--------------------------------------------------------------------------

# Test binaries. The rules for tclTestInit.o and xtTestInit.o are complicated
# because they are compiled from tclAppInit.c. Can't use the "-o" option
# because this doesn't work on some strange compilers (e.g. UnixWare).
#
# To enable concurrent parallel make of tclsh and tcltest resp xttest, these
# targets have to depend on tclsh, this ensures that linking of tclsh with
# tclAppInit.o does not execute concurrently with the renaming and recompiling
# of that same object file in the targets below.

tclTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
	@if test -f tclAppInit.o ; then \
	    rm -f tclAppInit.sav; \
	    mv tclAppInit.o tclAppInit.sav; \
	fi;
	fi
	$(CC) -c $(APP_CC_SWITCHES) \
		-DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
		-DTCL_TEST $(UNIX_DIR)/tclAppInit.c
	rm -f tclTestInit.o
	@rm -f tclTestInit.o
	mv tclAppInit.o tclTestInit.o
	@if test -f tclAppInit.sav ; then \
	    mv tclAppInit.sav tclAppInit.o; \
	fi;
	fi

xtTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
	@if test -f tclAppInit.o ; then \
	    rm -f tclAppInit.sav; \
	    mv tclAppInit.o tclAppInit.sav; \
	fi;
	fi
	$(CC) -c $(APP_CC_SWITCHES) \
		-DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
		-DTCL_TEST -DTCL_XT_TEST $(UNIX_DIR)/tclAppInit.c
	rm -f xtTestInit.o
	@rm -f xtTestInit.o
	mv tclAppInit.o xtTestInit.o
	@if test -f tclAppInit.sav ; then \
	    mv tclAppInit.sav tclAppInit.o; \
	fi;
	fi

# Object files used on all Unix systems:

REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
		$(GENERIC_DIR)/regcustom.h
TCLREHDRS=$(GENERIC_DIR)/tclRegexp.h
COMPILEHDR=$(GENERIC_DIR)/tclCompile.h
FSHDR=$(GENERIC_DIR)/tclFileSystem.h
IOHDR=$(GENERIC_DIR)/tclIO.h
MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
PARSEHDR=$(GENERIC_DIR)/tclParse.h
NREHDR=$(GENERIC_DIR)/tclInt.h
TRIMHDR=$(GENERIC_DIR)/tclStringTrim.h
REGHDRS		= $(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
	$(GENERIC_DIR)/regcustom.h
TCLREHDRS	= $(GENERIC_DIR)/tclRegexp.h
COMPILEHDR	= $(GENERIC_DIR)/tclCompile.h
FSHDR		= $(GENERIC_DIR)/tclFileSystem.h
IOHDR		= $(GENERIC_DIR)/tclIO.h
MATHHDRS	= $(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
PARSEHDR	= $(GENERIC_DIR)/tclParse.h
NREHDR		= $(GENERIC_DIR)/tclInt.h
TRIMHDR		= $(GENERIC_DIR)/tclStringTrim.h

TCL_LOCATIONS	= -DTCL_LIBRARY="\"${TCL_LIBRARY}\"" \
	-DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\""

regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
		$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
		$(GENERIC_DIR)/regc_nfa.c $(GENERIC_DIR)/regc_cvec.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regcomp.c

regexec.o: $(REGHDRS) $(GENERIC_DIR)/regexec.c $(GENERIC_DIR)/rege_dfa.c
1220
1221
1222
1223
1224
1225
1226
1227

1228
1229
1230
1231
1232
1233
1234
1291
1292
1293
1294
1295
1296
1297

1298
1299
1300
1301
1302
1303
1304
1305







-
+








tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNamesp.c

tclNotify.o: $(GENERIC_DIR)/tclNotify.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c

tclOO.o: $(GENERIC_DIR)/tclOO.c
tclOO.o: $(GENERIC_DIR)/tclOO.c $(GENERIC_DIR)/tclOOScript.h
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOO.c

tclOOBasic.o: $(GENERIC_DIR)/tclOOBasic.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOBasic.c

tclOOCall.o: $(GENERIC_DIR)/tclOOCall.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOCall.c
1265
1266
1267
1268
1269
1270
1271
1272

1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284


1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295



1296
1297
1298
1299
1300
1301
1302
1336
1337
1338
1339
1340
1341
1342

1343
1344
1345
1346
1347
1348

1349
1350
1351
1352
1353

1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376







-
+





-





-
+
+











+
+
+







# Part of Tcl's configuration information are the paths where it was installed
# and where it will look for its libraries (which can be different). We derive
# this information from the variables which can be overridden by the user. As
# every path can be configured separately we do not remember one general
# prefix/exec_prefix but all the different paths individually.

tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c
	$(CC) -c $(CC_SWITCHES)					\
	$(CC) -c $(CC_SWITCHES) \
		-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR)\"" \
		-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR)\"" \
		-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR)\"" \
		-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR)\"" \
		-DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \
		\
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
		-DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \
		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
		-DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \
		-DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \
		\
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
		$(GENERIC_DIR)/tclPkgConfig.c

tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPosixStr.c

tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c

tclProc.o: $(GENERIC_DIR)/tclProc.c $(COMPILEHDR) $(NREHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c

tclProcess.o: $(GENERIC_DIR)/tclProcess.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProcess.c

tclRegexp.o: $(GENERIC_DIR)/tclRegexp.c $(TCLREHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclRegexp.c

tclResolve.o: $(GENERIC_DIR)/tclResolve.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResolve.c

tclResult.o: $(GENERIC_DIR)/tclResult.c
1324
1325
1326
1327
1328
1329
1330









1331
1332
1333
1334
1335
1336
1337
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420







+
+
+
+
+
+
+
+
+







	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtf.c

tclVar.o: $(GENERIC_DIR)/tclVar.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c

tclZlib.o: $(GENERIC_DIR)/tclZlib.c
	$(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c

tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c
	$(CC) -c $(CC_SWITCHES) \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
		$(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip \
		$(GENERIC_DIR)/tclZipfs.c

tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c

tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c

1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1684
1685
1686
1687
1688
1689
1690

1691
1692
1693
1694
1695
1696
1697







-








tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixThrd.c

tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c

TCL_LOCATIONS=-DTCL_LIBRARY="\"${TCL_LIBRARY}\"" -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\""
tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh
	$(CC) -c $(CC_SWITCHES) $(TCL_LOCATIONS) $(UNIX_DIR)/tclUnixInit.c

tclUnixCompat.o: $(UNIX_DIR)/tclUnixCompat.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixCompat.c

# The following are Mac OS X only sources:
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1740
1741
1742
1743
1744
1745
1746



1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761



1762
1763
1764
1765
1766
1767
1768







-
-
-















-
-
-







#--------------------------------------------------------------------------
# Compat binaries, these must be compiled for use in a shared library even
# though they may be placed in a static executable or library. Since they are
# included in both the tcl library and the stub library, they need to be
# relocatable.
#--------------------------------------------------------------------------

fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c

opendir.o: $(COMPAT_DIR)/opendir.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c

mkstemp.o: $(COMPAT_DIR)/mkstemp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/mkstemp.c

memcmp.o: $(COMPAT_DIR)/memcmp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/memcmp.c

strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c

strstr.o: $(COMPAT_DIR)/strstr.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strstr.c

strtod.o: $(COMPAT_DIR)/strtod.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtod.c

strtol.o: $(COMPAT_DIR)/strtol.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c

strtoul.o: $(COMPAT_DIR)/strtoul.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoul.c

waitpid.o: $(COMPAT_DIR)/waitpid.c
1731
1732
1733
1734
1735
1736
1737



















































1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766















1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777








1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789









1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804












1805
1806
1807
1808
1809
1810
1811
1812
1813
1814







1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825








1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839








1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856



1857
1858
1859
1860
1861
1862
1863
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878















1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896








1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907









1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919












1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934







1935
1936
1937
1938
1939
1940
1941
1942
1943
1944








1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958








1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980



1981
1982
1983
1984
1985
1986
1987
1988
1989
1990







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+














-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
+
+
+
+
+
+
+



-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+






-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+














-
-
-
+
+
+







	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c

tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclOOStubLib.c

.c.o:
	$(CC) -c $(CC_SWITCHES) $<

#--------------------------------------------------------------------------
# Minizip implementation
#--------------------------------------------------------------------------
adler32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c

compress.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c

crc32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c

deflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c

ioapi.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
		$(ZLIB_DIR)/contrib/minizip/ioapi.c

infback.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c

inffast.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c

inflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c

inftrees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c

trees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c

uncompr.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c

zip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
		$(ZLIB_DIR)/contrib/minizip/zip.c

zutil.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c

minizip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
		$(ZLIB_DIR)/contrib/minizip/minizip.c

minizip${HOST_EXEEXT}: $(MINIZIP_OBJS)
	$(HOST_CC) -o $@ $(MINIZIP_OBJS)

#--------------------------------------------------------------------------
# Bundled Package targets
#--------------------------------------------------------------------------

# Propagate configure args like --enable-64bit to package configure
PKG_CFG_ARGS		= @PKG_CFG_ARGS@
# If PKG_DIR is changed to a different relative depth to the build dir, need
# to adapt the ../.. relative paths below and at the top of configure.ac (we
# cannot use absolute paths due to issues in nested configure when path to
# build dir contains spaces).
PKG_DIR			= ./pkgs

configure-packages:
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    if [ -x $$i/configure ]; then \
	      pkg=`basename $$i`; \
	      echo "Configuring package '$$pkg'"; \
	      mkdir -p $(PKG_DIR)/$$pkg; \
	      if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
		( cd $(PKG_DIR)/$$pkg; \
		  $$i/configure --with-tcl=../.. \
		      --with-tclinclude=$(GENERIC_DIR) \
		      $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \
		      --enable-shared --enable-threads; ) || exit $$?; \
	      fi; \
	    fi; \
	  fi; \
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		if [ -x $$i/configure ] ; then \
		    pkg=`basename $$i`; \
		    echo "Configuring package '$$pkg'"; \
		    mkdir -p $(PKG_DIR)/$$pkg; \
		    if [ ! -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
			( cd $(PKG_DIR)/$$pkg; \
			  $$i/configure --with-tcl=../.. \
			      --with-tclinclude=$(GENERIC_DIR) \
			      $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \
			      --enable-shared; ) || exit $$?; \
		    fi; \
		fi; \
	    fi; \
	done

packages: configure-packages ${STUB_LIB_FILE}
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      echo "Building package '$$pkg'"; \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \
	    fi; \
	  fi; \
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    echo "Building package '$$pkg'"; \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \
		fi; \
	    fi; \
	done

install-packages: packages
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      echo "Installing package '$$pkg'"; \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \
		  "DESTDIR=$(INSTALL_ROOT)"; ) || exit $$?; \
	    fi; \
	  fi; \
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    echo "Installing package '$$pkg'"; \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \
			  "DESTDIR=$(INSTALL_ROOT)"; ) || exit $$?; \
		fi; \
	    fi; \
	done

test-packages: ${TCLTEST_EXE} packages
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      echo "Testing package '$$pkg'"; \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE) \
		  "@LD_LIBRARY_PATH_VAR@=../..:$${@LD_LIBRARY_PATH_VAR@}" \
		  "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" \
		  "TCLLIBPATH=../../pkgs" test \
		  "TCLSH_PROG=../../${TCLTEST_EXE}"; ) \
	    fi; \
	  fi; \
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    echo "Testing package '$$pkg'"; \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) \
			  "@LD_LIBRARY_PATH_VAR@=../..:$${@LD_LIBRARY_PATH_VAR@}" \
			  "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" \
			  "TCLLIBPATH=../../pkgs" test \
			  "TCLSH_PROG=../../${TCLTEST_EXE}"; ) \
		fi; \
	    fi; \
	done

clean-packages:
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
	    fi; \
	  fi; \
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
		fi; \
	    fi; \
	done

distclean-packages:
	@for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
	    fi; \
	    rm -rf $(PKG_DIR)/$$pkg; \
	  fi; \
	@for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
		fi; \
		rm -rf $(PKG_DIR)/$$pkg; \
	    fi; \
	done; \
	rm -rf $(PKG_DIR)

dist-packages: configure-packages
	@rm -rf $(DISTROOT)/pkgs; \
	mkdir -p $(DISTROOT)/pkgs; \
	for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE) dist \
		  "DIST_ROOT=$(DISTROOT)/pkgs"; ) || exit $$?; \
	    fi; \
	  fi; \
	for i in $(PKGS_DIR)/* ; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) dist \
			  "DIST_ROOT=$(DISTROOT)/pkgs"; ) || exit $$?; \
		fi; \
	    fi; \
	done

#--------------------------------------------------------------------------
# Maintainer-only targets
#--------------------------------------------------------------------------

# The following target generates the file generic/tclDate.c from the yacc
# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
# not available in all environments. The name of the .c file is different than
# the name of the .y file so that make doesn't try to automatically regenerate
# the .c file.

gendate:
	bison --output-file=$(GENERIC_DIR)/tclDate.c \
	--no-lines \
	--name-prefix=TclDate \
	$(GENERIC_DIR)/tclGetDate.y
		--no-lines \
		--name-prefix=TclDate \
		$(GENERIC_DIR)/tclGetDate.y

#	yacc -l $(GENERIC_DIR)/tclGetDate.y
#	sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
#	    -e 's?SCCSID?RCS: @(#) ?' \
#	    -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
#	    -e '/TclDatenewstate:/d' -e '/#pragma/d' \
#	    -e '/#include <inttypes.h>/d' \
1885
1886
1887
1888
1889
1890
1891





1892
1893
1894
1895
1896
1897
1898




1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914










1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931










1932
1933
1934
1935
1936
1937
1938
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042








2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061








2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078







+
+
+
+
+







+
+
+
+








-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+









-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+







	@echo "This warning can be safely ignored, do not report as a bug!"

$(GENERIC_DIR)/tclOOStubInit.c: $(GENERIC_DIR)/tclOO.decls
	@echo "Warning: tclOOStubInit.c may be out of date."
	@echo "Developers may want to run \"make genstubs\" to regenerate."
	@echo "This warning can be safely ignored, do not report as a bug!"

$(GENERIC_DIR)/tclOOScript.h: $(GENERIC_DIR)/tclOOScript.tcl
	@echo "Warning: tclOOScript.h may be out of date."
	@echo "Developers may want to run \"make genscript\" to regenerate."
	@echo "This warning can be safely ignored, do not report as a bug!"

genstubs:
	$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
		$(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls \
		$(GENERIC_DIR)/tclTomMath.decls
	$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
		$(GENERIC_DIR)/tclOO.decls

genscript:
	$(NATIVE_TCLSH) $(TOOL_DIR)/makeHeader.tcl \
		$(GENERIC_DIR)/tclOOScript.tcl $(GENERIC_DIR)/tclOOScript.h

#
# Target to check that all exported functions have an entry in the stubs
# tables.
#

checkstubs: $(TCL_LIB_FILE)
	-@for i in `nm -p $(TCL_LIB_FILE) \
		| awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \
		| sort -n`; do \
		match=0; \
		for j in $(TCL_DECLS); do \
		    if [ `grep -c "$$i *(" $$j` -gt 0 ]; then \
			match=1; \
		    fi; \
		done; \
		if [ $$match -eq 0 ]; then echo $$i; fi \
		| sort -n` ; do \
	    match=0; \
	    for j in $(TCL_DECLS) ; do \
		if [ `grep -c "$$i *(" $$j` -gt 0 ] ; then \
		    match=1; \
		fi; \
	    done; \
	    if [ $$match -eq 0 ] ; then \
		echo $$i; \
	    fi; \
	done

#
# Target to check that all public APIs which are not command implementations
# have an entry in section three of the distributed manpages.
#

checkdoc: $(TCL_LIB_FILE)
	-@for i in `nm -p $(TCL_LIB_FILE) | awk '$$3 ~ /Tcl_/ { print $$3 }' \
		| grep -v 'Cmd$$' | sort -n`; do \
		match=0; \
		for j in $(TOP_DIR)/doc/*.3; do \
		    if [ `grep '\-' $$j | grep -c $$i` -gt 0 ]; then \
			match=1; \
		    fi; \
		done; \
		if [ $$match -eq 0 ]; then echo $$i; fi \
		| grep -v 'Cmd$$' | sort -n` ; do \
	    match=0; \
	    for j in $(TOP_DIR)/doc/*.3 ; do \
		if [ `grep '\-' $$j | grep -c $$i` -gt 0 ] ; then \
		    match=1; \
		fi; \
	    done; \
	    if [ $$match -eq 0 ] ; then \
		echo $$i; \
	    fi; \
	done

#
# Target to check for proper usage of UCHAR macro.
#

checkuchar:
1953
1954
1955
1956
1957
1958
1959
1960

1961
1962
1963
1964
1965
1966
1967

1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978


1979
1980
1981
1982
1983
1984
1985
2093
2094
2095
2096
2097
2098
2099

2100
2101
2102
2103
2104
2105
2106

2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127







-
+






-
+











+
+








#
# Target to create a Tcl RPM for Linux. Requires that you be on a Linux
# system.
#

rpm: all
	rm -f THIS.TCL.SPEC
	-@rm -f THIS.TCL.SPEC
	echo "%define _builddir `pwd`" > THIS.TCL.SPEC
	echo "%define _rpmdir `pwd`/RPMS" >> THIS.TCL.SPEC
	cat tcl.spec >> THIS.TCL.SPEC
	mkdir -p RPMS/i386
	rpmbuild -bb THIS.TCL.SPEC
	mv RPMS/i386/*.rpm .
	rm -rf RPMS THIS.TCL.SPEC
	-rm -rf RPMS THIS.TCL.SPEC

#
# Target to create a proper Tcl distribution from information in the master
# source directory. DISTDIR must be defined to indicate where to put the
# distribution. DISTDIR must be an absolute path name.
#

DISTROOT = /tmp/dist
DISTNAME = tcl${VERSION}${PATCH_LEVEL}
ZIPNAME	 = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip
DISTDIR	 = $(DISTROOT)/$(DISTNAME)
BUILTIN_PACKAGE_LIST = http opt msgcat reg dde tcltest platform

$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \
		$(UNIX_DIR)/aclocal.m4
	cd $(UNIX_DIR); autoconf
$(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure
	cd $(MAC_OSX_DIR); autoconf
$(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
	cd $(MAC_OSX_DIR); autoheader; touch $@
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017




2018
2019
2020
2021
2022
2023
2024
2148
2149
2150
2151
2152
2153
2154





2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165







-
-
-
-
-
+
+
+
+







	cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README \
		$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
		$(DISTDIR)
	@mkdir $(DISTDIR)/library
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	for i in http1.0 http opt msgcat reg dde tcltest platform; \
	    do \
		mkdir $(DISTDIR)/library/$$i ;\
		cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
	    done;
	for i in $(BUILTIN_PACKAGE_LIST) ; do \
	    mkdir $(DISTDIR)/library/$$i;\
	    cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
	done
	@mkdir $(DISTDIR)/library/encoding
	cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
	@mkdir $(DISTDIR)/library/msgs
	cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs
	@echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata
	@( cd $(TOP_DIR); \
	  find library/tzdata -name CVS -prune -o -type f -print ) \
2046
2047
2048
2049
2050
2051
2052
2053
2054

2055
2056
2057
2058
2059
2060
2061
2062
2187
2188
2189
2190
2191
2192
2193


2194

2195
2196
2197
2198
2199
2200
2201







-
-
+
-







		$(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \
		$(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \
		$(TOP_DIR)/win/tclsh.exe.manifest.in \
		$(DISTDIR)/win
	cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \
		$(DISTDIR)/win
	cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/*.vc $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
	@mkdir $(DISTDIR)/macosx
	cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \
		$(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \
2081
2082
2083
2084
2085
2086
2087
2088

2089
2090
2091
2092
2093

2094
2095



2096
2097
2098
2099
2100

2101
2102
2103
2104
2105
2106
2107
2220
2221
2222
2223
2224
2225
2226

2227
2228
2229
2230
2231
2232
2233


2234
2235
2236
2237
2238
2239
2240

2241
2242
2243
2244
2245
2246
2247
2248







-
+





+
-
-
+
+
+




-
+







		$(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \
		$(DISTDIR)/tools
	@mkdir $(DISTDIR)/libtommath
	cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath
	@mkdir $(DISTDIR)/pkgs
	cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs
	cp $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs
	for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \
	for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null` ; do \
	    tar -C $(DISTDIR)/pkgs -xzf "$$i"; \
	done

alldist: dist
	rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME)
	( cd $(DISTROOT); \
	cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \
		gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME)
		tar cf $(DISTNAME)-src.tar $(DISTNAME); \
		gzip -9 $(DISTNAME)-src.tar; \
		zip -qr8 $(ZIPNAME) $(DISTNAME) )

#--------------------------------------------------------------------------
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
# workspace. It depends on the Tcl & Tk being in directories called tcl8.* &
# tk8.* up two directories from the TOOL_DIR.
#
# Note that for platforms where this is important, it is more common to use a
# build of this HTML documentation that has already been placed online. As
# such, this rule is not guaranteed to work well on all systems; it only needs
# to function on those of the Tcl/Tk maintainers.
#
2140
2141
2142
2143
2144
2145
2146

2147
2148
2149
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291







+



.PHONY: clean distclean depend genstubs checkstubs checkexports checkuchar
.PHONY: shell gdb valgrind valgrindshell dist alldist rpm
.PHONY: tclLibObjs tcltest-real test-tcl gdb-test ro-test trace-test xttest
.PHONY: topDirName gendate gentommath_h trace-shell checkdoc
.PHONY: install-tzdata install-msgs
.PHONY: packages configure-packages test-packages clean-packages
.PHONY: dist-packages distclean-packages install-packages
.PHONY: install-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile

#--------------------------------------------------------------------------
# DO NOT DELETE THIS LINE -- make depend depends on it.

Changes to unix/README.

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
41
42
43
44
45
46
47


48
49
50
51
52
53
54







-
-







(c) Type "./configure". This runs a configuration script created by GNU
    autoconf, which configures Tcl for your system and creates a Makefile. The
    configure script allows you to customize the Tcl configuration for your
    site; for details on how you can do this, type "./configure --help" or
    refer to the autoconf documentation (not included here). Tcl's "configure"
    supports the following special switches in addition to the standard ones:

	--enable-threads	If this switch is set, Tcl will compile itself
				with multithreading support.
	--disable-load		If this switch is specified then Tcl will
				configure itself not to allow dynamic loading,
				even if your system appears to support it.
				Normally you can leave this switch out and Tcl
				will build itself for dynamic loading if your
				system supports it.
	--disable-dll-unloading	Disables support for the [unload] command even

Changes to unix/configure.

1
2
3

4
5
6
7
8
9
10
1
2

3
4
5
6
7
8
9
10


-
+







#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for tcl 9.0.
# Generated by GNU Autoconf 2.69 for tcl 8.7.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
573
574
575
576
577
578
579
580
581


582
583
584
585
586
587
588
573
574
575
576
577
578
579


580
581
582
583
584
585
586
587
588







-
-
+
+







subdirs=
MFLAGS=
MAKEFLAGS=

# Identity of this package.
PACKAGE_NAME='tcl'
PACKAGE_TARNAME='tcl'
PACKAGE_VERSION='9.0'
PACKAGE_STRING='tcl 9.0'
PACKAGE_VERSION='8.7'
PACKAGE_STRING='tcl 8.7'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
660
661
662
663
664
665
666










667
668
669
670
671
672
673
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683







+
+
+
+
+
+
+
+
+
+







TCL_LIB_FILE
PKG_CFG_ARGS
TCL_YEAR
TCL_PATCH_LEVEL
TCL_MINOR_VERSION
TCL_MAJOR_VERSION
TCL_VERSION
INSTALL_MSGS
INSTALL_LIBRARIES
TCL_ZIP_FILE
ZIPFS_BUILD
ZIP_INSTALL_OBJS
ZIP_PROG_VFSSEARCH
ZIP_PROG_OPTIONS
ZIP_PROG
EXEEXT_FOR_BUILD
CC_FOR_BUILD
DTRACE
LDFLAGS_DEFAULT
CFLAGS_DEFAULT
INSTALL_STUB_LIB
DLL_INSTALL_DIR
INSTALL_LIB
MAKE_STUB_LIB
695
696
697
698
699
700
701
702

703
704
705
706
707
708
709
705
706
707
708
709
710
711

712
713
714
715
716
717
718
719







-
+







LIBOBJS
AR
RANLIB
ZLIB_INCLUDE
ZLIB_SRCS
ZLIB_OBJS
TCLSH_PROG
TCL_THREADS
SHARED_BUILD
EGREP
GREP
CPP
OBJEXT
EXEEXT
ac_ct_CC
CPPFLAGS
744
745
746
747
748
749
750
751


752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770

771
772
773
774
775
776
777
754
755
756
757
758
759
760

761
762
763
764
765
766
767
768

769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788







-
+
+






-












+







PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL'
SHELL
OBJEXT_FOR_BUILD'
ac_subst_files=''
ac_user_opts='
enable_option_checking
enable_man_symlinks
enable_man_compression
enable_man_suffix
enable_threads
with_encoding
enable_shared
enable_64bit
enable_64bit_vis
enable_rpath
enable_corefoundation
enable_load
enable_symbols
enable_langinfo
enable_dll_unloading
with_tzdata
enable_dtrace
enable_zipfs
enable_framework
'
      ac_precious_vars='build_alias
host_alias
target_alias
CC
CFLAGS
1315
1316
1317
1318
1319
1320
1321
1322

1323
1324
1325
1326
1327
1328
1329
1326
1327
1328
1329
1330
1331
1332

1333
1334
1335
1336
1337
1338
1339
1340







-
+







#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures tcl 9.0 to adapt to many kinds of systems.
\`configure' configures tcl 8.7 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.
1376
1377
1378
1379
1380
1381
1382
1383

1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410

1411
1412
1413
1414
1415
1416
1417
1387
1388
1389
1390
1391
1392
1393

1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408

1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428







-
+














-












+








  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of tcl 9.0:";;
     short | recursive ) echo "Configuration of tcl 8.7:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-man-symlinks   use symlinks for the manpages (default: off)
  --enable-man-compression=PROG
                          compress the manpages with PROG (default: off)
  --enable-man-suffix=STRING
                          use STRING as a suffix to manpage file names
                          (default: no, tcl if enabled without
                          specifying STRING)
  --enable-threads        build with threads (default: on)
  --enable-shared         build and link with shared libraries (default: on)
  --enable-64bit          enable 64bit support (default: off)
  --enable-64bit-vis      enable 64bit Sparc VIS support (default: off)
  --disable-rpath         disable rpath support (default: on)
  --enable-corefoundation use CoreFoundation API on MacOSX (default: on)
  --enable-load           allow dynamic loading and "load" command (default:
                          on)
  --enable-symbols        build with debugging symbols (default: off)
  --enable-langinfo       use nl_langinfo if possible to determine encoding at
                          startup, otherwise use old heuristic (default: on)
  --enable-dll-unloading  enable the 'unload' command (default: on)
  --enable-dtrace         build with DTrace support (default: off)
  --enable-zipfs          build with Zipfs support (default: on)
  --enable-framework      package shared libraries in MacOSX frameworks
                          (default: off)

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
  --with-encoding         encoding for configuration values (default:
1490
1491
1492
1493
1494
1495
1496
1497

1498
1499
1500
1501
1502
1503
1504
1501
1502
1503
1504
1505
1506
1507

1508
1509
1510
1511
1512
1513
1514
1515







-
+







    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
tcl configure 9.0
tcl configure 8.7
generated by GNU Autoconf 2.69

Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
1851
1852
1853
1854
1855
1856
1857














































1858
1859
1860
1861
1862
1863
1864
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_func

# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES
# ---------------------------------------------
# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
# accordingly.
ac_fn_c_check_decl ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  as_decl_name=`echo $2|sed 's/ *(.*//'`
  as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
$as_echo_n "checking whether $as_decl_name is declared... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main ()
{
#ifndef $as_decl_name
#ifdef __cplusplus
  (void) $as_decl_use;
#else
  (void) $as_decl_name;
#endif
#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  eval "$3=yes"
else
  eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_decl

# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
# -------------------------------------------
# Tests whether TYPE exists after having included INCLUDES, setting cache
# variable VAR accordingly.
ac_fn_c_check_type ()
{
1966
1967
1968
1969
1970
1971
1972
1973

1974
1975
1976
1977
1978
1979
1980
2023
2024
2025
2026
2027
2028
2029

2030
2031
2032
2033
2034
2035
2036
2037







-
+







  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_member
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by tcl $as_me 9.0, which was
It was created by tcl $as_me 8.7, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328




2329
2330
2331
2332
2333
2334
2335
2375
2376
2377
2378
2379
2380
2381




2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392







-
-
-
-
+
+
+
+







ac_compiler_gnu=$ac_cv_c_compiler_gnu






TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="a0"
TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
TCL_PATCH_LEVEL="a2"
VERSION=${TCL_VERSION}

EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}

#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
3268
3269
3270
3271
3272
3273
3274

3275
3276
3277
3278
3279
3280
3281
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339







+







#ifndef __cplusplus
#define inline $ac_val
#endif
_ACEOF
    ;;
esac



#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files.  Special notes:
#	- stdlib.h doesn't define strtol, strtoul, or
#	  strtod insome versions of SunOS
#	- some versions of string.h don't declare procedures such
#	  as strstr
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3786
3787
3788
3789
3790
3791
3792




















3793
3794
3795
3796
3797
3798
3799







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







$as_echo "$tcl_cv_dirent_h" >&6; }

    if test $tcl_cv_dirent_h = no; then

$as_echo "#define NO_DIRENT_H 1" >>confdefs.h

    fi

    ac_fn_c_check_header_mongrel "$LINENO" "float.h" "ac_cv_header_float_h" "$ac_includes_default"
if test "x$ac_cv_header_float_h" = xyes; then :

else

$as_echo "#define NO_FLOAT_H 1" >>confdefs.h

fi


    ac_fn_c_check_header_mongrel "$LINENO" "values.h" "ac_cv_header_values_h" "$ac_includes_default"
if test "x$ac_cv_header_values_h" = xyes; then :

else

$as_echo "#define NO_VALUES_H 1" >>confdefs.h

fi


    ac_fn_c_check_header_mongrel "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default"
if test "x$ac_cv_header_stdlib_h" = xyes; then :
  tcl_ok=1
else
  tcl_ok=0
fi
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
3963
3964
3965
3966
3967
3968
3969





























































































































































































































































































































3970
3971
3972
3973
3974
3975
3976







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_pipe" >&5
$as_echo "$tcl_cv_cc_pipe" >&6; }
    if test $tcl_cv_cc_pipe = yes; then
	CFLAGS="$CFLAGS -pipe"
    fi
fi

#------------------------------------------------------------------------
# Threads support
#------------------------------------------------------------------------


    # Check whether --enable-threads was given.
if test "${enable_threads+set}" = set; then :
  enableval=$enable_threads; tcl_ok=$enableval
else
  tcl_ok=yes
fi


    if test "${TCL_THREADS}" = 1; then
	tcl_threaded_core=1;
    fi

    if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then
	TCL_THREADS=1
	# USE_THREAD_ALLOC tells us to try the special thread-based
	# allocator that significantly reduces lock contention

$as_echo "#define USE_THREAD_ALLOC 1" >>confdefs.h


$as_echo "#define _REENTRANT 1" >>confdefs.h

	if test "`uname -s`" = "SunOS" ; then

$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h

	fi

$as_echo "#define _THREAD_SAFE 1" >>confdefs.h

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthread" >&5
$as_echo_n "checking for pthread_mutex_init in -lpthread... " >&6; }
if ${ac_cv_lib_pthread_pthread_mutex_init+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lpthread  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

/* Override any GCC internal prototype to avoid an error.
   Use char because int might match the return type of a GCC
   builtin and then its argument prototype would still apply.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_pthread_pthread_mutex_init=yes
else
  ac_cv_lib_pthread_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_pthread_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_pthread_pthread_mutex_init" = xyes; then :
  tcl_ok=yes
else
  tcl_ok=no
fi

	if test "$tcl_ok" = "no"; then
	    # Check a little harder for __pthread_mutex_init in the same
	    # library, as some systems hide it there until pthread.h is
	    # defined.  We could alternatively do an AC_TRY_COMPILE with
	    # pthread.h, but that will work with libpthread really doesn't
	    # exist, like AIX 4.2.  [Bug: 4359]
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __pthread_mutex_init in -lpthread" >&5
$as_echo_n "checking for __pthread_mutex_init in -lpthread... " >&6; }
if ${ac_cv_lib_pthread___pthread_mutex_init+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lpthread  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

/* Override any GCC internal prototype to avoid an error.
   Use char because int might match the return type of a GCC
   builtin and then its argument prototype would still apply.  */
#ifdef __cplusplus
extern "C"
#endif
char __pthread_mutex_init ();
int
main ()
{
return __pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_pthread___pthread_mutex_init=yes
else
  ac_cv_lib_pthread___pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_pthread___pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_pthread___pthread_mutex_init" = xyes; then :
  tcl_ok=yes
else
  tcl_ok=no
fi

	fi

	if test "$tcl_ok" = "yes"; then
	    # The space is needed
	    THREADS_LIBS=" -lpthread"
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthreads" >&5
$as_echo_n "checking for pthread_mutex_init in -lpthreads... " >&6; }
if ${ac_cv_lib_pthreads_pthread_mutex_init+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lpthreads  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

/* Override any GCC internal prototype to avoid an error.
   Use char because int might match the return type of a GCC
   builtin and then its argument prototype would still apply.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_pthreads_pthread_mutex_init=yes
else
  ac_cv_lib_pthreads_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_pthreads_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_pthreads_pthread_mutex_init" = xyes; then :
  tcl_ok=yes
else
  tcl_ok=no
fi

	    if test "$tcl_ok" = "yes"; then
		# The space is needed
		THREADS_LIBS=" -lpthreads"
	    else
		{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc" >&5
$as_echo_n "checking for pthread_mutex_init in -lc... " >&6; }
if ${ac_cv_lib_c_pthread_mutex_init+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lc  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

/* Override any GCC internal prototype to avoid an error.
   Use char because int might match the return type of a GCC
   builtin and then its argument prototype would still apply.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_c_pthread_mutex_init=yes
else
  ac_cv_lib_c_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_c_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_c_pthread_mutex_init" = xyes; then :
  tcl_ok=yes
else
  tcl_ok=no
fi

		if test "$tcl_ok" = "no"; then
		    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc_r" >&5
$as_echo_n "checking for pthread_mutex_init in -lc_r... " >&6; }
if ${ac_cv_lib_c_r_pthread_mutex_init+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lc_r  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

/* Override any GCC internal prototype to avoid an error.
   Use char because int might match the return type of a GCC
   builtin and then its argument prototype would still apply.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_c_r_pthread_mutex_init=yes
else
  ac_cv_lib_c_r_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_c_r_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_c_r_pthread_mutex_init" = xyes; then :
  tcl_ok=yes
else
  tcl_ok=no
fi

		    if test "$tcl_ok" = "yes"; then
			# The space is needed
			THREADS_LIBS=" -pthread"
		    else
			TCL_THREADS=0
			{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&5
$as_echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&2;}
		    fi
		fi
	    fi
	fi

	# Does the pthread-implementation provide
	# 'pthread_attr_setstacksize' ?

	ac_saved_libs=$LIBS
	LIBS="$LIBS $THREADS_LIBS"
	for ac_func in pthread_attr_setstacksize pthread_atfork
do :
  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
  cat >>confdefs.h <<_ACEOF
#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF

fi
done

	LIBS=$ac_saved_libs
    else
	TCL_THREADS=0
    fi
    # Do checking message here to not mess up interleaved configure output
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with threads" >&5
$as_echo_n "checking for building with threads... " >&6; }
    if test "${TCL_THREADS}" = 1; then

$as_echo "#define TCL_THREADS 1" >>confdefs.h

	if test "${tcl_threaded_core}" = 1; then
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (threaded core)" >&5
$as_echo "yes (threaded core)" >&6; }
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
	fi
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
    fi




#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------



4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
3997
3998
3999
4000
4001
4002
4003


4004
4005
4006
4007
4008
4009
4010
4011
4012


































4013
4014
4015
4016
4017
4018
4019







-
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------


    #--------------------------------------------------------------------
    # On a few very rare systems, all of the libm.a stuff is
    # already in libc.a.  Set compiler flags accordingly.
    # Also, Linux requires the "ieee" library for math to work
    # right (and it must appear before "-lm").
    #--------------------------------------------------------------------

    ac_fn_c_check_func "$LINENO" "sin" "ac_cv_func_sin"
if test "x$ac_cv_func_sin" = xyes; then :
  MATH_LIBS=""
else
  MATH_LIBS="-lm"
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lieee" >&5
$as_echo_n "checking for main in -lieee... " >&6; }
if ${ac_cv_lib_ieee_main+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lieee  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */


int
main ()
{
return main ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_ieee_main=yes
else
  ac_cv_lib_ieee_main=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ieee_main" >&5
$as_echo "$ac_cv_lib_ieee_main" >&6; }
if test "x$ac_cv_lib_ieee_main" = xyes; then :
  MATH_LIBS="-lieee $MATH_LIBS"
fi


    #--------------------------------------------------------------------
    # Interactive UNIX requires -linet instead of -lsocket, plus it
    # needs net/errno.h to define the socket-related error codes.
    #--------------------------------------------------------------------

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -linet" >&5
4505
4506
4507
4508
4509
4510
4511


























































































































































































































































































4512
4513
4514
4515
4516
4517
4518
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then :
  LIBS="$LIBS -lnsl"
fi

fi



$as_echo "#define _REENTRANT 1" >>confdefs.h


$as_echo "#define _THREAD_SAFE 1" >>confdefs.h

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthread" >&5
$as_echo_n "checking for pthread_mutex_init in -lpthread... " >&6; }
if ${ac_cv_lib_pthread_pthread_mutex_init+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lpthread  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

/* Override any GCC internal prototype to avoid an error.
   Use char because int might match the return type of a GCC
   builtin and then its argument prototype would still apply.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_pthread_pthread_mutex_init=yes
else
  ac_cv_lib_pthread_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_pthread_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_pthread_pthread_mutex_init" = xyes; then :
  tcl_ok=yes
else
  tcl_ok=no
fi

    if test "$tcl_ok" = "no"; then
	# Check a little harder for __pthread_mutex_init in the same
	# library, as some systems hide it there until pthread.h is
	# defined.  We could alternatively do an AC_TRY_COMPILE with
	# pthread.h, but that will work with libpthread really doesn't
	# exist, like AIX 4.2.  [Bug: 4359]
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __pthread_mutex_init in -lpthread" >&5
$as_echo_n "checking for __pthread_mutex_init in -lpthread... " >&6; }
if ${ac_cv_lib_pthread___pthread_mutex_init+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lpthread  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

/* Override any GCC internal prototype to avoid an error.
   Use char because int might match the return type of a GCC
   builtin and then its argument prototype would still apply.  */
#ifdef __cplusplus
extern "C"
#endif
char __pthread_mutex_init ();
int
main ()
{
return __pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_pthread___pthread_mutex_init=yes
else
  ac_cv_lib_pthread___pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_pthread___pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_pthread___pthread_mutex_init" = xyes; then :
  tcl_ok=yes
else
  tcl_ok=no
fi

    fi

    if test "$tcl_ok" = "yes"; then
	# The space is needed
	THREADS_LIBS=" -lpthread"
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthreads" >&5
$as_echo_n "checking for pthread_mutex_init in -lpthreads... " >&6; }
if ${ac_cv_lib_pthreads_pthread_mutex_init+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lpthreads  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

/* Override any GCC internal prototype to avoid an error.
   Use char because int might match the return type of a GCC
   builtin and then its argument prototype would still apply.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_pthreads_pthread_mutex_init=yes
else
  ac_cv_lib_pthreads_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_pthreads_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_pthreads_pthread_mutex_init" = xyes; then :
  _ok=yes
else
  tcl_ok=no
fi

	if test "$tcl_ok" = "yes"; then
	    # The space is needed
	    THREADS_LIBS=" -lpthreads"
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc" >&5
$as_echo_n "checking for pthread_mutex_init in -lc... " >&6; }
if ${ac_cv_lib_c_pthread_mutex_init+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lc  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

/* Override any GCC internal prototype to avoid an error.
   Use char because int might match the return type of a GCC
   builtin and then its argument prototype would still apply.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_c_pthread_mutex_init=yes
else
  ac_cv_lib_c_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_c_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_c_pthread_mutex_init" = xyes; then :
  tcl_ok=yes
else
  tcl_ok=no
fi

	    if test "$tcl_ok" = "no"; then
		{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc_r" >&5
$as_echo_n "checking for pthread_mutex_init in -lc_r... " >&6; }
if ${ac_cv_lib_c_r_pthread_mutex_init+:} false; then :
  $as_echo_n "(cached) " >&6
else
  ac_check_lib_save_LIBS=$LIBS
LIBS="-lc_r  $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

/* Override any GCC internal prototype to avoid an error.
   Use char because int might match the return type of a GCC
   builtin and then its argument prototype would still apply.  */
#ifdef __cplusplus
extern "C"
#endif
char pthread_mutex_init ();
int
main ()
{
return pthread_mutex_init ();
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_lib_c_r_pthread_mutex_init=yes
else
  ac_cv_lib_c_r_pthread_mutex_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5
$as_echo "$ac_cv_lib_c_r_pthread_mutex_init" >&6; }
if test "x$ac_cv_lib_c_r_pthread_mutex_init" = xyes; then :
  tcl_ok=yes
else
  tcl_ok=no
fi

		if test "$tcl_ok" = "yes"; then
		    # The space is needed
		    THREADS_LIBS=" -pthread"
		else
		    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how to find pthread lib on your system - you must edit the LIBS in the Makefile..." >&5
$as_echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must edit the LIBS in the Makefile..." >&2;}
		fi
	    fi
	fi
    fi

    # Does the pthread-implementation provide
    # 'pthread_attr_setstacksize' ?

    ac_saved_libs=$LIBS
    LIBS="$LIBS $THREADS_LIBS"
    for ac_func in pthread_attr_setstacksize pthread_atfork
do :
  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
  cat >>confdefs.h <<_ACEOF
#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF

fi
done

    LIBS=$ac_saved_libs

    # TIP #509
    ac_fn_c_check_decl "$LINENO" "PTHREAD_MUTEX_RECURSIVE" "ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" "#include <pthread.h>
"
if test "x$ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" = xyes; then :
  ac_have_decl=1
else
  ac_have_decl=0
fi

cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE $ac_have_decl
_ACEOF
if test $ac_have_decl = 1; then :
  tcl_ok=yes
else
  tcl_ok=no
fi



# Add the threads support libraries
LIBS="$LIBS$THREADS_LIBS"


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5
$as_echo_n "checking how to build libraries... " >&6; }
4539
4540
4541
4542
4543
4544
4545

4546
4547
4548
4549
4550
4551
4552
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520







+







	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5
$as_echo "static" >&6; }
	SHARED_BUILD=0

$as_echo "#define STATIC_BUILD 1" >>confdefs.h

    fi



#--------------------------------------------------------------------
# Look for a native installed tclsh binary (if available)
# If one cannot be found then use the binary we build (fails for
# cross compiling). This is used for NATIVE_TCLSH in Makefile.
#--------------------------------------------------------------------
4975
4976
4977
4978
4979
4980
4981
4982

4983
4984
4985
4986
4987
4988
4989
4943
4944
4945
4946
4947
4948
4949

4950
4951
4952
4953
4954
4955
4956
4957







-
+







    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    if test "$GCC" = yes; then :

	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement"
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith"

else

	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""

fi
5085
5086
5087
5088
5089
5090
5091
5092

5093
5094
5095
5096
5097
5098
5099
5053
5054
5055
5056
5057
5058
5059

5060
5061
5062
5063
5064
5065
5066
5067







-
+







    PLAT_SRCS=""
    LDAIX_SRC=""
    if test "x${SHLIB_VERSION}" = x; then :
  SHLIB_VERSION="1.0"
fi
    case $system in
	AIX-*)
	    if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then :
	    if test "$GCC" != "yes"; then :

		# AIX requires the _r compiler when gcc isn't being used
		case "${CC}" in
		    *_r|*_r\ *)
			# ok ...
			;;
		    *)
5241
5242
5243
5244
5245
5246
5247
5248

5249
5250
5251
5252
5253
5254
5255
5209
5210
5211
5212
5213
5214
5215

5216
5217
5218
5219
5220
5221
5222
5223







-
+







	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*|MINGW32*)
	CYGWIN_*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o"
	    PLAT_OBJS='${CYGWIN_OBJS}'
	    PLAT_SRCS='${CYGWIN_SRCS}'
	    DL_LIBS="-ldl"
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5255
5256
5257
5258
5259
5260
5261



5262
5263
5264
5265
5266
5267
5268







-
-
-








fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5
$as_echo "$ac_cv_cygwin" >&6; }
	    if test "$ac_cv_cygwin" = "no"; then
		as_fn_error $? "${CC} is not a cygwin compiler." "$LINENO" 5
	    fi
	    if test "x${TCL_THREADS}" = "x0"; then
		as_fn_error $? "CYGWIN compile is only supported with --enable-threads" "$LINENO" 5
	    fi
	    do64bit_ok=yes
	    if test "x${SHARED_BUILD}" = "x1"; then
		echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
		# The eval makes quoting arguments work.
		if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
		then :
		else
5315
5316
5317
5318
5319
5320
5321
5322

5323
5324
5325
5326
5327
5328
5329
5280
5281
5282
5283
5284
5285
5286

5287
5288
5289
5290
5291
5292
5293
5294







-
+







	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	Haiku*)
	    LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_SUFFIX=".so"
	    SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'
	    SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-lroot"
	    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lnetwork" >&5
$as_echo_n "checking for inet_ntoa in -lnetwork... " >&6; }
if ${ac_cv_lib_network_inet_ntoa+:} false; then :
  $as_echo_n "(cached) " >&6
else
5637
5638
5639
5640
5641
5642
5643
5644

5645
5646
5647
5648
5649
5650
5651
5602
5603
5604
5605
5606
5607
5608

5609
5610
5611
5612
5613
5614
5615
5616







-
+








	    CFLAGS_OPTIMIZE="-O2"
	    # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings
	    # when you inline the string and math operations.  Turn this off to
	    # get rid of the warnings.
	    #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"

	    SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'
	    SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
	    if test $doRpath = yes; then :

		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
5724
5725
5726
5727
5728
5729
5730
5731

5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748




5749
5750
5751
5752
5753
5754
5755
5756
5757
5758

5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773




5774
5775
5776
5777

5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796




5797
5798
5799
5800
5801
5802
5803
5804
5689
5690
5691
5692
5693
5694
5695

5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707






5708
5709
5710
5711


5712
5713
5714
5715
5716
5717
5718

5719
5720
5721
5722
5723
5724
5725
5726
5727
5728






5729
5730
5731
5732


5733

5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747






5748
5749
5750
5751

5752
5753
5754
5755
5756
5757
5758







-
+











-
-
-
-
-
-
+
+
+
+
-
-







-
+









-
-
-
-
-
-
+
+
+
+
-
-

-
+













-
-
-
-
-
-
+
+
+
+
-







	    alpha|sparc64)
		SHLIB_CFLAGS="-fPIC"
		;;
	    *)
		SHLIB_CFLAGS="-fpic"
		;;
	    esac
	    SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
	    SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared'
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    if test $doRpath = yes; then :

		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
	    LDFLAGS="-Wl,-export-dynamic"
	    CFLAGS_OPTIMIZE="-O2"
	    if test "${TCL_THREADS}" = "1"; then :

		# On OpenBSD:	Compile with -pthread
		#		Don't link with -lpthread
		LIBS=`echo $LIBS | sed s/-lpthread//`
		CFLAGS="$CFLAGS -pthread"
	    # On OpenBSD:	Compile with -pthread
	    #		Don't link with -lpthread
	    LIBS=`echo $LIBS | sed s/-lpthread//`
	    CFLAGS="$CFLAGS -pthread"

fi
	    # OpenBSD doesn't do version numbers with dots.
	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
	    TCL_LIB_VERSIONS_OK=nodots
	    ;;
	NetBSD-*)
	    # NetBSD has ELF and can use 'cc -shared' to build shared libs
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
	    SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared'
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    if test $doRpath = yes; then :

		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    if test "${TCL_THREADS}" = "1"; then :

		# The -pthread needs to go in the CFLAGS, not LIBS
		LIBS=`echo $LIBS | sed s/-pthread//`
		CFLAGS="$CFLAGS -pthread"
	    	LDFLAGS="$LDFLAGS -pthread"
	    # The -pthread needs to go in the CFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS -pthread"
	    LDFLAGS="$LDFLAGS -pthread"

fi
	    ;;
	FreeBSD-*)
	DragonFly-*|FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    LDFLAGS=""
	    if test $doRpath = yes; then :

		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
	    if test "${TCL_THREADS}" = "1"; then :

		# The -pthread needs to go in the LDFLAGS, not LIBS
		LIBS=`echo $LIBS | sed s/-pthread//`
		CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
		LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
	    # The -pthread needs to go in the LDFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
	    LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
fi
	    case $system in
	    FreeBSD-3.*)
		# Version numbers are dot-stripped by system policy.
		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
		TCL_LIB_VERSIONS_OK=nodots
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164




6165
6166

6167
6168
6169
6170
6171


6172
6173
6174
6175
6176
6177
6178
6179
6180
6106
6107
6108
6109
6110
6111
6112






6113
6114
6115
6116
6117

6118
6119
6120
6121


6122
6123


6124
6125
6126
6127
6128
6129
6130







-
-
-
-
-
-
+
+
+
+

-
+



-
-
+
+
-
-







	    if test "$GCC" = yes; then :
  CFLAGS="$CFLAGS -mieee"
else

		CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"
fi
	    # see pthread_intro(3) for pthread support on osf1, k.furukawa
	    if test "${TCL_THREADS}" = 1; then :

		CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
		CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
		LIBS=`echo $LIBS | sed s/-lpthreads//`
		if test "$GCC" = yes; then :
	    CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
	    CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
	    LIBS=`echo $LIBS | sed s/-lpthreads//`
	    if test "$GCC" = yes; then :

		    LIBS="$LIBS -lpthread -lmach -lexc"
		LIBS="$LIBS -lpthread -lmach -lexc"

else

		    CFLAGS="$CFLAGS -pthread"
		    LDFLAGS="$LDFLAGS -pthread"
		CFLAGS="$CFLAGS -pthread"
		LDFLAGS="$LDFLAGS -pthread"

fi

fi
	    ;;
	QNX-6*)
	    # QNX RTP
	    # This may work for all QNX, but it was only reported for v6.
	    SHLIB_CFLAGS="-fPIC"
6516
6517
6518
6519
6520
6521
6522
6523

6524
6525

6526
6527
6528
6529
6530
6531
6532
6466
6467
6468
6469
6470
6471
6472

6473
6474

6475
6476
6477
6478
6479
6480
6481
6482







-
+

-
+







    # standard manufacturer compiler.

    if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then :

	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*|MINGW32_*) ;;
	    CYGWIN_*) ;;
	    IRIX*) ;;
	    NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
	    NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac
fi

    if test "$tcl_cv_cc_visibility_hidden" != yes; then :
6924
6925
6926
6927
6928
6929
6930
6931

6932
6933
6934
6935
6936
6937
6938
6874
6875
6876
6877
6878
6879
6880

6881
6882
6883
6884
6885
6886
6887
6888







-
+







_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_type_64bit=__int64
else
  tcl_type_64bit="long long"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
	# See if we should use long anyway  Note that we substitute in the
	# See if we could use long anyway  Note that we substitute in the
	# type that is our current guess for a 64-bit type inside this check
	# program, so it should be modified only carefully...
        cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
6950
6951
6952
6953
6954
6955
6956
6957
6958


6959
6960
6961
6962
6963
6964
6965
6900
6901
6902
6903
6904
6905
6906


6907
6908
6909
6910
6911
6912
6913
6914
6915







-
-
+
+







rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi

    if test "${tcl_cv_type_64bit}" = none ; then

$as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: using long" >&5
$as_echo "using long" >&6; }
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
    else

cat >>confdefs.h <<_ACEOF
#define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit}
_ACEOF

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_cv_type_64bit}" >&5
6993
6994
6995
6996
6997
6998
6999


































7000
7001
7002
7003
7004
7005
7006
6943
6944
6945
6946
6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
6987
6988
6989
6990







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5
$as_echo "$tcl_cv_struct_dirent64" >&6; }
	if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then

$as_echo "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h

	fi

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for DIR64" >&5
$as_echo_n "checking for DIR64... " >&6; }
if ${tcl_cv_DIR64+:} false; then :
  $as_echo_n "(cached) " >&6
else

	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/types.h>
#include <dirent.h>
int
main ()
{
struct dirent64 *p; DIR64 d = opendir64(".");
            p = readdir64(d); rewinddir64(d); closedir64(d);
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_cv_DIR64=yes
else
  tcl_cv_DIR64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_DIR64" >&5
$as_echo "$tcl_cv_DIR64" >&6; }
	if test "x${tcl_cv_DIR64}" = "xyes" ; then

$as_echo "#define HAVE_DIR64 1" >>confdefs.h

	fi

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct stat64" >&5
$as_echo_n "checking for struct stat64... " >&6; }
if ${tcl_cv_struct_stat64+:} false; then :
  $as_echo_n "(cached) " >&6
else
7425
7426
7427
7428
7429
7430
7431
7432

7433
7434
7435
7436
7437
7438
7439
7409
7410
7411
7412
7413
7414
7415

7416
7417
7418
7419
7420
7421
7422
7423







-
+







else

$as_echo "#define NO_UNAME 1" >>confdefs.h

fi


if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \
if test "`uname -s`" = "Darwin" && \
	test "`uname -r | awk -F. '{print $1}'`" -lt 7; then
    # prior to Darwin 7, realpath is not threadsafe, so don't
    # use it when threads are enabled, c.f. bug # 711232
    ac_cv_func_realpath=no
fi
ac_fn_c_check_func "$LINENO" "realpath" "ac_cv_func_realpath"
if test "x$ac_cv_func_realpath" = xyes; then :
7548
7549
7550
7551
7552
7553
7554
7555
7556

7557
7558
7559
7560
7561
7562
7563
7532
7533
7534
7535
7536
7537
7538


7539
7540
7541
7542
7543
7544
7545
7546







-
-
+







fi


#--------------------------------------------------------------------
#	Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------

if test "${TCL_THREADS}" = 1; then
    ac_fn_c_check_func "$LINENO" "getpwuid_r" "ac_cv_func_getpwuid_r"
ac_fn_c_check_func "$LINENO" "getpwuid_r" "ac_cv_func_getpwuid_r"
if test "x$ac_cv_func_getpwuid_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 5 args" >&5
$as_echo_n "checking for getpwuid_r with 5 args... " >&6; }
if ${tcl_cv_api_getpwuid_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
7645
7646
7647
7648
7649
7650
7651
7652

7653
7654
7655
7656
7657
7658
7659
7628
7629
7630
7631
7632
7633
7634

7635
7636
7637
7638
7639
7640
7641
7642







-
+








$as_echo "#define HAVE_GETPWUID_R 1" >>confdefs.h

    fi

fi

    ac_fn_c_check_func "$LINENO" "getpwnam_r" "ac_cv_func_getpwnam_r"
ac_fn_c_check_func "$LINENO" "getpwnam_r" "ac_cv_func_getpwnam_r"
if test "x$ac_cv_func_getpwnam_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 5 args" >&5
$as_echo_n "checking for getpwnam_r with 5 args... " >&6; }
if ${tcl_cv_api_getpwnam_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
7741
7742
7743
7744
7745
7746
7747
7748

7749
7750
7751
7752
7753
7754
7755
7724
7725
7726
7727
7728
7729
7730

7731
7732
7733
7734
7735
7736
7737
7738







-
+








$as_echo "#define HAVE_GETPWNAM_R 1" >>confdefs.h

    fi

fi

    ac_fn_c_check_func "$LINENO" "getgrgid_r" "ac_cv_func_getgrgid_r"
ac_fn_c_check_func "$LINENO" "getgrgid_r" "ac_cv_func_getgrgid_r"
if test "x$ac_cv_func_getgrgid_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 5 args" >&5
$as_echo_n "checking for getgrgid_r with 5 args... " >&6; }
if ${tcl_cv_api_getgrgid_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
7837
7838
7839
7840
7841
7842
7843
7844

7845
7846
7847
7848
7849
7850
7851
7820
7821
7822
7823
7824
7825
7826

7827
7828
7829
7830
7831
7832
7833
7834







-
+








$as_echo "#define HAVE_GETGRGID_R 1" >>confdefs.h

    fi

fi

    ac_fn_c_check_func "$LINENO" "getgrnam_r" "ac_cv_func_getgrnam_r"
ac_fn_c_check_func "$LINENO" "getgrnam_r" "ac_cv_func_getgrnam_r"
if test "x$ac_cv_func_getgrnam_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 5 args" >&5
$as_echo_n "checking for getgrnam_r with 5 args... " >&6; }
if ${tcl_cv_api_getgrnam_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
7933
7934
7935
7936
7937
7938
7939
7940
7941
7942
7943
7944





7945
7946
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956





7957
7958
7959
7960
7961
7962
7963
7964
7965


7966
7967
7968
7969
7970
7971
7972
7916
7917
7918
7919
7920
7921
7922





7923
7924
7925
7926
7927
7928
7929
7930
7931
7932
7933
7934





7935
7936
7937
7938
7939
7940
7941
7942
7943
7944
7945
7946


7947
7948
7949
7950
7951
7952
7953
7954
7955







-
-
-
-
-
+
+
+
+
+







-
-
-
-
-
+
+
+
+
+







-
-
+
+








$as_echo "#define HAVE_GETGRNAM_R 1" >>confdefs.h

    fi

fi

    if test "`uname -s`" = "Darwin" && \
	    test "`uname -r | awk -F. '{print $1}'`" -gt 5; then
	# Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
	# are actually MT-safe as they always return pointers
	# from TSD instead of static storage.
if test "`uname -s`" = "Darwin" && \
	test "`uname -r | awk -F. '{print $1}'`" -gt 5; then
    # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
    # are actually MT-safe as they always return pointers
    # from TSD instead of static storage.

$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h


    elif test "`uname -s`" = "HP-UX" && \
	      test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
        # Starting with HPUX 11.00 (we believe), gethostbyX
        # are actually MT-safe as they always return pointers
	# from TSD instead of static storage.
elif test "`uname -s`" = "HP-UX" && \
	test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
    # Starting with HPUX 11.00 (we believe), gethostbyX
    # are actually MT-safe as they always return pointers
    # from TSD instead of static storage.

$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h


    else
	ac_fn_c_check_func "$LINENO" "gethostbyname_r" "ac_cv_func_gethostbyname_r"
else
    ac_fn_c_check_func "$LINENO" "gethostbyname_r" "ac_cv_func_gethostbyname_r"
if test "x$ac_cv_func_gethostbyname_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 6 args" >&5
$as_echo_n "checking for gethostbyname_r with 6 args... " >&6; }
if ${tcl_cv_api_gethostbyname_r_6+:} false; then :
  $as_echo_n "(cached) " >&6
else
8095
8096
8097
8098
8099
8100
8101
8102

8103
8104
8105
8106
8107
8108
8109
8078
8079
8080
8081
8082
8083
8084

8085
8086
8087
8088
8089
8090
8091
8092







-
+








$as_echo "#define HAVE_GETHOSTBYNAME_R 1" >>confdefs.h

    fi

fi

	ac_fn_c_check_func "$LINENO" "gethostbyaddr_r" "ac_cv_func_gethostbyaddr_r"
    ac_fn_c_check_func "$LINENO" "gethostbyaddr_r" "ac_cv_func_gethostbyaddr_r"
if test "x$ac_cv_func_gethostbyaddr_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 7 args" >&5
$as_echo_n "checking for gethostbyaddr_r with 7 args... " >&6; }
if ${tcl_cv_api_gethostbyaddr_r_7+:} false; then :
  $as_echo_n "(cached) " >&6
else
8197
8198
8199
8200
8201
8202
8203
8204
8205
8206
8207
8208
8209
8210
8211
8180
8181
8182
8183
8184
8185
8186

8187
8188
8189
8190
8191
8192
8193







-








$as_echo "#define HAVE_GETHOSTBYADDR_R 1" >>confdefs.h

    fi

fi

    fi
fi

#---------------------------------------------------------------------------
#	Check for serial port interface.
#
#	termios.h is present on all POSIX systems.
#	sys/ioctl.h is almost always present, though what it contains
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
8399
8400
8401
8402
8403
8404
8405
8406
8371
8372
8373
8374
8375
8376
8377




8378
8379
8380
8381
8382
8383
8384







-
-
-
-







fi;;
  xDarwin)
	# Assume that we've got CoreFoundation present (checked elsewhere because
	# of wider impact).
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: OSX" >&5
$as_echo "OSX" >&6; };;
  *)
	cat >>confdefs.h <<_ACEOF
#define NOTIFIER_SELECT 1
_ACEOF

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
$as_echo "none" >&6; };;
esac

#------------------------------------------------------------------------------
#       Find out all about time handling differences.
#------------------------------------------------------------------------------
8853
8854
8855
8856
8857
8858
8859
8860
8861
8862
8863
8864
8865
8866
8867
8868
8869
8870
8871
8872
8873
8874
8875
8876
8877
8878
8879
8880
8881
8882
8883
8884
8885
8886
8887
8888
8889
8890
8891
8892
8893
8894
8895
8896
8897
8898
8899
8900
8901
8902
8903
8904
8905
8906
8907
8908
8909
8910
8911
8912
8913
8914
8915
8916
8917
8918
8919
8920
8921
8922
8923
8924
8925
8926
8927
8928
8929
8930
8931
8932
8933
8934
8935
8936
8937
8938
8939
8940
8941
8942
8943
8944
8945
8946
8947
8948
8949
8950
8951
8952
8953
8954
8955
8956
8957
8958
8959
8960
8961
8962
8963
8964
8965
8966
8967
8968
8969
8970
8971
8972
8973
8974
8975
8976
8977
8978
8979
8980
8981
8982
8983
8984
8985
8986
8987
8988
8989
8990
8991
8992
8993
8994
8995
8996
8997
8998
8999
9000
8831
8832
8833
8834
8835
8836
8837






































































































































8838
8839
8840
8841
8842
8843
8844







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	case " $LIBOBJS " in
  *" strtoul.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS strtoul.$ac_objext"
 ;;
esac

	USE_COMPAT=1
    fi


#--------------------------------------------------------------------
#	Check for the strtod function.  This is tricky because in some
#	versions of Linux strtod mis-parses strings starting with "+".
#--------------------------------------------------------------------


    ac_fn_c_check_func "$LINENO" "strtod" "ac_cv_func_strtod"
if test "x$ac_cv_func_strtod" = xyes; then :
  tcl_ok=1
else
  tcl_ok=0
fi

    if test "$tcl_ok" = 1; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strtod implementation" >&5
$as_echo_n "checking proper strtod implementation... " >&6; }
if ${tcl_cv_strtod_unbroken+:} false; then :
  $as_echo_n "(cached) " >&6
else
  if test "$cross_compiling" = yes; then :
  tcl_cv_strtod_unbroken=unknown
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
int main() {
    extern double strtod();
    char *term, *string = " +69";
    exit(strtod(string,&term) != 69 || term != string+4);
}
_ACEOF
if ac_fn_c_try_run "$LINENO"; then :
  tcl_cv_strtod_unbroken=ok
else
  tcl_cv_strtod_unbroken=broken
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
  conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtod_unbroken" >&5
$as_echo "$tcl_cv_strtod_unbroken" >&6; }
	if test "$tcl_cv_strtod_unbroken" = "ok"; then
	    tcl_ok=1
	else
	    tcl_ok=0
	fi
    fi
    if test "$tcl_ok" = 0; then
	case " $LIBOBJS " in
  *" strtod.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS strtod.$ac_objext"
 ;;
esac

	USE_COMPAT=1
    fi


#--------------------------------------------------------------------
#	Under Solaris 2.4, strtod returns the wrong value for the
#	terminating character under some conditions.  Check for this
#	and if the problem exists use a substitute procedure
#	"fixstrtod" that corrects the error.
#--------------------------------------------------------------------


    ac_fn_c_check_func "$LINENO" "strtod" "ac_cv_func_strtod"
if test "x$ac_cv_func_strtod" = xyes; then :
  tcl_strtod=1
else
  tcl_strtod=0
fi

    if test "$tcl_strtod" = 1; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Solaris2.4/Tru64 strtod bugs" >&5
$as_echo_n "checking for Solaris2.4/Tru64 strtod bugs... " >&6; }
if ${tcl_cv_strtod_buggy+:} false; then :
  $as_echo_n "(cached) " >&6
else

	    if test "$cross_compiling" = yes; then :
  tcl_cv_strtod_buggy=buggy
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

		extern double strtod();
		int main() {
		    char *infString="Inf", *nanString="NaN", *spaceString=" ";
		    char *term;
		    double value;
		    value = strtod(infString, &term);
		    if ((term != infString) && (term[-1] == 0)) {
			exit(1);
		    }
		    value = strtod(nanString, &term);
		    if ((term != nanString) && (term[-1] == 0)) {
			exit(1);
		    }
		    value = strtod(spaceString, &term);
		    if (term == (spaceString+1)) {
			exit(1);
		    }
		    exit(0);
		}
_ACEOF
if ac_fn_c_try_run "$LINENO"; then :
  tcl_cv_strtod_buggy=ok
else
  tcl_cv_strtod_buggy=buggy
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
  conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtod_buggy" >&5
$as_echo "$tcl_cv_strtod_buggy" >&6; }
	if test "$tcl_cv_strtod_buggy" = buggy; then
	    case " $LIBOBJS " in
  *" fixstrtod.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext"
 ;;
esac

	    USE_COMPAT=1

$as_echo "#define strtod fixstrtod" >>confdefs.h

	fi
    fi


#--------------------------------------------------------------------
#	Check for various typedefs and provide substitutes if
#	they don't exist.
#--------------------------------------------------------------------
10145
10146
10147
10148
10149
10150
10151





































































































































































10152
10153
10154
10155
10156
10157
10158
9989
9990
9991
9992
9993
9994
9995
9996
9997
9998
9999
10000
10001
10002
10003
10004
10005
10006
10007
10008
10009
10010
10011
10012
10013
10014
10015
10016
10017
10018
10019
10020
10021
10022
10023
10024
10025
10026
10027
10028
10029
10030
10031
10032
10033
10034
10035
10036
10037
10038
10039
10040
10041
10042
10043
10044
10045
10046
10047
10048
10049
10050
10051
10052
10053
10054
10055
10056
10057
10058
10059
10060
10061
10062
10063
10064
10065
10066
10067
10068
10069
10070
10071
10072
10073
10074
10075
10076
10077
10078
10079
10080
10081
10082
10083
10084
10085
10086
10087
10088
10089
10090
10091
10092
10093
10094
10095
10096
10097
10098
10099
10100
10101
10102
10103
10104
10105
10106
10107
10108
10109
10110
10111
10112
10113
10114
10115
10116
10117
10118
10119
10120
10121
10122
10123
10124
10125
10126
10127
10128
10129
10130
10131
10132
10133
10134
10135
10136
10137
10138
10139
10140
10141
10142
10143
10144
10145
10146
10147
10148
10149
10150
10151
10152
10153
10154
10155
10156
10157
10158
10159
10160
10161
10162
10163
10164
10165
10166
10167







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    AR='/usr/ccs/bin/ar'
	    RANLIB='/usr/ccs/bin/ranlib'
	fi
    fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5
$as_echo "$tcl_ok" >&6; }

#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
# Check whether --enable-zipfs was given.
if test "${enable_zipfs+set}" = set; then :
  enableval=$enable_zipfs; tcl_ok=$enableval
else
  tcl_ok=yes
fi

if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    # Put a plausible default for CC_FOR_BUILD in Makefile.
    if test -z "$CC_FOR_BUILD"; then
      if test "x$cross_compiling" = "xno"; then
        CC_FOR_BUILD='$(CC)'
      else
        { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
$as_echo_n "checking for gcc... " >&6; }
        if ${ac_cv_path_cc+:} false; then :
  $as_echo_n "(cached) " >&6
else

            search_path=`echo ${PATH} | sed -e 's/:/ /g'`
            for dir in $search_path ; do
                for j in `ls -r $dir/gcc 2> /dev/null` \
                        `ls -r $dir/gcc 2> /dev/null` ; do
                    if test x"$ac_cv_path_cc" = x ; then
                        if test -f "$j" ; then
                            ac_cv_path_cc=$j
                            break
                        fi
                    fi
                done
            done

fi

      fi
    fi

    # Also set EXEEXT_FOR_BUILD.
    if test "x$cross_compiling" = "xno"; then
      EXEEXT_FOR_BUILD='$(EXEEXT)'
      OBJEXT_FOR_BUILD='$(OBJEXT)'
    else
      OBJEXT_FOR_BUILD='.no'
      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
$as_echo_n "checking for build system executable suffix... " >&6; }
if ${bfd_cv_build_exeext+:} false; then :
  $as_echo_n "(cached) " >&6
else
  rm -f conftest*
         echo 'int main () { return 0; }' > conftest.c
         bfd_cv_build_exeext=
         ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
         for file in conftest.*; do
           case $file in
           *.c | *.o | *.obj | *.ilk | *.pdb) ;;
           *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
           esac
         done
         rm -f conftest*
         test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
$as_echo "$bfd_cv_build_exeext" >&6; }
      EXEEXT_FOR_BUILD=""
      test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
    fi

    #
    # Find a native zip implementation
    #

    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
$as_echo_n "checking for zip... " >&6; }
    if ${ac_cv_path_zip+:} false; then :
  $as_echo_n "(cached) " >&6
else

    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done

fi

    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip "
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
$as_echo "$ZIP_PROG" >&6; }
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="."
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
$as_echo "Found INFO Zip in environment" >&6; }
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="."
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH. Building minizip" >&5
$as_echo "No zip found on PATH. Building minizip" >&6; }
    fi





	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
$as_echo_n "checking for building with zipfs... " >&6; }
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;

$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h

       INSTALL_LIBRARIES=install-libraries-zipfs-static
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
     else

$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
    fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi






#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the cpuid instruction is usable" >&5
$as_echo_n "checking whether the cpuid instruction is usable... " >&6; }
10371
10372
10373
10374
10375
10376
10377

10378
10379
10380
10381
10382
10383
10384
10380
10381
10382
10383
10384
10385
10386
10387
10388
10389
10390
10391
10392
10393
10394







+







eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""

#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
#------------------------------------------------------------------------

TCL_SHARED_BUILD=${SHARED_BUILD}








10962
10963
10964
10965
10966
10967
10968
10969

10970
10971
10972
10973
10974
10975
10976
10972
10973
10974
10975
10976
10977
10978

10979
10980
10981
10982
10983
10984
10985
10986







-
+







test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by tcl $as_me 9.0, which was
This file was extended by tcl $as_me 8.7, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@
11019
11020
11021
11022
11023
11024
11025
11026

11027
11028
11029
11030
11031
11032
11033
11029
11030
11031
11032
11033
11034
11035

11036
11037
11038
11039
11040
11041
11042
11043







-
+








Report bugs to the package provider."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
tcl config.status 9.0
tcl config.status 8.7
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

Changes to unix/configure.ac.

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28




29
30
31
32
33
34
35
1
2
3
4
5

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24




25
26
27
28
29
30
31
32
33
34
35





-
+


















-
-
-
-
+
+
+
+







#! /bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.

AC_INIT([tcl],[9.0])
AC_INIT([tcl],[8.7])
AC_PREREQ(2.69)

dnl This is only used when included from macosx/configure.ac
m4_ifdef([SC_USE_CONFIG_HEADERS], [
    AC_CONFIG_HEADERS([tclConfig.h:../unix/tclConfig.h.in])
    AC_CONFIG_COMMANDS_PRE([DEFS="-DHAVE_TCL_CONFIG_H  -imacros tclConfig.h"])
    AH_TOP([
    #ifndef _TCLCONFIG
    #define _TCLCONFIG])
    AH_BOTTOM([
    /* Undef unused package specific autoheader defines so that we can
     * include both tclConfig.h and tkConfig.h at the same time: */
    /* override */ #undef PACKAGE_NAME
    /* override */ #undef PACKAGE_STRING
    /* override */ #undef PACKAGE_TARNAME
    #endif /* _TCLCONFIG */])
])

TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="a0"
TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
TCL_PATCH_LEVEL="a2"
VERSION=${TCL_VERSION}

EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}

#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
81
82
83
84
85
86
87

88
89
90
91
92
93
94
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95







+







# the AC_PROG_CC macro from adding "-g -O2".
if test "${CFLAGS+set}" != "set" ; then
    CFLAGS=""
fi

AC_PROG_CC
AC_C_INLINE


#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files.  Special notes:
#	- stdlib.h doesn't define strtol, strtoul, or
#	  strtod insome versions of SunOS
#	- some versions of string.h don't declare procedures such
#	  as strstr
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
116
117
118
119
120
121
122






123
124
125
126
127
128
129







-
-
-
-
-
-







	AC_TRY_COMPILE(,, tcl_cv_cc_pipe=yes, tcl_cv_cc_pipe=no)
	CFLAGS=$hold_cflags])
    if test $tcl_cv_cc_pipe = yes; then
	CFLAGS="$CFLAGS -pipe"
    fi
fi

#------------------------------------------------------------------------
# Threads support
#------------------------------------------------------------------------

SC_ENABLE_THREADS

#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------

SC_TCL_CFG_ENCODING

#--------------------------------------------------------------------
211
212
213
214
215
216
217
218

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245













246
247
248
249
250
251
252
253
254
255









256
257
258
259



260
261
262
263
264
265
266
267
206
207
208
209
210
211
212

213
214
215
216
217
218
219
220
221
222
223
224
225
226














227
228
229
230
231
232
233
234
235
236
237
238
239
240









241
242
243
244
245
246
247
248
249
250



251
252
253

254
255
256
257
258
259
260







-
+













-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
-








AC_REPLACE_FUNCS(mkstemp opendir strtol waitpid)
AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR, 1, [Do we have strerror()])])
AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD, 1, [Do we have getwd()])])
AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3, 1, [Do we have wait3()])])
AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME, 1, [Do we have uname()])])

if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \
if test "`uname -s`" = "Darwin" && \
	test "`uname -r | awk -F. '{print [$]1}'`" -lt 7; then
    # prior to Darwin 7, realpath is not threadsafe, so don't
    # use it when threads are enabled, c.f. bug # 711232
    ac_cv_func_realpath=no
fi
AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH, 1, [Do we have realpath()])])

SC_TCL_IPV6

#--------------------------------------------------------------------
#	Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------

if test "${TCL_THREADS}" = 1; then
    SC_TCL_GETPWUID_R
    SC_TCL_GETPWNAM_R
    SC_TCL_GETGRGID_R
    SC_TCL_GETGRNAM_R
    if test "`uname -s`" = "Darwin" && \
	    test "`uname -r | awk -F. '{print [$]1}'`" -gt 5; then
	# Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
	# are actually MT-safe as they always return pointers
	# from TSD instead of static storage.
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
		[Do we have MT-safe gethostbyname() ?])
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
		[Do we have MT-safe gethostbyaddr() ?])
SC_TCL_GETPWUID_R
SC_TCL_GETPWNAM_R
SC_TCL_GETGRGID_R
SC_TCL_GETGRNAM_R
if test "`uname -s`" = "Darwin" && \
	test "`uname -r | awk -F. '{print [$]1}'`" -gt 5; then
    # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
    # are actually MT-safe as they always return pointers
    # from TSD instead of static storage.
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
	    [Do we have MT-safe gethostbyname() ?])
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
	    [Do we have MT-safe gethostbyaddr() ?])

    elif test "`uname -s`" = "HP-UX" && \
	      test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
        # Starting with HPUX 11.00 (we believe), gethostbyX
        # are actually MT-safe as they always return pointers
	# from TSD instead of static storage.
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
		[Do we have MT-safe gethostbyname() ?])
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
		[Do we have MT-safe gethostbyaddr() ?])
elif test "`uname -s`" = "HP-UX" && \
	test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
    # Starting with HPUX 11.00 (we believe), gethostbyX
    # are actually MT-safe as they always return pointers
    # from TSD instead of static storage.
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
	    [Do we have MT-safe gethostbyname() ?])
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
	    [Do we have MT-safe gethostbyaddr() ?])

    else
	SC_TCL_GETHOSTBYNAME_R
	SC_TCL_GETHOSTBYADDR_R
else
    SC_TCL_GETHOSTBYNAME_R
    SC_TCL_GETHOSTBYADDR_R
    fi
fi

#---------------------------------------------------------------------------
#	Check for serial port interface.
#
#	termios.h is present on all POSIX systems.
#	sys/ioctl.h is almost always present, though what it contains
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
316
317
318
319
320
321
322

323
324
325
326
327
328
329







-







	AS_IF([test $tcl_kqueue_headers = xyyy], [
	    AC_DEFINE(NOTIFIER_KQUEUE, [1], [Is kqueue(2) supported?])]);;
  xDarwin)
	# Assume that we've got CoreFoundation present (checked elsewhere because
	# of wider impact).
	AC_MSG_RESULT([OSX]);;
  *)
	AC_DEFINE_UNQUOTED(NOTIFIER_SELECT)
	AC_MSG_RESULT([none]);;
esac

#------------------------------------------------------------------------------
#       Find out all about time handling differences.
#------------------------------------------------------------------------------

384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
376
377
378
379
380
381
382




















383
384
385
386
387
388
389







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








SC_TCL_CHECK_BROKEN_FUNC(strtoul, [
    extern int strtoul();
    char *term, *string = "0";
    exit(strtoul(string,&term,0) != 0 || term != string+1);
])

#--------------------------------------------------------------------
#	Check for the strtod function.  This is tricky because in some
#	versions of Linux strtod mis-parses strings starting with "+".
#--------------------------------------------------------------------

SC_TCL_CHECK_BROKEN_FUNC(strtod, [
    extern double strtod();
    char *term, *string = " +69";
    exit(strtod(string,&term) != 69 || term != string+4);
])

#--------------------------------------------------------------------
#	Under Solaris 2.4, strtod returns the wrong value for the
#	terminating character under some conditions.  Check for this
#	and if the problem exists use a substitute procedure
#	"fixstrtod" that corrects the error.
#--------------------------------------------------------------------

SC_BUGGY_STRTOD

#--------------------------------------------------------------------
#	Check for various typedefs and provide substitutes if
#	they don't exist.
#--------------------------------------------------------------------

AC_TYPE_MODE_T
AC_TYPE_PID_T
785
786
787
788
789
790
791














































792
793
794
795
796
797
798
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    # tclDTrace.o and the combined object file above.
	    AR='/usr/ccs/bin/ar'
	    RANLIB='/usr/ccs/bin/ranlib'
	fi
    fi
fi
AC_MSG_RESULT([$tcl_ok])

#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
AC_ARG_ENABLE(zipfs,
    AC_HELP_STRING([--enable-zipfs],
	[build with Zipfs support (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    AX_CC_FOR_BUILD
    #
    # Find a native zip implementation
    #
    SC_ZIPFS_SUPPORT
	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
AC_MSG_CHECKING([for building with zipfs])
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;
       AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?])
       INSTALL_LIBRARIES=install-libraries-zipfs-static
       AC_MSG_RESULT([yes])
     else
       AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       AC_MSG_RESULT([yes])
    fi
else
AC_MSG_RESULT([no])
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi
AC_SUBST(ZIPFS_BUILD)
AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(INSTALL_LIBRARIES)
AC_SUBST(INSTALL_MSGS)


#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------

AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [
    AC_TRY_LINK(, [
956
957
958
959
960
961
962

963
964
965
966
967
968
969
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988







+







AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_YEAR)
AC_SUBST(PKG_CFG_ARGS)

AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_FILE)
AC_SUBST(TCL_STUB_LIB_FLAG)
AC_SUBST(TCL_STUB_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_PATH)

Changes to unix/installManPage.

56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75





























76
77
78
79
80
81
82
83
56
57
58
59
60
61
62













63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

92
93
94
95
96
97
98







-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-







# A sed script to parse the alternative names out of a man page.
#
# Backslashes are trippled in the sed script, because it is in
# backticks which doesn't pass backslashes literally.
#
Names=`sed -n '
#                               Look for a line that starts with .SH NAME
    /^\.SH NAME/{
#                               Read next line
	n
#                               Remove all commas ...
	s/,//g
#                               ... and backslash-escaped spaces.
	s/\\\ //g
#                               Delete from \- to the end of line
	s/ \\\-.*//
#                               Convert all non-space non-alphanum sequences
#                               to single underscores.
	s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g
#                               print the result and exit
    /^\.SH NAME/,/^\./{


	/^\./!{

	    # Remove all commas...
	    s/,//g

	    # ... and backslash-escaped spaces.
	    s/\\\ //g

	    /\\\-.*/{
		# Delete from \- to the end of line
		s/ \\\-.*//
		h
		s/.*/./
		x
	    }

	    # Convert all non-space non-alphanum sequences
	    # to single underscores.
	    s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g
	    p
	    g
	    /^\./{
		q
	    }
    }

	p;q
    }' $ManPage`

if test -z "$Names" ; then
    echo "warning: no target names found in $ManPage"
fi

########################################################################

Changes to unix/tcl.m4.

87
88
89
90
91
92
93
94
95

96
97
98


99
100
101
102
103
104
105
87
88
89
90
91
92
93

94
95
96
97
98
99
100
101
102
103
104
105
106
107







-

+



+
+







	    fi

	    # check in a few common install locations
	    if test x"${ac_cv_c_tclconfig}" = x ; then
		for i in `ls -d ${libdir} 2>/dev/null` \
			`ls -d ${exec_prefix}/lib 2>/dev/null` \
			`ls -d ${prefix}/lib 2>/dev/null` \
			`ls -d /usr/contrib/lib 2>/dev/null` \
			`ls -d /usr/local/lib 2>/dev/null` \
			`ls -d /usr/contrib/lib 2>/dev/null` \
			`ls -d /usr/pkg/lib 2>/dev/null` \
			`ls -d /usr/lib 2>/dev/null` \
			`ls -d /usr/lib64 2>/dev/null` \
			`ls -d /usr/local/lib/tcl8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl8.7 2>/dev/null` \
			; do
		    if test -f "$i/tclConfig.sh" ; then
			ac_cv_c_tclconfig="`(cd $i; pwd)`"
			break
		    fi
		done
	    fi
220
221
222
223
224
225
226

227
228


229
230
231
232
233
234
235
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240







+


+
+







	    # check in a few common install locations
	    if test x"${ac_cv_c_tkconfig}" = x ; then
		for i in `ls -d ${libdir} 2>/dev/null` \
			`ls -d ${exec_prefix}/lib 2>/dev/null` \
			`ls -d ${prefix}/lib 2>/dev/null` \
			`ls -d /usr/local/lib 2>/dev/null` \
			`ls -d /usr/contrib/lib 2>/dev/null` \
			`ls -d /usr/pkg/lib 2>/dev/null` \
			`ls -d /usr/lib 2>/dev/null` \
			`ls -d /usr/lib64 2>/dev/null` \
			`ls -d /usr/local/lib/tk8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tk8.7 2>/dev/null` \
			; do
		    if test -f "$i/tkConfig.sh" ; then
			ac_cv_c_tkconfig="`(cd $i; pwd)`"
			break
		    fi
		done
	    fi
538
539
540
541
542
543
544

545
546
547
548
549
550
551
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557







+







	AC_MSG_RESULT([shared])
	SHARED_BUILD=1
    else
	AC_MSG_RESULT([static])
	SHARED_BUILD=0
	AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
    fi
    AC_SUBST(SHARED_BUILD)
])

#------------------------------------------------------------------------
# SC_ENABLE_FRAMEWORK --
#
#	Allows the building of shared libraries into frameworks
#
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
594
595
596
597
598
599
600











































































































601
602
603
604
605
606
607







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







		AC_MSG_RESULT([static library])
	    fi
	    FRAMEWORK_BUILD=0
	fi
    fi
])

#------------------------------------------------------------------------
# SC_ENABLE_THREADS --
#
#	Specify if thread support should be enabled
#
# Arguments:
#	none
#
# Results:
#
#	Adds the following arguments to configure:
#		--enable-threads
#
#	Sets the following vars:
#		THREADS_LIBS	Thread library(s)
#
#	Defines the following vars:
#		TCL_THREADS
#		_REENTRANT
#		_THREAD_SAFE
#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_THREADS], [
    AC_ARG_ENABLE(threads,
	AC_HELP_STRING([--enable-threads],
	    [build with threads (default: on)]),
	[tcl_ok=$enableval], [tcl_ok=yes])

    if test "${TCL_THREADS}" = 1; then
	tcl_threaded_core=1;
    fi

    if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then
	TCL_THREADS=1
	# USE_THREAD_ALLOC tells us to try the special thread-based
	# allocator that significantly reduces lock contention
	AC_DEFINE(USE_THREAD_ALLOC, 1,
	    [Do we want to use the threaded memory allocator?])
	AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?])
	if test "`uname -s`" = "SunOS" ; then
	    AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1,
		    [Do we really want to follow the standard? Yes we do!])
	fi
	AC_DEFINE(_THREAD_SAFE, 1, [Do we want the thread-safe OS API?])
	AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
	if test "$tcl_ok" = "no"; then
	    # Check a little harder for __pthread_mutex_init in the same
	    # library, as some systems hide it there until pthread.h is
	    # defined.  We could alternatively do an AC_TRY_COMPILE with
	    # pthread.h, but that will work with libpthread really doesn't
	    # exist, like AIX 4.2.  [Bug: 4359]
	    AC_CHECK_LIB(pthread, __pthread_mutex_init,
		tcl_ok=yes, tcl_ok=no)
	fi

	if test "$tcl_ok" = "yes"; then
	    # The space is needed
	    THREADS_LIBS=" -lpthread"
	else
	    AC_CHECK_LIB(pthreads, pthread_mutex_init,
		tcl_ok=yes, tcl_ok=no)
	    if test "$tcl_ok" = "yes"; then
		# The space is needed
		THREADS_LIBS=" -lpthreads"
	    else
		AC_CHECK_LIB(c, pthread_mutex_init,
		    tcl_ok=yes, tcl_ok=no)
		if test "$tcl_ok" = "no"; then
		    AC_CHECK_LIB(c_r, pthread_mutex_init,
			tcl_ok=yes, tcl_ok=no)
		    if test "$tcl_ok" = "yes"; then
			# The space is needed
			THREADS_LIBS=" -pthread"
		    else
			TCL_THREADS=0
			AC_MSG_WARN([Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...])
		    fi
		fi
	    fi
	fi

	# Does the pthread-implementation provide
	# 'pthread_attr_setstacksize' ?

	ac_saved_libs=$LIBS
	LIBS="$LIBS $THREADS_LIBS"
	AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
	LIBS=$ac_saved_libs
    else
	TCL_THREADS=0
    fi
    # Do checking message here to not mess up interleaved configure output
    AC_MSG_CHECKING([for building with threads])
    if test "${TCL_THREADS}" = 1; then
	AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?])
	if test "${tcl_threaded_core}" = 1; then
	    AC_MSG_RESULT([yes (threaded core)])
	else
	    AC_MSG_RESULT([yes])
	fi
    else
	AC_MSG_RESULT([no])
    fi

    AC_SUBST(TCL_THREADS)
])

#------------------------------------------------------------------------
# SC_ENABLE_SYMBOLS --
#
#	Specify if debugging symbols should be used.
#	Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging
#	can also be enabled.
#
1083
1084
1085
1086
1087
1088
1089
1090

1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104

1105
1106
1107
1108
1109
1110
1111
982
983
984
985
986
987
988

989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002

1003
1004
1005
1006
1007
1008
1009
1010







-
+













-
+







    UNSHARED_LIB_SUFFIX=""
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    AS_IF([test "$GCC" = yes], [
	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement"
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith"
    ], [
	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""
    ])
    AC_CHECK_TOOL(AR, ar)
    STLIB_LD='${AR} cr'
    LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
    PLAT_OBJS=""
    PLAT_SRCS=""
    LDAIX_SRC=""
    AS_IF([test "x${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"])
    case $system in
	AIX-*)
	    AS_IF([test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"], [
	    AS_IF([test "$GCC" != "yes"], [
		# AIX requires the _r compiler when gcc isn't being used
		case "${CC}" in
		    *_r|*_r\ *)
			# ok ...
			;;
		    *)
			# Make sure only first arg gets _r
1192
1193
1194
1195
1196
1197
1198
1199

1200
1201
1202
1203
1204
1205
1206
1091
1092
1093
1094
1095
1096
1097

1098
1099
1100
1101
1102
1103
1104
1105







-
+







	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*|MINGW32*)
	CYGWIN_*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o"
	    PLAT_OBJS='${CYGWIN_OBJS}'
	    PLAT_SRCS='${CYGWIN_SRCS}'
	    DL_LIBS="-ldl"
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1117
1118
1119
1120
1121
1122
1123



1124
1125
1126
1127
1128
1129
1130







-
-
-







		], [],
		ac_cv_cygwin=no,
		ac_cv_cygwin=yes)
	    )
	    if test "$ac_cv_cygwin" = "no"; then
		AC_MSG_ERROR([${CC} is not a cygwin compiler.])
	    fi
	    if test "x${TCL_THREADS}" = "x0"; then
		AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads])
	    fi
	    do64bit_ok=yes
	    if test "x${SHARED_BUILD}" = "x1"; then
		echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
		# The eval makes quoting arguments work.
		if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
		then :
		else
1246
1247
1248
1249
1250
1251
1252
1253

1254
1255
1256
1257
1258
1259
1260
1142
1143
1144
1145
1146
1147
1148

1149
1150
1151
1152
1153
1154
1155
1156







-
+







	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	Haiku*)
	    LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_SUFFIX=".so"
	    SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'
	    SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-lroot"
	    AC_CHECK_LIB(network, inet_ntoa, [LIBS="$LIBS -lnetwork"])
	    ;;
	HP-UX-*.11.*)
	    # Use updated header definitions where possible
	    AC_DEFINE(_XOPEN_SOURCE_EXTENDED, 1, [Do we want to use the XOPEN network library?])
1390
1391
1392
1393
1394
1395
1396
1397

1398
1399
1400
1401
1402
1403
1404
1286
1287
1288
1289
1290
1291
1292

1293
1294
1295
1296
1297
1298
1299
1300







-
+








	    CFLAGS_OPTIMIZE="-O2"
	    # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings
	    # when you inline the string and math operations.  Turn this off to
	    # get rid of the warnings.
	    #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"

	    SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'
	    SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"])
1440
1441
1442
1443
1444
1445
1446
1447

1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461




1462
1463
1464
1465
1466
1467
1468
1469
1470

1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482




1483
1484
1485

1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501




1502
1503
1504
1505
1506
1507
1508
1336
1337
1338
1339
1340
1341
1342

1343
1344
1345
1346
1347
1348
1349
1350
1351
1352





1353
1354
1355
1356

1357
1358
1359
1360
1361
1362
1363

1364
1365
1366
1367
1368
1369
1370
1371





1372
1373
1374
1375

1376

1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388





1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399







-
+









-
-
-
-
-
+
+
+
+
-







-
+







-
-
-
-
-
+
+
+
+
-

-
+











-
-
-
-
-
+
+
+
+







	    alpha|sparc64)
		SHLIB_CFLAGS="-fPIC"
		;;
	    *)
		SHLIB_CFLAGS="-fpic"
		;;
	    esac
	    SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
	    SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared'
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
	    LDFLAGS="-Wl,-export-dynamic"
	    CFLAGS_OPTIMIZE="-O2"
	    AS_IF([test "${TCL_THREADS}" = "1"], [
		# On OpenBSD:	Compile with -pthread
		#		Don't link with -lpthread
		LIBS=`echo $LIBS | sed s/-lpthread//`
		CFLAGS="$CFLAGS -pthread"
	    # On OpenBSD:	Compile with -pthread
	    #		Don't link with -lpthread
	    LIBS=`echo $LIBS | sed s/-lpthread//`
	    CFLAGS="$CFLAGS -pthread"
	    ])
	    # OpenBSD doesn't do version numbers with dots.
	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
	    TCL_LIB_VERSIONS_OK=nodots
	    ;;
	NetBSD-*)
	    # NetBSD has ELF and can use 'cc -shared' to build shared libs
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
	    SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared'
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    AS_IF([test "${TCL_THREADS}" = "1"], [
		# The -pthread needs to go in the CFLAGS, not LIBS
		LIBS=`echo $LIBS | sed s/-pthread//`
		CFLAGS="$CFLAGS -pthread"
	    	LDFLAGS="$LDFLAGS -pthread"
	    # The -pthread needs to go in the CFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS -pthread"
	    LDFLAGS="$LDFLAGS -pthread"
	    ])
	    ;;
	FreeBSD-*)
	DragonFly-*|FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    LDFLAGS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    AS_IF([test "${TCL_THREADS}" = "1"], [
		# The -pthread needs to go in the LDFLAGS, not LIBS
		LIBS=`echo $LIBS | sed s/-pthread//`
		CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
		LDFLAGS="$LDFLAGS $PTHREAD_LIBS"])
	    # The -pthread needs to go in the LDFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
	    LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
	    case $system in
	    FreeBSD-3.*)
		# Version numbers are dot-stripped by system policy.
		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
		TCL_LIB_VERSIONS_OK=nodots
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681








1682
1683
1684
1685
1686
1687
1688
1689
1557
1558
1559
1560
1561
1562
1563









1564
1565
1566
1567
1568
1569
1570
1571

1572
1573
1574
1575
1576
1577
1578







-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-







	    DL_LIBS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'])
	    AS_IF([test "$GCC" = yes], [CFLAGS="$CFLAGS -mieee"], [
		CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"])
	    # see pthread_intro(3) for pthread support on osf1, k.furukawa
	    AS_IF([test "${TCL_THREADS}" = 1], [
		CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
		CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
		LIBS=`echo $LIBS | sed s/-lpthreads//`
		AS_IF([test "$GCC" = yes], [
		    LIBS="$LIBS -lpthread -lmach -lexc"
		], [
		    CFLAGS="$CFLAGS -pthread"
		    LDFLAGS="$LDFLAGS -pthread"
	    CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
	    CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
	    LIBS=`echo $LIBS | sed s/-lpthreads//`
	    AS_IF([test "$GCC" = yes], [
		LIBS="$LIBS -lpthread -lmach -lexc"
	    ], [
		CFLAGS="$CFLAGS -pthread"
		LDFLAGS="$LDFLAGS -pthread"
		])
	    ])
	    ;;
	QNX-6*)
	    # QNX RTP
	    # This may work for all QNX, but it was only reported for v6.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="ld -Bshareable -x"
1908
1909
1910
1911
1912
1913
1914
1915

1916
1917

1918
1919
1920
1921
1922
1923
1924
1797
1798
1799
1800
1801
1802
1803

1804
1805

1806
1807
1808
1809
1810
1811
1812
1813







-
+

-
+







    # libraries to the right flags for gcc, instead of those for the
    # standard manufacturer compiler.

    AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [
	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*|MINGW32_*) ;;
	    CYGWIN_*) ;;
	    IRIX*) ;;
	    NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
	    NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac])

    AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
	AC_DEFINE(MODULE_SCOPE, [extern],
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
1925
1926
1927
1928
1929
1930
1931

1932
1933
1934
1935
1936
1937
1938







-







# Arguments:
#	none
#
# Results:
#
#	Defines some of the following vars:
#		NO_DIRENT_H
#		NO_VALUES_H
#		NO_STDLIB_H
#		NO_STRING_H
#		NO_SYS_WAIT_H
#		NO_DLFCN_H
#		HAVE_SYS_PARAM_H
#
#		HAVE_STRING_H ?
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
1962
1963
1964
1965
1966
1967
1968


1969
1970
1971
1972
1973
1974
1975







-
-







closedir(d);
], tcl_cv_dirent_h=yes, tcl_cv_dirent_h=no)])

    if test $tcl_cv_dirent_h = no; then
	AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?])
    fi

    AC_CHECK_HEADER(float.h, , [AC_DEFINE(NO_FLOAT_H, 1, [Do we have <float.h>?])])
    AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H, 1, [Do we have <values.h>?])])
    AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
    AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
    AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
    AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0)
    if test $tcl_ok = 0; then
	AC_DEFINE(NO_STDLIB_H, 1, [Do we have <stdlib.h>?])
    fi
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356

2357
2358
2359
2360
2361







2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2177
2178
2179
2180
2181
2182
2183
2184





















































2185
2186
2187
2188

2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215


2216
2217
2218

2219
2220
2221
2222
2223
2224
2225








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+





+
+
+
+
+
+
+














-
-



-







		tcl_cv_timezone_time=yes, tcl_cv_timezone_time=no)])
	if test $tcl_cv_timezone_time = yes ; then
	    AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?])
	fi
    fi
])

#--------------------------------------------------------------------
# SC_BUGGY_STRTOD
#
#	Under Solaris 2.4, strtod returns the wrong value for the
#	terminating character under some conditions.  Check for this
#	and if the problem exists use a substitute procedure
#	"fixstrtod" (provided by Tcl) that corrects the error.
#	Also, on Compaq's Tru64 Unix 5.0,
#	strtod(" ") returns 0.0 instead of a failure to convert.
#
# Arguments:
#	none
#
# Results:
#
#	Might defines some of the following vars:
#		strtod (=fixstrtod)
#
#--------------------------------------------------------------------

AC_DEFUN([SC_BUGGY_STRTOD], [
    AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0)
    if test "$tcl_strtod" = 1; then
	AC_CACHE_CHECK([for Solaris2.4/Tru64 strtod bugs], tcl_cv_strtod_buggy,[
	    AC_TRY_RUN([
		extern double strtod();
		int main() {
		    char *infString="Inf", *nanString="NaN", *spaceString=" ";
		    char *term;
		    double value;
		    value = strtod(infString, &term);
		    if ((term != infString) && (term[-1] == 0)) {
			exit(1);
		    }
		    value = strtod(nanString, &term);
		    if ((term != nanString) && (term[-1] == 0)) {
			exit(1);
		    }
		    value = strtod(spaceString, &term);
		    if (term == (spaceString+1)) {
			exit(1);
		    }
		    exit(0);
		}], tcl_cv_strtod_buggy=ok, tcl_cv_strtod_buggy=buggy,
		    tcl_cv_strtod_buggy=buggy)])
	if test "$tcl_cv_strtod_buggy" = buggy; then
	    AC_LIBOBJ([fixstrtod])
	    USE_COMPAT=1
	    AC_DEFINE(strtod, fixstrtod, [Do we want to use the strtod() in compat?])
	fi
    fi
])

#--------------------------------------------------------------------
# SC_TCL_LINK_LIBS
#
#	Search for the libraries needed to link the Tcl shell.
#	Things like the math library (-lm) and socket stuff (-lsocket vs.
#	-lnsl) are dealt with here.
#	-lnsl) or thread library (-lpthread) are dealt with here.
#
# Arguments:
#	None.
#
# Results:
#
#	Sets the following vars:
#		THREADS_LIBS	Thread library(s)
#
#	Defines the following vars:
#		_REENTRANT
#		_THREAD_SAFE
#
#	Might append to the following vars:
#		LIBS
#		MATH_LIBS
#
#	Might define the following vars:
#		HAVE_NET_ERRNO_H
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_LINK_LIBS], [
    #--------------------------------------------------------------------
    # On a few very rare systems, all of the libm.a stuff is
    # already in libc.a.  Set compiler flags accordingly.
    # Also, Linux requires the "ieee" library for math to work
    # right (and it must appear before "-lm").
    #--------------------------------------------------------------------

    AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
    AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])

    #--------------------------------------------------------------------
    # Interactive UNIX requires -linet instead of -lsocket, plus it
    # needs net/errno.h to define the socket-related error codes.
    #--------------------------------------------------------------------

    AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"])
2416
2417
2418
2419
2420
2421
2422

















































2423
2424
2425
2426
2427
2428
2429
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    if test "$tcl_checkBoth" = 1; then
	tk_oldLibs=$LIBS
	LIBS="$LIBS -lsocket -lnsl"
	AC_CHECK_FUNC(accept, tcl_checkNsl=0, [LIBS=$tk_oldLibs])
    fi
    AC_CHECK_FUNC(gethostbyname, , [AC_CHECK_LIB(nsl, gethostbyname,
	    [LIBS="$LIBS -lnsl"])])

    AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?])
    AC_DEFINE(_THREAD_SAFE, 1, [Do we want the thread-safe OS API?])
    AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
    if test "$tcl_ok" = "no"; then
	# Check a little harder for __pthread_mutex_init in the same
	# library, as some systems hide it there until pthread.h is
	# defined.  We could alternatively do an AC_TRY_COMPILE with
	# pthread.h, but that will work with libpthread really doesn't
	# exist, like AIX 4.2.  [Bug: 4359]
	AC_CHECK_LIB(pthread, __pthread_mutex_init,
		tcl_ok=yes, tcl_ok=no)
    fi

    if test "$tcl_ok" = "yes"; then
	# The space is needed
	THREADS_LIBS=" -lpthread"
    else
	AC_CHECK_LIB(pthreads, pthread_mutex_init,
	_ok=yes, tcl_ok=no)
	if test "$tcl_ok" = "yes"; then
	    # The space is needed
	    THREADS_LIBS=" -lpthreads"
	else
	    AC_CHECK_LIB(c, pthread_mutex_init,
		    tcl_ok=yes, tcl_ok=no)
	    if test "$tcl_ok" = "no"; then
		AC_CHECK_LIB(c_r, pthread_mutex_init,
			tcl_ok=yes, tcl_ok=no)
		if test "$tcl_ok" = "yes"; then
		    # The space is needed
		    THREADS_LIBS=" -pthread"
		else
		    AC_MSG_WARN([Don't know how to find pthread lib on your system - you must edit the LIBS in the Makefile...])
		fi
	    fi
	fi
    fi

    # Does the pthread-implementation provide
    # 'pthread_attr_setstacksize' ?

    ac_saved_libs=$LIBS
    LIBS="$LIBS $THREADS_LIBS"
    AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
    LIBS=$ac_saved_libs

    # TIP #509
    AC_CHECK_DECLS([PTHREAD_MUTEX_RECURSIVE],tcl_ok=yes,tcl_ok=no, [[#include <pthread.h>]])
])

#--------------------------------------------------------------------
# SC_TCL_EARLY_FLAGS
#
#	Check for what flags are needed to be passed so the correct OS
#	features are available.
2478
2479
2480
2481
2482
2483
2484
2485

2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498

2499
2500
2501
2502
2503
2504
2505
2506


2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519









2520
2521
2522
2523
2524
2525
2526
2364
2365
2366
2367
2368
2369
2370

2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383

2384
2385
2386
2387
2388
2389
2390


2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421







-
+












-
+






-
-
+
+













+
+
+
+
+
+
+
+
+







#	None
#
# Results:
#
#	Might define the following vars:
#		TCL_WIDE_INT_IS_LONG
#		TCL_WIDE_INT_TYPE
#		HAVE_STRUCT_DIRENT64
#		HAVE_STRUCT_DIRENT64, HAVE_DIR64
#		HAVE_STRUCT_STAT64
#		HAVE_TYPE_OFF64_T
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_64BIT_FLAGS], [
    AC_MSG_CHECKING([for 64-bit integer type])
    AC_CACHE_VAL(tcl_cv_type_64bit,[
	tcl_cv_type_64bit=none
	# See if the compiler knows natively about __int64
	AC_TRY_COMPILE(,[__int64 value = (__int64) 0;],
	    tcl_type_64bit=__int64, tcl_type_64bit="long long")
	# See if we should use long anyway  Note that we substitute in the
	# See if we could use long anyway  Note that we substitute in the
	# type that is our current guess for a 64-bit type inside this check
	# program, so it should be modified only carefully...
        AC_TRY_COMPILE(,[switch (0) {
            case 1: case (sizeof(]${tcl_type_64bit}[)==sizeof(long)): ;
        }],tcl_cv_type_64bit=${tcl_type_64bit})])
    if test "${tcl_cv_type_64bit}" = none ; then
	AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Are wide integers to be implemented with C 'long's?])
	AC_MSG_RESULT([using long])
	AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Do 'long' and 'long long' have the same size (64-bit)?])
	AC_MSG_RESULT([yes])
    else
	AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit},
	    [What type should be used to define wide integers?])
	AC_MSG_RESULT([${tcl_cv_type_64bit}])

	# Now check for auxiliary declarations
	AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[
	    AC_TRY_COMPILE([#include <sys/types.h>
#include <dirent.h>],[struct dirent64 p;],
		tcl_cv_struct_dirent64=yes,tcl_cv_struct_dirent64=no)])
	if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then
	    AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in <sys/types.h>?])
	fi

	AC_CACHE_CHECK([for DIR64], tcl_cv_DIR64,[
	    AC_TRY_COMPILE([#include <sys/types.h>
#include <dirent.h>],[struct dirent64 *p; DIR64 d = opendir64(".");
            p = readdir64(d); rewinddir64(d); closedir64(d);],
		tcl_cv_DIR64=yes,tcl_cv_DIR64=no)])
	if test "x${tcl_cv_DIR64}" = "xyes" ; then
	    AC_DEFINE(HAVE_DIR64, 1, [Is 'DIR64' in <sys/types.h>?])
	fi

	AC_CACHE_CHECK([for struct stat64], tcl_cv_struct_stat64,[
	    AC_TRY_COMPILE([#include <sys/stat.h>],[struct stat64 p;
],
		tcl_cv_struct_stat64=yes,tcl_cv_struct_stat64=no)])
	if test "x${tcl_cv_struct_stat64}" = "xyes" ; then
	    AC_DEFINE(HAVE_STRUCT_STAT64, 1, [Is 'struct stat64' in <sys/stat.h>?])
3010
3011
3012
3013
3014
3015
3016



























































































































3017
3018
3019
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



if test "x$NEED_FAKE_RFC2553" = "x1"; then
   AC_DEFINE([NEED_FAKE_RFC2553], 1,
        [Use compat implementation of getaddrinfo() and friends])
   AC_LIBOBJ([fake-rfc2553])
   AC_CHECK_FUNC(strlcpy)
fi
])

#------------------------------------------------------------------------
# SC_CC_FOR_BUILD
#	For cross compiles, locate a C compiler that can generate native binaries.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		CC_FOR_BUILD
#		EXEEXT_FOR_BUILD
#------------------------------------------------------------------------

dnl Get a default for CC_FOR_BUILD to put into Makefile.
AC_DEFUN([AX_CC_FOR_BUILD],[# Put a plausible default for CC_FOR_BUILD in Makefile.
    if test -z "$CC_FOR_BUILD"; then
      if test "x$cross_compiling" = "xno"; then
        CC_FOR_BUILD='$(CC)'
      else
        AC_MSG_CHECKING([for gcc])
        AC_CACHE_VAL(ac_cv_path_cc, [
            search_path=`echo ${PATH} | sed -e 's/:/ /g'`
            for dir in $search_path ; do
                for j in `ls -r $dir/gcc 2> /dev/null` \
                        `ls -r $dir/gcc 2> /dev/null` ; do
                    if test x"$ac_cv_path_cc" = x ; then
                        if test -f "$j" ; then
                            ac_cv_path_cc=$j
                            break
                        fi
                    fi
                done
            done
        ])
      fi
    fi
    AC_SUBST(CC_FOR_BUILD)
    # Also set EXEEXT_FOR_BUILD.
    if test "x$cross_compiling" = "xno"; then
      EXEEXT_FOR_BUILD='$(EXEEXT)'
      OBJEXT_FOR_BUILD='$(OBJEXT)'
    else
      OBJEXT_FOR_BUILD='.no'
      AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext,
        [rm -f conftest*
         echo 'int main () { return 0; }' > conftest.c
         bfd_cv_build_exeext=
         ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
         for file in conftest.*; do
           case $file in
           *.c | *.o | *.obj | *.ilk | *.pdb) ;;
           *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
           esac
         done
         rm -f conftest*
         test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no])
      EXEEXT_FOR_BUILD=""
      test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
    fi
    AC_SUBST(EXEEXT_FOR_BUILD)])dnl
    AC_SUBST(OBJEXT_FOR_BUILD)])dnl
])


#------------------------------------------------------------------------
# SC_ZIPFS_SUPPORT
#	Locate a zip encoder installed on the system path, or none.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		ZIP_PROG
#       ZIP_PROG_OPTIONS
#       ZIP_PROG_VFSSEARCH
#       ZIP_INSTALL_OBJS
#------------------------------------------------------------------------

AC_DEFUN([SC_ZIPFS_SUPPORT], [
    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    AC_MSG_CHECKING([for zip])
    AC_CACHE_VAL(ac_cv_path_zip, [
    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done
    ])
    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip "
        AC_MSG_RESULT([$ZIP_PROG])
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="."
        AC_MSG_RESULT([Found INFO Zip in environment])
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="."
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        AC_MSG_RESULT([No zip found on PATH. Building minizip])
    fi
    AC_SUBST(ZIP_PROG)
    AC_SUBST(ZIP_PROG_OPTIONS)
    AC_SUBST(ZIP_PROG_VFSSEARCH)
    AC_SUBST(ZIP_INSTALL_OBJS)
])

# Local Variables:
# mode: autoconf
# End:

Changes to unix/tcl.pc.in.

1
2
3
4
5
6


7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15






+
+







# tcl pkg-config source file

prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@
libfile=@TCL_LIB_FILE@
zipfile=@TCL_ZIP_FILE@

Name: Tool Command Language
Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
URL: http://www.tcl.tk/
Version: @TCL_VERSION@@TCL_PATCH_LEVEL@
Requires.private: zlib >= 1.2.3
Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@

Changes to unix/tcl.spec.

1
2
3
4
5
6
7

8
9
10
11
12
13
14
1
2
3
4
5
6

7
8
9
10
11
12
13
14






-
+







# This file is the basis for a binary Tcl RPM for Linux.

%{!?directory:%define directory /usr/local}

Name:          tcl
Summary:       Tcl scripting language development environment
Version:       9.0a0
Version:       8.7a2
Release:       2
License:       BSD
Group:         Development/Languages
Source:        http://prdownloads.sourceforge.net/tcl/tcl%{version}-src.tar.gz
URL:           http://www.tcl.tk/
Buildroot:     /var/tmp/%{name}%{version}

Changes to unix/tclAppInit.c.

75
76
77
78
79
80
81


82
83
84
85
86
87
88
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90







+
+







{
#ifdef TCL_XT_TEST
    XtToolkitInitialize();
#endif

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#else
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*

Changes to unix/tclConfig.h.in.

191
192
193
194
195
196
197



198
199
200
201
202
203
204
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207







+
+
+







#undef HAVE_STRTOL

/* Define to 1 if the system has the type `struct addrinfo'. */
#undef HAVE_STRUCT_ADDRINFO

/* Is 'struct dirent64' in <sys/types.h>? */
#undef HAVE_STRUCT_DIRENT64

/* Is 'DIR64' in <sys/types.h>? */
#undef HAVE_DIR64

/* Define to 1 if the system has the type `struct in6_addr'. */
#undef HAVE_STRUCT_IN6_ADDR

/* Define to 1 if the system has the type `struct sockaddr_in6'. */
#undef HAVE_STRUCT_SOCKADDR_IN6

291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
294
295
296
297
298
299
300



301
302
303
304
305
306
307







-
-
-








/* Do we have <dlfcn.h>? */
#undef NO_DLFCN_H

/* Do we have fd_set? */
#undef NO_FD_SET

/* Do we have <float.h>? */
#undef NO_FLOAT_H

/* Do we have fstatfs()? */
#undef NO_FSTATFS

/* Do we have gettimeofday()? */
#undef NO_GETTOD

/* Do we have getwd() */
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
330
331
332
333
334
335
336



337
338
339
340
341
342
343







-
-
-








/* Do we have uname() */
#undef NO_UNAME

/* Do we have a usable 'union wait'? */
#undef NO_UNION_WAIT

/* Do we have <values.h>? */
#undef NO_VALUES_H

/* Do we have wait3() */
#undef NO_WAIT3

/* Define to the address where bug reports for this package should be sent. */
#undef PACKAGE_BUGREPORT

/* Define to the full name of this package. */
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403

404
405
406
407
408
409
410
384
385
386
387
388
389
390



391
392
393
394
395
396

397
398
399
400
401
402
403
404







-
-
-






-
+








/* Is memory debugging enabled? */
#undef TCL_MEM_DEBUG

/* What is the default extension for shared libraries? */
#undef TCL_SHLIB_EXT

/* Are we building with threads enabled? */
#undef TCL_THREADS

/* Do we allow unloading of shared libraries? */
#undef TCL_UNLOAD_DLLS

/* Does this platform have wide high-resolution clicks? */
#undef TCL_WIDE_CLICKS

/* Are wide integers to be implemented with C 'long's? */
/* Do Tcl_WideInt, 'long' and 'long long' all have the same size (64-bit) ? */
#undef TCL_WIDE_INT_IS_LONG

/* What type should be used to define wide integers? */
#undef TCL_WIDE_INT_TYPE

/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
#undef TIME_WITH_SYS_TIME

Changes to unix/tclConfig.sh.in.

34
35
36
37
38
39
40



41
42
43
44
45
46
47
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50







+
+
+







TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'

# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=@TCL_SHARED_BUILD@

# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='@TCL_LIB_FILE@'

# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library):
TCL_ZIP_FILE='@TCL_ZIP_FILE@'

# Additional libraries to use when linking Tcl.
TCL_LIBS='@TCL_LIBS@'

# Top-level directory in which Tcl's platform-independent files are
# installed.
TCL_PREFIX='@prefix@'
160
161
162
163
164
165
166
167
168
169
163
164
165
166
167
168
169










-
-
-
TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'

# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'

# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'

# Flag, 1: we built Tcl with threads enabled, 0 we didn't
TCL_THREADS=@TCL_THREADS@

Changes to unix/tclEpollNotfy.c.

1
2
3
4
5
6


7
8
9
10
11
12
13
14
15
16
17
18
19
20


21
22
23
24
25
26
27
1
2
3
4


5
6
7
8
9
10
11
12
13
14



15
16
17
18
19
20
21
22
23
24
25
26




-
-
+
+








-
-
-



+
+







/*
 * tclEpollNotfy.c --
 *
 *	This file contains the implementation of the epoll()-based
 *	Linux-specific notifier, which is the lowest-level part of the
 *	Tcl event loop. This file works together with generic/tclNotify.c.
 *	Linux-specific notifier, which is the lowest-level part of the Tcl
 *	event loop. This file works together with generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <[email protected]>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef NOTIFIER_EPOLL

#define _GNU_SOURCE		/* For pipe2(2) */
#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#if defined(NOTIFIER_EPOLL) && TCL_THREADS
#define _GNU_SOURCE		/* For pipe2(2) */
#include <fcntl.h>
#include <signal.h>
#include <sys/epoll.h>
#ifdef HAVE_EVENTFD
#include <sys/eventfd.h>
#endif /* HAVE_EVENTFD */
#include <sys/queue.h>
50
51
52
53
54
55
56
57
58
59



60
61
62
63
64
65
66
49
50
51
52
53
54
55



56
57
58
59
60
61
62
63
64
65







-
-
-
+
+
+







				 * ready for I/O. */
    struct PlatformEventData *pedPtr;
				/* Pointer to PlatformEventData associating this
				 * FileHandler with epoll(7) events. */
} FileHandler;

/*
 * The following structure associates a FileHandler and the thread that owns it
 * with the file descriptors of interest and their event masks passed to epoll_ctl(2)
 * and their corresponding event(s) returned by epoll_wait(2).
 * The following structure associates a FileHandler and the thread that owns
 * it with the file descriptors of interest and their event masks passed to
 * epoll_ctl(2) and their corresponding event(s) returned by epoll_wait(2).
 */

struct ThreadSpecificData;
struct PlatformEventData {
    FileHandler *filePtr;
    struct ThreadSpecificData *tsdPtr;
};
84
85
86
87
88
89
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
128
83
84
85
86
87
88
89
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
128
129
130
131
132
133
134
135
136
137
138
139







+
















-
+
+







-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * The following static structure contains the state information for the
 * epoll based implementation of the Tcl notifier. One of these structures is
 * created for each thread that is using the notifier.
 */

LIST_HEAD(PlatformReadyFileHandlerList, FileHandler);
typedef struct ThreadSpecificData {
    FileHandler *triggerFilePtr;
    FileHandler *firstFileHandlerPtr;
				/* Pointer to head of file handler list. */
    struct PlatformReadyFileHandlerList firstReadyFileHandlerPtr;
				/* Pointer to head of list of FileHandlers
				 * associated with regular files (S_IFREG)
				 * that are ready for I/O. */
    pthread_mutex_t notifierMutex;
				/* Mutex protecting notifier termination in
				 * PlatformEventsFinalize. */
#ifdef HAVE_EVENTFD
    int triggerEventFd;		/* eventfd(2) used by other threads to wake
				 * up this thread for inter-thread IPC. */
#else
    int triggerPipe[2];		/* pipe(2) used by other threads to wake
				 * up this thread for inter-thread IPC. */
#endif /* HAVE_EVENTFD */
    int eventsFd;		/* epoll(7) file descriptor used to wait for fds */
    int eventsFd;		/* epoll(7) file descriptor used to wait for
				 * fds */
    struct epoll_event *readyEvents;
				/* Pointer to at most maxReadyEvents events
				 * returned by epoll_wait(2). */
    size_t maxReadyEvents;	/* Count of epoll_events in readyEvents. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

void PlatformEventsControl(FileHandler *filePtr, ThreadSpecificData *tsdPtr, int op, int isNew);
static void PlatformEventsFinalize(void);
void PlatformEventsInit(void);
static int PlatformEventsTranslate(struct epoll_event *event);
static int PlatformEventsWait(struct epoll_event *events, size_t numEvents, struct timeval *timePtr);


/*
 * Forward declarations.
 */

static void		PlatformEventsControl(FileHandler *filePtr,
			    ThreadSpecificData *tsdPtr, int op, int isNew);
static void		PlatformEventsFinalize(void);
static void		PlatformEventsInit(void);
static int		PlatformEventsTranslate(struct epoll_event *event);
static int		PlatformEventsWait(struct epoll_event *events,
			    size_t numEvents, struct timeval *timePtr);

/*
 * Incorporate the base notifier API.
 */

#include "tclUnixNotfy.c"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
185
186
187
188
189
190
191

192
193


194
195
196
197
198
199
200
201
202
203
204
205
206








207
208
209
210
211
212
213
214
215
216




217
218
219
220
221
222
223
196
197
198
199
200
201
202
203


204
205
206
207
208
209
210








211
212
213
214
215
216
217
218
219
220
221
222
223
224




225
226
227
228
229
230
231
232
233
234
235







+
-
-
+
+





-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+






-
-
-
-
+
+
+
+







 *----------------------------------------------------------------------
 *
 * PlatformEventsControl --
 *
 *	This function registers interest for the file descriptor and the mask
 *	of TCL_* bits associated with filePtr on the epoll file descriptor
 *	associated with tsdPtr.
 *
 *	Future calls to epoll_wait will return filePtr and tsdPtr alongside with
 *	the event registered here via the PlatformEventData struct.
 *	Future calls to epoll_wait will return filePtr and tsdPtr alongside
 *	with the event registered here via the PlatformEventData struct.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If adding a new file descriptor, a PlatformEventData struct will be
 *	allocated and associated with filePtr.
 *	fstat is called on the file descriptor; if it is associated with
 *	a regular file (S_IFREG,) filePtr is considered to be ready for I/O
 *	and added to or deleted from the corresponding list in tsdPtr.
 *	If it is not associated with a regular file, the file descriptor is
 *	added, modified concerning its mask of events of interest, or deleted
 *	from the epoll file descriptor of the calling thread.
 *	- If adding a new file descriptor, a PlatformEventData struct will be
 *	  allocated and associated with filePtr.
 *	- fstat is called on the file descriptor; if it is associated with a
 *	  regular file (S_IFREG,) filePtr is considered to be ready for I/O
 *	  and added to or deleted from the corresponding list in tsdPtr.
 *	- If it is not associated with a regular file, the file descriptor is
 *	  added, modified concerning its mask of events of interest, or
 *	  deleted from the epoll file descriptor of the calling thread.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsControl(
	FileHandler *filePtr,
	ThreadSpecificData *tsdPtr,
	int op,
	int isNew)
    FileHandler *filePtr,
    ThreadSpecificData *tsdPtr,
    int op,
    int isNew)
{
    struct epoll_event newEvent;
    struct PlatformEventData *newPedPtr;
    struct stat fdStat;

    newEvent.events = 0;
    if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
231
232
233
234
235
236
237
238
239
240
241




242
243
244
245
246
247
248
249
250


251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271



272
273
274
275
276
277
278
279
280



281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299

300
301
302
303
304
305
306
307
308


309
310
311
312
313
314
315
243
244
245
246
247
248
249




250
251
252
253
254
255
256
257
258
259
260
261

262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281



282
283
284
285
286
287
288
289
290



291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311

312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330







-
-
-
-
+
+
+
+








-
+
+


















-
-
-
+
+
+






-
-
-
+
+
+


















-
+









+
+







        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
	filePtr->pedPtr = newPedPtr;
    }
    newEvent.data.ptr = filePtr->pedPtr;

    /*
     * N.B.	As discussed in Tcl_WaitForEvent(), epoll(7) does not sup-
     *		port regular files (S_IFREG.) Therefore, filePtr is in these
     *		cases simply added or deleted from the list of FileHandlers
     *		associated with regular files belonging to tsdPtr.
     * N.B. As discussed in Tcl_WaitForEvent(), epoll(7) does not support
     * regular files (S_IFREG.) Therefore, filePtr is in these cases simply
     * added or deleted from the list of FileHandlers associated with regular
     * files belonging to tsdPtr.
     */

    if (fstat(filePtr->fd, &fdStat) == -1) {
	Tcl_Panic("fstat: %s", strerror(errno));
    } else if ((fdStat.st_mode & S_IFMT) == S_IFREG) {
	switch (op) {
	case EPOLL_CTL_ADD:
	    if (isNew) {
		LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr, readyNode);
		LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr,
			readyNode);
	    }
	    break;
	case EPOLL_CTL_DEL:
	    LIST_REMOVE(filePtr, readyNode);
	    break;
	}
	return;
   } else if (epoll_ctl(tsdPtr->eventsFd, op, filePtr->fd, &newEvent) == -1) {
	Tcl_Panic("epoll_ctl: %s", strerror(errno));
   }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsFinalize --
 *
 *	This function closes the eventfd and the epoll file descriptor and
 *	frees the epoll_event structs owned by the thread of the caller.
 *	The above operations are protected by tsdPtr->notifierMutex, which
 *	is destroyed thereafter.
 *	frees the epoll_event structs owned by the thread of the caller.  The
 *	above operations are protected by tsdPtr->notifierMutex, which is
 *	destroyed thereafter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 * 	While tsdPtr->notifierMutex is held:
 *	The per-thread eventfd(2) is closed, if non-zero, and set to -1.
 *	The per-thread epoll(7) fd is closed, if non-zero, and set to 0.
 *	The per-thread epoll_event structs are freed, if any, and set to 0.
 *	- The per-thread eventfd(2) is closed, if non-zero, and set to -1.
 *	- The per-thread epoll(7) fd is closed, if non-zero, and set to 0.
 *	- The per-thread epoll_event structs are freed, if any, and set to 0.
 *
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsFinalize(
	void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&tsdPtr->notifierMutex);
#ifdef HAVE_EVENTFD
    if (tsdPtr->triggerEventFd) {
	close(tsdPtr->triggerEventFd);
	tsdPtr->triggerEventFd = -1;
    }
#else
#else /* !HAVE_EVENTFD */
    if (tsdPtr->triggerPipe[0]) {
	close(tsdPtr->triggerPipe[0]);
	tsdPtr->triggerPipe[0] = -1;
    }
    if (tsdPtr->triggerPipe[1]) {
	close(tsdPtr->triggerPipe[1]);
	tsdPtr->triggerPipe[1] = -1;
    }
#endif /* HAVE_EVENTFD */
    ckfree(tsdPtr->triggerFilePtr->pedPtr);
    ckfree(tsdPtr->triggerFilePtr);
    if (tsdPtr->eventsFd > 0) {
	close(tsdPtr->eventsFd);
	tsdPtr->eventsFd = 0;
    }
    if (tsdPtr->readyEvents) {
	ckfree(tsdPtr->readyEvents);
	tsdPtr->maxReadyEvents = 0;
330
331
332
333
334
335
336
337
338
339
340
341
342
343








344
345
346
347
348
349

350
351
352
353
354
355
356
357
358
359
360
361


362
363
364
365

366
367
368
369
370


371
372
373
374
375
376
377
378
379


380
381
382
383
384
385
386
387
388
389
390


391
392
393
394
395
396
397
398
399
400
401
402
403

404
405
406
407
408
409
410
345
346
347
348
349
350
351







352
353
354
355
356
357
358
359
360
361
362
363
364

365

366
367
368
369
370
371
372
373
374
375

376
377
378
379
380

381
382
383
384
385

386
387
388
389
390
391
392
393
394


395
396
397
398
399
400
401
402
403
404
405


406
407
408
409
410
411
412
413
414
415
416
417
418
419

420
421
422
423
424
425
426
427







-
-
-
-
-
-
-
+
+
+
+
+
+
+
+





-
+
-










-
+
+



-
+




-
+
+







-
-
+
+









-
-
+
+












-
+







 *	tsdPtr for the thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The following per-thread entities are initialised:
 *	notifierMutex is initialised.
 *	The eventfd(2) is created w/ EFD_CLOEXEC and EFD_NONBLOCK.
 *	The epoll(7) fd is created w/ EPOLL_CLOEXEC.
 *	A FileHandler struct is allocated and initialised for the event-
 *	fd(2), registering interest for TCL_READABLE on it via Platform-
 *	EventsControl().
 *	readyEvents and maxReadyEvents are initialised with 512 epoll_events.
 *	- notifierMutex is initialised.
 *	- The eventfd(2) is created w/ EFD_CLOEXEC and EFD_NONBLOCK.
 *	- The epoll(7) fd is created w/ EPOLL_CLOEXEC.
 *	- A FileHandler struct is allocated and initialised for the
 *	  eventfd(2), registering interest for TCL_READABLE on it via
 *	  PlatformEventsControl().
 *	- readyEvents and maxReadyEvents are initialised with 512
 *	  epoll_events.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsInit(
PlatformEventsInit(void)
	void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr;

    errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
    if (errno) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex");
    }
    filePtr = ckalloc(sizeof(*filePtr));
#ifdef HAVE_EVENTFD
    if ((tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK)) <= 0) {
    tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK);
    if (tsdPtr->triggerEventFd <= 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger eventfd");
    }
    filePtr->fd = tsdPtr->triggerEventFd;
#else
#else /* !HAVE_EVENTFD */
    if (pipe2(tsdPtr->triggerPipe, O_CLOEXEC | O_NONBLOCK) != 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
    }
    filePtr->fd = tsdPtr->triggerPipe[0];
#endif
#endif /* HAVE_EVENTFD */
    tsdPtr->triggerFilePtr = filePtr;
    if ((tsdPtr->eventsFd = epoll_create1(EPOLL_CLOEXEC)) == -1) {
	Tcl_Panic("epoll_create1: %s", strerror(errno));
    }
    filePtr->mask = TCL_READABLE;
    PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1);
    if (!tsdPtr->readyEvents) {
        tsdPtr->maxReadyEvents = 512;
	tsdPtr->readyEvents = ckalloc(tsdPtr->maxReadyEvents
	    * sizeof(tsdPtr->readyEvents[0]));
	tsdPtr->readyEvents = ckalloc(
		tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsTranslate --
 *
 *	This function translates the platform-specific mask of returned
 *	events in eventPtr to a mask of TCL_* bits.
 *	This function translates the platform-specific mask of returned events
 *	in eventPtr to a mask of TCL_* bits.
 *
 * Results:
 *	Returns the translated mask.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsTranslate(
	struct epoll_event *eventPtr)
    struct epoll_event *eventPtr)
{
    int mask;

    mask = 0;
    if (eventPtr->events & (EPOLLIN | EPOLLHUP)) {
	mask |= TCL_READABLE;
    }
421
422
423
424
425
426
427
428
429
430



431
432
433
434
435
436
437





438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457


458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474



475
476
477
478
479
480
481
482
483

484
485
486


487
488
489
490
491
492
493
494
495
496
497
498


499
500
501
502
503
504
505
438
439
440
441
442
443
444



445
446
447
448
449





450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472


473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488



489
490
491
492
493
494
495
496
497
498
499

500
501


502
503
504
505
506
507
508
509
510
511
512
513


514
515
516
517
518
519
520
521
522







-
-
-
+
+
+


-
-
-
-
-
+
+
+
+
+


















-
-
+
+














-
-
-
+
+
+








-
+

-
-
+
+










-
-
+
+







 *----------------------------------------------------------------------
 *
 * PlatformEventsWait --
 *
 *	This function abstracts waiting for I/O events via epoll_wait.
 *
 * Results:
 *	Returns -1 if epoll_wait failed. Returns 0 if polling and if no
 *	events became available whilst polling. Returns a pointer to and
 *	the count of all returned events in all other cases.
 *	Returns -1 if epoll_wait failed. Returns 0 if polling and if no events
 *	became available whilst polling. Returns a pointer to and the count of
 *	all returned events in all other cases.
 *
 * Side effects:
 *	gettimeofday(2), epoll_wait(2), and gettimeofday(2) are called,
 *	in the specified order.
 *	If timePtr specifies a positive value, it is updated to reflect
 *	the amount of time that has passed; if its value would {under,
 *	over}flow, it is set to zero.
 *	gettimeofday(2), epoll_wait(2), and gettimeofday(2) are called, in the
 *	specified order.
 *	If timePtr specifies a positive value, it is updated to reflect the
 *	amount of time that has passed; if its value would {under, over}flow,
 *	it is set to zero.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsWait(
    struct epoll_event *events,
    size_t numEvents,
    struct timeval *timePtr)
{
    int numFound;
    struct timeval tv0, tv1, tv_delta;
    int timeout;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * If timePtr is NULL, epoll_wait(2) will wait indefinitely. If it
     * specifies a timeout of {0,0}, epoll_wait(2) will poll. Otherwise,
     * the timeout will simply be converted to milliseconds.
     * specifies a timeout of {0,0}, epoll_wait(2) will poll. Otherwise, the
     * timeout will simply be converted to milliseconds.
     */

    if (!timePtr) {
	timeout = -1;
    } else if (!timePtr->tv_sec && !timePtr->tv_usec) {
	timeout = 0;
    } else {
	timeout = (int)timePtr->tv_sec * 1000;
	if (timePtr->tv_usec) {
	    timeout += (int)timePtr->tv_usec / 1000;
	}
    }

    /*
     * Call (and possibly block on) epoll_wait(2) and substract the delta
     * of gettimeofday(2) before and after the call from timePtr if the
     * latter is not NULL. Return the number of events returned by epoll_wait(2).
     * Call (and possibly block on) epoll_wait(2) and substract the delta of
     * gettimeofday(2) before and after the call from timePtr if the latter is
     * not NULL. Return the number of events returned by epoll_wait(2).
     */

    gettimeofday(&tv0, NULL);
    numFound = epoll_wait(tsdPtr->eventsFd, events, (int)numEvents, timeout);
    gettimeofday(&tv1, NULL);
    if (timePtr && (timePtr->tv_sec && timePtr->tv_usec)) {
	timersub(&tv1, &tv0, &tv_delta);
	if (!timercmp(&tv_delta, timePtr, >)) {
		timersub(timePtr, &tv_delta, timePtr);
	    timersub(timePtr, &tv_delta, timePtr);
	} else {
		timePtr->tv_sec = 0;
		timePtr->tv_usec = 0;
	    timePtr->tv_sec = 0;
	    timePtr->tv_usec = 0;
	}
    }
    return numFound;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *
 *	This function registers a file handler with the epoll notifier
 *	of the thread of the caller.
 *	This function registers a file handler with the epoll notifier of the
 *	thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new file handler structure.
 *	PlatformEventsControl() is called for the new file handler structure.
543
544
545
546
547
548
549
550
551


552
553
554
555
556
557
558
559
560
561


562
563
564
565
566
567
568
560
561
562
563
564
565
566


567
568
569
570
571
572
573
574
575
576


577
578
579
580
581
582
583
584
585







-
-
+
+








-
-
+
+







	} else {
	    isNew = 0;
	}
	filePtr->proc = proc;
	filePtr->clientData = clientData;
	filePtr->mask = mask;

	PlatformEventsControl(filePtr, tsdPtr, isNew ?
	    EPOLL_CTL_ADD : EPOLL_CTL_MOD, isNew);
	PlatformEventsControl(filePtr, tsdPtr,
		isNew ? EPOLL_CTL_ADD : EPOLL_CTL_MOD, isNew);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	Cancel a previously-arranged callback arrangement for a file on
 *	the epoll file descriptor of the thread of the caller.
 *	Cancel a previously-arranged callback arrangement for a file on the
 *	epoll file descriptor of the thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If a callback was previously registered on file, remove it.
 *	PlatformEventsControl() is called for the file handler structure.
624
625
626
627
628
629
630

631
632
633
634
635
636
637
638
639
640
641
642
643
644
645

646
647
648
649
650
651
652
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662

663
664
665
666
667
668
669
670







+














-
+







 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	This function is called by Tcl_DoOneEvent to wait for new events on
 *	the message queue. If the block time is 0, then Tcl_WaitForEvent just
 *	polls without blocking.
 *
 *	The waiting logic is implemented in PlatformEventsWait.
 *
 * Results:
 *	Returns -1 if PlatformEventsWait() would block forever, otherwise
 *	returns 0.
 *
 * Side effects:
 *	Queues file events that are detected by PlatformEventsWait().
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
    const Tcl_Time *timePtr)	/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
688
689
690
691
692
693
694

695
696
697
698


699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719

720
721
722
723
724
725
726
727
728
729
730
731
732



733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750


751
752
753


754
755
756
757
758
759
760
761


762






763

764
765
766


767
768
769
770
771



772
773
774



775

776
777
778
779
780
781
782
706
707
708
709
710
711
712
713
714
715


716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737

738
739
740
741
742
743
744
745
746
747
748



749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768

769
770
771
772

773
774
775
776
777
778
779
780
781

782
783
784
785
786
787
788
789
790

791
792
793

794
795
796




797
798
799



800
801
802

803
804
805
806
807
808
809
810







+


-
-
+
+




















-
+










-
-
-
+
+
+

















-
+
+


-
+
+







-
+
+

+
+
+
+
+
+
-
+


-
+
+

-
-
-
-
+
+
+
-
-
-
+
+
+
-
+







	    timeoutPtr = NULL;
	}

	/*
	 * Walk the list of FileHandlers associated with regular files
	 * (S_IFREG) belonging to tsdPtr, queue Tcl events for them, and
	 * update their mask of events of interest.
	 *
	 * As epoll(7) does not support regular files, the behaviour of
	 * {select,poll}(2) is simply simulated here: fds associated with
	 * regular files are added to this list by PlatformEventsControl()
	 * and processed here before calling (and possibly blocking) on
	 * regular files are added to this list by PlatformEventsControl() and
	 * processed here before calling (and possibly blocking) on
	 * PlatformEventsWait().
	 */

	numQueued = 0;
	LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) {
	    mask = 0;
	    if (filePtr->mask & TCL_READABLE) {
		mask |= TCL_READABLE;
	    }
	    if (filePtr->mask & TCL_WRITABLE) {
		mask |= TCL_WRITABLE;
	    }

	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
		    ckalloc(sizeof(FileHandlerEvent));
			ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
		numQueued++;
	    }
	    filePtr->readyMask = mask;
	}

	/*
	 * If any events were queued in the above loop, force PlatformEvents-
	 * Wait() to poll as there already are events that need to be processed
	 * at this point.
	 * If any events were queued in the above loop, force
	 * PlatformEventsWait() to poll as there already are events that need
	 * to be processed at this point.
	 */

	if (numQueued) {
	    timeout.tv_sec = 0;
	    timeout.tv_usec = 0;
	    timeoutPtr = &timeout;
	}

	/*
	 * Wait or poll for new events, queue Tcl events for the FileHandlers
	 * corresponding to them, and update the FileHandlers' mask of events
	 * of interest registered by the last call to Tcl_CreateFileHandler().
	 *
	 * Events for the eventfd(2)/trigger pipe are processed here in order
	 * to facilitate inter-thread IPC. If another thread intends to wake
	 * up this thread whilst it's blocking on PlatformEventsWait(), it
	 * write(2)s to the eventfd(2)/trigger pipe (see Tcl_AlertNotifier(),)
	 * which in turn will cause PlatformEventsWait() to return immediately.
	 * which in turn will cause PlatformEventsWait() to return
	 * immediately.
	 */

	numFound = PlatformEventsWait(tsdPtr->readyEvents, tsdPtr->maxReadyEvents, timeoutPtr);
	numFound = PlatformEventsWait(tsdPtr->readyEvents,
		tsdPtr->maxReadyEvents, timeoutPtr);
	for (numEvent = 0; numEvent < numFound; numEvent++) {
	    pedPtr = tsdPtr->readyEvents[numEvent].data.ptr;
	    filePtr = pedPtr->filePtr;
	    mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]);
#ifdef HAVE_EVENTFD
	    if (filePtr->fd == tsdPtr->triggerEventFd) {
		uint64_t eventFdVal;
		i = read(tsdPtr->triggerEventFd, &eventFdVal, sizeof(eventFdVal));
		i = read(tsdPtr->triggerEventFd, &eventFdVal,
			sizeof(eventFdVal));
		if ((i != sizeof(eventFdVal)) && (errno != EAGAIN)) {
		    Tcl_Panic(
			    "Tcl_WaitForEvent: read from %p->triggerEventFd: %s",
			    (void *) tsdPtr, strerror(errno));
		}
		continue;
	    }
#else
#else /* !HAVE_EVENTFD */
	    if (filePtr->fd == tsdPtr->triggerPipe[0]) {
		char triggerPipeVal;
		i = read(tsdPtr->triggerPipe[0], &triggerPipeVal, sizeof(triggerPipeVal));
		i = read(tsdPtr->triggerPipe[0], &triggerPipeVal,
			sizeof(triggerPipeVal));
		if ((i != sizeof(triggerPipeVal)) && (errno != EAGAIN)) {
#endif
			Tcl_Panic("Tcl_WaitForEvent: "
				"read from %p->triggerEventFd: %s",
				(void *)tsdPtr, strerror(errno));
		    Tcl_Panic(
			    "Tcl_WaitForEvent: read from %p->triggerPipe[0]: %s",
			    (void *) tsdPtr, strerror(errno));
		} else {
		    continue;
		}
		}
		continue;
	    }
	    }
#endif /* HAVE_EVENTFD */
	    if (!mask) {
		continue;
	    }

	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
792
793
794
795
796
797
798

799
800
801
802
803
804
805
806
807
808
809
820
821
822
823
824
825
826
827
828


829
830
831
832
833
834
835
836







+

-
-








	    }
	    filePtr->readyMask = mask;
	}
	return 0;
    }
}

#endif /* NOTIFIER_EPOLL && TCL_THREADS */
#endif /* !HAVE_COREFOUNDATION */

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

Changes to unix/tclKqueueNotfy.c.

9
10
11
12
13
14
15
16
17
18
19
20


21
22
23
24
25
26
27
9
10
11
12
13
14
15


16
17
18
19
20
21
22
23
24
25
26
27







-
-



+
+







 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <[email protected]>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef NOTIFIER_KQUEUE

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#if defined(NOTIFIER_KQUEUE) && TCL_THREADS

#include <signal.h>
#include <sys/types.h>
#include <sys/event.h>
#include <sys/queue.h>
#include <sys/time.h>

/*
47
48
49
50
51
52
53
54
55
56



57
58
59
60
61
62
63
47
48
49
50
51
52
53



54
55
56
57
58
59
60
61
62
63







-
-
-
+
+
+







				 * ready for I/O. */
    struct PlatformEventData *pedPtr;
				/* Pointer to PlatformEventData associating this
				 * FileHandler with kevent(2) events. */
} FileHandler;

/*
 * The following structure associates a FileHandler and the thread that owns it
 * with the file descriptors of interest and their event masks passed to kevent(2)
 * and their corresponding event(s) returned by kevent(2).
 * The following structure associates a FileHandler and the thread that owns
 * it with the file descriptors of interest and their event masks passed to
 * kevent(2) and their corresponding event(s) returned by kevent(2).
 */

struct ThreadSpecificData;
struct PlatformEventData {
    FileHandler *filePtr;
    struct ThreadSpecificData *tsdPtr;
};
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
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







-
+
+






-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







				 * associated with regular files (S_IFREG)
				 * that are ready for I/O. */
    pthread_mutex_t notifierMutex;
				/* Mutex protecting notifier termination in
				 * PlatformEventsFinalize. */
    int triggerPipe[2];		/* pipe(2) used by other threads to wake
				 * up this thread for inter-thread IPC. */
    int eventsFd;		/* kqueue(2) file descriptor used to wait for fds. */
    int eventsFd;		/* kqueue(2) file descriptor used to wait for
				 * fds. */
    struct kevent *readyEvents;	/* Pointer to at most maxReadyEvents events
				 * returned by kevent(2). */
    size_t maxReadyEvents;	/* Count of kevents in readyEvents. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

void PlatformEventsControl(FileHandler *filePtr, ThreadSpecificData *tsdPtr, int op, int isNew);
static void PlatformEventsFinalize(void);
void PlatformEventsInit(void);
static int PlatformEventsTranslate(struct kevent *eventPtr);
static int PlatformEventsWait(struct kevent *events, size_t numEvents, struct timeval *timePtr);


/*
 * Forward declarations of internal functions.
 */

static void		PlatformEventsControl(FileHandler *filePtr,
			    ThreadSpecificData *tsdPtr, int op, int isNew);
static void		PlatformEventsFinalize(void);
static void		PlatformEventsInit(void);
static int		PlatformEventsTranslate(struct kevent *eventPtr);
static int		PlatformEventsWait(struct kevent *events,
			    size_t numEvents, struct timeval *timePtr);

#include "tclUnixNotfy.c"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
176
177
178
179
180
181
182

183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199










200
201
202
203
204
205
206
207
208
209




210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228





229
230
231
232
233
234
235
236
237


238
239
240
241
242
243
244
245
246
247
248
249
250
251
252


253
254
255
256
257


258
259
260
261


262
263
264
265
266
267
268
269
270
271
272





273
274
275



276
277


278
279
280
281
282


283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299




300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197










198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213




214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231





232
233
234
235
236
237
238
239
240
241
242
243
244

245
246
247
248
249
250
251
252
253
254
255
256
257
258
259


260
261
262
263
264


265
266
267
268
269

270
271
272
273
274
275
276
277





278
279
280
281
282



283
284
285
286

287
288
289
290
291
292

293
294
295
296
297
298
299
300
301
302
303
304
305
306
307




308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328

329
330
331
332
333
334
335
336







+







-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+






-
-
-
-
+
+
+
+














-
-
-
-
-
+
+
+
+
+








-
+
+













-
-
+
+



-
-
+
+



-
+
+






-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+

-
+
+




-
+
+













-
-
-
-
+
+
+
+

















-
+







 *----------------------------------------------------------------------
 *
 * PlatformEventsControl --
 *
 *	This function registers interest for the file descriptor and the mask
 *	of TCL_* bits associated with filePtr on the kqueue file descriptor
 *	associated with tsdPtr.
 *
 *	Future calls to kevent will return filePtr and tsdPtr alongside with
 *	the event registered here via the PlatformEventData struct.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If adding a new file descriptor, a PlatformEventData struct will be
 *	allocated and associated with filePtr.
 *	fstat is called on the file descriptor; if it is associated with
 *	a regular file (S_IFREG,) filePtr is considered to be ready for I/O
 *	and added to or deleted from the corresponding list in tsdPtr.
 *	If it is not associated with a regular file, the file descriptor is
 *	added, modified concerning its mask of events of interest, or deleted
 *	from the epoll file descriptor of the calling thread.
 *	If deleting a file descriptor, kevent(2) is called twice specifying
 *	EVFILT_READ first and then EVFILT_WRITE (see note below.)
 *	- If adding a new file descriptor, a PlatformEventData struct will be
 *	  allocated and associated with filePtr.
 *	- fstat is called on the file descriptor; if it is associated with
 *	  a regular file (S_IFREG,) filePtr is considered to be ready for I/O
 *	  and added to or deleted from the corresponding list in tsdPtr.
 *	- If it is not associated with a regular file, the file descriptor is
 *	  added, modified concerning its mask of events of interest, or
 *	  deleted from the epoll file descriptor of the calling thread.
 *	- If deleting a file descriptor, kevent(2) is called twice specifying
 *	  EVFILT_READ first and then EVFILT_WRITE (see note below.)
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsControl(
	FileHandler *filePtr,
	ThreadSpecificData *tsdPtr,
	int op,
	int isNew)
    FileHandler *filePtr,
    ThreadSpecificData *tsdPtr,
    int op,
    int isNew)
{
    int numChanges;
    struct kevent changeList[2];
    struct PlatformEventData *newPedPtr;
    struct stat fdStat;

    if (isNew) {
        newPedPtr = ckalloc(sizeof(*newPedPtr));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
        filePtr->pedPtr = newPedPtr;
    }

    /*
     * N.B.	As discussed in Tcl_WaitForEvent(), kqueue(2) does not repro-
     *		duce the `always ready' {select,poll}(2) behaviour for regular
     *		files (S_IFREG) prior to FreeBSD 11.0-RELEASE. Therefore, file-
     *		Ptr is in these cases simply added or deleted from the list of
     *		FileHandlers associated with regular files belonging to tsdPtr.
     * N.B. As discussed in Tcl_WaitForEvent(), kqueue(2) does not reproduce
     * the `always ready' {select,poll}(2) behaviour for regular files
     * (S_IFREG) prior to FreeBSD 11.0-RELEASE. Therefore, filePtr is in these
     * cases simply added or deleted from the list of FileHandlers associated
     * with regular files belonging to tsdPtr.
     */

    if (fstat(filePtr->fd, &fdStat) == -1) {
	Tcl_Panic("fstat: %s", strerror(errno));
    } else if ((fdStat.st_mode & S_IFMT) == S_IFREG) {
	switch (op) {
	case EV_ADD:
	    if (isNew) {
		LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr, readyNode);
		LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr,
			readyNode);
	    }
	    break;
	case EV_DELETE:
	    LIST_REMOVE(filePtr, readyNode);
	    break;
	}
	return;
    }

    numChanges = 0;
    switch (op) {
    case EV_ADD:
	if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
	    EV_SET(&changeList[numChanges], (uintptr_t)filePtr->fd, EVFILT_READ,
		op, 0, 0, filePtr->pedPtr);
	    EV_SET(&changeList[numChanges], (uintptr_t)filePtr->fd,
		    EVFILT_READ, op, 0, 0, filePtr->pedPtr);
	    numChanges++;
	}
	if (filePtr->mask & TCL_WRITABLE) {
	    EV_SET(&changeList[numChanges], (uintptr_t)filePtr->fd, EVFILT_WRITE,
		op, 0, 0, filePtr->pedPtr);
	    EV_SET(&changeList[numChanges], (uintptr_t)filePtr->fd,
		    EVFILT_WRITE, op, 0, 0, filePtr->pedPtr);
	    numChanges++;
	}
        if (numChanges) {
	    if (kevent(tsdPtr->eventsFd, changeList, numChanges, NULL, 0, NULL) == -1) {
	    if (kevent(tsdPtr->eventsFd, changeList, numChanges, NULL, 0,
		    NULL) == -1) {
		Tcl_Panic("kevent: %s", strerror(errno));
	    }
	}
	break;
    case EV_DELETE:
	/*
	 * N.B.	kqueue(2) has separate filters for readability and writabi-
	 *		lity fd events. We therefore need to ensure that fds are
	 *		ompletely removed from the kqueue(2) fd when deleting.
	 *		This is exacerbated by changes to filePtr->mask w/o calls
	 *		to PlatforEventsControl() after e.g. an exec(3) in a child
	 * N.B. kqueue(2) has separate filters for readability and writability
	 * fd events. We therefore need to ensure that fds are ompletely
	 * removed from the kqueue(2) fd when deleting.  This is exacerbated
	 * by changes to filePtr->mask w/o calls to PlatforEventsControl()
	 * after e.g. an exec(3) in a child process.
	 *		process.
	 *		As one of these calls can fail, two separate kevent(2) calls
	 *		are made for EVFILT_{READ,WRITE}.
	 *
	 * As one of these calls can fail, two separate kevent(2) calls are
	 * made for EVFILT_{READ,WRITE}.
	 */
	EV_SET(&changeList[0], (uintptr_t)filePtr->fd, EVFILT_READ, op, 0, 0, NULL);
	EV_SET(&changeList[0], (uintptr_t)filePtr->fd, EVFILT_READ, op, 0, 0,
		NULL);
	if ((kevent(tsdPtr->eventsFd, changeList, 1, NULL, 0, NULL) == -1)
		&& (errno != ENOENT)) {
	    Tcl_Panic("kevent: %s", strerror(errno));
	}
	EV_SET(&changeList[0], (uintptr_t)filePtr->fd, EVFILT_WRITE, op, 0, 0, NULL);
	EV_SET(&changeList[0], (uintptr_t)filePtr->fd, EVFILT_WRITE, op, 0, 0,
		NULL);
	if ((kevent(tsdPtr->eventsFd, changeList, 1, NULL, 0, NULL) == -1)
		&& (errno != ENOENT)) {
	    Tcl_Panic("kevent: %s", strerror(errno));
	}
	break;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsFinalize --
 *
 *	This function closes the pipe and the kqueue file descriptors
 *	and frees the kevent structs owned by the thread of the caller.
 *	The above operations are protected by tsdPtr->notifierMutex, which
 *	is destroyed thereafter.
 *	This function closes the pipe and the kqueue file descriptors and
 *	frees the kevent structs owned by the thread of the caller.  The above
 *	operations are protected by tsdPtr->notifierMutex, which is destroyed
 *	thereafter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 * 	While tsdPtr->notifierMutex is held:
 *	The per-thread pipe(2) fds are closed, if non-zero, and set to -1.
 *	The per-thread kqueue(2) fd is closed, if non-zero, and set to 0.
 *	The per-thread kevent structs are freed, if any, and set to 0.
 *
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsFinalize(
	void)
    void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&tsdPtr->notifierMutex);
    if (tsdPtr->triggerPipe[0]) {
	close(tsdPtr->triggerPipe[0]);
	tsdPtr->triggerPipe[0] = -1;
342
343
344
345
346
347
348
349
350
351



352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367










368
369
370
371
372

373
374
375
376
377
378
379
380
354
355
356
357
358
359
360



361
362
363
364
365
366
367
368
369










370
371
372
373
374
375
376
377
378
379
380
381
382
383

384

385
386
387
388
389
390
391







-
-
-
+
+
+






-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+




-
+
-







}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsInit --
 *
 *	This function abstracts creating a kqueue fd via the kqueue
 *	system call and allocating memory for the kevents structs in
 *	tsdPtr for the thread of the caller.
 *	This function abstracts creating a kqueue fd via the kqueue system
 *	call and allocating memory for the kevents structs in tsdPtr for the
 *	thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The following per-thread entities are initialised:
 *	notifierMutex is initialised.
 *	The pipe(2) is created; fcntl(2) is called on both fds to set
 *	FD_CLOEXEC and O_NONBLOCK.
 *	The kqueue(2) fd is created; fcntl(2) is called on it to set
 *	FD_CLOEXEC.
 *	A FileHandler struct is allocated and initialised for the event-
 *	fd(2), registering interest for TCL_READABLE on it via Platform-
 *	EventsControl().
 *	readyEvents and maxReadyEvents are initialised with 512 kevents.

 *	- notifierMutex is initialised.
 *	- The pipe(2) is created; fcntl(2) is called on both fds to set
 *	  FD_CLOEXEC and O_NONBLOCK.
 *	- The kqueue(2) fd is created; fcntl(2) is called on it to set
 *	  FD_CLOEXEC.
 *	- A FileHandler struct is allocated and initialised for the event-
 *	  fd(2), registering interest for TCL_READABLE on it via Platform-
 *	  EventsControl().
 *	- readyEvents and maxReadyEvents are initialised with 512 kevents.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsInit(
PlatformEventsInit(void)
	void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int i, fdFl;
    FileHandler *filePtr;

    errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
    if (errno) {
400
401
402
403
404
405
406
407
408


409
410
411
412
413
414
415
411
412
413
414
415
416
417


418
419
420
421
422
423
424
425
426







-
-
+
+







    }
    filePtr = ckalloc(sizeof(*filePtr));
    filePtr->fd = tsdPtr->triggerPipe[0];
    filePtr->mask = TCL_READABLE;
    PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1);
    if (!tsdPtr->readyEvents) {
        tsdPtr->maxReadyEvents = 512;
	tsdPtr->readyEvents = ckalloc(tsdPtr->maxReadyEvents
	    * sizeof(tsdPtr->readyEvents[0]));
	tsdPtr->readyEvents = ckalloc(
		tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------
 *
425
426
427
428
429
430
431
432

433
434
435
436
437
438
439
436
437
438
439
440
441
442

443
444
445
446
447
448
449
450







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsTranslate(
	struct kevent *eventPtr)
    struct kevent *eventPtr)
{
    int mask;

    mask = 0;
    if (eventPtr->filter == EVFILT_READ) {
	mask |= TCL_READABLE;
	if (eventPtr->flags & EV_ERROR) {
450
451
452
453
454
455
456
457
458


459
460
461
462
463


464
465
466
467
468
469
470





471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490



491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508


509
510
511
512


513
514
515
516
517

518
519
520


521
522
523
524
525
526
527
461
462
463
464
465
466
467


468
469
470
471
472


473
474
475
476





477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498



499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517


518
519
520
521
522

523
524
525
526
527
528

529
530


531
532
533
534
535
536
537
538
539







-
-
+
+



-
-
+
+


-
-
-
-
-
+
+
+
+
+

















-
-
-
+
+
+
















-
-
+
+



-
+
+




-
+

-
-
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsWait --
 *
 *	This function abstracts waiting for I/O events via the kevent
 *	system call.
 *	This function abstracts waiting for I/O events via the kevent system
 *	call.
 *
 * Results:
 *	Returns -1 if kevent failed. Returns 0 if polling and if no events
 *	became available whilst polling. Returns a pointer to and the count
 *	of all returned events in all other cases.
 *	became available whilst polling. Returns a pointer to and the count of
 *	all returned events in all other cases.
 *
 * Side effects:
 *	gettimeofday(2), kevent(2), and gettimeofday(2) are called,
 *	in the specified order.
 *	If timePtr specifies a positive value, it is updated to reflect
 *	the amount of time that has passed; if its value would {under,
 *	over}flow, it is set to zero.
 *	gettimeofday(2), kevent(2), and gettimeofday(2) are called, in the
 *	specified order.
 *	If timePtr specifies a positive value, it is updated to reflect the
 *	amount of time that has passed; if its value would {under, over}flow,
 *	it is set to zero.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsWait(
    struct kevent *events,
    size_t numEvents,
    struct timeval *timePtr)
{
    int numFound;
    struct timeval tv0, tv1, tv_delta;
    struct timespec timeout, *timeoutPtr;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * If timePtr is NULL, kevent(2) will wait indefinitely. If it speci-
     * fies a timeout of {0,0}, kevent(2) will poll. Otherwise, the time-
     * out will simply be converted to a timespec.
     * If timePtr is NULL, kevent(2) will wait indefinitely. If it specifies a
     * timeout of {0,0}, kevent(2) will poll. Otherwise, the timeout will
     * simply be converted to a timespec.
     */

    if (!timePtr) {
	timeoutPtr = NULL;
    } else if (!timePtr->tv_sec && !timePtr->tv_usec) {
	timeout.tv_sec = 0;
	timeout.tv_nsec = 0;
	timeoutPtr = &timeout;
    } else {
	timeout.tv_sec = timePtr->tv_sec;
	timeout.tv_nsec = timePtr->tv_usec * 1000;
	timeoutPtr = &timeout;
    }

    /*
     * Call (and possibly block on) kevent(2) and substract the delta of
     * gettimeofday(2) before and after the call from timePtr if the latter
     * is not NULL. Return the number of events returned by kevent(2).
     * gettimeofday(2) before and after the call from timePtr if the latter is
     * not NULL. Return the number of events returned by kevent(2).
     */

    gettimeofday(&tv0, NULL);
    numFound = kevent(tsdPtr->eventsFd, NULL, 0, events, (int)numEvents, timeoutPtr);
    numFound = kevent(tsdPtr->eventsFd, NULL, 0, events, (int) numEvents,
	    timeoutPtr);
    gettimeofday(&tv1, NULL);
    if (timePtr && (timePtr->tv_sec && timePtr->tv_usec)) {
	timersub(&tv1, &tv0, &tv_delta);
	if (!timercmp(&tv_delta, timePtr, >)) {
		timersub(timePtr, &tv_delta, timePtr);
	    timersub(timePtr, &tv_delta, timePtr);
	} else {
		timePtr->tv_sec = 0;
		timePtr->tv_usec = 0;
	    timePtr->tv_sec = 0;
	    timePtr->tv_usec = 0;
	}
    }
    return numFound;
}

/*
 *----------------------------------------------------------------------
586
587
588
589
590
591
592
593
594


595
596
597
598
599
600
601
598
599
600
601
602
603
604


605
606
607
608
609
610
611
612
613







-
-
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	Cancel a previously-arranged callback arrangement for a file on
 *	the kqueue of the thread of the caller.
 *	Cancel a previously-arranged callback arrangement for a file on the
 *	kqueue of the thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If a callback was previously registered on file, remove it.
 *	PlatformEventsControl() is called for the file handler structure.
657
658
659
660
661
662
663

664
665
666
667
668
669
670
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683







+







 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	This function is called by Tcl_DoOneEvent to wait for new events on
 *	the message queue. If the block time is 0, then Tcl_WaitForEvent just
 *	polls without blocking.
 *
 *	The waiting logic is implemented in PlatformEventsWait.
 *
 * Results:
 *	Returns -1 if PlatformEventsWait() would block forever, otherwise
 *	returns 0.
 *
 * Side effects:
722
723
724
725
726
727
728

729
730
731
732
733





734
735
736
737
738
739
740
735
736
737
738
739
740
741
742
743




744
745
746
747
748
749
750
751
752
753
754
755







+

-
-
-
-
+
+
+
+
+







	    timeoutPtr = NULL;
	}

	/*
	 * Walk the list of FileHandlers associated with regular files
	 * (S_IFREG) belonging to tsdPtr, queue Tcl events for them, and
	 * update their mask of events of interest.
	 *
	 * kqueue(2), unlike epoll(7), does support regular files, but
	 * EVFILT_READ only `[r]eturns when the file pointer is not at
	 * the end of file' as opposed to unconditionally. While FreeBSD
	 * 11.0-RELEASE adds support for this mode (NOTE_FILE_POLL,) this
	 * is not used for reasons of compatibility.
	 * EVFILT_READ only `[r]eturns when the file pointer is not at the end
	 * of file' as opposed to unconditionally. While FreeBSD 11.0-RELEASE
	 * adds support for this mode (NOTE_FILE_POLL,) this is not used for
	 * reasons of compatibility.
	 *
	 * Therefore, the behaviour of {select,poll}(2) is simply simulated
	 * here: fds associated with regular files are added to this list by
	 * PlatformEventsControl() and processed here before calling (and
	 * possibly blocking) on PlatformEventsWait().
	 */

	numQueued = 0;
750
751
752
753
754
755
756
757

758
759
760
761
762
763
764
765
766
767
768
769
770
771

772
773
774
775
776
777
778
779







-
+







	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
		    ckalloc(sizeof(FileHandlerEvent));
			ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
		numQueued++;
	    }
	    filePtr->readyMask = mask;
784
785
786
787
788
789
790
791


792
793


794
795
796
797
798
799
800



801
802

803
804
805

806
807
808
809
810
811
812
813
799
800
801
802
803
804
805

806
807
808

809
810
811
812
813




814
815
816


817



818

819
820
821
822
823
824
825







-
+
+

-
+
+



-
-
-
-
+
+
+
-
-
+
-
-
-
+
-







	 * Events for the trigger pipe are processed here in order to facilitate
	 * inter-thread IPC. If another thread intends to wake up this thread
	 * whilst it's blocking on PlatformEventsWait(), it write(2)s to the
	 * other end of the pipe (see Tcl_AlertNotifier(),) which in turn will
	 * cause PlatformEventsWait() to return immediately.
	 */

	numFound = PlatformEventsWait(tsdPtr->readyEvents, tsdPtr->maxReadyEvents, timeoutPtr);
	numFound = PlatformEventsWait(tsdPtr->readyEvents,
		tsdPtr->maxReadyEvents, timeoutPtr);
	for (numEvent = 0; numEvent < numFound; numEvent++) {
	    pedPtr = (struct PlatformEventData *)tsdPtr->readyEvents[numEvent].udata;
	    pedPtr = (struct PlatformEventData *)
		    tsdPtr->readyEvents[numEvent].udata;
	    filePtr = pedPtr->filePtr;
	    mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]);
	    if (filePtr->fd == tsdPtr->triggerPipe[0]) {
		do {
		    i = read(tsdPtr->triggerPipe[0], buf, 1);
		    if ((i == -1) && (errno != EAGAIN)) {
			Tcl_Panic("Tcl_WaitForEvent: "
		i = read(tsdPtr->triggerPipe[0], buf, 1);
		if ((i == -1) && (errno != EAGAIN)) {
		    Tcl_Panic("Tcl_WaitForEvent: read from %p->triggerPipe: %s",
				"read from %p->triggerPipe: %s",
				(void *)tsdPtr, strerror(errno));
			    (void *) tsdPtr, strerror(errno));
		    } else {
			break;
		    }
		}
		} while (1);
		continue;
	    }
	    if (!mask) {
		continue;
	    }

	    /*
825
826
827
828
829
830
831

832
833
834
835
836
837
838
839
840
841
842
837
838
839
840
841
842
843
844
845


846
847
848
849
850
851
852
853







+

-
-








	    }
	    filePtr->readyMask |= mask;
	}
	return 0;
    }
}

#endif /* NOTIFIER_KQUEUE && TCL_THREADS */
#endif /* !HAVE_COREFOUNDATION */

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

Changes to unix/tclSelectNotfy.c.

1
2
3
4
5
6



7
8
9
10
11
12
13
14
15
16
17
18


19
20
21
22
23
24
25
1
2
3



4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22
23
24
25



-
-
-
+
+
+







-
-



+
+







/*
 * tclSelectNotfy.c --
 *
 *	This file contains the implementation of the select()-based
 *	generic Unix notifier, which is the lowest-level part of the
 *	Tcl event loop. This file works together with generic/tclNotify.c.
 *	This file contains the implementation of the select()-based generic
 *	Unix notifier, which is the lowest-level part of the Tcl event loop.
 *	This file works together with generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#if !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#if (!defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)) || !TCL_THREADS

#include <signal.h>

/*
 * This structure is used to keep track of the notifier info for a registered
 * file.
 */

77
78
79
80
81
82
83
84

85
86
87
88
89
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
77
78
79
80
81
82
83

84
85
86
87
88
89
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







-
+












-
-
-
+
+
+






-
+
+








-
+







				 * to Tcl_CreateFileHandler. */
    SelectMasks readyMasks;	/* This array reflects the readable/writable
				 * conditions that were found to exist by the
				 * last call to select. */
    int numFdBits;		/* Number of valid bits in checkMasks (one
				 * more than highest fd for which
				 * Tcl_WatchFile has been called). */
#ifdef TCL_THREADS
#if TCL_THREADS
    int onList;			/* True if it is in this list */
    unsigned int pollState;	/* pollState is used to implement a polling
				 * handshake between each thread and the
				 * notifier thread. Bits defined below. */
    struct ThreadSpecificData *nextPtr, *prevPtr;
				/* All threads that are currently waiting on
				 * an event have their ThreadSpecificData
				 * structure on a doubly-linked listed formed
				 * from these pointers. You must hold the
				 * notifierMutex lock before accessing these
				 * fields. */
#ifdef __CYGWIN__
    void *event;     /* Any other thread alerts a notifier
	 * that an event is ready to be processed
	 * by sending this event. */
    void *event;		/* Any other thread alerts a notifier that an
				 * event is ready to be processed by sending
				 * this event. */
    void *hwnd;			/* Messaging window. */
#else /* !__CYGWIN__ */
    pthread_cond_t waitCV;	/* Any other thread alerts a notifier that an
				 * event is ready to be processed by signaling
				 * this condition variable. */
#endif /* __CYGWIN__ */
    int waitCVinitialized;	/* Variable to flag initialization of the structure */
    int waitCVinitialized;	/* Variable to flag initialization of the
				 * structure. */
    int eventReady;		/* True if an event is ready to be processed.
				 * Used as condition flag together with waitCV
				 * above. */
#endif /* TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

#ifdef TCL_THREADS
#if TCL_THREADS
/*
 * The following static indicates the number of threads that have initialized
 * notifiers.
 *
 * You must hold the notifierMutex lock before accessing this variable.
 */

167
168
169
170
171
172
173
174
175
176
177
178
179








180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196

197
198
199
200


201
202
203

204
205
206

207
208
209

210
211
212
213
214
215
216






217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237



238
239
240
241
242
243
244
168
169
170
171
172
173
174






175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198

199
200
201


202
203
204
205

206
207
208

209
210
211

212
213






214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238


239
240
241
242
243
244
245
246
247
248







-
-
-
-
-
-
+
+
+
+
+
+
+
+
















-
+


-
-
+
+


-
+


-
+


-
+

-
-
-
-
-
-
+
+
+
+
+
+



















-
-
+
+
+







 * initializing the triggerPipe and right before the notifier thread
 * terminates.
 */

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.
 * 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

/*
 * This is the thread ID of the notifier thread that does select.
 */

static Tcl_ThreadId notifierThread;
#endif /* TCL_THREADS */

/*
 * Static routines defined in this file.
 */

#ifdef TCL_THREADS
#if TCL_THREADS
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static int	atForkInit = 0;
static void	AtForkChild(void);
static int atForkInit = 0;
static void		AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);
static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);

/*
 * Import of Windows API when building threaded with Cygwin.
 * Import of critical bits of Windows API when building threaded with Cygwin.
 */

#if defined(TCL_THREADS) && defined(__CYGWIN__)
#if defined(__CYGWIN__)
typedef struct {
    void *hwnd;
    unsigned int *message;
    int wParam;
    int lParam;
    int time;
    int x;
    void *hwnd;			/* Messaging window. */
    unsigned int *message;	/* Message payload. */
    int wParam;			/* Event-specific "word" parameter. */
    int lParam;			/* Event-specific "long" parameter. */
    int time;			/* Event timestamp. */
    int x;			/* Event location (where meaningful). */
    int y;
} MSG;

typedef struct {
    unsigned int style;
    void *lpfnWndProc;
    int cbClsExtra;
    int cbWndExtra;
    void *hInstance;
    void *hIcon;
    void *hCursor;
    void *hbrBackground;
    void *lpszMenuName;
    const void *lpszClassName;
} WNDCLASS;

extern void __stdcall	CloseHandle(void *);
extern void *__stdcall	CreateEventW(void *, unsigned char, unsigned char,
			    void *);
extern void * __stdcall	CreateWindowExW(void *, const void *, const void *,
			    DWORD, int, int, int, int, void *, void *, void *, void *);
extern void *__stdcall	CreateWindowExW(void *, const void *, const void *,
			    DWORD, int, int, int, int, void *, void *, void *,
			    void *);
extern DWORD __stdcall	DefWindowProcW(void *, int, void *, void *);
extern unsigned char __stdcall	DestroyWindow(void *);
extern int __stdcall	DispatchMessageW(const MSG *);
extern unsigned char __stdcall	GetMessageW(MSG *, void *, int, int);
extern void __stdcall	MsgWaitForMultipleObjects(DWORD, void *,
			    unsigned char, DWORD, DWORD);
extern unsigned char __stdcall	PeekMessageW(MSG *, void *, int, int, int);
281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
285
286
287
288
289
290
291

292
293
294
295
296
297
298
299







-
+







Tcl_InitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#ifdef TCL_THREADS
#if TCL_THREADS
	tsdPtr->eventReady = 0;

	/*
	 * Initialize thread specific condition variable for this thread.
	 */
	if (tsdPtr->waitCVinitialized == 0) {
#ifdef __CYGWIN__
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
336
337
338
339
340
341
342

343
344
345
346
347
348
349







-







		Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
	    }
	    atForkInit = 1;
	}
#endif /* HAVE_PTHREAD_ATFORK */

	notifierCount++;

	pthread_mutex_unlock(&notifierInitMutex);

#endif /* TCL_THREADS */
	return tsdPtr;
    }
}

366
367
368
369
370
371
372
373

374
375
376
377
378
379
380
381
382
383
384

385
386
387
388
389
390
391
392
393
394
395
396
397
398












399
400
401
402
403
404





405
406
407
408
409
410
411
412
369
370
371
372
373
374
375

376
377
378
379
380
381
382
383
384
385
386

387














388
389
390
391
392
393
394
395
396
397
398
399
400





401
402
403
404
405

406
407
408
409
410
411
412







-
+










-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
-







Tcl_FinalizeNotifier(
    ClientData clientData)		/* Not used. */
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
#ifdef TCL_THREADS
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	pthread_mutex_lock(&notifierInitMutex);
	notifierCount--;

	/*
	 * If this is the last thread to use the notifier, close the notifier
	 * pipe and wait for the background thread to terminate.
	 */

	if (notifierCount == 0) {
	if (notifierCount == 0 && triggerPipe != -1) {

	    if (triggerPipe != -1) {
		if (write(triggerPipe, "q", 1) != 1) {
		    Tcl_Panic("Tcl_FinalizeNotifier: %s",
			    "unable to write q to triggerPipe");
		}
		close(triggerPipe);
		pthread_mutex_lock(&notifierMutex);
		while(triggerPipe != -1) {
		    pthread_cond_wait(&notifierCV, &notifierMutex);
		}
		pthread_mutex_unlock(&notifierMutex);
		if (notifierThreadRunning) {
		    int result = pthread_join((pthread_t) notifierThread, NULL);
	    if (write(triggerPipe, "q", 1) != 1) {
		Tcl_Panic("Tcl_FinalizeNotifier: %s",
			"unable to write 'q' to triggerPipe");
	    }
	    close(triggerPipe);
	    pthread_mutex_lock(&notifierMutex);
	    while(triggerPipe != -1) {
		pthread_cond_wait(&notifierCV, &notifierMutex);
	    }
	    pthread_mutex_unlock(&notifierMutex);
	    if (notifierThreadRunning) {
		int result = pthread_join((pthread_t) notifierThread, NULL);

		    if (result) {
			Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier "
				"thread");
		    }
		    notifierThreadRunning = 0;
		if (result) {
		    Tcl_Panic("Tcl_FinalizeNotifier: %s",
			    "unable to join notifier thread");
		}
		notifierThreadRunning = 0;
		}
	    }
	}

	/*
	 * Clean up any synchronization objects in the thread local storage.
	 */

583
584
585
586
587
588
589
590

591
592
593
594
595
596
597
583
584
585
586
587
588
589

590
591
592
593
594
595
596
597







-
+







	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	ckfree(filePtr);
    }
}

#if defined(TCL_THREADS) && defined(__CYGWIN__)
#if defined(__CYGWIN__)

static DWORD __stdcall
NotifierProc(
    void *hwnd,
    unsigned int message,
    void *wParam,
    void *lParam)
636
637
638
639
640
641
642
643

644
645
646
647
648

649
650
651
652
653
654
655
636
637
638
639
640
641
642

643
644
645
646
647

648
649
650
651
652
653
654
655







-
+




-
+







{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
#ifdef TCL_THREADS
#if TCL_THREADS
	int waitForFiles;
#   ifdef __CYGWIN__
	MSG msg;
#   endif /* __CYGWIN__ */
#else
#else /* !TCL_THREADS */
	/*
	 * Impl. notes: timeout & timeoutPtr are used if, and only if threads
	 * are not enabled. They are the arguments for the regular select()
	 * used when the core is not thread-enabled.
	 */

	struct timeval timeout, *timeoutPtr;
671
672
673
674
675
676
677
678

679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697

698
699
700
701
702
703
704
671
672
673
674
675
676
677

678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696

697
698
699
700
701
702
703
704







-
+


















-
+







	     */

	    if (timePtr->sec != 0 || timePtr->usec != 0) {
		vTime = *timePtr;
		tclScaleTimeProcPtr(&vTime, tclTimeClientData);
		timePtr = &vTime;
	    }
#ifndef TCL_THREADS
#if !TCL_THREADS
	    timeout.tv_sec = timePtr->sec;
	    timeout.tv_usec = timePtr->usec;
	    timeoutPtr = &timeout;
	} else if (tsdPtr->numFdBits == 0) {
	    /*
	     * If there are no threads, no timeout, and no fds registered,
	     * then there are no events possible and we must avoid deadlock.
	     * Note that this is not entirely correct because there might be a
	     * signal that could interrupt the select call, but we don't
	     * handle that case if we aren't using threads.
	     */

	    return -1;
	} else {
	    timeoutPtr = NULL;
#endif /* !TCL_THREADS */
	}

#ifdef TCL_THREADS
#if TCL_THREADS
	/*
	 * Start notifier thread and place this thread on the list of
	 * interested threads, signal the notifier thread, and wait for a
	 * response or a timeout.
	 */
	StartNotifierThread("Tcl_WaitForEvent");

767
768
769
770
771
772
773
774

775
776
777


778
779
780
781




782
783

784
785

786
787
788
789
790
791
792
767
768
769
770
771
772
773

774
775


776
777
778



779
780
781
782
783

784
785

786
787
788
789
790
791
792
793







-
+

-
-
+
+

-
-
-
+
+
+
+

-
+

-
+







		} else {
		    timeout = 0xFFFFFFFF;
		}
		pthread_mutex_unlock(&notifierMutex);
		MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
		pthread_mutex_lock(&notifierMutex);
	    }
#else
#else /* !__CYGWIN__ */
	    if (timePtr != NULL) {
	       Tcl_Time now;
	       struct timespec ptime;
		Tcl_Time now;
		struct timespec ptime;

	       Tcl_GetTime(&now);
	       ptime.tv_sec = timePtr->sec + now.sec + (timePtr->usec + now.usec) / 1000000;
	       ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
		Tcl_GetTime(&now);
		ptime.tv_sec = timePtr->sec + now.sec +
			(timePtr->usec + now.usec) / 1000000;
		ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);

	       pthread_cond_timedwait(&tsdPtr->waitCV, &notifierMutex, &ptime);
		pthread_cond_timedwait(&tsdPtr->waitCV, &notifierMutex, &ptime);
	    } else {
	       pthread_cond_wait(&tsdPtr->waitCV, &notifierMutex);
		pthread_cond_wait(&tsdPtr->waitCV, &notifierMutex);
	    }
#endif /* __CYGWIN__ */
	}
	tsdPtr->eventReady = 0;

#ifdef __CYGWIN__
	while (PeekMessageW(&msg, NULL, 0, 0, 0)) {
826
827
828
829
830
831
832
833
834

835
836
837
838
839
840
841
827
828
829
830
831
832
833


834
835
836
837
838
839
840
841







-
-
+







	    tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
	    tsdPtr->onList = 0;
	    if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
		Tcl_Panic("Tcl_WaitForEvent: %s",
			"unable to write to triggerPipe");
	    }
	}

#else
#else /* !TCL_THREADS */
	tsdPtr->readyMasks = tsdPtr->checkMasks;
	numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable,
		&tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception,
		timeoutPtr);

	/*
	 * Some systems don't clear the masks after an error, so we have to do
881
882
883
884
885
886
887
888

889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
881
882
883
884
885
886
887

888
889
890
891
892
893
894


895
896
897
898
899
900
901







-
+






-
-








		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;
	}
#ifdef TCL_THREADS
#if TCL_THREADS
	pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
	return 0;
    }
}

#ifdef TCL_THREADS

/*
 *----------------------------------------------------------------------
 *
 * NotifierThreadProc --
 *
 *	This routine is the initial (and only) function executed by the
 *	special notifier thread. Its job is to wait for file descriptors to
914
915
916
917
918
919
920

921
922
923
924
925
926
927
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926







+







 * Side effects:
 *	The trigger pipe used to signal the notifier thread is created when
 *	the notifier thread first starts.
 *
 *----------------------------------------------------------------------
 */

#if TCL_THREADS
static TCL_NORETURN void
NotifierThreadProc(
    ClientData clientData)	/* Not used. */
{
    ThreadSpecificData *tsdPtr;
    fd_set readableMask;
    fd_set writableMask;
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106


1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1096
1097
1098
1099
1100
1101
1102

1103

1104
1105
1106


1107
1108
1109
1110
1111
1112
1113
1114







-

-
+
+

-
-








    pthread_mutex_lock(&notifierMutex);
    triggerPipe = -1;
    pthread_cond_broadcast(&notifierCV);
    pthread_mutex_unlock(&notifierMutex);

    TclpThreadExit(0);
}

#endif /* TCL_THREADS */


#endif /* (!NOTIFIER_EPOLL && !NOTIFIER_KQUEUE) || !TCL_THREADS */
#endif /* !HAVE_COREFOUNDATION */

#endif /* !NOTIFIER_EPOLL && !NOTIFIER_KQUEUE */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclUnixChan.c.

379
380
381
382
383
384
385
386

387
388
389
390
391
392
393
394
395
396
397
398
399
400
401

402
403
404
405
406

407
408

409
410
411
412
413
414
415
379
380
381
382
383
384
385

386
387
388
389
390
391
392
393
394
395
396
397
398
399
400

401
402
403
404
405

406
407

408
409
410
411
412
413
414
415







-
+














-
+




-
+

-
+







    Tcl_WideInt oldLoc, newLoc;

    /*
     * Save our current place in case we need to roll-back the seek.
     */

    oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
    if (oldLoc == Tcl_LongAsWide(-1)) {
    if (oldLoc == -1) {
	/*
	 * Bad things are happening. Error out...
	 */

	*errorCodePtr = errno;
	return -1;
    }

    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);

    /*
     * Check for expressability in our return type, and roll-back otherwise.
     */

    if (newLoc > Tcl_LongAsWide(INT_MAX)) {
    if (newLoc > INT_MAX) {
	*errorCodePtr = EOVERFLOW;
	TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
	return -1;
    } else {
	*errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
	*errorCodePtr = (newLoc == -1) ? errno : 0;
    }
    return (int) Tcl_WideAsLong(newLoc);
    return (int) newLoc;
}

/*
 *----------------------------------------------------------------------
 *
 * FileWideSeekProc --
 *

Changes to unix/tclUnixCompat.c.

43
44
45
46
47
48
49
50

51
52
53
54
55
56
57
43
44
45
46
47
48
49

50
51
52
53
54
55
56
57







-
+







    }

/*
 * Per-thread private storage used to store values returned from MT-unsafe
 * library calls.
 */

#ifdef TCL_THREADS
#if TCL_THREADS

typedef struct {
    struct passwd pwd;
#if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5)
#define NEED_PW_CLEANER 1
    char *pbuf;
    int pbuflen;
178
179
180
181
182
183
184
185

186
187
188
189
190
191
192
178
179
180
181
182
183
184

185
186
187
188
189
190
191
192







-
+







 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwNam(
    const char *name)
{
#if !defined(TCL_THREADS)
#if !TCL_THREADS
    return getpwnam(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETPWNAM_R_5)
    struct passwd *pwPtr = NULL;

258
259
260
261
262
263
264
265

266
267
268
269
270
271
272
258
259
260
261
262
263
264

265
266
267
268
269
270
271
272







-
+







 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwUid(
    uid_t uid)
{
#if !defined(TCL_THREADS)
#if !TCL_THREADS
    return getpwuid(uid);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETPWUID_R_5)
    struct passwd *pwPtr = NULL;

361
362
363
364
365
366
367
368

369
370
371
372
373
374
375
361
362
363
364
365
366
367

368
369
370
371
372
373
374
375







-
+







 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrNam(
    const char *name)
{
#if !defined(TCL_THREADS)
#if !TCL_THREADS
    return getgrnam(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETGRNAM_R_5)
    struct group *grPtr = NULL;

441
442
443
444
445
446
447
448

449
450
451
452
453
454
455
441
442
443
444
445
446
447

448
449
450
451
452
453
454
455







-
+







 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrGid(
    gid_t gid)
{
#if !defined(TCL_THREADS)
#if !TCL_THREADS
    return getgrgid(gid);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETGRGID_R_5)
    struct group *grPtr = NULL;

544
545
546
547
548
549
550
551

552
553
554
555
556
557
558
544
545
546
547
548
549
550

551
552
553
554
555
556
557
558







-
+







 *---------------------------------------------------------------------------
 */

struct hostent *
TclpGetHostByName(
    const char *name)
{
#if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYNAME)
#if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYNAME)
    return gethostbyname(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETHOSTBYNAME_R_5)
    int h_errno;

614
615
616
617
618
619
620
621

622
623
624
625
626
627
628
614
615
616
617
618
619
620

621
622
623
624
625
626
627
628







-
+








struct hostent *
TclpGetHostByAddr(
    const char *addr,
    int length,
    int type)
{
#if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYADDR)
#if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYADDR)
    return gethostbyaddr(addr, length, type);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETHOSTBYADDR_R_7)
    int h_errno;

Changes to unix/tclUnixFCmd.c.

252
253
254
255
256
257
258
259

260
261
262
263
264
265
266
252
253
254
255
256
257
258

259
260
261
262
263
264
265
266







-
+







    return realpath(path, resolved);
}
#else
#   define Realpath	realpath
#endif /* PURIFY */

#ifndef NO_REALPATH
#if defined(__APPLE__) && defined(TCL_THREADS) && \
#if defined(__APPLE__) && TCL_THREADS && \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
	MAC_OS_X_VERSION_MIN_REQUIRED < 1030
/*
 * Prior to Darwin 7, realpath is not thread-safe, c.f. Bug 711232; if we
 * might potentially be running on pre-10.3 OSX, check Darwin release at
 * runtime before using realpath.
 */
365
366
367
368
369
370
371
372

373
374
375
376
377
378

379
380
381
382
383
384
385
386
387
388

389
390
391
392

393
394
395
396
397
398
399
365
366
367
368
369
370
371

372
373
374
375
376
377

378
379
380
381
382
383
384
385
386
387

388
389
390
391

392
393
394
395
396
397
398
399







-
+





-
+









-
+



-
+







     * as EINVAL instead of EEXIST (first rule out the correct EINVAL result
     * code for moving a directory into itself). Must be conditionally
     * compiled because realpath() not defined on all systems.
     */

    if (errno == EINVAL && haveRealpath) {
	char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN];
	DIR *dirPtr;
	TclDIR *dirPtr;
	Tcl_DirEntry *dirEntPtr;

	if ((Realpath((char *) src, srcPath) != NULL)	/* INTL: Native. */
		&& (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native */
		&& (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
	    dirPtr = opendir(dst);			/* INTL: Native. */
	    dirPtr = TclOSopendir(dst);			/* INTL: Native. */
	    if (dirPtr != NULL) {
		while (1) {
		    dirEntPtr = TclOSreaddir(dirPtr);	/* INTL: Native. */
		    if (dirEntPtr == NULL) {
			break;
		    }
		    if ((strcmp(dirEntPtr->d_name, ".") != 0) &&
			    (strcmp(dirEntPtr->d_name, "..") != 0)) {
			errno = EEXIST;
			closedir(dirPtr);
			TclOSclosedir(dirPtr);
			return TCL_ERROR;
		    }
		}
		closedir(dirPtr);
		TclOSclosedir(dirPtr);
	    }
	}
	errno = EINVAL;
    }
#endif	/* !NO_REALPATH */

    if (strcmp(src, "/") == 0) {
961
962
963
964
965
966
967
968

969
970
971
972
973
974
975
961
962
963
964
965
966
967

968
969
970
971
972
973
974
975







-
+







    Tcl_StatBuf statBuf;
    const char *source, *errfile;
    int result, sourceLen;
    int targetLen;
#ifndef HAVE_FTS
    int numProcessed = 0;
    Tcl_DirEntry *dirEntPtr;
    DIR *dirPtr;
    TclDIR *dirPtr;
#else
    const char *paths[2] = {NULL, NULL};
    FTS *fts = NULL;
    FTSENT *ent;
#endif

    errfile = NULL;
986
987
988
989
990
991
992
993

994
995
996
997
998
999
1000
1001
1002
1003
1004
1005

1006
1007
1008
1009
1010
1011
1012
986
987
988
989
990
991
992

993
994
995
996
997
998
999
1000
1001
1002
1003
1004

1005
1006
1007
1008
1009
1010
1011
1012







-
+











-
+







	 * Process the regular file
	 */

	return traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_F,
		errorPtr);
    }
#ifndef HAVE_FTS
    dirPtr = opendir(source);				/* INTL: Native. */
    dirPtr = TclOSopendir(source);			/* INTL: Native. */
    if (dirPtr == NULL) {
	/*
	 * Can't read directory
	 */

	errfile = source;
	goto end;
    }
    result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_PRED,
	    errorPtr);
    if (result != TCL_OK) {
	closedir(dirPtr);
	TclOSclosedir(dirPtr);
	return result;
    }

    TclDStringAppendLiteral(sourcePtr, "/");
    sourceLen = Tcl_DStringLength(sourcePtr);

    if (targetPtr != NULL) {
1048
1049
1050
1051
1052
1053
1054
1055

1056
1057
1058
1059

1060
1061
1062
1063
1064
1065
1066
1048
1049
1050
1051
1052
1053
1054

1055
1056
1057
1058

1059
1060
1061
1062
1063
1064
1065
1066







-
+



-
+







	if (doRewind && (numProcessed > MAX_READDIR_UNLINK_THRESHOLD)) {
	    /*
	     * Call rewinddir if we've called unlink or rmdir so many times
	     * (since the opendir or the previous rewinddir), to avoid a
	     * NULL-return that may a symptom of a buggy readdir.
	     */

	    rewinddir(dirPtr);
	    TclOSrewinddir(dirPtr);
	    numProcessed = 0;
	}
    }
    closedir(dirPtr);
    TclOSclosedir(dirPtr);

    /*
     * Strip off the trailing slash we added
     */

    Tcl_DStringSetLength(sourcePtr, sourceLen - 1);
    if (targetPtr != NULL) {
2298
2299
2300
2301
2302
2303
2304
2305


2306
2307
2308
2309
2310
2311
2312
2298
2299
2300
2301
2302
2303
2304

2305
2306
2307
2308
2309
2310
2311
2312
2313







-
+
+







    winPath = ckalloc(size);
    cygwin_conv_path(1, native, winPath, size);

    return winPath;
}

static const int attributeArray[] = {
    0x20, 0, 2, 0, 0, 1, 4};
    0x20, 0, 2, 0, 0, 1, 4
};

/*
 *----------------------------------------------------------------------
 *
 * GetUnixFileAttributes
 *
 *	Gets the readonly attribute of a file.
2335
2336
2337
2338
2339
2340
2341
2342
2343


2344
2345
2346
2347
2348
2349
2350
2336
2337
2338
2339
2340
2341
2342


2343
2344
2345
2346
2347
2348
2349
2350
2351







-
-
+
+







    ckfree(winPath);

    if (fileAttributes == -1) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewIntObj((fileAttributes&attributeArray[objIndex])!=0);

    *attributePtrPtr = Tcl_NewIntObj(
	    (fileAttributes & attributeArray[objIndex]) != 0);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes
2393
2394
2395
2396
2397
2398
2399
2400

2401
2402
2403
2404
2405
2406
2407
2394
2395
2396
2397
2398
2399
2400

2401
2402
2403
2404
2405
2406
2407
2408







-
+







    if ((fileAttributes != old)
	    && !SetFileAttributesW(winPath, fileAttributes)) {
	ckfree(winPath);
	StatError(interp, fileName);
	return TCL_ERROR;
    }

	ckfree(winPath);
    ckfree(winPath);
    return TCL_OK;
}
#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
/*
 *----------------------------------------------------------------------
 *
 * GetUnixFileAttributes
2435
2436
2437
2438
2439
2440
2441
2442

2443
2444
2445
2446
2447
2448
2449
2450
2436
2437
2438
2439
2440
2441
2442

2443

2444
2445
2446
2447
2448
2449
2450







-
+
-







	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags&UF_IMMUTABLE);
    *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags & UF_IMMUTABLE);

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes

Changes to unix/tclUnixFile.c.

255
256
257
258
259
260
261
262

263
264
265
266
267
268
269
255
256
257
258
259
260
261

262
263
264
265
266
267
268
269







-
+







	matchResult = NativeMatchType(interp, native, nativeTail, types);
	if (matchResult == 1) {
	    Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	}
	Tcl_DecrRefCount(tailPtr);
	Tcl_DecrRefCount(fileNamePtr);
    } else {
	DIR *d;
	TclDIR *d;
	Tcl_DirEntry *entryPtr;
	const char *dirName;
	size_t dirLength, nativeDirLen;
	int matchHidden, matchHiddenPat;
	Tcl_StatBuf statBuf;
	Tcl_DString ds;		/* native encoding of dir */
	Tcl_DString dsOrig;	/* utf-8 encoding of dir */
306
307
308
309
310
311
312
313

314
315
316
317
318
319
320
306
307
308
309
310
311
312

313
314
315
316
317
318
319
320







-
+







		|| !S_ISDIR(statBuf.st_mode)) {
	    Tcl_DStringFree(&dsOrig);
	    Tcl_DStringFree(&ds);
	    Tcl_DecrRefCount(fileNamePtr);
	    return TCL_OK;
	}

	d = opendir(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",
			Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
	    }
384
385
386
387
388
389
390
391

392
393
394
395
396
397
398
384
385
386
387
388
389
390

391
392
393
394
395
396
397
398







-
+







	    }
	    Tcl_DStringFree(&utfDs);
	    if (matchResult < 0) {
		break;
	    }
	}

	closedir(d);
	TclOSclosedir(d);
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&dsOrig);
	Tcl_DecrRefCount(fileNamePtr);
    }
    if (matchResult < 0) {
	return TCL_ERROR;
    }

Changes to unix/tclUnixInit.c.

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
35
36
37
38
39
40
41





42
43
44
45
46
47
48







-
-
-
-
-







#ifdef __CYGWIN__
DLLIMPORT extern __stdcall unsigned char GetVersionExW(void *);
DLLIMPORT extern __stdcall void *GetModuleHandleW(const void *);
DLLIMPORT extern __stdcall void FreeLibrary(void *);
DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *);
DLLIMPORT extern __stdcall void GetSystemInfo(void *);

#define NUMPLATFORMS 4
static const char *const platforms[NUMPLATFORMS] = {
    "Win32s", "Windows 95", "Windows NT", "Windows CE"
};

#define NUMPROCESSORS 11
static const char *const processors[NUMPROCESSORS] = {
    "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "amd64", "ia32_on_win64"
};

typedef struct {
317
318
319
320
321
322
323
324

325
326
327
328
329
330
331
312
313
314
315
316
317
318

319
320
321
322
323
324
325
326







-
+








#ifdef HAVE_COREFOUNDATION
static int		MacOSXGetLibraryPath(Tcl_Interp *interp,
			    int maxPathLen, char *tclLibPath);
#endif /* HAVE_COREFOUNDATION */
#if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && ( \
	(defined(TCL_THREADS) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \
	(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)\
	)))
/*
 * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c:
 * initialize release global at startup from uname().
 */
449
450
451
452
453
454
455
456

457
458
459
460
461
462
463
444
445
446
447
448
449
450

451
452
453
454
455
456
457
458







-
+







 *
 *-------------------------------------------------------------------------
 */

void
TclpInitLibraryPath(
    char **valuePtr,
    size_t *lengthPtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    32
    Tcl_Obj *pathPtr, *objPtr;
    const char *str;
    Tcl_DString buffer;

578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
573
574
575
576
577
578
579






580
581
582
583
584
585
586







-
-
-
-
-
-







{
    Tcl_DString encodingName;
    Tcl_SetSystemEncoding(NULL,
	    Tcl_GetEncodingNameFromEnvironment(&encodingName));
    Tcl_DStringFree(&encodingName);
}

void
TclpSetInterfaces(void)
{
    /* do nothing */
}

static const char *
SearchKnownEncodings(
    const char *encoding)
{
    int left = 0;
    int right = sizeof(localeTable)/sizeof(LocaleTable);

886
887
888
889
890
891
892
893
894

895
896
897
898
899
900
901
902
903
875
876
877
878
879
880
881


882


883
884
885
886
887
888
889







-
-
+
-
-







	    GetVersionExW(&osInfo);
	}
	osInfoInitialized = 1;
    }

    GetSystemInfo(&sysInfo);

    if (osInfo.dwPlatformId < NUMPLATFORMS) {
	Tcl_SetVar2(interp, "tcl_platform", "os",
    Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY);
		platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
    }
    sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
    if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) {
	Tcl_SetVar2(interp, "tcl_platform", "machine",
		processors[sysInfo.wProcessorArchitecture],
		TCL_GLOBAL_ONLY);
    }

Changes to unix/tclUnixNotfy.c.

8
9
10
11
12
13
14

15
16
17
18
19


20
21





22
23
24
25



26
27
28
29
30
31
32
33
34
35
36
37

38
39
40
41
42
43
44
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22


23
24
25
26
27
28



29
30
31



32


33
34
35
36
37

38
39
40
41
42
43
44
45







+





+
+
-
-
+
+
+
+
+

-
-
-
+
+
+
-
-
-

-
-





-
+







 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <[email protected]>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <poll.h>
#include "tclInt.h"

/*
 * Static routines defined in this file.
 */

static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);
#if !TCL_THREADS
#ifdef NOTIFIER_SELECT
#ifdef TCL_THREADS
# undef NOTIFIER_EPOLL
# undef NOTIFIER_KQUEUE
# define NOTIFIER_SELECT
#elif !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)
# define NOTIFIER_SELECT
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static void	AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
# if defined(HAVE_PTHREAD_ATFORK)
static void		AtForkChild(void);
# endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
#endif /* NOTIFIER_SELECT */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);

#ifdef NOTIFIER_SELECT
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * StartNotifierThread --
 *
 *	Start a notfier thread and wait for the notifier pipe to be created.
 *	Start a notifier thread and wait for the notifier pipe to be created.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Running Thread.
 *
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
67
68
69
70
71
72
73

74
75
76
77
78
79
80







-







	    pthread_mutex_unlock(&notifierMutex);

	    notifierThreadRunning = 1;
	}
	pthread_mutex_unlock(&notifierInitMutex);
    }
}
#endif /* TCL_THREADS */
#endif /* NOTIFIER_SELECT */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AlertNotifier --
 *
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
128
129
130

131
132
133
134
135
136

137
138
139
140
141
142
143
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
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143
144







-
+












-
+







+




-

+







    ClientData clientData)
{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    } else {
#ifdef NOTIFIER_SELECT
#ifdef TCL_THREADS
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = clientData;

	pthread_mutex_lock(&notifierMutex);
	tsdPtr->eventReady = 1;

#   ifdef __CYGWIN__
	PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#   else
	pthread_cond_broadcast(&tsdPtr->waitCV);
#   endif /* __CYGWIN__ */
	pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
#else
#else /* !NOTIFIER_SELECT */
	ThreadSpecificData *tsdPtr = clientData;
#if defined(NOTIFIER_EPOLL) && defined(HAVE_EVENTFD)
	uint64_t eventFdVal = 1;
	if (write(tsdPtr->triggerEventFd, &eventFdVal,
		sizeof(eventFdVal)) != sizeof(eventFdVal)) {
	    Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerEventFd",
		(void *)tsdPtr);
	}
#else
	if (write(tsdPtr->triggerPipe[1], "", 1) != 1) {
	    Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerPipe",
		(void *)tsdPtr);
#endif /* NOTIFIER_EPOLL && HAVE_EVENTFD */
	}
#endif /* NOTIFIER_EPOLL && HAVE_EVENTFD */
#endif /* NOTIFIER_SELECT */
    }
}

/*
 *----------------------------------------------------------------------
 *
276
277
278
279
280
281
282
283

284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304

305
306
307
308
309
310
311
312




313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329

330
331
332
333
334
335
336
277
278
279
280
281
282
283

284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304

305
306
307
308
309




310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329

330
331
332
333
334
335
336
337







-
+




















-
+




-
-
-
-
+
+
+
+
















-
+







	}
	break;
    }
    return 1;
}

#ifdef NOTIFIER_SELECT
#ifdef TCL_THREADS
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * AlertSingleThread --
 *
 *	Notify a single thread that is waiting on a file descriptor to become
 *	readable or writable or to have an exception condition.
 *	notifierMutex must be held.
 *
 * Result:
 *	None.
 *
 * Side effects:
 *	The condition variable associated with the thread is broadcasted.
 *
 *----------------------------------------------------------------------
 */

static void
AlertSingleThread(
	ThreadSpecificData *tsdPtr)
    ThreadSpecificData *tsdPtr)
{
    tsdPtr->eventReady = 1;
    if (tsdPtr->onList) {
        /*
         * Remove the ThreadSpecificData structure of this thread
         * from the waiting list. This prevents us from
         * continuously spinning on epoll_wait until the other
         * threads runs and services the file event.
         * Remove the ThreadSpecificData structure of this thread from the
         * waiting list. This prevents us from continuously spinning on
         * epoll_wait until the other threads runs and services the file
         * event.
         */

        if (tsdPtr->prevPtr) {
    	    tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
        } else {
    	    waitingListPtr = tsdPtr->nextPtr;
        }
        if (tsdPtr->nextPtr) {
    	    tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
        }
        tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
        tsdPtr->onList = 0;
        tsdPtr->pollState = 0;
    }
#ifdef __CYGWIN__
    PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#else /* __CYGWIN__ */
#else /* !__CYGWIN__ */
    pthread_cond_broadcast(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
}

#if defined(HAVE_PTHREAD_ATFORK)
/*
 *----------------------------------------------------------------------
355
356
357
358
359
360
361
362


363
364

365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386


387
388
389
390
391
392
393
394

395
396
397

398
399
400
401
402
403
404
356
357
358
359
360
361
362

363
364
365

366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386


387
388
389
390
391
392
393
394
395

396
397
398

399
400
401
402
403
404
405
406







-
+
+

-
+




















-
-
+
+







-
+


-
+







	pthread_cond_destroy(&notifierCV);
    }
    pthread_mutex_init(&notifierInitMutex, NULL);
    pthread_mutex_init(&notifierMutex, NULL);
    pthread_cond_init(&notifierCV, NULL);

    /*
     * notifierThreadRunning == 1: thread is running, (there might be data in notifier lists)
     * notifierThreadRunning == 1: thread is running, (there might be data in
     *		notifier lists)
     * atForkInit == 0: InitNotifier was never called
     * notifierCount != 0: unbalanced  InitNotifier() / FinalizeNotifier calls
     * 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;

	    close(triggerPipe);
	    triggerPipe = -1;
	    /*
	     * The waitingListPtr might contain event info from multiple
	     * threads, which are invalid here, so setting it to NULL is not
	     * unreasonable.
	     */
	    waitingListPtr = NULL;

	    /*
	     * The tsdPtr from before the fork is copied as well.  But since
	     * we are paranoic, we don't trust its condvar and reset it.
	     * The tsdPtr from before the fork is copied as well. But since we
	     * are paranoic, we don't trust its condvar and reset it.
	     */
#ifdef __CYGWIN__
	    DestroyWindow(tsdPtr->hwnd);
	    tsdPtr->hwnd = CreateWindowExW(NULL, className,
		    className, 0, 0, 0, 0, 0, NULL, NULL,
		    TclWinGetTclInstance(), NULL);
	    ResetEvent(tsdPtr->event);
#else
#else /* !__CYGWIN__ */
	    pthread_cond_destroy(&tsdPtr->waitCV);
	    pthread_cond_init(&tsdPtr->waitCV, NULL);
#endif
#endif /* __CYGWIN__ */

	    /*
	     * In case, we had multiple threads running before the fork,
	     * make sure, we don't try to reach out to their thread local data.
	     */
	    tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;

461
462
463
464
465
466
467
468
469


470
471
472
473
474
475
476
463
464
465
466
467
468
469


470
471
472
473
474
475
476
477
478







-
-
+
+







    /*
     * If there is a non-zero finite timeout, compute the time when we give
     * up.
     */

    if (timeout > 0) {
	Tcl_GetTime(&now);
	abortTime.sec = now.sec + timeout/1000;
	abortTime.usec = now.usec + (timeout%1000)*1000;
	abortTime.sec = now.sec + timeout / 1000;
	abortTime.usec = now.usec + (timeout % 1000) * 1000;
	if (abortTime.usec >= 1000000) {
	    abortTime.usec -= 1000000;
	    abortTime.sec += 1;
	}
	timeoutPtr = &blockTime;
    } else if (timeout == 0) {
	timeoutPtr = &blockTime;
497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
499
500
501
502
503
504
505

506
507
508
509
510
511
512
513







-
+







    }

    /*
     * Loop in a mini-event loop of our own, waiting for either the file to
     * become ready or a timeout to occur.
     */

    while (1) {
    do {
	if (timeout > 0) {
	    blockTime.tv_sec = abortTime.sec - now.sec;
	    blockTime.tv_usec = abortTime.usec - now.usec;
	    if (blockTime.tv_usec < 0) {
		blockTime.tv_sec -= 1;
		blockTime.tv_usec += 1000000;
	    }
520
521
522
523
524
525
526
527

528
529

530
531
532
533
534
535

536
537
538

539
540
541

542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564





565
566
567
568
569
570
571
572
573
574
575
522
523
524
525
526
527
528

529
530

531
532
533
534
535
536

537
538
539

540
541
542

543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561





562
563
564
565
566


567
568
569
570
571
572
573
574
575







-
+

-
+





-
+


-
+


-
+


















-
-
-
-
-
+
+
+
+
+
-
-









	 */

	if (!timeoutPtr) {
	    pollTimeout = -1;
	} else if (!timeoutPtr->tv_sec && !timeoutPtr->tv_usec) {
	    pollTimeout = 0;
	} else {
	    pollTimeout = (int)timeoutPtr->tv_sec * 1000;
	    pollTimeout = (int) timeoutPtr->tv_sec * 1000;
	    if (timeoutPtr->tv_usec) {
		pollTimeout += ((int)timeoutPtr->tv_usec / 1000);
		pollTimeout += (int) timeoutPtr->tv_usec / 1000;
	    }
	}
	numFound = poll(pollFds, 1, pollTimeout);
	if (numFound == 1) {
	    result = 0;
	    if (pollFds[0].events & (POLLIN | POLLHUP)) {
	    if (pollFds[0].revents & (POLLIN | POLLHUP)) {
		result |= TCL_READABLE;
	    }
	    if (pollFds[0].events & POLLOUT) {
	    if (pollFds[0].revents & POLLOUT) {
		result |= TCL_WRITABLE;
	    }
	    if (pollFds[0].events & POLLERR) {
	    if (pollFds[0].revents & POLLERR) {
		result |= TCL_EXCEPTION;
	    }
	    if (result) {
		break;
	    }
	}
	if (timeout == 0) {
	    break;
	}
	if (timeout < 0) {
	    continue;
	}

	/*
	 * The select returned early, so we need to recompute the timeout.
	 */

	Tcl_GetTime(&now);
	if ((abortTime.sec < now.sec)
		|| (abortTime.sec==now.sec && abortTime.usec<=now.usec)) {
	    break;
	}
    }
    } while ((abortTime.sec > now.sec)
	    || (abortTime.sec == now.sec && abortTime.usec > now.usec));
    return result;
}

    return result;
}
#endif /* !HAVE_COREFOUNDATION */

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

Changes to unix/tclUnixPort.h.

53
54
55
56
57
58
59
60

61
62
63

64
65











66
67
68
69
70
71
72
53
54
55
56
57
58
59

60
61
62

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83







-
+


-
+


+
+
+
+
+
+
+
+
+
+
+







/*
 *---------------------------------------------------------------------------
 * Parameterize for 64-bit filesystem support.
 *---------------------------------------------------------------------------
 */

#ifdef HAVE_STRUCT_DIRENT64
typedef struct dirent64	Tcl_DirEntry;
typedef struct dirent64		Tcl_DirEntry;
#   define TclOSreaddir		readdir64
#else
typedef struct dirent	Tcl_DirEntry;
typedef struct dirent		Tcl_DirEntry;
#   define TclOSreaddir		readdir
#endif
#ifdef HAVE_DIR64
typedef DIR64			TclDIR;
#   define TclOSopendir		opendir64
#   define TclOSrewinddir	rewinddir64
#   define TclOSclosedir	closedir64
#else
typedef DIR			TclDIR;
#   define TclOSopendir		opendir
#   define TclOSrewinddir	rewinddir
#   define TclOSclosedir	closedir
#endif

#ifdef HAVE_TYPE_OFF64_T
typedef off64_t		Tcl_SeekOffset;
#   define TclOSseek		lseek64
#   define TclOSopen		open64
#else
typedef off_t		Tcl_SeekOffset;
83
84
85
86
87
88
89
90
91


92
93
94
95
96
97
98
94
95
96
97
98
99
100


101
102
103
104
105
106
107
108
109







-
-
+
+







#   define HANDLE void *
#   define HINSTANCE void *
#   define SOCKET unsigned int
#   define WSAEWOULDBLOCK 10035
    typedef unsigned short WCHAR;
    __declspec(dllimport) extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *);
    __declspec(dllimport) extern __stdcall int GetModuleFileNameW(void *, const char *, int);
    __declspec(dllimport) extern __stdcall int WideCharToMultiByte(int, int, const char *, int,
	    const char *, int, const char *, const char *);
    __declspec(dllimport) extern __stdcall int WideCharToMultiByte(int, int, const void *, int,
	    char *, int, const char *, void *);
    __declspec(dllimport) extern __stdcall int MultiByteToWideChar(int, int, const char *, int,
	    WCHAR *, int);
    __declspec(dllimport) extern __stdcall void OutputDebugStringW(const WCHAR *);
    __declspec(dllimport) extern __stdcall int IsDebuggerPresent();
    __declspec(dllimport) extern __stdcall int GetLastError();
    __declspec(dllimport) extern __stdcall int GetFileAttributesW(const WCHAR *);
    __declspec(dllimport) extern __stdcall int SetFileAttributesW(const WCHAR *, int);
147
148
149
150
151
152
153
154

155
156
157
158
159
160
161
158
159
160
161
162
163
164

165
166
167
168
169
170
171
172







-
+







#endif
#ifdef HAVE_UNISTD_H
#   include <unistd.h>
#else
#   include "../compat/unistd.h"
#endif

extern int TclUnixSetBlockingMode(int fd, int mode);
MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);

#include <utime.h>

/*
 *---------------------------------------------------------------------------
 * Socket support stuff: This likely needs more work to parameterize for each
 * system.
177
178
179
180
181
182
183
184
185

186
187
188
189
190
191
192
193
194
195
196
197
188
189
190
191
192
193
194


195





196
197
198
199
200
201
202







-
-
+
-
-
-
-
-







 *---------------------------------------------------------------------------
 * Some platforms (e.g. SunOS) don't define FLT_MAX and FLT_MIN, so we look
 * for an alternative definition. If no other alternative is available we use
 * a reasonable guess.
 *---------------------------------------------------------------------------
 */

#ifndef NO_FLOAT_H
#   include <float.h>
#include <float.h>
#else
#ifndef NO_VALUES_H
#   include <values.h>
#endif
#endif

#ifndef FLT_MAX
#   ifdef MAXFLOAT
#	define FLT_MAX	MAXFLOAT
#   else
#	define FLT_MAX	3.402823466E+38F
#   endif
604
605
606
607
608
609
610
611
612
613


614
615
616
617
618
619
620
621
609
610
611
612
613
614
615



616
617

618
619
620
621
622
623
624







-
-
-
+
+
-







#	endif
#	if MAC_OS_X_VERSION_MAX_ALLOWED < 1040
#	    undef HAVE_OSSPINLOCKLOCK
#	    undef HAVE_PTHREAD_ATFORK
#	    undef HAVE_COPYFILE
#	endif
#	if MAC_OS_X_VERSION_MAX_ALLOWED < 1030
#	    ifdef TCL_THREADS
		/* prior to 10.3, realpath is not threadsafe, c.f. bug 711232 */
#		define NO_REALPATH 1
	    /* prior to 10.3, realpath is not threadsafe, c.f. bug 711232 */
#	    define NO_REALPATH 1
#	    endif
#	    undef HAVE_LANGINFO
#	endif
#   endif /* MAC_OS_X_VERSION_MAX_ALLOWED */
#   if defined(HAVE_COREFOUNDATION) && defined(__LP64__) && \
	    defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050
#	warning "Weak import of 64-bit CoreFoundation is not supported, will not run on Mac OS X < 10.5."
#   endif
680
681
682
683
684
685
686
687

688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712






713
714

715
716
717
718
719
720
721
722
723
724
725
683
684
685
686
687
688
689

690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709






710
711
712
713
714
715
716

717
718
719
720
721
722
723
724
725
726
727
728







-
+



















-
-
-
-
-
-
+
+
+
+
+
+

-
+











 *---------------------------------------------------------------------------
 * The following macros and declaration wrap the C runtime library functions.
 *---------------------------------------------------------------------------
 */

#define TclpExit	exit

#ifdef TCL_THREADS
#if !defined(TCL_THREADS) || TCL_THREADS
#   include <pthread.h>
#endif /* TCL_THREADS */

/* FIXME - Hyper-enormous platform assumption! */
#ifndef AF_INET6
#   define AF_INET6	10
#endif

/*
 *---------------------------------------------------------------------------
 * Set of MT-safe implementations of some known-to-be-MT-unsafe library calls.
 * Instead of returning pointers to the static storage, those return pointers
 * to the TSD data.
 *---------------------------------------------------------------------------
 */

#include <pwd.h>
#include <grp.h>

extern struct passwd *	TclpGetPwNam(const char *name);
extern struct group *	TclpGetGrNam(const char *name);
extern struct passwd *	TclpGetPwUid(uid_t uid);
extern struct group *	TclpGetGrGid(gid_t gid);
extern struct hostent *	TclpGetHostByName(const char *name);
extern struct hostent *	TclpGetHostByAddr(const char *addr,
MODULE_SCOPE struct passwd *	TclpGetPwNam(const char *name);
MODULE_SCOPE struct group *	TclpGetGrNam(const char *name);
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);
extern void *TclpMakeTcpClientChannelMode(
MODULE_SCOPE void *TclpMakeTcpClientChannelMode(
				    void *tcpSocket, int mode);

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

Changes to unix/tclUnixSock.c.

213
214
215
216
217
218
219
220

221
222
223
224
225
226
227
213
214
215
216
217
218
219

220
221
222
223
224
225
226
227







-
+







 *
 * ----------------------------------------------------------------------
 */

static void
InitializeHostName(
    char **valuePtr,
    size_t *lengthPtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *native = NULL;

#ifndef NO_UNAME
    struct utsname u;
    struct hostent *hp;
1120
1121
1122
1123
1124
1125
1126
1127

1128
1129
1130
1131
1132
1133
1134
1120
1121
1122
1123
1124
1125
1126

1127
1128
1129
1130
1131
1132
1133
1134







-
+








/*
 * ----------------------------------------------------------------------
 *
 * TcpAsyncCallback --
 *
 *	Called by the event handler that TcpConnect sets up internally for
 *	[socket -async] to get notified when the asyncronous connection
 *	[socket -async] to get notified when the asynchronous connection
 *	attempt has succeeded or failed.
 *
 * ----------------------------------------------------------------------
 */

static void
TcpAsyncCallback(
1153
1154
1155
1156
1157
1158
1159
1160

1161
1162
1163
1164
1165
1166
1167
1168

1169
1170
1171
1172
1173
1174
1175
1153
1154
1155
1156
1157
1158
1159

1160
1161
1162
1163
1164
1165
1166
1167

1168
1169
1170
1171
1172
1173
1174
1175







-
+







-
+







 *      and an error message is left in interp.
 *
 * Side effects:
 *	Opens a socket.
 *
 * Remarks:
 *	A single host name may resolve to more than one IP address, e.g. for
 *	an IPv4/IPv6 dual stack host. For handling asyncronously connecting
 *	an IPv4/IPv6 dual stack host. For handling asynchronously connecting
 *	sockets in the background for such hosts, this function can act as a
 *	coroutine. On the first call, it sets up the control variables for the
 *	two nested loops over the local and remote addresses. Once the first
 *	connection attempt is in progress, it sets up itself as a writable
 *	event handler for that socket, and returns. When the callback occurs,
 *	control is transferred to the "reenter" label, right after the initial
 *	return and the loops resume as if they had never been interrupted.
 *	For syncronously connecting sockets, the loops work the usual way.
 *	For synchronously connecting sockets, the loops work the usual way.
 *
 * ----------------------------------------------------------------------
 */

static int
TcpConnect(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */

Changes to unix/tclUnixThrd.c.

9
10
11
12
13
14
15
16
17




















































































































































18
19
20
21
22

23
24
25
26
27
28
29
9
10
11
12
13
14
15


16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176







-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





+







 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifdef TCL_THREADS

#if TCL_THREADS

/*
 * TIP #509. Ensures that Tcl's mutexes are reentrant.
 *
 *----------------------------------------------------------------------
 *
 * PMutexInit --
 *
 *	Sets up the memory pointed to by its argument so that it contains the
 *	implementation of a recursive lock. Caller supplies the space.
 *
 *----------------------------------------------------------------------
 *
 * PMutexDestroy --
 *
 *	Tears down the implementation of a recursive lock (but does not
 *	deallocate the space holding the lock).
 *
 *----------------------------------------------------------------------
 *
 * PMutexLock --
 *
 *	Locks a recursive lock. (Similar to pthread_mutex_lock)
 *
 *----------------------------------------------------------------------
 *
 * PMutexUnlock --
 *
 *	Unlocks a recursive lock. (Similar to pthread_mutex_unlock)
 *
 *----------------------------------------------------------------------
 *
 * PCondWait --
 *
 *	Waits on a condition variable linked a recursive lock. (Similar to
 *	pthread_cond_wait)
 *
 *----------------------------------------------------------------------
 *
 * PCondTimedWait --
 *
 *	Waits for a limited amount of time on a condition variable linked to a
 *	recursive lock. (Similar to pthread_cond_timedwait)
 *
 *----------------------------------------------------------------------
 */

#ifndef HAVE_DECL_PTHREAD_MUTEX_RECURSIVE
#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE 0
#endif

#if HAVE_DECL_PTHREAD_MUTEX_RECURSIVE
/*
 * Pthread has native reentrant (AKA recursive) mutexes. Use them for
 * Tcl_Mutex.
 */

typedef pthread_mutex_t PMutex;

static void
PMutexInit(
    PMutex *pmutexPtr)
{
    pthread_mutexattr_t attr;

    pthread_mutexattr_init(&attr);
    pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
    pthread_mutex_init(pmutexPtr, &attr);
}

#define PMutexDestroy	pthread_mutex_destroy
#define PMutexLock	pthread_mutex_lock
#define PMutexUnlock	pthread_mutex_unlock
#define PCondWait	pthread_cond_wait
#define PCondTimedWait	pthread_cond_timedwait

#else /* !HAVE_PTHREAD_MUTEX_RECURSIVE */

/*
 * No native support for reentrant mutexes. Emulate them with regular mutexes
 * and thread-local counters.
 */

typedef struct PMutex {
    pthread_mutex_t mutex;
    pthread_t thread;
    int counter;
} PMutex;

static void
PMutexInit(
    PMutex *pmutexPtr)
{
    pthread_mutex_init(&pmutexPtr->mutex, NULL);
    pmutexPtr->thread = 0;
    pmutexPtr->counter = 0;
}

static void
PMutexDestroy(
    PMutex *pmutexPtr)
{
    pthread_mutex_destroy(&pmutexPtr->mutex);
}

static void
PMutexLock(
    PMutex *pmutexPtr)
{
    if (pmutexPtr->thread != pthread_self() || pmutexPtr->counter == 0) {
	pthread_mutex_lock(&pmutexPtr->mutex);
	pmutexPtr->thread = pthread_self();
	pmutexPtr->counter = 0;
    }
    pmutexPtr->counter++;
}

static void
PMutexUnlock(
    PMutex *pmutexPtr)
{
    pmutexPtr->counter--;
    if (pmutexPtr->counter == 0) {
	pmutexPtr->thread = 0;
	pthread_mutex_unlock(&pmutexPtr->mutex);
    }
}

static void
PCondWait(
    pthread_cond_t *pcondPtr,
    PMutex *pmutexPtr)
{
    pthread_cond_wait(pcondPtr, &pmutexPtr->mutex);
}

static void
PCondTimedWait(
    pthread_cond_t *pcondPtr,
    PMutex *pmutexPtr,
    struct timespec *ptime)
{
    pthread_cond_timedwait(pcondPtr, &pmutexPtr->mutex, ptime);
}
#endif /* HAVE_PTHREAD_MUTEX_RECURSIVE */

#ifndef TCL_NO_DEPRECATED
typedef struct {
    char nabuf[16];
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;
#endif /* TCL_NO_DEPRECATED */

/*
 * masterLock is used to serialize creation of mutexes, condition variables,
 * and thread local storage. This is the only place that can count on the
 * ability to statically initialize the mutex.
 */

37
38
39
40
41
42
43


44
45







46
47
48
49
50
51
52
184
185
186
187
188
189
190
191
192


193
194
195
196
197
198
199
200
201
202
203
204
205
206







+
+
-
-
+
+
+
+
+
+
+







static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER;

/*
 * allocLock is used by Tcl's version of malloc for synchronization. For
 * obvious reasons, cannot use any dyamically allocated storage.
 */

static PMutex allocLock;
static pthread_once_t allocLockInitOnce = PTHREAD_ONCE_INIT;
static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t *allocLockPtr = &allocLock;

static void
allocLockInit(void)
{
    PMutexInit(&allocLock);
}
static PMutex *allocLockPtr = &allocLock;

#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --
68
69
70
71
72
73
74
75

76
77
78
79
80
81
82
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236







-
+







    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#ifdef TCL_THREADS
#if TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;

    pthread_attr_init(&attr);
    pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);

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
257
258
259
260
261
262
263


264
265
266
267
268

269
270

271
272
273

274
275
276
277
278
279
280
281







-
-
+
+



-
+

-
+


-
+







	if (!result && (size < TCL_THREAD_STACK_MIN)) {
	    pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN);
	}
#endif /* TCL_THREAD_STACK_MIN */
    }
#endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */

    if (! (flags & TCL_THREAD_JOINABLE)) {
	pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED);
    if (!(flags & TCL_THREAD_JOINABLE)) {
	pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
    }

    if (pthread_create(&theThread, &attr,
	    (void * (*)(void *))proc, (void *)clientData) &&
	    (void * (*)(void *)) proc, (void *) clientData) &&
	    pthread_create(&theThread, NULL,
		    (void * (*)(void *))proc, (void *)clientData)) {
		    (void * (*)(void *)) proc, (void *) clientData)) {
	result = TCL_ERROR;
    } else {
	*idPtr = (Tcl_ThreadId)theThread;
	*idPtr = (Tcl_ThreadId) theThread;
	result = TCL_OK;
    }
    pthread_attr_destroy(&attr);
    return result;
#else
    return TCL_ERROR;
#endif /* TCL_THREADS */
146
147
148
149
150
151
152
153

154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187

188
189


190

191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

212
213
214
215
216
217
218
300
301
302
303
304
305
306

307
308
309
310
311
312
313
314
315
316
317
318
319
320

321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342

343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366

367
368
369
370
371
372
373
374







-
+













-




















+

-
+
+

+




















-
+







int
Tcl_JoinThread(
    Tcl_ThreadId threadId,	/* Id of the thread to wait upon. */
    int *state)			/* Reference to the storage the result of the
				 * thread we wait upon will be written into.
				 * May be NULL. */
{
#ifdef TCL_THREADS
#if TCL_THREADS
    int result;
    unsigned long retcode, *retcodePtr = &retcode;

    result = pthread_join((pthread_t) threadId, (void**) retcodePtr);
    if (state) {
	*state = (int) retcode;
    }
    return (result == 0) ? TCL_OK : TCL_ERROR;
#else
    return TCL_ERROR;
#endif
}

#ifdef TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * TclpThreadExit --
 *
 *	This procedure terminates the current thread.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	This procedure terminates the current thread.
 *
 *----------------------------------------------------------------------
 */

void
TclpThreadExit(
    int status)
{
#if TCL_THREADS
    pthread_exit(INT2PTR(status));
}
#else /* TCL_THREADS */
    exit(status);
#endif /* TCL_THREADS */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCurrentThread --
 *
 *	This procedure returns the ID of the currently running thread.
 *
 * Results:
 *	A thread ID.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
#ifdef TCL_THREADS
#if TCL_THREADS
    return (Tcl_ThreadId) pthread_self();
#else
    return (Tcl_ThreadId) 0;
#endif
}

/*
233
234
235
236
237
238
239
240

241
242
243
244
245
246
247
389
390
391
392
393
394
395

396
397
398
399
400
401
402
403







-
+







 *
 *----------------------------------------------------------------------
 */

void
TclpInitLock(void)
{
#ifdef TCL_THREADS
#if TCL_THREADS
    pthread_mutex_lock(&initLock);
#endif
}

/*
 *----------------------------------------------------------------------
 *
259
260
261
262
263
264
265
266

267
268
269
270
271
272
273
415
416
417
418
419
420
421

422
423
424
425
426
427
428
429







-
+







 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeLock(void)
{
#ifdef TCL_THREADS
#if TCL_THREADS
    /*
     * You do not need to destroy mutexes that were created with the
     * PTHREAD_MUTEX_INITIALIZER macro. These mutexes do not need any
     * destruction: masterLock, allocLock, and initLock.
     */

    pthread_mutex_unlock(&initLock);
290
291
292
293
294
295
296
297

298
299
300
301
302
303
304
305
306
307
308
309
310
311
312

313
314
315
316
317
318
319
320
321
322
323
324
325
326

327
328
329
330
331
332
333
334
335
336
337
446
447
448
449
450
451
452

453
454
455
456
457
458
459
460
461
462
463
464
465
466
467

468
469
470
471
472
473
474
475
476
477
478
479
480
481

482
483
484
485

486
487
488
489
490
491
492







-
+














-
+













-
+



-







 *
 *----------------------------------------------------------------------
 */

void
TclpInitUnlock(void)
{
#ifdef TCL_THREADS
#if TCL_THREADS
    pthread_mutex_unlock(&initLock);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclpMasterLock
 *
 *	This procedure is used to grab a lock that serializes creation and
 *	finalization of serialization objects. This interface is only needed
 *	in finalization; it is hidden during creation of the objects.
 *
 *	This lock must be different than the initLock because the initLock is
 *	held during creation of syncronization objects.
 *	held during creation of synchronization objects.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Acquire the master mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpMasterLock(void)
{
#ifdef TCL_THREADS
#if TCL_THREADS
    pthread_mutex_lock(&masterLock);
#endif
}


/*
 *----------------------------------------------------------------------
 *
 * TclpMasterUnlock
 *
 *	This procedure is used to release a lock that serializes creation and
345
346
347
348
349
350
351
352

353
354
355
356
357
358
359
500
501
502
503
504
505
506

507
508
509
510
511
512
513
514







-
+







 *
 *----------------------------------------------------------------------
 */

void
TclpMasterUnlock(void)
{
#ifdef TCL_THREADS
#if TCL_THREADS
    pthread_mutex_unlock(&masterLock);
#endif
}

/*
 *----------------------------------------------------------------------
 *
372
373
374
375
376
377
378
379
380




381
382
383
384
385
386
387

388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403

404
405
406
407
408
409
410
411
412

413
414

415
416
417
418
419
420
421
422
423
424
425



426
427
428
429
430
431


432
433
434
435
436
437
438
527
528
529
530
531
532
533


534
535
536
537
538
539
540
541
542
543

544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559

560
561
562
563
564
565
566
567
568

569
570

571
572
573
574
575
576
577
578
579



580
581
582
583
584
585
586


587
588
589
590
591
592
593
594
595







-
-
+
+
+
+






-
+















-
+








-
+

-
+








-
-
-
+
+
+




-
-
+
+







 *
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#ifdef TCL_THREADS
    pthread_mutex_t **allocLockPtrPtr = &allocLockPtr;
#if TCL_THREADS
    PMutex **allocLockPtrPtr = &allocLockPtr;

    pthread_once(&allocLockInitOnce, allocLockInit);
    return (Tcl_Mutex *) allocLockPtrPtr;
#else
    return NULL;
#endif
}

#ifdef TCL_THREADS
#if TCL_THREADS

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *
 *	This procedure is invoked to lock a mutex. This procedure handles
 *	initializing the mutex, if necessary. The caller can rely on the fact
 *	that Tcl_Mutex is an opaque pointer. This routine will change that
 *	pointer from NULL after first use.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May block the current thread. The mutex is aquired when this returns.
 *	May block the current thread. The mutex is acquired when this returns.
 *	Will allocate memory for a pthread_mutex_t and initialize this the
 *	first time this Tcl_Mutex is used.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexLock(
    Tcl_Mutex *mutexPtr)	/* Really (pthread_mutex_t **) */
    Tcl_Mutex *mutexPtr)	/* Really (PMutex **) */
{
    pthread_mutex_t *pmutexPtr;
    PMutex *pmutexPtr;

    if (*mutexPtr == NULL) {
	pthread_mutex_lock(&masterLock);
	if (*mutexPtr == NULL) {
	    /*
	     * Double inside master lock check to avoid a race condition.
	     */

	    pmutexPtr = ckalloc(sizeof(pthread_mutex_t));
	    pthread_mutex_init(pmutexPtr, NULL);
	    *mutexPtr = (Tcl_Mutex)pmutexPtr;
	    pmutexPtr = ckalloc(sizeof(PMutex));
	    PMutexInit(pmutexPtr);
	    *mutexPtr = (Tcl_Mutex) pmutexPtr;
	    TclRememberMutex(mutexPtr);
	}
	pthread_mutex_unlock(&masterLock);
    }
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pthread_mutex_lock(pmutexPtr);
    pmutexPtr = *((PMutex **) mutexPtr);
    PMutexLock(pmutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexUnlock --
 *
446
447
448
449
450
451
452
453

454
455

456
457

458
459
460
461
462
463
464
603
604
605
606
607
608
609

610
611

612
613

614
615
616
617
618
619
620
621







-
+

-
+

-
+







 *	The mutex is released when this returns.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexUnlock(
    Tcl_Mutex *mutexPtr)	/* Really (pthread_mutex_t **) */
    Tcl_Mutex *mutexPtr)	/* Really (PMutex **) */
{
    pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **) mutexPtr;
    PMutex *pmutexPtr = *(PMutex **) mutexPtr;

    pthread_mutex_unlock(pmutexPtr);
    PMutexUnlock(pmutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeMutex --
 *
476
477
478
479
480
481
482
483

484
485
486

487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507

508
509
510
511
512
513
514
515
516
517

518
519
520
521

522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541


542
543

544
545
546
547
548
549
550
551
552
553
554
555
556

557
558
559
560
561
562
563
633
634
635
636
637
638
639

640
641
642

643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663

664
665
666
667
668
669
670
671
672
673

674
675
676
677

678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696


697
698
699

700
701
702
703
704
705
706
707
708
709
710
711
712

713
714
715
716
717
718
719
720







-
+


-
+




















-
+









-
+



-
+


















-
-
+
+

-
+












-
+







 *----------------------------------------------------------------------
 */

void
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **) mutexPtr;
    PMutex *pmutexPtr = *(PMutex **) mutexPtr;

    if (pmutexPtr != NULL) {
	pthread_mutex_destroy(pmutexPtr);
	PMutexDestroy(pmutexPtr);
	ckfree(pmutexPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionWait --
 *
 *	This procedure is invoked to wait on a condition variable. The mutex
 *	is automically released as part of the wait, and automatically grabbed
 *	when the condition is signaled.
 *
 *	The mutex must be held when this procedure is called.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May block the current thread. The mutex is aquired when this returns.
 *	May block the current thread. The mutex is acquired when this returns.
 *	Will allocate memory for a pthread_mutex_t and initialize this the
 *	first time this Tcl_Mutex is used.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ConditionWait(
    Tcl_Condition *condPtr,	/* Really (pthread_cond_t **) */
    Tcl_Mutex *mutexPtr,	/* Really (pthread_mutex_t **) */
    Tcl_Mutex *mutexPtr,	/* Really (PMutex **) */
    const Tcl_Time *timePtr) /* Timeout on waiting period */
{
    pthread_cond_t *pcondPtr;
    pthread_mutex_t *pmutexPtr;
    PMutex *pmutexPtr;
    struct timespec ptime;

    if (*condPtr == NULL) {
	pthread_mutex_lock(&masterLock);

	/*
	 * Double check inside mutex to avoid race, then initialize condition
	 * variable if necessary.
	 */

	if (*condPtr == NULL) {
	    pcondPtr = ckalloc(sizeof(pthread_cond_t));
	    pthread_cond_init(pcondPtr, NULL);
	    *condPtr = (Tcl_Condition) pcondPtr;
	    TclRememberCondition(condPtr);
	}
	pthread_mutex_unlock(&masterLock);
    }
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pcondPtr = *((pthread_cond_t **)condPtr);
    pmutexPtr = *((PMutex **) mutexPtr);
    pcondPtr = *((pthread_cond_t **) condPtr);
    if (timePtr == NULL) {
	pthread_cond_wait(pcondPtr, pmutexPtr);
	PCondWait(pcondPtr, pmutexPtr);
    } else {
	Tcl_Time now;

	/*
	 * Make sure to take into account the microsecond component of the
	 * current time, including possible overflow situations. [Bug #411603]
	 */

	Tcl_GetTime(&now);
	ptime.tv_sec = timePtr->sec + now.sec +
	    (timePtr->usec + now.usec) / 1000000;
	ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
	pthread_cond_timedwait(pcondPtr, pmutexPtr, &ptime);
	PCondTimedWait(pcondPtr, pmutexPtr, &ptime);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionNotify --
576
577
578
579
580
581
582
583


584
585
586
587
588

589
590
591
592
593
594
595
733
734
735
736
737
738
739

740
741
742
743
744
745

746
747
748
749
750
751
752
753







-
+
+




-
+







 *----------------------------------------------------------------------
 */

void
Tcl_ConditionNotify(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *((pthread_cond_t **)condPtr);
    pthread_cond_t *pcondPtr = *((pthread_cond_t **) condPtr);

    if (pcondPtr != NULL) {
	pthread_cond_broadcast(pcondPtr);
    } else {
	/*
	 * Noone has used the condition variable, so there are no waiters.
	 * No-one has used the condition variable, so there are no waiters.
	 */
    }
}

/*
 *----------------------------------------------------------------------
 *
609
610
611
612
613
614
615
616

617
618
619
620
621
622
623
767
768
769
770
771
772
773

774
775
776
777
778
779
780
781







-
+







 *----------------------------------------------------------------------
 */

void
TclpFinalizeCondition(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr;
    pthread_cond_t *pcondPtr = *(pthread_cond_t **) condPtr;

    if (pcondPtr != NULL) {
	pthread_cond_destroy(pcondPtr);
	ckfree(pcondPtr);
	*condPtr = NULL;
    }
}
643
644
645
646
647
648
649
650

651
652
653
654
655
656
657
658
659
660

661
662
663
664
665
666
667
668
669
670
671
672

673
674
675
676
677
678
679
680
681
682
683


684
685
686
687
688
689


690
691

692
693
694
695
696
697

698
699
700
701
702
703
704

705

706
707
708
709

710
711
712
713
714
715
716
801
802
803
804
805
806
807

808
809
810
811
812
813
814
815
816
817

818
819
820
821
822
823
824
825
826
827
828
829

830
831
832
833
834
835
836
837
838
839


840
841
842
843
844
845


846
847
848

849
850
851
852
853
854

855
856
857
858
859
860
861
862
863

864
865
866
867

868
869
870
871
872
873
874
875







-
+









-
+











-
+









-
-
+
+




-
-
+
+

-
+





-
+







+
-
+



-
+







 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
Tcl_DirEntry *
TclpReaddir(
    DIR * dir)
    TclDIR * dir)
{
    return TclOSreaddir(dir);
}

#undef TclpInetNtoa
char *
TclpInetNtoa(
    struct in_addr addr)
{
#ifdef TCL_THREADS
#if TCL_THREADS
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    unsigned char *b = (unsigned char*) &addr.s_addr;

    sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]);
    return tsdPtr->nabuf;
#else
    return inet_ntoa(addr);
#endif
}
#endif /* TCL_NO_DEPRECATED */

#ifdef TCL_THREADS
#if TCL_THREADS
/*
 * Additions by AOL for specialized thread memory allocator.
 */

#ifdef USE_THREAD_ALLOC
static pthread_key_t key;

typedef struct {
    Tcl_Mutex tlock;
    pthread_mutex_t plock;
} allocMutex;
    PMutex plock;
} AllocMutex;

Tcl_Mutex *
TclpNewAllocMutex(void)
{
    allocMutex *lockPtr;
    register pthread_mutex_t *plockPtr;
    AllocMutex *lockPtr;
    register PMutex *plockPtr;

    lockPtr = malloc(sizeof(allocMutex));
    lockPtr = malloc(sizeof(AllocMutex));
    if (lockPtr == NULL) {
	Tcl_Panic("could not allocate lock");
    }
    plockPtr = &lockPtr->plock;
    lockPtr->tlock = (Tcl_Mutex) plockPtr;
    pthread_mutex_init(&lockPtr->plock, NULL);
    PMutexInit(&lockPtr->plock);
    return &lockPtr->tlock;
}

void
TclpFreeAllocMutex(
    Tcl_Mutex *mutex)		/* The alloc mutex to free. */
{
    AllocMutex *lockPtr = (AllocMutex *) mutex;
    allocMutex* lockPtr = (allocMutex*) mutex;

    if (!lockPtr) {
	return;
    }
    pthread_mutex_destroy(&lockPtr->plock);
    PMutexDestroy(&lockPtr->plock);
    free(lockPtr);
}

void
TclpInitAllocCache(void)
{
    pthread_key_create(&key, NULL);
754
755
756
757
758
759
760
761

762
763
764
765
766
767
768
913
914
915
916
917
918
919

920
921
922
923
924
925
926
927







-
+







#endif /* USE_THREAD_ALLOC */

void *
TclpThreadCreateKey(void)
{
    pthread_key_t *ptkeyPtr;

    ptkeyPtr = TclpSysAlloc(sizeof *ptkeyPtr, 0);
    ptkeyPtr = TclpSysAlloc(sizeof(pthread_key_t), 0);
    if (NULL == ptkeyPtr) {
	Tcl_Panic("unable to allocate thread key!");
    }

    if (pthread_key_create(ptkeyPtr, NULL)) {
	Tcl_Panic("unable to create pthread key!");
    }

Deleted unix/tclUnixThrd.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclUnixThrd.h --
 *
 *      This header file defines things for thread support.
 *
 * Copyright (c) 1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TCLUNIXTHRD
#define _TCLUNIXTHRD

#ifdef TCL_THREADS


#endif /* TCL_THREADS */
#endif /* _TCLUNIXTHRD */

Changes to win/Makefile.in.

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
161
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
161
162
163
164
165
166
167







+
+
+
+
+
















+








VER			= @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@
DOTVER			= @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@
DDEVER			= @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@
DDEDOTVER		= @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@
REGVER			= @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@
REGDOTVER		= @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@

TCL_ZIP_FILE		= @TCL_ZIP_FILE@
TCL_VFS_PATH		= libtcl.vfs/tcl_library
TCL_VFS_ROOT		= libtcl.vfs


TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
TCL_DLL_FILE		= @TCL_DLL_FILE@
TCL_LIB_FILE		= @TCL_LIB_FILE@
DDE_DLL_FILE		= tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX}
REG_DLL_FILE		= tclreg$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${LIBSUFFIX}
ZLIB_DLL_FILE		= zlib1.dll

SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
STATIC_LIBRARIES	= $(TCL_LIB_FILE)

TCLSH			= tclsh$(VER)${EXESUFFIX}
WINE			= @WINE@
CAT32			= cat32$(EXEEXT)
MAN2TCL			= man2tcl$(EXEEXT)

# For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is
# available *BEFORE* running make for the first time. Certain build targets
# (make genstubs, make install) need it to be available on the PATH. This
# executable should *NOT* be required just to do a normal build although
192
193
194
195
196
197
198







































199
200
201
202
203
204
205
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








RMDIR		= rm -rf
MKDIR		= mkdir -p
SHELL		= @SHELL@
RM		= rm -f
COPY		= cp

###
# Tip 430 - ZipFS Modifications
###

TCL_ZIP_FILE		= @TCL_ZIP_FILE@
TCL_VFS_PATH		= libtcl.vfs/tcl_library
TCL_VFS_ROOT		= libtcl.vfs

HOST_CC		        = @CC_FOR_BUILD@
HOST_EXEEXT             = @EXEEXT_FOR_BUILD@
HOST_OBJEXT             = @OBJEXT_FOR_BUILD@
ZIPFS_BUILD	        = @ZIPFS_BUILD@
NATIVE_ZIP		= @ZIP_PROG@
ZIP_PROG_OPTIONS		= @ZIP_PROG_OPTIONS@
ZIP_PROG_VFSSEARCH  = @ZIP_PROG_VFSSEARCH@
SHARED_BUILD		= @SHARED_BUILD@
INSTALL_MSGS            = @INSTALL_MSGS@
INSTALL_LIBRARIES       = @INSTALL_LIBRARIES@

# Minizip
MINIZIP_OBJS = \
        adler32.$(HOST_OBJEXT) \
        compress.$(HOST_OBJEXT) \
        crc32.$(HOST_OBJEXT) \
        deflate.$(HOST_OBJEXT) \
        infback.$(HOST_OBJEXT) \
        inffast.$(HOST_OBJEXT) \
        inflate.$(HOST_OBJEXT) \
        inftrees.$(HOST_OBJEXT) \
        ioapi.$(HOST_OBJEXT) \
        iowin32.$(HOST_OBJEXT)  \
        trees.$(HOST_OBJEXT) \
        uncompr.$(HOST_OBJEXT) \
        zip.$(HOST_OBJEXT) \
        zutil.$(HOST_OBJEXT) \
        minizip.$(HOST_OBJEXT)

ZIP_INSTALL_OBJS =  @ZIP_INSTALL_OBJS@

CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
-I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \
-DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}

CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@
281
282
283
284
285
286
287

288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304

305
306
307
308
309
310
311
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358







+

















+







	tclPathObj.$(OBJEXT) \
	tclPipe.$(OBJEXT) \
	tclPkg.$(OBJEXT) \
	tclPkgConfig.$(OBJEXT) \
	tclPosixStr.$(OBJEXT) \
	tclPreserve.$(OBJEXT) \
	tclProc.$(OBJEXT) \
	tclProcess.$(OBJEXT) \
	tclRegexp.$(OBJEXT) \
	tclResolve.$(OBJEXT) \
	tclResult.$(OBJEXT) \
	tclScan.$(OBJEXT) \
	tclStringObj.$(OBJEXT) \
	tclStrToD.$(OBJEXT) \
	tclStubInit.$(OBJEXT) \
	tclThread.$(OBJEXT) \
	tclThreadAlloc.$(OBJEXT) \
	tclThreadJoin.$(OBJEXT) \
	tclThreadStorage.$(OBJEXT) \
	tclTimer.$(OBJEXT) \
	tclTomMathInterface.$(OBJEXT) \
	tclTrace.$(OBJEXT) \
	tclUtf.$(OBJEXT) \
	tclUtil.$(OBJEXT) \
	tclVar.$(OBJEXT) \
	tclZipfs.$(OBJEXT) \
	tclZlib.$(OBJEXT)

TOMMATH_OBJS = \
	bncore.${OBJEXT} \
	bn_reverse.${OBJEXT} \
	bn_fast_s_mp_mul_digs.${OBJEXT} \
	bn_fast_s_mp_sqr.${OBJEXT} \
396
397
398
399
400
401
402
403


404
405
406
407
408
409
410
443
444
445
446
447
448
449

450
451
452
453
454
455
456
457
458







-
+
+







DDE_OBJS = tclWinDde.$(OBJEXT)

REG_OBJS = tclWinReg.$(OBJEXT)

STUB_OBJS = \
	tclStubLib.$(OBJEXT) \
	tclTomMathStubLib.$(OBJEXT) \
	tclOOStubLib.$(OBJEXT)
	tclOOStubLib.$(OBJEXT) \
	tclWinPanic.$(OBJEXT)

TCLSH_OBJS = tclAppInit.$(OBJEXT)

ZLIB_OBJS = \
	adler32.$(OBJEXT) \
	compress.$(OBJEXT) \
	crc32.$(OBJEXT) \
421
422
423
424
425
426
427
428

429
430
431
432
433
434
435










436
437
438

439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455

456
457
458




459
460
461
462
463
464
465
469
470
471
472
473
474
475

476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495

496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512

513
514
515
516
517
518
519
520
521
522
523
524
525
526
527







-
+







+
+
+
+
+
+
+
+
+
+


-
+
















-
+



+
+
+
+








TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]

all: binaries libraries doc packages

tcltest: $(TCLSH) $(TEST_DLL_FILE)

binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH)
binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH)

winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}

libraries:

doc:

tclzipfile: ${TCL_ZIP_FILE}

${TCL_ZIP_FILE}:  ${ZIP_INSTALL_OBJS} ${DDE_DLL_FILE} ${REG_DLL_FILE}
	rm -rf ${TCL_VFS_ROOT}
	mkdir -p ${TCL_VFS_PATH}
	$(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}
	$(COPY) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde
	$(COPY) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg
	cd  ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH}

$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
	$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	@VC_MANIFEST_EMBED_EXE@

cat32.$(OBJEXT): cat.c
	$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)

$(CAT32): cat32.$(OBJEXT)
	$(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE)

# The following targets are configured by autoconf to generate either a shared
# library or static library

${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
	@$(RM) ${TCL_STUB_LIB_FILE}
	@MAKE_STUB_LIB@ ${STUB_OBJS}
	@POST_MAKE_LIB@

${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@
${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ ${TCL_ZIP_FILE}
	@$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE)
	@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
	@VC_MANIFEST_EMBED_DLL@
ifeq (${ZIPFS_BUILD},1)
	cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE}
	${NATIVE_ZIP} -A ${TCL_DLL_FILE}
endif

${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@$(RM) ${TCL_LIB_FILE}
	@MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@POST_MAKE_LIB@

${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}
496
497
498
499
500
501
502











503
504
505
506
507
508
509
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582







+
+
+
+
+
+
+
+
+
+
+







	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

testMain.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME)

tclMain2.${OBJEXT}: tclMain.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)

# TIP #430, ZipFS Support
tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl \
	-DCFG_RUNTIME_PATH=\"$(bindir_native)\" \
	-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
	-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
	-DCFG_RUNTIME_LIBDIR="\"$(bindir_native)\"" \
	-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \
	$(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip  @DEPARG@ $(CC_OBJNAME)


# TIP #59, embedding of configuration information into the binary library.
#
# Part of Tcl's configuration information are the paths where it was installed
# and where it will look for its libraries (which can be different). We derive
# this information from the variables which can be overridden by the user. As
# every path can be configured separately we do not remember one general
518
519
520
521
522
523
524


525
526
527
528
529
530
531
532
533
534
535
536
537
538
539



540
541
542
543
544
545
546
547





















































548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567







568


569
570
571
572
573
574
575
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705

706
707
708
709
710
711
712
713
714







+
+















+
+
+








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




















+
+
+
+
+
+
+
-
+
+







		-DCFG_INSTALL_DOCDIR=\"$(MAN_INSTALL_DIR)\" \
		\
		-DCFG_RUNTIME_LIBDIR=\"$(libdir_native)\" \
		-DCFG_RUNTIME_BINDIR=\"$(bindir_native)\" \
		-DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \
		-DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \
		-DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
		-DBUILD_tcl \
		@DEPARG@ $(CC_OBJNAME)

# The following objects are part of the stub library and should not be built
# as DLL objects but none of the symbols should be exported

tclStubLib.${OBJEXT}: tclStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

tclOOStubLib.${OBJEXT}: tclOOStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

tclWinPanic.${OBJEXT}: tclWinPanic.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

# Implicit rule for all object files that will end up in the Tcl library

%.${OBJEXT}: %.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME)

.rc.$(RES):
	$(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@



#--------------------------------------------------------------------------
# Minizip implementation
#--------------------------------------------------------------------------
adler32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c

compress.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c

crc32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c

deflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c

ioapi.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c

iowin32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c

infback.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c

inffast.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c

inflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c

inftrees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c

trees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c

uncompr.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c

zip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c

zutil.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c

minizip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -DIOAPI_NO_64 -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c

minizip${HOST_EXEEXT}: $(MINIZIP_OBJS)
	$(HOST_CC) -o $@ $(MINIZIP_OBJS)

# The following target generates the file generic/tclDate.c from the yacc
# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
# not available in all environments. The name of the .c file is different than
# the name of the .y file so that make doesn't try to automatically regenerate
# the .c file.

gendate:
	bison --output-file=$(GENERIC_DIR)/tclDate.c \
	--name-prefix=TclDate \
	--no-lines \
	$(GENERIC_DIR)/tclGetDate.y

# The following target generates the file generic/tclTomMath.h. It needs to be
# run (and the results checked) after updating to a new release of libtommath.

gentommath_h:
	$(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/fix_tommath_h.tcl" \
		"$(TOMMATH_DIR_NATIVE)/tommath.h" \
		> "$(GENERIC_DIR_NATIVE)/tclTomMath.h"

INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA)
INSTALL_DOC_TARGETS = install-doc
INSTALL_PACKAGE_TARGETS = install-packages
INSTALL_DEV_TARGETS = install-headers
INSTALL_EXTRA_TARGETS =
INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \
		  $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS)
install: all install-binaries install-libraries install-doc install-packages

install: $(INSTALL_TARGETS)

install-binaries: binaries
	@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) $$i; \
616
617
618
619
620
621
622





623
624
625
626
627
628
629
630
631
632
633

634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661


662
663
664
665
666
667
668


669
670

671
672

673
674

675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690



















691
692
693
694
695
696
697
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776

777
778
779
780
781
782
783
784









785
786
787
788
789







790
791
792
793
794
795
796


797
798
799

800
801

802
803

804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846







+
+
+
+
+










-
+







-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-
+
+





-
-
+
+

-
+

-
+

-
+
















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		$(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    fi
	@if [ -f $(REG_LIB_FILE) ]; then \
	    echo Installing $(REG_LIB_FILE); \
	    $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    fi

install-libraries-zipfs-shared: libraries

install-libraries-zipfs-static: install-libraries-zipfs-shared
	$(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"

install-libraries: libraries install-tzdata install-msgs
	@for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \
		$(SCRIPT_INSTALL_DIR); \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) $$i; \
		else true; \
		fi; \
	    done;
	@for i in http1.0 opt0.4 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform; \
	@for i in opt0.4 encoding ../tcl8 ../tcl8/8.4  ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6 ../tcl8/8.7; \
	    do \
	    if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing header files";
	@for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
		"$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \
		"$(GENERIC_DIR)/tclPlatDecls.h" \
		"$(GENERIC_DIR)/tclTomMath.h" \
		"$(GENERIC_DIR)/tclTomMathDecls.h"; \
	    do \
	    $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
	    done;
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
	@for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
	    do \
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing library http1.0 directory";
	@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
	    done;
	@echo "Installing package http 2.8.12 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/http-2.8.12.tm;
	@echo "Installing package http 2.9.0 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.9.0.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.6.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/msgcat-1.6.1.tm;
	@echo "Installing package msgcat 1.7.0 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.7/msgcat-1.7.0.tm;
	@echo "Installing package tcltest 2.4.0 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/tcltest-2.4.0.tm;
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm;
	@echo "Installing package platform 1.0.14 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/platform-1.0.14.tm;
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/platform/shell-1.1.4.tm;
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";
	@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
		$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
	done;

install-tzdata:
	@echo "Installing time zone data"
	@$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
	    "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"

install-msgs:
	@echo "Installing message catalogs"
	@$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
	    "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"

install-doc: doc

install-headers:
	@for i in "$(INCLUDE_INSTALL_DIR)"; \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
		fi; \
	    done;
	@echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
	@for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
		$(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
		$(GENERIC_DIR)/tclPlatDecls.h \
		$(GENERIC_DIR)/tclTomMath.h \
		$(GENERIC_DIR)/tclTomMathDecls.h ; \
	    do \
	    $(COPY) $$i "$(INCLUDE_INSTALL_DIR)"; \
	    done;

# Optional target to install private headers
install-private-headers: libraries
	@for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
712
713
714
715
716
717
718
719

720

721
722


723
724
725
726
727
728
729




730
731
732
733
734
735

736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754



755
756
757
758

759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777

778
779
780
781
782
783
784
861
862
863
864
865
866
867

868
869
870


871
872
873
874
875
876



877
878
879
880
881
882
883
884
885

886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911

912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930

931
932
933
934
935
936
937
938







-
+

+
-
-
+
+




-
-
-
+
+
+
+





-
+



















+
+
+



-
+


















-
+







# tcltest, i.e.:
#	% make test TESTFLAGS="-verbose bps -file fileName.test"

test: test-tcl test-packages

test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
	$(WINE) ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
	-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
	package ifneeded tcltests 0.1 \"[list source [file normalize $(ROOT_DIR_NATIVE)/tests/tcltests.tcl]];package provide tcltests 0.1\"; \
	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
	package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" | $(WINE) ./$(CAT32)

# Useful target to launch a built tclsh with the proper path,...
runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
	$(WINE) ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
	package ifneeded tcltests 0.1 \"[list source [file normalize $(ROOT_DIR_NATIVE)/tests/tcltests.tcl]];package provide tcltests 0.1\"; \
	package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)

# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
shell: binaries
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) $(SCRIPT)
	$(WINE) ./$(TCLSH) $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: binaries
	@echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run
	gdb ./$(TCLSH) --command=gdb.run
	rm gdb.run

depend:

Makefile: $(SRC_DIR)/Makefile.in
	./config.status

cleanhelp:
	$(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe

clean: cleanhelp clean-packages
	$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
	$(RM) $(TCLSH) $(CAT32)
	$(RM) *.pch *.ilk *.pdb
	$(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT}
	$(RM) *.zip
	$(RMDIR) *.vfs

distclean: distclean-packages clean
	$(RM) Makefile config.status config.cache config.log tclConfig.sh \
		tcl.hpj config.status.lineno
		tcl.hpj config.status.lineno tclsh.exe.manifest

#
# Bundled package targets
#

PKG_CFG_ARGS		= @PKG_CFG_ARGS@
PKG_DIR			= ./pkgs

packages:
	@builddir=`$(CYGPATH) $$(pwd -P)`; \
	for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ] ; then \
	    if [ -x $$i/configure ] ; then \
	      pkg=`basename $$i`; \
	      mkdir -p $(PKG_DIR)/$$pkg; \
	      if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	        ( cd $(PKG_DIR)/$$pkg; \
	          echo "Configuring package '$$i' wd = `$(CYGPATH) $$(pwd -P)`"; \
	          $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \
	          $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared; ) \
	      fi ; \
	      echo "Building package '$$pkg'"; \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \
	    fi; \
	  fi; \
	done; \
	cd $$builddir
854
855
856
857
858
859
860
861

862
863
864
865
866
867
868
1008
1009
1010
1011
1012
1013
1014

1015
1016
1017
1018
1019
1020
1021
1022







-
+







	$(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
	    "$(GENERIC_DIR_NATIVE)" \
	    "$(GENERIC_DIR_NATIVE)/tclOO.decls"

#
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
# workspace. It depends on the Tcl & Tk being in directories called tcl8.* &
# tk8.* up two directories from the TOOL_DIR.
#

TOOL_DIR=$(ROOT_DIR)/tools
HTML_INSTALL_DIR=$(ROOT_DIR)/html
html:
	$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)"
880
881
882
883
884
885
886

887
888
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043







+



.PHONY: all tcltest binaries libraries doc gendate gentommath_h install
.PHONY: install-binaries install-libraries install-tzdata install-msgs
.PHONY: install-doc install-private-headers test test-tcl runtest shell
.PHONY: gdb depend cleanhelp clean distclean packages install-packages
.PHONY: test-packages clean-packages distclean-packages genstubs html
.PHONY: html-tcl html-tk
.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile

# DO NOT DELETE THIS LINE -- make depend depends on it.

Changes to win/README.

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

20
21
22
23
24
25
26

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

19
20
21
22
23
24
25
26
-
+

















-
+







Tcl 9.0 for Windows
Tcl 8.7 for Windows

1. Introduction
---------------

This is the directory where you configure and compile the Windows
version of Tcl.  This directory also contains source files for Tcl
that are specific to Microsoft Windows.

The information in this file is maintained on the web at:

	http://www.tcl.tk/doc/howto/compile.html#win

2. Compiling Tcl
----------------

In order to compile Tcl for Windows, you need the following:

	Tcl 9.0 Source Distribution (plus any patches)
	Tcl 8.7 Source Distribution (plus any patches)

	and

	Visual C++ 6 or newer

	or

75
76
77
78
79
80
81
82

83
84

85
86
87
88
89
90
91
75
76
77
78
79
80
81

82
83

84
85
86
87
88
89
90
91







-
+

-
+







and Msys, you can download a suitable win32 or win64 compiler from
[https://sourceforge.net/projects/mingw-w64/files/]

Use the Makefile "install" target to install Tcl.  It will install it
according to the prefix options you provided in the correct directory
structure.

Note that in order to run tclsh90.exe, you must ensure that tcl90.dll is
Note that in order to run tclsh87.exe, you must ensure that tcl87.dll is
on your path, in the system directory, or in the directory containing
tclsh90.exe.
tclsh87.exe.

Note: Tcl no longer provides support for Win32s.

3. Test suite
-------------

This distribution contains an extensive test suite for Tcl.  Some of the

Changes to win/buildall.vc.bat.

34
35
36
37
38
39
40
41



42
43
44
45
46
47
48
34
35
36
37
38
39
40

41
42
43
44
45
46
47
48
49
50







-
+
+
+







if defined WINDOWSSDKDIR (goto :startBuilding)

:: We need to run the development environment batch script that comes
:: with developer studio (v4,5,6,7,etc...)  All have it.  This path
:: might not be correct.  You should call it yourself prior to running
:: this batchfile.
::
call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
REM call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
set "VSCMD_START_DIR=%CD%"
call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\Common7\Tools\VsDevCmd.bat"
if errorlevel 1 (goto no_vcvars)

:startBuilding

echo.
echo Sit back and have a cup of coffee while this grinds through ;)
echo You asked for *everything*, remember?

Deleted win/coffbase.txt.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43











































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
;
; This file defines the virtual base addresses for the Dynamic Link Libraries
; that are part of the Tcl system.  The first token on a line is the key (or name
; of the DLL) and the second token is the virtual base address, in hexidecimal.
; The third token is the maximum size of the DLL image file, including symbols.
;
; Using a specified "prefered load address" should speed loading time by avoiding
; relocations (NT supported only).  It is assumed extension authors will contribute
; their modules to this grand-master list.  You can use the dumpbin utility with
; the /headers option to get the "size of image" data (already in hex).  If the
; maximum size is too small a linker warning will occur.  Modules can overlap when
; they're mutually exclusive.  This info is placed in the DLL's PE header by the
; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,<key>` option.

tcl		0x10000000	0x00200000
tcldde		0x10200000	0x00010000
tclreg		0x10210000	0x00010000
tk		0x10220000	0x00200000
expect		0x10480000	0x00080000
itcl		0x10500000	0x00080000
itk		0x10580000	0x00080000
bltlite		0x10600000	0x00080000
blt		0x10680000	0x00080000
iocpsock	0x10700000	0x00080000
tls		0x10780000	0x00100000
winico		0x10880000	0x00010000
sample		0x108B0000	0x00010000
tile		0x10900000	0x00080000
memchan		0x109D0000	0x00010000
tdom		0x109E0000	0x00080000
tclvfs		0x10A70000	0x00010000
tkvideo		0x10B00000	0x00010000
tclsdl		0x10B20000	0x00080000
vqtcl		0x10C00000	0x00010000
tdbc		0x10C40000	0x00010000
thread		0x10C80000	0x00020000
nsf		0x10ca0000	0x00080000
;
; insert new packages here
;
snack		0x1E000000	0x00400000
sound		0x1E400000	0x00400000
snackogg	0x1E800000	0x00200000

Changes to win/configure.

695
696
697
698
699
700
701











702
703
704
705
706
707
708
709

710
711

712
713
714
715
716
717
718
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719

720
721

722
723
724
725
726
727
728
729







+
+
+
+
+
+
+
+
+
+
+







-
+

-
+







TCL_VERSION
MACHINE
TCL_WIN_VERSION
VC_MANIFEST_EMBED_EXE
VC_MANIFEST_EMBED_DLL
LDFLAGS_DEFAULT
CFLAGS_DEFAULT
INSTALL_MSGS
INSTALL_LIBRARIES
TCL_ZIP_FILE
ZIPFS_BUILD
ZIP_INSTALL_OBJS
ZIP_PROG_VFSSEARCH
ZIP_PROG_OPTIONS
ZIP_PROG
TCLSH_PROG
EXEEXT_FOR_BUILD
CC_FOR_BUILD
ZLIB_OBJS
ZLIB_LIBS
ZLIB_DLL_FILE
CFLAGS_WARNING
CFLAGS_OPTIMIZE
CFLAGS_DEBUG
DL_LIBS
CELIB_DIR
WINE
CYGPATH
TCL_THREADS
SHARED_BUILD
SET_MAKE
RC
RANLIB
AR
EGREP
GREP
CPP
756
757
758
759
760
761
762
763


764
765
766
767
768
769
770
771

772
773
774
775
776
777
778
779
767
768
769
770
771
772
773

774
775
776
777
778

779
780
781

782

783
784
785
786
787
788
789







-
+
+



-



-
+
-







PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL'
SHELL
OBJEXT_FOR_BUILD'
ac_subst_files=''
ac_user_opts='
enable_option_checking
enable_threads
with_encoding
enable_shared
enable_64bit
enable_wince
enable_zipfs
with_celib
enable_symbols
enable_embedded_manifest
'
      ac_precious_vars='build_alias
host_alias
target_alias
CC
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1395
1396
1397
1398
1399
1400
1401

1402
1403

1404
1405
1406
1407
1408
1409
1410
1411
1412

1413
1414
1415
1416
1417
1418
1419







-


-
+








-








  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-threads        build with threads (default: on)
  --enable-shared         build and link with shared libraries (default: on)
  --enable-64bit          enable 64bit support (where applicable)
  --enable-wince          enable Win/CE support (where applicable)
  --enable-zipfs          build with Zipfs support (default: on)
  --enable-symbols        build with debugging symbols (default: off)
  --enable-embedded-manifest
                          embed manifest if possible (default: yes)

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
  --with-encoding         encoding for configuration values
  --with-celib=DIR        use Windows/CE support library from DIR

Some influential environment variables:
  CC          C compiler command
  CFLAGS      C compiler flags
  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
              nonstandard directory <lib dir>
  LIBS        libraries to pass to the linker, e.g. -l<library>
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105




2106
2107
2108
2109
2110
2111
2112
2103
2104
2105
2106
2107
2108
2109




2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120







-
-
-
-
+
+
+
+









# The following define is needed when building with Cygwin since newer
# versions of autoconf incorrectly set SHELL to /bin/bash instead of
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh

TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="a0"
TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
TCL_PATCH_LEVEL="a2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
TCL_DDE_MINOR_VERSION=4
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION

3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3681
3682
3683
3684
3685
3686
3687

































3688
3689
3690
3691
3692
3693
3694







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------




#--------------------------------------------------------------------
# Check whether --enable-threads or --disable-threads was given.
#--------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with threads" >&5
$as_echo_n "checking for building with threads... " >&6; }
    # Check whether --enable-threads was given.
if test "${enable_threads+set}" = set; then :
  enableval=$enable_threads; tcl_ok=$enableval
else
  tcl_ok=yes
fi


    if test "$tcl_ok" = "yes"; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (default)" >&5
$as_echo "yes (default)" >&6; }
	TCL_THREADS=1
	$as_echo "#define TCL_THREADS 1" >>confdefs.h

	# USE_THREAD_ALLOC tells us to try the special thread-based
	# allocator that significantly reduces lock contention
	$as_echo "#define USE_THREAD_ALLOC 1" >>confdefs.h

    else
	TCL_THREADS=0
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
    fi



#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------



3767
3768
3769
3770
3771
3772
3773

3774
3775
3776
3777
3778
3779
3780
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756







+







$as_echo "static" >&6; }
	SHARED_BUILD=0

$as_echo "#define STATIC_BUILD 1" >>confdefs.h

    fi



#--------------------------------------------------------------------
# The statements below define a collection of compile flags.  This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------

3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3783
3784
3785
3786
3787
3788
3789



























3790
3791
3792
3793
3794
3795
3796







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







else
  do64bit=no
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5
$as_echo "$do64bit" >&6; }

    # Cross-compiling options for Windows/CE builds

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if Windows/CE build is requested" >&5
$as_echo_n "checking if Windows/CE build is requested... " >&6; }
    # Check whether --enable-wince was given.
if test "${enable_wince+set}" = set; then :
  enableval=$enable_wince; doWince=$enableval
else
  doWince=no
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doWince" >&5
$as_echo "$doWince" >&6; }

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Windows/CE celib directory" >&5
$as_echo_n "checking for Windows/CE celib directory... " >&6; }

# Check whether --with-celib was given.
if test "${with_celib+set}" = set; then :
  withval=$with_celib; CELIB_DIR=$withval
else
  CELIB_DIR=NO_CELIB
fi

    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CELIB_DIR" >&5
$as_echo "$CELIB_DIR" >&6; }

    # Set some defaults (may get changed below)
    EXTRA_CFLAGS=""

$as_echo "#define MODULE_SCOPE extern" >>confdefs.h


    # Extract the first word of "cygpath", so it can be a program name with args.
3872
3873
3874
3875
3876
3877
3878





































3879
3880
3881
3882
3883
3884
3885
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







  test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo"
fi
fi
CYGPATH=$ac_cv_prog_CYGPATH
if test -n "$CYGPATH"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5
$as_echo "$CYGPATH" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi


    # Extract the first word of "wine", so it can be a program name with args.
set dummy wine; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_WINE+:} false; then :
  $as_echo_n "(cached) " >&6
else
  if test -n "$WINE"; then
  ac_cv_prog_WINE="$WINE" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_WINE="wine"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
IFS=$as_save_IFS

fi
fi
WINE=$ac_cv_prog_WINE
if test -n "$WINE"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $WINE" >&5
$as_echo "$WINE" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi



4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438

4439
4440
4441
4442
4443
4444
4445
4446
4318
4319
4320
4321
4322
4323
4324




































































































4325

4326
4327
4328
4329
4330
4331
4332







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-







	    CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
	    # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy)
	    CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
	    lflags="${lflags} -nologo"
	    LINKBIN="link"
	fi

	if test "$doWince" != "no" ; then
	    # Set defaults for common evc4/PPC2003 setup
	    # Currently Tcl requires 300+, possibly 420+ for sockets
	    CEVERSION=420; 		# could be 211 300 301 400 420 ...
	    TARGETCPU=ARMV4;	# could be ARMV4 ARM MIPS SH3 X86 ...
	    ARCH=ARM;		# could be ARM MIPS X86EM ...
	    PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002"
	    if test "$doWince" != "yes"; then
		# If !yes then the user specified something
		# Reset ARCH to allow user to skip specifying it
		ARCH=
		eval `echo $doWince | awk -F "," '{ \
	if (length($1)) { printf "CEVERSION=\"%s\"\n", $1; \
	if ($1 < 400)	  { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \
	if (length($2)) { printf "TARGETCPU=\"%s\"\n", toupper($2) }; \
	if (length($3)) { printf "ARCH=\"%s\"\n", toupper($3) }; \
	if (length($4)) { printf "PLATFORM=\"%s\"\n", $4 }; \
		}'`
		if test "x${ARCH}" = "x" ; then
		    ARCH=$TARGETCPU;
		fi
	    fi
	    OSVERSION=WCE$CEVERSION;
	    if test "x${WCEROOT}" = "x" ; then
		WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0"
		if test ! -d "${WCEROOT}" ; then
		    WCEROOT="C:/Program Files/Microsoft eMbedded Tools"
		fi
	    fi
	    if test "x${SDKROOT}" = "x" ; then
		SDKROOT="C:/Program Files/Windows CE Tools"
		if test ! -d "${SDKROOT}" ; then
		    SDKROOT="C:/Windows CE Tools"
		fi
	    fi
	    # The space-based-path will work for the Makefile, but will
	    # not work if AC_TRY_COMPILE is called.
	    WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'`
	    SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'`
	    CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'`
	    if test ! -d "${CELIB_DIR}/inc"; then
		as_fn_error $? "Invalid celib directory \"${CELIB_DIR}\"" "$LINENO" 5
	    fi
	    if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\
		-o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then
		as_fn_error $? "could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" "$LINENO" 5
	    else
		CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include"
		if test -d "${CEINCLUDE}/${TARGETCPU}" ; then
		    CEINCLUDE="${CEINCLUDE}/${TARGETCPU}"
		fi
		CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"
	    fi
	fi

	if test "$doWince" != "no" ; then
	    CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin"
	    if test "${TARGETCPU}" = "X86"; then
		CC="${CEBINROOT}/cl.exe"
	    else
		CC="${CEBINROOT}/cl${ARCH}.exe"
	    fi
	    CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\""
	    RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\""
	    arch=`echo ${ARCH} | awk '{print tolower($0)}'`
	    defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS"
	    for i in $defs ; do
		cat >>confdefs.h <<_ACEOF
#define $i 1
_ACEOF

	    done
#	    if test "${ARCH}" = "X86EM"; then
#		AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION)
#	    fi
	    cat >>confdefs.h <<_ACEOF
#define _WIN32_WCE $CEVERSION
_ACEOF

	    cat >>confdefs.h <<_ACEOF
#define UNDER_CE $CEVERSION
_ACEOF

	    CFLAGS_DEBUG="-nologo -Zi -Od"
	    CFLAGS_OPTIMIZE="-nologo -O2"
	    lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'`
	    lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo"
	    LINKBIN="\"${CEBINROOT}/link.exe\""

	    if test "${CEVERSION}" -lt 400 ; then
		LIBS="coredll.lib corelibc.lib winsock.lib"
	    else
		LIBS="coredll.lib corelibc.lib ws2.lib"
	    fi
	    # celib currently stuck at wce300 status
	    #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib"
	    LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\""
	    LIBS_GUI="commctrl.lib commdlg.lib"
	else
	    LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
	LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
	fi

	SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
	SHLIB_LD_LIBS='${LIBS}'
	# link -lib only works when -lib is the first arg
	STLIB_LD="${LINKBIN} -lib ${lflags}"
	RC_OUT=-fo
	RC_TYPE=-r
4463
4464
4465
4466
4467
4468
4469
4470

4471
4472
4473
4474
4475
4476
4477
4349
4350
4351
4352
4353
4354
4355

4356
4357
4358
4359
4360
4361
4362
4363







-
+








	# Specify the CC output file names based on the target name
	CC_OBJNAME="-Fo\$@"
	CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\$@')\""

	# Specify linker flags depending on the type of app being
	# built -- Console vs. Window.
	if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then
	if test "${TARGETCPU}" != "X86"; then
	    LDFLAGS_CONSOLE="-link ${lflags}"
	    LDFLAGS_WINDOW=${LDFLAGS_CONSOLE}
	else
	    LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}"
	    LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
	fi
    fi
4689
4690
4691
4692
4693
4694
4695
4696

4697
4698
4699
4700
4701
4702
4703
4575
4576
4577
4578
4579
4580
4581

4582
4583
4584
4585
4586
4587
4588
4589







-
+







  tcl_ok=yes

fi
if test "$tcl_ok" = "yes"; then :

  ZLIB_DLL_FILE=\${ZLIB_DLL_FILE}

  if test "$do64bit" = "yes"; then :
  if test "$do64bit" != "no"; then :

    if test "$GCC" == "yes"; then :

      ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a


else
4822
4823
4824
4825
4826
4827
4828










































































































































































































4829
4830
4831
4832
4833
4834
4835
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







cat >>confdefs.h <<_ACEOF
#define uintptr_t $tcl_cv_uintptr_t
_ACEOF

    fi

fi



#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
# Check whether --enable-zipfs was given.
if test "${enable_zipfs+set}" = set; then :
  enableval=$enable_zipfs; tcl_ok=$enableval
else
  tcl_ok=yes
fi

if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    # Put a plausible default for CC_FOR_BUILD in Makefile.
if test -z "$CC_FOR_BUILD"; then
  if test "x$cross_compiling" = "xno"; then
    CC_FOR_BUILD='$(CC)'
  else
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
$as_echo_n "checking for gcc... " >&6; }
    if ${ac_cv_path_cc+:} false; then :
  $as_echo_n "(cached) " >&6
else

	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/gcc 2> /dev/null` \
		    `ls -r $dir/gcc 2> /dev/null` ; do
		if test x"$ac_cv_path_cc" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_cc=$j
			break
		    fi
		fi
	    done
	done

fi

  fi
fi

# Also set EXEEXT_FOR_BUILD.
if test "x$cross_compiling" = "xno"; then
  EXEEXT_FOR_BUILD='$(EXEEXT)'
  OBJEXT_FOR_BUILD='$(OBJEXT)'
else
  OBJEXT_FOR_BUILD='.no'
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
$as_echo_n "checking for build system executable suffix... " >&6; }
if ${bfd_cv_build_exeext+:} false; then :
  $as_echo_n "(cached) " >&6
else
  rm -f conftest*
     echo 'int main () { return 0; }' > conftest.c
     bfd_cv_build_exeext=
     ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
     for file in conftest.*; do
       case $file in
       *.c | *.o | *.obj | *.ilk | *.pdb) ;;
       *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
       esac
     done
     rm -f conftest*
     test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
$as_echo "$bfd_cv_build_exeext" >&6; }
  EXEEXT_FOR_BUILD=""
  test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
fi

    #
    # Find a native zip implementation
    #

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
$as_echo_n "checking for tclsh... " >&6; }

    if ${ac_cv_path_tclsh+:} false; then :
  $as_echo_n "(cached) " >&6
else

	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \
		    `ls -r $dir/tclsh* 2> /dev/null` ; do
		if test x"$ac_cv_path_tclsh" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_tclsh=$j
			break
		    fi
		fi
	    done
	done

fi


    if test -f "$ac_cv_path_tclsh" ; then
	TCLSH_PROG="$ac_cv_path_tclsh"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
$as_echo "$TCLSH_PROG" >&6; }
    else
	# It is not an error if an installed version of Tcl can't be located.
	TCLSH_PROG=""
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
$as_echo "No tclsh found on PATH" >&6; }
    fi



    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
$as_echo_n "checking for zip... " >&6; }
    if ${ac_cv_path_zip+:} false; then :
  $as_echo_n "(cached) " >&6
else

    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done

fi

    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip "
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
$as_echo "$ZIP_PROG" >&6; }
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="."
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
$as_echo "Found INFO Zip in environment" >&6; }
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="."
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5
$as_echo "No zip found on PATH building minizip" >&6; }
    fi





	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
$as_echo_n "checking for building with zipfs... " >&6; }
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;

$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h

       INSTALL_LIBRARIES=install-libraries-zipfs-static
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
     else

$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
    fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi






#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------

# See if declarations like FINDEX_INFO_LEVELS are

Changes to win/configure.ac.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17




18
19
20
21
22
23
24
1
2
3
4
5
6
7
8
9
10
11
12
13




14
15
16
17
18
19
20
21
22
23
24













-
-
-
-
+
+
+
+







#! /bin/bash -norc
# This file is an input file used by the GNU "autoconf" program to
# generate the file "configure", which is run during Tcl installation
# to configure the system for the local environment.

AC_INIT(../generic/tcl.h)
AC_PREREQ(2.69)

# The following define is needed when building with Cygwin since newer
# versions of autoconf incorrectly set SHELL to /bin/bash instead of
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh

TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="a0"
TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
TCL_PATCH_LEVEL="a2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
TCL_DDE_MINOR_VERSION=4
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION

74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
74
75
76
77
78
79
80






81
82
83
84
85
86
87







-
-
-
-
-
-







#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------

AC_OBJEXT
AC_EXEEXT

#--------------------------------------------------------------------
# Check whether --enable-threads or --disable-threads was given.
#--------------------------------------------------------------------

SC_ENABLE_THREADS

#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------

SC_TCL_CFG_ENCODING

#--------------------------------------------------------------------
124
125
126
127
128
129
130
131

132
133
134
135
136
137
138
118
119
120
121
122
123
124

125
126
127
128
129
130
131
132







-
+







  enableval="$enable_shared"
  tcl_ok=$enableval
], [
  tcl_ok=yes
])
AS_IF([test "$tcl_ok" = "yes"], [
  AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}])
  AS_IF([test "$do64bit" = "yes"], [
  AS_IF([test "$do64bit" != "no"], [
    AS_IF([test "$GCC" == "yes"],[
      AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a])
    ], [
      AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/zdll.lib])
    ])
  ], [
    AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win32/zdll.lib])
169
170
171
172
173
174
175
















































176
177
178
179
180
181
182
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_uintptr_t" != none; then
	AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
	   type wide enough to hold a pointer.])
    fi
])


#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
AC_ARG_ENABLE(zipfs,
    AC_HELP_STRING([--enable-zipfs],
	[build with Zipfs support (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    AX_CC_FOR_BUILD
    #
    # Find a native zip implementation
    #
    SC_PROG_TCLSH
    SC_ZIPFS_SUPPORT
	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
AC_MSG_CHECKING([for building with zipfs])
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;
       AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?])
       INSTALL_LIBRARIES=install-libraries-zipfs-static
       AC_MSG_RESULT([yes])
     else
       AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       AC_MSG_RESULT([yes])
    fi
else
AC_MSG_RESULT([no])
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi
AC_SUBST(ZIPFS_BUILD)
AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(INSTALL_LIBRARIES)
AC_SUBST(INSTALL_MSGS)


#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be

Changes to win/makefile.vc.

1

2
3
4

5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
22
23
24
25


26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41


42
43
44

45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68



69

70
71
72
73
74
75

76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130

131
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

161
162



163
164
165
166
167


168
169
170
171
172
173

174
175
176
177
178

179
180

181
182
183
184
185
186


187
188
189

190
191




























192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242

1

2

3
4
5
6
7
8
9
10
11
12
13
14
15










16
17


18













19
20

21

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41




42
43
44
45

46






47


48
































49
50
51


52

53



54



55


56
57
58
59
60







61







62


63
















64
65





66


67
68
69





70
71






72
73




74


75




76

77
78
79
80

81
82
83
84
85
86
87
88
89
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
128
129
130
131
132
-
+
-

-
+









+


-
-
-
-
-
-
-
-
-
-
+
+
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-

-
+



















-
-
-
-

+
+
+
-
+
-
-
-
-
-
-
+
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
+
-

-
-
-
+
-
-
-
+
-
-
+
+
+
+

-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
-
-
+
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
+

-
-
-
-
+
-
-
+
-
-
-
-

-
+
+


-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







#-------------------------------------------------------------
#------------------------------------------------------------- -*- makefile -*-
# makefile.vc --
#
#	Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+)
#	Microsoft Visual C++ makefile for building Tcl with nmake
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2001-2005 ActiveState Corporation.
# Copyright (c) 2001-2004 David Gravereaux.
# Copyright (c) 2003-2008 Pat Thoyts.
# Copyright (c) 2017 Ashok P. Nadkarni
#------------------------------------------------------------------------------

# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
MSG = ^
You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
Platform SDK first to setup the environment.  Jump to this line to read^
the build instructions.
!error $(MSG)
!endif

# General usage:
#   nmake [-nologo] -f makefile.vc [TARGET|MACRODEF [TARGET|MACRODEF] [...]]
#------------------------------------------------------------------------------
# HOW TO USE this makefile:
#
# 1)  It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the
#     environment.  This is used as a check to see if vcvars32.bat had been
#     run prior to running nmake or during the installation of Microsoft
#     Visual C++, MSVCDir had been set globally and the PATH adjusted.
#     Either way is valid.
#
#     You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin
#     directory to setup the proper environment, if needed, for your
#     current setup.  This is a needed bootstrap requirement and allows the
#     swapping of different environments to be easier.
#
# 2)  To use the Platform SDK (not expressly needed), run setenv.bat after
#     vcvars32.bat according to the instructions for it.  This can also
# For MACRODEF, see TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md)
# or examine Sections 6-8 in rules.vc.
#     turn on the 64-bit compiler, if your SDK has it.
#
# 3)  Targets are:
# Possible values of TARGET are:
#	release  -- Builds the core, the shell and the dlls. (default)
#	dlls     -- Just builds the windows extensions
#	shell    -- Just builds the shell and the core.
#	core     -- Only builds the core [tclXX.(dll|lib)].
#	all      -- Builds everything.
#	test     -- Builds and runs the test suite.
#	tcltest  -- Just builds the test shell.
#	install  -- Installs the built binaries and libraries to $(INSTALLDIR)
#		    as the root of the install tree.
#	tidy/clean/hose -- varying levels of cleaning.
#	genstubs -- Rebuilds the Stubs table and support files (dev only).
#	depend   -- Generates an accurate set of source dependancies for this
#		    makefile.  Helpful to avoid problems when the sources are
#		    refreshed and you rebuild, but can "overbuild" when common
#		    headers like tclInt.h just get small changes.
#	htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the
#		    troff manual pages found in $(ROOT)\doc. You need to
#		    have installed the HTML Help Compiler package from Microsoft
#		    to produce the .chm file.
#	winhelp  -- (deprecated) Builds the windows .hlp file for Tcl from
#		    the troff man files found in $(ROOT)\doc. This type of
#		    help file is deprecated by Microsoft in favour of html
#		    help files (.chm)
#
# The steps to setup a Visual C++ environment depend on which
# version of Visual Studio and/or the Windows SDK you are building
# against and are not described here. The simplest method is generally
# 4)  Macros usable on the commandline:
# to start a command shell using one of the short cuts installed by
#	INSTALLDIR=<path>
#		Sets where to install Tcl from the built binaries.
#		C:\Progra~1\Tcl is assumed when not specified.
#
#	OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,tclalloc,unchecked,none
#		Sets special options for the core.  The default is for none.
# Visual Studio/Windows SDK for the appropriate target architecture.
#		Any combination of the above may be used (comma separated).
#		'none' will over-ride everything to nothing.
#
#		loimpact = Adds a flag for how NT treats the heap to keep memory
#			   in use, low.  This is said to impact alloc performance.
#		msvcrt   = Affects the static option only to switch it from
#			   using libcmt(d) as the C runtime [by default] to
#			   msvcrt(d). This is useful for static embedding
#			   support.
#		nothreads= Turns off full multithreading support.
#		pdbs     = Build detached symbols for release builds.
#		profile  = Adds profiling hooks.  Map file is assumed.
#		static   = Builds a static library of the core instead of a
#			   dll.  The static library will contain the dde and reg
#			   extensions. External applications who want to use
#			   this, need to link with the stub library as well as
#			   the static Tcl library.The shell will be static (and
#			   large), as well.
#		staticpkg = Affects the static option only to switch
#			   tclshXX.exe to have the dde and reg extension linked
#			   inside it.
#		symbols  = Debug build. Links to the debug C runtime, disables
#			   optimizations and creates pdb symbols files.
#		thrdalloc = Use the thread allocator (shared global free pool)
#			   This is the default on threaded builds.
#		tclalloc = Use the old non-thread allocator
#		unchecked= Allows a symbols build to not use the debug
#			   enabled runtime (msvcrt.dll not msvcrtd.dll
#			   or libcmt.lib not libcmtd.lib).
#
#	STATS=compdbg,memdbg,none
#		Sets optional memory and bytecode compiler debugging code added
#		to the core.  The default is for none.  Any combination of the
#		above may be used (comma separated).  'none' will over-ride
#		everything to nothing.
# NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform
# SDK (not expressly needed), run setenv.bat after
# vcvars32.bat according to the instructions for it.  This can also
#
#		compdbg  = Enables byte compilation logging.
# turn on the 64-bit compiler, if your SDK has it.
#		memdbg   = Enables the debugging memory allocator.
#
#	CHECKS=64bit,fullwarn,nodep,none
#		Sets special macros for checking compatibility.
#
# Examples:
#		64bit    = Enable 64bit portability warnings (if available)
#		fullwarn = Builds with full compiler and link warnings enabled.
#			    Very verbose.
#       c:\tcl_src\win\>nmake -f makefile.vc release
#		nodep	 = Turns off compatibility macros to ensure the core
#			    isn't being built with deprecated functions.
#       c:\tcl_src\win\>nmake -f makefile.vc test
#       c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols
#
#	MACHINE=(ARM|AMD64|IA64|IX86)
#		Set the machine type used for the compiler, linker, and
#		resource compiler.  This hook is needed to tell the tools
#		when alternate platforms are requested.  IX86 is the default
#		when not specified. If the CPU environment variable has been
#		set (ie: recent Platform SDK) then MACHINE is set from CPU.
#

#	TMP_DIR=<path>
#	OUT_DIR=<path>
#		Hooks to allow the intermediate and output directories to be
#		changed.  $(OUT_DIR) is assumed to be
#		$(BINROOT)\(Release|Debug) based on if symbols are requested.
#		$(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
#
# NOTE:
#	TESTPAT=<file>
#		Reads the tests requested to be run from this file.
# Before modifying this file, check whether the modification is applicable
#
#	CFG_ENCODING=encoding
#		name of encoding for configuration information. Defaults
#		to cp1252
#
# 5)  Examples:
#
#	Basic syntax of calling nmake looks like this:
#	nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]]
#
#                        Standard (no frills)
#       c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
#       Setting environment for using Microsoft Visual C++ tools.
#       c:\tcl_src\win\>nmake -f makefile.vc release
#       c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
#
# to building extensions as well and if so, modify rules.vc instead.

#                         Building for Win64
#       c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
#       Setting environment for using Microsoft Visual C++ tools.
#       c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
#       Targeting Windows pre64 RETAIL
# The PROJECT macro is used by rules.vc for generating appropriate
#       c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64
#
# macros and rules.
PROJECT = tcl

#------------------------------------------------------------------------------
#==============================================================================
###############################################################################


# Default target to build if no target is specified. If unspecified, the
# rules.vc file will set up "all" as the target.
#    //==================================================================\\
#   >>[               -> Do not modify below this line. <-               ]<<
#   >>[  Please, use the commandline macros to modify how Tcl is built.  ]<<
#   >>[  If you need more features, send us a patch for more macros.     ]<<
#    \\==================================================================//

DEFAULT_BUILD_TARGET = release

###############################################################################
#==============================================================================
#------------------------------------------------------------------------------

# We want to use our own resource file, not the standard template one.
!if !exist("makefile.vc")
MSG = ^
RCFILE = tcl.rc
You must run this makefile only from the directory it is in.^
Please `cd` to its location first.
!error $(MSG)
!endif

PROJECT = tcl
# The rules.vc file does most of the hard work in terms of defining
# the build configuration, macros, output directories etc.
!include "rules.vc"

STUBPREFIX      = $(PROJECT)stub
# Tcl version info based on macros set up by rules.vc
DOTVERSION      = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
VERSION         = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)

# We need versions of various core packages to generate appropriate
# file names during installation.
!if [echo REM = This file is generated from makefile.vc > versions.vc]
!endif
!if [echo PKG_HTTP_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc]
!endif
!if [echo PKG_TCLTEST_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc]
!endif
!if [echo PKG_MSGCAT_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc]
!endif
!if [echo PKG_PLATFORM_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc]
!endif
!if [echo PKG_SHELL_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc]
!endif
!if [echo PKG_DDE_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc]
!endif
!if [echo PKG_REG_VER =\>> versions.vc] \
   && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc]
!endif

!include versions.vc

DDEDOTVERSION = 1.4
DDEVERSION = $(DDEDOTVERSION:.=)

REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)

BINROOT		= $(MAKEDIR)     # originally .
ROOT		= $(MAKEDIR)\..  # originally ..

TCLIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
TCLLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
TCLLIB		= $(OUT_DIR)\$(TCLLIBNAME)

TCLSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
TCLSTUBLIB	= $(OUT_DIR)\$(TCLSTUBLIBNAME)

TCLSHNAME	= $(PROJECT)sh$(VERSION)$(SUFX).exe
TCLSH		= $(OUT_DIR)\$(TCLSHNAME)

TCLREGLIBNAME	= $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB	= $(OUT_DIR)\$(TCLREGLIBNAME)

TCLDDELIBNAME	= $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB	= $(OUT_DIR)\$(TCLDDELIBNAME)

TCLTEST		= $(OUT_DIR)\$(PROJECT)test.exe
CAT32		= $(OUT_DIR)\cat32.exe

# Can we run what we build? IX86 runs on all architectures.
!ifndef TCLSH_NATIVE
!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
TCLSH_NATIVE	= $(TCLSH)
!else
!error You must explicitly set TCLSH_NATIVE for cross-compilation
!endif
!endif

### Make sure we use backslash only.
LIB_INSTALL_DIR		= $(_INSTALLDIR)\lib
BIN_INSTALL_DIR		= $(_INSTALLDIR)\bin
DOC_INSTALL_DIR		= $(_INSTALLDIR)\doc
SCRIPT_INSTALL_DIR	= $(_INSTALLDIR)\lib\tcl$(DOTVERSION)
INCLUDE_INSTALL_DIR	= $(_INSTALLDIR)\include

TCLSHOBJS = \
	$(TMP_DIR)\tclAppInit.obj \
!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
	$(TMP_DIR)\tclWinReg.obj \
	$(TMP_DIR)\tclWinDde.obj \
323
324
325
326
327
328
329

330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346

347
348
349
350
351
352
353
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245







+

















+







	$(TMP_DIR)\tclPathObj.obj \
	$(TMP_DIR)\tclPipe.obj \
	$(TMP_DIR)\tclPkg.obj \
	$(TMP_DIR)\tclPkgConfig.obj \
	$(TMP_DIR)\tclPosixStr.obj \
	$(TMP_DIR)\tclPreserve.obj \
	$(TMP_DIR)\tclProc.obj \
	$(TMP_DIR)\tclProcess.obj \
	$(TMP_DIR)\tclRegexp.obj \
	$(TMP_DIR)\tclResolve.obj \
	$(TMP_DIR)\tclResult.obj \
	$(TMP_DIR)\tclScan.obj \
	$(TMP_DIR)\tclStringObj.obj \
	$(TMP_DIR)\tclStrToD.obj \
	$(TMP_DIR)\tclStubInit.obj \
	$(TMP_DIR)\tclThread.obj \
	$(TMP_DIR)\tclThreadAlloc.obj \
	$(TMP_DIR)\tclThreadJoin.obj \
	$(TMP_DIR)\tclThreadStorage.obj \
	$(TMP_DIR)\tclTimer.obj \
	$(TMP_DIR)\tclTomMathInterface.obj \
	$(TMP_DIR)\tclTrace.obj \
	$(TMP_DIR)\tclUtf.obj \
	$(TMP_DIR)\tclUtil.obj \
	$(TMP_DIR)\tclVar.obj \
	$(TMP_DIR)\tclZipfs.obj \
	$(TMP_DIR)\tclZlib.obj

ZLIBOBJS = \
	$(TMP_DIR)\adler32.obj \
	$(TMP_DIR)\compress.obj \
	$(TMP_DIR)\crc32.obj \
	$(TMP_DIR)\deflate.obj \
454
455
456
457
458
459
460
461


462
463

464
465

466
467
468
469
470
471
472
473
474
475

476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492

493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519


520
521
522
523
524
525

526
527
528
529

530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596


597

598
599
600

601
602
603
604
605


606
607
608
609
610
611
612
613
614
615
616

617
618
619
620
621
622
623
624
625
626
627
628

629
630
631
632
633
634

635
636

637
638
639



640
641
642



643

644
645
646

647
648
649

650
651
652
653

654
655
656
657
658

659
660
661
662

663
664
665
666
667
668

669
670
671
672

673
674
675
676
677
678
679
346
347
348
349
350
351
352

353
354
355

356


357

358


359
360




361

















362



























363
364




365

366




367















































368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385


386
387
388
389
390
391

392
393

394


395
396
397








398

399
400
401
402
403
404
405
406





407


408
409


410
411
412
413
414


415
416
417
418
419
420
421
422
423

424
425
426

427
428
429

430
431
432
433

434
435
436
437
438

439
440
441


442
443
444
445
446
447

448
449
450


451
452
453
454
455
456
457
458







-
+
+

-
+
-
-
+
-

-
-


-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-

-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


















-
-
+
+

+


-
+

-

-
-
+
+

-
-
-
-
-
-
-
-

-
+







-
-
-
-
-
+
-
-


-
-
+


+

-
-
+
+
+



+
+
+
-
+


-
+


-
+



-
+




-
+


-
-
+





-
+


-
-
+







!endif

TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)

TCLSTUBOBJS = \
	$(TMP_DIR)\tclStubLib.obj \
	$(TMP_DIR)\tclTomMathStubLib.obj \
	$(TMP_DIR)\tclOOStubLib.obj
	$(TMP_DIR)\tclOOStubLib.obj \
	$(TMP_DIR)\tclWinPanic.obj

### The following paths CANNOT have spaces in them.
### The following paths CANNOT have spaces in them as they appear on
COMPATDIR	= $(ROOT)\compat
DOCDIR		= $(ROOT)\doc
### the left side of implicit rules.
GENERICDIR	= $(ROOT)\generic
TOMMATHDIR	= $(ROOT)\libtommath
TOOLSDIR	= $(ROOT)\tools
WINDIR		= $(ROOT)\win
PKGSDIR		= $(ROOT)\pkgs

#---------------------------------------------------------------------
# Compile flags
#---------------------------------------------------------------------

# Additional include and C macro definitions for the implicit rules
!if !$(DEBUG)
!if $(OPTIMIZING)
### This cranks the optimization level to maximize speed
cdebug	= -O2 $(OPTIMIZATIONS)
!else
cdebug	=
!endif
!if $(SYMBOLS)
cdebug	= $(cdebug) -Zi
!endif
!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
### Warnings are too many, can't support warnings into errors.
cdebug	= -Zi -Od $(DEBUGFLAGS)
!else
cdebug	= -Zi -WX $(DEBUGFLAGS)
!endif

# defined in rules.vc
### Common compiler options that are architecture specific
!if "$(MACHINE)" == "ARM"
carch = -D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE
!else
carch =
!endif

### Declarations common to all compiler options
cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE
cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\

!if $(MSVCRT)
!if $(DEBUG) && !$(UNCHECKED)
crt = -MDd
!else
crt = -MD
!endif
!else
!if $(DEBUG) && !$(UNCHECKED)
crt = -MTd
!else
crt = -MT
!endif
!endif

TCL_INCLUDES	= -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
TCL_DEFINES	= -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1
PRJ_INCLUDES	= -I"$(TOMMATHDIR)"
PRJ_DEFINES	= -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1 -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE
BASE_CFLAGS	= $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
CON_CFLAGS	= $(cflags) $(cdebug) $(crt) -DCONSOLE
TCL_CFLAGS	= $(BASE_CFLAGS) $(OPTDEFINES)
STUB_CFLAGS     = $(cflags) $(cdebug) $(OPTDEFINES)


# Additional Link libraries needed beyond those in rules.vc
#---------------------------------------------------------------------
# Link flags
#---------------------------------------------------------------------

PRJ_LIBS   = netapi32.lib user32.lib userenv.lib ws2_32.lib
!if $(DEBUG)
ldebug	= -debug -debugtype:cv
!else
ldebug	= -release -opt:ref -opt:icf,3
!if $(SYMBOLS)
ldebug	= $(ldebug) -debug -debugtype:cv
!endif
!endif

### Declarations common to all linker options
lflags	= -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)

!if $(PROFILE)
lflags	= $(lflags) -profile
!endif

!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
lflags	= $(lflags) -nodefaultlib:libucrt.lib
!endif

!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
### Align sections for PE size savings.
lflags	= $(lflags) -opt:nowin98
!else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
### Align sections for speed in loading by choosing the virtual page size.
lflags	= $(lflags) -align:4096
!endif

!if $(LOIMPACT)
lflags	= $(lflags) -ws:aggressive
!endif

dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows

baselibs   = netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
baselibs   = $(baselibs) bufferoverflowU.lib
!endif
!endif
!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
baselibs   = $(baselibs) ucrt.lib
!endif

#---------------------------------------------------------------------
# TclTest flags
#---------------------------------------------------------------------

!if "$(TESTPAT)" != ""
TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
!endif


#---------------------------------------------------------------------
# Project specific targets
#---------------------------------------------------------------------

release:    setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
core:	    setup $(TCLLIB) $(TCLSTUBLIB)
shell:	    setup $(TCLSH)
dlls:	    setup $(TCLREGLIB) $(TCLDDELIB)
all:	    setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs
tcltest:    setup $(TCLTEST) dlls $(CAT32)
all:	    setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
tcltest:    setup $(TCLTEST) dlls
install:    install-binaries install-libraries install-docs install-pkgs
setup:      default-setup

test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls $(CAT32)
test-core: setup $(TCLTEST) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
!if "$(OS)" == "Windows_NT"  || "$(MSVCDIR)" == "IDE"
	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
		package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]
		package ifneeded dde 1.4.1 [list load "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry]
<<
!else
	@echo Please wait while the tests are collected...
	$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
		package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.2 "$(TCLREGLIB:\=/)" registry]
<<
	type tests.log | more
!endif

runtest: setup $(TCLTEST) dlls $(CAT32)
runtest: setup $(TCLTEST) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) $(SCRIPT)

runshell: setup $(TCLSH) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLSH) $(SCRIPT)

setup:
	@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
	@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)

!if !$(STATIC_BUILD)
!if $(STATIC_BUILD)
$(TCLIMPLIB): $(TCLLIB)
!endif

$(TCLLIB): $(TCLOBJS)
!if $(STATIC_BUILD)
	$(lib32) -nologo $(LINKERFLAGS) -out:$@ @<<
	$(LIBCMD) @<<
$**
<<

!else
	$(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \
		$(baselibs) @<<

$(TCLLIB): $(TCLOBJS)
	$(DLLCMD) @<<
$**
<<
	$(_VC_MANIFEST_EMBED_DLL)

$(TCLIMPLIB): $(TCLLIB)

!endif
!endif # $(STATIC_BUILD)

$(TCLSTUBLIB): $(TCLSTUBOBJS)
	$(lib32) -nologo $(LINKERFLAGS) -nodefaultlib -out:$@ $(TCLSTUBOBJS)
	$(LIBCMD) -nodefaultlib $(TCLSTUBOBJS)

$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
	$(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
	$(CONEXECMD) -stack:2300000 $**
	$(_VC_MANIFEST_EMBED_EXE)

$(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
	$(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
	$(CONEXECMD) -stack:2300000 $**
	$(_VC_MANIFEST_EMBED_EXE)

!if $(STATIC_BUILD)
$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
	$(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
	$(LIBCMD) $**
!else
$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
	$(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \
		$** $(baselibs)
	$(DLLCMD) $**
	$(_VC_MANIFEST_EMBED_DLL)
!endif

!if $(STATIC_BUILD)
$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
	$(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
	$(LIBCMD) $**
!else
$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
	$(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \
		$** $(baselibs)
	$(DLLCMD) $**
	$(_VC_MANIFEST_EMBED_DLL)
!endif

pkgs:
	@for /d %d in ($(PKGSDIR)\*) do \
	  @if exist "%~fd\win\makefile.vc" ( \
	    pushd "%~fd\win" & \
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
480
481
482
483
484
485
486






487
488
489
490
491
492
493







-
-
-
-
-
-







	@for /d %d in ($(PKGSDIR)\*) do \
	  @if exist "%~fd\win\makefile.vc" ( \
	    pushd "%~fd\win" & \
	    $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\
	    popd \
	  )

$(CAT32): $(WINDIR)\cat.c
	$(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
	$(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \
		$(baselibs)
	$(_VC_MANIFEST_EMBED_EXE)

#---------------------------------------------------------------------
# Regenerate the stubs files.  [Development use only]
#---------------------------------------------------------------------

genstubs:
!if !exist($(TCLSH))
	@echo Build tclsh first!
742
743
744
745
746
747
748
749
750
751






752
753
754
755
756
757
758
759
760
761
762
763

764
765
766
767
768
769
770
771
772

773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856















857
858
859
860
861
862
863

864
865
866
867
868
869
870
871
872
873

874
875
876
877
878
879
880
881

882
883
884
885
886
887
888
889
890

891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
515
516
517
518
519
520
521



522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538

539
540
541
542
543
544
545
546
547

548
549
550
551
552
553
554
555
556
557
558
559
560
561
562




























































563
564
565
566
567





568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599

600
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615
616

617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634

635
636
637
638
639
640
641







-
-
-
+
+
+
+
+
+











-
+








-
+














-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







+









-
+







-
+








-
+

















-







		> "$(GENERICDIR)\tclTomMath.h"
!endif

#---------------------------------------------------------------------
# Build the Windows HTML help file.
#---------------------------------------------------------------------

# NOTE: you can define HHC on the command-line to override this
!ifndef HHC
HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe""
# NOTE: you can define HHC on the command-line to override this.
# nmake does not set macro values if already set on the command line.
!if defined(PROCESSOR_ARCHITECTURE) && "$(PROCESSOR_ARCHITECTURE)" == "AMD64"
HHC="%ProgramFiles(x86)%\HTML Help Workshop\hhc.exe"
!else
HHC="%ProgramFiles%\HTML Help Workshop\hhc.exe"
!endif
HTMLDIR=$(OUT_DIR)\html
HTMLBASE=TclTk$(VERSION)
HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm

htmlhelp: chmsetup $(CHMFILE)

$(CHMFILE): $(DOCDIR)\*
	@$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)"
	@echo Compiling HTML help project
	-$(HHC) <<$(HHPFILE) >NUL
	-"$(HHC)" <<$(HHPFILE) >NUL
[OPTIONS]
Compatibility=1.1 or later
Compiled file=$(HTMLBASE).chm
Default topic=contents.htm
Display compile progress=no
Error log file=$(HTMLBASE).log
Full-text search=Yes
Language=0x409 English (United States)
Title=Tcl/Tk $(DOT_VERSION) Help
Title=Tcl/Tk $(DOTVERSION) Help
[FILES]
contents.htm
docs.css
Keywords\*.htm
TclCmd\*.htm
TclLib\*.htm
TkCmd\*.htm
TkLib\*.htm
UserCmd\*.htm
<<

chmsetup:
	@if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR)

#-------------------------------------------------------------------------
# Build the old-style Windows .hlp file
#-------------------------------------------------------------------------

TCLHLPBASE	= $(PROJECT)$(VERSION)
HELPFILE	= $(OUT_DIR)\$(TCLHLPBASE).hlp
HELPCNT		= $(OUT_DIR)\$(TCLHLPBASE).cnt
DOCTMP_DIR	= $(OUT_DIR)\$(PROJECT)_docs
HELPRTF		= $(DOCTMP_DIR)\$(PROJECT).rtf
MAN2HELP	= $(DOCTMP_DIR)\man2help.tcl
MAN2HELP2	= $(DOCTMP_DIR)\man2help2.tcl
INDEX		= $(DOCTMP_DIR)\index.tcl
BMP		= $(DOCTMP_DIR)\feather.bmp
BMP_NOPATH	= feather.bmp
MAN2TCL		= $(DOCTMP_DIR)\man2tcl.exe

winhelp: docsetup $(HELPFILE)

docsetup:
	@if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)

$(MAN2HELP) $(MAN2HELP2) $(INDEX) $(BMP): $(TOOLSDIR)\$$(@F)
	@$(CPY) $(TOOLSDIR)\$(@F) $(@D)

$(HELPFILE): $(HELPRTF) $(BMP)
	cd $(DOCTMP_DIR)
	start /wait hcrtf.exe -x <<$(PROJECT).hpj
[OPTIONS]
COMPRESS=12 Hall Zeck
LCID=0x409 0x0 0x0 ; English (United States)
TITLE=Tcl/Tk Reference Manual
BMROOT=.
CNT=$(@B).cnt
HLP=$(@B).hlp

[FILES]
$(PROJECT).rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,27648,(r15263976),(r65535)

[CONFIG]
BrowseButtons()
CreateButton(1, "Web", ExecFile("http://www.tcl.tk"))
CreateButton(2, "SF", ExecFile("http://sf.net/projects/tcl"))
CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
<<
	cd $(MAKEDIR)
	@$(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
	@$(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"

$(MAN2TCL): $(TOOLSDIR)\$$(@B).c
	$(cc32) $(TCL_CFLAGS) -Fo$(@D)\ $(TOOLSDIR)\$(@B).c
	$(link32) $(conlflags) -out:$@ -stack:16384 $(@D)\man2tcl.obj
	$(_VC_MANIFEST_EMBED_EXE)

$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\*
	$(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/)

install-docs:
!if exist("$(CHMFILE)")
	@echo Installing compiled HTML help
	@$(CPY) "$(CHMFILE)" "$(DOC_INSTALL_DIR)\"
!endif
!if exist("$(HELPFILE)")
	@echo Installing Windows help
	@$(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
	@$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
!endif

# "emacs font-lock highlighting fix

#---------------------------------------------------------------------
# Generate the tcl.nmake file which contains the options used to build
# Tcl itself. This is used when building extensions.
#---------------------------------------------------------------------
tcl-nmake: $(OUT_DIR)\tcl.nmake
$(OUT_DIR)\tcl.nmake:
	@type << >$@
CORE_MACHINE = $(MACHINE)
CORE_DEBUG = $(DEBUG)
CORE_USE_THREAD_ALLOC = $(USE_THREAD_ALLOC)
CORE_USE_WIDECHAR_API = $(USE_WIDECHAR_API)
<<

#---------------------------------------------------------------------
# Build tclConfig.sh for the TEA build system.
#---------------------------------------------------------------------

tclConfig: $(OUT_DIR)\tclConfig.sh

# TBD - is this tclConfig.sh file ever used? The values are incorrect!
$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
	@echo Creating tclConfig.sh
        @nmakehlp -s << $** >$@
@TCL_DLL_FILE@       $(TCLLIBNAME)
@TCL_VERSION@        $(DOTVERSION)
@TCL_MAJOR_VERSION@  $(TCL_MAJOR_VERSION)
@TCL_MINOR_VERSION@  $(TCL_MINOR_VERSION)
@TCL_PATCH_LEVEL@    $(TCL_PATCH_LEVEL)
@CC@                 $(CC)
@DEFS@               $(TCL_CFLAGS)
@DEFS@               $(pkgcflags)
@CFLAGS_DEBUG@       -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd
@CFLAGS_OPTIMIZE@    -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD
@LDFLAGS_DEBUG@      -nologo -machine:$(MACHINE) -debug -debugtype:cv
@LDFLAGS_OPTIMIZE@   -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
@TCL_DBGX@           $(SUFX)
@TCL_LIB_FILE@       $(PROJECT)$(VERSION)$(SUFX).lib
@TCL_NEEDS_EXP_FILE@
@LIBS@               $(baselibs)
@LIBS@               $(baselibs) $(PRJ_LIBS)
@prefix@             $(_INSTALLDIR)
@exec_prefix@        $(BIN_INSTALL_DIR)
@SHLIB_CFLAGS@
@STLIB_CFLAGS@
@CFLAGS_WARNING@     -W3
@EXTRA_CFLAGS@       -YX
@SHLIB_LD@           $(link32) $(dlllflags)
@STLIB_LD@           $(lib32) -nologo
@SHLIB_LD_LIBS@      $(baselibs)
@SHLIB_LD_LIBS@      $(baselibs) $(PRJ_LIBS)
@SHLIB_SUFFIX@       .dll
@DL_LIBS@
@LDFLAGS@
@TCL_CC_SEARCH_FLAGS@
@TCL_LD_SEARCH_FLAGS@
@LIBOBJS@
@RANLIB@
@TCL_LIB_FLAG@
@TCL_BUILD_LIB_SPEC@
@TCL_LIB_SPEC@       $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
@TCL_INCLUDE_SPEC@   -I$(INCLUDE_INSTALL_DIR)
@TCL_LIB_VERSIONS_OK@
@TCL_SRC_DIR@        $(ROOT)
@TCL_PACKAGE_PATH@
@TCL_STUB_LIB_FILE@  $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_FLAG@  $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_SPEC@  -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)
@TCL_THREADS@        $(TCL_THREADS)
@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
@TCL_STUB_LIB_PATH@  $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
@CFG_TCL_EXPORT_FILE_SUFFIX@  $(VERSION)$(SUFX).lib
@CFG_TCL_SHARED_LIB_SUFFIX@   $(VERSION)$(SUFX).dll
@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
!if $(STATIC_BUILD)
934
935
936
937
938
939
940
941

942
943
944
945
946

947
948
949
950

951
952
953

954
955

956



957
958
959

960
961
962

963
964
965
966
967
968
969
970
971
972


973
974
975
976

977
978
979
980
981
982
983
984
985

986
987

988
989
990
991
992
993

994
995

996
997
998
999
1000
1001
1002
1003
1004

1005
1006
1007

1008
1009

1010



1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031

1032
1033
1034
1035
1036
1037
1038
660
661
662
663
664
665
666

667
668
669
670
671

672
673
674
675

676
677
678

679
680
681
682

683
684
685
686
687

688
689
690

691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706

707
708
709
710
711

712
713
714

715
716

717
718
719
720
721
722

723
724

725
726
727
728
729
730
731
732
733

734
735
736

737
738
739
740

741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763

764
765
766
767
768
769
770
771







-
+




-
+



-
+


-
+


+
-
+
+
+


-
+


-
+










+
+



-
+




-



-
+

-
+





-
+

-
+








-
+


-
+


+
-
+
+
+




















-
+







	$(GENERICDIR)/tclGetDate.y

#---------------------------------------------------------------------
# Special case object file targets
#---------------------------------------------------------------------

$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
	$(cc32) $(TCL_CFLAGS) -DTCL_TEST \
	$(cc32) $(appcflags) -DTCL_TEST \
	    -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
	    -Fo$@ $?

$(TMP_DIR)\tclMain2.obj: $(GENERICDIR)\tclMain.c
	$(cc32) $(TCL_CFLAGS) -DBUILD_tcl -DTCL_ASCII_MAIN \
	$(cc32) $(pkgcflags) -DTCL_ASCII_MAIN \
	    -Fo$@ $?

$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
	$(cc32) $(TCL_CFLAGS) -Fo$@ $?
	$(cc32) $(appcflags) -Fo$@ $?

$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
	$(cc32) $(TCL_CFLAGS) -Fo$@ $?
	$(cc32) $(appcflags) -Fo$@ $?

$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
	$(CCAPPCMD) $?
	$(cc32) $(TCL_CFLAGS) -Fo$@ $?

$(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c
	$(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip -Fo$@ $?

$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
	$(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $?
	$(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $?

$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
	$(cc32) -DBUILD_tcl $(TCL_CFLAGS) \
	$(cc32) $(pkgcflags) \
	-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
	-DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\""	\
	-DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
	-DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\""     \
	-DCFG_RUNTIME_DLLFILE="\"$(CFG_RUNTIME_DLLFILE:\=\\)\""     \
	-DCFG_RUNTIME_ZIPFILE="\"$(CFG_RUNTIME_ZIPFILE:\=\\)\""     \
	-Fo$@ $?

$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
	$(cc32) $(TCL_CFLAGS) \
	$(cc32) $(appcflags) \
	    -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
	    -Fo$@ $?

### The following objects should be built using the stub interfaces
### *ALL* extensions need to built with -DTCL_THREADS=1

$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
!if $(STATIC_BUILD)
	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
	$(cc32) $(appcflags) -DSTATIC_BUILD -Fo$@ $?
!else
	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
	$(cc32) $(appcflags) -DUSE_TCL_STUBS -Fo$@ $?
!endif


$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
!if $(STATIC_BUILD)
	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
	$(cc32) $(appcflags) -DSTATIC_BUILD -Fo$@ $?
!else
	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
	$(cc32) $(appcflags) -DUSE_TCL_STUBS -Fo$@ $?
!endif


### The following objects are part of the stub library and should not
### be built as DLL objects.  -Zl is used to avoid a dependency on any
### specific C run-time.

$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
	$(cc32) $(stubscflags) -Fo$@ $?

$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
	$(cc32) $(stubscflags) -Fo$@ $?

$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
	$(cc32) $(stubscflags) -Fo$@ $?
	$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?

$(TMP_DIR)\tclWinPanic.obj: $(WINDIR)\tclWinPanic.c
	$(cc32) $(stubscflags) -Fo$@ $?

$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
	@nmakehlp -s << $** >$@
@MACHINE@	  $(MACHINE:IX86=X86)
@TCL_WIN_VERSION@  $(DOTVERSION).0.0
<<

#---------------------------------------------------------------------
# Generate the source dependencies.  Having dependency rules will
# improve incremental build accuracy without having to resort to a
# full rebuild just because some non-global header file like
# tclCompile.h was changed.  These rules aren't needed when building
# from scratch.
#---------------------------------------------------------------------

depend:
!if !exist($(TCLSH))
	@echo Build tclsh first!
!else
	$(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
		-passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
		-passthru:"-DBUILD_tcl $(TCL_INCLUDES) $(PRJ_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
		$(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<<
$(TCLOBJS)
<<
!endif

#---------------------------------------------------------------------
# Dependency rules
1046
1047
1048
1049
1050
1051
1052

1053

1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064

1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079

1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090

1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117


1118
1119
1120
1121
1122
1123
1124














1125
1126
1127
1128
1129
1130
1131
779
780
781
782
783
784
785
786

787
788
789
790
791





792

793










794
795
796
797

798
799
800
801








802



803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822




823
824
825






826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846







+
-
+




-
-
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-




-
+



-
-
-
-
-
-
-
-
+
-
-
-




















-
-
-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+







!endif

### add a spacer in the output
!message


#---------------------------------------------------------------------
# Implicit rules that are not covered by the common ones defined in
# Implicit rules.  A limitation exists with nmake that requires that
# rules.vc. A limitation exists with nmake that requires that
# source directory can not contain spaces in the path.  This an
# absolute.
#---------------------------------------------------------------------

{$(WINDIR)}.c{$(TMP_DIR)}.obj::
	$(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<

{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj::
	$(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
	$(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<<
$<
<<

{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
	$(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<

{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
	$(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<

{$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj::
	$(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
	$(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<<
$<
<<

{$(WINDIR)}.rc{$(TMP_DIR)}.res:
	$(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
	    -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
	    -d TCL_THREADS=$(TCL_THREADS) \
	    -d STATIC_BUILD=$(STATIC_BUILD) \
	    $<

$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest
$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WINDIR)\tclsh.rc

.SUFFIXES:
.SUFFIXES:.c .rc


#---------------------------------------------------------------------
# Installation.
#---------------------------------------------------------------------

install-binaries:
	@echo Installing to '$(_INSTALLDIR)'
	@echo Installing $(TCLLIBNAME)
!if "$(TCLLIB)" != "$(TCLIMPLIB)"
	@$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\"
!endif
	@$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
!if exist($(TCLSH))
	@echo Installing $(TCLSHNAME)
	@$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
!endif
	@echo Installing $(TCLSTUBLIBNAME)
	@$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"

#" emacs fix

install-libraries: tclConfig install-msgs install-tzdata
	@if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \
install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
	@if not exist "$(SCRIPT_INSTALL_DIR)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.7" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.7"
	@if not exist "$(LIB_INSTALL_DIR)\nmake" \
		$(MKDIR) "$(LIB_INSTALL_DIR)\nmake"
	@echo Installing header files
	@$(CPY) "$(GENERICDIR)\tcl.h"             "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclDecls.h"        "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclOO.h"           "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclOODecls.h"      "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclPlatDecls.h"    "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclTomMath.h"      "$(INCLUDE_INSTALL_DIR)\"
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150




1151
1152
1153
1154
1155
1156

1157
1158
1159

1160
1161
1162

1163
1164
1165

1166
1167
1168

1169
1170
1171
1172
1173
1174
1175
856
857
858
859
860
861
862



863
864
865
866
867
868
869
870
871

872
873
874

875
876
877

878
879
880

881
882
883

884
885
886
887
888
889
890
891







-
-
-
+
+
+
+





-
+


-
+


-
+


-
+


-
+







	@$(CPY) "$(ROOT)\library\safe.tcl"        "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\tclIndex"        "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\package.tcl"     "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\word.tcl"        "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\auto.tcl"        "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(OUT_DIR)\tclConfig.sh"         "$(LIB_INSTALL_DIR)\"
	@$(CPY) "$(WINDIR)\tclooConfig.sh"        "$(LIB_INSTALL_DIR)\"
	@echo Installing library http1.0 directory
	@$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
	    "$(SCRIPT_INSTALL_DIR)\http1.0\"
	@$(CPY) "$(WINDIR)\rules.vc"              "$(LIB_INSTALL_DIR)\nmake\"
	@$(CPY) "$(WINDIR)\targets.vc"              "$(LIB_INSTALL_DIR)\nmake\"
	@$(CPY) "$(WINDIR)\nmakehlp.c"            "$(LIB_INSTALL_DIR)\nmake\"
	@$(CPY) "$(OUT_DIR)\tcl.nmake"            "$(LIB_INSTALL_DIR)\nmake\"
	@echo Installing library opt0.4 directory
	@$(CPY) "$(ROOT)\library\opt\*.tcl" \
	    "$(SCRIPT_INSTALL_DIR)\opt0.4\"
	@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
	@$(COPY) "$(ROOT)\library\http\http.tcl" \
	    "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\http-$(PKG_HTTP_VER).tm"
	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm"
	@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
	@$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
	    "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\msgcat-$(PKG_MSGCAT_VER).tm"
	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.7\msgcat-$(PKG_MSGCAT_VER).tm"
	@echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
	@$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
	    "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\tcltest-$(PKG_TCLTEST_VER).tm"
	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
	@echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
	@$(COPY) "$(ROOT)\library\platform\platform.tcl" \
	    "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform-$(PKG_PLATFORM_VER).tm"
	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform-$(PKG_PLATFORM_VER).tm"
	@echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
	@$(COPY) "$(ROOT)\library\platform\shell.tcl" \
	    "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform\shell-$(PKG_SHELL_VER).tm"
	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm"
	@echo Installing $(TCLDDELIBNAME)
!if $(STATIC_BUILD)
!if !$(TCL_USE_STATIC_PACKAGES)
	@$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\"
!endif
!else
	@$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
1185
1186
1187
1188
1189
1190
1191
1192

1193
1194
1195
1196
1197
1198
1199
1200
901
902
903
904
905
906
907

908

909
910
911
912
913
914
915







-
+
-







	@$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
	@$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \
	    "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
!endif
	@echo Installing encodings
	@$(CPY) "$(ROOT)\library\encoding\*.enc" \
		"$(SCRIPT_INSTALL_DIR)\encoding\"

# "emacs font-lock highlighting fix
#" emacs fix

install-tzdata:
	@echo Installing time zone data
	@set TCL_LIBRARY=$(ROOT:\=/)/library
	@$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
	    "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"

1220
1221
1222
1223
1224
1225
1226
1227

1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244

1245
1246
1247
1248
1249
1250
1251
1252
1253
935
936
937
938
939
940
941

942

















943
944
945




946
947
948







-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+


-
-
-
-



	@echo Removing $(TCLTEST) ...
	@if exist $(TCLTEST) del $(TCLTEST)
	@echo Removing $(TCLDDELIB) ...
	@if exist $(TCLDDELIB) del $(TCLDDELIB)
	@echo Removing $(TCLREGLIB) ...
	@if exist $(TCLREGLIB) del $(TCLREGLIB)

clean: clean-pkgs
clean: default-clean clean-pkgs
	@echo Cleaning $(TMP_DIR)\* ...
	@if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
	@echo Cleaning $(WINDIR)\nmakehlp.obj ...
	@if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
	@echo Cleaning $(WINDIR)\nmakehlp.exe ...
	@if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
	@echo Cleaning $(WINDIR)\nmhlp-out.txt ...
	@if exist $(WINDIR)\nmhlp-out.txt del $(WINDIR)\nmhlp-out.txt
	@echo Cleaning $(WINDIR)\_junk.pch ...
	@if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
	@echo Cleaning $(WINDIR)\vercl.x ...
	@if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
	@echo Cleaning $(WINDIR)\vercl.i ...
	@if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
	@echo Cleaning $(WINDIR)\versions.vc ...
	@if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc

hose: default-hose
realclean: hose

hose:
	@echo Hosing $(OUT_DIR)\* ...
	@if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)

# Local Variables:
# mode: makefile
# End:

Changes to win/nmakehlp.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

50
51
52
53
54
55
56
10
11
12
13
14
15
16




17
18

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51







-
-
-
-


-


















-







+







 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ----------------------------------------------------------------------------
 */

#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
#define NO_SHLWAPI_GDI
#define NO_SHLWAPI_STREAM
#define NO_SHLWAPI_REG
#include <shlwapi.h>
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
#pragma comment (lib, "shlwapi.lib")
#include <stdio.h>
#include <math.h>

/*
 * This library is required for x64 builds with _some_ versions of MSVC
 */
#if defined(_M_IA64) || defined(_M_AMD64)
#if _MSC_VER >= 1400 && _MSC_VER < 1500
#pragma comment(lib, "bufferoverflowU")
#endif
#endif

/* ISO hack for dumb VC++ */
#ifdef _MSC_VER
#define   snprintf	_snprintf
#endif



/* protos */

static int CheckForCompilerFeature(const char *option);
static int CheckForLinkerFeature(const char **options, int count);
static int IsIn(const char *string, const char *substring);
static int SubstituteFile(const char *substs, const char *filename);
static int QualifyPath(const char *path);
static int LocateDependency(const char *keyfile);
static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
static DWORD WINAPI ReadFromPipe(LPVOID args);

/* globals */

#define CHUNK	25
#define STATICBUFFERSIZE    1000
70
71
72
73
74
75
76
77

78
79
80
81
82
83
84
65
66
67
68
69
70
71

72
73
74
75
76
77
78
79







-
+







main(
    int argc,
    char *argv[])
{
    char msg[300];
    DWORD dwWritten;
    int chars;
    char *s;
    const char *s;

    /*
     * Make sure children (cl.exe and link.exe) are kept quiet.
     */

    SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX);

168
169
170
171
172
173
174












175
176
177
178
179
180
181
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188







+
+
+
+
+
+
+
+
+
+
+
+







		    "Emit the fully qualified path\n"
		    "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
		    &dwWritten, NULL);
		return 2;
	    }
	    return QualifyPath(argv[2]);

	case 'L':
	    if (argc != 3) {
		chars = snprintf(msg, sizeof(msg) - 1,
		    "usage: %s -L keypath\n"
		    "Emit the fully qualified path of directory containing keypath\n"
		    "exitcodes: 0 == success, 1 == not found, 2 == error\n", argv[0]);
		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
		    &dwWritten, NULL);
		return 2;
	    }
	    return LocateDependency(argv[2]);
	}
    }
    chars = snprintf(msg, sizeof(msg) - 1,
	    "usage: %s -c|-f|-l|-Q|-s|-V ...\n"
	    "This is a little helper app to equalize shell differences between WinNT and\n"
	    "Win9x and get nmake.exe to accomplish its job.\n",
	    argv[0]);
672
673
674
675
676
677
678











679
680
681
682
683
684
685
686
687
688
689
690
691

















692
693
694
695
696
697
698
699
700
701















































































702
703
704
705
706
707
708
709
710
711
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726










727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815







+
+
+
+
+
+
+
+
+
+
+













+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











	list_free(&substPtr);
    }
    fclose(fp);
    return 0;
}

BOOL FileExists(LPCTSTR szPath)
{
#ifndef INVALID_FILE_ATTRIBUTES
    #define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
#endif
    DWORD pathAttr = GetFileAttributes(szPath);
    return (pathAttr != INVALID_FILE_ATTRIBUTES &&
	    !(pathAttr & FILE_ATTRIBUTE_DIRECTORY));
}


/*
 * QualifyPath --
 *
 *	This composes the current working directory with a provided path
 *	and returns the fully qualified and normalized path.
 *	Mostly needed to setup paths for testing.
 */

static int
QualifyPath(
    const char *szPath)
{
    char szCwd[MAX_PATH + 1];

	GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL);
    printf("%s\n", szCwd);
    return 0;
}

/*
 * Implements LocateDependency for a single directory. See that command
 * for an explanation.
 * Returns 0 if found after printing the directory.
 * Returns 1 if not found but no errors.
 * Returns 2 on any kind of error
 * Basically, these are used as exit codes for the process.
 */
static int LocateDependencyHelper(const char *dir, const char *keypath)
{
    HANDLE hSearch;
    char szTmp[MAX_PATH + 1];
    char *p;
    GetCurrentDirectory(MAX_PATH, szCwd);
    while ((p = strchr(szPath, '/')) && *p)
	*p = '\\';
    PathCombine(szTmp, szCwd, szPath);
    PathCanonicalize(szCwd, szTmp);
    printf("%s\n", szCwd);
    return 0;
}
    char path[MAX_PATH+1];
    int dirlen, keylen, ret;
    WIN32_FIND_DATA finfo;

    if (dir == NULL || keypath == NULL)
	return 2; /* Have no real error reporting mechanism into nmake */
    dirlen = strlen(dir);
    if ((dirlen + 3) > sizeof(path))
	return 2;
    strncpy(path, dir, dirlen);
    strncpy(path+dirlen, "\\*", 3);	/* Including terminating \0 */
    keylen = strlen(keypath);

#if 0 /* This function is not available in Visual C++ 6 */
    /*
     * Use numerics 0 -> FindExInfoStandard,
     * 1 -> FindExSearchLimitToDirectories,
     * as these are not defined in Visual C++ 6
     */
    hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0);
#else
    hSearch = FindFirstFile(path, &finfo);
#endif
    if (hSearch == INVALID_HANDLE_VALUE)
	return 1; /* Not found */

    /* Loop through all subdirs checking if the keypath is under there */
    ret = 1; /* Assume not found */
    do {
	int sublen;
	/*
	 * We need to check it is a directory despite the
	 * FindExSearchLimitToDirectories in the above call. See SDK docs
	 */
	if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0)
	    continue;
	sublen = strlen(finfo.cFileName);
	if ((dirlen+1+sublen+1+keylen+1) > sizeof(path))
	    continue;		/* Path does not fit, assume not matched */
	strncpy(path+dirlen+1, finfo.cFileName, sublen);
	path[dirlen+1+sublen] = '\\';
	strncpy(path+dirlen+1+sublen+1, keypath, keylen+1);
	if (FileExists(path)) {
	    /* Found a match, print to stdout */
	    path[dirlen+1+sublen] = '\0';
	    QualifyPath(path);
	    ret = 0;
	    break;
	}
    } while (FindNextFile(hSearch, &finfo));
    FindClose(hSearch);
    return ret;
}

/*
 * LocateDependency --
 *
 *	Locates a dependency for a package.
 *        keypath - a relative path within the package directory
 *          that is used to confirm it is the correct directory.
 *	The search path for the package directory is currently only
 *      the parent and grandparent of the current working directory.
 *      If found, the command prints
 *         name_DIRPATH=<full path of located directory>
 *      and returns 0. If not found, does not print anything and returns 1.
 */
static int LocateDependency(const char *keypath)
{
    int i, ret;
    static char *paths[] = {"..", "..\\..", "..\\..\\.."};

    for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
	ret = LocateDependencyHelper(paths[i], keypath);
	if (ret == 0)
	    return ret;
    }
    return ret;
}


/*
 * Local variables:
 *   mode: c
 *   c-basic-offset: 4
 *   fill-column: 78
 *   indent-tabs-mode: t
 *   tab-width: 8
 * End:
 */

Added win/rules-ext.vc.























































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# This file should only be included in makefiles for Tcl extensions,
# NOT in the makefile for Tcl itself.

!ifndef _RULES_EXT_VC

# We need to run from the directory the parent makefile is located in.
# nmake does not tell us what makefile was used to invoke it so parent
# makefile has to set the MAKEFILEVC macro or we just make a guess and
# warn if we think that is not the case.
!if "$(MAKEFILEVC)" == ""

!if exist("$(PROJECT).vc")
MAKEFILEVC = $(PROJECT).vc
!elseif exist("makefile.vc")
MAKEFILEVC = makefile.vc
!endif
!endif # "$(MAKEFILEVC)" == ""

!if !exist("$(MAKEFILEVC)")
MSG = ^
You must run nmake from the directory containing the project makefile.^
If you are doing that and getting this message, set the MAKEFILEVC^
macro to the name of the project makefile.
!message WARNING: $(MSG)
!endif

!if "$(PROJECT)" == "tcl"
!error The rules-ext.vc file is not intended for Tcl itself.
!endif

# We extract version numbers using the nmakehlp program. For now use
# the local copy of nmakehlp. Once we locate Tcl, we will use that
# one if it is newer.
!if [$(CC) -nologo "nmakehlp.c" -link -subsystem:console > nul]
!endif

# First locate the Tcl directory that we are working with.
!if "$(TCLDIR)" != ""

_RULESDIR = $(TCLDIR:/=\)

!else

# If an installation path is specified, that is also the Tcl directory.
# Also Tk never builds against an installed Tcl, it needs Tcl sources
!if defined(INSTALLDIR) && "$(PROJECT)" != "tk"
_RULESDIR=$(INSTALLDIR:/=\)
!else
# Locate Tcl sources
!if [echo _RULESDIR = \> nmakehlp.out] \
   || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
_RULESDIR = ..\..\tcl
!else
!include nmakehlp.out
!endif

!endif # defined(INSTALLDIR)....

!endif # ifndef TCLDIR

# Now look for the targets.vc file under the Tcl root. Note we check this
# file and not rules.vc because the latter also exists on older systems.
!if exist("$(_RULESDIR)\lib\nmake\targets.vc") # Building against installed Tcl
_RULESDIR = $(_RULESDIR)\lib\nmake
!elseif exist("$(_RULESDIR)\win\targets.vc")   # Building against Tcl sources
_RULESDIR = $(_RULESDIR)\win
!else
# If we have not located Tcl's targets file, most likely we are compiling
# against an older version of Tcl and so must use our own support files.
_RULESDIR = .
!endif

!if "$(_RULESDIR)" != "."
# Potentially using Tcl's support files. If this extension has its own
# nmake support files, need to compare the versions and pick newer.

!if exist("rules.vc") # The extension has its own copy

!if [echo TCL_RULES_MAJOR = \> versions.vc] \
   && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MAJOR >> versions.vc]
!endif
!if [echo TCL_RULES_MINOR = \>> versions.vc] \
   && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MINOR >> versions.vc]
!endif

!if [echo OUR_RULES_MAJOR = \>> versions.vc] \
   && [nmakehlp -V "rules.vc" RULES_VERSION_MAJOR >> versions.vc]
!endif
!if [echo OUR_RULES_MINOR = \>> versions.vc] \
   && [nmakehlp -V "rules.vc" RULES_VERSION_MINOR >> versions.vc]
!endif
!include versions.vc
# We have a newer version of the support files, use them
!if ($(TCL_RULES_MAJOR) != $(OUR_RULES_MAJOR)) || ($(TCL_RULES_MINOR) < $(OUR_RULES_MINOR))
_RULESDIR = .
!endif

!endif # if exist("rules.vc")

!endif # if $(_RULESDIR) != "."

# Let rules.vc know what copy of nmakehlp.c to use.
NMAKEHLPC = $(_RULESDIR)\nmakehlp.c

# Get rid of our internal defines before calling rules.vc
!undef TCL_RULES_MAJOR
!undef TCL_RULES_MINOR
!undef OUR_RULES_MAJOR
!undef OUR_RULES_MINOR

!if exist("$(_RULESDIR)\rules.vc")
!message *** Using $(_RULESDIR)\rules.vc
!include "$(_RULESDIR)\rules.vc"
!else
!error *** Could not locate rules.vc in $(_RULESDIR)
!endif

!endif # _RULES_EXT_VC

Changes to win/rules.vc.

1

2
3
4
5







6
7
8
9
10
11

12
13
14
15
16





17
18
19
20


















21
22
23



24

25



26
27











28
29





































































30
31
32
33
34
35
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
51
52
53
54



































55
56
57

























































































































































































































































58
59
60
61
62
63
64
65
66
67
68
69

70

71
72
73
74




75


76

77
78




















79
80
81
82
83
84
85
86
87
88
89
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
128
129




130
131

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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175

176
177
178
179
180








181
182
183




184
185


186

187


188




189
190




























191



192
193

194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210


211
212

213

214
215
216




















217






218
219

220
221
222
223
224
225
226
227
228
229
230



231









232
233
234
235
236





237

238
239
240
241
242
243
244
245
246
247
248
249
250
251
252


253
254
255
256
257
258
259

260
261
262
263
264
265
266
267
268
269
270
271
272

273
274
275
276
277
278

279
280
281
282
283
284

285
286
287
288
289
290
291
292
293

294
295

296
297
298
299
300

301
302
303
304
305
306
307

308
309
310
311
312
313





314
315






































































































316


































































317

318

319
320
321

322
323
324
325



326
327

328
329
330
331



















332
333
334
335
336
337
338

1
2
3


4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27




28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46


47
48
49

50
51
52
53
54


55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
128
129
130
131
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183



184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443

444
445
446
447
448
449
450
451
452
453
454
455
456
457

458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492




493
494
495
496


497



498
499
500





501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526

527



528
529
530
531
532
533







534
535
536
537
538
539
540
541
542
543
544
545
546


547
548
549
550




551
552
553
554


555

556
557
558
559
560
561



562


563
564





565
566



567



















568
569
570
571
572
573

574
575
576
577
578
579
580
581
582
583
584
585
586
587



588
589
590
591


592
593
594
595

596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632

633
634
635
636

637













638
639
640
641
642
643
644

645
646
647
648


649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668

669
670
671
672
673
674
675

676
677
678
679
680
681
682
683

684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702


703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723

724
725
726
727
728
729
730
731

732







733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764

765



766

767



768

769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886

887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954

955



956




957
958
959


960




961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
-
+


-
-
+
+
+
+
+
+
+






+





+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+
+
-
+

+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-

-
-
-
-
-

+

-
-
-
-
-
-
-
-


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+

+




+
+
+
+

+
+
-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












-
-
-
-




-
-
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+


+
+
+
+
+
+
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-
+
-
+
+

+
+

-
-
-
+
-
-


-
-
-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+





+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
-
-
+
+

+
-
+
+

+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-




+
+

-
+

+

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+

-
+







-



+
+
+

+
+
+
+
+
+
+
+
+



-
-
+
+
+
+
+

+














-
+
+






-
+
-
-
-
-
-
-
-






+






+






+









+

-
+
-
-
-

-
+
-
-
-

-


+






+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+
-
-
-
+
-
-
-
-
+
+
+
-
-
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







#------------------------------------------------------------------------------
#------------------------------------------------------------- -*- makefile -*-
# rules.vc --
#
#	Microsoft Visual C++ makefile include for decoding the commandline
#	macros.  This file does not need editing to build Tcl.
# Part of the nmake based build system for Tcl and its extensions.
# This file does all the hard work in terms of parsing build options,
# compiler switches, defining common targets and macros. The Tcl makefile
# directly includes this. Extensions include it via "rules-ext.vc".
#
# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for
# detailed documentation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 2001-2003 David Gravereaux.
# Copyright (c) 2003-2008 Patrick Thoyts
# Copyright (c) 2017      Ashok P. Nadkarni
#------------------------------------------------------------------------------

!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
cc32		= $(CC)   # built-in default.
link32		= link
lib32		= lib
rc32		= $(RC)   # built-in default.

# 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)" == ""
PRJ_PACKAGE_TCLNAME = $(PROJECT)
!endif

# Also special case Tcl and Tk to save some typing later
DOING_TCL = 0
DOING_TK  = 0
!if "$(PROJECT)" == "tcl"
DOING_TCL = 1
!elseif "$(PROJECT)" == "tk"
DOING_TK = 1
!endif

!ifndef INSTALLDIR
### Assume the normal default.
!ifndef NEED_TK
# Backwards compatibility
!ifdef PROJECT_REQUIRES_TK
_INSTALLDIR	= C:\Program Files\Tcl
NEED_TK = $(PROJECT_REQUIRES_TK)
!else
NEED_TK = 0
!endif
!endif
### Fix the path separators.
_INSTALLDIR	= $(INSTALLDIR:/=\)

!ifndef NEED_TCL_SOURCE
NEED_TCL_SOURCE = 0
!endif

!ifdef NEED_TK_SOURCE
!if $(NEED_TK_SOURCE)
NEED_TK = 1
!endif
!else
NEED_TK_SOURCE = 0
!endif

################################################################
# Nmake is a pretty weak environment in syntax and capabilities
# so this file is necessarily verbose. It's broken down into
# the following parts.
#
# 0. Sanity check that compiler environment is set up and initialize
#    any built-in settings from the parent makefile
# 1. First define the external tools used for compiling, copying etc.
#    as this is independent of everything else.
# 2. Figure out our build structure in terms of the directory, whether
#    we are building Tcl or an extension, etc.
# 3. Determine the compiler and linker versions
# 4. Build the nmakehlp helper application
# 5. Determine the supported compiler options and features
# 6. Parse the OPTS macro value for user-specified build configuration
# 7. Parse the STATS macro value for statistics instrumentation
# 8. Parse the CHECKS macro for additional compilation checks
# 9. Extract Tcl, and possibly Tk, version numbers from the headers
# 10. Based on this selected configuration, construct the output
#     directory and file paths
# 11. Construct the paths where the package is to be installed
# 12. Set up the actual options passed to compiler and linker based
#     on the information gathered above.
# 13. Define some standard build targets and implicit rules. These may
#     be optionally disabled by the parent makefile.
# 14. (For extensions only.) Compare the configuration of the target
#     Tcl and the extensions and warn against discrepancies.
#
# One final note about the macro names used. They are as they are
# for historical reasons. We would like legacy extensions to
# continue to work with this make include file so be wary of
# changing them for consistency or clarity.

# 0. Sanity check compiler environment

# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)

!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
MSG = ^
Visual C++ compiler environment not initialized.
!error $(MSG)
!endif

# We need to run from the directory the parent makefile is located in.
# nmake does not tell us what makefile was used to invoke it so parent
# makefile has to set the MAKEFILEVC macro or we just make a guess and
# warn if we think that is not the case.
!if "$(MAKEFILEVC)" == ""

!if exist("$(PROJECT).vc")
MAKEFILEVC = $(PROJECT).vc
!elseif exist("makefile.vc")
MAKEFILEVC = makefile.vc
!endif
!endif # "$(MAKEFILEVC)" == ""

!if !exist("$(MAKEFILEVC)")
MSG = ^
You must run nmake from the directory containing the project makefile.^
If you are doing that and getting this message, set the MAKEFILEVC^
macro to the name of the project makefile.
!message WARNING: $(MSG)
!endif


################################################################
# 1. Define external programs being used

#----------------------------------------------------------
# Set the proper copy method to avoid overwrite questions
# to the user when copying files and selecting the right
# "delete all" method.
#----------------------------------------------------------

!if "$(OS)" == "Windows_NT"
RMDIR	= rmdir /S /Q
ERRNULL  = 2>NUL
!if ![ver | find "4.0" > nul]
CPY	= echo y | xcopy /i >NUL
COPY	= copy >NUL
!else
CPY	= xcopy /i /y >NUL
CPYDIR  = xcopy /e /i /y >NUL
COPY	= copy /y >NUL
!endif
!else # "$(OS)" != "Windows_NT"
CPY	= xcopy /i >_JUNK.OUT # On Win98 NUL does not work here.
COPY	= copy >_JUNK.OUT # On Win98 NUL does not work here.
RMDIR	= deltree /Y
NULL    = \NUL # Used in testing directory existence
ERRNULL = >NUL # Win9x shell cannot redirect stderr
!endif
MKDIR   = mkdir

######################################################################
# 2. Figure out our build environment in terms of what we're building.
#
# (a) Tcl itself
# (b) Tk
# (c) a Tcl extension using libraries/includes from an *installed* Tcl
# (d) a Tcl extension using libraries/includes from Tcl source directory
#
# This last is needed because some extensions still need
# some Tcl interfaces that are not publicly exposed.
#
# The fragment will set the following macros:
# ROOT - root of this module sources
# COMPATDIR - source directory that holds compatibility sources
# DOCDIR - source directory containing documentation files
# GENERICDIR - platform-independent source directory
# WINDIR - Windows-specific source directory
# TESTDIR - directory containing test files
# TOOLSDIR - directory containing build tools
# _TCLDIR - root of the Tcl installation OR the Tcl sources. Not set
#    when building Tcl itself.
# _INSTALLDIR - native form of the installation path. For Tcl
#    this will be the root of the Tcl installation. For extensions
#    this will be the lib directory under the root.
# TCLINSTALL  - set to 1 if _TCLDIR refers to
#    headers and libraries from an installed Tcl, and 0 if built against
#    Tcl sources. Not set when building Tcl itself. Yes, not very well
#    named.
# _TCL_H - native path to the tcl.h file
#
# If Tk is involved, also sets the following
# _TKDIR - native form Tk installation OR Tk source. Not set if building
#    Tk itself.
# TKINSTALL - set 1 if _TKDIR refers to installed Tk and 0 if Tk sources
# _TK_H - native path to the tk.h file
#------------------------------------------------------------------------------
# Determine the host and target architectures and compiler version.
#------------------------------------------------------------------------------

# Root directory for sources and assumed subdirectories
ROOT = $(MAKEDIR)\..
# The following paths CANNOT have spaces in them as they appear on the
# left side of implicit rules.
!ifndef COMPATDIR
COMPATDIR	= $(ROOT)\compat
!endif
!ifndef DOCDIR
DOCDIR		= $(ROOT)\doc
!endif
!ifndef GENERICDIR
GENERICDIR	= $(ROOT)\generic
!endif
!ifndef TOOLSDIR
TOOLSDIR	= $(ROOT)\tools
!endif
!ifndef TESTDIR
TESTDIR	= $(ROOT)\tests
!endif
!ifndef LIBDIR
!if exist("$(ROOT)\library")
LIBDIR          = $(ROOT)\library
!else
LIBDIR          = $(ROOT)\lib
!endif
!endif
!ifndef DEMODIR
!if exist("$(LIBDIR)\demos")
DEMODIR		= $(LIBDIR)\demos
!else
DEMODIR		= $(ROOT)\demos
!endif
!endif # ifndef DEMODIR
# Do NOT enclose WINDIR in a !ifndef because Windows always defines
# WINDIR env var to point to c:\windows!
# TBD - This is a potentially dangerous conflict, rename WINDIR to
# something else
WINDIR		= $(ROOT)\win

!ifndef RCDIR
!if exist("$(WINDIR)\rc")
RCDIR           = $(WINDIR)\rc
!else
RCDIR           = $(WINDIR)
!endif
!endif
RCDIR = $(RCDIR:/=\)

# The target directory where the built packages and binaries will be installed.
# INSTALLDIR is the (optional) path specified by the user.
# _INSTALLDIR is INSTALLDIR using the backslash separator syntax
!ifdef INSTALLDIR
### Fix the path separators.
_INSTALLDIR	= $(INSTALLDIR:/=\)
!else
### Assume the normal default.
_INSTALLDIR	= $(HOMEDRIVE)\Tcl
!endif

!if $(DOING_TCL)

# BEGIN Case 2(a) - Building Tcl itself

# Only need to define _TCL_H
_TCL_H = ..\generic\tcl.h

# END Case 2(a) - Building Tcl itself

!elseif $(DOING_TK)

# BEGIN Case 2(b) - Building Tk

TCLINSTALL = 0 # Tk always builds against Tcl source, not an installed Tcl
!if "$(TCLDIR)" == ""
!if [echo TCLDIR = \> nmakehlp.out] \
   || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
!error *** Could not locate Tcl source directory.
!endif
!include nmakehlp.out
!endif # TCLDIR == ""

_TCLDIR	= $(TCLDIR:/=\)
_TCL_H  = $(_TCLDIR)\generic\tcl.h
!if !exist("$(_TCL_H)")
!error Could not locate tcl.h. Please set the TCLDIR macro to point to the Tcl *source* directory.
!endif

_TK_H = ..\generic\tk.h

# END Case 2(b) - Building Tk

!else

# BEGIN Case 2(c) or (d) - Building an extension other than Tk

# If command line has specified Tcl location through TCLDIR, use it
# else default to the INSTALLDIR setting
!if "$(TCLDIR)" != ""

_TCLDIR	= $(TCLDIR:/=\)
!if exist("$(_TCLDIR)\include\tcl.h") # Case 2(c) with TCLDIR defined
TCLINSTALL	= 1
_TCL_H          = $(_TCLDIR)\include\tcl.h
!elseif exist("$(_TCLDIR)\generic\tcl.h") # Case 2(d) with TCLDIR defined
TCLINSTALL	= 0
_TCL_H          = $(_TCLDIR)\generic\tcl.h
!endif

!else  #  # Case 2(c) for extensions with TCLDIR undefined

# Need to locate Tcl depending on whether it needs Tcl source or not.
# If we don't, check the INSTALLDIR for an installed Tcl first

!if exist("$(_INSTALLDIR)\include\tcl.h") && !$(NEED_TCL_SOURCE)

TCLINSTALL	= 1
TCLDIR          = $(_INSTALLDIR)\..
# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions
# later so the \.. accounts for the /lib
_TCLDIR		= $(_INSTALLDIR)\..
_TCL_H          = $(_TCLDIR)\include\tcl.h

!else # exist(...) && ! $(NEED_TCL_SOURCE)

!if [echo _TCLDIR = \> nmakehlp.out] \
   || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
!error *** Could not locate Tcl source directory.
!endif
!include nmakehlp.out
TCLINSTALL      = 0
TCLDIR         = $(_TCLDIR)
_TCL_H          = $(_TCLDIR)\generic\tcl.h

!endif # exist(...) && ! $(NEED_TCL_SOURCE)

!endif # TCLDIR

!ifndef _TCL_H
MSG =^
Failed to find tcl.h. The TCLDIR macro is set incorrectly or is not set and default path does not contain tcl.h.
!error $(MSG)
!endif

# Now do the same to locate Tk headers and libs if project requires Tk
!if $(NEED_TK)

!if "$(TKDIR)" != ""

_TKDIR = $(TKDIR:/=\)
!if exist("$(_TKDIR)\include\tk.h")
TKINSTALL      = 1
_TK_H          = $(_TKDIR)\include\tk.h
!elseif exist("$(_TKDIR)\generic\tk.h")
TKINSTALL      = 0
_TK_H          = $(_TKDIR)\generic\tk.h
!endif

!else # TKDIR not defined

# Need to locate Tcl depending on whether it needs Tcl source or not.
# If we don't, check the INSTALLDIR for an installed Tcl first

!if exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)

TKINSTALL      = 1
# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions
# later so the \.. accounts for the /lib
_TKDIR         = $(_INSTALLDIR)\..
_TK_H          = $(_TKDIR)\include\tk.h
TKDIR          = $(_TKDIR)

!else # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)

!if [echo _TKDIR = \> nmakehlp.out] \
   || [nmakehlp -L generic\tk.h >> nmakehlp.out]
!error *** Could not locate Tk source directory.
!endif
!include nmakehlp.out
TKINSTALL      = 0
TKDIR          = $(_TKDIR)
_TK_H          = $(_TKDIR)\generic\tk.h

!endif # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)

!endif # TKDIR

!ifndef _TK_H
MSG =^
Failed to find tk.h. The TKDIR macro is set incorrectly or is not set and default path does not contain tk.h.
!error $(MSG)
!endif

!endif # NEED_TK

!if $(NEED_TCL_SOURCE) && $(TCLINSTALL)
MSG = ^
*** Warning: This extension requires the source distribution of Tcl.^
*** Please set the TCLDIR macro to point to the Tcl sources.
!error $(MSG)
!endif

!if $(NEED_TK_SOURCE)
!if $(TKINSTALL)
MSG = ^
*** Warning: This extension requires the source distribution of Tk.^
*** Please set the TKDIR macro to point to the Tk sources.
!error $(MSG)
!endif
!endif


# If INSTALLDIR set to Tcl installation root dir then reset to the
# lib dir for installing extensions
!if exist("$(_INSTALLDIR)\include\tcl.h")
_INSTALLDIR=$(_INSTALLDIR)\lib
!endif

# END Case 2(c) or (d) - Building an extension
!endif # if $(DOING_TCL)

################################################################
# 3. Determine compiler version and architecture
# In this section, we figure out the compiler version and the
# architecture for which we are building. This sets the
# following macros:
# VCVERSION - the internal compiler version as 1200, 1400, 1910 etc.
#     This is also printed by the compiler in dotted form 19.10 etc.
# VCVER - the "marketing version", for example Visual C++ 6 for internal
#     compiler version 1200. This is kept only for legacy reasons as it
#     does not make sense for recent Microsoft compilers. Only used for
#     output directory names.
# ARCH - set to IX86 or AMD64 depending on 32- or 64-bit target
# NATIVE_ARCH - set to IX86 or AMD64 for the host machine
# MACHINE - same as $(ARCH) - legacy
# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed
# CFG_ENCODING - set to an character encoding.
#   TBD - this is passed to compiler as TCL_CFGVAL_ENCODING but can't
#   see where it is used

cc32		= $(CC)   # built-in default.
link32		= link
lib32		= lib
rc32		= $(RC)   # built-in default.

#----------------------------------------------------------------
# Figure out the compiler architecture and version by writing
# the C macros to a file, preprocessing them with the C
# preprocessor and reading back the created file

_HASH=^#
_VC_MANIFEST_EMBED_EXE=
_VC_MANIFEST_EMBED_DLL=
VCVER=0
!if ![echo VCVERSION=_MSC_VER > vercl.x] \
    && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \
    && ![echo ARCH=IX86 >> vercl.x] \
    && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
    && ![echo ARCH=AMD64 >> vercl.x] \
    && ![echo $(_HASH)endif >> vercl.x] \
    && ![cl -nologo -TC -P vercl.x $(ERRNULL)]
    && ![$(cc32) -nologo -TC -P vercl.x 2>NUL]
!include vercl.i
!if $(VCVERSION) < 1900
!if ![echo VCVER= ^\> vercl.vc] \
    && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc]
!include vercl.vc
!endif
!else
# The simple calculation above does not apply to new Visual Studio releases
# Keep the compiler version in its native form.
VCVER = $(VCVERSION)
!endif
!endif

!if ![del $(ERRNUL) /q/f vercl.x vercl.i vercl.vc]
!if ![del 2>NUL /q/f vercl.x vercl.i vercl.vc]
!endif

#----------------------------------------------------------------
# The MACHINE macro is used by legacy makefiles so set it as well
!ifdef MACHINE
!if "$(MACHINE)" == "x86"
!undef MACHINE
MACHINE = IX86
!elseif "$(MACHINE)" == "x64"
!undef MACHINE
MACHINE = AMD64
!endif
!if "$(MACHINE)" != "$(ARCH)"
!error Specified MACHINE macro $(MACHINE) does not match detected target architecture $(ARCH).
!endif
!else
MACHINE=$(ARCH)
!endif

#------------------------------------------------------------
# Figure out the *host* architecture by reading the registry

!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86]
NATIVE_ARCH=IX86
!else
NATIVE_ARCH=AMD64
!endif

# Since MSVC8 we must deal with manifest resources.
!if $(VCVERSION) >= 1400
_VC_MANIFEST_EMBED_EXE=if exist [email protected] mt -nologo -manifest [email protected] -outputresource:$@;1
_VC_MANIFEST_EMBED_DLL=if exist [email protected] mt -nologo -manifest [email protected] -outputresource:$@;2
!endif

!ifndef MACHINE
MACHINE=$(ARCH)
!endif

!ifndef CFG_ENCODING
CFG_ENCODING	= \"cp1252\"
!endif

!message ===============================================================================

################################################################
#----------------------------------------------------------
# build the helper app we need to overcome nmake's limiting
# environment.
# 4. Build the nmakehlp program
# This is a helper app we need to overcome nmake's limiting
# environment. We will call out to it to get various bits of
#----------------------------------------------------------

!if !exist(nmakehlp.exe)
!if [$(cc32) -nologo nmakehlp.c -link -subsystem:console > nul]
!endif
# information about supported compiler options etc.
#
# Tcl itself will always use the nmakehlp.c program which is
# in its own source. This is the "master" copy and kept updated.
#
# Extensions built against an installed Tcl will use the installed
# copy of Tcl's nmakehlp.c if there is one and their own version
# otherwise. In the latter case, they would also be using their own
# rules.vc. Note that older versions of Tcl do not install nmakehlp.c
# or rules.vc.
#
# Extensions built against Tcl sources will use the one from the Tcl source.
#
# When building an extension using a sufficiently new version of Tcl,
# rules-ext.vc will define NMAKEHLPC appropriately to point to the
# copy of nmakehlp.c to be used.

!ifndef NMAKEHLPC
# Default to the one in the current directory (the extension's own nmakehlp.c)
NMAKEHLPC = nmakehlp.c

!if !$(DOING_TCL)
!if $(TCLINSTALL)
!if exist("$(_TCLDIR)\lib\nmake\nmakehlp.c")
NMAKEHLPC = $(_TCLDIR)\lib\nmake\nmakehlp.c
!endif

!else # ! $(TCLINSTALL)
#----------------------------------------------------------
# Test for compiler features
#----------------------------------------------------------
!if exist("$(_TCLDIR)\win\nmakehlp.c")
NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c
!endif
!endif # $(TCLINSTALL)
!endif # !$(DOING_TCL)

### test for optimizations
!if [nmakehlp -c -Ot]
!message *** Compiler has 'Optimizations'
OPTIMIZING	= 1
!else
!message *** Compiler does not have 'Optimizations'
OPTIMIZING	= 0
!endif # NMAKEHLPC

# We always build nmakehlp even if it exists since we do not know
# what source it was built from.
!if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul]
!endif

################################################################
# 5. Test for compiler features
# Visual C++ compiler options have changed over the years. Check
# which options are supported by the compiler in use.
#
# The following macros are set:
OPTIMIZATIONS   =

# OPTIMIZATIONS - the compiler flags to be used for optimized builds
# DEBUGFLAGS - the compiler flags to be used for debug builds
# LINKERFLAGS - Flags passed to the linker
#
!if [nmakehlp -c -Ot]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -Ot
!endif

# Note that these are the compiler settings *available*, not those
# that will be *used*. The latter depends on the OPTS macro settings
# which we have not yet parsed.
#
!if [nmakehlp -c -Oi]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -Oi
# Also note that some of the flags in OPTIMIZATIONS are not really
!endif
# related to optimization. They are placed there only for legacy reasons
# as some extensions expect them to be included in that macro.

# -Op improves float consistency. Note only needed for older compilers
# Newer compilers do not need or support this option.
!if [nmakehlp -c -Op]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -Op
!endif

FPOPTS  = -Op
!if [nmakehlp -c -fp:strict]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -fp:strict
!endif

!if [nmakehlp -c -Gs]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -Gs
!endif

!if [nmakehlp -c -GS]
# Strict floating point semantics - present in newer compilers in lieu of -Op
!if [nmakehlp -c -fp:strict]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -GS
!endif

FPOPTS  = $(FPOPTS) -fp:strict
!if [nmakehlp -c -GL]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -GL
!endif

DEBUGFLAGS     =

!if [nmakehlp -c -RTC1]
DEBUGFLAGS     = $(DEBUGFLAGS) -RTC1
!elseif [nmakehlp -c -GZ]
DEBUGFLAGS     = $(DEBUGFLAGS) -GZ
!endif

COMPILERFLAGS  =-W3 /DUNICODE /D_UNICODE /D_ATL_XP_TARGETING

# In v13 -GL and -YX are incompatible.
!if [nmakehlp -c -YX]
!if ![nmakehlp -c -GL]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -YX
!endif
!endif

!if "$(MACHINE)" == "IX86"
### test for pentium errata
!if [nmakehlp -c -QI0f]
!message *** Compiler has 'Pentium 0x0f fix'
COMPILERFLAGS  = $(COMPILERFLAGS) -QI0f
FPOPTS  = $(FPOPTS) -QI0f
!else
!message *** Compiler does not have 'Pentium 0x0f fix'
!endif
!endif

### test for optimizations
# /O2 optimization includes /Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy as per
# documentation. Note we do NOT want /Gs as that inserts a _chkstk
# stack probe at *every* function entry, not just those with more than
# a page of stack allocation resulting in a performance hit.  However,
# /O2 documentation is misleading as its stack probes are simply the
# default page size locals allocation probes and not what is implied
# by an explicit /Gs option.
!if "$(MACHINE)" == "IA64"
### test for Itanium errata
!if [nmakehlp -c -QIA64_Bx]

OPTIMIZATIONS = $(FPOPTS)

!if [nmakehlp -c -O2]
!message *** Compiler has 'B-stepping errata workarounds'
COMPILERFLAGS   = $(COMPILERFLAGS) -QIA64_Bx
OPTIMIZING = 1
OPTIMIZATIONS   = $(OPTIMIZATIONS) -O2
!else
# Legacy, really. All modern compilers support this
!message *** Compiler does not have 'B-stepping errata workarounds'
!message *** Compiler does not have 'Optimizations'
OPTIMIZING = 0
!endif

# Checks for buffer overflows in local arrays
!if [nmakehlp -c -GS]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -GS
!endif

# Link time optimization. Note that this option (potentially) makes
# generated libraries only usable by the specific VC++ version that
# created it. Requires /LTCG linker option
!if [nmakehlp -c -GL]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -GL
CC_GL_OPT_ENABLED = 1
!else
# In newer compilers -GL and -YX are incompatible.
!if [nmakehlp -c -YX]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -YX
!endif
!endif # [nmakehlp -c -GL]

DEBUGFLAGS     = $(FPOPTS)

# Run time error checks. Not available or valid in a release, non-debug build
# RTC is for modern compilers, -GZ is legacy
!if [nmakehlp -c -RTC1]
DEBUGFLAGS     = $(DEBUGFLAGS) -RTC1
!elseif [nmakehlp -c -GZ]
DEBUGFLAGS     = $(DEBUGFLAGS) -GZ
!endif

#----------------------------------------------------------------
# Linker flags

# LINKER_TESTFLAGS are for internal use when we call nmakehlp to test
# if the linker supports a specific option. Without these flags link will
# Prevents "LNK1561: entry point must be defined" error compiling from VS-IDE:
# return "LNK1561: entry point must be defined" error compiling from VS-IDE:
# They are not passed through to the actual application / extension
# link rules.
!ifndef LINKER_TESTFLAGS
LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmhlp-out.txt
LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmakehlp.out
!endif

!if "$(MACHINE)" == "IX86"
### test for -align:4096, when align:512 will do.
!if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)]
!message *** Linker has 'Win98 alignment problem'
ALIGN98_HACK	= 1
!else
!message *** Linker does not have 'Win98 alignment problem'
ALIGN98_HACK	= 0
!endif
!else
ALIGN98_HACK	= 0
!endif

LINKERFLAGS     =

# If compiler has enabled link time optimization, linker must too with -ltcg
!ifdef CC_GL_OPT_ENABLED
!if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)]
LINKERFLAGS     =-ltcg
LINKERFLAGS     = $(LINKERFLAGS) -ltcg
!endif
!endif

#----------------------------------------------------------
# Decode the options requested.
########################################################################
# 6. Parse the OPTS macro to work out the requested build configuration.
# Based on this, we will construct the actual switches to be passed to the
# compiler and linker using the macros defined in the previous section.
# The following macros are defined by this section based on OPTS
# STATIC_BUILD - 0 -> Tcl is to be built as a shared library
#                1 -> build as a static library and shell
# TCL_THREADS - legacy but always 1 on Windows since winsock requires it.
# DEBUG - 1 -> debug build, 0 -> release builds
# SYMBOLS - 1 -> generate PDB's, 0 -> no PDB's
# PROFILE - 1 -> generate profiling info, 0 -> no profiling
# PGO     - 1 -> profile based optimization, 0 -> no
# MSVCRT  - 1 -> link to dynamic C runtime even when building static Tcl build
#           0 -> link to static C runtime for static Tcl build.
#           Does not impact shared Tcl builds (STATIC_BUILD == 0)
# TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions
#           in the Tcl shell. 0 -> keep them as shared libraries
#           Does not impact shared Tcl builds.
# USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation.
#           0 -> Use the non-thread allocator.
#----------------------------------------------------------
# UNCHECKED - 1 -> when doing a debug build with symbols, use the release
#           C runtime, 0 -> use the debug C runtime.
# USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking
# CONFIG_CHECK - 1 -> check current build configuration against Tcl
#           configuration (ignored for Tcl itself)
# Further, LINKERFLAGS are modified based on above.

!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
# Default values for all the above
STATIC_BUILD	= 0
TCL_THREADS	= 1
DEBUG		= 0
SYMBOLS		= 0
PROFILE		= 0
PGO		= 0
MSVCRT		= 1
LOIMPACT	= 0
TCL_USE_STATIC_PACKAGES	= 0
USE_THREAD_ALLOC = 1
UNCHECKED	= 0
CONFIG_CHECK    = 1
!if $(DOING_TCL)
USE_STUBS       = 0
!else
USE_STUBS       = 1
!endif

# If OPTS is not empty AND does not contain "none" which turns off all OPTS
# set the above macros based on OPTS content
!if "$(OPTS)" != "" && ![nmakehlp -f "$(OPTS)" "none"]

# OPTS are specified, parse them

!if [nmakehlp -f $(OPTS) "static"]
!message *** Doing static
STATIC_BUILD	= 1
!else
STATIC_BUILD	= 0
!endif

!if [nmakehlp -f $(OPTS) "nostubs"]
!message *** Not using stubs
USE_STUBS	= 0
!endif

!if [nmakehlp -f $(OPTS) "nomsvcrt"]
!message *** Doing nomsvcrt
MSVCRT		= 0
!else
!if [nmakehlp -f $(OPTS) "msvcrt"]
!message *** Doing msvcrt
MSVCRT		= 1
!else
!if !$(STATIC_BUILD)
MSVCRT		= 1
!else
MSVCRT		= 0
!endif
!endif
!endif
!endif # [nmakehlp -f $(OPTS) "nomsvcrt"]

!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD)
!message *** Doing staticpkg
TCL_USE_STATIC_PACKAGES	= 1
!else
TCL_USE_STATIC_PACKAGES	= 0
!endif
!if [nmakehlp -f $(OPTS) "nothreads"]

!message *** Compile explicitly for non-threaded tcl
TCL_THREADS	= 0
USE_THREAD_ALLOC= 0
!else
TCL_THREADS	= 1
USE_THREAD_ALLOC= 1
!endif
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols
DEBUG		= 1
!else
DEBUG		= 0
!endif

!if [nmakehlp -f $(OPTS) "pdbs"]
!message *** Doing pdbs
SYMBOLS		= 1
!else
SYMBOLS		= 0
!endif

!if [nmakehlp -f $(OPTS) "profile"]
!message *** Doing profile
PROFILE		= 1
!else
PROFILE		= 0
!endif

!if [nmakehlp -f $(OPTS) "pgi"]
!message *** Doing profile guided optimization instrumentation
PGO		= 1
!elseif [nmakehlp -f $(OPTS) "pgo"]
!message *** Doing profile guided optimization
PGO		= 2
!else
PGO		= 0
!endif

!if [nmakehlp -f $(OPTS) "loimpact"]
!message *** Doing loimpact
!message *** Warning: ignoring option "loimpact" - deprecated on modern Windows.
LOIMPACT	= 1
!else
LOIMPACT	= 0
!endif
!if [nmakehlp -f $(OPTS) "thrdalloc"]

!message *** Doing thrdalloc
USE_THREAD_ALLOC = 1
!endif
!if [nmakehlp -f $(OPTS) "tclalloc"]
!message *** Doing tclalloc
USE_THREAD_ALLOC = 0
!endif

!if [nmakehlp -f $(OPTS) "unchecked"]
!message *** Doing unchecked
UNCHECKED = 1
!else
UNCHECKED = 0
!endif

!if [nmakehlp -f $(OPTS) "noconfigcheck"]
CONFIG_CHECK = 1
!else
CONFIG_CHECK = 0
!endif

!endif # "$(OPTS)" != ""  && ... parsing of OPTS

# Set linker flags based on above

!if $(PGO) > 1
!if [nmakehlp -l -ltcg:pgoptimize $(LINKER_TESTFLAGS)]
LINKERFLAGS	= $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize
!else
MSG=^
This compiler does not support profile guided optimization.
!error $(MSG)
!endif
!elseif $(PGO) > 0
!if [nmakehlp -l -ltcg:pginstrument $(LINKER_TESTFLAGS)]
LINKERFLAGS	= $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument
!else
MSG=^
This compiler does not support profile guided optimization.
!error $(MSG)
!endif
!endif

################################################################
# 7. Parse the STATS macro to configure code instrumentation
# The following macros are set by this section:
# TCL_MEM_DEBUG - 1 -> enables memory allocation instrumentation
#                 0 -> disables
# TCL_COMPILE_DEBUG - 1 -> enables byte compiler logging
#                     0 -> disables

# Default both are off
TCL_MEM_DEBUG	    = 0
TCL_COMPILE_DEBUG   = 0

!if "$(STATS)" != "" && ![nmakehlp -f "$(STATS)" "none"]

!if [nmakehlp -f $(STATS) "memdbg"]
!message *** Doing memdbg
TCL_MEM_DEBUG	    = 1
!else
TCL_MEM_DEBUG	    = 0
!endif

!if [nmakehlp -f $(STATS) "compdbg"]
!message *** Doing compdbg
TCL_COMPILE_DEBUG   = 1
!else
TCL_COMPILE_DEBUG   = 0
!endif

!endif

####################################################################
# 8. Parse the CHECKS macro to configure additional compiler checks
# The following macros are set by this section:
# WARNINGS - compiler switches that control the warnings level
# TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions
#                     0 -> enable deprecated functions

# Defaults - Permit deprecated functions and warning level 3
TCL_NO_DEPRECATED	    = 0
WARNINGS		    = -W3

!if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"]

!if [nmakehlp -f $(CHECKS) "nodep"]
!message *** Doing nodep check
TCL_NO_DEPRECATED	    = 1
!endif

!if [nmakehlp -f $(CHECKS) "fullwarn"]
!message *** Doing full warnings check
WARNINGS		    = -W4
!if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)]
LINKERFLAGS		    = $(LINKERFLAGS) -warn:3
!endif
!endif

!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
!message *** Doing 64bit portability warnings
WARNINGS		    = $(WARNINGS) -Wp64
!endif

!endif

################################################################
# 9. Extract various version numbers
# For Tcl and Tk, version numbers are extracted from tcl.h and tk.h
# respectively. For extensions, versions are extracted from the
# configure.in or configure.ac from the TEA configuration if it
# exists, and unset otherwise.
# Sets the following macros:
# TCL_MAJOR_VERSION
# TCL_MINOR_VERSION
# TCL_PATCH_LEVEL
# TCL_VERSION
# TK_MAJOR_VERSION
# TK_MINOR_VERSION
# TK_PATCH_LEVEL
# TK_VERSION
# DOTVERSION - set as (for example) 2.5
# VERSION - set as (for example 25)
#----------------------------------------------------------
#--------------------------------------------------------------

!if [echo REM = This file is generated from rules.vc > versions.vc]
!endif
!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc]
!endif
!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
!endif
!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
!endif

!if defined(_TK_H)
!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]
!endif
!if [echo TK_MINOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
!endif
!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
!endif
!endif # _TK_H

!include versions.vc

TCL_VERSION	= $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
TCL_DOTVERSION	= $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
!if defined(_TK_H)
TK_VERSION	= $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
TK_DOTVERSION	= $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
!endif

# Set DOTVERSION and VERSION
!if $(DOING_TCL)

DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
VERSION = $(TCL_VERSION)

!elseif $(DOING_TK)

DOTVERSION = $(TK_DOTVERSION)
VERSION = $(TK_VERSION)

!else # Doing a non-Tk extension

# If parent makefile has not defined DOTVERSION, try to get it from TEA
# first from a configure.in file, and then from configure.ac
!ifndef DOTVERSION
!if [echo DOTVERSION = \> versions.vc] \
   || [nmakehlp -V $(ROOT)\configure.in ^[$(PROJECT)^] >> versions.vc]
!if [echo DOTVERSION = \> versions.vc] \
   || [nmakehlp -V $(ROOT)\configure.ac ^[$(PROJECT)^] >> versions.vc]
!error *** Could not figure out extension version. Please define DOTVERSION in parent makefile before including rules.vc.
!endif
!endif
!include versions.vc
!endif # DOTVERSION
VERSION         = $(DOTVERSION:.=)

!endif # $(DOING_TCL) ... etc.

################################################################
# 10. Construct output directory and file paths
# Figure-out how to name our intermediate and output directories.
# In order to avoid inadvertent mixing of object files built using
# We wouldn't want different builds to use the same .obj files
# different compilers, build configurations etc.,
# by accident.
#----------------------------------------------------------

#
#----------------------------------------
# Naming convention:
#   t = full thread support.
#   s = static library (as opposed to an
# Naming convention (suffixes):
#   t = full thread support. (Not used for Tcl >= 8.7)
#   s = static library (as opposed to an import library)
#	import library)
#   g = linked to the debug enabled C
#   g = linked to the debug enabled C run-time.
#	run-time.
#   x = special static build when it
#	links to the dynamic C run-time.
#----------------------------------------
#   x = special static build when it links to the dynamic C run-time.
#
# The following macros are set in this section:
# SUFX - the suffix to use for binaries based on above naming convention
# BUILDDIRTOP - the toplevel default output directory
#      is of the form {Release,Debug}[_AMD64][_COMPILERVERSION]
# TMP_DIR - directory where object files are created
# OUT_DIR - directory where output executables are created
# Both TMP_DIR and OUT_DIR are defaulted only if not defined by the
# parent makefile (or command line). The default values are
# based on BUILDDIRTOP.
# STUBPREFIX - name of the stubs library for this project
# PRJIMPLIB - output path of the generated project import library
# PRJLIBNAME - name of generated project library
# PRJLIB     - output path of generated project library
# PRJSTUBLIBNAME - name of the generated project stubs library
# PRJSTUBLIB - output path of the generated project stubs library
# RESFILE - output resource file (only if not static build)

SUFX	    = tsgx

!if $(DEBUG)
BUILDDIRTOP = Debug
!else
BUILDDIRTOP = Release
!endif
361
362
363
364
365
366
367
368

369
370
371
372
373
374
375
376
377
378
379
380
381
382
383










384
385
386
387





388





389
390
391
392
393
394
395
396
397















398
399

400
401
402
403






404
405





406

407
















408
409
410






411



412
413


414
415



416
417
418
419
420



























421
422
423
424
425








426


427

428
429
430
431
432
433





















434
435











436




437

438
439
440


441
442
443

444

445
446


447
448
449


450
451
452








453
454
455
456




457
















458
459
460
461
462
463
464
465
466
467

468
469
470
471
472
473
474
475
476
477
478
479











480
481
482
483
484
485
486
487
488
489

490
491
492
493
494
495
496
497
498















499
500



501



502






503




504
505

506
507



508



509

510
511
512

513
514
515
516





517
518
519
520




521
522
523
524




525
526
527
528
529














530
531

532
533
534




535




536
537



538
539
540










541




542












543









544

545

546



547
548
549






550
551
552











553
554
555
556



557
558


559
560
561
562
563
564
565
566





567
568
569
570
571
572
573
574
575
576
577
578






















579
580



581
582
583
584

585
586



587


588





























589

590

591
592

593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611


















612
613
614
615



616



617













618
619




620
621
622













623

624
625
626
627
628















629
630
631
632
633
634
635
636
637
638
639
640
641
642

643
644
645
646
647
648
649
650
651

652
653
654
655
656























657

658
659
660




























661


662



663


664
665




666
667
668
669
670
671
672
673




674


675
676
677
678
679
680
681






682
683
684
685
686
687
688
689










690


691

692
693




694
695
696
697
698






699
700

701
702
703

704
705
706
707
708

1009
1010
1011
1012
1013
1014
1015

1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042



1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053









1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069

1070




1071
1072
1073
1074
1075
1076
1077

1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101



1102
1103
1104
1105
1106
1107
1108
1109
1110
1111


1112
1113

1114
1115
1116
1117





1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145




1146
1147
1148
1149
1150
1151
1152
1153

1154
1155
1156
1157






1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196

1197



1198
1199



1200
1201
1202


1203
1204



1205
1206



1207
1208
1209
1210
1211
1212
1213
1214
1215
1216


1217
1218
1219
1220

1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245

1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278

1279
1280
1281
1282
1283
1284
1285



1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301

1302
1303
1304
1305
1306
1307
1308

1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320

1321


1322
1323
1324

1325
1326
1327
1328
1329
1330


1331




1332
1333
1334
1335
1336
1337



1338
1339
1340
1341
1342



1343
1344
1345
1346





1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361

1362


1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377



1378
1379
1380
1381
1382
1383
1384
1385
1386
1387

1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404

1405
1406
1407
1408
1409
1410
1411
1412
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


1444
1445
1446


1447




1448
1449
1450
1451
1452

1453










1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476

1477
1478
1479
1480



1481
1482

1483
1484
1485
1486
1487
1488

1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519

1520


1521



















1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539




1540
1541
1542

1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565



1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580





1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595














1596









1597





1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622



1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653

1654
1655
1656
1657
1658
1659


1660
1661
1662
1663
1664






1665
1666
1667
1668
1669

1670
1671
1672






1673
1674
1675
1676
1677
1678








1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694

1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713


1714



1715

1716







-
+















+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+

+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
-
+
+
+
+
+
+

-
+
+
+
+
+

+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+

+
+
+
-
-
+
+
-

+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
-
+
+

+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
+
-
-
-
+
+
-
-
-
+

+
-
-
+
+
-
-
-
+
+
-
-
-
+
+
+
+
+
+
+
+


-
-
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
+












+
+
+
+
+
+
+
+
+
+
+









-
+






-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+
+

+
+
+
-
+
+
+
+
+
+

+
+
+
+

-
+
-
-
+
+
+
-
+
+
+

+

-
-
+
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+
+

-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-

+
+
+
+

+
+
+
+


+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+

+
-
+
-
+
+
+

-
-
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+
+
-
-
+
+

-
-

-
-
-
-
+
+
+
+
+
-

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+
+

-
-
-
+

-
+
+
+

+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
+
+
+

+
+
-
-
+
+
+
+

-
-
-
-
-
-

+
+
+
+
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

+
+

+

-
+
+
+
+





+
+
+
+
+
+


+

-
-
+
-
-
-

-
+
EXT	    = lib
!if !$(MSVCRT)
TMP_DIRFULL = $(TMP_DIRFULL:X=)
SUFX	    = $(SUFX:x=)
!endif
!endif

!if !$(TCL_THREADS)
!if !$(TCL_THREADS) || $(TCL_VERSION) > 86
TMP_DIRFULL = $(TMP_DIRFULL:Threaded=)
SUFX	    = $(SUFX:t=)
!endif

!ifndef TMP_DIR
TMP_DIR	    = $(TMP_DIRFULL)
!ifndef OUT_DIR
OUT_DIR	    = .\$(BUILDDIRTOP)
!endif
!else
!ifndef OUT_DIR
OUT_DIR	    = $(TMP_DIR)
!endif
!endif

# Relative paths -> absolute
!if [echo OUT_DIR = \> nmakehlp.out] \
   || [nmakehlp -Q "$(OUT_DIR)" >> nmakehlp.out]
!error *** Could not fully qualify path OUT_DIR=$(OUT_DIR)
!endif
!if [echo TMP_DIR = \>> nmakehlp.out] \
   || [nmakehlp -Q "$(TMP_DIR)" >> nmakehlp.out]
!error *** Could not fully qualify path TMP_DIR=$(TMP_DIR)
!endif
!include nmakehlp.out

#----------------------------------------------------------
# Decode the statistics requested.
#----------------------------------------------------------
# The name of the stubs library for the project being built
STUBPREFIX      = $(PROJECT)stub

# Set up paths to various Tcl executables and libraries needed by extensions
!if $(DOING_TCL)

TCLSHNAME       = $(PROJECT)sh$(VERSION)$(SUFX).exe
TCLSH		= $(OUT_DIR)\$(TCLSHNAME)
TCLIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
TCLLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
TCLLIB		= $(OUT_DIR)\$(TCLLIBNAME)
!if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"]
TCL_MEM_DEBUG	    = 0
TCL_COMPILE_DEBUG   = 0
!else
!if [nmakehlp -f $(STATS) "memdbg"]
!message *** Doing memdbg
TCL_MEM_DEBUG	    = 1
!else
TCL_MEM_DEBUG	    = 0

TCLSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
TCLSTUBLIB	= $(OUT_DIR)\$(TCLSTUBLIBNAME)
TCL_INCLUDES    = -I"$(WINDIR)" -I"$(GENERICDIR)"

!else # ! $(DOING_TCL)

!if $(TCLINSTALL) # Building against an installed Tcl

# When building extensions, we need to locate tclsh. Depending on version
# of Tcl we are building against, this may or may not have a "t" suffix.
# Try various possibilities in turn.
TCLSH		= $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist("$(TCLSH)")
TCLSH           = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
!if [nmakehlp -f $(STATS) "compdbg"]

!message *** Doing compdbg
TCL_COMPILE_DEBUG   = 1
!else
TCL_COMPILE_DEBUG   = 0
TCLSTUBLIB	= $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
!endif
TCL_LIBRARY	= $(_TCLDIR)\lib
TCLREGLIB	= $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib
TCLDDELIB	= $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib
TCLTOOLSDIR	= \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES    = -I"$(_TCLDIR)\include"

!else # Building against Tcl sources

TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist($(TCLSH))
TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
TCLSTUBLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
TCL_LIBRARY	= $(_TCLDIR)\library
TCLREGLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib
TCLDDELIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib
TCLTOOLSDIR	= $(_TCLDIR)\tools
TCL_INCLUDES	= -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
#----------------------------------------------------------
# Decode the checks requested.
#----------------------------------------------------------

!endif # TCLINSTALL

tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"

!endif # $(DOING_TCL)

# We need a tclsh that will run on the host machine as part of the build.
# IX86 runs on all architectures.
!ifndef TCLSH_NATIVE
!if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"]
TCL_NO_DEPRECATED	    = 0
!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
TCLSH_NATIVE	= $(TCLSH)
WARNINGS		    = -W3
!else
!error You must explicitly set TCLSH_NATIVE for cross-compilation
!endif
!endif
!if [nmakehlp -f $(CHECKS) "nodep"]
!message *** Doing nodep check
TCL_NO_DEPRECATED	    = 1
!else
TCL_NO_DEPRECATED	    = 0

# Do the same for Tk and Tk extensions that require the Tk libraries
!if $(DOING_TK) || $(NEED_TK)
WISHNAMEPREFIX = wish
WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
TKLIBNAME	= $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT)
TKSTUBLIBNAME	= tkstub$(TK_VERSION).lib
TKIMPLIBNAME	= tk$(TK_VERSION)$(SUFX).lib

!if $(DOING_TK)
WISH 		= $(OUT_DIR)\$(WISHNAME)
TKSTUBLIB	= $(OUT_DIR)\$(TKSTUBLIBNAME)
TKIMPLIB	= $(OUT_DIR)\$(TKIMPLIBNAME)
TKLIB		= $(OUT_DIR)\$(TKLIBNAME)
TK_INCLUDES    = -I"$(WINDIR)" -I"$(GENERICDIR)"

!else # effectively NEED_TK

!if $(TKINSTALL) # Building against installed Tk
WISH		= $(_TKDIR)\bin\$(WISHNAME)
TKSTUBLIB	= $(_TKDIR)\lib\$(TKSTUBLIBNAME)
TKIMPLIB	= $(_TKDIR)\lib\$(TKIMPLIBNAME)
# When building extensions, may be linking against Tk that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TKIMPLIB)")
TKIMPLIBNAME	= tk$(TK_VERSION)$(SUFX:t=).lib
TKIMPLIB	= $(_TKDIR)\lib\$(TKIMPLIBNAME)
!endif
!if [nmakehlp -f $(CHECKS) "fullwarn"]
!message *** Doing full warnings check
WARNINGS		    = -W4
!if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)]
TK_INCLUDES     = -I"$(_TKDIR)\include"
!else # Building against Tk sources
WISH		= $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME)
TKSTUBLIB	= $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME)
TKIMPLIB	= $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
# When building extensions, may be linking against Tk that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TKIMPLIB)")
LINKERFLAGS		    = $(LINKERFLAGS) -warn:3
TKIMPLIBNAME	= tk$(TK_VERSION)$(SUFX:t=).lib
TKIMPLIB	= $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
!endif
TK_INCLUDES     = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
!else
WARNINGS		    = -W3
!endif
!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
!message *** Doing 64bit portability warnings
WARNINGS		    = $(WARNINGS) -Wp64
!endif # TKINSTALL
tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"

!endif # $(DOING_TK)
!endif # $(DOING_TK) || $(NEED_TK)

# Various output paths
PRJIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX:t=).lib
PRJLIBNAME	= $(PROJECT)$(VERSION)$(SUFX:t=).$(EXT)
PRJLIB		= $(OUT_DIR)\$(PRJLIBNAME)

PRJSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
PRJSTUBLIB	= $(OUT_DIR)\$(PRJSTUBLIBNAME)

# If extension parent makefile has not defined a resource definition file,
# we will generate one from standard template.
!if !$(DOING_TCL) && !$(DOING_TK) && !$(STATIC_BUILD)
!ifdef RCFILE
RESFILE = $(TMP_DIR)\$(RCFILE:.rc=.res)
!else
RESFILE = $(TMP_DIR)\$(PROJECT).res
!endif
!endif

###################################################################
# 11. Construct the paths for the installation directories
# The following macros get defined in this section:
# LIB_INSTALL_DIR - where libraries should be installed
# BIN_INSTALL_DIR - where the executables should be installed
# DOC_INSTALL_DIR - where documentation should be installed
# SCRIPT_INSTALL_DIR - where scripts should be installed
# INCLUDE_INSTALL_DIR - where C include files should be installed
# DEMO_INSTALL_DIR - where demos should be installed
# PRJ_INSTALL_DIR - where package will be installed (not set for Tcl and Tk)

!if $(DOING_TCL) || $(DOING_TK)
LIB_INSTALL_DIR		= $(_INSTALLDIR)\lib
BIN_INSTALL_DIR		= $(_INSTALLDIR)\bin
DOC_INSTALL_DIR		= $(_INSTALLDIR)\doc
!if $(PGO) > 1
!if $(DOING_TCL)
!if [nmakehlp -l -ltcg:pgoptimize $(LINKER_TESTFLAGS)]
LINKERFLAGS	= $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize
!else
SCRIPT_INSTALL_DIR	= $(_INSTALLDIR)\lib\$(PROJECT)$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
!else # DOING_TK
MSG=^
This compiler does not support profile guided optimization.
!error $(MSG)
SCRIPT_INSTALL_DIR	= $(_INSTALLDIR)\lib\$(PROJECT)$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
!endif
DEMO_INSTALL_DIR	= $(SCRIPT_INSTALL_DIR)\demos
!elseif $(PGO) > 0
!if [nmakehlp -l -ltcg:pginstrument $(LINKER_TESTFLAGS)]
INCLUDE_INSTALL_DIR	= $(_INSTALLDIR)\include

LINKERFLAGS	= $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument
!else
MSG=^
!else # extension other than Tk

This compiler does not support profile guided optimization.
!error $(MSG)
!endif
PRJ_INSTALL_DIR         = $(_INSTALLDIR)\$(PROJECT)$(DOTVERSION)
LIB_INSTALL_DIR		= $(PRJ_INSTALL_DIR)
BIN_INSTALL_DIR		= $(PRJ_INSTALL_DIR)
DOC_INSTALL_DIR		= $(PRJ_INSTALL_DIR)
SCRIPT_INSTALL_DIR	= $(PRJ_INSTALL_DIR)
DEMO_INSTALL_DIR	= $(PRJ_INSTALL_DIR)\demos
INCLUDE_INSTALL_DIR	= $(_INSTALLDIR)\..\include

!endif

#----------------------------------------------------------
# Set our defines now armed with our options.
###################################################################
# 12. Set up actual options to be passed to the compiler and linker
# Now we have all the information we need, set up the actual flags and
# options that we will pass to the compiler and linker. The main
#----------------------------------------------------------
# makefile should use these in combination with whatever other flags
# and switches are specific to it.
# The following macros are defined, names are for historical compatibility:
# OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS
# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration opttions
# crt - Compiler switch that selects the appropriate C runtime
# cdebug - Compiler switches related to debug AND optimizations
# cwarn - Compiler switches that set warning levels
# cflags - complete compiler switches (subsumes cdebug and cwarn)
# ldebug - Linker switches controlling debug information and optimization
# lflags - complete linker switches (subsumes ldebug) except subsystem type
# dlllflags - complete linker switches to build DLLs (subsumes lflags)
# conlflags - complete linker switches for console program (subsumes lflags)
# guilflags - complete linker switches for GUI program (subsumes lflags)
# baselibs - minimum Windows libraries required. Parent makefile can
#    define PRJ_LIBS before including rules.rc if additional libs are needed

OPTDEFINES	= -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS

!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)
!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
!endif
!if $(TCL_NO_DEPRECATED)
OPTDEFINES	= $(OPTDEFINES) -DTCL_NO_DEPRECATED
!endif

!if $(USE_STUBS)
# Note we do not define USE_TCL_STUBS even when building tk since some
# test targets in tk do not use stubs
!if ! $(DOING_TCL)
USE_STUBS_DEFS  = -DUSE_TCL_STUBS -DUSE_TCLOO_STUBS
!if $(NEED_TK)
USE_STUBS_DEFS  = $(USE_STUBS_DEFS) -DUSE_TK_STUBS
!endif
!endif
!endif # USE_STUBS

!if !$(DEBUG)
OPTDEFINES	= $(OPTDEFINES) -DNDEBUG
!if $(OPTIMIZING)
OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_OPTIMIZED
!endif
!endif
!if $(PROFILE)
OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_PROFILED
!endif
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
!if "$(MACHINE)" == "AMD64"
OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_DO64BIT
!endif
!if $(VCVERSION) < 1300
OPTDEFINES	= $(OPTDEFINES) -DNO_STRTOI64
!endif

#----------------------------------------------------------
# Locate the Tcl headers to build against
#----------------------------------------------------------
# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
COMPILERFLAGS  = /D_ATL_XP_TARGETING

# Following is primarily for the benefit of extensions. Tcl 8.5 builds
# Tcl without /DUNICODE, while 8.6 builds with it defined. When building
# an extension, it is advisable (but not mandated) to use the same Windows
# API as the Tcl build. This is accordingly defaulted below. A particular
# extension can override this by pre-definining USE_WIDECHAR_API.
!ifndef USE_WIDECHAR_API
!if $(TCL_VERSION) > 85
USE_WIDECHAR_API = 1
!else
USE_WIDECHAR_API = 0
!endif
!endif

!if "$(PROJECT)" == "tcl"
!if $(USE_WIDECHAR_API)
COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE
!endif

# Like the TEA system only set this non empty for non-Tk extensions
# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
# so we pass both
_TCL_H          = ..\generic\tcl.h
!if !$(DOING_TCL) && !$(DOING_TK)
PKGNAMEFLAGS = -DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
               -DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
               -DPACKAGE_VERSION="\"$(DOTVERSION)\"" \
               -DMODULE_SCOPE=extern
!endif

# crt picks the C run time based on selected OPTS
!if $(MSVCRT)
!if $(DEBUG) && !$(UNCHECKED)
crt = -MDd
!else

crt = -MD
# If INSTALLDIR set to tcl root dir then reset to the lib dir.
!if exist("$(_INSTALLDIR)\include\tcl.h")
!endif
!else
!if $(DEBUG) && !$(UNCHECKED)
_INSTALLDIR=$(_INSTALLDIR)\lib
crt = -MTd
!else
crt = -MT
!endif
!endif

!if !defined(TCLDIR)
!if exist("$(_INSTALLDIR)\..\include\tcl.h")
# cdebug includes compiler options for debugging as well as optimization.
TCLINSTALL	= 1
_TCLDIR		= $(_INSTALLDIR)\..
_TCL_H          = $(_INSTALLDIR)\..\include\tcl.h
TCLDIR          = $(_INSTALLDIR)\..
!if $(DEBUG)

# In debugging mode, optimizations need to be disabled
cdebug = -Zi -Od $(DEBUGFLAGS)

!else
MSG=^
Failed to find tcl.h.  Set the TCLDIR macro.
!error $(MSG)

cdebug = $(OPTIMIZATIONS)
!if $(SYMBOLS)
cdebug = $(cdebug) -Zi
!endif
!else
_TCLDIR	= $(TCLDIR:/=\)
!if exist("$(_TCLDIR)\include\tcl.h")

!endif # $(DEBUG)

# cwarn includes default warning levels.
TCLINSTALL	= 1
_TCL_H          = $(_TCLDIR)\include\tcl.h
!elseif exist("$(_TCLDIR)\generic\tcl.h")
TCLINSTALL	= 0
_TCL_H          = $(_TCLDIR)\generic\tcl.h
cwarn = $(WARNINGS)

!if "$(MACHINE)" == "AMD64"
# Disable pointer<->int warnings related to cast between different sizes
# There are a gadzillion of these due to use of ClientData and
# clutter up compiler
# output increasing chance of a real warning getting lost. So disable them.
# Eventually some day, Tcl will be 64-bit clean.
cwarn = $(cwarn) -wd4311 -wd4312
!endif

### Common compiler options that are architecture specific
!if "$(MACHINE)" == "ARM"
carch = -D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE
!else
MSG =^
carch =
Failed to find tcl.h.  The TCLDIR macro does not appear correct.
!error $(MSG)
!endif

!if $(DEBUG)
# Turn warnings into errors
cwarn = $(cwarn) -WX
!endif

INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES)
!if !$(DOING_TCL) && !$(DOING_TK)
INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WINDIR)" -I"$(COMPATDIR)"
!endif

# These flags are defined roughly in the order of the pre-reform
# rules.vc/makefile.vc to help visually compare that the pre- and
# post-reform build logs
#--------------------------------------------------------------
# Extract various version numbers from tcl headers
# The generated file is then included in the makefile.

# cflags contains generic flags used for building practically all object files
cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\ $(cdebug)

# 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)
!if [echo REM = This file is generated from rules.vc > versions.vc]

# Link flags

!if $(DEBUG)
ldebug	= -debug -debugtype:cv
!else
ldebug	= -release -opt:ref -opt:icf,3
!if $(SYMBOLS)
ldebug	= $(ldebug) -debug -debugtype:cv
!endif
!endif
!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \

   && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc]
# Note: Profiling is currently only possible with the Visual Studio Enterprise
!if $(PROFILE)
ldebug= $(ldebug) -profile
!endif
!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]

### Declarations common to all linker versions
lflags	= -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)

!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
lflags	= $(lflags) -nodefaultlib:libucrt.lib
!endif
!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]

dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows

# Libraries that are required for every image.
# Extensions should define any additional libraries with $(PRJ_LIBS)
winlibs   = kernel32.lib advapi32.lib

!if $(NEED_TK)
winlibs = $(winlibs) gdi32.lib user32.lib uxtheme.lib
!endif

# If building the tcl core then we need additional package versions
!if "$(PROJECT)" == "tcl"
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "AMD64"
!if [echo PKG_HTTP_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc]
!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
winlibs   = $(winlibs) bufferoverflowU.lib
!endif
!if [echo PKG_TCLTEST_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc]
!endif
!if [echo PKG_MSGCAT_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc]
!endif
!if [echo PKG_PLATFORM_VER = \>> versions.vc] \

baselibs = $(winlibs) $(PRJ_LIBS)

!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
baselibs   = $(baselibs) ucrt.lib
   && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc]
!endif
!if [echo PKG_SHELL_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc]
!endif
!if [echo PKG_DDE_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc]
!endif
!if [echo PKG_REG_VER =\>> versions.vc] \
   && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc]
!endif
!endif

################################################################
# 13. Define standard commands, common make targets and implicit rules

CCPKGCMD = $(cc32) $(pkgcflags) -Fo$(TMP_DIR)^\
CCAPPCMD = $(cc32) $(appcflags) -Fo$(TMP_DIR)^\
CCSTUBSCMD = $(cc32) $(stubscflags) -Fo$(TMP_DIR)^\

LIBCMD = $(lib32) -nologo $(LINKERFLAGS) -out:$@
DLLCMD = $(link32) $(dlllflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)

CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
RESCMD  = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
	    $(TCL_INCLUDES) \
	    -DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
	    -DCOMMAVERSION=$(DOTVERSION:.=,),0 \
	    -DDOTVERSION=\"$(DOTVERSION)\" \
	    -DVERSION=\"$(VERSION)\" \
	    -DSUFX=\"$(SUFX:t=)\" \
	    -DPROJECT=\"$(PROJECT)\" \
	    -DPRJLIBNAME=\"$(PRJLIBNAME)\"

!include versions.vc
!ifndef DEFAULT_BUILD_TARGET
DEFAULT_BUILD_TARGET = $(PROJECT)
!endif

#--------------------------------------------------------------
# Setup tcl version dependent stuff headers
#--------------------------------------------------------------
default-target: $(DEFAULT_BUILD_TARGET)

!if "$(PROJECT)" != "tcl"
default-pkgindex:
	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
	    [list load [file join $$dir $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl

default-pkgindex-tea:
	@if exist $(ROOT)\pkgIndex.tcl.in nmakehlp -s << $(ROOT)\pkgIndex.tcl.in > $(OUT_DIR)\pkgIndex.tcl
TCL_VERSION	= $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
@PACKAGE_VERSION@    $(DOTVERSION)
@PACKAGE_NAME@       $(PRJ_PACKAGE_TCLNAME)
@PACKAGE_TCLNAME@    $(PRJ_PACKAGE_TCLNAME)
@PKG_LIB_FILE@       $(PRJLIBNAME)
<<


default-install: default-install-binaries default-install-libraries

default-install-binaries: $(PRJLIB)
	@echo Installing binaries to '$(SCRIPT_INSTALL_DIR)'
	@if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
	@$(CPY) $(PRJLIB) "$(SCRIPT_INSTALL_DIR)" >NUL

default-install-libraries: $(OUT_DIR)\pkgIndex.tcl
	@echo Installing libraries to '$(SCRIPT_INSTALL_DIR)'
	@if exist $(LIBDIR) $(CPY) $(LIBDIR)\*.tcl "$(SCRIPT_INSTALL_DIR)"
	@echo Installing package index in '$(SCRIPT_INSTALL_DIR)'
	@$(CPY) $(OUT_DIR)\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)

default-install-stubs:
	@echo Installing stubs library to '$(SCRIPT_INSTALL_DIR)'
	@if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
	@$(CPY) $(PRJSTUBLIB) "$(SCRIPT_INSTALL_DIR)" >NUL

default-install-docs-html:
	@echo Installing documentation files to '$(DOC_INSTALL_DIR)'
	@if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)"
	@if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.html" "$(DOCDIR)\*.css" "$(DOCDIR)\*.png") do @$(COPY) %f "$(DOC_INSTALL_DIR)"

default-install-docs-n:
!if $(TCLINSTALL)
	@echo Installing documentation files to '$(DOC_INSTALL_DIR)'
TCLSH		= "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
!if !exist($(TCLSH)) && $(TCL_THREADS)
	@if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)"
TCLSH           = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe"
!endif
TCLSTUBLIB	= "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
TCLIMPLIB	= "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
TCL_LIBRARY	= $(_TCLDIR)\lib
TCLREGLIB	= "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib"
TCLDDELIB	= "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib"
COFFBASE	= \must\have\tcl\sources\to\build\this\target
TCLTOOLSDIR	= \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES    = -I"$(_TCLDIR)\include"
!else
TCLSH		= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
!if !exist($(TCLSH)) && $(TCL_THREADS)
TCLSH		= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe"
!endif
TCLSTUBLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
TCLIMPLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
TCL_LIBRARY	= $(_TCLDIR)\library
TCLREGLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib"
	@if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.n") do @$(COPY) %f "$(DOC_INSTALL_DIR)"

default-install-demos:
	@echo Installing demos to '$(DEMO_INSTALL_DIR)'
	@if not exist "$(DEMO_INSTALL_DIR)" mkdir "$(DEMO_INSTALL_DIR)"
	@if exist $(DEMODIR) $(CPYDIR) "$(DEMODIR)" "$(DEMO_INSTALL_DIR)"

default-clean:
	@echo Cleaning $(TMP_DIR)\* ...
	@if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
	@echo Cleaning $(WINDIR)\nmakehlp.obj, nmakehlp.exe ...
	@if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
	@if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
	@if exist $(WINDIR)\nmakehlp.out del $(WINDIR)\nmakehlp.out
	@echo Cleaning $(WINDIR)\nmhlp-out.txt ...
	@if exist $(WINDIR)\nmhlp-out.txt del $(WINDIR)\nmhlp-out.txt
	@echo Cleaning $(WINDIR)\_junk.pch ...
	@if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
TCLDDELIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib"
COFFBASE	= "$(_TCLDIR)\win\coffbase.txt"
TCLTOOLSDIR	= $(_TCLDIR)\tools
TCL_INCLUDES	= -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
	@echo Cleaning $(WINDIR)\vercl.x, vercl.i ...
	@if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
	@if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
!endif
	@echo Cleaning $(WINDIR)\versions.vc, version.vc ...
	@if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
	@if exist $(WINDIR)\version.vc del $(WINDIR)\version.vc

default-hose: default-clean
	@echo Hosing $(OUT_DIR)\* ...
	@if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)

# Only for backward compatibility
default-distclean: default-hose

default-setup:
	@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
	@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)

!if "$(TESTPAT)" != ""
TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
!endif

default-test: default-setup $(PROJECT)
	@set TCLLIBPATH=$(OUT_DIR:\=/)
	@if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)"
	cd "$(TESTDIR)" && $(DEBUGGER) $(TCLSH) all.tcl $(TESTFLAGS)
#-------------------------------------------------------------------------
# Locate the Tk headers to build against
#-------------------------------------------------------------------------

default-shell: default-setup $(PROJECT)
	@set TCLLIBPATH=$(OUT_DIR:\=/)
	@if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)"
	$(DEBUGGER) $(TCLSH)

# Generation of Windows version resource
!ifdef RCFILE

# Note: don't use $** in below rule because there may be other dependencies
# and only the "master" rc must be passed to the resource compiler
$(TMP_DIR)\$(PROJECT).res: $(RCDIR)\$(PROJECT).rc
	$(RESCMD) $(RCDIR)\$(PROJECT).rc

!else
!if "$(PROJECT)" == "tk"
_TK_H          = ..\generic\tk.h
_INSTALLDIR    = $(_INSTALLDIR)\..
!endif


# If parent makefile has not defined a resource definition file,
# we will generate one from standard template.
$(TMP_DIR)\$(PROJECT).res: $(TMP_DIR)\$(PROJECT).rc

$(TMP_DIR)\$(PROJECT).rc:
	@$(COPY) << $(TMP_DIR)\$(PROJECT).rc
#include <winver.h>

VS_VERSION_INFO VERSIONINFO
 FILEVERSION	COMMAVERSION
 PRODUCTVERSION	COMMAVERSION
 FILEFLAGSMASK	0x3fL
#ifdef DEBUG
 FILEFLAGS	VS_FF_DEBUG
!ifdef PROJECT_REQUIRES_TK
!if !defined(TKDIR)
!if exist("$(_INSTALLDIR)\..\include\tk.h")
TKINSTALL      = 1
_TKDIR         = $(_INSTALLDIR)\..
_TK_H          = $(_TKDIR)\include\tk.h
TKDIR          = $(_TKDIR)
!elseif exist("$(_TCLDIR)\include\tk.h")
TKINSTALL      = 1
_TKDIR         = $(_TCLDIR)
_TK_H          = $(_TKDIR)\include\tk.h
TKDIR          = $(_TKDIR)
!endif
!else
#else
_TKDIR = $(TKDIR:/=\)
!if exist("$(_TKDIR)\include\tk.h")
TKINSTALL      = 1
_TK_H          = $(_TKDIR)\include\tk.h
!elseif exist("$(_TKDIR)\generic\tk.h")
TKINSTALL      = 0
_TK_H          = $(_TKDIR)\generic\tk.h
!else
MSG =^
 FILEFLAGS	0x0L
Failed to find tk.h. The TKDIR macro does not appear correct.
!error $(MSG)
!endif
!endif
!endif
#endif
 FILEOS		VOS_NT_WINDOWS32
 FILETYPE	VFT_DLL
 FILESUBTYPE	0x0L
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "040904b0"
        BEGIN
            VALUE "FileDescription",  "Tcl extension " PROJECT
            VALUE "OriginalFilename", PRJLIBNAME
            VALUE "FileVersion",      DOTVERSION
            VALUE "ProductName",      "Package " PROJECT " for Tcl"
            VALUE "ProductVersion",   DOTVERSION
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x409, 1200
    END
END

<<

!endif # ifdef RCFILE
#-------------------------------------------------------------------------
# Extract Tk version numbers
#-------------------------------------------------------------------------

!ifndef DISABLE_IMPLICIT_RULES
DISABLE_IMPLICIT_RULES = 0
!endif

!if !$(DISABLE_IMPLICIT_RULES)
# Implicit rule definitions - only for building library objects. For stubs and
# main application, the master makefile should define explicit rules.

{$(ROOT)}.c{$(TMP_DIR)}.obj::
	$(CCPKGCMD) @<<
$<
<<

{$(WINDIR)}.c{$(TMP_DIR)}.obj::
	$(CCPKGCMD) @<<
$<
<<

{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
	$(CCPKGCMD) @<<
$<
<<

{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
	$(CCPKGCMD) @<<
$<
<<

{$(RCDIR)}.rc{$(TMP_DIR)}.res:
	$(RESCMD) $<
!if defined(PROJECT_REQUIRES_TK) || "$(PROJECT)" == "tk"

{$(WINDIR)}.rc{$(TMP_DIR)}.res:
	$(RESCMD) $<

{$(TMP_DIR)}.rc{$(TMP_DIR)}.res:
	$(RESCMD) $<
!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]

.SUFFIXES:
.SUFFIXES:.c .rc

!endif
!if [echo TK_MINOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
!endif
!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
!endif

################################################################
# 14. Sanity check selected options against Tcl build options
# When building an extension, certain configuration options should
# match the ones used when Tcl was built. Here we check and
!include versions.vc
# warn on a mismatch.
!if ! $(DOING_TCL)

TK_DOTVERSION	= $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
TK_VERSION	= $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)

!if "$(PROJECT)" != "tk"
!if $(TKINSTALL)
WISH		= "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe"
!if $(TCLINSTALL) # Building against an installed Tcl
!if exist("$(_TCLDIR)\lib\nmake\tcl.nmake")
TCLNMAKECONFIG = "$(_TCLDIR)\lib\nmake\tcl.nmake"
!endif
!else # ! $(TCLINSTALL) - building against Tcl source
!if exist("$(OUT_DIR)\tcl.nmake")
TKSTUBLIB	= "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib"
TKIMPLIB	= "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib"
TK_INCLUDES     = -I"$(_TKDIR)\include"
!else
WISH		= "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe"
TKSTUBLIB	= "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib"
TKIMPLIB	= "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib"
TK_INCLUDES     = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake"
!endif
!endif # TCLINSTALL

!if $(CONFIG_CHECK)
!ifdef TCLNMAKECONFIG
!include $(TCLNMAKECONFIG)

!if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)"
!error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)).
!endif
!if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG)
!message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)).
!endif
!endif

!endif
!endif # TCLNMAKECONFIG

!endif # ! $(DOING_TCL)


#----------------------------------------------------------
# Display stats being used.
#----------------------------------------------------------

!if !$(DOING_TCL)
!message *** Building against Tcl at '$(_TCLDIR)'
!endif
!if !$(DOING_TK) && $(NEED_TK)
!message *** Building against Tk at '$(_TKDIR)'
!endif
!message *** Intermediate directory will be '$(TMP_DIR)'
!message *** Output directory will be '$(OUT_DIR)'
!message *** Installation, if selected, will be in '$(_INSTALLDIR)'
!message *** Suffix for binaries will be '$(SUFX)'
!message *** Optional defines are '$(OPTDEFINES)'
!message *** Compiler version $(VCVER). Target machine is $(MACHINE)
!message *** Compiler version $(VCVER). Target $(MACHINE), host $(NATIVE_ARCH).
!message *** Host architecture is $(NATIVE_ARCH)
!message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)'
!message *** Link options '$(LINKERFLAGS)'

!endif
!endif # ifdef _RULES_VC

Added win/targets.vc.



































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#------------------------------------------------------------- -*- makefile -*-
# targets.vc --
#
# Part of the nmake based build system for Tcl and its extensions.
# This file defines some standard targets for the convenience of extensions
# and can be optionally included by the extension makefile.
# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for docs.

$(PROJECT): setup pkgindex $(PRJLIB)

!ifdef PRJ_STUBOBJS
$(PROJECT): $(PRJSTUBLIB)
$(PRJSTUBLIB): $(PRJ_STUBOBJS)
	$(LIBCMD) $**

$(PRJ_STUBOBJS):
	$(CCSTUBSCMD) %s
!endif # PRJ_STUBOBJS

!ifdef PRJ_MANIFEST
$(PROJECT): $(PRJLIB).manifest
$(PRJLIB).manifest: $(PRJ_MANIFEST)
	@nmakehlp -s << $** >$@
@MACHINE@	  $(MACHINE:IX86=X86)
<<
!endif

!if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk"
$(PRJLIB): $(PRJ_OBJS) $(RESFILE)
!if $(STATIC_BUILD)
       $(LIBCMD) $**
!else
       $(DLLCMD) $**
       $(_VC_MANIFEST_EMBED_DLL)
!endif
       -@del $*.exp
!endif

!if "$(PRJ_HEADERS)" != "" && "$(PRJ_OBJS)" != ""
$(PRJ_OBJS): $(PRJ_HEADERS)
!endif

# If parent makefile has defined stub objects, add their installation
# to the default install
!if "$(PRJ_STUBOBJS)" != ""
default-install: default-install-stubs
!endif

# Unlike the other default targets, these cannot be in rules.vc because
# the executed command depends on existence of macro PRJ_HEADERS_PUBLIC
# that the parent makefile will not define until after including rules-ext.vc
!if "$(PRJ_HEADERS_PUBLIC)" != ""
default-install: default-install-headers
default-install-headers:
	@echo Installing headers to '$(INCLUDE_INSTALL_DIR)'
	@for %f in ($(PRJ_HEADERS_PUBLIC)) do @$(COPY) %f "$(INCLUDE_INSTALL_DIR)"
!endif

!if "$(DISABLE_STANDARD_TARGETS)" == ""
DISABLE_STANDARD_TARGETS = 0
!endif

!if "$(DISABLE_TARGET_setup)" == ""
DISABLE_TARGET_setup = 0
!endif
!if "$(DISABLE_TARGET_install)" == ""
DISABLE_TARGET_install = 0
!endif
!if "$(DISABLE_TARGET_clean)" == ""
DISABLE_TARGET_clean = 0
!endif
!if "$(DISABLE_TARGET_test)" == ""
DISABLE_TARGET_test = 0
!endif
!if "$(DISABLE_TARGET_shell)" == ""
DISABLE_TARGET_shell = 0
!endif

!if !$(DISABLE_STANDARD_TARGETS)
!if !$(DISABLE_TARGET_setup)
setup: default-setup
!endif
!if !$(DISABLE_TARGET_install)
install: default-install
!endif
!if !$(DISABLE_TARGET_clean)
clean: default-clean
realclean: hose
hose: default-hose
distclean: realclean default-distclean
!endif
!if !$(DISABLE_TARGET_test)
test: default-test
!endif
!if !$(DISABLE_TARGET_shell)
shell: default-shell
!endif
!endif # DISABLE_STANDARD_TARGETS

Changes to win/tcl.dsp.

148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
148
149
150
151
152
153
154




155
156
157
158
159
160
161







-
-
-
-







# End Source File
# Begin Source File

SOURCE=..\compat\fixstrtod.c
# End Source File
# Begin Source File

SOURCE=..\compat\float.h
# End Source File
# Begin Source File

SOURCE=..\compat\gettod.c
# End Source File
# Begin Source File

SOURCE=..\compat\limits.h
# End Source File
# Begin Source File
1263
1264
1265
1266
1267
1268
1269




1270
1271
1272
1273
1274
1275
1276
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276







+
+
+
+







SOURCE=..\generic\tclPreserve.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclProc.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclProcess.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclRegexp.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclRegexp.h
# End Source File
1523
1524
1525
1526
1527
1528
1529




1530
1531
1532
1533
1534
1535
1536
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540







+
+
+
+







SOURCE=.\tclWinLoad.c
# End Source File
# Begin Source File

SOURCE=.\tclWinNotify.c
# End Source File
# Begin Source File

SOURCE=.\tclWinPanic.c
# End Source File
# Begin Source File

SOURCE=.\tclWinPipe.c
# End Source File
# Begin Source File

SOURCE=.\tclWinPort.h
# End Source File

Changes to win/tcl.hpj.in.

1
2
3
4
5
6
7
8

9
10

11
12
13
14
15
16
17
1
2
3
4
5
6
7

8
9

10
11
12
13
14
15
16
17







-
+

-
+







; This file is maintained by HCW. Do not modify this file directly.

[OPTIONS]
HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
CNT=tcl90.cnt
CNT=tcl87.cnt
COPYRIGHT=Copyright � 2000 Ajuba Solutions
HLP=tcl90.hlp
HLP=tcl87.hlp

[FILES]
tcl.rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,0

Changes to win/tcl.m4.

247
248
249
250
251
252
253

254
255
256
257
258
259
260
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261







+







#
# Results:
#
#	Substitutes the following vars:
#		TCL_BIN_DIR
#		TCL_SRC_DIR
#		TCL_LIB_FILE
#		TCL_ZIP_FILE
#
#------------------------------------------------------------------------

AC_DEFUN([SC_LOAD_TCLCONFIG], [
    AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh])

    if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then
279
280
281
282
283
284
285

286
287
288
289
290
291
292
293
294
295
296
297

298
299
300
301
302
303
304
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307







+












+







        TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH}
    fi

    #
    # eval is required to do the TCL_DBGX substitution
    #

    eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\""
    eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
    eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
    eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""

    eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
    eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
    eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""

    AC_SUBST(TCL_VERSION)
    AC_SUBST(TCL_BIN_DIR)
    AC_SUBST(TCL_SRC_DIR)

    AC_SUBST(TCL_ZIP_FILE)
    AC_SUBST(TCL_LIB_FILE)
    AC_SUBST(TCL_LIB_FLAG)
    AC_SUBST(TCL_LIB_SPEC)

    AC_SUBST(TCL_STUB_LIB_FILE)
    AC_SUBST(TCL_STUB_LIB_FLAG)
    AC_SUBST(TCL_STUB_LIB_SPEC)
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418

419
420
421
422
423
424
425
379
380
381
382
383
384
385




































386
387
388
389
390
391
392
393







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+







	AC_MSG_RESULT([shared])
	SHARED_BUILD=1
    else
	AC_MSG_RESULT([static])
	SHARED_BUILD=0
	AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
    fi
])

#------------------------------------------------------------------------
# SC_ENABLE_THREADS --
#
#	Specify if thread support should be enabled
#
# Arguments:
#	none
#
# Results:
#
#	Adds the following arguments to configure:
#		--enable-threads=yes|no
#
#	Defines the following vars:
#		TCL_THREADS
#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_THREADS], [
    AC_MSG_CHECKING(for building with threads)
    AC_ARG_ENABLE(threads, [  --enable-threads        build with threads (default: on)],
	[tcl_ok=$enableval], [tcl_ok=yes])

    if test "$tcl_ok" = "yes"; then
	AC_MSG_RESULT([yes (default)])
	TCL_THREADS=1
	AC_DEFINE(TCL_THREADS)
	# USE_THREAD_ALLOC tells us to try the special thread-based
	# allocator that significantly reduces lock contention
	AC_DEFINE(USE_THREAD_ALLOC)
    else
	TCL_THREADS=0
	AC_MSG_RESULT(no)
    fi
    AC_SUBST(TCL_THREADS)
    AC_SUBST(SHARED_BUILD)
])

#------------------------------------------------------------------------
# SC_ENABLE_SYMBOLS --
#
#	Specify if debugging symbols should be used.
#	Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562

563
564
565
566
567
568
569
508
509
510
511
512
513
514











515
516
517
518
519
520
521
522
523
524
525
526
527







-
-
-
-
-
-
-
-
-
-
-





+








    # Step 0: Enable 64 bit support?

    AC_MSG_CHECKING([if 64bit support is requested])
    AC_ARG_ENABLE(64bit,[  --enable-64bit          enable 64bit support (where applicable)], [do64bit=$enableval], [do64bit=no])
    AC_MSG_RESULT($do64bit)

    # Cross-compiling options for Windows/CE builds

    AC_MSG_CHECKING([if Windows/CE build is requested])
    AC_ARG_ENABLE(wince,[  --enable-wince          enable Win/CE support (where applicable)], [doWince=$enableval], [doWince=no])
    AC_MSG_RESULT($doWince)

    AC_MSG_CHECKING([for Windows/CE celib directory])
    AC_ARG_WITH(celib,[  --with-celib=DIR        use Windows/CE support library from DIR],
	    CELIB_DIR=$withval, CELIB_DIR=NO_CELIB)
    AC_MSG_RESULT([$CELIB_DIR])

    # Set some defaults (may get changed below)
    EXTRA_CFLAGS=""
	AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])

    AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)
    AC_CHECK_PROG(WINE, wine, wine,)

    SHLIB_SUFFIX=".dll"

    # MACHINE is IX86 for LINK, but this is used by the manifest,
    # which requires x86|amd64|ia64.
    MACHINE="X86"

867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964

965
966
967
968
969
970
971
972
825
826
827
828
829
830
831



























































































832

833
834
835
836
837
838
839







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-







	    CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
	    # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy)
	    CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
	    lflags="${lflags} -nologo"
	    LINKBIN="link"
	fi

	if test "$doWince" != "no" ; then
	    # Set defaults for common evc4/PPC2003 setup
	    # Currently Tcl requires 300+, possibly 420+ for sockets
	    CEVERSION=420; 		# could be 211 300 301 400 420 ...
	    TARGETCPU=ARMV4;	# could be ARMV4 ARM MIPS SH3 X86 ...
	    ARCH=ARM;		# could be ARM MIPS X86EM ...
	    PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002"
	    if test "$doWince" != "yes"; then
		# If !yes then the user specified something
		# Reset ARCH to allow user to skip specifying it
		ARCH=
		eval `echo $doWince | awk -F "," '{ \
	if (length([$]1)) { printf "CEVERSION=\"%s\"\n", [$]1; \
	if ([$]1 < 400)	  { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \
	if (length([$]2)) { printf "TARGETCPU=\"%s\"\n", toupper([$]2) }; \
	if (length([$]3)) { printf "ARCH=\"%s\"\n", toupper([$]3) }; \
	if (length([$]4)) { printf "PLATFORM=\"%s\"\n", [$]4 }; \
		}'`
		if test "x${ARCH}" = "x" ; then
		    ARCH=$TARGETCPU;
		fi
	    fi
	    OSVERSION=WCE$CEVERSION;
	    if test "x${WCEROOT}" = "x" ; then
		WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0"
		if test ! -d "${WCEROOT}" ; then
		    WCEROOT="C:/Program Files/Microsoft eMbedded Tools"
		fi
	    fi
	    if test "x${SDKROOT}" = "x" ; then
		SDKROOT="C:/Program Files/Windows CE Tools"
		if test ! -d "${SDKROOT}" ; then
		    SDKROOT="C:/Windows CE Tools"
		fi
	    fi
	    # The space-based-path will work for the Makefile, but will
	    # not work if AC_TRY_COMPILE is called.
	    WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'`
	    SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'`
	    CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'`
	    if test ! -d "${CELIB_DIR}/inc"; then
		AC_MSG_ERROR([Invalid celib directory "${CELIB_DIR}"])
	    fi
	    if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\
		-o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then
		AC_MSG_ERROR([could not find PocketPC SDK or target compiler to enable WinCE mode [$CEVERSION,$TARGETCPU,$ARCH,$PLATFORM]])
	    else
		CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include"
		if test -d "${CEINCLUDE}/${TARGETCPU}" ; then
		    CEINCLUDE="${CEINCLUDE}/${TARGETCPU}"
		fi
		CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"
	    fi
	fi

	if test "$doWince" != "no" ; then
	    CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin"
	    if test "${TARGETCPU}" = "X86"; then
		CC="${CEBINROOT}/cl.exe"
	    else
		CC="${CEBINROOT}/cl${ARCH}.exe"
	    fi
	    CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\""
	    RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\""
	    arch=`echo ${ARCH} | awk '{print tolower([$]0)}'`
	    defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS"
	    for i in $defs ; do
		AC_DEFINE_UNQUOTED($i)
	    done
#	    if test "${ARCH}" = "X86EM"; then
#		AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION)
#	    fi
	    AC_DEFINE_UNQUOTED(_WIN32_WCE, $CEVERSION)
	    AC_DEFINE_UNQUOTED(UNDER_CE, $CEVERSION)
	    CFLAGS_DEBUG="-nologo -Zi -Od"
	    CFLAGS_OPTIMIZE="-nologo -O2"
	    lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'`
	    lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo"
	    LINKBIN="\"${CEBINROOT}/link.exe\""
	    AC_SUBST(CELIB_DIR)
	    if test "${CEVERSION}" -lt 400 ; then
		LIBS="coredll.lib corelibc.lib winsock.lib"
	    else
		LIBS="coredll.lib corelibc.lib ws2.lib"
	    fi
	    # celib currently stuck at wce300 status
	    #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib"
	    LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\""
	    LIBS_GUI="commctrl.lib commdlg.lib"
	else
	    LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
	LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
	fi

	SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
	SHLIB_LD_LIBS='${LIBS}'
	# link -lib only works when -lib is the first arg
	STLIB_LD="${LINKBIN} -lib ${lflags}"
	RC_OUT=-fo
	RC_TYPE=-r
989
990
991
992
993
994
995
996

997
998
999
1000
1001
1002
1003
856
857
858
859
860
861
862

863
864
865
866
867
868
869
870







-
+








	# Specify the CC output file names based on the target name
	CC_OBJNAME="-Fo\[$]@"
	CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\[$]@')\""

	# Specify linker flags depending on the type of app being
	# built -- Console vs. Window.
	if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then
	if test "${TARGETCPU}" != "X86"; then
	    LDFLAGS_CONSOLE="-link ${lflags}"
	    LDFLAGS_WINDOW=${LDFLAGS_CONSOLE}
	else
	    LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}"
	    LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
	fi
    fi
1122
1123
1124
1125
1126
1127
1128
1129
1130


1131
1132

1133
1134
1135

1136
1137
1138
1139
1140
1141
1142
989
990
991
992
993
994
995


996
997
998

999
1000
1001

1002
1003
1004
1005
1006
1007
1008
1009







-
-
+
+

-
+


-
+







#		--with-tcl=...
#
#	Defines the following vars:
#		TCL_BIN_DIR	Full path to the tcl build dir.
#------------------------------------------------------------------------

AC_DEFUN([SC_WITH_TCL], [
    if test -d ../../tcl9.0$1/win;  then
	TCL_BIN_DEFAULT=../../tcl9.0$1/win
    if test -d ../../tcl8.7$1/win;  then
	TCL_BIN_DEFAULT=../../tcl8.7$1/win
    else
	TCL_BIN_DEFAULT=../../tcl9.0/win
	TCL_BIN_DEFAULT=../../tcl8.7/win
    fi

    AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 9.0 binaries from DIR],
    AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 8.7 binaries from DIR],
	    TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
    if test ! -d $TCL_BIN_DIR; then
	AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
    fi
    if test ! -f $TCL_BIN_DIR/Makefile; then
	AC_MSG_ERROR(There is no Makefile in $TCL_BIN_DIR:  perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
    else
1293
1294
1295
1296
1297
1298
1299



























































































































1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
	fi
	])
    fi
    AC_MSG_RESULT([$result])
    AC_SUBST(VC_MANIFEST_EMBED_DLL)
    AC_SUBST(VC_MANIFEST_EMBED_EXE)
])

#------------------------------------------------------------------------
# SC_CC_FOR_BUILD
#	For cross compiles, locate a C compiler that can generate native binaries.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		CC_FOR_BUILD
#		EXEEXT_FOR_BUILD
#------------------------------------------------------------------------

dnl Get a default for CC_FOR_BUILD to put into Makefile.
AC_DEFUN([AX_CC_FOR_BUILD],
[# Put a plausible default for CC_FOR_BUILD in Makefile.
if test -z "$CC_FOR_BUILD"; then
  if test "x$cross_compiling" = "xno"; then
    CC_FOR_BUILD='$(CC)'
  else
    AC_MSG_CHECKING([for gcc])
    AC_CACHE_VAL(ac_cv_path_cc, [
	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/gcc 2> /dev/null` \
		    `ls -r $dir/gcc 2> /dev/null` ; do
		if test x"$ac_cv_path_cc" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_cc=$j
			break
		    fi
		fi
	    done
	done
    ])
  fi
fi
AC_SUBST(CC_FOR_BUILD)
# Also set EXEEXT_FOR_BUILD.
if test "x$cross_compiling" = "xno"; then
  EXEEXT_FOR_BUILD='$(EXEEXT)'
  OBJEXT_FOR_BUILD='$(OBJEXT)'
else
  OBJEXT_FOR_BUILD='.no'
  AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext,
    [rm -f conftest*
     echo 'int main () { return 0; }' > conftest.c
     bfd_cv_build_exeext=
     ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
     for file in conftest.*; do
       case $file in
       *.c | *.o | *.obj | *.ilk | *.pdb) ;;
       *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
       esac
     done
     rm -f conftest*
     test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no])
  EXEEXT_FOR_BUILD=""
  test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
fi
AC_SUBST(EXEEXT_FOR_BUILD)])dnl
AC_SUBST(OBJEXT_FOR_BUILD)])dnl



#------------------------------------------------------------------------
# SC_ZIPFS_SUPPORT
#	Locate a zip encoder installed on the system path, or none.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		ZIP_PROG
#       ZIP_PROG_OPTIONS
#       ZIP_PROG_VFSSEARCH
#       ZIP_INSTALL_OBJS
#------------------------------------------------------------------------

AC_DEFUN([SC_ZIPFS_SUPPORT], [
    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    AC_MSG_CHECKING([for zip])
    AC_CACHE_VAL(ac_cv_path_zip, [
    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done
    ])
    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip "
        AC_MSG_RESULT([$ZIP_PROG])
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="."
        AC_MSG_RESULT([Found INFO Zip in environment])
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="."
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        AC_MSG_RESULT([No zip found on PATH building minizip])
    fi
    AC_SUBST(ZIP_PROG)
    AC_SUBST(ZIP_PROG_OPTIONS)
    AC_SUBST(ZIP_PROG_VFSSEARCH)
    AC_SUBST(ZIP_INSTALL_OBJS)
])

Changes to win/tcl.rc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29
1
2
3
4
5
6
7
8
9






10
11
12
13
14
15

16
17
18
19
20
21
22
23









-
-
-
-
-
-






-
+







// Version Resource Script
//

#include <winver.h>
#include <tcl.h>

//
// build-up the name suffix that defines the type of build this is.
//
#if TCL_THREADS
#define SUFFIX_THREADS	    "t"
#else
#define SUFFIX_THREADS	    ""
#endif

#if DEBUG && !UNCHECKED
#define SUFFIX_DEBUG	    "g"
#else
#define SUFFIX_DEBUG	    ""
#endif

#define SUFFIX		    SUFFIX_THREADS SUFFIX_DEBUG
#define SUFFIX		    SUFFIX_DEBUG


LANGUAGE 0x9, 0x1	/* LANG_ENGLISH, SUBLANG_DEFAULT */

VS_VERSION_INFO VERSIONINFO
 FILEVERSION 	TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
 PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL

Changes to win/tclAppInit.c.

31
32
33
34
35
36
37
38

39


40
41
42
43
44
45
46
31
32
33
34
35
36
37

38
39
40
41
42
43
44
45
46
47
48







-
+

+
+








#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
extern Tcl_PackageInitProc Registry_Init;
extern Tcl_PackageInitProc Dde_Init;
extern Tcl_PackageInitProc Dde_SafeInit;
#endif

#ifdef TCL_BROKEN_MAINARGS
#if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS)
int _CRT_glob = 0;
#endif /* __GNUC__ || TCL_BROKEN_MAINARGS */
#ifdef TCL_BROKEN_MAINARGS
static void setargv(int *argcPtr, TCHAR ***argvPtr);
#endif /* TCL_BROKEN_MAINARGS */

/*
 * The following #if block allows you to change the AppInit function by using
 * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
 * #if checks for that #define and uses Tcl_AppInit if it does not exist.
120
121
122
123
124
125
126



127
128
129
130
131
132
133
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138







+
+
+







	if (*p == '\\') {
	    *p = '/';
	}
    }

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif !defined(_WIN32) || defined(UNICODE)
    /* This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*

Changes to win/tclConfig.sh.in.

36
37
38
39
40
41
42



43
44
45
46
47
48
49
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52







+
+
+







TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'

# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=@TCL_SHARED_BUILD@

# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='@TCL_LIB_FILE@'

# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library):
TCL_ZIP_FILE='@TCL_ZIP_FILE@'

# Flag to indicate whether shared libraries need export files.
TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@

# String that can be evaluated to generate the part of the export file
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed).  May depend on the variables
171
172
173
174
175
176
177
178
179
180
181
174
175
176
177
178
179
180











-
-
-
-
TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'

# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'

# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'

# Flag, 1: we built Tcl with threads enabled, 0 we didn't
TCL_THREADS=@TCL_THREADS@

Changes to win/tclWin32Dll.c.

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
19
20
21
22
23
24
25

26
27
28
29
30
31
32
33
34


35
36
37
38
39
40
41







-









-
-







/*
 * The following variables keep track of information about this DLL on a
 * per-instance basis. Each time this DLL is loaded, it gets its own new data
 * segment with its own copy of all static and global information.
 */

static HINSTANCE hInstance;	/* HINSTANCE of this DLL. */
static int platformId;		/* Running under NT, or 95/98? */

/*
 * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it
 */

#if defined(_MSC_VER) && (_MSC_VER <= 1100) && defined (_M_IX86)
#define cpuid	__asm __emit 0fh __asm __emit 0a2h
#endif

static Tcl_Encoding winTCharEncoding = NULL;

/*
 * The following declaration is for the VC++ DLL entry point.
 */

BOOL APIENTRY		DllMain(HINSTANCE hInst, DWORD reason,
			    LPVOID reserved);

182
183
184
185
186
187
188
189
190
191
192
193


194
195
196
197


198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
179
180
181
182
183
184
185

186
187


188
189
190
191


192
193
194
































195
196
197
198
199
200
201







-


-
-
+
+


-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    HINSTANCE hInst)		/* Library instance handle. */
{
    OSVERSIONINFOW os;

    hInstance = hInst;
    os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
    GetVersionExW(&os);
    platformId = os.dwPlatformId;

    /*
     * We no longer support Win32s or Win9x, so just in case someone manages
     * to get a runtime there, make sure they know that.
     * We no longer support Win32s or Win9x or Windows CE, so just in case
     * someone manages to get a runtime there, make sure they know that.
     */

    if (platformId == VER_PLATFORM_WIN32s) {
	Tcl_Panic("Win32s is not a supported platform");
    if (os.dwPlatformId != VER_PLATFORM_WIN32_NT) {
	Tcl_Panic("Windows NT is the only supported platform");
    }
    if (platformId == VER_PLATFORM_WIN32_WINDOWS) {
	Tcl_Panic("Windows 9x is not a supported platform");
    }

    TclWinResetInterfaces();
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinGetPlatformId --
 *
 *	Determines whether running under NT, 95, or Win32s, to allow runtime
 *	conditional code.
 *
 * Results:
 *	The return value is one of:
 *	VER_PLATFORM_WIN32s	   Win32s on Windows 3.1 (not supported)
 *	VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME (not supported)
 *	VER_PLATFORM_WIN32_NT	Win32 on Windows NT, 2000, XP
 *	VER_PLATFORM_WIN32_CE	Win32 on Windows CE
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclWinGetPlatformId(void)
{
    return platformId;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclWinNoBackslash --
 *
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292

293
294
295

296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
224
225
226
227
228
229
230























231
232

233



234

235
236
237
238
239
240
241
242
243
244
245
246
247
248
249


250
251
252
253
254
255
256
257
258
259
260
261
262
263
























264
265
266
267
268
269
270







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+
-
-
-
+
-















-
-














-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    }
    return path;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetInterfaces --
 *
 *	A helper proc that initializes winTCharEncoding.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TclpSetInterfaces(void)
{
    TclWinResetInterfaces();
    winTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
}

/*
 *---------------------------------------------------------------------------
 *
 * TclWinEncodingsCleanup --
 *
 *	Called during finalization to free up any encodings we use.
 *	Called during finalization to clean up any memory allocated in our
 *
 *	We also clean up any memory allocated in our mount point map which is
 *	used to follow certain kinds of symlinks. That code should never be
 *	mount point map which is used to follow certain kinds of symlinks.
 *	used once encodings are taken down.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TclWinEncodingsCleanup(void)
{
    MountPointMap *dlIter, *dlIter2;

    TclWinResetInterfaces();

    /*
     * Clean up the mount point map.
     */

    Tcl_MutexLock(&mountPointMap);
    dlIter = driveLetterLookup;
    while (dlIter != NULL) {
	dlIter2 = dlIter->nextPtr;
	ckfree(dlIter->volumeName);
	ckfree(dlIter);
	dlIter = dlIter2;
    }
    Tcl_MutexUnlock(&mountPointMap);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclWinResetInterfaces --
 *
 *	Called during finalization to reset us to a safe state for reuse.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
void
TclWinResetInterfaces(void)
{
    if (winTCharEncoding != NULL) {
	Tcl_FreeEncoding(winTCharEncoding);
	winTCharEncoding = NULL;
    }
}

/*
 *--------------------------------------------------------------------
 *
 * TclWinDriveLetterForVolMountPoint
 *
 *	Unfortunately, Windows provides no easy way at all to get hold of the
509
510
511
512
513
514
515
516

517
518
519
520
521
522




523
524

525
526
527
528
529


530
531
532


533
534
535
536
537
538



539
540
541
542
543

544
545

546
547
548


549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564

565
566
567
568


569
570



571
572
573
574
575

576
577

578
579
580
581


582
583








584
585
586
587
588
589
590
421
422
423
424
425
426
427

428

429




430
431
432
433
434

435
436
437
438


439
440
441


442
443
444
445




446
447
448



449

450


451



452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468

469
470
471
472
473
474
475


476
477
478
479
480
481
482

483


484
485
486
487
488
489
490


491
492
493
494
495
496
497
498
499
500
501
502
503
504
505







-
+
-

-
-
-
-
+
+
+
+

-
+



-
-
+
+

-
-
+
+


-
-
-
-
+
+
+
-
-
-

-
+
-
-
+
-
-
-
+
+















-
+




+
+
-
-
+
+
+




-
+
-
-
+




+
+
-
-
+
+
+
+
+
+
+
+







}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
 *
 *	Convert between UTF-8 and Unicode when running Windows NT or the
 *	Convert between UTF-8 and Unicode when running Windows.
 *	current ANSI code page when running Windows 95.
 *
 *	On Mac, Unix, and Windows 95, all strings exchanged between Tcl and
 *	the OS are "char" oriented. We need only one Tcl_Encoding to convert
 *	between UTF-8 and the system's native encoding. We use NULL to
 *	represent that encoding.
 *	On Mac and Unix, all strings exchanged between Tcl and the OS are
 *	"char" oriented. We need only one Tcl_Encoding to convert between
 *	UTF-8 and the system's native encoding. We use NULL to represent
 *	that encoding.
 *
 *	On NT, some strings exchanged between Tcl and the OS are "char"
 *	On Windows, some strings exchanged between Tcl and the OS are "char"
 *	oriented, while others are in Unicode. We need two Tcl_Encoding APIs
 *	depending on whether we are targeting a "char" or Unicode interface.
 *
 *	Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding of
 *	NULL should always used to convert between UTF-8 and the system's
 *	Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding
 *	of NULL should always used to convert between UTF-8 and the system's
 *	"char" oriented encoding. The following two functions are used in
 *	Windows-specific code to convert between UTF-8 and Unicode strings
 *	(NT) or "char" strings(95). This saves you the trouble of writing the
 *	Windows-specific code to convert between UTF-8 and Unicode strings.
 *	This saves you the trouble of writing the
 *	following type of fragment over and over:
 *
 *		if (running NT) {
 *		    encoding <- Tcl_GetEncoding("unicode");
 *		    nativeBuffer <- UtfToExternal(encoding, utfBuffer);
 *		    Tcl_FreeEncoding(encoding);
 *		encoding <- Tcl_GetEncoding("unicode");
 *		nativeBuffer <- UtfToExternal(encoding, utfBuffer);
 *		Tcl_FreeEncoding(encoding);
 *		} else {
 *		    nativeBuffer <- UtfToExternal(NULL, utfBuffer);
 *		}
 *
 *	By convention, in Windows a TCHAR is a character in the ANSI code page
 *	By convention, in Windows a TCHAR is a Unicode character. If you plan
 *	on Windows 95, a Unicode character on Windows NT. If you plan on
 *	targeting a Unicode interfaces when running on NT and a "char"
 *	on targeting a Unicode interface when running on Windows, these
 *	oriented interface while running on 95, these functions should be
 *	used. If you plan on targetting the same "char" oriented function on
 *	both 95 and NT, use Tcl_UtfToExternal() with an encoding of NULL.
 *	functions should be used. If you plan on targetting a "char" oriented
 *	function on Windows, use Tcl_UtfToExternal() with an encoding of NULL.
 *
 * Results:
 *	The result is a pointer to the string in the desired target encoding.
 *	Storage for the result string is allocated in dsPtr; the caller must
 *	call Tcl_DStringFree() when the result is no longer needed.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

TCHAR *
Tcl_WinUtfToTChar(
    const char *string,		/* Source string in UTF-8. */
    int len,			/* Source string length in bytes, or < 0 for
    int len,			/* Source string length in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_DStringInit(dsPtr);
    if (!string) {
    return (TCHAR *) Tcl_UtfToExternalDString(winTCharEncoding,
	    string, len, dsPtr);
	return NULL;
    }
    return Tcl_UtfToUniCharDString(string, len, dsPtr);
}

char *
Tcl_WinTCharToUtf(
    const TCHAR *string,	/* Source string in Unicode when running NT,
    const TCHAR *string,	/* Source string in Unicode. */
				 * ANSI when running 95. */
    int len,			/* Source string length in bytes, or < 0 for
    int len,			/* Source string length in bytes, or -1 for
				 * platform-specific string length. */
    Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_DStringInit(dsPtr);
    if (!string) {
    return Tcl_ExternalToUtfDString(winTCharEncoding,
	    (const char *) string, len, dsPtr);
	return NULL;
    }
    if (len < 0) {
	len = wcslen(string);
    } else {
	len /= 2;
    }
    return Tcl_UniCharToUtfDString(string, len, dsPtr);
}

/*
 *------------------------------------------------------------------------
 *
 * TclWinCPUID --
 *
606
607
608
609
610
611
612
613

614
615
616
617
618
619
620
521
522
523
524
525
526
527

528
529
530
531
532
533
534
535







-
+







    int index,		/* Which CPUID value to retrieve. */
    int *regsPtr)	/* Registers after the CPUID. */
{
    int status = TCL_ERROR;

#if defined(HAVE_INTRIN_H) && defined(_WIN64)

    __cpuid(regsPtr, index);
    __cpuid((int *)regsPtr, index);
    status = TCL_OK;

#elif defined(__GNUC__)
#   if defined(_WIN64)
    /*
     * Execute the CPUID instruction with the given index, and store results
     * off 'regPtr'.

Changes to win/tclWinChan.c.

550
551
552
553
554
555
556
557
558


559
560
561
562
563
564
565
566
567
568
569
570

571
572
573
574
575
576
577
550
551
552
553
554
555
556


557
558
559
560
561
562
563
564
565
566
567
568
569

570
571
572
573
574
575
576
577







-
-
+
+











-
+







	moveMethod = FILE_BEGIN;
    } else if (mode == SEEK_CUR) {
	moveMethod = FILE_CURRENT;
    } else {
	moveMethod = FILE_END;
    }

    newPosHigh = Tcl_WideAsLong(offset >> 32);
    newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset),
    newPosHigh = (LONG)(offset >> 32);
    newPos = SetFilePointer(infoPtr->handle, (LONG)offset,
	    &newPosHigh, moveMethod);
    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    *errorCodePtr = errno;
	    return -1;
	}
    }
    return (((Tcl_WideInt)((unsigned)newPos))
	    | (Tcl_LongAsWide(newPosHigh) << 32));
	    | ((Tcl_WideInt)newPosHigh << 32));
}

/*
 *----------------------------------------------------------------------
 *
 * FileTruncateProc --
 *
609
610
611
612
613
614
615
616
617


618
619
620
621
622
623
624
609
610
611
612
613
614
615


616
617
618
619
620
621
622
623
624







-
-
+
+







	}
    }

    /*
     * Move to where we want to truncate
     */

    newPosHigh = Tcl_WideAsLong(length >> 32);
    newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
    newPosHigh = (LONG)(length >> 32);
    newPos = SetFilePointer(infoPtr->handle, (LONG)length,
	    &newPosHigh, FILE_BEGIN);
    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    return errno;
1375
1376
1377
1378
1379
1380
1381
1382

1383
1384
1385
1386
1387
1388
1389
1375
1376
1377
1378
1379
1380
1381

1382
1383
1384
1385
1386
1387
1388
1389







-
+








    infoPtr->nextPtr = NULL;
    infoPtr->validMask = permissions;
    infoPtr->watchMask = 0;
    infoPtr->flags = appendMode;
    infoPtr->handle = handle;
    infoPtr->dirty = 0;
    sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
	    infoPtr, permissions);

    /*
     * Files have default translation of AUTO and ^Z eof char, which means
     * that a ^Z will be accepted as EOF when reading.

Changes to win/tclWinConsole.c.

1316
1317
1318
1319
1320
1321
1322
1323

1324
1325
1326
1327
1328
1329
1330
1316
1317
1318
1319
1320
1321
1322

1323
1324
1325
1326
1327
1328
1329
1330







-
+








    /*
     * Use the pointer for the name of the result channel. This keeps the
     * channel names unique, since some may share handles (stdin/stdout/stderr
     * for instance).
     */

    sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
	    infoPtr, permissions);

    if (permissions & TCL_READABLE) {
	/*
	 * Make sure the console input buffer is ready for only character
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1356
1357
1358
1359
1360
1361
1362

1363



1364
1365
1366
1367
1368
1369
1370







-

-
-
-







    /*
     * Files have default translation of AUTO and ^Z eof char, which means
     * that a ^Z will be accepted as EOF when reading.
     */

    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
#ifdef UNICODE
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode");
#else
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
#endif
    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleThreadActionProc --

Changes to win/tclWinDde.c.

13
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
13
14
15
16
17
18
19

20








21
22
23
24
25
26
27







-
+
-
-
-
-
-
-
-
-







#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"
#include <dde.h>
#include <ddeml.h>

#include <tchar.h>
#ifndef UNICODE
#   undef CP_WINUNICODE
#   define CP_WINUNICODE CP_WINANSI
#   undef Tcl_WinTCharToUtf
#   define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
#   undef Tcl_WinUtfToTChar
#   define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
#endif

#if !defined(NDEBUG)
    /* test POKE server Implemented for debug mode only */
#   undef CBF_FAIL_POKES
#   define CBF_FAIL_POKES 0
#endif

55
56
57
58
59
60
61
62

63
64
65
66
67
68

69
70
71
72
73
74
75
47
48
49
50
51
52
53

54
55
56
57
58
59

60
61
62
63
64
65
66
67







-
+





-
+







    struct Conversation *nextPtr;
				/* The next conversation in the list. */
    RegisteredInterp *riPtr;	/* The info we know about the conversation. */
    HCONV hConv;		/* The DDE handle for this conversation. */
    Tcl_Obj *returnPackagePtr;	/* The result package for this conversation. */
} Conversation;

struct DdeEnumServices {
typedef struct {
    Tcl_Interp *interp;
    int result;
    ATOM service;
    ATOM topic;
    HWND hwnd;
};
} DdeEnumServices;

typedef struct {
    Conversation *currentConversations;
				/* A list of conversations currently being
				 * processed. */
    RegisteredInterp *interpListPtr;
				/* List of all interpreters registered in the
83
84
85
86
87
88
89
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



















128
129


130
131
132
133
134
135
136
75
76
77
78
79
80
81

82
83
84
85
86
87
88
89
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
128
129
130
131
132
133
134
135
136
137
138


139
140
141
142
143
144
145
146
147







-
+
















-
+




















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+







 */

static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance;	/* The application instance handle given to us
				 * by DdeInitialize. */
static int ddeIsServer = 0;

#define TCL_DDE_VERSION		"1.4.0"
#define TCL_DDE_VERSION		"1.4.1"
#define TCL_DDE_PACKAGE_NAME	"dde"
#define TCL_DDE_SERVICE_NAME	TEXT("TclEval")
#define TCL_DDE_EXECUTE_RESULT	TEXT("$TCLEVAL$EXECUTE$RESULT")

#define DDE_FLAG_ASYNC 1
#define DDE_FLAG_BINARY 2
#define DDE_FLAG_FORCE 4

TCL_DECLARE_MUTEX(ddeMutex)

/*
 * Forward declarations for functions defined later in this file.
 */

static LRESULT CALLBACK	DdeClientWindowProc(HWND hwnd, UINT uMsg,
			    WPARAM wParam, LPARAM lParam);
static int		DdeCreateClient(struct DdeEnumServices *es);
static int		DdeCreateClient(DdeEnumServices *es);
static BOOL CALLBACK	DdeEnumWindowsCallback(HWND hwndTarget,
			    LPARAM lParam);
static void		DdeExitProc(ClientData clientData);
static int		DdeGetServicesList(Tcl_Interp *interp,
			    const TCHAR *serviceName, const TCHAR *topicName);
static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv,
			    HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData,
			    DWORD dwData1, DWORD dwData2);
static LRESULT		DdeServicesOnAck(HWND hwnd, WPARAM wParam,
			    LPARAM lParam);
static void		DeleteProc(ClientData clientData);
static Tcl_Obj *	ExecuteRemoteObject(RegisteredInterp *riPtr,
			    Tcl_Obj *ddeObjectPtr);
static int		MakeDdeConnection(Tcl_Interp *interp,
			    const TCHAR *name, HCONV *ddeConvPtr);
static void		SetDdeError(Tcl_Interp *interp);
static int		DdeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

static unsigned char *
getByteArrayFromObj(
	Tcl_Obj *objPtr,
	size_t *lengthPtr
) {
    int length;

    unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
#if TCL_MAJOR_VERSION > 8
    if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
	/* 64-bit and TIP #494 situation: */
	 *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
    } else
#endif
	/* 32-bit or without TIP #494 */
    *lengthPtr = (size_t) (unsigned) length;
    return result;
}

DLLEXPORT int	Dde_Init(Tcl_Interp *interp);
DLLEXPORT int	Dde_SafeInit(Tcl_Interp *interp);
DLLEXPORT int		Dde_Init(Tcl_Interp *interp);
DLLEXPORT int		Dde_SafeInit(Tcl_Interp *interp);

/*
 *----------------------------------------------------------------------
 *
 * Dde_Init --
 *
 *	This function initializes the dde command.
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
159
160
161
162
163
164
165







166
167
168
169
170
171
172







-
-
-
-
-
-
-







Dde_Init(
    Tcl_Interp *interp)
{
    if (!Tcl_InitStubs(interp, "8.1", 0)) {
	return TCL_ERROR;
    }

#ifdef UNICODE
    if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"Win32s and Windows 9x are not supported platforms", -1));
	return TCL_ERROR;
    }
#endif
    Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
    Tcl_CreateExitHandler(DdeExitProc, NULL);
    return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
}

/*
 *----------------------------------------------------------------------
400
401
402
403
404
405
406
407

408
409

410
411
412
413
414
415
416
404
405
406
407
408
409
410

411
412

413
414
415
416
417
418
419
420







-
+

-
+







	}
    }

    /*
     * We have found a unique name. Now add it to the registry.
     */

    riPtr = ckalloc(sizeof(RegisteredInterp));
    riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp));
    riPtr->interp = interp;
    riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
    riPtr->name = (TCHAR *) Tcl_Alloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
    riPtr->nextPtr = tsdPtr->interpListPtr;
    riPtr->handlerPtr = handlerPtr;
    if (riPtr->handlerPtr != NULL) {
	Tcl_IncrRefCount(riPtr->handlerPtr);
    }
    tsdPtr->interpListPtr = riPtr;
    _tcscpy(riPtr->name, actualName);
503
504
505
506
507
508
509
510

511
512
513
514
515
516
517
507
508
509
510
511
512
513

514
515
516
517
518
519
520
521







-
+







    if (searchPtr != NULL) {
	if (prevPtr == NULL) {
	    tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = searchPtr->nextPtr;
	}
    }
    ckfree(riPtr->name);
    Tcl_Free((char *) riPtr->name);
    if (riPtr->handlerPtr) {
	Tcl_DecrRefCount(riPtr->handlerPtr);
    }
    Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
}

/*
541
542
543
544
545
546
547
548

549
550
551
552
553
554
555
545
546
547
548
549
550
551

552
553
554
555
556
557
558
559







-
+







ExecuteRemoteObject(
    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)) {
    if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) {
	Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
		"a handler procedure must be defined for use in a safe "
		"interp", -1));
	Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL);
	result = TCL_ERROR;
    }

623
624
625
626
627
628
629
630

631
632
633
634
635
636
637
627
628
629
630
631
632
633

634
635
636
637
638
639
640
641







-
+







    HSZ ddeTopic, HSZ ddeItem,	/* String handles. Transaction-type
				 * dependent. */
    HDDEDATA hData,		/* DDE data. Transaction-type dependent. */
    DWORD dwData1, DWORD dwData2)
				/* Transaction-dependent data. */
{
    Tcl_DString dString;
    int len;
    size_t len;
    DWORD dlen;
    TCHAR *utilString;
    Tcl_Obj *ddeObjectPtr;
    HDDEDATA ddeReturn = NULL;
    RegisteredInterp *riPtr;
    Conversation *convPtr, *prevConvPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
673
674
675
676
677
678
679
680

681
682
683
684
685
686
687
677
678
679
680
681
682
683

684
685
686
687
688
689
690
691







-
+







	Tcl_DStringSetLength(&dString,  (len + 1) * sizeof(TCHAR) - 1);
	utilString = (TCHAR *) Tcl_DStringValue(&dString);
	DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
		CP_WINUNICODE);
	for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
		riPtr = riPtr->nextPtr) {
	    if (_tcsicmp(riPtr->name, utilString) == 0) {
		convPtr = ckalloc(sizeof(Conversation));
		convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation));
		convPtr->nextPtr = tsdPtr->currentConversations;
		convPtr->returnPackagePtr = NULL;
		convPtr->hConv = hConv;
		convPtr->riPtr = riPtr;
		tsdPtr->currentConversations = convPtr;
		break;
	    }
703
704
705
706
707
708
709
710

711
712
713
714
715
716
717
707
708
709
710
711
712
713

714
715
716
717
718
719
720
721







-
+







		    tsdPtr->currentConversations = convPtr->nextPtr;
		} else {
		    prevConvPtr->nextPtr = convPtr->nextPtr;
		}
		if (convPtr->returnPackagePtr != NULL) {
		    Tcl_DecrRefCount(convPtr->returnPackagePtr);
		}
		ckfree(convPtr);
		Tcl_Free((char *) convPtr);
		break;
	    }
	}
	return (HDDEDATA) TRUE;

    case XTYP_REQUEST:
	/*
729
730
731
732
733
734
735

736
737
738
739

740
741
742
743
744
745
746
747
748
749






750
751

752
753
754
755
756
757
758
759
760

761
762
763
764
765
766
767
768
769
770





771
772

773
774
775
776
777
778
779
780
781
782

783
784
785
786
787
788
789
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750





751
752
753
754
755
756


757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772





773
774
775
776
777


778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796







+




+





-
-
-
-
-
+
+
+
+
+
+
-
-
+









+





-
-
-
-
-
+
+
+
+
+
-
-
+










+







		&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
	    /*
	     * Empty loop body.
	     */
	}

	if (convPtr != NULL) {
	    Tcl_DString dsBuf;
	    char *returnString;

	    len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
	    Tcl_DStringInit(&dString);
	    Tcl_DStringInit(&dsBuf);
	    Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
	    utilString = (TCHAR *) Tcl_DStringValue(&dString);
	    DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
		    CP_WINUNICODE);
	    if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
		if (uFmt == CF_TEXT) {
		    returnString =
			    Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
		} else {
		    returnString = (char *)
		returnString =
			Tcl_GetString(convPtr->returnPackagePtr);
		len = convPtr->returnPackagePtr->length;
		if (uFmt != CF_TEXT) {
		    Tcl_WinUtfToTChar(returnString, len, &dsBuf);
		    returnString = Tcl_DStringValue(&dsBuf);
			    Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
		    len = sizeof(TCHAR) * len + 1;
		    len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1;
		}
		ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
			(DWORD) len+1, 0, ddeItem, uFmt, 0);
	    } else {
		if (Tcl_IsSafe(convPtr->riPtr->interp)) {
		    ddeReturn = NULL;
		} else {
		    Tcl_DString ds;
		    Tcl_Obj *variableObjPtr;

		    Tcl_WinTCharToUtf(utilString, -1, &ds);
		    variableObjPtr = Tcl_GetVar2Ex(
			    convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
			    TCL_GLOBAL_ONLY);
		    if (variableObjPtr != NULL) {
			if (uFmt == CF_TEXT) {
			    returnString = Tcl_GetStringFromObj(
				    variableObjPtr, &len);
			} else {
			    returnString = (char *) Tcl_GetUnicodeFromObj(
			returnString = Tcl_GetString(variableObjPtr);
			len = variableObjPtr->length;
			if (uFmt != CF_TEXT) {
			    Tcl_WinUtfToTChar(returnString, len, &dsBuf);
			    returnString = Tcl_DStringValue(&dsBuf);
				    variableObjPtr, &len);
			    len = sizeof(TCHAR) * len + 1;
			    len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1;
			}
			ddeReturn = DdeCreateDataHandle(ddeInstance,
				(BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
				uFmt, 0);
		    } else {
			ddeReturn = NULL;
		    }
		    Tcl_DStringFree(&ds);
		}
	    }
	    Tcl_DStringFree(&dsBuf);
	    Tcl_DStringFree(&dString);
	}
	return ddeReturn;

#if !CBF_FAIL_POKES
    case XTYP_POKE:
	/*
800
801
802
803
804
805
806
807

808

809
810
811



812
813
814
815
816
817
818
819




820
821

822

823
824
825
826

827
828
829
830
831
832
833
807
808
809
810
811
812
813

814
815
816
817


818
819
820
821
822
823
824
825



826
827
828
829


830
831
832
833
834
835
836
837
838
839
840
841
842
843
844







-
+

+

-
-
+
+
+





-
-
-
+
+
+
+
-
-
+

+




+







		&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
	    /*
	     * Empty loop body.
	     */
	}

	if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) {
	    Tcl_DString ds;
	    Tcl_DString ds, ds2;
	    Tcl_Obj *variableObjPtr;
	    DWORD len2;

	    len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
	    Tcl_DStringInit(&dString);
	    Tcl_DStringInit(&dString);
	    Tcl_DStringInit(&ds2);
	    len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
	    Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
	    utilString = (TCHAR *) Tcl_DStringValue(&dString);
	    DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
		    CP_WINUNICODE);
	    Tcl_WinTCharToUtf(utilString, -1, &ds);
	    utilString = (TCHAR *) DdeAccessData(hData, &dlen);
	    if (uFmt == CF_TEXT) {
		variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
	    utilString = (TCHAR *) DdeAccessData(hData, &len2);
	    len = len2;
	    if (uFmt != CF_TEXT) {
		Tcl_WinTCharToUtf(utilString, -1, &ds2);
	    } else {
		variableObjPtr = Tcl_NewUnicodeObj(utilString, -1);
		utilString = (TCHAR *) Tcl_DStringValue(&ds2);
	    }
	    variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);

	    Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
		    variableObjPtr, TCL_GLOBAL_ONLY);

	    Tcl_DStringFree(&ds2);
	    Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&dString);
		ddeReturn = (HDDEDATA) DDE_FACK;
	}
	return ddeReturn;

#endif
860
861
862
863
864
865
866

867
868





869
870
871
872
873
874
875
871
872
873
874
875
876
877
878


879
880
881
882
883
884
885
886
887
888
889
890







+
-
-
+
+
+
+
+







	    /* Cannot be unicode, so assume utf-8 */
	    if (!string[dlen-1]) {
		dlen--;
	    }
	    ddeObjectPtr = Tcl_NewStringObj(string, dlen);
	} else {
	    /* unicode */
	    Tcl_DString dsBuf;
	    dlen >>= 1;
	    ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1);

	    Tcl_WinTCharToUtf(utilString, dlen - sizeof(TCHAR), &dsBuf);
	    ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
		    Tcl_DStringLength(&dsBuf));
	    Tcl_DStringFree(&dsBuf);
	}
	Tcl_IncrRefCount(ddeObjectPtr);
	DdeUnaccessData(hData);
	if (convPtr->returnPackagePtr != NULL) {
	    Tcl_DecrRefCount(convPtr->returnPackagePtr);
	}
	convPtr->returnPackagePtr = NULL;
1026
1027
1028
1029
1030
1031
1032
1033

1034
1035
1036
1037
1038
1039
1040
1041
1042
1043

1044
1045
1046
1047
1048
1049
1050
1041
1042
1043
1044
1045
1046
1047

1048
1049
1050
1051
1052
1053
1054
1055
1056
1057

1058
1059
1060
1061
1062
1063
1064
1065







-
+









-
+







 *	Sets the services list into the interp result.
 *
 *----------------------------------------------------------------------
 */

static int
DdeCreateClient(
    struct DdeEnumServices *es)
    DdeEnumServices *es)
{
    WNDCLASSEX wc;
    static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
    static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window");

    memset(&wc, 0, sizeof(wc));
    wc.cbSize = sizeof(wc);
    wc.lpfnWndProc = DdeClientWindowProc;
    wc.lpszClassName = szDdeClientClassName;
    wc.cbWndExtra = sizeof(struct DdeEnumServices *);
    wc.cbWndExtra = sizeof(DdeEnumServices *);

    /*
     * Register and create the callback window.
     */

    RegisterClassEx(&wc);
    es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName,
1058
1059
1060
1061
1062
1063
1064
1065
1066


1067
1068
1069
1070
1071
1072
1073
1073
1074
1075
1076
1077
1078
1079


1080
1081
1082
1083
1084
1085
1086
1087
1088







-
-
+
+







    UINT uMsg,			/* The type of message received */
    WPARAM wParam,
    LPARAM lParam)		/* (Potentially) our local handle */
{
    switch (uMsg) {
    case WM_CREATE: {
	LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
	struct DdeEnumServices *es =
		(struct DdeEnumServices *) lpcs->lpCreateParams;
	DdeEnumServices *es =
		(DdeEnumServices *) lpcs->lpCreateParams;

#ifdef _WIN64
	SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
#else
	SetWindowLong(hwnd, GWL_USERDATA, (LONG) es);
#endif
	return (LRESULT) 0L;
1084
1085
1086
1087
1088
1089
1090
1091

1092
1093
1094
1095
1096

1097
1098

1099
1100
1101
1102


1103
1104
1105
1106
1107
1108
1109
1099
1100
1101
1102
1103
1104
1105

1106
1107
1108
1109
1110

1111
1112

1113
1114
1115


1116
1117
1118
1119
1120
1121
1122
1123
1124







-
+




-
+

-
+


-
-
+
+







    HWND hwnd,
    WPARAM wParam,
    LPARAM lParam)
{
    HWND hwndRemote = (HWND)wParam;
    ATOM service = (ATOM)LOWORD(lParam);
    ATOM topic = (ATOM)HIWORD(lParam);
    struct DdeEnumServices *es;
    DdeEnumServices *es;
    TCHAR sz[255];
    Tcl_DString dString;

#ifdef _WIN64
    es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
    es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
    es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
    es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
#endif

    if ((es->service == (ATOM)0 || es->service == service)
	    && (es->topic == (ATOM)0 || es->topic == topic)) {
    if (((es->service == (ATOM)0) || (es->service == service))
	    && ((es->topic == (ATOM)0) || (es->topic == topic))) {
	Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
	Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);

	GlobalGetAtomName(service, sz, 255);
	Tcl_WinTCharToUtf(sz, -1, &dString);
	Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
	Tcl_DStringFree(&dString);
1142
1143
1144
1145
1146
1147
1148
1149

1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163

1164
1165
1166
1167
1168
1169
1170
1157
1158
1159
1160
1161
1162
1163

1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177

1178
1179
1180
1181
1182
1183
1184
1185







-
+













-
+








static BOOL CALLBACK
DdeEnumWindowsCallback(
    HWND hwndTarget,
    LPARAM lParam)
{
    DWORD_PTR dwResult = 0;
    struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
    DdeEnumServices *es = (DdeEnumServices *) lParam;

    SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
	    MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
	    &dwResult);
    return TRUE;
}

static int
DdeGetServicesList(
    Tcl_Interp *interp,
    const TCHAR *serviceName,
    const TCHAR *topicName)
{
    struct DdeEnumServices es;
    DdeEnumServices es;

    es.interp = interp;
    es.result = TCL_OK;
    es.service = (serviceName == NULL)
	    ? (ATOM)0 : GlobalAddAtom(serviceName);
    es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName);

1277
1278
1279
1280
1281
1282
1283
1284


1285
1286
1287
1288
1289
1290
1291
1292

1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307



1308
1309
1310
1311
1312
1313
1314
1292
1293
1294
1295
1296
1297
1298

1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334







-
+
+








+















+
+
+







    static const char *const ddeEvalOptions[] = {
	"-async", NULL
    };
    static const char *const ddeReqOptions[] = {
	"-binary", NULL
    };

    int index, i, length, argIndex;
    int index, i, argIndex;
    size_t length;
    int flags = 0, result = TCL_OK, firstArg = 0;
    HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
    HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
    HCONV hConv = NULL;
    const TCHAR *serviceName = NULL, *topicName = NULL;
    const char *string;
    DWORD ddeResult;
    Tcl_Obj *objPtr, *handlerPtr = NULL;
    Tcl_DString serviceBuf, topicBuf, itemBuf;

    /*
     * Initialize DDE server/client
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_DStringInit(&serviceBuf);
    Tcl_DStringInit(&topicBuf);
    Tcl_DStringInit(&itemBuf);
    switch ((enum DdeSubcommands) index) {
    case DDE_SERVERNAME:
	for (i = 2; i < objc; i++) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
		    "option", 0, &argIndex) != TCL_OK) {
		/*
		 * If it is the last argument, it might be a server name
1350
1351
1352
1353
1354
1355
1356
1357

1358
1359
1360
1361
1362
1363
1364
1370
1371
1372
1373
1374
1375
1376

1377
1378
1379
1380
1381
1382
1383
1384







-
+








	firstArg = (objc == i) ? 1 : i;
	break;
    case DDE_EXECUTE:
	if (objc == 5) {
	    firstArg = 2;
	    break;
	} else if (objc >= 6 && objc <= 7) {
	} else if ((objc >= 6) && (objc <= 7)) {
	    firstArg = objc - 3;
	    for (i = 2; i < firstArg; i++) {
		if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
			"option", 0, &argIndex) != TCL_OK) {
		    goto wrongDdeExecuteArgs;
		}
		if (argIndex == DDE_EXEC_ASYNC) {
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446






1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463





1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476

1477
1478


1479
1480
1481



1482
1483
1484
1485
1486
1487
1488
1489



1490

1491
1492
1493


1494




1495
1496
1497



1498
1499
1500

1501
1502

1503
1504
1505
1506
1507
1508
1509
1510
1511

1512
1513
1514
1515
1516
1517
1518
1455
1456
1457
1458
1459
1460
1461





1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479





1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498


1499
1500



1501
1502
1503
1504
1505
1506
1507
1508
1509


1510
1511
1512
1513
1514
1515


1516
1517
1518
1519
1520
1521
1522



1523
1524
1525
1526
1527

1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548







-
-
-
-
-
+
+
+
+
+
+












-
-
-
-
-
+
+
+
+
+













+
-
-
+
+
-
-
-
+
+
+






-
-
+
+
+

+

-
-
+
+

+
+
+
+
-
-
-
+
+
+


-
+


+









+







	    break;
	}
    }

    Initialize();

    if (firstArg != 1) {
#ifdef UNICODE
	serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length);
#else
	serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
#endif
	const char *src = Tcl_GetString(objv[firstArg]);

	length = objv[firstArg]->length;
	Tcl_WinUtfToTChar(src, length, &serviceBuf);
	serviceName = (TCHAR *) Tcl_DStringValue(&serviceBuf);
	length = Tcl_DStringLength(&serviceBuf) / sizeof(TCHAR);
    } else {
	length = 0;
    }

    if (length == 0) {
	serviceName = NULL;
    } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
	ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName,
		CP_WINUNICODE);
    }

    if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
#ifdef UNICODE
	topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length);
#else
	topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
#endif
	const char *src = Tcl_GetString(objv[firstArg + 1]);

	length = objv[firstArg + 1]->length;
	topicName = Tcl_WinUtfToTChar(src, length, &topicBuf);
	length = Tcl_DStringLength(&topicBuf) / sizeof(TCHAR);
	if (length == 0) {
	    topicName = NULL;
	} else {
	    ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName,
		    CP_WINUNICODE);
	}
    }

    switch ((enum DdeSubcommands) index) {
    case DDE_SERVERNAME:
	serviceName = DdeSetServerName(interp, serviceName, flags,
		handlerPtr);
	if (serviceName != NULL) {
	    Tcl_DString dsBuf;
#ifdef UNICODE
	    Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1));

	    Tcl_WinTCharToUtf(serviceName, -1, &dsBuf);
#else
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
#endif
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
		    Tcl_DStringLength(&dsBuf)));
	    Tcl_DStringFree(&dsBuf);
	} else {
	    Tcl_ResetResult(interp);
	}
	break;

    case DDE_EXECUTE: {
	int dataLength;
	const Tcl_UniChar *dataString;
	size_t dataLength;
	const void *dataString;
	Tcl_DString dsBuf;

	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString = (const Tcl_UniChar *)
		    Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
	    dataString =
		    getByteArrayFromObj(objv[firstArg + 2], &dataLength);
	} else {
	    const char *src;

	    src = Tcl_GetString(objv[firstArg + 2]);
	    dataLength = objv[firstArg + 2]->length;
	    dataString =
		    Tcl_GetUnicodeFromObj(objv[firstArg + 2], &dataLength);
	    dataLength = (dataLength + 1) * sizeof(Tcl_UniChar);
	    dataString = (const TCHAR *)
		    Tcl_WinUtfToTChar(src, dataLength, &dsBuf);
	    dataLength = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
	}

	if (dataLength <= 0) {
	if (dataLength + 1 < 2) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot execute null data", -1));
	    Tcl_DStringFree(&dsBuf);
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    break;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);

	if (hConv == NULL) {
	    Tcl_DStringFree(&dsBuf);
	    SetDdeError(interp);
	    result = TCL_ERROR;
	    break;
	}

	ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString,
		(DWORD) dataLength, 0, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, 0);
1530
1531
1532
1533
1534
1535
1536

1537
1538
1539
1540
1541
1542



1543
1544
1545
1546




1547
1548
1549
1550
1551
1552
1553
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570



1571
1572
1573




1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584







+



-
-
-
+
+
+
-
-
-
-
+
+
+
+







		}
	    }
	    DdeFreeDataHandle(ddeData);
	} else {
	    SetDdeError(interp);
	    result = TCL_ERROR;
	}
	Tcl_DStringFree(&dsBuf);
	break;
    }
    case DDE_REQUEST: {
#ifdef UNICODE
	const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
		&length);
	const TCHAR *itemString;
	const char *src;

#else
	const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
		&length);
#endif
	src = Tcl_GetString(objv[firstArg + 2]);
	length = objv[firstArg + 2]->length;
	itemString = Tcl_WinUtfToTChar(src, length, &itemBuf);
	length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR);

	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot request value of null data", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
1567
1568
1569
1570
1571
1572
1573
1574

1575
1576
1577
1578

1579

1580
1581
1582




1583

1584
1585




1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601

1602
1603
1604

1605
1606
1607

1608




1609
1610
1611
1612
1613
1614
1615

1616
1617
1618

1619



1620
1621
1622


1623
1624
1625
1626
1627
1628
1629
1598
1599
1600
1601
1602
1603
1604

1605
1606
1607
1608

1609
1610
1611



1612
1613
1614
1615
1616
1617


1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631

1632
1633
1634


1635



1636


1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653

1654
1655
1656
1657
1658
1659


1660
1661
1662
1663
1664
1665
1666
1667
1668







-
+



-
+

+
-
-
-
+
+
+
+

+
-
-
+
+
+
+










-



-
-
+
-
-
-
+
-
-

+

+
+
+
+







+


-
+

+
+
+

-
-
+
+







		ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
			(flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL);
		if (ddeData == NULL) {
		    SetDdeError(interp);
		    result = TCL_ERROR;
		} else {
		    DWORD tmp;
		    const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp);
		    TCHAR *dataString = (TCHAR *) DdeAccessData(ddeData, &tmp);

		    if (flags & DDE_FLAG_BINARY) {
			returnObjPtr =
				Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
				Tcl_NewByteArrayObj((BYTE *) dataString, tmp);
		    } else {
			Tcl_DString dsBuf;
			tmp >>= 1;
			if (tmp && !dataString[(tmp-1)]) {
			    --tmp;

			if ((tmp >= sizeof(TCHAR))
				&& !dataString[tmp / sizeof(TCHAR) - 1]) {
			    tmp -= sizeof(TCHAR);
			}
			Tcl_WinTCharToUtf(dataString, tmp, &dsBuf);
			returnObjPtr = Tcl_NewUnicodeObj(dataString,
				(int) tmp);
			returnObjPtr =
			    Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
				    Tcl_DStringLength(&dsBuf));
			Tcl_DStringFree(&dsBuf);
		    }
		    DdeUnaccessData(ddeData);
		    DdeFreeDataHandle(ddeData);
		    Tcl_SetObjResult(interp, returnObjPtr);
		}
	    } else {
		SetDdeError(interp);
		result = TCL_ERROR;
	    }
	}

	break;
    }
    case DDE_POKE: {
#ifdef UNICODE
	const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
	Tcl_DString dsBuf;
		&length);
#else
	const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
	const TCHAR *itemString;
		&length);
#endif
	BYTE *dataString;
	const char *src;

	src = Tcl_GetString(objv[firstArg + 2]);
	length = objv[firstArg + 2]->length;
	itemString = Tcl_WinUtfToTChar(src, length, &itemBuf);
	length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR);
	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot have a null item", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString = (BYTE *)
		    Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
		    getByteArrayFromObj(objv[firstArg + 3], &length);
	} else {
	    const char *data =
		    Tcl_GetString(objv[firstArg + 3]);
	    length = objv[firstArg + 3]->length;
	    dataString = (BYTE *)
		    Tcl_GetUnicodeFromObj(objv[firstArg + 3], &length);
	    length = 2 * length + 1;
		    Tcl_WinUtfToTChar(data, length, &dsBuf);
	    length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
	}

	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);

	if (hConv == NULL) {
1640
1641
1642
1643
1644
1645
1646

1647
1648
1649
1650
1651
1652
1653
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693







+







		    result = TCL_ERROR;
		}
	    } else {
		SetDdeError(interp);
		result = TCL_ERROR;
	    }
	}
	Tcl_DStringFree(&dsBuf);
	break;
    }

    case DDE_SERVICES:
	result = DdeGetServicesList(interp, serviceName, topicName);
	break;

1698
1699
1700
1701
1702
1703
1704
1705

1706
1707
1708
1709
1710
1711
1712
1738
1739
1740
1741
1742
1743
1744

1745
1746
1747
1748
1749
1750
1751
1752







-
+







	     * Don't exchange objects between interps. The target interp would
	     * compile an object, producing a bytecode structure that refers
	     * to other objects owned by the target interp. If the target
	     * interp is then deleted, the bytecode structure would be
	     * referring to deallocated objects.
	     */

	    if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) {
	    if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) {
		Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
			"permission denied: a handler procedure must be"
			" defined for use in a safe interp", -1));
		Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
			NULL);
		result = TCL_ERROR;
	    }
1757
1758
1759
1760
1761
1762
1763


1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781








1782
1783
1784
1785
1786
1787
1788
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820



1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835







+
+















-
-
-
+
+
+
+
+
+
+
+







		    }
		}
		Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
	    }
	    Tcl_Release(riPtr);
	    Tcl_Release(sendInterp);
	} else {
	    Tcl_DString dsBuf;

	    /*
	     * This is a non-local request. Send the script to the server and
	     * poll it for a result.
	     */

	    if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
	    invalidServerResponse:
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("invalid data returned from server", -1));
		Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
		result = TCL_ERROR;
		goto cleanup;
	    }

	    objPtr = Tcl_ConcatObj(objc, objv);
	    string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length);
	    ddeItemData = DdeCreateDataHandle(ddeInstance,
		    (BYTE *) string, (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0);
	    string = Tcl_GetString(objPtr);
	    length = objPtr->length;
	    Tcl_WinUtfToTChar(string, length, &dsBuf);
	    string = Tcl_DStringValue(&dsBuf);
	    length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
	    ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string,
		    (DWORD) length, 0, 0, CF_UNICODETEXT, 0);
	    Tcl_DStringFree(&dsBuf);

	    if (flags & DDE_FLAG_ASYNC) {
		ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
			0xFFFFFFFF, hConv, 0,
			CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
		DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
	    } else {
1803
1804
1805
1806
1807
1808
1809
1810

1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823

1824
1825
1826
1827








1828
1829
1830
1831
1832
1833
1834
1850
1851
1852
1853
1854
1855
1856

1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867

1868

1869
1870



1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885







-
+










-

-
+

-
-
-
+
+
+
+
+
+
+
+







		SetDdeError(interp);
		result = TCL_ERROR;
		goto cleanup;
	    }

	    if (!(flags & DDE_FLAG_ASYNC)) {
		Tcl_Obj *resultPtr;
		Tcl_UniChar *ddeDataString;
		TCHAR *ddeDataString;

		/*
		 * The return handle has a two or four element list in it. The
		 * first element is the return code (TCL_OK, TCL_ERROR, etc.).
		 * The second is the result of the script. If the return code
		 * is TCL_ERROR, then the third element is the value of the
		 * variable "errorCode", and the fourth is the value of the
		 * variable "errorInfo".
		 */

		resultPtr = Tcl_NewObj();
		length = DdeGetData(ddeData, NULL, 0, 0);
		ddeDataString = ckalloc(length);
		ddeDataString = (TCHAR *) Tcl_Alloc(length);
		DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
		length = (length >> 1) - 1;
		resultPtr = Tcl_NewUnicodeObj(ddeDataString, length);
		ckfree(ddeDataString);
		if (length > sizeof(TCHAR)) {
		    length -= sizeof(TCHAR);
		}
		Tcl_WinTCharToUtf(ddeDataString, length, &dsBuf);
		resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
			Tcl_DStringLength(&dsBuf));
		Tcl_DStringFree(&dsBuf);
		Tcl_Free((char *) ddeDataString);

		if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    goto invalidServerResponse;
		}
		if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
1870
1871
1872
1873
1874
1875
1876



1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942







+
+
+












    }
    if (ddeData != NULL) {
	DdeFreeDataHandle(ddeData);
    }
    if (hConv != NULL) {
	DdeDisconnect(hConv);
    }
    Tcl_DStringFree(&itemBuf);
    Tcl_DStringFree(&topicBuf);
    Tcl_DStringFree(&serviceBuf);
    return result;
}

/*
 * Local variables:
 * mode: c
 * indent-tabs-mode: t
 * tab-width: 8
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinError.c.

26
27
28
29
30
31
32
33

34
35
36
37
38
39
40
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40







-
+







    ENOMEM,	/* ERROR_ARENA_TRASHED		7 */
    ENOMEM,	/* ERROR_NOT_ENOUGH_MEMORY	8 */
    ENOMEM,	/* ERROR_INVALID_BLOCK		9 */
    E2BIG,	/* ERROR_BAD_ENVIRONMENT	10 */
    ENOEXEC,	/* ERROR_BAD_FORMAT		11 */
    EACCES,	/* ERROR_INVALID_ACCESS		12 */
    EINVAL,	/* ERROR_INVALID_DATA		13 */
    EFAULT,	/* ERROR_OUT_OF_MEMORY		14 */
    ENOMEM,	/* ERROR_OUT_OF_MEMORY		14 */
    ENOENT,	/* ERROR_INVALID_DRIVE		15 */
    EACCES,	/* ERROR_CURRENT_DIRECTORY	16 */
    EXDEV,	/* ERROR_NOT_SAME_DEVICE	17 */
    ENOENT,	/* ERROR_NO_MORE_FILES		18 */
    EROFS,	/* ERROR_WRITE_PROTECT		19 */
    ENXIO,	/* ERROR_BAD_UNIT		20 */
    EBUSY,	/* ERROR_NOT_READY		21 */
387
388
389
390
391
392
393
394

395
396
397
398
399
400
401
402
403
404
405
406
407
408



409
410
411
412
413
414
415
387
388
389
390
391
392
393

394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418







-
+














+
+
+







{
#define TCL_MAX_WARN_LEN 1024
    va_list argList;
    va_start(argList, format);

    if (IsDebuggerPresent()) {
	WCHAR msgString[TCL_MAX_WARN_LEN];
	char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
	char buf[TCL_MAX_WARN_LEN * 3];

	vsnprintf(buf, sizeof(buf), format, argList);
	msgString[TCL_MAX_WARN_LEN-1] = L'\0';
	MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN);

	/*
	 * Truncate MessageBox string if it is too long to not overflow the buffer.
	 */

	if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
	    memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
	}
	OutputDebugStringW(msgString);
    } else {
	if (!isatty(fileno(stderr))) {
	    fprintf(stderr, "\xef\xbb\xbf");
	}
	vfprintf(stderr, format, argList);
	fprintf(stderr, "\n");
	fflush(stderr);
    }
#   if defined(__GNUC__)
    __builtin_trap();
#   else

Changes to win/tclWinFCmd.c.

333
334
335
336
337
338
339
340

341
342
343
344
345
346
347
333
334
335
336
337
338
339

340
341
342
343
344
345
346
347







-
+








	    /*
	     * Check whether the destination path is actually inside the
	     * source path. This is true if the prefix matches, and the next
	     * character is either end-of-string or a directory separator
	     */

	    if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0)
	    if ((strncmp(src, dst, Tcl_DStringLength(&srcString))==0)
		    && (dst[Tcl_DStringLength(&srcString)] == '\\'
		    || dst[Tcl_DStringLength(&srcString)] == '/'
		    || dst[Tcl_DStringLength(&srcString)] == '\0')) {
		/*
		 * Trying to move a directory into itself.
		 */

1022
1023
1024
1025
1026
1027
1028
1029


1030
1031
1032
1033
1034
1035
1036
1022
1023
1024
1025
1026
1027
1028

1029
1030
1031
1032
1033
1034
1035
1036
1037







-
+
+







    /*
     * The RemoveDirectory API acts differently under Win95/98 and NT WRT NULL
     * and "". Avoid passing these values.
     */

    if (nativePath == NULL || nativePath[0] == '\0') {
	Tcl_SetErrno(ENOENT);
	goto end;
	Tcl_DStringInit(errorPtr);
	return TCL_ERROR;
    }

    attr = GetFileAttributes(nativePath);

    if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
	/*
	 * It is a symbolic link - remove it.
1104
1105
1106
1107
1108
1109
1110
1111
1112

1113
1114
1115
1116
1117
1118
1119
1120
1105
1106
1107
1108
1109
1110
1111


1112

1113
1114
1115
1116
1117
1118
1119







-
-
+
-







	 * don't want to initialise the errorPtr yet.
	 */
	return TCL_ERROR;
    }

  end:
    if (errorPtr != NULL) {
	char *p;
	Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
	char *p = Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
	p = Tcl_DStringValue(errorPtr);
	for (; *p; ++p) {
	    if (*p == '\\') *p = '/';
	}
    }
    return TCL_ERROR;

}
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1645
1646
1647
1648
1649
1650
1651

1652
1653
1654
1655
1656
1657
1658







-







	    Tcl_IncrRefCount(tempPath);

	    /*
	     * We'd like to call Tcl_FSGetNativePath(tempPath) but that is
	     * likely to lead to infinite loops.
	     */

	    Tcl_DStringInit(&ds);
	    tempString = TclGetString(tempPath);
	    nativeName = Tcl_WinUtfToTChar(tempString, tempPath->length, &ds);
	    Tcl_DecrRefCount(tempPath);
	    handle = FindFirstFile(nativeName, &data);
	    if (handle == INVALID_HANDLE_VALUE) {
		/*
		 * FindFirstFile() doesn't like root directories. We would

Changes to win/tclWinFile.c.

526
527
528
529
530
531
532





533
534
535
536
537
538
539
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544







+
+
+
+
+







 *	anything went wrong.
 *
 *	In the future we should enhance this to return a path object rather
 *	than a string.
 *
 *--------------------------------------------------------------------
 */

#if defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Warray-bounds"
#endif

static Tcl_Obj *
WinReadLinkDirectory(
    const TCHAR *linkDirPath)
{
    int attr, len, offset;
    DUMMY_REPARSE_BUFFER dummy;
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
568
569
570
571
572
573
574

575
576
577
578
579
580
581







-







	 * There is an assumption in this code that 'wide' interfaces are
	 * being used (see tclWin32Dll.c), which is true for the only systems
	 * which support reparse tags at present. If that changes in the
	 * future, this code will have to be generalised.
	 */

	offset = 0;
#ifdef UNICODE
	if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') {
	    /*
	     * Check whether this is a mounted volume.
	     */

	    if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer,
		    L"\\??\\Volume{",11) == 0) {
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650




651
652
653
654
655
656
657
629
630
631
632
633
634
635

636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664







-


















+
+
+
+







		/*
		 * Strip off the prefix.
		 */

		offset = 4;
	    }
	}
#endif /* UNICODE */

	Tcl_WinTCharToUtf((const TCHAR *)
		reparseBuffer->MountPointReparseBuffer.PathBuffer,
		(int) reparseBuffer->MountPointReparseBuffer
		.SubstituteNameLength, &ds);

	copy = Tcl_DStringValue(&ds)+offset;
	len = Tcl_DStringLength(&ds)-offset;
	retVal = Tcl_NewStringObj(copy,len);
	Tcl_IncrRefCount(retVal);
	Tcl_DStringFree(&ds);
	return retVal;
    }

  invalidError:
    Tcl_SetErrno(EINVAL);
    return NULL;
}

#if defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic pop
#endif

/*
 *--------------------------------------------------------------------
 *
 * NativeReadReparse --
 *
 *	Read the junction/reparse information from a given NTFS directory.
796
797
798
799
800
801
802
803

804
805
806
807
808
809
810
803
804
805
806
807
808
809

810
811
812
813
814
815
816
817







-
+








TCL_NORETURN void
tclWinDebugPanic(
    const char *format, ...)
{
#define TCL_MAX_WARN_LEN 1024
    va_list argList;
    char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
    char buf[TCL_MAX_WARN_LEN * 3];
    WCHAR msgString[TCL_MAX_WARN_LEN];

    va_start(argList, format);
    vsnprintf(buf, sizeof(buf), format, argList);

    msgString[TCL_MAX_WARN_LEN-1] = L'\0';
    MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN);
855
856
857
858
859
860
861
862

863
864
865
866
867
868
869

870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
862
863
864
865
866
867
868

869
870
871
872
873
874
875
876
877
878
879
880

881









882
883
884
885
886
887
888







-
+







+



-

-
-
-
-
-
-
-
-
-








void
TclpFindExecutable(
    const char *argv0)		/* If NULL, install PanicMessageBox, otherwise
				 * ignore. */
{
    WCHAR wName[MAX_PATH];
    char name[MAX_PATH * TCL_UTF_MAX];
    char name[MAX_PATH * 3];

    /*
     * Under Windows we ignore argv0, and return the path for the file used to
     * create this process. Only if it is NULL, install a new panic handler.
     */

    if (argv0 == NULL) {
#	undef Tcl_SetPanicProc
	Tcl_SetPanicProc(tclWinDebugPanic);
    }

#ifdef UNICODE
    GetModuleFileNameW(NULL, wName, MAX_PATH);
#else
    GetModuleFileNameA(NULL, name, sizeof(name));

    /*
     * Convert to WCHAR to get out of ANSI codepage
     */

    MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
#endif
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
    TclWinNoBackslash(name);
    TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
}

/*
 *----------------------------------------------------------------------
1432
1433
1434
1435
1436
1437
1438
1439
1440


1441
1442
1443
1444
1445



1446
1447
1448

1449
1450
1451


















1452
1453
1454

1455
1456
1457
1458

1459
1460
1461














1462
1463

1464

1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478


1479
1480




1481
1482
1483
1484
1485
1486
1487
1430
1431
1432
1433
1434
1435
1436


1437
1438
1439
1440



1441
1442
1443
1444
1445
1446
1447
1448


1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468

1469
1470
1471
1472

1473
1474
1475

1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492

1493

1494
1495
1496
1497
1498

1499



1500


1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515







-
-
+
+


-
-
-
+
+
+



+

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+



-
+


-
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+
-





-

-
-
-

-
-
+
+


+
+
+
+








const char *
TclpGetUserHome(
    const char *name,		/* User name for desired home directory. */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name of user's home directory. */
{
    const char *result = NULL;
    USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr;
    char *result = NULL;
    USER_INFO_1 *uiPtr;
    Tcl_DString ds;
    int nameLen = -1;
    int badDomain = 0;
    char *domain;
    WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain;
    int rc = 0;
    const char *domain;
    WCHAR *wName, *wHomeDir, *wDomain;
    WCHAR buf[MAX_PATH];

    Tcl_DStringInit(bufferPtr);

    wDomain = NULL;
    domain = strchr(name, '@');
    if (domain != NULL) {
    domain = Tcl_UtfFindFirst(name, '@');
    if (domain == NULL) {
	const char *ptr;

	/* no domain - firstly check it's the current user */
	if ( (ptr = TclpGetUserName(&ds)) != NULL
	  && strcasecmp(name, ptr) == 0
	) {
	    /* try safest and fastest way to get current user home */
	    ptr = TclGetEnv("HOME", &ds);
	    if (ptr != NULL) {
		Tcl_JoinPath(1, &ptr, bufferPtr);
		rc = 1;
		result = Tcl_DStringValue(bufferPtr);
	    }
	}
	Tcl_DStringFree(&ds);
    } else {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
	badDomain = NetGetDCName(NULL, wName, (LPBYTE *) wDomainPtr);
	rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain);
	Tcl_DStringFree(&ds);
	nameLen = domain - name;
    }
    if (badDomain == 0) {
    if (rc == 0) {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
	if (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) uiPtrPtr) == 0) {
	while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
	    /*
	     * user does not exists - if domain was not specified,
	     * try again using current domain.
	     */
	    rc = 1;
	    if (domain != NULL) break;
	    /* get current domain */
	    rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain);
	    if (rc != 0) break;
	    domain = INT2PTR(-1); /* repeat once */
	}
	if (rc == 0) {
	    DWORD i, size = MAX_PATH;
	    wHomeDir = uiPtr->usri1_home_dir;
	    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
		size = lstrlenW(wHomeDir);
		Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
		Tcl_UniCharToUtfDString(wHomeDir, size, bufferPtr);
			bufferPtr);
	    } else {
		/*
		 * User exists but has no home dir. Return
		 * "{GetProfilesDirectory}/<user>".
		 */
		DWORD i, size = MAX_PATH;
		GetProfilesDirectoryW(buf, &size);
		for (i = 0; i < size; ++i){
		    if (buf[i] == '\\') buf[i] = '/';
		}
		Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
		Tcl_DStringAppend(bufferPtr, "/", -1);
		Tcl_DStringAppend(bufferPtr, name, -1);
		Tcl_DStringAppend(bufferPtr, "/", 1);
		Tcl_DStringAppend(bufferPtr, name, nameLen);
	    }
	    result = Tcl_DStringValue(bufferPtr);
	    /* be sure we returns normalized path */
	    for (i = 0; i < size; ++i){
		if (result[i] == '\\') result[i] = '/';
	    }
	    NetApiBufferFree((void *) uiPtr);
	}
	Tcl_DStringFree(&ds);
    }
    if (wDomain != NULL) {
	NetApiBufferFree((void *) wDomain);
    }
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566




1567
1568

1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579




1580











1581
1582


1583
1584
1585






1586
1587
1588
1589
1590








1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1585
1586
1587
1588
1589
1590
1591



1592
1593
1594
1595
1596

1597
1598
1599
1600
1601
1602
1603
1604




1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620


1621
1622



1623
1624
1625
1626
1627
1628





1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645

1646
1647
1648
1649
1650
1651
1652







-
-
-
+
+
+
+

-
+







-
-
-
-
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+









-







	/*
	 * File exists, nothing else to check.
	 */

	return 0;
    }

    if ((mode & W_OK)
	&& (attr & FILE_ATTRIBUTE_READONLY)
	&& !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
    /*
     * If it's not a directory (assume file), do several fast checks:
     */
    if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
	/*
	 * The attributes say the file is not writable.	 If the file is a
	 * If the attributes say this is not writable at all.  The file is a
	 * regular file (i.e., not a directory), then the file is not
	 * writable, full stop.	 For directories, the read-only bit is
	 * (mostly) ignored by Windows, so we can't ascertain anything about
	 * directory access from the attrib data.  However, if we have the
	 * advanced 'getFileSecurityProc', then more robust ACL checks
	 * will be done below.
	 */

	Tcl_SetErrno(EACCES);
	return -1;
    }
	if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
	    Tcl_SetErrno(EACCES);
	    return -1;
	}

	/* If doesn't have the correct extension, it can't be executable */
	if ((mode & X_OK) && !NativeIsExec(nativePath)) {
	    Tcl_SetErrno(EACCES);
	    return -1;
	}
	/* Special case for read/write/executable check on file */
	if ((mode & (R_OK|W_OK|X_OK)) && !(mode & ~(R_OK|W_OK|X_OK))) {
	    DWORD mask = 0;
	    HANDLE hFile;
	    if (mode & R_OK) { mask |= GENERIC_READ;  }
	    if (mode & W_OK) { mask |= GENERIC_WRITE; }
    if (mode & X_OK) {
	if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) {
	    if (mode & X_OK) { mask |= GENERIC_EXECUTE; }

	    /*
	     * It's not a directory and doesn't have the correct extension.
	     * Therefore it can't be executable
	    hFile = CreateFile(nativePath, mask,
		FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL,
		OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL);
	    if (hFile != INVALID_HANDLE_VALUE) {
		CloseHandle(hFile);
		return 0;
	     */

	    Tcl_SetErrno(EACCES);
	    return -1;
	}
	    }
	    /* fast exit if access was denied */
	    if (GetLastError() == ERROR_ACCESS_DENIED) {
		Tcl_SetErrno(EACCES);
		return -1;
	    }
	}
	/* We cannnot verify the access fast, check it below using security info. */
    }

    /*
     * It looks as if the permissions are ok, but if we are on NT, 2000 or XP,
     * we have a more complex permissions structure so we try to check that.
     * The code below is remarkably complex for such a simple thing as finding
     * what permissions the OS has set for a file.
     */

#ifdef UNICODE
    {
	SECURITY_DESCRIPTOR *sdPtr = NULL;
	unsigned long size;
	PSID pSid = 0;
	BOOL SidDefaulted;
	SID_IDENTIFIER_AUTHORITY samba_unmapped = {{0, 0, 0, 0, 0, 22}};
	GENERIC_MAPPING genMap;
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1801
1802
1803
1804
1805
1806
1807

1808
1809
1810
1811
1812
1813
1814







-







	CloseHandle(hToken);
	if (!accessYesNo) {
	    Tcl_SetErrno(EACCES);
	    return -1;
	}

    }
#endif /* !UNICODE */
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * NativeIsExec --
1788
1789
1790
1791
1792
1793
1794

1795
1796
1797
1798





1799
1800
1801
1802
1803
1804
1805
1832
1833
1834
1835
1836
1837
1838
1839




1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851







+
-
-
-
-
+
+
+
+
+







	return 0;
    }

    if (path[len-4] != '.') {
	return 0;
    }

    path += len-3;
    if ((_tcsicmp(path+len-3, TEXT("exe")) == 0)
	    || (_tcsicmp(path+len-3, TEXT("com")) == 0)
	    || (_tcsicmp(path+len-3, TEXT("cmd")) == 0)
	    || (_tcsicmp(path+len-3, TEXT("bat")) == 0)) {
    if ((_tcsicmp(path, TEXT("exe")) == 0)
	    || (_tcsicmp(path, TEXT("com")) == 0)
	    || (_tcsicmp(path, TEXT("cmd")) == 0)
	    || (_tcsicmp(path, TEXT("cmd")) == 0)
	    || (_tcsicmp(path, TEXT("bat")) == 0)) {
	return 1;
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
1968
1969
1970
1971
1972
1973
1974
1975


1976
1977
1978
1979
1980
1981
1982
2014
2015
2016
2017
2018
2019
2020

2021
2022
2023
2024
2025
2026
2027
2028
2029







-
+
+







     * in wish by default). However the subsequent GetFileInformationByHandle
     * will fail. We do a WinIsReserved to see if it is one of the special
     * names, and if successful, mock up a BY_HANDLE_FILE_INFORMATION
     * structure.
     */

    fileHandle = CreateFile(nativePath, GENERIC_READ,
	    FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING,
	    FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
	    NULL, OPEN_EXISTING,
	    FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);

    if (fileHandle != INVALID_HANDLE_VALUE) {
	BY_HANDLE_FILE_INFORMATION data;

	if (GetFileInformationByHandle(fileHandle,&data) != TRUE) {
            fileType = GetFileType(fileHandle);

Changes to win/tclWinInit.c.

80
81
82
83
84
85
86
87

88
89
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
80
81
82
83
84
85
86

87
88
89
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







-
+



-
-
-
-
-



















-







/*
 * Windows version dependend functions
 */
TclWinProcs tclWinProcs;

/*
 * The following arrays contain the human readable strings for the Windows
 * platform and processor values.
 * processor values.
 */


#define NUMPLATFORMS 4
static const char *const platforms[NUMPLATFORMS] = {
    "Win32s", "Windows 95", "Windows NT", "Windows CE"
};

#define NUMPROCESSORS 11
static const char *const processors[NUMPROCESSORS] = {
    "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "amd64", "ia32_on_win64"
};

/*
 * The default directory in which the init.tcl file is expected to be found.
 */

static TclInitProcessGlobalValueProc	InitializeDefaultLibraryDir;
static ProcessGlobalValue defaultLibraryDir =
	{0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL};

static TclInitProcessGlobalValueProc	InitializeSourceLibraryDir;
static ProcessGlobalValue sourceLibraryDir =
	{0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL};

static void		AppendEnvironment(Tcl_Obj *listPtr, const char *lib);
static int		ToUtf(const WCHAR *wSrc, char *dst);

/*
 *---------------------------------------------------------------------------
 *
 * TclpInitPlatform --
 *
 *	Initialize all the platform-dependant things like signals,
183
184
185
186
187
188
189
190

191
192
193
194
195
196
197
177
178
179
180
181
182
183

184
185
186
187
188
189
190
191







-
+







 *
 *-------------------------------------------------------------------------
 */

void
TclpInitLibraryPath(
    char **valuePtr,
    size_t *lengthPtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    64
    Tcl_Obj *pathPtr;
    char installLib[LIBRARY_SIZE];
    const char *bytes;

258
259
260
261
262
263
264
265

266
267
268
269
270
271
272
252
253
254
255
256
257
258

259
260
261
262
263
264
265
266







-
+







static void
AppendEnvironment(
    Tcl_Obj *pathPtr,
    const char *lib)
{
    int pathc;
    WCHAR wBuf[MAX_PATH];
    char buf[MAX_PATH * TCL_UTF_MAX];
    char buf[MAX_PATH * 3];
    Tcl_Obj *objPtr;
    Tcl_DString ds;
    const char **pathv;
    char *shortlib;

    /*
     * The shortlib value needs to be the tail component of the lib path. For
287
288
289
290
291
292
293
294

295
296

297
298
299
300
301
302
303
304
305
306
281
282
283
284
285
286
287

288


289



290
291
292
293
294
295
296







-
+
-
-
+
-
-
-







    }

    /*
     * The "L" preceeding the TCL_LIBRARY string is used to tell VC++ that
     * this is a unicode string.
     */

    if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
    GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH);
	buf[0] = '\0';
	GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wBuf, -1, buf, MAX_PATH * 3, NULL, NULL);
    } else {
	ToUtf(wBuf, buf);
    }

    if (buf[0] != '\0') {
	objPtr = Tcl_NewStringObj(buf, -1);
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);

	TclWinNoBackslash(buf);
	Tcl_SplitPath(buf, &pathc, &pathv);
346
347
348
349
350
351
352
353

354
355
356
357
358

359
360
361
362


363
364
365
366
367
368
369
370
371
372
336
337
338
339
340
341
342

343
344
345
346
347

348
349
350


351
352



353
354
355
356
357
358
359







-
+




-
+


-
-
+
+
-
-
-







 *
 *---------------------------------------------------------------------------
 */

static void
InitializeDefaultLibraryDir(
    char **valuePtr,
    size_t *lengthPtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    HMODULE hModule = TclWinGetTclInstance();
    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
    char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
    char name[(MAX_PATH + LIBRARY_SIZE) * 3];
    char *end, *p;

    if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
	GetModuleFileNameA(hModule, name, MAX_PATH);
    GetModuleFileNameW(hModule, wName, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);
    } else {
	ToUtf(wName, name);
    }

    end = strrchr(name, '\\');
    *end = '\0';
    p = strrchr(name, '\\');
    if (p != NULL) {
	end = p;
    }
397
398
399
400
401
402
403
404

405
406
407
408
409

410
411
412
413


414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
384
385
386
387
388
389
390

391
392
393
394
395

396
397
398


399
400



401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
































417
418
419
420
421
422
423







-
+




-
+


-
-
+
+
-
-
-
















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *
 *---------------------------------------------------------------------------
 */

static void
InitializeSourceLibraryDir(
    char **valuePtr,
    size_t *lengthPtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    HMODULE hModule = TclWinGetTclInstance();
    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
    char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
    char name[(MAX_PATH + LIBRARY_SIZE) * 3];
    char *end, *p;

    if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
	GetModuleFileNameA(hModule, name, MAX_PATH);
    GetModuleFileNameW(hModule, wName, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);
    } else {
	ToUtf(wName, name);
    }

    end = strrchr(name, '\\');
    *end = '\0';
    p = strrchr(name, '\\');
    if (p != NULL) {
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "../library");
    *lengthPtr = strlen(name);
    *valuePtr = ckalloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
 * ToUtf --
 *
 *	Convert a char string to a UTF string.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
ToUtf(
    const WCHAR *wSrc,
    char *dst)
{
    char *start;

    start = dst;
    while (*wSrc != '\0') {
	dst += Tcl_UniCharToUtf(*wSrc, dst);
	wSrc++;
    }
    *dst = '\0';
    return (int) (dst - start);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetInitialEncodings --
 *
 *	Based on the locale, determine the encoding of the operating system
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516





















517
518
519
520
521
522
523
440
441
442
443
444
445
446

447
448
449
450
451






452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489







-





-
-
-
-
-
-










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 */

void
TclpSetInitialEncodings(void)
{
    Tcl_DString encodingName;

    TclpSetInterfaces();
    Tcl_SetSystemEncoding(NULL,
	    Tcl_GetEncodingNameFromEnvironment(&encodingName));
    Tcl_DStringFree(&encodingName);
}

void TclWinSetInterfaces(
    int dummy)			/* Not used. */
{
    TclpSetInterfaces();
}

const char *
Tcl_GetEncodingNameFromEnvironment(
    Tcl_DString *bufPtr)
{
    Tcl_DStringInit(bufPtr);
    Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
    wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
    Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
    return Tcl_DStringValue(bufPtr);
}

const char *
TclpGetUserName(
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * the name of user. */
{
    Tcl_DStringInit(bufferPtr);

    if (TclGetEnv("USERNAME", bufferPtr) == NULL) {
	TCHAR szUserName[UNLEN+1];
	DWORD cchUserNameLen = UNLEN;

	if (!GetUserName(szUserName, &cchUserNameLen)) {
	    return NULL;
	}
	cchUserNameLen--;
	cchUserNameLen *= sizeof(TCHAR);
	Tcl_WinTCharToUtf(szUserName, cchUserNameLen, bufferPtr);
    }
    return Tcl_DStringValue(bufferPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetVariables --
 *
 *	Performs platform-specific interpreter initialization related to the
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
507
508
509
510
511
512
513


514
515
516
517
518
519
520







-
-







    union {
	SYSTEM_INFO info;
	OemId oemId;
    } sys;
    static OSVERSIONINFOW osInfo;
    static int osInfoInitialized = 0;
    Tcl_DString ds;
    TCHAR szUserName[UNLEN+1];
    DWORD cchUserNameLen = UNLEN;

    Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
	    TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);

    if (!osInfoInitialized) {
	HMODULE handle = GetModuleHandle(TEXT("NTDLL"));
	int(__stdcall *getversion)(void *) =
565
566
567
568
569
570
571
572
573

574
575
576
577
578
579
580
581
582
529
530
531
532
533
534
535


536


537
538
539
540
541
542
543







-
-
+
-
-








    /*
     * Define the tcl_platform array.
     */

    Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
	    TCL_GLOBAL_ONLY);
    if (osInfo.dwPlatformId < NUMPLATFORMS) {
	Tcl_SetVar2(interp, "tcl_platform", "os",
    Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY);
		platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
    }
    wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
    if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) {
	Tcl_SetVar2(interp, "tcl_platform", "machine",
		processors[sys.oemId.wProcessorArchitecture],
		TCL_GLOBAL_ONLY);
    }
620
621
622
623
624
625
626
627
628
629

630
631
632
633
634
635

636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652

653
654
655
656
657
658
659
581
582
583
584
585
586
587



588






589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605

606
607
608
609
610
611
612
613







-
-
-
+
-
-
-
-
-
-
+
















-
+








    /*
     * Initialize the user name from the environment first, since this is much
     * faster than asking the system.
     * Note: cchUserNameLen is number of characters including nul terminator.
     */

    Tcl_DStringInit(&ds);
    if (TclGetEnv("USERNAME", &ds) == NULL) {
	if (GetUserName(szUserName, &cchUserNameLen) != 0) {
    ptr = TclpGetUserName(&ds);
	    int cbUserNameLen = cchUserNameLen - 1;
	    cbUserNameLen *= sizeof(TCHAR);
	    Tcl_WinTCharToUtf(szUserName, cbUserNameLen, &ds);
	}
    }
    Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
    Tcl_SetVar2(interp, "tcl_platform", "user", ptr ? ptr : "",
	    TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&ds);

    /*
     * Define what the platform PATH separator is. [TIP #315]
     */

    Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensitive, on Windows this matches mioxed case.
 *	case sensitive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or -1 if there is no such entry. The integer at *lengthPtr is
 *	filled in with the length of name (if a matching entry is found) or
 *	the length of the environ array (if no matching entry is found).
 *

Changes to win/tclWinInt.h.

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
36
37
38
39
40
41
42



















43
44
45
46
47
48
49







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 */
typedef struct TclWinProcs {
    BOOL (WINAPI *cancelSynchronousIo)(HANDLE);
} TclWinProcs;

MODULE_SCOPE TclWinProcs tclWinProcs;

/*
 * Some versions of Borland C have a define for the OSVERSIONINFO for
 * Win32s and for NT, but not for Windows 95.
 * Define VER_PLATFORM_WIN32_CE for those without newer headers.
 */

#ifndef VER_PLATFORM_WIN32_WINDOWS
#define VER_PLATFORM_WIN32_WINDOWS 1
#endif
#ifndef VER_PLATFORM_WIN32_CE
#define VER_PLATFORM_WIN32_CE 3
#endif

#ifdef _WIN64
#         define TCL_I_MODIFIER        "I"
#else
#         define TCL_I_MODIFIER        ""
#endif

/*
 * Declarations of functions that are not accessible by way of the
 * stubs table.
 */

MODULE_SCOPE char	TclWinDriveLetterForVolMountPoint(
			    const TCHAR *mountPoint);
78
79
80
81
82
83
84
85
86


87
88
89
90
91
92
93
94
95
96
97
98
59
60
61
62
63
64
65


66
67





68
69
70
71
72
73
74







-
-
+
+
-
-
-
-
-







MODULE_SCOPE HANDLE	TclWinSerialOpen(HANDLE handle, const TCHAR *name,
			    DWORD access);
MODULE_SCOPE int	TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal,
			    const TCHAR *LinkCopy);
MODULE_SCOPE int	TclWinSymLinkDelete(const TCHAR *LinkOriginal,
			    int linkOnly);
MODULE_SCOPE int        TclWinFileOwned(Tcl_Obj *);
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
MODULE_SCOPE void	TclWinFreeAllocCache(void);

MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr);
MODULE_SCOPE void	TclFreeAllocCache(void *);
MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
MODULE_SCOPE void *	TclpGetAllocCache(void);
MODULE_SCOPE void	TclpSetAllocCache(void *);
#endif /* TCL_THREADS */

/* Needed by tclWinFile.c and tclWinFCmd.c */
#ifndef FILE_ATTRIBUTE_REPARSE_POINT
#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
#endif

/*

Changes to win/tclWinNotify.c.

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
32
33
34
35
36
37
38

39
40
41
42
43
44
45







-







    DWORD thread;		/* Identifier for thread associated with this
				 * notifier. */
    HANDLE event;		/* Event object used to wake up the notifier
				 * thread. */
    int pending;		/* Alert message pending, this field is locked
				 * by the notifierMutex. */
    HWND hwnd;			/* Messaging window. */
    int timeout;		/* Current timeout value. */
    int timerActive;		/* 1 if interval timer is running. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following static indicates the number of threads that have initialized
305
306
307
308
309
310
311
312
313
314
315
316

317
318
319
320
321
322
323
304
305
306
307
308
309
310

311
312
313

314
315
316
317
318
319
320
321







-



-
+







	     */

	    timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
	    if (timeout == 0) {
		timeout = 1;
	    }
	}
	tsdPtr->timeout = timeout;
	if (timeout != 0) {
	    tsdPtr->timerActive = 1;
	    SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
		    (unsigned long) tsdPtr->timeout, NULL);
		    timeout, NULL);
	} else {
	    tsdPtr->timerActive = 0;
	    KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
	}
    }
}


Added win/tclWinPanic.c.

























































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * tclWinPanic.c --
 *
 *	Contains the Windows-specific command-line panic proc.
 *
 * Copyright (c) 2013 by Jan Nijtmans.
 * All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConsolePanic --
 *
 *	Display a message. If a debugger is present, present it directly to
 *	the debugger, otherwise send it to stderr.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ConsolePanic(
    const char *format, ...)
{
#define TCL_MAX_WARN_LEN 26000
    va_list argList;
    WCHAR msgString[TCL_MAX_WARN_LEN];
    char buf[TCL_MAX_WARN_LEN * 3];
    HANDLE handle = GetStdHandle(STD_ERROR_HANDLE);
    DWORD dummy;

    va_start(argList, format);
    vsnprintf(buf+3, sizeof(buf)-3, format, argList);
    buf[sizeof(buf)-1] = 0;
    msgString[TCL_MAX_WARN_LEN-1] = L'\0';
    MultiByteToWideChar(CP_UTF8, 0, buf+3, -1, msgString, TCL_MAX_WARN_LEN);

    /*
     * Truncate MessageBox string if it is too long to not overflow the buffer.
     */

    if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
	memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
    }

    if (IsDebuggerPresent()) {
	OutputDebugStringW(msgString);
    } else if (_isatty(2)) {
	WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0);
    } else {
	buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */
	WriteFile(handle, buf, strlen(buf), &dummy, 0);
	WriteFile(handle, "\n", 1, &dummy, 0);
	FlushFileBuffers(handle);
    }
#   if defined(__GNUC__)
	__builtin_trap();
#   elif defined(_WIN64)
	__debugbreak();
#   elif defined(_MSC_VER)
	_asm {int 3}
#   else
	DebugBreak();
#   endif
#if defined(_WIN32)
	ExitProcess(1);
#else
	abort();
#endif
}
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Changes to win/tclWinPipe.c.

865
866
867
868
869
870
871
872

873
874
875
876
877
878
879
865
866
867
868
869
870
871

872
873
874
875
876
877
878
879







-
+







{
    ProcInfo *infoPtr;

    PipeInit();

    Tcl_MutexLock(&pipeMutex);
    for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
	if (infoPtr->hProcess == (HANDLE) pid) {
	if (infoPtr->dwProcessId == (DWORD) (size_t) pid) {
	    Tcl_MutexUnlock(&pipeMutex);
	    return infoPtr->dwProcessId;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);
    return (unsigned long) -1;
}
937
938
939
940
941
942
943
944

945
946
947
948
949
950
951
937
938
939
940
941
942
943

944
945
946
947
948
949
950
951







-
+







{
    int result, applType, createFlags;
    Tcl_DString cmdLine;	/* Complete command line (TCHAR). */
    STARTUPINFO startInfo;
    PROCESS_INFORMATION procInfo;
    SECURITY_ATTRIBUTES secAtts;
    HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
    char execPath[MAX_PATH * TCL_UTF_MAX];
    char execPath[MAX_PATH * 3];
    WinFile *filePtr;

    PipeInit();

    applType = ApplicationType(interp, argv[0], execPath);
    if (applType == APPL_NONE) {
	return TCL_ERROR;
1091
1092
1093
1094
1095
1096
1097
1098
1099

1100
1101
1102
1103
1104
1105
1106
1107
1108








1109
1110
1111
1112
1113
1114
1115






1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1091
1092
1093
1094
1095
1096
1097


1098
1099








1100
1101
1102
1103
1104
1105
1106
1107
1108






1109
1110
1111
1112
1113
1114
















1115
1116
1117
1118
1119
1120
1121







-
-
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







     * provided by this application, and run in the background.
     *
     * If we are starting a GUI process, they don't automatically get a
     * console, so it doesn't matter if they are started as foreground or
     * detached processes. The GUI window will still pop up to the foreground.
     */

    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
	if (HasConsole()) {
    if (HasConsole()) {
	    createFlags = 0;
	} else if (applType == APPL_DOS) {
	    /*
	     * Under NT, 16-bit DOS applications will not run unless they can
	     * be attached to a console. If we are running without a console,
	     * run the 16-bit program as an normal process inside of a hidden
	     * console application, and then run that hidden console as a
	     * detached process.
	     */
    } else if (applType == APPL_DOS) {
	/*
	 * Under NT, 16-bit DOS applications will not run unless they can
	 * be attached to a console. If we are running without a console,
	 * run the 16-bit program as an normal process inside of a hidden
	 * console application, and then run that hidden console as a
	 * detached process.
	 */

	    startInfo.wShowWindow = SW_HIDE;
	    startInfo.dwFlags |= STARTF_USESHOWWINDOW;
	    createFlags = CREATE_NEW_CONSOLE;
	    TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
	} else {
	    createFlags = DETACHED_PROCESS;
	startInfo.wShowWindow = SW_HIDE;
	startInfo.dwFlags |= STARTF_USESHOWWINDOW;
	createFlags = CREATE_NEW_CONSOLE;
	TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
    } else {
	createFlags = DETACHED_PROCESS;
	}
    } else {
	if (HasConsole()) {
	    createFlags = 0;
	} else {
	    createFlags = DETACHED_PROCESS;
	}

	if (applType == APPL_DOS) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "DOS application process not supported on this platform",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP",
		    NULL);
	    goto end;
	}
    }

    /*
     * cmdLine gets the full command line used to invoke the executable,
     * including the name of the executable itself. The command line arguments
     * in argv[] are stored in cmdLine separated by spaces. Special characters
     * in individual arguments from argv[] must be quoted when being stored in
1176
1177
1178
1179
1180
1181
1182
1183

1184
1185
1186
1187
1188
1189
1190
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168
1169
1170
1171
1172
1173







-
+







     * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID
     * Number: Q124121
     */

    WaitForInputIdle(procInfo.hProcess, 5000);
    CloseHandle(procInfo.hThread);

    *pidPtr = (Tcl_Pid) procInfo.hProcess;
    *pidPtr = (Tcl_Pid) (size_t) procInfo.dwProcessId;
    if (*pidPtr != 0) {
	TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
    }
    result = TCL_OK;

  end:
    Tcl_DStringFree(&cmdLine);
1285
1286
1287
1288
1289
1290
1291
1292

1293
1294
1295
1296
1297
1298
1299
1268
1269
1270
1271
1272
1273
1274

1275
1276
1277
1278
1279
1280
1281
1282







-
+







    Tcl_DString nameBuf, ds;
    const TCHAR *nativeName;
    TCHAR nativeFullPath[MAX_PATH];
    static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"};

    /*
     * Look for the program as an external program. First try the name as it
     * is, then try adding .com, .exe, and .bat, in that order, to the name,
     * is, then try adding .com, .exe, .bat and .cmd, in that order, to the name,
     * looking for an executable.
     *
     * Using the raw SearchPath() function doesn't do quite what is necessary.
     * If the name of the executable already contains a '.' character, it will
     * not try appending the specified extension when searching (in other
     * words, SearchPath will not find the program "a.b.exe" if the arguments
     * specified "a.b" and ".exe"). So, first look for the file as it is
1404
1405
1406
1407
1408
1409
1410
1411

1412
1413
1414
1415
1416
1417
1418
1387
1388
1389
1390
1391
1392
1393

1394
1395
1396
1397
1398
1399
1400
1401







-
+







    if (applType == APPL_NONE) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
		originalName, Tcl_PosixError(interp)));
	return APPL_NONE;
    }

    if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) {
    if (applType == APPL_WIN3X) {
	/*
	 * Replace long path name of executable with short path name for
	 * 16-bit applications. Otherwise the application may not be able to
	 * correctly parse its own command line to separate off the
	 * application name from the arguments.
	 */

1437
1438
1439
1440
1441
1442
1443
1444















1445

































































1446
1447
1448
1449
1450
1451
1452
1453
1454
1455


1456












1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477


1478
1479

1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492





































1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506

1507
1508
1509
1510





1511
1512
1513


1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531







































1532
1533
1534
1535
1536
1537
1538
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516


1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551

1552
1553
1554

1555
1556
1557











1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596












1597




1598
1599
1600
1601
1602



1603
1604


















1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
+
+

+
+
+
+
+
+
+
+
+
+
+
+




















-
+
+

-
+


-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static const char *
BuildCmdLineBypassBS(
    const char *current,
    const char **bspos
) {
    /* mark first backslash possition */
    if (!*bspos) {
	*bspos = current;
    }
    do {
	current++;
    } while (*current == '\\');
    return current;
}

static void
QuoteCmdLineBackslash(
    Tcl_DString *dsPtr,
    const char *start,
    const char *current,
    const char *bspos
) {
    if (!bspos) {
	if (current > start) { /* part before current (special) */
	    Tcl_DStringAppend(dsPtr, start, (int) (current - start));
	}
    } else {
    	if (bspos > start) { /* part before first backslash */
	    Tcl_DStringAppend(dsPtr, start, (int) (bspos - start));
	}
	while (bspos++ < current) { /* each backslash twice */
	    TclDStringAppendLiteral(dsPtr, "\\\\");
	}
    }
}

static const char *
QuoteCmdLinePart(
    Tcl_DString *dsPtr,
    const char *start,
    const char *special,
    const char *specMetaChars,
    const char **bspos
) {
    if (!*bspos) {
	/* rest before special (before quote) */
	QuoteCmdLineBackslash(dsPtr, start, special, NULL);
	start = special;
    } else {
	/* rest before first backslash and backslashes into new quoted block */
	QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
	start = *bspos;
    }
    /*
     * escape all special chars enclosed in quotes like `"..."`, note that here we
     * don't must escape `\` (with `\`), because it's outside of the main quotes,
     * so `\` remains `\`, but important - not at end of part, because results as
     * before the quote,  so `%\%\` should be escaped as `"%\%"\\`).
     */
    TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */
    do {
    	*bspos = NULL;
	special++;
	if (*special == '\\') {
	    /* bypass backslashes (and mark first backslash possition)*/
	    special = BuildCmdLineBypassBS(special, bspos);
	    if (*special == '\0') break;
	}
    } while (*special && strchr(specMetaChars, *special));
    if (!*bspos) {
	/* unescaped rest before quote */
	QuoteCmdLineBackslash(dsPtr, start, special, NULL);
    } else {
	/* unescaped rest before first backslash (rather belongs to the main block) */
	QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
    }
    TclDStringAppendLiteral(dsPtr, "\""); /* closing escape quote-char */
    return special;
}

static void
BuildCommandLine(
    const char *executable,	/* Full path of executable (including
				 * extension). Replacement for argv[0]. */
    int argc,			/* Number of arguments. */
    const char **argv,		/* Argument strings in UTF. */
    Tcl_DString *linePtr)	/* Initialized Tcl_DString that receives the
				 * command line (TCHAR). */
{
    const char *arg, *start, *special;
    int quote, i;
    const char *arg, *start, *special, *bspos;
    int quote = 0, i;
    Tcl_DString ds;

    /* characters to enclose in quotes if unpaired quote flag set */
    const static char *specMetaChars = "&|^<>!()%";
    /* characters to enclose in quotes in any case (regardless unpaired-flag) */
    const static char *specMetaChars2 = "%";

    /* Quote flags:
     *   CL_ESCAPE   - escape argument;
     *   CL_QUOTE    - enclose in quotes;
     *   CL_UNPAIRED - previous arguments chain contains unpaired quote-char;
     */
    enum {CL_ESCAPE = 1, CL_QUOTE = 2, CL_UNPAIRED = 4};

    Tcl_DStringInit(&ds);

    /*
     * Prime the path. Add a space separator if we were primed with something.
     */

    TclDStringAppendDString(&ds, linePtr);
    if (Tcl_DStringLength(linePtr) > 0) {
	TclDStringAppendLiteral(&ds, " ");
    }

    for (i = 0; i < argc; i++) {
	if (i == 0) {
	    arg = executable;
	} else {
	    arg = argv[i];
	    TclDStringAppendLiteral(&ds, " ");
	}

	quote = 0;
	quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */
	bspos = NULL;
	if (arg[0] == '\0') {
	    quote = 1;
	    quote = CL_QUOTE;
	} else {
	    int count;
	    Tcl_UniChar ch = 0;

	    for (start = arg; *start != '\0'; start += count) {
		count = TclUtfToUniChar(start, &ch);
		if (Tcl_UniCharIsSpace(ch)) {	/* INTL: ISO space. */
		    quote = 1;
		    break;
		}
	    }
	}
	if (quote) {
	    Tcl_UniChar ch;
	    for (start = arg;
		*start != '\0' &&
		    (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
		start += count
	    ) {
		count = Tcl_UtfToUniChar(start, &ch);
		if (count > 1) continue;
		if (Tcl_UniCharIsSpace(ch)) {
		    quote |= CL_QUOTE; /* quote only */
		    if (bspos) { /* if backslash found - escape & quote */
			quote |= CL_ESCAPE;
			break;
		    }
		    continue;
		}
		if (strchr(specMetaChars, *start)) {
		    quote |= (CL_ESCAPE|CL_QUOTE); /*escape & quote */
		    break;
		}
		if (*start == '"') {
		    quote |= CL_ESCAPE; /* escape only */
		    continue;
		}
		if (*start == '\\') {
		    bspos = start;
		    if (quote & CL_QUOTE) { /* if quote - escape & quote */
			quote |= CL_ESCAPE;
			break;
		    }
		    continue;
		}
	    }
	    bspos = NULL;
	}
	if (quote & CL_QUOTE) {
	    /* start of argument (main opening quote-char) */
	    TclDStringAppendLiteral(&ds, "\"");
	}
	start = arg;
	for (special = arg; ; ) {
	    if ((*special == '\\') && (special[1] == '\\' ||
		    special[1] == '"' || (quote && special[1] == '\0'))) {
		Tcl_DStringAppend(&ds, start, (int) (special - start));
		start = special;
		while (1) {
		    special++;
		    if (*special == '"' || (quote && *special == '\0')) {
			/*
			 * N backslashes followed a quote -> insert N * 2 + 1
			 * backslashes then a quote.
	if (!(quote & CL_ESCAPE)) {
			 */

			Tcl_DStringAppend(&ds, start,
				(int) (special - start));
	    /* nothing to escape */
	    Tcl_DStringAppend(&ds, arg, -1);
	} else {
	    start = arg;
	    for (special = arg; *special != '\0'; ) {
			break;
		    }
		    if (*special != '\\') {
		/* position of `\` is important before quote or at end (equal `\"` because quoted) */
		if (*special == '\\') {
			break;
		    }
		}
		Tcl_DStringAppend(&ds, start, (int) (special - start));
		start = special;
	    }
	    if (*special == '"') {
		Tcl_DStringAppend(&ds, start, (int) (special - start));
		TclDStringAppendLiteral(&ds, "\\\"");
		start = special + 1;
	    }
	    if (*special == '\0') {
		break;
	    }
	    special++;
	}
	Tcl_DStringAppend(&ds, start, (int) (special - start));
	if (quote) {
		    /* bypass backslashes (and mark first backslash possition)*/
		    special = BuildCmdLineBypassBS(special, &bspos);
		    if (*special == '\0') break;
		}
		/* ["] */
		if (*special == '"') {
		    quote ^= CL_UNPAIRED; /* invert unpaired flag - observe unpaired quotes */
		    /* add part before (and escape backslashes before quote) */
		    QuoteCmdLineBackslash(&ds, start, special, bspos);
		    bspos = NULL;
		    /* escape using backslash */
		    TclDStringAppendLiteral(&ds, "\\\"");
		    start = ++special;
		    continue;
		}
		/* unpaired (escaped) quote causes special handling on meta-chars */
		if ((quote & CL_UNPAIRED) && strchr(specMetaChars, *special)) {
		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos);
		    /* start to current or first backslash */
		    start = !bspos ? special : bspos;
		    continue;
		}
		/* special case for % - should be enclosed always (paired also) */
		if (strchr(specMetaChars2, *special)) {
		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars2, &bspos);
		    /* start to current or first backslash */
		    start = !bspos ? special : bspos;
		    continue;
		}
		/* other not special (and not meta) character */
		bspos = NULL; /* reset last backslash possition (not interesting) */
		special++;
	    }
	    /* rest of argument (and escape backslashes before closing main quote) */
	    QuoteCmdLineBackslash(&ds, start, special,
	    	(quote & CL_QUOTE) ? bspos : NULL);
	}
	if (quote & CL_QUOTE) {
	    /* end of argument (main closing quote-char) */
	    TclDStringAppendLiteral(&ds, "\"");
	}
    }
    Tcl_DStringFree(linePtr);
    Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
    Tcl_DStringFree(&ds);
}
1619
1620
1621
1622
1623
1624
1625
1626

1627
1628
1629
1630
1631
1632
1633
1731
1732
1733
1734
1735
1736
1737

1738
1739
1740
1741
1742
1743
1744
1745







-
+







    /*
     * For backward compatibility with previous versions of Tcl, we use
     * "file%d" as the base name for pipes even though it would be more
     * natural to use "pipe%d". Use the pointer to keep the channel names
     * unique, in case channels share handles (stdin/stdout).
     */

    sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
    infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
	    infoPtr, infoPtr->validMask);

    /*
     * Pipes have AUTO translation mode on Windows and ^Z eof char, which
     * means that a ^Z will be appended to them at close. This is needed for
     * Windows programs that expect a ^Z at EOF.
2360
2361
2362
2363
2364
2365
2366
2367

2368
2369
2370
2371
2372
2373
2374
2472
2473
2474
2475
2476
2477
2478

2479
2480
2481
2482
2483
2484
2485
2486







-
+







     * Find the process and cut it from the process list.
     */

    Tcl_MutexLock(&pipeMutex);
    prevPtrPtr = &procList;
    for (infoPtr = procList; infoPtr != NULL;
	    prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
	 if (infoPtr->hProcess == (HANDLE) pid) {
	 if (infoPtr->dwProcessId == (DWORD) (size_t) pid) {
	    *prevPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);

    /*

Changes to win/tclWinPort.h.

563
564
565
566
567
568
569



570
571
563
564
565
566
567
568
569
570
571
572
573
574







+
+
+


#ifndef INVALID_SET_FILE_POINTER
#define INVALID_SET_FILE_POINTER 0xFFFFFFFF
#endif /* INVALID_SET_FILE_POINTER */

#ifndef LABEL_SECURITY_INFORMATION
#   define LABEL_SECURITY_INFORMATION (0x00000010L)
#endif

#define Tcl_DirEntry void
#define TclDIR void

#endif /* _TCLWINPORT */

Changes to win/tclWinReg.c.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
18
19
20
21
22
23
24







25
26
27
28
29
30
31







-
-
-
-
-
-
-







#endif
#include "tclInt.h"
#ifdef _MSC_VER
#   pragma comment (lib, "advapi32.lib")
#endif
#include <stdlib.h>

#ifndef UNICODE
#   undef Tcl_WinTCharToUtf
#   define Tcl_WinTCharToUtf(a,b,c)	Tcl_ExternalToUtfDString(NULL,a,b,c)
#   undef Tcl_WinUtfToTChar
#   define Tcl_WinUtfToTChar(a,b,c)	Tcl_UtfToExternalDString(NULL,a,b,c)
#endif /* !UNICODE */

/*
 * Ensure that we can say which registry is being accessed.
 */

#ifndef KEY_WOW64_64KEY
#   define KEY_WOW64_64KEY	(0x0100)
#endif
126
127
128
129
130
131
132



















133
134
135
136
137
138
139
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







			    const TCHAR * pKeyName, REGSAM mode);
static int		RegistryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
			    Tcl_Obj *typeObj, REGSAM mode);

static unsigned char *
getByteArrayFromObj(
	Tcl_Obj *objPtr,
	size_t *lengthPtr
) {
    int length;

    unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
#if TCL_MAJOR_VERSION > 8
    if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
	/* 64-bit and TIP #494 situation: */
	 *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
    } else
#endif
	/* 32-bit or without TIP #494 */
    *lengthPtr = (size_t) (unsigned) length;
    return result;
}

DLLEXPORT int		Registry_Init(Tcl_Interp *interp);
DLLEXPORT int		Registry_Unload(Tcl_Interp *interp, int flags);

/*
 *----------------------------------------------------------------------
 *
159
160
161
162
163
164
165
166

167
168
169
170
171
172
173
171
172
173
174
175
176
177

178
179
180
181
182
183
184
185







-
+







    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
	return TCL_ERROR;
    }

    cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
	    interp, DeleteCmd);
    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
    return Tcl_PkgProvide(interp, "registry", "1.3.2");
    return Tcl_PkgProvide(interp, "registry", "1.3.3");
}

/*
 *----------------------------------------------------------------------
 *
 * Registry_Unload --
 *
410
411
412
413
414
415
416
417

418
419
420
421
422

423
424
425
426
427
428
429
430

431
432
433
434
435
436
437
438
439
440
441
442
443
444
445

446
447
448
449
450
451
452
422
423
424
425
426
427
428

429
430
431
432
433

434
435
436
437
438
439
440
441

442
443
444
445
446
447
448
449
450
451
452
453
454
455
456

457
458
459
460
461
462
463
464







-
+




-
+







-
+














-
+







    REGSAM saveMode = mode;

    /*
     * Find the parent of the key being deleted and open it.
     */

    keyName = Tcl_GetString(keyNameObj);
    buffer = ckalloc(keyNameObj->length + 1);
    buffer = Tcl_Alloc(keyNameObj->length + 1);
    strcpy(buffer, keyName);

    if (ParseKeyName(interp, buffer, &hostName, &rootKey,
	    &keyName) != TCL_OK) {
	ckfree(buffer);
	Tcl_Free(buffer);
	return TCL_ERROR;
    }

    if (*keyName == '\0') {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("bad key: cannot delete root keys", -1));
	Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
	ckfree(buffer);
	Tcl_Free(buffer);
	return TCL_ERROR;
    }

    tail = strrchr(keyName, '\\');
    if (tail) {
	*tail++ = '\0';
    } else {
	tail = keyName;
	keyName = NULL;
    }

    mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
    result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
    if (result != ERROR_SUCCESS) {
	ckfree(buffer);
	Tcl_Free(buffer);
	if (result == ERROR_FILE_NOT_FOUND) {
	    return TCL_OK;
	}
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to delete key: ", -1));
	AppendSystemError(interp, result);
	return TCL_ERROR;
466
467
468
469
470
471
472
473

474
475
476
477
478
479
480
478
479
480
481
482
483
484

485
486
487
488
489
490
491
492







-
+







	AppendSystemError(interp, result);
	result = TCL_ERROR;
    } else {
	result = TCL_OK;
    }

    RegCloseKey(subkey);
    ckfree(buffer);
    Tcl_Free(buffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteValue --
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517

518
519
520
521
522
523
524
507
508
509
510
511
512
513

514
515
516
517
518
519
520
521
522
523
524
525
526


527
528
529
530
531
532
533
534







-













-
-
+







    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj,	/* Name of key. */
    Tcl_Obj *valueNameObj,	/* Name of value to delete. */
    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    char *valueName;
    size_t length;
    DWORD result;
    Tcl_DString ds;

    /*
     * Attempt to open the key for deletion.
     */

    mode |= KEY_SET_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    valueName = Tcl_GetString(valueNameObj);
    length = valueNameObj->length;
    Tcl_WinUtfToTChar(valueName, length, &ds);
    Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds);
    result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
    Tcl_DStringFree(&ds);
    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unable to delete value \"%s\" from key \"%s\": ",
		Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
	AppendSystemError(interp, result);
599
600
601
602
603
604
605
606

607
608
609
610
611
612
613
614
609
610
611
612
613
614
615

616

617
618
619
620
621
622
623







-
+
-







			"unable to enumerate subkeys of \"%s\": ",
			Tcl_GetString(keyNameObj)));
		AppendSystemError(interp, result);
		result = TCL_ERROR;
	    }
	    break;
	}
	Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
	name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
	name = Tcl_DStringValue(&ds);
	if (pattern && !Tcl_StringMatch(name, pattern)) {
	    Tcl_DStringFree(&ds);
	    continue;
	}
	result = Tcl_ListObjAppendElement(interp, resultPtr,
		Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
	Tcl_DStringFree(&ds);
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675

676
677
678
679
680
681
682
660
661
662
663
664
665
666

667
668
669
670
671
672
673
674
675
676
677
678
679
680
681


682
683
684
685
686
687
688
689







-















-
-
+







    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    DWORD result, type;
    Tcl_DString ds;
    const char *valueName;
    const TCHAR *nativeValue;
    size_t length;

    /*
     * Attempt to open the key for reading.
     */

    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Get the type of the value.
     */

    valueName = Tcl_GetString(valueNameObj);
    length = valueNameObj->length;
    nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
    nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds);
    result = RegQueryValueEx(key, nativeValue, NULL, &type,
	    NULL, NULL);
    Tcl_DStringFree(&ds);
    RegCloseKey(key);

    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
731
732
733
734
735
736
737

738
739
740
741
742
743
744







-







    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    const char *valueName;
    const TCHAR *nativeValue;
    DWORD result, length, type;
    Tcl_DString data, buf;
    size_t nameLen;

    /*
     * Attempt to open the key for reading.
     */

    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
750
751
752
753
754
755
756
757
758

759
760
761
762
763
764
765
756
757
758
759
760
761
762


763
764
765
766
767
768
769
770







-
-
+







     */

    Tcl_DStringInit(&data);
    Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
    length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;

    valueName = Tcl_GetString(valueNameObj);
    nameLen = valueNameObj->length;
    nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
    nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &buf);

    result = RegQueryValueEx(key, nativeValue, NULL, &type,
	    (BYTE *) Tcl_DStringValue(&data), &length);
    while (result == ERROR_MORE_DATA) {
	/*
	 * The Windows docs say that in this error case, we just need to
	 * expand our buffer and request more data. Required for
940
941
942
943
944
945
946
947
948
949
950
951
952

953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969

970
971
972
973
974
975
976
945
946
947
948
949
950
951

952
953
954
955

956

957
958
959
960
961
962
963
964
965
966
967
968
969
970
971

972
973
974
975
976
977
978
979







-




-
+
-















-
+







    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj,	/* Key to open. */
    REGSAM mode,		/* Access mode. */
    int flags,			/* 0 or REG_CREATE. */
    HKEY *keyPtr)		/* Returned HKEY. */
{
    char *keyName, *buffer, *hostName;
    size_t length;
    HKEY rootKey;
    DWORD result;

    keyName = Tcl_GetString(keyNameObj);
    length = keyNameObj->length;
    buffer = Tcl_Alloc(keyNameObj->length + 1);
    buffer = ckalloc(length + 1);
    strcpy(buffer, keyName);

    result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
    if (result == TCL_OK) {
	result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
	if (result != ERROR_SUCCESS) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unable to open key: ", -1));
	    AppendSystemError(interp, result);
	    result = TCL_ERROR;
	} else {
	    result = TCL_OK;
	}
    }

    ckfree(buffer);
    Tcl_Free(buffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * OpenSubKey --
1015
1016
1017
1018
1019
1020
1021

1022


1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039

1040


1041
1042
1043
1044
1045
1046
1047
1018
1019
1020
1021
1022
1023
1024
1025

1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045

1046
1047
1048
1049
1050
1051
1052
1053
1054







+
-
+
+

















+
-
+
+







    }

    /*
     * Now open the specified key with the requested permissions. Note that
     * this key must be closed by the caller.
     */

    if (keyName) {
    keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
	keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
    }
    if (flags & REG_CREATE) {
	DWORD create;

	result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL,
		REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
    } else if (rootKey == HKEY_PERFORMANCE_DATA) {
	/*
	 * Here we fudge it for this special root key. See MSDN for more info
	 * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it.
	 */

	*keyPtr = HKEY_PERFORMANCE_DATA;
	result = ERROR_SUCCESS;
    } else {
	result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
		keyPtr);
    }
    if (keyName) {
    Tcl_DStringFree(&buf);
	Tcl_DStringFree(&buf);
    }

    /*
     * Be sure to close the root key since we are done with it now.
     */

    if (hostName) {
	RegCloseKey(rootKey);
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273

1274
1275
1276
1277
1278
1279
1280
1251
1252
1253
1254
1255
1256
1257

1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277


1278
1279
1280
1281
1282
1283
1284
1285







-




















-
-
+







    Tcl_Obj *keyNameObj,	/* Name of key. */
    Tcl_Obj *valueNameObj,	/* Name of value to set. */
    Tcl_Obj *dataObj,		/* Data to be written. */
    Tcl_Obj *typeObj,		/* Type of data to be written. */
    REGSAM mode)		/* Mode flags to pass. */
{
    int type;
    size_t length;
    DWORD result;
    HKEY key;
    const char *valueName;
    Tcl_DString nameBuf;

    if (typeObj == NULL) {
	type = REG_SZ;
    } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
	    0, (int *) &type) != TCL_OK) {
	if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    mode |= KEY_ALL_ACCESS;
    if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    valueName = Tcl_GetString(valueNameObj);
    length = valueNameObj->length;
    valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
    valueName = (char *) Tcl_WinUtfToTChar(valueName, valueNameObj->length, &nameBuf);

    if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
	int value;

	if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) {
	    RegCloseKey(key);
	    Tcl_DStringFree(&nameBuf);
1301
1302
1303
1304
1305
1306
1307
1308
1309

1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330

1331
1332
1333
1334
1335
1336
1337
1338
1339
1340

1341
1342
1343
1344

1345
1346
1347
1348
1349
1350

1351
1352
1353
1354
1355
1356
1357
1306
1307
1308
1309
1310
1311
1312


1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332


1333
1334
1335
1336
1337
1338
1339

1340
1341

1342
1343
1344
1345

1346
1347
1348
1349
1350
1351

1352
1353
1354
1355
1356
1357
1358
1359







-
-
+



















-
-
+






-


-
+



-
+





-
+







	 * nulls, which aren't allowed in REG_MULTI_SZ values.
	 */

	Tcl_DStringInit(&data);
	for (i = 0; i < objc; i++) {
	    const char *bytes = Tcl_GetString(objv[i]);

	    length = objv[i]->length;
	    Tcl_DStringAppend(&data, bytes, length);
	    Tcl_DStringAppend(&data, bytes, objv[i]->length);

	    /*
	     * Add a null character to separate this value from the next.
	     */

	    Tcl_DStringAppend(&data, "", 1);	/* NUL-terminated string */
	}

	Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
		&buf);
	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
		(DWORD) Tcl_DStringLength(&buf));
	Tcl_DStringFree(&data);
	Tcl_DStringFree(&buf);
    } else if (type == REG_SZ || type == REG_EXPAND_SZ) {
	Tcl_DString buf;
	const char *data = Tcl_GetString(dataObj);

	length = dataObj->length;
	data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
	data = (char *) Tcl_WinUtfToTChar(data, dataObj->length, &buf);

	/*
	 * Include the null in the length, padding if needed for WCHAR.
	 */

	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
	length = Tcl_DStringLength(&buf) + 1;

	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) data, (DWORD) length);
		(DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1);
	Tcl_DStringFree(&buf);
    } else {
	BYTE *data;
	int bytelength;
	size_t bytelength;

	/*
	 * Store binary data in the registry.
	 */

	data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
	data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength);
	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
		(DWORD) type, data, (DWORD) bytelength);
    }

    Tcl_DStringFree(&nameBuf);
    RegCloseKey(key);

1404
1405
1406
1407
1408
1409
1410
1411
1412

1413
1414
1415
1416
1417
1418
1419
1406
1407
1408
1409
1410
1411
1412


1413
1414
1415
1416
1417
1418
1419
1420







-
-
+







	}
	if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    str = Tcl_GetString(objv[0]);
    len = objv[0]->length;
    wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds);
    wstr = (WCHAR *) Tcl_WinUtfToTChar(str, objv[0]->length, &ds);
    if (Tcl_DStringLength(&ds) == 0) {
	wstr = NULL;
    }

    /*
     * Use the ignore the result.
     */

Changes to win/tclWinSerial.c.

1438
1439
1440
1441
1442
1443
1444
1445

1446
1447
1448
1449
1450
1451
1452
1438
1439
1440
1441
1442
1443
1444

1445
1446
1447
1448
1449
1450
1451
1452







-
+







    infoPtr->sysBufWrite = 4096;

    /*
     * Use the pointer to keep the channel names unique, in case the handles
     * are shared between multiple channels (stdin/stdout).
     */

    sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
	    infoPtr, permissions);


    SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
    PurgeComm(handle,
1734
1735
1736
1737
1738
1739
1740
1741

1742
1743
1744
1745
1746
1747
1748
1734
1735
1736
1737
1738
1739
1740

1741
1742
1743
1744
1745
1746
1747
1748







-
+







	 * control characters to something large and custom, they'll know the
	 * hex/octal value rather than the printable form.
	 */

	dcb.XonChar = argv[0][0];
	dcb.XoffChar = argv[1][0];
	if (argv[0][0] & 0x80 || argv[1][0] & 0x80) {
	    Tcl_UniChar character;
	    Tcl_UniChar character = 0;
	    int charLen;

	    charLen = Tcl_UtfToUniChar(argv[0], &character);
	    if (argv[0][charLen]) {
		goto badXchar;
	    }
	    dcb.XonChar = (char) character;

Changes to win/tclWinSock.c.

356
357
358
359
360
361
362
363

364
365
366
367
368
369
370
356
357
358
359
360
361
362

363
364
365
366
367
368
369
370







-
+







 *
 *----------------------------------------------------------------------
 */

void
InitializeHostName(
    char **valuePtr,
    size_t *lengthPtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1];
    DWORD length = MAX_COMPUTERNAME_LENGTH + 1;
    Tcl_DString ds;

    if (GetComputerName(tbuf, &length) != 0) {
734
735
736
737
738
739
740
741
742


743
744
745
746
747
748
749
734
735
736
737
738
739
740


741
742
743
744
745
746
747
748
749







-
-
+
+







	 */

	if (errorCodePtr == NULL) {
	    return -1;
	}

	/*
	 * A non blocking socket waiting for an asyncronous connect returns
	 * directly the error EWOULDBLOCK.
	 * A non blocking socket waiting for an asynchronous connect
	 * returns directly the error EWOULDBLOCK
	 */

	if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
	    *errorCodePtr = EWOULDBLOCK;
	    return -1;
	}

1686
1687
1688
1689
1690
1691
1692
1693

1694
1695

1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707

1708
1709
1710
1711
1712
1713
1714
1715

1716
1717
1718
1719
1720
1721
1722
1686
1687
1688
1689
1690
1691
1692

1693
1694

1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706

1707
1708
1709
1710
1711
1712
1713
1714

1715
1716
1717
1718
1719
1720
1721
1722







-
+

-
+











-
+







-
+







 *
 * TcpConnect --
 *
 *	This function opens a new socket in client mode.
 *
 *	This might be called in 3 circumstances:
 *	-   By a regular socket command
 *	-   By the event handler to continue an asynchroneous connect
 *	-   By the event handler to continue an asynchronously connect
 *	-   By a blocking socket function (gets/puts) to terminate the
 *	    connect synchroneously
 *	    connect synchronously
 *
 * Results:
 *      TCL_OK, if the socket was successfully connected or an asynchronous
 *      connection is in progress. If an error occurs, TCL_ERROR is returned
 *      and an error message is left in interp.
 *
 * Side effects:
 *	Opens a socket.
 *
 * Remarks:
 *	A single host name may resolve to more than one IP address, e.g. for
 *	an IPv4/IPv6 dual stack host. For handling asyncronously connecting
 *	an IPv4/IPv6 dual stack host. For handling asynchronously connecting
 *	sockets in the background for such hosts, this function can act as a
 *	coroutine. On the first call, it sets up the control variables for the
 *	two nested loops over the local and remote addresses. Once the first
 *	connection attempt is in progress, it sets up itself as a writable
 *	event handler for that socket, and returns. When the callback occurs,
 *	control is transferred to the "reenter" label, right after the initial
 *	return and the loops resume as if they had never been interrupted.
 *	For syncronously connecting sockets, the loops work the usual way.
 *	For synchronously connecting sockets, the loops work the usual way.
 *
 *----------------------------------------------------------------------
 */

static int
TcpConnect(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
1812
1813
1814
1815
1816
1817
1818
1819

1820
1821
1822
1823
1824
1825
1826
1812
1813
1814
1815
1816
1817
1818

1819
1820
1821
1822
1823
1824
1825
1826







-
+







	    if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
		    statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		continue;
	    }

	    /*
	     * For asyncroneous connect set the socket in nonblocking mode
	     * For asynchroneous connect set the socket in nonblocking mode
	     * and activate connect notification
	     */

	    if (async_connect) {
		TcpState *statePtr2;
		int in_socket_list = 0;

1926
1927
1928
1929
1930
1931
1932
1933
1934


1935
1936
1937
1938
1939
1940
1941
1926
1927
1928
1929
1930
1931
1932


1933
1934
1935
1936
1937
1938
1939
1940
1941







-
-
+
+







                 * Free list lock.
                 */

		SetEvent(tsdPtr->socketListLock);
	    }

	    /*
	     * Clear the tsd socket list pointer if we did not wait for the
	     * FD_CONNECT asynchronously.
	     * Clear the tsd socket list pointer if we did not wait for
	     * the FD_CONNECT asynchroneously
	     */

	    tsdPtr->pendingTcpState = NULL;

	    if (Tcl_GetErrno() == 0) {
		goto out;
	    }
2010
2011
2012
2013
2014
2015
2016
2017

2018
2019
2020
2021
2022
2023
2024
2010
2011
2012
2013
2014
2015
2016

2017
2018
2019
2020
2021
2022
2023
2024







-
+







             * Free list lock.
             */

	    SetEvent(tsdPtr->socketListLock);
	}

	/*
	 * Error message on syncroneous connect
	 * Error message on synchroneous connect
	 */

	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't open socket: %s", Tcl_PosixError(interp)));
	}
	return TCL_ERROR;

Changes to win/tclWinThrd.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
9
10
11
12
13
14
15


16
17
18
19
20
21
22







-
-







 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclWinInt.h"

#include <float.h>

/* Workaround for mingw versions which don't provide this in float.h */
#ifndef _MCW_EM
#   define	_MCW_EM		0x0008001F	/* Error masks */
#   define	_MCW_RC		0x00000300	/* Rounding */
#   define	_MCW_PC		0x00030000	/* Precision */
_CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask);
#endif
39
40
41
42
43
44
45
46

47
48
49
50
51
52
53
37
38
39
40
41
42
43

44
45
46
47
48
49
50
51







-
+







static CRITICAL_SECTION initLock;

/*
 * allocLock is used by Tcl's version of malloc for synchronization. For
 * obvious reasons, cannot use any dyamically allocated storage.
 */

#ifdef TCL_THREADS
#if TCL_THREADS

static struct Tcl_Mutex_ {
    CRITICAL_SECTION crit;
} allocLock;
static Tcl_Mutex allocLockPtr = &allocLock;
static int allocOnce = 0;

74
75
76
77
78
79
80
81

82
83
84
85
86
87
88
72
73
74
75
76
77
78

79
80
81
82
83
84
85
86







-
+







 * Condition Variable implementation.
 */

/*
 * The per-thread event and queue pointers.
 */

#ifdef TCL_THREADS
#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;
239
240
241
242
243
244
245
246

247
248
249
250
251
252
253
237
238
239
240
241
242
243

244
245
246
247
248
249
250
251







-
+







    } else {
	if (flags & TCL_THREAD_JOINABLE) {
	    TclRememberJoinableThread(*idPtr);
	}

	/*
	 * The only purpose of this is to decrement the reference count so the
	 * OS resources will be reaquired when the thread closes.
	 * OS resources will be reacquired when the thread closes.
	 */

	CloseHandle(tHandle);
	LeaveCriticalSection(&joinLock);
	return TCL_OK;
    }
}
397
398
399
400
401
402
403
404

405
406
407
408
409
410
411
395
396
397
398
399
400
401

402
403
404
405
406
407
408
409







-
+







 *
 * TclpMasterLock
 *
 *	This procedure is used to grab a lock that serializes creation of
 *	mutexes, condition variables, and thread local storage keys.
 *
 *	This lock must be different than the initLock because the initLock is
 *	held during creation of syncronization objects.
 *	held during creation of synchronization objects.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Acquire the master mutex.
 *
472
473
474
475
476
477
478
479

480
481
482
483
484
485
486
470
471
472
473
474
475
476

477
478
479
480
481
482
483
484







-
+







 *
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#ifdef TCL_THREADS
#if TCL_THREADS
    if (!allocOnce) {
	InitializeCriticalSection(&allocLock.crit);
	allocOnce = 1;
    }
    return &allocLockPtr;
#else
    return NULL;
514
515
516
517
518
519
520
521

522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537

538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554

555
556
557
558
559
560
561
512
513
514
515
516
517
518

519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534

535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551

552
553
554
555
556
557
558
559







-
+















-
+
















-
+







    /*
     * Destroy the critical section that we are holding!
     */

    DeleteCriticalSection(&masterLock);
    initialized = 0;

#ifdef TCL_THREADS
#if TCL_THREADS
    if (allocOnce) {
	DeleteCriticalSection(&allocLock.crit);
	allocOnce = 0;
    }
#endif

    LeaveCriticalSection(&initLock);

    /*
     * Destroy the critical section that we were holding.
     */

    DeleteCriticalSection(&initLock);
}

#ifdef TCL_THREADS
#if TCL_THREADS

/* locally used prototype */
static void		FinalizeConditionEvent(ClientData data);

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *
 *	This procedure is invoked to lock a mutex. This is a self initializing
 *	mutex that is automatically finalized during Tcl_Finalize.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May block the current thread. The mutex is aquired when this returns.
 *	May block the current thread. The mutex is acquired when this returns.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexLock(
    Tcl_Mutex *mutexPtr)	/* The lock */
647
648
649
650
651
652
653
654

655
656
657
658
659
660
661
645
646
647
648
649
650
651

652
653
654
655
656
657
658
659







-
+







 *
 *	The mutex must be held when this procedure is called.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May block the current thread. The mutex is aquired when this returns.
 *	May block the current thread. The mutex is acquired when this returns.
 *	Will allocate memory for a HANDLE and initialize this the first time
 *	this Tcl_Condition is used.
 *
 *----------------------------------------------------------------------
 */

void

Changes to win/tclsh.rc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
1
2
3
4
5
6
7
8
9
10






11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30










-
-
-
-
-
-












-
+







//
// Version Resource Script
//

#include <winver.h>
#include <tcl.h>

//
// build-up the name suffix that defines the type of build this is.
//
#if TCL_THREADS
#define SUFFIX_THREADS	    "t"
#else
#define SUFFIX_THREADS	    ""
#endif

#if STATIC_BUILD
#define SUFFIX_STATIC	    "s"
#else
#define SUFFIX_STATIC	    ""
#endif

#if DEBUG && !UNCHECKED
#define SUFFIX_DEBUG	    "g"
#else
#define SUFFIX_DEBUG	    ""
#endif

#define SUFFIX		    SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG
#define SUFFIX		    SUFFIX_STATIC SUFFIX_DEBUG


LANGUAGE 0x9, 0x1	/* LANG_ENGLISH, SUBLANG_DEFAULT */

VS_VERSION_INFO VERSIONINFO
 FILEVERSION 	TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
 PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL