Tcl Source Code

Check-in [3e22a9b9f9]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

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

Overview
Comment:Merge 8.7
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | tip-515
Files: files | file ages | folders
SHA3-256: 3e22a9b9f99a300108c42b4fe1d6cbb380f3d2ae50e59ac402f7f125b22080a6
User & Date: jan.nijtmans 2018-09-22 13:24:33.420
Context
2018-09-26
23:43
Implementatin of TIP #515: Level Value Reform check-in: 1486105322 user: jan.nijtmans tags: core-8-branch-timeline-fix
2018-09-22
13:37
merge tip-515 branch check-in: 686effa0af user: jan.nijtmans tags: tip-514
13:24
Merge 8.7 Closed-Leaf check-in: 3e22a9b9f9 user: jan.nijtmans tags: tip-515
13:18
Change ULLONG_MAX -> UWIDE_MAX, LLONG_MAX -> WIDE_MAX and LLONG_MIN -> WIDE_MIN everywhere, because ... check-in: 59d28e540e user: jan.nijtmans tags: core-8-branch
12:45
merge 8.7 check-in: 7160931bed user: jan.nijtmans tags: tip-515
Changes
Side-by-Side Diff Ignore Whitespace Patch
Changes to generic/tclBasic.c.
︙
7512
7513
7514
7515
7516
7517
7518
7519

7520
7521
7522
7523
7524
7525
7526

7512
7513
7514
7515
7516
7517
7518

7519
7520
7521
7522
7523
7524
7525
7526








-
+








			Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
			return TCL_OK;
		    }
		    string++;
		}
	    }
	    goto unChanged;
	} else if (l == LLONG_MIN) {
	} else if (l == WIDE_MIN) {
	    TclInitBignumFromWideInt(&big, l);
	    goto tooLarge;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
	return TCL_OK;
    }
︙
7637
7638
7639
7640
7641
7642
7643
7644

7645
7646
7647
7648
7649
7650
7651

7637
7638
7639
7640
7641
7642
7643

7644
7645
7646
7647
7648
7649
7650
7651








-
+








    }
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_DOUBLE) {
	d = *((const double *) ptr);
	if ((d >= (double)LLONG_MAX) || (d <= (double)LLONG_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));
︙
Changes to generic/tclExecute.c.
︙
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

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








-
+

-
+






-
-
+
+








	int type1, type2;
	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_WIDE) {
	    /* value is between LLONG_MIN and LLONG_MAX */
	    /* value is between WIDE_MIN and WIDE_MAX */
	    /* [string is integer] is -UINT_MAX to UINT_MAX range */
	    /* [string is wideinteger] is -ULLONG_MAX to ULLONG_MAX range */
	    /* [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;
	    }
	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the LLONG_MIN to LLONG_MAX range */
	    /* [string is wideinteger] is -ULLONG_MAX to ULLONG_MAX range */
	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
	    Tcl_WideInt w;

	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_WIDE;
	    }
	}
	TclNewIntObj(objResultPtr, type1);
︙
6057
6058
6059
6060
6061
6062
6063
6064

6065
6066

6067
6068
6069
6070
6071
6072
6073

6057
6058
6059
6060
6061
6062
6063

6064
6065

6066
6067
6068
6069
6070
6071
6072
6073








-
+

