Tcl Source Code

Check-in [3dcb7571f5]
Login
Core Home Timeline Branches Tags Tickets Wiki Clone or Download
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Merge 8.7
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 3dcb7571f51656f735e311523d49d0f37c564e931c50407f42e3c7dbf074d5bb
User & Date: jan.nijtmans 2019-03-15 21:17:24
Context
2019-03-17
22:17
Merge 8.7 check-in: 5bfbe84775 user: jan.nijtmans tags: trunk
2019-03-15
21:17
Merge 8.7 check-in: 3dcb7571f5 user: jan.nijtmans tags: trunk
20:52
Eliminate usage of mp_isneg(), just check bignum->sign directly (as libtommath itself does) Make Tcl... check-in: 515a22d41d user: jan.nijtmans tags: core-8-branch
2019-03-14
20:03
merge-mark check-in: 80c345bf67 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to .travis.yml. 

77
78
79
80
81
82
83












84
85
86
87
88
89
90
...
134
135
136
137
138
139
140
















141
142
143
144
145
146
147
...
165
166
167
168
169
170
171
172















173
174
175
176
177
178
179
180
181

          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
        - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6












    - os: osx
      osx_image: xcode8
      env:
        - BUILD_DIR=unix
    - os: osx
      osx_image: xcode8
      env:
................................................................................
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1
















# Test with mingw-w64 (64 bit)
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
................................................................................
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1
















before_install:
  - export ERROR_ON_FAILURES=1
  - cd ${BUILD_DIR}
install:
  - test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT}
script:
  - make
  # The styles=develop avoids some weird problems on OSX
  - test -n "$NO_DIRECT_TEST" || make test styles=develop







>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>










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
...
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
...
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

          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
        - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6
    - os: linux
      dist: xenial
      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
        - CFGOPT=CFLAGS=-DTCL_NO_DEPRECATED=1
    - os: osx
      osx_image: xcode8
      env:
        - BUILD_DIR=unix
    - os: osx
      osx_image: xcode8
      env:
................................................................................
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_NO_DEPRECATED=1"
        - NO_DIRECT_TEST=1
# Test with mingw-w64 (64 bit)
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
................................................................................
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1

    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1"
        - NO_DIRECT_TEST=1
before_install:
  - export ERROR_ON_FAILURES=1
  - cd ${BUILD_DIR}
install:
  - test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT}
script:
  - make
  # The styles=develop avoids some weird problems on OSX
  - test -n "$NO_DIRECT_TEST" || make test styles=develop

Changes to doc/timerate.n. 

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

.TP
\fI-calibrate\fR
.
To measure very fast scripts as exact as posible the calibration process
may be required.

The \fI-calibrate\fR option is used to calibrate timerate, calculating the
estimated overhead of the given script as the default overhead for future 
invocations of the \fBtimerate\fR command. If the \fItime\fR parameter is not 
specified, the calibrate procedure runs for up to 10 seconds.
.TP
\fI-overhead double\fR
.
The \fI-overhead\fR parameter supplies an estimate (in microseconds) of the
measurement overhead of each iteration of the tested script. This quantity
will be subtracted from the measured time prior to reporting results.







|
|








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

.TP
\fI-calibrate\fR
.
To measure very fast scripts as exact as posible the calibration process
may be required.

The \fI-calibrate\fR option is used to calibrate timerate, calculating the
estimated overhead of the given script as the default overhead for future
invocations of the \fBtimerate\fR command. If the \fItime\fR parameter is not
specified, the calibrate procedure runs for up to 10 seconds.
.TP
\fI-overhead double\fR
.
The \fI-overhead\fR parameter supplies an estimate (in microseconds) of the
measurement overhead of each iteration of the tested script. This quantity
will be subtracted from the measured time prior to reporting results.

Changes to generic/tclBasic.c. 

6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
....
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
....
7099
7100
7101
7102
7103
7104
7105
7106
7107
7108
7109
7110
7111
7112
7113

	    }
	}
	break;
    case TCL_NUMBER_BIG:
	if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (mp_isneg(&big)) {
	    mp_clear(&big);
	    goto negarg;
	}
	break;
    default:
	if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
	    return TCL_ERROR;
