Tcl Source Code

Check-in [c8a7a0b2d8]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Merge 8.7
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:c8a7a0b2d84c9b536274410b7efd4873e99a1dd01d1356e74131bc5200b795a9
User & Date: jan.nijtmans 2019-04-11 20:38:42
Context
2019-04-19
00:38
merge 8.7 check-in: ddaa30125b user: dkf tags: trunk
2019-04-11
20:38
Merge 8.7 check-in: c8a7a0b2d8 user: jan.nijtmans tags: trunk
20:37
Merge 8.6 check-in: 2a6c012bff user: jan.nijtmans tags: core-8-branch
12:53
merge 8.7 check-in: 436735f3af user: sebres tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclExecute.c.

5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
....
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
	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;
	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the WIDE_MIN to WIDE_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_INT;
	    }
	}
	TclNewIntObj(objResultPtr, type1);
	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
	NEXT_INST_F(1, 1, 1);

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

		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
		WIDE_RESULT(wResult);
	    }
	}

    overflowExpon:

	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	if ((big2.used > 1)
#if DIGIT_BIT > 28
		|| ((big2.used == 1) && (big2.dp[0] >= (1<<28)))
#endif
	) {
	    mp_clear(&big2);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	mp_init(&bigResult);
	mp_expt_d_ex(&big1, big2.dp[0], &bigResult, 1);
	mp_clear(&big1);
	mp_clear(&big2);
	BIG_RESULT(&bigResult);
    }

    case INST_ADD:
    case INST_SUB:
    case INST_MULT:
    case INST_DIV:






|







 







>
|
<
|
|
<
<
<






|

<







5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
....
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
	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;
	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
	    /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
	    Tcl_WideInt w;

	    if (TclGetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_INT;
	    }
	}
	TclNewIntObj(objResultPtr, type1);
	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
	NEXT_INST_F(1, 1, 1);

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

		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
		WIDE_RESULT(wResult);
	    }
	}

    overflowExpon:

	if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)

		|| (value2Ptr->typePtr != &tclIntType)
		|| (Tcl_WideUInt)w2 >= (1<<28)) {



	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	mp_init(&bigResult);
	mp_expt_d_ex(&big1, w2, &bigResult, 1);
	mp_clear(&big1);

	BIG_RESULT(&bigResult);
    }

    case INST_ADD:
    case INST_SUB:
    case INST_MULT:
    case INST_DIV:

Changes to generic/tclTomMathInterface.c.

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
...
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
 */