-
+








		NEXT_INST_F(1, 1, 0);

	    case INST_DIV:
		if (w2 == 0) {
		    TRACE(("%s %s => DIVIDE BY ZERO\n",
			    O2S(valuePtr), O2S(value2Ptr)));
		    goto divideByZero;
		} else if ((w1 == LLONG_MIN) && (w2 == -1)) {
		} else if ((w1 == WIDE_MIN) && (w2 == -1)) {
		    /*
		     * Can't represent (-LLONG_MIN) as a Tcl_WideInt.
		     * Can't represent (-WIDE_MIN) as a Tcl_WideInt.
		     */

		    goto overflow;
		}
		wResult = w1 / w2;

		/*
︙
6192
6193
6194
6195
6196
6197
6198
6199

6200
6201
6202
6203
6204
6205
6206

6192
6193
6194
6195
6196
6197
6198

6199
6200
6201
6202
6203
6204
6205
6206








-
+








	switch (type1) {
	case TCL_NUMBER_NAN:
	    /* -NaN => NaN */
	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	case TCL_NUMBER_WIDE:
	    w1 = *((const Tcl_WideInt *) ptr1);
	    if (w1 != LLONG_MIN) {
	    if (w1 != WIDE_MIN) {
		if (Tcl_IsShared(valuePtr)) {
		    TclNewIntObj(objResultPtr, -w1);
		    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 1, 1);
		}
		TclSetIntObj(valuePtr, -w1);
		TRACE_APPEND(("%s\n", O2S(valuePtr)));
︙
8666
8667
8668
8669
8670
8671
8672
8673

8674
8675
8676

8677
8678
8679
8680
8681
8682
8683

8666
8667
8668
8669
8670
8671
8672

8673
8674
8675

8676
8677
8678
8679
8680
8681
8682
8683








-
+


-
+









	    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
︙
8772
8773
8774
8775
8776
8777
8778
8779

8780
8781
8782
8783
8784
8785
8786

8772
8773
8774
8775
8776
8777
8778

8779
8780
8781
8782
8783
8784
8785
8786








-
+








	BIG_RESULT(&big);
    case INST_UMINUS:
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    DOUBLE_RESULT(-(*((const double *) ptr)));
	case TCL_NUMBER_WIDE:
	    w = *((const Tcl_WideInt *) ptr);
	    if (w != LLONG_MIN) {
	    if (w != WIDE_MIN) {
		WIDE_RESULT(-w);
	    }
	    TclInitBignumFromWideInt(&big, w);
	    break;
	default:
	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
	}
︙
8858
8859
8860
8861
8862
8863
8864
8865

8866
8867
8868

8869
8870
8871
8872
8873
8874
8875

8858
8859
8860
8861
8862
8863
8864

8865
8866
8867

8868
8869
8870
8871
8872
8873
8874
8875








-
+


-
+








	     *	  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)LLONG_MIN) {
	    if (d2 < (double)WIDE_MIN) {
		return MP_GT;
	    }
	    if (d2 > (double)LLONG_MAX) {
	    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)) {
︙
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

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








-
+


-
+









-
+








	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;
	case TCL_NUMBER_BIG:
	    if (TclIsInfinite(d1)) {
		return (d1 > 0.0) ? MP_GT : MP_LT;
	    }
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if ((d1 < (double)LLONG_MAX) && (d1 > (double)LLONG_MIN)) {
	    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;
︙
8937
8938
8939
8940
8941
8942
8943
8944

8945
8946
8947
8948
8949
8950
8951

8937
8938
8939
8940
8941
8942
8943

8944
8945
8946
8947
8948
8949
8950
8951








-
+








	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)LLONG_MAX) && (d2 > (double)LLONG_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);
︙
Changes to generic/tclPort.h.
︙
20
21
22
23
24
25
26

27

28
29
30

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"

#define UWIDE_MAX ((Tcl_WideUInt)-1)
#define WIDE_MAX ((Tcl_WideInt)((~(Tcl_WideUInt)0) >> 1))
#define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1))
#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1))

#endif /* _TCLPORT */
Changes to generic/tclScan.c.
︙
922
923
924
925
926
927
928
929

930
931

932
933
934
935
936
937
938

922
923
924
925
926
927
928

929
930

931
932
933
934
935
936
937
938








-
+

-
+








	    string = end;
	    if (flags & SCAN_SUPPRESS) {
		Tcl_DecrRefCount(objPtr);
		break;
	    }
	    if (flags & SCAN_LONGER) {
		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
		    wideValue = LLONG_MAX;
		    wideValue = WIDE_MAX;
		    if (TclGetString(objPtr)[0] == '-') {
			wideValue = LLONG_MIN;
			wideValue = WIDE_MIN;
		    }
		}
		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
			    (Tcl_WideUInt)wideValue);
		    Tcl_SetStringObj(objPtr, buf, -1);
		} else {
︙
This page was generated in about 0.066s by Fossil 2.26 [1205ec86cb] 2025-04-30 16:57:32