................................................................................
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > (Tcl_WideInt)0) {
	    goto unChanged;
	} else if (l == (Tcl_WideInt)0) {
	    if (TclHasStringRep(objv[1])) {
		size_t numBytes;
		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
................................................................................
	    goto unChanged;
	}
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
	return TCL_OK;
    }

    if (type == TCL_NUMBER_BIG) {
	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]);







|







 







|

|







 







|








6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
....
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
....
7099
7100
7101
7102
7103
7104
7105
7106
7107
7108
7109
7110
7111
7112
7113

	    }
	}
	break;
    case TCL_NUMBER_BIG:
	if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (big.sign != MP_ZPOS) {
	    mp_clear(&big);
	    goto negarg;
	}
	break;
    default:
	if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
	    return TCL_ERROR;
................................................................................
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > 0) {
	    goto unChanged;
	} else if (l == 0) {
	    if (TclHasStringRep(objv[1])) {
		size_t numBytes;
		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
................................................................................
	    goto unChanged;
	}
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
	return TCL_OK;
    }

    if (type == TCL_NUMBER_BIG) {
	if (((const mp_int *) ptr)->sign != MP_ZPOS) {
	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
	tooLarge:
	    mp_neg(&big, &big);
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	} else {
	unChanged:
	    Tcl_SetObjResult(interp, objv[1]);

Changes to generic/tclExecute.c. 

7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
....
7646
7647
7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
....
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
....
7689
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
....
7747
7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
7760
7761
7762
7763
7764
7765
....
7772
7773
7774
7775
7776
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
....
7875
7876
7877
7878
7879
7880
7881
7882
7883
7884
7885
7886
7887
7888
7889
7890
7891
....
8194
8195
8196
8197
8198
8199
8200
8201
8202
8203
8204
8205
8206
8207
8208
8209
8210
8211
8212
8213
8214
8215
8216
8217
....
8350
8351
8352
8353
8354
8355
8356
8357
8358
8359
8360
8361
8362
8363
8364
....
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
8399
8400
8401

		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification
		 */

		if (((wQuotient < (Tcl_WideInt) 0)
			|| ((wQuotient == (Tcl_WideInt) 0)
			&& ((w1 < (Tcl_WideInt)0 && w2 > (Tcl_WideInt)0)
			|| (w1 > (Tcl_WideInt)0 && w2 < (Tcl_WideInt)0))))
			&& (wQuotient * w2 != w1)) {
		    wQuotient -= (Tcl_WideInt) 1;
		}
		wRemainder = w1 - w2*wQuotient;
		WIDE_RESULT(wRemainder);
	    }

................................................................................
	    return NULL;
	}
	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)) {
	    /*
	     * Convert to Tcl's integer division rules.
	     */

	    mp_sub_d(&bigResult, 1, &bigResult);
	    mp_add(&bigRemainder, &big2, &bigRemainder);
	}
................................................................................
    case INST_RSHIFT: {
	/*
	 * Reject negative shift argument.
	 */

	switch (type2) {
	case TCL_NUMBER_INT:
	    invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
	    break;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    invalid = mp_isneg(&big2);
	    mp_clear(&big2);
	    break;
	default:
	    /* Unused, here to silence compiler warning */
	    invalid = 0;
	}
	if (invalid) {
................................................................................
	    return GENERAL_ARITHMETIC_ERROR;
	}

	/*
	 * Zero shifted any number of bits is still zero.
	 */

	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.
	     *
................................................................................
		 * 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_INT:
		    zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
		    break;
		case TCL_NUMBER_BIG:
		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
		    zero = (!mp_isneg(&big1));
		    mp_clear(&big1);
		    break;
		default:
		    /* Unused, here to silence compiler warning. */
		    zero = 0;
		}
		if (zero) {
................................................................................
	    /*
	     * Handle shifts within the native wide range.
	     */

	    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];
		    }
		    WIDE_RESULT(-1);
		}
		WIDE_RESULT(w1 >> shift);
	    }
	}
