Check-in [74dd374960]
Not logged in

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

Overview
Comment:add tcl upstream changes
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 74dd3749603b84f91cd7e74f755e065394b91230
User & Date: chw 2020-01-10 20:10:39
Context
2020-01-11
12:26
update scrollutil to version 1.4 check-in: 23505fa586 user: chw tags: trunk
2020-01-10
20:10
add tcl upstream changes check-in: 74dd374960 user: chw tags: trunk
2020-01-06
19:28
add tk upstream changes check-in: 6fdd47ec26 user: chw tags: trunk
Changes

Changes to jni/tcl/doc/CrtChannel.3.

644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
If the option value is successfully modified to the new value, the function
returns \fBTCL_OK\fR.
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
unrecognized.
If \fInewValue\fR specifies a value for the option that
is not supported or if a system call error occurs,
the function should leave an error message in the
\fIresult\fR field of \fIinterp\fR if \fIinterp\fR is not NULL. The
function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
.PP
This value can be retrieved with \fBTcl_ChannelSetOptionProc\fR, which returns
a pointer to the function.
.SS GETOPTIONPROC
.PP







|
|







644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
If the option value is successfully modified to the new value, the function
returns \fBTCL_OK\fR.
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
unrecognized.
If \fInewValue\fR specifies a value for the option that
is not supported or if a system call error occurs,
the function should leave an error message in the result
of \fIinterp\fR if \fIinterp\fR is not NULL. The
function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
.PP
This value can be retrieved with \fBTcl_ChannelSetOptionProc\fR, which returns
a pointer to the function.
.SS GETOPTIONPROC
.PP

Changes to jni/tcl/doc/CrtSlave.3.

115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
...
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
...
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
.PP
These procedures are intended for access to the multiple interpreter
facility from inside C programs. They enable managing multiple interpreters
in a hierarchical relationship, and the management of aliases, commands
that when invoked in one interpreter execute a command in another
interpreter. The return value for those procedures that return an \fBint\fR
is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
then the \fBresult\fR field of the interpreter contains an error message.
.PP
\fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR.
It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which
allows \fIinterp\fR to manipulate the new slave.
If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
code has access to all the Tcl commands.
If it is \fB1\fR, the command creates a
................................................................................
\fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR.
If no such slave interpreter exists, \fBNULL\fR is returned.
.PP
\fBTcl_GetMaster\fR returns a pointer to the master interpreter of
\fIinterp\fR. If \fIinterp\fR has no master (it is a
top-level interpreter) then \fBNULL\fR is returned.
.PP
\fBTcl_GetInterpPath\fR sets the \fIresult\fR field in \fIaskingInterp\fR
to the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR;
\fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation
of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fBTCL_ERROR\fR is returned and the \fIresult\fR field in
\fIaskingInterp\fR contains the error message.
.PP
\fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in
\fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
to be invoked in \fItargetInterp\fR. The arguments specified by the strings
contained in \fIargv\fR are always prepended to any arguments supplied in the
invocation of \fIslaveCmd\fR and passed to \fItargetCmd\fR.
This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if
................................................................................
strings.
.PP
\fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from
the set of hidden commands to the set of exposed commands, putting
it under the name
\fIcmdName\fR.
\fIHiddenCmdName\fR must be the name of an existing hidden
command, or the operation will return \fBTCL_ERROR\fR and leave an error
message in the \fIresult\fR field in \fIinterp\fR.
If an exposed command named \fIcmdName\fR already exists,
the operation returns \fBTCL_ERROR\fR and leaves an error message in the
value result of \fIinterp\fR.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in a call to
\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will again succeed.
.PP
\fBTcl_HideCommand\fR moves the command named \fIcmdName\fR from the set of
exposed commands to the set of hidden commands, under the name
\fIhiddenCmdName\fR.
\fICmdName\fR must be the name of an existing exposed
command, or the operation will return \fBTCL_ERROR\fR and leave an error
message in the value result of \fIinterp\fR.
Currently both \fIcmdName\fR and \fIhiddenCmdName\fR must not contain
namespace qualifiers, or the operation will return \fBTCL_ERROR\fR and
leave an error message in the value result of \fIinterp\fR.
The \fICmdName\fR will be looked up in the global namespace, and not
relative to the current namespace, even if the current namespace is not the
global one.
If a hidden command whose name is \fIhiddenCmdName\fR already
exists, the operation also returns \fBTCL_ERROR\fR and the \fIresult\fR
field in \fIinterp\fR contains an error message.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in a call to
\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will fail.
.PP
For a description of the Tcl interface to multiple interpreters, see
\fIinterp(n)\fR.
.SH "SEE ALSO"
interp