void
TclInitBignumFromWideInt(
    mp_int *a,			/* Bignum to initialize */
    Tcl_WideInt v)		/* Initial value */
{
	if (mp_init_size(a, (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
		Tcl_Panic("initialization failure in TclInitBignumFromWideInt");
	}
    if (v < (Tcl_WideInt)0) {
	mp_set_long_long(a, (Tcl_WideUInt)(-v));
	mp_neg(a, a);
    } else {
	mp_set_long_long(a, (Tcl_WideUInt)v);
................................................................................
 */

void
TclInitBignumFromWideUInt(
    mp_int *a,			/* Bignum to initialize */
    Tcl_WideUInt v)		/* Initial value */
{
	if (mp_init_size(a, (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
	    Tcl_Panic("initialization failure in TclInitBignumFromWideUInt");
	}
	mp_set_long_long(a, v);
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






|







 







|












107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
...
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
 */

void
TclInitBignumFromWideInt(
    mp_int *a,			/* Bignum to initialize */
    Tcl_WideInt v)		/* Initial value */
{
	if (mp_init(a) != MP_OKAY) {
		Tcl_Panic("initialization failure in TclInitBignumFromWideInt");
	}
    if (v < (Tcl_WideInt)0) {
	mp_set_long_long(a, (Tcl_WideUInt)(-v));
	mp_neg(a, a);
    } else {
	mp_set_long_long(a, (Tcl_WideUInt)v);
................................................................................
 */

void
TclInitBignumFromWideUInt(
    mp_int *a,			/* Bignum to initialize */
    Tcl_WideUInt v)		/* Initial value */
{
	if (mp_init(a) != MP_OKAY) {
	    Tcl_Panic("initialization failure in TclInitBignumFromWideUInt");
	}
	mp_set_long_long(a, v);
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to libtommath/bn_mp_set_double.c.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 *
 * SPDX-License-Identifier: Unlicense
 */

#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
int mp_set_double(mp_int *a, double b)
{
   uint64_t frac;
   int exp, res;
   union {
      double   dbl;
      uint64_t bits;
   } cast;
   cast.dbl = b;

   exp = (int)((unsigned)(cast.bits >> 52) & 0x7FFU);
   frac = (cast.bits & ((1ULL << 52) - 1ULL)) | (1ULL << 52);

   if (exp == 0x7FF) { /* +-inf, NaN */






|



|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 *
 * SPDX-License-Identifier: Unlicense
 */

#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
int mp_set_double(mp_int *a, double b)
{
   unsigned long long frac;
   int exp, res;
   union {
      double   dbl;
      unsigned long long bits;
   } cast;
   cast.dbl = b;

   exp = (int)((unsigned)(cast.bits >> 52) & 0x7FFU);
   frac = (cast.bits & ((1ULL << 52) - 1ULL)) | (1ULL << 52);

   if (exp == 0x7FF) { /* +-inf, NaN */

Changes to libtommath/bn_mp_sqrt.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
..
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
..
92
93
94
95
96
97
98
99

100
101
102

103





104
105
106
107
108
109
110
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

#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;
   int i, j, k;
#ifndef NO_FLOATING_POINT

   volatile double d;
   mp_digit dig;
#endif

   /* must be positive */
   if (arg->sign == MP_NEG) {
      return MP_VAL;
................................................................................
   }

   /* easy out */
   if (mp_iszero(arg) == MP_YES) {
      mp_zero(ret);
      return MP_OKAY;
   }



   i = (arg->used / 2) - 1;
   j = 2 * i;
   if ((res = mp_init_size(&t1, i+2)) != MP_OKAY) {
      return res;
   }

................................................................................
      goto E2;
   }

   for (k = 0; k < i; ++k) {
      t1.dp[k] = (mp_digit) 0;
   }

#ifndef NO_FLOATING_POINT

   /* Estimate the square root using the hardware floating point unit. */

   d = 0.0;
   for (k = arg->used-1; k >= j; --k) {
      d = ldexp(d, DIGIT_BIT) + (double)(arg->dp[k]);
   }

................................................................................
   } else {
      t1.used = i+1;
      t1.dp[i] = ((mp_digit) d) - 1;
   }

#else

   /* Estimate the square root as having 1 in the most significant place. */


   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) {
      goto E1;
   }






>
>
>







<

>







 







>
>







 







<
<







 







|
>
|
<
<
>
|
>
>
>
>
>







10
11
12
13
14
15
16
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
..
53
54
55
56
57
58
59


60
61
62
63
64
65
66
..
95
96
97
98
99
100
101
102
103
104


105
106
107
108
109
110
111
112
113
114
115
116
117
118
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

#ifndef NO_FLOATING_POINT
#include <math.h>
#if (DIGIT_BIT != 28) || (FLT_RADIX != 2) || (DBL_MANT_DIG != 53) || (DBL_MAX_EXP != 1024)
#define NO_FLOATING_POINT
#endif
#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;

#ifndef NO_FLOATING_POINT
   int i, j, k;
   volatile double d;
   mp_digit dig;
#endif

   /* must be positive */
   if (arg->sign == MP_NEG) {
      return MP_VAL;
................................................................................
   }

   /* easy out */
   if (mp_iszero(arg) == MP_YES) {
      mp_zero(ret);
      return MP_OKAY;
   }

#ifndef NO_FLOATING_POINT

   i = (arg->used / 2) - 1;
   j = 2 * i;
   if ((res = mp_init_size(&t1, i+2)) != MP_OKAY) {
      return res;
   }

................................................................................
      goto E2;
   }

   for (k = 0; k < i; ++k) {
      t1.dp[k] = (mp_digit) 0;
   }



   /* Estimate the square root using the hardware floating point unit. */

   d = 0.0;
   for (k = arg->used-1; k >= j; --k) {
      d = ldexp(d, DIGIT_BIT) + (double)(arg->dp[k]);
   }

................................................................................
   } else {
      t1.used = i+1;
      t1.dp[i] = ((mp_digit) d) - 1;
   }

#else

   if ((res = mp_init_copy(&t1, arg)) != MP_OKAY) {
      return res;
   }



   if ((res = mp_init(&t2)) != MP_OKAY) {
      goto E2;
   }

   /* First approx. (not very bad for large arg) */
   mp_rshd(&t1, t1.used/2);

#endif

   /* t1 > 0  */
   if ((res = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) {
      goto E1;
   }