................................................................................
		return NULL;
	    }

	    negativeExponent = (w2 < 0);
	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
	} else {
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    negativeExponent = mp_isneg(&big2);
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = !mp_iszero(&big2);
	    mp_clear(&big2);
	}

	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *)ptr1);

	    if (negativeExponent) {
................................................................................
	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);
................................................................................
	    if (d2 > (double)WIDE_MAX) {
		return MP_LT;
	    }
	    w2 = (Tcl_WideInt) d2;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if (mp_isneg(&big2)) {
		compare = MP_GT;
	    } else {
		compare = MP_LT;
	    }
	    mp_clear(&big2);
	    return compare;
	}
................................................................................
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    if (TclIsInfinite(d1)) {
		return (d1 > 0.0) ? MP_GT : MP_LT;
	    }
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    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;
	    }







|
|







 







|







 







|



|







 







|







 







|



|







 







|







 







|

|







 







|








|







 







|







 







|








7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
....
7646
7647
7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
....
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
....
7689
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
....
7747
7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
7760
7761
7762
7763
7764
7765
....
7772
7773
7774
7775
7776
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
....
7875
7876
7877
7878
7879
7880
7881
7882
7883
7884
7885
7886
7887
7888
7889
7890
7891
....
8194
8195
8196
8197
8198
8199
8200
8201
8202
8203
8204
8205
8206
8207
8208
8209
8210
8211
8212
8213
8214
8215
8216
8217
....
8350
8351
8352
8353
8354
8355
8356
8357
8358
8359
8360
8361
8362
8363
8364
....
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
8399
8400
8401

		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification
		 */

		if (((wQuotient < (Tcl_WideInt) 0)
			|| ((wQuotient == (Tcl_WideInt) 0)
			&& ((w1 < 0 && w2 > 0)
			|| (w1 > 0 && w2 < 0))))
			&& (wQuotient * w2 != w1)) {
		    wQuotient -= (Tcl_WideInt) 1;
		}
		wRemainder = w1 - w2*wQuotient;
		WIDE_RESULT(wRemainder);
	    }

................................................................................
	    return NULL;
	}
	Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	mp_init(&bigResult);
	mp_init(&bigRemainder);
	mp_div(&big1, &big2, &bigResult, &bigRemainder);
	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);
	}
................................................................................
    case INST_RSHIFT: {
	/*
	 * Reject negative shift argument.
	 */

	switch (type2) {
	case TCL_NUMBER_INT:
	    invalid = (*((const Tcl_WideInt *)ptr2) < 0);
	    break;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    invalid = big2.sign != MP_ZPOS;
	    mp_clear(&big2);
	    break;
	default:
	    /* Unused, here to silence compiler warning */
	    invalid = 0;
	}
	if (invalid) {
................................................................................
	    return GENERAL_ARITHMETIC_ERROR;
	}

	/*
	 * Zero shifted any number of bits is still zero.
	 */

	if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == 0)) {
	    return constants[0];
	}

	if (opcode == INST_LSHIFT) {
	    /*
	     * Large left shifts create integer overflow.
	     *
................................................................................
		 * 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_INT:
		    zero = (*(const Tcl_WideInt *)ptr1 > 0);
		    break;
		case TCL_NUMBER_BIG:
		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
		    zero = (big1.sign == MP_ZPOS);
		    mp_clear(&big1);
		    break;
		default:
		    /* Unused, here to silence compiler warning. */
		    zero = 0;
		}
		if (zero) {
................................................................................
	    /*
	     * Handle shifts within the native wide range.
	     */

	    if (type1 == TCL_NUMBER_INT) {
		w1 = *(const Tcl_WideInt *)ptr1;
		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
		    if (w1 >= 0) {
			return constants[0];
		    }
		    WIDE_RESULT(-1);
		}
		WIDE_RESULT(w1 >> shift);
	    }
	}
................................................................................
		return NULL;
	    }

	    negativeExponent = (w2 < 0);
	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
	} else {
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    negativeExponent = big2.sign != MP_ZPOS;
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = big2.used != 0;
	    mp_clear(&big2);
	}

	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *)ptr1);

	    if (negativeExponent) {
................................................................................
	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);
