Tcl Source Code

Check-in [abfe208bbd]
Login

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

Overview
Comment:Merge 8.7. All calls using MP_WUR handled now.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | no-wur
Files: files | file ages | folders
SHA3-256: abfe208bbdca77e76739091f906697375b0d877776a87cfab48ba054b1768f58
User & Date: jan.nijtmans 2020-01-22 09:26:00
Context
2020-01-23
10:33
Add error-handling to all libtommath function calls. Most likely not perfect (open for further impro... check-in: 40c22004df user: jan.nijtmans tags: core-8-branch
2020-01-22
09:26
Merge 8.7. All calls using MP_WUR handled now. Closed-Leaf check-in: abfe208bbd user: jan.nijtmans tags: no-wur
2020-01-21
22:00
Implement TIP 543 check-in: 7f045bde78 user: dgp tags: core-8-branch
16:05
Merge 8.7, more WIP check-in: 77a1c10c7b user: jan.nijtmans tags: no-wur
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/TraceVar.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1989-1993 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 Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, Tcl_VarTraceInfo2 \- monitor accesses to a variable
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1989-1993 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 Tcl_TraceVar 3 8.7 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, Tcl_VarTraceInfo2 \- monitor accesses to a variable
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
\fBTCL_TRACE_WRITES\fR
Invoke \fIproc\fR whenever an attempt is made to modify the variable.
.TP
\fBTCL_TRACE_UNSETS\fR
Invoke \fIproc\fR whenever the variable is unset.
A variable may be unset either explicitly by an \fBunset\fR command,
or implicitly when a procedure returns (its local variables are
automatically unset) or when the interpreter is deleted (all
variables are automatically unset).
.TP
\fBTCL_TRACE_ARRAY\fR
Invoke \fIproc\fR whenever the array command is invoked.
This gives the trace procedure a chance to update the array before
array names or array get is called.  Note that this is called
before an array set, but that will trigger write traces.







|







91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
\fBTCL_TRACE_WRITES\fR
Invoke \fIproc\fR whenever an attempt is made to modify the variable.
.TP
\fBTCL_TRACE_UNSETS\fR
Invoke \fIproc\fR whenever the variable is unset.
A variable may be unset either explicitly by an \fBunset\fR command,
or implicitly when a procedure returns (its local variables are
automatically unset) or when the interpreter or namespace is deleted (all
variables are automatically unset).
.TP
\fBTCL_TRACE_ARRAY\fR
Invoke \fIproc\fR whenever the array command is invoked.
This gives the trace procedure a chance to update the array before
array names or array get is called.  Note that this is called
before an array set, but that will trigger write traces.
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
procedure call:  the trace procedure will need to pass this flag
back to variable-related procedures like \fBTcl_GetVar\fR if it
attempts to access the variable.
The bit \fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is
about to be destroyed;  this information may be useful to \fIproc\fR
so that it can clean up its own internal data structures (see
the section \fBTCL_TRACE_DESTROYED\fR below for more details).
Lastly, the bit \fBTCL_INTERP_DESTROYED\fR will be set if the entire
interpreter is being destroyed.
When this bit is set, \fIproc\fR must be especially careful in
the things it does (see the section \fBTCL_INTERP_DESTROYED\fR below).
The trace procedure's return value should normally be NULL;  see
\fBERROR RETURNS\fR below for information on other possibilities.
.PP
\fBTcl_UntraceVar\fR may be used to remove a trace.
If the variable specified by \fIinterp\fR, \fIvarName\fR, and \fIflags\fR
has a trace set with \fIflags\fR, \fIproc\fR, and
\fIclientData\fR, then the corresponding trace is removed.







<
<
<
<







156
157
158
159
160
161
162




163
164
165
166
167
168
169
procedure call:  the trace procedure will need to pass this flag
back to variable-related procedures like \fBTcl_GetVar\fR if it
attempts to access the variable.
The bit \fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is
about to be destroyed;  this information may be useful to \fIproc\fR
so that it can clean up its own internal data structures (see
the section \fBTCL_TRACE_DESTROYED\fR below for more details).




The trace procedure's return value should normally be NULL;  see
\fBERROR RETURNS\fR below for information on other possibilities.
.PP
\fBTcl_UntraceVar\fR may be used to remove a trace.
If the variable specified by \fIinterp\fR, \fIvarName\fR, and \fIflags\fR
has a trace set with \fIflags\fR, \fIproc\fR, and
\fIclientData\fR, then the corresponding trace is removed.
326
327
328
329
330
331
332









333
334
335
336
337
338
339
.PP
The return value from \fIproc\fR is only used during read and
write tracing.
During unset traces, the return value is ignored and all relevant
trace procedures will always be invoked.
.SH "RESTRICTIONS"
.PP









A trace procedure can be called at any time, even when there
are partially formed results stored in the interpreter.  If
the trace procedure does anything that could damage this result (such
as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR
and related routines to save and restore the original state of
the interpreter before it returns.
.SH "UNDEFINED VARIABLES"







>
>
>
>
>
>
>
>
>







322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
.PP
The return value from \fIproc\fR is only used during read and
write tracing.
During unset traces, the return value is ignored and all relevant
trace procedures will always be invoked.
.SH "RESTRICTIONS"
.PP
Because operations on variables may take place as part of the deletion
of the interp that contains them, \fIproc\fR must be careful about checking
what the \fIinterp\fR parameter can be used to do.
The routine \fBTcl_InterpDeleted\fR is an important tool for this.
When \fBTcl_InterpDeleted\fR returns 1, \fIproc\fR will not be able
to invoke any scripts in \fIinterp\fR. You may encounter old code using
a deprecated flag value \fBTCL_INTERP_DESTROYED\fR to signal this
condition, but any supported code should be converted to stop using it.
.PP
A trace procedure can be called at any time, even when there
are partially formed results stored in the interpreter.  If
the trace procedure does anything that could damage this result (such
as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR
and related routines to save and restore the original state of
the interpreter before it returns.
.SH "UNDEFINED VARIABLES"
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
In an unset callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit
is set in \fIflags\fR if the trace is being removed as part
of the deletion.
Traces on a variable are always removed whenever the variable
is deleted;  the only time \fBTCL_TRACE_DESTROYED\fR is not set is for
a whole-array trace invoked when only a single element of an
array is unset.
.SH "TCL_INTERP_DESTROYED"
.PP
When an interpreter is destroyed, unset traces are called for
all of its variables.
The \fBTCL_INTERP_DESTROYED\fR bit will be set in the \fIflags\fR
argument passed to the trace procedures.
Trace procedures must be extremely careful in what they do if
the \fBTCL_INTERP_DESTROYED\fR bit is set.
It is not safe for the procedures to invoke any Tcl procedures
on the interpreter, since its state is partially deleted.
All that trace procedures should do under these circumstances is
to clean up and free their own internal data structures.
.SH BUGS
.PP
Tcl does not do any error checking to prevent trace procedures
from misusing the interpreter during traces with \fBTCL_INTERP_DESTROYED\fR
set.
.PP
Array traces are not yet integrated with the Tcl \fBinfo exists\fR command,
nor is there Tcl-level access to array traces.
.SH "SEE ALSO"
trace(n)
.SH KEYWORDS
clientData, trace, variable







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


<
<
<
<






355
356
357
358
359
360
361












362
363




364
365
366
367
368
369
In an unset callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit
is set in \fIflags\fR if the trace is being removed as part
of the deletion.
Traces on a variable are always removed whenever the variable
is deleted;  the only time \fBTCL_TRACE_DESTROYED\fR is not set is for
a whole-array trace invoked when only a single element of an
array is unset.












.SH BUGS
.PP




Array traces are not yet integrated with the Tcl \fBinfo exists\fR command,
nor is there Tcl-level access to array traces.
.SH "SEE ALSO"
trace(n)
.SH KEYWORDS
clientData, trace, variable

Changes to generic/tcl.h.

1027
1028
1029
1030
1031
1032
1033


1034


1035
1036
1037
1038
1039
1040
1041
#define TCL_NAMESPACE_ONLY	 2
#define TCL_APPEND_VALUE	 4
#define TCL_LIST_ELEMENT	 8
#define TCL_TRACE_READS		 0x10
#define TCL_TRACE_WRITES	 0x20
#define TCL_TRACE_UNSETS	 0x40
#define TCL_TRACE_DESTROYED	 0x80


#define TCL_INTERP_DESTROYED	 0x100


#define TCL_LEAVE_ERR_MSG	 0x200
#define TCL_TRACE_ARRAY		 0x800
#ifndef TCL_REMOVE_OBSOLETE_TRACES
/* Required to support old variable/vdelete/vinfo traces. */
#define TCL_TRACE_OLD_STYLE	 0x1000
#endif
/* Indicate the semantics of the result of a trace. */







>
>

>
>







1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
#define TCL_NAMESPACE_ONLY	 2
#define TCL_APPEND_VALUE	 4
#define TCL_LIST_ELEMENT	 8
#define TCL_TRACE_READS		 0x10
#define TCL_TRACE_WRITES	 0x20
#define TCL_TRACE_UNSETS	 0x40
#define TCL_TRACE_DESTROYED	 0x80

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TCL_INTERP_DESTROYED	 0x100
#endif

#define TCL_LEAVE_ERR_MSG	 0x200
#define TCL_TRACE_ARRAY		 0x800
#ifndef TCL_REMOVE_OBSOLETE_TRACES
/* Required to support old variable/vdelete/vinfo traces. */
#define TCL_TRACE_OLD_STYLE	 0x1000
#endif
/* Indicate the semantics of the result of a trace. */

Changes to generic/tclStrToD.c.

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
    char *retval = ckalloc(len + 1);
				/* Output buffer. */
    mp_int b;			/* Numerator of the fraction being
				 * converted. */
    mp_digit digit;		/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Index in the output buffer. */


    /*
     * b = bw * 2**b2 * 5**b5
     */

    mp_init_u64(&b, bw);


    MulPow5(&b, b5, &b);

    mp_mul_2d(&b, b2, &b);


    /*
     * Adjust if the logarithm was guessed wrong.
     */

    if (b.used <= sd) {
	mp_mul_d(&b, 10, &b);
	ilim = ilim1;
	--k;
    }

    /*
     * Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT)
     * by mp_digit extraction.
     */

    i = 1;
    for (;;) {
	if (b.used <= sd) {
	    digit = 0;
	} else {
	    digit = b.dp[sd];
	    if (b.used > sd+1 || digit >= 10) {
		Tcl_Panic("wrong digit!");
	    }







>





|
>
>
|
>
|
>





|
|










|







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
    char *retval = ckalloc(len + 1);
				/* Output buffer. */
    mp_int b;			/* Numerator of the fraction being
				 * converted. */
    mp_digit digit;		/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Index in the output buffer. */
    mp_err err;

    /*
     * b = bw * 2**b2 * 5**b5
     */

    if (mp_init_u64(&b, bw) != MP_OKAY) {
	return NULL;
    }
    err = MulPow5(&b, b5, &b);
    if (err == MP_OKAY) {
	err = mp_mul_2d(&b, b2, &b);
    }

    /*
     * Adjust if the logarithm was guessed wrong.
     */

    if ((err == MP_OKAY) && (b.used <= sd)) {
	err = mp_mul_d(&b, 10, &b);
	ilim = ilim1;
	--k;
    }

    /*
     * Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT)
     * by mp_digit extraction.
     */

    i = 1;
    while (err == MP_OKAY) {
	if (b.used <= sd) {
	    digit = 0;
	} else {
	    digit = b.dp[sd];
	    if (b.used > sd+1 || digit >= 10) {
		Tcl_Panic("wrong digit!");
	    }
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
	    break;
	}

	/*
	 * Advance to the next digit.
	 */

	mp_mul_d(&b, 10, &b);
	++i;
    }

    /*
     * Endgame - store the location of the decimal point and the end of the
     * string.
     */







|







3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
	    break;
	}

	/*
	 * Advance to the next digit.
	 */

	err = mp_mul_d(&b, 10, &b);
	++i;
    }

    /*
     * Endgame - store the location of the decimal point and the end of the
     * string.
     */
3744
3745
3746
3747
3748
3749
3750
3751
3752

3753
3754
3755
3756
3757
3758
3759
    int r;
    mp_int temp;

    /*
     * Compare b and S-m: this is the same as comparing B+m and S.
     */

    mp_init(&temp);
    mp_add(b, m, &temp);

    r = mp_cmp_mag(&temp, S);
    mp_clear(&temp);
    switch(r) {
    case MP_LT:
	return 0;
    case MP_EQ:
	return isodd;







|
|
>







3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
    int r;
    mp_int temp;

    /*
     * Compare b and S-m: this is the same as comparing B+m and S.
     */

    if ((mp_init(&temp) != MP_OKAY) || (mp_add(b, m, &temp) != MP_OKAY)) {
	return 0;
    }
    r = mp_cmp_mag(&temp, S);
    mp_clear(&temp);
    switch(r) {
    case MP_LT:
	return 0;
    case MP_EQ:
	return isodd;
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
     */

    if ((retval == NULL) || (mp_init_u64(&b, bw) != MP_OKAY)) {
	return NULL;
    }
    err = mp_mul_2d(&b, b2, &b);
    if (err == MP_OKAY) {
	mp_init_set(&S, 1);
    }
    if (err == MP_OKAY) {
	MulPow5(&S, s5, &S);
    }
    if (err == MP_OKAY) {
	mp_mul_2d(&S, s2, &S);
    }

    /*
     * Handle the case where we guess the position of the decimal point wrong.
     */

    if ((err == MP_OKAY) && (mp_cmp_mag(&b, &S) == MP_LT)) {
	err = mp_mul_d(&b, 10, &b);
	minit = 10;
	ilim =ilim1;
	--k;
    }

    /*
     * mminus = 2**m2minus * 5**m5
     */


    mp_init_set(&mminus, minit);


    mp_mul_2d(&mminus, m2minus, &mminus);

    if (m2plus > m2minus) {
	mp_init_copy(&mplus, &mminus);

	mp_mul_2d(&mplus, m2plus-m2minus, &mplus);

    }

    /*
     * Loop through the digits.
     */


    mp_init(&dig);

    i = 1;
    for (;;) {
	mp_div(&b, &S, &dig, &b);
	if (dig.used > 1 || dig.dp[0] >= 10) {
	    Tcl_Panic("wrong digit!");
	}
	digit = dig.dp[0];

	/*
	 * Does the current digit leave us with a remainder small enough to
	 * round to it?
	 */

	r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus);
	if (r1 == MP_LT || (r1 == MP_EQ && (dPtr->w.word1 & 1) == 0)) {
	    mp_mul_2d(&b, 1, &b);
	    if (ShouldBankerRoundUp(&b, &S, digit&1)) {
		++digit;
		if (digit == 10) {
		    *s++ = '9';
		    s = BumpUp(s, retval, &k);
		    break;
		}







|


|


|

















>
|
>
>
|
>
|
|
>
|
>






>
|
>

|
|












|







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

    if ((retval == NULL) || (mp_init_u64(&b, bw) != MP_OKAY)) {
	return NULL;
    }
    err = mp_mul_2d(&b, b2, &b);
    if (err == MP_OKAY) {
	err = mp_init_set(&S, 1);
    }
    if (err == MP_OKAY) {
	err = MulPow5(&S, s5, &S);
    }
    if (err == MP_OKAY) {
	err = mp_mul_2d(&S, s2, &S);
    }

    /*
     * Handle the case where we guess the position of the decimal point wrong.
     */

    if ((err == MP_OKAY) && (mp_cmp_mag(&b, &S) == MP_LT)) {
	err = mp_mul_d(&b, 10, &b);
	minit = 10;
	ilim =ilim1;
	--k;
    }

    /*
     * mminus = 2**m2minus * 5**m5
     */

    if (err == MP_OKAY) {
	err = mp_init_set(&mminus, minit);
    }
    if (err == MP_OKAY) {
	err = mp_mul_2d(&mminus, m2minus, &mminus);
    }
    if ((err == MP_OKAY) && (m2plus > m2minus)) {
	err = mp_init_copy(&mplus, &mminus);
	if (err == MP_OKAY) {
	    err = mp_mul_2d(&mplus, m2plus-m2minus, &mplus);
	}
    }

    /*
     * Loop through the digits.
     */

    if (err == MP_OKAY) {
	err = mp_init(&dig);
    }
    i = 1;
    while (err == MP_OKAY) {
	err = mp_div(&b, &S, &dig, &b);
	if (dig.used > 1 || dig.dp[0] >= 10) {
	    Tcl_Panic("wrong digit!");
	}
	digit = dig.dp[0];

	/*
	 * Does the current digit leave us with a remainder small enough to
	 * round to it?
	 */

	r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus);
	if (r1 == MP_LT || (r1 == MP_EQ && (dPtr->w.word1 & 1) == 0)) {
	    err = mp_mul_2d(&b, 1, &b);
	    if (ShouldBankerRoundUp(&b, &S, digit&1)) {
		++digit;
		if (digit == 10) {
		    *s++ = '9';
		    s = BumpUp(s, retval, &k);
		    break;
		}
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
	}

	/*
	 * Have we converted all the requested digits?
	 */

	*s++ = '0' + digit;
	if (i == ilim) {
	    mp_mul_2d(&b, 1, &b);
	    if (ShouldBankerRoundUp(&b, &S, digit&1)) {
		s = BumpUp(s, retval, &k);
	    }
	    break;
	}

	/*
	 * Advance to the next digit.
	 */

	if (s5 > 0) {
	    /*
	     * Can possibly shorten the denominator.
	     */

	    mp_mul_2d(&b, 1, &b);

	    mp_mul_2d(&mminus, 1, &mminus);

	    if (m2plus > m2minus) {
		mp_mul_2d(&mplus, 1, &mplus);
	    }

	    mp_div_d(&S, 5, &S, NULL);

	    --s5;

	    /*
	     * IDEA: It might possibly be a win to fall back to int64_t
	     *       arithmetic here if S < 2**64/10. But it's a win only for
	     *       a fairly narrow range of magnitudes so perhaps not worth
	     *       bothering.  We already know that we shorten the







|
|










|




|
>
|
>
|
|

>
|
>







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
	}

	/*
	 * Have we converted all the requested digits?
	 */

	*s++ = '0' + digit;
	if ((err == MP_OKAY) && (i == ilim)) {
	    err = mp_mul_2d(&b, 1, &b);
	    if (ShouldBankerRoundUp(&b, &S, digit&1)) {
		s = BumpUp(s, retval, &k);
	    }
	    break;
	}

	/*
	 * Advance to the next digit.
	 */

	if ((err == MP_OKAY) && (s5 > 0)) {
	    /*
	     * Can possibly shorten the denominator.
	     */

	    err = mp_mul_2d(&b, 1, &b);
	    if (err == MP_OKAY) {
		err = mp_mul_2d(&mminus, 1, &mminus);
	    }
	    if ((err == MP_OKAY) && (m2plus > m2minus)) {
		err = mp_mul_2d(&mplus, 1, &mplus);
	    }
	    if (err == MP_OKAY) {
		err = mp_div_d(&S, 5, &S, NULL);
	    }
	    --s5;

	    /*
	     * IDEA: It might possibly be a win to fall back to int64_t
	     *       arithmetic here if S < 2**64/10. But it's a win only for
	     *       a fairly narrow range of magnitudes so perhaps not worth
	     *       bothering.  We already know that we shorten the
3954
3955
3956
3957
3958
3959
3960
3961
3962

3963

3964
3965
3966
3967
3968
3969
3970
3971
3972
	     * 10**38  12 trips
	     * 10**39  13 trips
	     * 10**40  14 trips
	     * 10**41  15 trips
	     * 10**42  16 trips
	     * thereafter no gain.
	     */
	} else {
	    mp_mul_d(&b, 10, &b);

	    mp_mul_d(&mminus, 10, &mminus);

	    if (m2plus > m2minus) {
		mp_mul_2d(&mplus, 10, &mplus);
	    }
	}

	++i;
    }

    /*







|
|
>
|
>
|
|







3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
	     * 10**38  12 trips
	     * 10**39  13 trips
	     * 10**40  14 trips
	     * 10**41  15 trips
	     * 10**42  16 trips
	     * thereafter no gain.
	     */
	} else if (err == MP_OKAY) {
	    err = mp_mul_d(&b, 10, &b);
	    if (err == MP_OKAY) {
		err = mp_mul_d(&mminus, 10, &mminus);
	    }
	    if ((err == MP_OKAY) && (m2plus > m2minus)) {
		err = mp_mul_2d(&mplus, 10, &mplus);
	    }
	}

	++i;
    }

    /*
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
    char *s = retval;		/* Cursor in the return value. */
    mp_int b;			/* Numerator of the result. */
    mp_int S;			/* Denominator of the result. */
    mp_int dig;			/* Current digit of the result. */
    int digit;			/* Current digit of the result. */
    int g;			/* Size of the current digit ground. */
    int i, j;


    /*
     * b = bw * 2**b2 * 5**b5
     * S = 2**s2 * 5*s5
     */

    mp_init(&dig);


    mp_init_u64(&b, bw);



    mp_mul_2d(&b, b2, &b);

    mp_init_set(&S, 1);




    MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);



    /*
     * Handle the case where we guess the position of the decimal point wrong.
     */

    if ((mp_cmp_mag(&b, &S) == MP_LT) && (mp_mul_d(&b, 10, &b) == MP_OKAY)) {
	ilim =ilim1;
	--k;
    }

    /*
     * Convert the leading digit.
     */

    i = 0;
    mp_div(&b, &S, &dig, &b);
    if (dig.used > 1 || dig.dp[0] >= 10) {
	Tcl_Panic("wrong digit!");
    }
    digit = dig.dp[0];

    /*
     * Is a single digit all that was requested?
     */

    *s++ = '0' + digit;
    if (++i >= ilim) {
	if ((mp_mul_2d(&b, 1, &b) == MP_OKAY) && ShouldBankerRoundUp(&b, &S, digit&1)) {
	    s = BumpUp(s, retval, &k);
	}
    } else {
	for (;;) {
	    /*
	     * Shift by a group of digits.
	     */

	    g = ilim - i;
	    if (g > DIGIT_GROUP) {
		g = DIGIT_GROUP;
	    }
	    if (s5 >= g) {
		mp_div_d(&S, dpow5[g], &S, NULL);
		s5 -= g;
	    } else if (s5 > 0) {
		mp_div_d(&S, dpow5[s5], &S, NULL);

		mp_mul_d(&b, dpow5[g - s5], &b);

		s5 = 0;
	    } else {
		mp_mul_d(&b, dpow5[g], &b);
	    }

	    mp_mul_2d(&b, g, &b);


	    /*
	     * As with the shortening bignum conversion, it's possible at this
	     * point that we will have reduced the denominator to less than
	     * 2**64/10, at which point it would be possible to fall back to
	     * to int64_t arithmetic. But the potential payoff is tremendously
	     * less - unless we're working in F format - because we know that
	     * three groups of digits will always suffice for %#.17e, the
	     * longest format that doesn't introduce empty precision.
	     *
	     * Extract the next group of digits.
	     */


	    if ((mp_div(&b, &S, &dig, &b) != MP_OKAY) || (dig.used > 1)) {
		Tcl_Panic("wrong digit!");
	    }
	    digit = dig.dp[0];
	    for (j = g-1; j >= 0; --j) {
		int t = itens[j];

		*s++ = digit / t + '0';







>






|
>
>
|
>
>
>
|
>
|
>
>
>
>
|
>
>















|















|









|


|
>
|
>


|

>
|
>














|







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
    char *s = retval;		/* Cursor in the return value. */
    mp_int b;			/* Numerator of the result. */
    mp_int S;			/* Denominator of the result. */
    mp_int dig;			/* Current digit of the result. */
    int digit;			/* Current digit of the result. */
    int g;			/* Size of the current digit ground. */
    int i, j;
    mp_err err;

    /*
     * b = bw * 2**b2 * 5**b5
     * S = 2**s2 * 5*s5
     */

    if (mp_init(&dig) != MP_OKAY) {
	return NULL;
    }
    if (mp_init_u64(&b, bw) != MP_OKAY) {
	mp_clear(&dig);
	return NULL;
    }
    err = mp_mul_2d(&b, b2, &b);
    if (err == MP_OKAY) {
 	err = mp_init_set(&S, 1);
    }
    if (err == MP_OKAY) {
	err = MulPow5(&S, s5, &S);
	if (err == MP_OKAY) {
	    err = mp_mul_2d(&S, s2, &S);
	}
    }

    /*
     * Handle the case where we guess the position of the decimal point wrong.
     */

    if ((mp_cmp_mag(&b, &S) == MP_LT) && (mp_mul_d(&b, 10, &b) == MP_OKAY)) {
	ilim =ilim1;
	--k;
    }

    /*
     * Convert the leading digit.
     */

    i = 0;
    err = mp_div(&b, &S, &dig, &b);
    if (dig.used > 1 || dig.dp[0] >= 10) {
	Tcl_Panic("wrong digit!");
    }
    digit = dig.dp[0];

    /*
     * Is a single digit all that was requested?
     */

    *s++ = '0' + digit;
    if (++i >= ilim) {
	if ((mp_mul_2d(&b, 1, &b) == MP_OKAY) && ShouldBankerRoundUp(&b, &S, digit&1)) {
	    s = BumpUp(s, retval, &k);
	}
    } else {
	while (err == MP_OKAY) {
	    /*
	     * Shift by a group of digits.
	     */

	    g = ilim - i;
	    if (g > DIGIT_GROUP) {
		g = DIGIT_GROUP;
	    }
	    if (s5 >= g) {
		err = mp_div_d(&S, dpow5[g], &S, NULL);
		s5 -= g;
	    } else if (s5 > 0) {
		err = mp_div_d(&S, dpow5[s5], &S, NULL);
		if (err == MP_OKAY) {
		    err = mp_mul_d(&b, dpow5[g - s5], &b);
		}
		s5 = 0;
	    } else {
		err = mp_mul_d(&b, dpow5[g], &b);
	    }
	    if (err == MP_OKAY) {
		err = mp_mul_2d(&b, g, &b);
	    }

	    /*
	     * As with the shortening bignum conversion, it's possible at this
	     * point that we will have reduced the denominator to less than
	     * 2**64/10, at which point it would be possible to fall back to
	     * to int64_t arithmetic. But the potential payoff is tremendously
	     * less - unless we're working in F format - because we know that
	     * three groups of digits will always suffice for %#.17e, the
	     * longest format that doesn't introduce empty precision.
	     *
	     * Extract the next group of digits.
	     */


	    if ((err != MP_OKAY) || (mp_div(&b, &S, &dig, &b) != MP_OKAY) || (dig.used > 1)) {
		Tcl_Panic("wrong digit!");
	    }
	    digit = dig.dp[0];
	    for (j = g-1; j >= 0; --j) {
		int t = itens[j];

		*s++ = digit / t + '0';

Changes to generic/tclTrace.c.

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
 * TCL_TRACE_ANY_EXEC		- OR'd combination of all EXEC flags.
 * TCL_TRACE_EXEC_IN_PROGRESS   - The callback function on this trace is
 *				  currently executing. Therefore we don't let
 *				  further traces execute.
 * TCL_TRACE_EXEC_DIRECT	- This execution trace is triggered directly
 *				  by the command being traced, not because of
 *				  an internal trace.
 * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also be used
 * in command execution traces.
 */

#define TCL_TRACE_ENTER_DURING_EXEC	4
#define TCL_TRACE_LEAVE_DURING_EXEC	8
#define TCL_TRACE_ANY_EXEC		15
#define TCL_TRACE_EXEC_IN_PROGRESS	0x10
#define TCL_TRACE_EXEC_DIRECT		0x20







<
|







75
76
77
78
79
80
81

82
83
84
85
86
87
88
89
 * TCL_TRACE_ANY_EXEC		- OR'd combination of all EXEC flags.
 * TCL_TRACE_EXEC_IN_PROGRESS   - The callback function on this trace is
 *				  currently executing. Therefore we don't let
 *				  further traces execute.
 * TCL_TRACE_EXEC_DIRECT	- This execution trace is triggered directly
 *				  by the command being traced, not because of
 *				  an internal trace.

 * The flag 'TCL_TRACE_DESTROYED' may also be used in command execution traces.
 */

#define TCL_TRACE_ENTER_DURING_EXEC	4
#define TCL_TRACE_LEAVE_DURING_EXEC	8
#define TCL_TRACE_ANY_EXEC		15
#define TCL_TRACE_EXEC_IN_PROGRESS	0x10
#define TCL_TRACE_EXEC_DIRECT		0x20
2561
2562
2563
2564
2565
2566
2567



2568
2569
2570
2571
2572
2573
2574
    part1 = TclGetString(part1Ptr);
    part2 = part2Ptr? TclGetString(part2Ptr) : NULL;

    return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags,
	    leaveErrMsg);
}




int
TclCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    Var *arrayPtr,	/* Pointer to array variable that contains the
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */







>
>
>







2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
    part1 = TclGetString(part1Ptr);
    part2 = part2Ptr? TclGetString(part2Ptr) : NULL;

    return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags,
	    leaveErrMsg);
}

#undef TCL_INTERP_DESTROYED
#define TCL_INTERP_DESTROYED     0x100

int
TclCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    Var *arrayPtr,	/* Pointer to array variable that contains the
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */

Changes to unix/Makefile.in.

278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
#--------------------------------------------------------------------------

STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
	${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
	${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \
	@EXTRA_CC_SWITCHES@

CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT -DMP_WUR=

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@







|







278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
#--------------------------------------------------------------------------

STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
	${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
	${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \
	@EXTRA_CC_SWITCHES@

CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT

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@

Changes to win/Makefile.in.

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
CFLAGS_OPTIMIZE	= @CFLAGS_OPTIMIZE@

# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS = 		$(CFLAGS_DEBUG)
#CFLAGS = 		$(CFLAGS_OPTIMIZE)
#CFLAGS = 		$(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS = 		@CFLAGS@ @CFLAGS_DEFAULT@ -D_ATL_XP_TARGETING -DMP_FIXED_CUTOFFS -DMP_NO_STDINT -DMP_WUR=

# To compile without backward compatibility and deprecated code uncomment the
# following
NO_DEPRECATED_FLAGS	=
#NO_DEPRECATED_FLAGS	= -DTCL_NO_DEPRECATED

# To enable compilation debugging reverse the comment characters on one of the







|







78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
CFLAGS_OPTIMIZE	= @CFLAGS_OPTIMIZE@

# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS = 		$(CFLAGS_DEBUG)
#CFLAGS = 		$(CFLAGS_OPTIMIZE)
#CFLAGS = 		$(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS = 		@CFLAGS@ @CFLAGS_DEFAULT@ -D_ATL_XP_TARGETING -DMP_FIXED_CUTOFFS -DMP_NO_STDINT

# To compile without backward compatibility and deprecated code uncomment the
# following
NO_DEPRECATED_FLAGS	=
#NO_DEPRECATED_FLAGS	= -DTCL_NO_DEPRECATED

# To enable compilation debugging reverse the comment characters on one of the

Changes to win/makefile.vc.

435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
### the left side of implicit rules.
TOMMATHDIR	= $(ROOT)\libtommath
PKGSDIR		= $(ROOT)\pkgs

# Additional include and C macro definitions for the implicit rules
# defined in rules.vc
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 /DMP_FIXED_CUTOFFS /DMP_WUR=

# Additional Link libraries needed beyond those in rules.vc
PRJ_LIBS   = netapi32.lib user32.lib userenv.lib ws2_32.lib

#---------------------------------------------------------------------
# TclTest flags
#---------------------------------------------------------------------







|







435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
### the left side of implicit rules.
TOMMATHDIR	= $(ROOT)\libtommath
PKGSDIR		= $(ROOT)\pkgs

# Additional include and C macro definitions for the implicit rules
# defined in rules.vc
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 /DMP_FIXED_CUTOFFS

# Additional Link libraries needed beyond those in rules.vc
PRJ_LIBS   = netapi32.lib user32.lib userenv.lib ws2_32.lib

#---------------------------------------------------------------------
# TclTest flags
#---------------------------------------------------------------------