Attachment "132.patch" to
ticket [722737ffff]
added by
kennykb
2003-12-20 00:24:51.
? generic/kevin-dtoa.c
? generic/kevin_dtoa.c
? generic/y.output
? generic/y.tab.c
? generic/y.tab.h
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.100
diff -b -u -r1.100 tclDecls.h
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.67
diff -b -u -r1.67 tclInt.decls
--- generic/tclInt.decls 15 Dec 2003 00:49:38 -0000 1.67
+++ generic/tclInt.decls 19 Dec 2003 17:10:47 -0000
@@ -734,6 +734,17 @@
Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
CONST char *file, int line)
}
+
+# added for 8.5 floating point conversion
+
+declare 182 generic {
+ char* TclDToA( double d, int mode, int nDigits, \
+ int* decPt, int* signum, char** endPtr )
+}
+declare 183 generic {
+ void TclFreeDToA( char* digits )
+}
+
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
Index: generic/tclIntDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntDecls.h,v
retrieving revision 1.55
diff -b -u -r1.55 tclIntDecls.h
--- generic/tclIntDecls.h 15 Dec 2003 00:49:38 -0000 1.55
+++ generic/tclIntDecls.h 19 Dec 2003 17:10:47 -0000
@@ -957,6 +957,17 @@
EXTERN Tcl_Obj * TclDbNewListObjDirect _ANSI_ARGS_((int objc,
Tcl_Obj ** objv, CONST char * file, int line));
#endif
+#ifndef TclDToA_TCL_DECLARED
+#define TclDToA_TCL_DECLARED
+/* 182 */
+EXTERN char* TclDToA _ANSI_ARGS_((double d, int mode, int nDigits,
+ int* decPt, int* signum, char** endPtr));
+#endif
+#ifndef TclFreeDToA_TCL_DECLARED
+#define TclFreeDToA_TCL_DECLARED
+/* 183 */
+EXTERN void TclFreeDToA _ANSI_ARGS_((char* digits));
+#endif
typedef struct TclIntStubs {
int magic;
@@ -1168,6 +1179,8 @@
Tcl_Obj * (*tcl_GetStartupScript) _ANSI_ARGS_((CONST char ** encodingNamePtr)); /* 179 */
Tcl_Obj * (*tclNewListObjDirect) _ANSI_ARGS_((int objc, Tcl_Obj ** objv)); /* 180 */
Tcl_Obj * (*tclDbNewListObjDirect) _ANSI_ARGS_((int objc, Tcl_Obj ** objv, CONST char * file, int line)); /* 181 */
+ char* (*tclDToA) _ANSI_ARGS_((double d, int mode, int nDigits, int* decPt, int* signum, char** endPtr)); /* 182 */
+ void (*tclFreeDToA) _ANSI_ARGS_((char* digits)); /* 183 */
} TclIntStubs;
#ifdef __cplusplus
@@ -1807,6 +1820,14 @@
#define TclDbNewListObjDirect \
(tclIntStubsPtr->tclDbNewListObjDirect) /* 181 */
#endif
+#ifndef TclDToA
+#define TclDToA \
+ (tclIntStubsPtr->tclDToA) /* 182 */
+#endif
+#ifndef TclFreeDToA
+#define TclFreeDToA \
+ (tclIntStubsPtr->tclFreeDToA) /* 183 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
Index: generic/tclIntPlatDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntPlatDecls.h,v
retrieving revision 1.21
diff -b -u -r1.21 tclIntPlatDecls.h
Index: generic/tclPlatDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclPlatDecls.h,v
retrieving revision 1.20
diff -b -u -r1.20 tclPlatDecls.h
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.91
diff -b -u -r1.91 tclStubInit.c
--- generic/tclStubInit.c 15 Dec 2003 00:49:38 -0000 1.91
+++ generic/tclStubInit.c 19 Dec 2003 17:10:48 -0000
@@ -276,6 +276,8 @@
Tcl_GetStartupScript, /* 179 */
TclNewListObjDirect, /* 180 */
TclDbNewListObjDirect, /* 181 */
+ TclDToA, /* 182 */
+ TclFreeDToA, /* 183 */
};
TclIntPlatStubs tclIntPlatStubs = {
Index: generic/tclUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtil.c,v
retrieving revision 1.43
diff -b -u -r1.43 tclUtil.c
--- generic/tclUtil.c 4 Sep 2003 16:44:12 -0000 1.43
+++ generic/tclUtil.c 19 Dec 2003 17:10:48 -0000
@@ -61,12 +61,11 @@
* TclPrecTraceProc.
*/
-static char precisionString[10] = "12";
+static char precisionString[10] = "17";
/* The string value of all the tcl_precision
* variables. */
-static char precisionFormat[10] = "%.12g";
- /* The format string actually used in calls
- * to sprintf. */
+static int prec = 17; /* The corresponding integer value. */
+
TCL_DECLARE_MUTEX(precisionMutex)
/*
@@ -1881,34 +1880,125 @@
* must have at least TCL_DOUBLE_SPACE
* characters. */
{
- char *p, c;
- Tcl_UniChar ch;
- Tcl_MutexLock(&precisionMutex);
- sprintf(dst, precisionFormat, value);
- Tcl_MutexUnlock(&precisionMutex);
+ char* digits0;
+ char* digits; /* String of significant digits
+ * for the conversion of value */
- /*
- * If the ASCII result looks like an integer, add ".0" so that it
- * doesn't look like an integer anymore. This prevents floating-point
- * values from being converted to integers unintentionally.
- * Check for ASCII specifically to speed up the function.
+ char* endPtr; /* Pointer to the end of the string of
+ * significant digits */
+ int decPt; /* Position of the decimal point relative
+ * to 'digits' */
+ int signum; /* Flag == 1 if the number is negative */
+ char* p; /* Pointer used to accumulate the
+ * result string. */
+
+ p = dst;
+
+ /* Convert the value to a string of digits. */
+
+ digits0 = digits = TclDToA( value, 4, prec, &decPt, &signum, &endPtr );
+
+ /* Put in a minus sign if necessary */
+
+ if ( signum ) {
+ *p++ = '-';
+ }
+
+ /* Handle Infinity and NaN */
+
+ if ( decPt == 9999 ) {
+ while ( *p++ = *digits++ ) {
+ /* do nothing */
+ }
+ } else {
+
+ /* Test whether to render the number in E format. The test goes
+ * as follows:
+ * (1) If decPt <= -3, then the string will be shorter in E format.
+ * Use it.
+ * (2) If the decimal point is more than 5 places past the end
+ * of the string of significant digits, then E format is shorter.
+ * (3) Otherwise, F format is shorter.
*/
- for (p = dst; *p != 0; ) {
- if (UCHAR(*p) < 0x80) {
- c = *p++;
+ if ( decPt <= -3 || decPt > ( endPtr - digits ) + 5 ) {
+
+ /* E format. Render the significand with one digit before
+ * the decimal point. */
+
+ *p++ = *digits++;
+ if ( *digits ) {
+ *p++ = '.';
+ while ( *p = *digits++ ) {
+ p++;
+ }
+ }
+
+ /* (decPt-1) is the exponent. Put in its signum. */
+
+ *p++ = 'e';
+ --decPt;
+ if ( decPt < 0 ) {
+ *p++ = '-';
+ decPt = -decPt;
} else {
- p += Tcl_UtfToUniChar(p, &ch);
- c = UCHAR(ch);
+ *p++ = '+';
}
- if ((c == '.') || isalpha(UCHAR(c))) { /* INTL: ISO only. */
- return;
+
+ /* Put in the exponent */
+
+ if ( decPt >= 100 ) {
+ *p++ = '0' + ( decPt / 100 );
+ decPt = decPt % 100;
}
+ *p++ = '0' + ( decPt / 10 );
+ *p++ = '0' + ( decPt % 10 );
+ *p++ = '\0';
+
+ } else {
+
+ /* F format */
+
+ if ( decPt <= 0 ) {
+
+ /* Leading decimal point */
+
+ *p++ = '0';
+ *p++ = '.';
+ while ( decPt++ < 0 ) {
+ *p++ = '0';
}
- p[0] = '.';
- p[1] = '0';
- p[2] = 0;
+
+ } else {
+
+ /* Digits before the decimal point */
+
+ while ( decPt-- > 0 ) {
+ if ( *digits ) {
+ *p++ = *digits++;
+ } else {
+ *p++ = '0';
+ }
+ }
+ *p++ = '.';
+ }
+
+ /* Collect digits after the decimal point */
+
+ if ( *digits ) {
+ while ( *p++ = *digits++ ) {
+ /* do nothing */
+ }
+ } else {
+ *p++ = '0';
+ *p++ = '\0';
+ }
+ }
+ }
+
+ TclFreeDToA( digits0 );
+
}
/*
@@ -1942,7 +2032,6 @@
{
CONST char *value;
char *end;
- int prec;
/*
* If the variable is unset, then recreate the trace.
@@ -1999,7 +2088,6 @@
return "improper value for precision";
}
TclFormatInt(precisionString, prec);
- sprintf(precisionFormat, "%%.%dg", prec);
Tcl_MutexUnlock(&precisionMutex);
return (char *) NULL;
}
Index: tests/expr-old.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/expr-old.test,v
retrieving revision 1.17
diff -b -u -r1.17 expr-old.test
--- tests/expr-old.test 27 Mar 2003 13:48:58 -0000 1.17
+++ tests/expr-old.test 19 Dec 2003 17:10:49 -0000
@@ -93,7 +93,7 @@
# automatic conversion to integers where needed.
test expr-old-2.1 {floating-point operators} {expr -4.2} -4.2
-test expr-old-2.2 {floating-point operators} {expr -(1.1+4.2)} -5.3
+test expr-old-2.2 {floating-point operators} {expr -(1.1+4.4)} -5.5
test expr-old-2.3 {floating-point operators} {expr +5.7} 5.7
test expr-old-2.4 {floating-point operators} {expr +--+-62.0} -62.0
test expr-old-2.5 {floating-point operators} {expr !2.1} 0
@@ -430,7 +430,7 @@
test expr-old-25.16 {type conversions} {expr 2+2.5} 4.5
test expr-old-25.17 {type conversions} {expr 2+2.5} 4.5
test expr-old-25.18 {type conversions} {expr 2.0e2} 200.0
-test expr-old-25.19 {type conversions} {eformat} {expr 2.0e15} 2e+15
+test expr-old-25.19 {type conversions} {expr 2.0e15} 2e+15
test expr-old-25.20 {type conversions} {expr 10.0} 10.0
# Various error conditions.
Index: tests/scan.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/scan.test,v
retrieving revision 1.14
diff -b -u -r1.14 scan.test
--- tests/scan.test 22 Jun 2002 04:19:47 -0000 1.14
+++ tests/scan.test 19 Dec 2003 17:10:49 -0000
@@ -427,7 +427,7 @@
test scan-6.1 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
-} {3 2.1 -300000000.0 0.99962 {}}
+} {3 2.1 -3e+08 0.99962 {}}
test scan-6.2 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] $a $b $c $d
@@ -448,7 +448,7 @@
set a {}; set b {}; set c {}; set d {}
list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d
} {4 4.6 99999.7 87.643 118.0}
-test scan-6.6 {floating-point scanning} {eformat} {
+test scan-6.6 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d
} {4 1.2345 0.697 124.0 5e-05}
Index: tests/util.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/util.test,v
retrieving revision 1.13
diff -b -u -r1.13 util.test
--- tests/util.test 27 Aug 2003 20:29:36 -0000 1.13
+++ tests/util.test 19 Dec 2003 17:10:49 -0000
@@ -287,17 +287,18 @@
concat x[expr 1.39999999999]
} {x1.39999999999}
test util-6.3 {Tcl_PrintDouble - using tcl_precision} {
+ set tcl_precision 12
concat x[expr 1.399999999999]
} {x1.4}
test util-6.4 {Tcl_PrintDouble - using tcl_precision} {
set tcl_precision 5
concat x[expr 1.123412341234]
} {x1.1234}
-set tcl_precision 12
+set tcl_precision 17
test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {
concat x[expr 2.0]
} {x2.0}
-test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} {eformat} {
+test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} {
concat x[expr 3.0e98]
} {x3e+98}
@@ -329,7 +330,7 @@
list [catch {set tcl_precision abc} msg] $msg $tcl_precision
} {1 {can't set "tcl_precision": improper value for precision} 12}
-set tcl_precision 12
+set tcl_precision 17
# This test always succeeded in the C locale anyway...
test util-8.1 {TclNeedSpace - correct UTF8 handling} {
Index: unix/Makefile.in
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/Makefile.in,v
retrieving revision 1.133
diff -b -u -r1.133 Makefile.in
--- unix/Makefile.in 21 Oct 2003 00:23:34 -0000 1.133
+++ unix/Makefile.in 19 Dec 2003 17:10:49 -0000
@@ -304,7 +304,8 @@
GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o tclClock.o \
tclCmdAH.o tclCmdIL.o tclCmdMZ.o tclCompCmds.o tclCompExpr.o \
- tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclEncoding.o \
+ tclCompile.o tclConfig.o tclDate.o\
+ tclDictObj.o tclDToA.o tclEncoding.o \
tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
tclIOGT.o tclIOSock.o tclIOUtil.o tclLink.o tclListObj.o \
@@ -355,6 +356,7 @@
$(GENERIC_DIR)/tclConfig.c \
$(GENERIC_DIR)/tclDate.c \
$(GENERIC_DIR)/tclDictObj.c \
+ $(GENERIC_DIR)/tclDToA.c \
$(GENERIC_DIR)/tclEncoding.c \
$(GENERIC_DIR)/tclEnv.c \
$(GENERIC_DIR)/tclEvent.c \
@@ -846,6 +848,9 @@
tclDictObj.o: $(GENERIC_DIR)/tclDictObj.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDictObj.c
+
+tclDToA.o: $(GENERIC_DIR)/tclDToA.c $(GENERIC_DIR)/dtoa.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDToA.c
tclEncoding.o: $(GENERIC_DIR)/tclEncoding.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEncoding.c
Index: win/Makefile.in
===================================================================
RCS file: /cvsroot/tcl/tcl/win/Makefile.in,v
retrieving revision 1.75
diff -b -u -r1.75 Makefile.in
--- win/Makefile.in 10 Nov 2003 22:55:47 -0000 1.75
+++ win/Makefile.in 19 Dec 2003 17:10:49 -0000
@@ -221,6 +221,7 @@
tclConfig.$(OBJEXT) \
tclDate.$(OBJEXT) \
tclDictObj.$(OBJEXT) \
+ tclDToA.$(OBJECT) \
tclEncoding.$(OBJEXT) \
tclEnv.$(OBJEXT) \
tclEvent.$(OBJEXT) \
Index: win/makefile.bc
===================================================================
RCS file: /cvsroot/tcl/tcl/win/makefile.bc,v
retrieving revision 1.18
diff -b -u -r1.18 makefile.bc
--- win/makefile.bc 10 Nov 2003 22:55:48 -0000 1.18
+++ win/makefile.bc 19 Dec 2003 17:10:49 -0000
@@ -211,6 +211,7 @@
$(TMPDIR)\tclConfig.obj \
$(TMPDIR)\tclDate.obj \
$(TMPDIR)\tclDictObj.obj \
+ $(TMPDIR)\tclDToA.obj \
$(TMPDIR)\tclEncoding.obj \
$(TMPDIR)\tclEnv.obj \
$(TMPDIR)\tclEvent.obj \
Index: win/makefile.vc
===================================================================
RCS file: /cvsroot/tcl/tcl/win/makefile.vc,v
retrieving revision 1.113
diff -b -u -r1.113 makefile.vc
--- win/makefile.vc 10 Nov 2003 22:55:48 -0000 1.113
+++ win/makefile.vc 19 Dec 2003 17:10:49 -0000
@@ -242,6 +242,7 @@
$(TMP_DIR)\tclConfig.obj \
$(TMP_DIR)\tclDate.obj \
$(TMP_DIR)\tclDictObj.obj \
+ $(TMP_DIR)\tclDToA.obj \
$(TMP_DIR)\tclEncoding.obj \
$(TMP_DIR)\tclEnv.obj \
$(TMP_DIR)\tclEvent.obj \