................................................................................
	    if (d2 > (double)WIDE_MAX) {
		return MP_LT;
	    }
	    w2 = (Tcl_WideInt) d2;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if (big2.sign != MP_ZPOS) {
		compare = MP_GT;
	    } else {
		compare = MP_LT;
	    }
	    mp_clear(&big2);
	    return compare;
	}
................................................................................
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    if (TclIsInfinite(d1)) {
		return (d1 > 0.0) ? MP_GT : MP_LT;
	    }
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
		if (big2.sign != MP_ZPOS) {
		    compare = MP_GT;
		} else {
		    compare = MP_LT;
		}
		mp_clear(&big2);
		return compare;
	    }

Changes to generic/tclInt.h. 

2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999

MODULE_SCOPE int	TclInfoGlobalsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoLocalsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoVarsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclInitAlloc(void);
MODULE_SCOPE void	TclInitBignumFromLong(mp_int *, long);
MODULE_SCOPE void	TclInitBignumFromWideInt(mp_int *, Tcl_WideInt);
MODULE_SCOPE void	TclInitBignumFromWideUInt(mp_int *, Tcl_WideUInt);
MODULE_SCOPE void	TclInitDbCkalloc(void);
MODULE_SCOPE void	TclInitDoubleConversion(void);
MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation(
			    Tcl_Interp *interp);
MODULE_SCOPE void	TclInitEncodingSubsystem(void);







<








2985
2986
2987
2988
2989
2990
2991

2992
2993
2994
2995
2996
2997
2998

MODULE_SCOPE int	TclInfoGlobalsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoLocalsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoVarsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclInitAlloc(void);

MODULE_SCOPE void	TclInitBignumFromWideInt(mp_int *, Tcl_WideInt);
MODULE_SCOPE void	TclInitBignumFromWideUInt(mp_int *, Tcl_WideUInt);
MODULE_SCOPE void	TclInitDbCkalloc(void);
MODULE_SCOPE void	TclInitDoubleConversion(void);
MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation(
			    Tcl_Interp *interp);
MODULE_SCOPE void	TclInitEncodingSubsystem(void);

Changes to generic/tclPipe.c. 

329
330
331
332
333
334
335
336
337
338
339
340
341
342
343

	 * Make sure we start at the beginning of the file.
	 */

	if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
	    objPtr = Tcl_NewObj();
	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
	    if (count == -1) {
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|








329
330
331
332
333
334
335
336
337
338
339
340
341
342
343

	 * Make sure we start at the beginning of the file.
	 */

	if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, 0, SEEK_SET);
	    objPtr = Tcl_NewObj();
	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
	    if (count == -1) {
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(

Changes to generic/tclScan.c. 

939
940
941
942
943
944
945
946
947
948
949
950
951
952
953

		}
	    } 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) {







|








939
940
941
942
943
944
945
946
947
948
949
950
951
952
953

		}
	    } else if (flags & SCAN_BIG) {
		if (flags & SCAN_UNSIGNED) {
		    mp_int big;
		    int code = Tcl_GetBignumFromObj(interp, objPtr, &big);

		    if (code == TCL_OK) {
			if (big.sign != MP_ZPOS) {
			    code = TCL_ERROR;
			}
			mp_clear(&big);
		    }

		    if (code == TCL_ERROR) {
			if (objs != NULL) {

Changes to generic/tclStrToD.c. 

525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
...
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
...
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
...
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
....
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
....
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
....
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
....
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652

    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 */

#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.
     */

................................................................................
			 * too large shifts first.
			 */

			if ((octalSignificandWide != 0)
				&& (((size_t)shift >=
					CHAR_BIT*sizeof(Tcl_WideUInt))
				|| (octalSignificandWide >
					(~(Tcl_WideUInt)0 >> shift)))) {
			    octalSignificandOverflow = 1;
			    TclInitBignumFromWideUInt(&octalSignificandBig,
				    octalSignificandWide);
			}
		    }
		    if (!octalSignificandOverflow) {
			octalSignificandWide =
................................................................................
		     * Shifting by more bits than are in the value being
		     * shifted is at least de facto nonportable. Check for too
		     * large shifts first.
		     */

		    if (significandWide != 0 &&
			    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
			    significandWide > (~(Tcl_WideUInt)0 >> shift))) {
			significandOverflow = 1;
			TclInitBignumFromWideUInt(&significandBig,
				significandWide);
		    }
		}
		if (!significandOverflow) {
		    significandWide = (significandWide << shift) + d;
................................................................................
		     * Shifting by more bits than are in the value being
		     * shifted is at least de facto nonportable. Check for too
		     * large shifts first.
		     */

		    if (significandWide != 0 &&
			    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
			    significandWide > (~(Tcl_WideUInt)0 >> shift))) {
			significandOverflow = 1;
			TclInitBignumFromWideUInt(&significandBig,
				significandWide);
		    }
		}
		if (!significandOverflow) {
		    significandWide = (significandWide << shift) + 1;
................................................................................
	    /*
	     * There's no need to multiply if the multiplicand is zero.
	     */

	    *wideRepPtr = digit;
	    return 0;
	} else if (numZeros >= maxpow10_wide
		|| w > ((~(Tcl_WideUInt)0)-digit)/pow10_wide[numZeros+1]) {
	    /*
	     * Wide multiplication will overflow.  Expand the number to a
	     * bignum and fall through into the bignum case.
	     */

	    TclInitBignumFromWideUInt(bignumRepPtr, w);
	} else {
................................................................................
TclCeil(
    const mp_int *a)			/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;

    mp_init(&b);
    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;
................................................................................

	    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);
	    }