.SH KEYWORDS
alias, command, exposed commands, hidden commands, interpreter, invoke,
master, slave







|







 







|
|


|
|







 







|
|

|
|

|
|






|


|




|
|

|
|









115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
...
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
...
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
.PP
These procedures are intended for access to the multiple interpreter
facility from inside C programs. They enable managing multiple interpreters
in a hierarchical relationship, and the management of aliases, commands
that when invoked in one interpreter execute a command in another
interpreter. The return value for those procedures that return an \fBint\fR
is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
then the interpreter's result contains an error message.
.PP
\fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR.
It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which
allows \fIinterp\fR to manipulate the new slave.
If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
code has access to all the Tcl commands.
If it is \fB1\fR, the command creates a
................................................................................
\fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR.
If no such slave interpreter exists, \fBNULL\fR is returned.
.PP
\fBTcl_GetMaster\fR returns a pointer to the master interpreter of
\fIinterp\fR. If \fIinterp\fR has no master (it is a
top-level interpreter) then \fBNULL\fR is returned.
.PP
\fBTcl_GetInterpPath\fR stores in the result of \fIaskingInterp\fR
the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR;
\fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation
of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fBTCL_ERROR\fR is returned and an error message is stored as the
result of \fIaskingInterp\fR.
.PP
\fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in
\fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
to be invoked in \fItargetInterp\fR. The arguments specified by the strings
contained in \fIargv\fR are always prepended to any arguments supplied in the
invocation of \fIslaveCmd\fR and passed to \fItargetCmd\fR.
This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if
................................................................................
strings.
.PP
\fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from
the set of hidden commands to the set of exposed commands, putting
it under the name
\fIcmdName\fR.
\fIHiddenCmdName\fR must be the name of an existing hidden
command, or the operation will return \fBTCL_ERROR\fR and
leave an error message as the result of \fIinterp\fR.
If an exposed command named \fIcmdName\fR already exists,
the operation returns \fBTCL_ERROR\fR and leaves an error message as
the result of \fIinterp\fR.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in any
script evaluation mechanism will again succeed.
.PP
\fBTcl_HideCommand\fR moves the command named \fIcmdName\fR from the set of
exposed commands to the set of hidden commands, under the name
\fIhiddenCmdName\fR.
\fICmdName\fR must be the name of an existing exposed
command, or the operation will return \fBTCL_ERROR\fR and leave an error
message as the result of \fIinterp\fR.
Currently both \fIcmdName\fR and \fIhiddenCmdName\fR must not contain
namespace qualifiers, or the operation will return \fBTCL_ERROR\fR and
leave an error message as the result of \fIinterp\fR.
The \fICmdName\fR will be looked up in the global namespace, and not
relative to the current namespace, even if the current namespace is not the
global one.
If a hidden command whose name is \fIhiddenCmdName\fR already
exists, the operation also returns \fBTCL_ERROR\fR and an error
message is left as the result of \fIinterp\fR.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in
any script evaluation mechanism will fail.
.PP
For a description of the Tcl interface to multiple interpreters, see
\fIinterp(n)\fR.
.SH "SEE ALSO"
interp

.SH KEYWORDS
alias, command, exposed commands, hidden commands, interpreter, invoke,
master, slave

Changes to jni/tcl/doc/Panic.3.

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
same formatting rules are also used by the built-in Tcl command
\fBformat\fR.
.PP
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
\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







|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
same formatting rules are also used by the built-in Tcl command
\fBformat\fR.
.PP
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 instead. 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
\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

Changes to jni/tcl/generic/tclExecute.c.