................................................................................
TclFloor(
    const mp_int *a)			/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;

    mp_init(&b);
    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;







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|








525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
...
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
...
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
...
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
....
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
....
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
....
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
....
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652

    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 */

#define ALL_BITS	((Tcl_WideUInt)-1)
#define MOST_BITS	(ALL_BITS >> 1)

    /*
     * Initialize bytes to start of the object's string rep if the caller
     * didn't pass anything else.
     */

................................................................................
			 * too large shifts first.
			 */

			if ((octalSignificandWide != 0)
				&& (((size_t)shift >=
					CHAR_BIT*sizeof(Tcl_WideUInt))
				|| (octalSignificandWide >
					((Tcl_WideUInt)-1 >> shift)))) {
			    octalSignificandOverflow = 1;
			    TclInitBignumFromWideUInt(&octalSignificandBig,
				    octalSignificandWide);
			}
		    }
		    if (!octalSignificandOverflow) {
			octalSignificandWide =
................................................................................
		     * Shifting by more bits than are in the value being
		     * shifted is at least de facto nonportable. Check for too
		     * large shifts first.
		     */

		    if (significandWide != 0 &&
			    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
			    significandWide > ((Tcl_WideUInt)-1 >> shift))) {
			significandOverflow = 1;
			TclInitBignumFromWideUInt(&significandBig,
				significandWide);
		    }
		}
		if (!significandOverflow) {
		    significandWide = (significandWide << shift) + d;
................................................................................
		     * Shifting by more bits than are in the value being
		     * shifted is at least de facto nonportable. Check for too
		     * large shifts first.
		     */

		    if (significandWide != 0 &&
			    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
			    significandWide > ((Tcl_WideUInt)-1 >> shift))) {
			significandOverflow = 1;
			TclInitBignumFromWideUInt(&significandBig,
				significandWide);
		    }
		}
		if (!significandOverflow) {
		    significandWide = (significandWide << shift) + 1;
................................................................................
	    /*
	     * There's no need to multiply if the multiplicand is zero.
	     */

	    *wideRepPtr = digit;
	    return 0;
	} else if (numZeros >= maxpow10_wide
		|| w > ((Tcl_WideUInt)-1-digit)/pow10_wide[numZeros+1]) {
	    /*
	     * Wide multiplication will overflow.  Expand the number to a
	     * bignum and fall through into the bignum case.
	     */

	    TclInitBignumFromWideUInt(bignumRepPtr, w);
	} else {
................................................................................
TclCeil(
    const mp_int *a)			/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;

    mp_init(&b);
    if (a->sign != MP_ZPOS) {
	mp_neg(a, &b);
	r = -TclFloor(&b);
    } else {
	int bits = mp_count_bits(a);

	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
	    r = HUGE_VAL;
................................................................................

	    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);
	    }
................................................................................
TclFloor(
    const mp_int *a)			/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;

    mp_init(&b);
    if (a->sign != MP_ZPOS) {
	mp_neg(a, &b);
	r = -TclCeil(&b);
    } else {
	int bits = mp_count_bits(a);

	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
	    r = DBL_MAX;

Changes to generic/tclTomMathInterface.c. 

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

 */

int
TclBN_revision(void)
{
    return TCLTOMMATH_REVISION;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclInitBignumFromLong --
 *
 *	Allocate and initialize a 'bignum' from a native 'long'.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The 'bignum' is constructed.
 *
 *----------------------------------------------------------------------
 */

void
TclInitBignumFromLong(
    mp_int *a,
    long v)
{
    if (mp_init_size(a, (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
	Tcl_Panic("initialization failure in TclInitBignumFromLong");
    }
    if (v < (long)0) {
	mp_set_long_long(a, (Tcl_WideUInt)(-(Tcl_WideInt)v));
	mp_neg(a, a);
    } else {
	mp_set_long_long(a, (Tcl_WideUInt)v);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclInitBignumFromWideInt --
 *
 *	Allocate and initialize a 'bignum' from a Tcl_WideInt







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








85
86
87
88
89
90
91
































92
93
94
95
96
97
98

 */

int
TclBN_revision(void)
{
    return TCLTOMMATH_REVISION;
}
































 
/*
 *----------------------------------------------------------------------
 *
 * TclInitBignumFromWideInt --
 *
 *	Allocate and initialize a 'bignum' from a Tcl_WideInt

Changes to generic/tclUtil.c. 

3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
....
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
....
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722

	if (numType != TCL_NUMBER_BIG) {
	    /* Must be a double -> not a valid index */
	    goto parseError;
	}

	/* objPtr holds an integer outside the signed wide range */
	/* Truncate to the signed wide range. */
	*widePtr = mp_isneg((mp_int *)cd) ? WIDE_MIN : WIDE_MAX;
    return TCL_OK;
    }

    /* objPtr does not hold a number, check the end+/- format... */
    if (GetEndOffsetFromObj(objPtr, endValue, widePtr) == TCL_OK) {
	return TCL_OK;
    }
................................................................................

		if (numType == TCL_NUMBER_INT) {
		    /* sum holds an integer in the signed wide range */
			*widePtr = *(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);
	    }
................................................................................
	    }

	    /* 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);







|







 







|







 







|








3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
....
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
....
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722

	if (numType != TCL_NUMBER_BIG) {
	    /* Must be a double -> not a valid index */
	    goto parseError;
	}

	/* objPtr holds an integer outside the signed wide range */
	/* Truncate to the signed wide range. */
	*widePtr = (((mp_int *)cd)->sign != MP_ZPOS) ? WIDE_MIN : WIDE_MAX;
    return TCL_OK;
    }

    /* objPtr does not hold a number, check the end+/- format... */
    if (GetEndOffsetFromObj(objPtr, endValue, widePtr) == TCL_OK) {
	return TCL_OK;
    }
................................................................................

		if (numType == TCL_NUMBER_INT) {
		    /* sum holds an integer in the signed wide range */
			*widePtr = *(Tcl_WideInt *)cd;
		} else {
		    /* sum holds an integer outside the signed wide range */
		    /* Truncate to the signed wide range. */
		    if (((mp_int *)cd)->sign != MP_ZPOS) {
			*widePtr = WIDE_MIN;
		    } else {
			*widePtr = WIDE_MAX;
		    }
		}
		Tcl_DecrRefCount(sum);
	    }
................................................................................
	    }

	    /* 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_int *)cd)->sign != MP_ZPOS) {
		    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);

This page was generated in about 0.049s by Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14