8800
8801
8802
8803
8804
8805
8806
8807
8808
8809
8810
8811
8812
8813
8814
....
9188
9189
9190
9191
9192
9193
9194
9195
9196
9197
9198
9199
9200
9201
9202
9203
9204
9205
9206
9207
9208
9209
9210
9211
	    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);
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = big2.used != 0;
	    mp_clear(&big2);
	    break;
	}

	switch (type1) {
	case TCL_NUMBER_LONG:
	    l1 = *((const long *)ptr1);
................................................................................
	case INST_SUB:
	    mp_sub(&big1, &big2, &bigResult);
	    break;
	case INST_MULT:
	    mp_mul(&big1, &big2, &bigResult);
	    break;
	case INST_DIV:
	    if (big2.used == 0) {
		mp_clear(&big1);
		mp_clear(&big2);
		mp_clear(&bigResult);
		return DIVIDED_BY_ZERO;
	    }
	    mp_init(&bigRemainder);
	    mp_div(&big1, &big2, &bigResult, &bigRemainder);
	    /* TODO: internals intrusion */
	    if (bigRemainder.used != 0
		    && (bigRemainder.sign != big2.sign)) {
		/*
		 * Convert to Tcl's integer division rules.
		 */

		mp_sub_d(&bigResult, 1, &bigResult);
		mp_add(&bigRemainder, &big2, &bigRemainder);







|







 







|








|







8800
8801
8802
8803
8804
8805
8806
8807
8808
8809
8810
8811
8812
8813
8814
....
9188
9189
9190
9191
9192
9193
9194
9195
9196
9197
9198
9199
9200
9201
9202
9203
9204
9205
9206
9207
9208
9209
9210
9211
	    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);
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = !mp_iszero(&big2);
	    mp_clear(&big2);
	    break;
	}

	switch (type1) {
	case TCL_NUMBER_LONG:
	    l1 = *((const long *)ptr1);
................................................................................
	case INST_SUB:
	    mp_sub(&big1, &big2, &bigResult);
	    break;
	case INST_MULT:
	    mp_mul(&big1, &big2, &bigResult);
	    break;
	case INST_DIV:
	    if (mp_iszero(&big2)) {
		mp_clear(&big1);
		mp_clear(&big2);
		mp_clear(&bigResult);
		return DIVIDED_BY_ZERO;
	    }
	    mp_init(&bigRemainder);
	    mp_div(&big1, &big2, &bigResult, &bigRemainder);
	    /* TODO: internals intrusion */
	    if (!mp_iszero(&bigRemainder)
		    && (bigRemainder.sign != big2.sign)) {
		/*
		 * Convert to Tcl's integer division rules.
		 */

		mp_sub_d(&bigResult, 1, &bigResult);
		mp_add(&bigRemainder, &big2, &bigRemainder);

Changes to jni/tcl/generic/tclResult.c.

1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718

void
Tcl_TransferResult(
    Tcl_Interp *sourceInterp,	/* Interp whose result and return options
				 * should be moved to the target interp.
				 * After moving result, this interp's result
				 * is reset. */
    int code,			/* The return code value active in 
				 * sourceInterp. Controls how the return options
				 * dictionary is retrieved from sourceInterp,
				 * same as in Tcl_GetReturnOptions, to then be
				 * transferred to targetInterp. */
    Tcl_Interp *targetInterp)	/* Interp where result and return options 
				 * should be stored. If source and target are
				 * the same, nothing is done. */
{
    Interp *tiPtr = (Interp *) targetInterp;
    Interp *siPtr = (Interp *) sourceInterp;

    if (sourceInterp == targetInterp) {







|




|







1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718

void
Tcl_TransferResult(
    Tcl_Interp *sourceInterp,	/* Interp whose result and return options
				 * should be moved to the target interp.
				 * After moving result, this interp's result
				 * is reset. */
    int code,			/* The return code value active in
				 * sourceInterp. Controls how the return options
				 * dictionary is retrieved from sourceInterp,
				 * same as in Tcl_GetReturnOptions, to then be
				 * transferred to targetInterp. */
    Tcl_Interp *targetInterp)	/* Interp where result and return options
				 * should be stored. If source and target are
				 * the same, nothing is done. */
{
    Interp *tiPtr = (Interp *) targetInterp;
    Interp *siPtr = (Interp *) sourceInterp;

    if (sourceInterp == targetInterp) {

Changes to jni/tcl/generic/tclStrToD.c.

11
12
13
14
15
16
17

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
....
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
....
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
....
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
....
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
....
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
....
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
....
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
....
4470
4471
4472
4473
4474
4475
4476

4477
4478
4479
4480
4481
4482
4483
4484
....
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
 *
 * 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"

#include <math.h>

/*
 * Older MSVC has no copysign function, but it's available at least since
 * MSVC++ 12.0 (that is Visual Studio 2013).
 */

#if (defined(_MSC_VER) && (_MSC_VER < 1800))
inline static double
copysign(double a, double b) {
    return _copysign(a, b);
}
#endif

/*
 * Define KILL_OCTAL to suppress interpretation of numbers with leading zero
 * as octal. (Ceterum censeo: numeros octonarios delendos esse.)
 */

................................................................................
	    }
	    break;

	case ZERO:
	case DECIMAL:
	    significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1,
		    &significandWide, &significandBig, significandOverflow);
	    if (!significandOverflow && (significandWide > MOST_BITS+signum)){
		significandOverflow = 1;
		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
	    }
	returnInteger:
	    if (!significandOverflow) {
		if (significandWide >
			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
................................................................................
	     * to whether 'significandOverflow' is set. The desired floating
	     * point value is significand * 10**k, where
	     * k = numTrailZeros+exponent-numDigitsAfterDp.
	     */

	    objPtr->typePtr = &tclDoubleType;
	    if (exponentSignum) {
		/* 
		 * At this point exponent>=0, so the following calculation
		 * cannot underflow. 
		 */
		exponent = -exponent;
	    }

	    /*
	     * Adjust the exponent for the number of trailing zeros that
	     * have not been accumulated, and the number of digits after
................................................................................
		if (exponent + numTrailZeros < LONG_MIN + numDigitsAfterDp) {
		    exponent = LONG_MIN;
		} else {
		    exponent = exponent + numTrailZeros - numDigitsAfterDp;
		}
	    }

	    /* 
	     * The desired number is now significandWide * 10**exponent
	     * or significandBig * 10**exponent, depending on whether
	     * the significand has overflowed a wide int.
	     */
	    if (!significandOverflow) {
		objPtr->internalRep.doubleValue = MakeLowPrecisionDouble(
			signum, significandWide, numSigDigs, exponent);
................................................................................
	    }
	    objPtr->typePtr = &tclDoubleType;
	    break;

#ifdef IEEE_FLOATING_POINT
	case sNAN:
	case sNANFINISH:
	    objPtr->internalRep.doubleValue = MakeNaN(signum,significandWide);
	    objPtr->typePtr = &tclDoubleType;
	    break;
#endif
	case INITIAL:
	    /* This case only to silence compiler warning. */
	    Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
	}
................................................................................
	if (M5 - 1 > M2) {
	    M2 = M5 - 1;
	}
    }

    /*
     * Compute twoMv as 2*M*v, where v is the approximate value.
     * This is done by bit-whacking to calculate 2**(M2+1)*significand, 
     * and then multiplying by 5**M5.
     */

    msb = binExponent + M2;	/* 1008 */
    nDigits = msb / MP_DIGIT_BIT + 1;
    mp_init_size(&twoMv, nDigits);
    i = (msb % MP_DIGIT_BIT + 1);
................................................................................
    for (i=0; i<=8; ++i) {
	if ((M5 + exponent) & (1 << i)) {
	    mp_mul(&twoMd, pow5+i, &twoMd);
	}
    }
    mp_mul_2d(&twoMd, M2+exponent+1, &twoMd);

    /* 
     * Now let twoMd = twoMd - twoMv, the difference between the exact and
     * approximate values.
     */

    mp_sub(&twoMd, &twoMv, &twoMd);

    /*
................................................................................
	if ((rteSigWide & 1) == 0) {
	    mp_clear(&twoMd);
	    mp_clear(&twoMv);
	    return approxResult;
	}
    }

    /* 
     * Reduce the numerator and denominator of the corrector term so that
     * they will fit in the floating point precision.
     */
    shift = mp_count_bits(&twoMv) - FP_PRECISION - 1;
    if (shift > 0) {
	mp_div_2d(&twoMv, shift, &twoMv, NULL);
	mp_div_2d(&twoMd, shift, &twoMd, NULL);
................................................................................

    /*
     * Initialize table of powers of 10 expressed as wide integers.
     */

    maxpow10_wide = (int)
	    floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));

    pow10_wide = ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
    u = 1;
    for (i = 0; i < maxpow10_wide; ++i) {
	pow10_wide[i] = u;
	u *= 10;
    }
    pow10_wide[i] = u;

................................................................................

	    if (shift > 0) {
		mp_mul_2d(a, shift, &b);
	    } else if (shift < 0) {
		mp_int d;
		mp_init(&d);
		mp_div_2d(a, -shift, &b, &d);
		exact = d.used == 0;
		mp_clear(&d);
	    } else {
		mp_copy(a, &b);
	    }
	    if (!exact) {
		mp_add_d(&b, 1, &b);
	    }







>


<
|
<
<
<
<
<
<
|
<







 







|







 







|

|







 







|







 







|







 







|







 







|







 







|







 







>
|







 







|







11
12
13
14
15
16
17
18
19
20

21






22

23
24
25
26
27
28
29
....
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
....
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
....
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
....
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
....
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
....
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
....
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
....
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
....
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
 *
 * 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"
#include <float.h>
#include <math.h>


#ifdef _WIN32






#define copysign _copysign

#endif

/*
 * Define KILL_OCTAL to suppress interpretation of numbers with leading zero
 * as octal. (Ceterum censeo: numeros octonarios delendos esse.)
 */

................................................................................
	    }
	    break;

	case ZERO:
	case DECIMAL:
	    significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1,
		    &significandWide, &significandBig, significandOverflow);
	    if (!significandOverflow && (significandWide > MOST_BITS+signum)) {
		significandOverflow = 1;
		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
	    }
	returnInteger:
	    if (!significandOverflow) {
		if (significandWide >
			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
................................................................................
	     * to whether 'significandOverflow' is set. The desired floating
	     * point value is significand * 10**k, where
	     * k = numTrailZeros+exponent-numDigitsAfterDp.
	     */

	    objPtr->typePtr = &tclDoubleType;
	    if (exponentSignum) {
		/*
		 * At this point exponent>=0, so the following calculation
		 * cannot underflow.
		 */
		exponent = -exponent;
	    }

	    /*
	     * Adjust the exponent for the number of trailing zeros that
	     * have not been accumulated, and the number of digits after
................................................................................
		if (exponent + numTrailZeros < LONG_MIN + numDigitsAfterDp) {
		    exponent = LONG_MIN;
		} else {
		    exponent = exponent + numTrailZeros - numDigitsAfterDp;
		}
	    }

	    /*
	     * The desired number is now significandWide * 10**exponent
	     * or significandBig * 10**exponent, depending on whether
	     * the significand has overflowed a wide int.
	     */
	    if (!significandOverflow) {
		objPtr->internalRep.doubleValue = MakeLowPrecisionDouble(
			signum, significandWide, numSigDigs, exponent);
................................................................................
	    }
	    objPtr->typePtr = &tclDoubleType;
	    break;

#ifdef IEEE_FLOATING_POINT
	case sNAN:
	case sNANFINISH:
	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
	    objPtr->typePtr = &tclDoubleType;
	    break;
#endif
	case INITIAL:
	    /* This case only to silence compiler warning. */
	    Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
	}
................................................................................
	if (M5 - 1 > M2) {
	    M2 = M5 - 1;
	}
    }

    /*
     * Compute twoMv as 2*M*v, where v is the approximate value.
     * This is done by bit-whacking to calculate 2**(M2+1)*significand,
     * and then multiplying by 5**M5.
     */

    msb = binExponent + M2;	/* 1008 */
    nDigits = msb / MP_DIGIT_BIT + 1;
    mp_init_size(&twoMv, nDigits);
    i = (msb % MP_DIGIT_BIT + 1);
................................................................................
    for (i=0; i<=8; ++i) {
	if ((M5 + exponent) & (1 << i)) {
	    mp_mul(&twoMd, pow5+i, &twoMd);
	}
    }
    mp_mul_2d(&twoMd, M2+exponent+1, &twoMd);

    /*
     * Now let twoMd = twoMd - twoMv, the difference between the exact and
     * approximate values.
     */

    mp_sub(&twoMd, &twoMv, &twoMd);

    /*
................................................................................
	if ((rteSigWide & 1) == 0) {
	    mp_clear(&twoMd);
	    mp_clear(&twoMv);
	    return approxResult;
	}
    }

    /*
     * Reduce the numerator and denominator of the corrector term so that
     * they will fit in the floating point precision.
     */
    shift = mp_count_bits(&twoMv) - FP_PRECISION - 1;
    if (shift > 0) {
	mp_div_2d(&twoMv, shift, &twoMv, NULL);
	mp_div_2d(&twoMd, shift, &twoMd, NULL);
................................................................................

    /*
     * Initialize table of powers of 10 expressed as wide integers.
     */

    maxpow10_wide = (int)
	    floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));
    pow10_wide = (Tcl_WideUInt *)
	    ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
    u = 1;
    for (i = 0; i < maxpow10_wide; ++i) {
	pow10_wide[i] = u;
	u *= 10;
    }
    pow10_wide[i] = u;

................................................................................

	    if (shift > 0) {
		mp_mul_2d(a, shift, &b);
	    } else if (shift < 0) {
		mp_int d;
		mp_init(&d);
		mp_div_2d(a, -shift, &b, &d);
		exact = mp_iszero(&d);
		mp_clear(&d);
	    } else {
		mp_copy(a, &b);
	    }
	    if (!exact) {
		mp_add_d(&b, 1, &b);
	    }