[kennykb_numerics_branch]

        * generic/tclInt.h:             Moved TclParseInteger to tclUtil.c
        * generic/tclParseExpr.c:       and made it static.
        * generic/tclUtil.c:

        * generic/tclInt.decls: Moved TclExprFloatError to tclBasic.c and
        * generic/tclBasic.c:   made it static.
        * generic/tclExecute.c:

        * generitc/tclIntDecls.h:       make genstubs
        * generic/tclStubInit.c:

        * generic/tclExecute.c: errno, IS_NAN, IS_INF, LLD no longer called in
        this file; dropped/disabled support for them.

        * generic/tclCompExpr.c:        errno no longer used in these files;
        * generic/tclParseExpr.c:       dropped support "hack" for it.

        * generic/tclStrToD.c:  Disabled out of date support "hack" for errno.

        * generic/tclBasic.c:   Eliminated VerifyExprObjType.  Initialize
        errno to zero in OldMathFuncProc.

10 files changed, 157 insertions, 67 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 26b1f2d..2619d0e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.136.2.20 2005/08/19 21:55:20 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.136.2.21 2005/08/22 03:49:38 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -69,8 +69,11 @@ static int	ExprUnaryFunc _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv));
 static int	ExprWideFunc  _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int argc, Tcl_Obj *CONST *objv));
+#if 0
 static int	VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Obj *objPtr));
+#endif
+static void	ExprFloatError _ANSI_ARGS_((Tcl_Interp *interp, double value));
 
 static void	MathFuncWrongNumArgs _ANSI_ARGS_((Tcl_Interp* interp,
 		    int expected, int actual, Tcl_Obj *CONST *objv));
@@ -2861,7 +2864,10 @@ OldMathFuncProc(clientData, interp, objc, objv)
     Tcl_Value args[MAX_MATH_ARGS];
     Tcl_Value funcResult;
     int result;
-    int i, j, k;
+#if 0
+    int i;
+#endif
+    int j, k;
     double d;
 
     /* Check argument count */
@@ -2996,6 +3002,7 @@ OldMathFuncProc(clientData, interp, objc, objv)
 
     /* Call the function */
 
+    errno = 0;
     result = (*dataPtr->proc)(dataPtr->clientData, interp, args,
 	    &funcResult);
     if (result != TCL_OK) {
@@ -3011,7 +3018,7 @@ OldMathFuncProc(clientData, interp, objc, objv)
     } else {
 	d = funcResult.doubleValue;
 	if (IS_NAN(d) || IS_INF(d)) {
-	    TclExprFloatError(interp, d);
+	    ExprFloatError(interp, d);
 	    return TCL_ERROR;
 	}
 	TclNewDoubleObj(valuePtr, d);
@@ -4990,7 +4997,7 @@ ExprUnaryFunc(clientData, interp, objc, objv)
 	dResult = (*func)(d);
 	if ((errno != 0) || IS_NAN(dResult)) {
 	    if (errno != ERANGE || (dResult != 0.0 && !IS_INF(dResult))) {
-		TclExprFloatError(interp, dResult);
+		ExprFloatError(interp, dResult);
 		return TCL_ERROR;
 	    }
 	}
@@ -5033,7 +5040,7 @@ ExprBinaryFunc(clientData, interp, objc, objv)
 	dResult = (*func)(d1, d2);
 	if ((errno != 0) || IS_NAN(dResult)) {
 	    if (errno != ERANGE || (dResult != 0.0 && !IS_INF(dResult))) {
-		TclExprFloatError(interp, dResult);
+		ExprFloatError(interp, dResult);
 		return TCL_ERROR;
 	    }
 	}
@@ -5528,11 +5535,14 @@ ExprSrandFunc(clientData, interp, objc, objv)
     }
     valuePtr = objv[1];
 
+
+    /* TODO: error message reform? */
+#if 0
     if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
 	return TCL_ERROR;
     }
+#endif
 
-    /* TODO: error message reform? */
     if (Tcl_GetLongFromObj(interp, valuePtr, &i) != TCL_OK) {
 	/*
 	 * At this point, the only other possible type is double
@@ -5567,6 +5577,56 @@ ExprSrandFunc(clientData, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * ExprFloatError --
+ *
+ *	This procedure is called when an error occurs during a floating-point
+ *	operation. It reads errno and sets interp->objResultPtr accordingly.
+ *
+ * Results:
+ *	interp->objResultPtr is set to hold an error message.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ExprFloatError(interp, value)
+    Tcl_Interp *interp;         /* Where to store error message. */
+    double value;               /* Value returned after error; used to
+                                 * distinguish underflows from overflows. */
+{
+    CONST char *s;
+
+    if ((errno == EDOM) || IS_NAN(value)) {
+	s = "domain error: argument not in valid range";
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL);
+    } else if ((errno == ERANGE) || IS_INF(value)) {
+	if (value == 0.0) {
+	    s = "floating-point value too small to represent";
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
+	} else {
+	    s = "floating-point value too large to represent";
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
+	}
+    } else {
+	char msg[64 + TCL_INTEGER_SPACE];
+
+	sprintf(msg, "unknown floating-point error, errno = %d", errno);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
+    }
+}
+
+
+#if 0
+/*
+ *----------------------------------------------------------------------
+ *
  * VerifyExprObjType --
  *
  *	This procedure is called by the math functions to verify that
@@ -5637,6 +5697,7 @@ VerifyExprObjType(interp, objPtr)
     return TCL_ERROR;
 #endif
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 9df405d..2e88790 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -9,28 +9,13 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompExpr.c,v 1.25.2.3 2005/08/04 16:47:50 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.25.2.4 2005/08/22 03:49:39 dgp Exp $
  */
 
 #include "tclInt.h"
 #include "tclCompile.h"
 
 /*
- * The stuff below is a bit of a hack so that this file can be used in
- * environments that include no UNIX, i.e. no errno: just arrange to use the
- * errno from tclExecute.c here.
- */
-
-#ifdef TCL_GENERIC_ONLY
-#define NO_ERRNO_H
-#endif
-
-#ifdef NO_ERRNO_H
-extern int errno;			/* Use errno from tclExecute.c. */
-#define ERANGE 34
-#endif
-
-/*
  * Boolean variable that controls whether expression compilation tracing is
  * enabled.
  */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 753cd49..9f97fdb 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.167.2.29 2005/08/19 21:55:21 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.167.2.30 2005/08/22 03:49:39 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -49,6 +49,7 @@
 #   define NO_ERRNO_H
 #endif /* !TCL_GENERIC_ONLY */
 
+#if 0
 #ifdef NO_ERRNO_H
 int errno;
 #   define EDOM   33
@@ -69,6 +70,7 @@ int errno;
 #	define DBL_MAX 1.79769313486231570e+308
 #   endif /* MAXDOUBLE */
 #endif /* !DBL_MAX */
+#endif
 
 /*
  * A mask (should be 2**n-1) that is used to work out when the bytecode engine
@@ -141,12 +143,11 @@ long		tclObjsFreed   = 0;
 long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
 #endif /* TCL_COMPILE_STATS */
 
+#if 0
 /*
  * Macros for testing floating-point values for certain special cases. Test
  * for not-a-number by comparing a value against itself; test for infinity by
  * comparing against the largest floating-point value.
- *
- * TODO: Eliminate these ?
  */
 
 #ifdef _MSC_VER
@@ -156,6 +157,7 @@ long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
 #define IS_NAN(f) ((f) != (f))
 #define IS_INF(f) ( (f) > DBL_MAX || (f) < -DBL_MAX )
 #endif
+#endif
 
 /*
  * The new macro for ending an instruction; note that a reasonable C-optimiser
@@ -333,13 +335,11 @@ long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
 	(IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType)
 
 #define W0	Tcl_LongAsWide(0)
-#endif
 /*
  * For tracing that uses wide values.
  */
 #define LLD				"%" TCL_LL_MODIFIER "d"
 
-#if 0
 #ifndef TCL_WIDE_INT_IS_LONG
 /*
  * Extract a double value from a general numeric object.
@@ -6791,6 +6791,7 @@ GetOpcodeName(pc)
 }
 #endif /* TCL_COMPILE_DEBUG */
 
+#if 0
 /*
  *----------------------------------------------------------------------
  *
@@ -6838,6 +6839,7 @@ TclExprFloatError(interp, value)
 	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
     }
 }
+#endif
 
 #ifdef TCL_COMPILE_STATS
 /*
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index c83dca0..7f0bc81 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tclInt.decls,v 1.84.2.10 2005/08/19 05:17:48 dgp Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.84.2.11 2005/08/22 03:49:39 dgp Exp $
 
 library tcl
 
@@ -87,9 +87,9 @@ declare 14 generic {
 #  declare 15 generic {
 #      void TclExpandParseValue(ParseValue *pvPtr, int needed)
 #  }
-declare 16 generic {
-    void TclExprFloatError(Tcl_Interp *interp, double value)
-}
+#declare 16 generic {
+#    void TclExprFloatError(Tcl_Interp *interp, double value)
+#}
 # Removed in 8.4
 #declare 17 generic {
 #    int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e9746b7..c50b760 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.202.2.24 2005/08/19 21:55:21 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.202.2.25 2005/08/22 03:49:39 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -2059,8 +2059,10 @@ MODULE_SCOPE int	TclParseNumber _ANSI_ARGS_((Tcl_Interp* interp,
 MODULE_SCOPE void	TclParseInit _ANSI_ARGS_ ((Tcl_Interp *interp,
 			    CONST char *string, int numBytes,
 			    Tcl_Parse *parsePtr));
+#if 0
 MODULE_SCOPE int	TclParseInteger _ANSI_ARGS_((CONST char *string,
 			    int numBytes));
+#endif
 MODULE_SCOPE int	TclParseWhiteSpace _ANSI_ARGS_((CONST char *src,
 			    int numBytes, Tcl_Parse *parsePtr, char *typePtr));
 MODULE_SCOPE int	TclProcessReturn _ANSI_ARGS_((Tcl_Interp *interp,
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 3a424fe..2fcb761 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -12,9 +12,9 @@
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
 <<<<<<< tclIntDecls.h
- * RCS: @(#) $Id: tclIntDecls.h,v 1.75.2.10 2005/08/19 05:17:48 dgp Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.75.2.11 2005/08/22 03:49:40 dgp Exp $
 =======
- * RCS: @(#) $Id: tclIntDecls.h,v 1.75.2.10 2005/08/19 05:17:48 dgp Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.75.2.11 2005/08/22 03:49:40 dgp Exp $
 >>>>>>> 1.83
  */
 
@@ -148,12 +148,7 @@ EXTERN void		TclDeleteVars _ANSI_ARGS_((Interp * iPtr,
 EXTERN void		TclDumpMemoryInfo _ANSI_ARGS_((FILE * outFile));
 #endif
 /* Slot 15 is reserved */
-#ifndef TclExprFloatError_TCL_DECLARED
-#define TclExprFloatError_TCL_DECLARED
-/* 16 */
-EXTERN void		TclExprFloatError _ANSI_ARGS_((Tcl_Interp * interp, 
-				double value));
-#endif
+/* Slot 16 is reserved */
 /* Slot 17 is reserved */
 /* Slot 18 is reserved */
 /* Slot 19 is reserved */
@@ -1120,7 +1115,7 @@ typedef struct TclIntStubs {
     void *reserved13;
     void (*tclDumpMemoryInfo) _ANSI_ARGS_((FILE * outFile)); /* 14 */
     void *reserved15;
-    void (*tclExprFloatError) _ANSI_ARGS_((Tcl_Interp * interp, double value)); /* 16 */
+    void *reserved16;
     void *reserved17;
     void *reserved18;
     void *reserved19;
@@ -1419,10 +1414,7 @@ extern TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */
 #endif
 /* Slot 15 is reserved */
-#ifndef TclExprFloatError
-#define TclExprFloatError \
-	(tclIntStubsPtr->tclExprFloatError) /* 16 */
-#endif
+/* Slot 16 is reserved */
 /* Slot 17 is reserved */
 /* Slot 18 is reserved */
 /* Slot 19 is reserved */
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index 2e59c49a..b74b69d 100644
--- a/generic/tclParseExpr.c
+++ b/generic/tclParseExpr.c
@@ -12,27 +12,12 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclParseExpr.c,v 1.23.2.10 2005/08/17 20:49:55 kennykb Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.23.2.11 2005/08/22 03:49:40 dgp Exp $
  */
 
 #include "tclInt.h"
 
 /*
- * The stuff below is a bit of a hack so that this file can be used in
- * environments that include no UNIX, i.e. no errno: just arrange to use the
- * errno from tclExecute.c here.
- */
-
-#ifdef TCL_GENERIC_ONLY
-#define NO_ERRNO_H
-#endif
-
-#ifdef NO_ERRNO_H
-extern int errno;			/* Use errno from tclExecute.c. */
-#define ERANGE 34
-#endif
-
-/*
  * Boolean variable that controls whether expression parse tracing is enabled.
  */
 
@@ -1886,6 +1871,7 @@ GetLexeme(infoPtr)
     }
 }
 
+#if 0
 /*
  *----------------------------------------------------------------------
  *
@@ -1945,6 +1931,7 @@ TclParseInteger(string, numBytes)
     }
     return 0;
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 7333d4b..658177f 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.21 2005/08/17 21:39:01 kennykb Exp $
+ * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.22 2005/08/22 03:49:40 dgp Exp $
  *
  *----------------------------------------------------------------------
  */
@@ -29,6 +29,10 @@
 #include <ctype.h>
 #include <tommath.h>
 
+#if 0
+/* Hack is out of date.  tclInt.h unconditionally #include's errno.h
+ * (via tclPort.h).
+ */
 /*
  * The stuff below is a bit of a hack so that this file can be used in
  * environments that include no UNIX, i.e. no errno: just arrange to use the
@@ -43,6 +47,7 @@
 extern int errno;			/* Use errno from tclExecute.c. */
 #   define ERANGE 34
 #endif
+#endif
 
 #if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
 #   define IEEE_FLOATING_POINT
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 729173a..9487130 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -9,9 +9,9 @@
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
 <<<<<<< tclStubInit.c
- * RCS: @(#) $Id: tclStubInit.c,v 1.109.2.13 2005/08/19 05:17:48 dgp Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.109.2.14 2005/08/22 03:49:41 dgp Exp $
 =======
- * RCS: @(#) $Id: tclStubInit.c,v 1.109.2.13 2005/08/19 05:17:48 dgp Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.109.2.14 2005/08/22 03:49:41 dgp Exp $
 >>>>>>> 1.121
  */
 
@@ -99,7 +99,7 @@ TclIntStubs tclIntStubs = {
     NULL, /* 13 */
     TclDumpMemoryInfo, /* 14 */
     NULL, /* 15 */
-    TclExprFloatError, /* 16 */
+    NULL, /* 16 */
     NULL, /* 17 */
     NULL, /* 18 */
     NULL, /* 19 */
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 8b1a532..667e308 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- *  RCS: @(#) $Id: tclUtil.c,v 1.51.2.16 2005/08/15 20:46:02 dgp Exp $
+ *  RCS: @(#) $Id: tclUtil.c,v 1.51.2.17 2005/08/22 03:49:41 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -87,6 +87,8 @@ static void		FreeProcessGlobalValue _ANSI_ARGS_((
 			    ClientData clientData));
 static void		FreeThreadHash _ANSI_ARGS_((ClientData clientData));
 static Tcl_HashTable *	GetThreadHash _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr));
+static int		ParseInteger _ANSI_ARGS_((CONST char *bytes,
+			    int numBytes));
 static int		SetEndOffsetFromAny _ANSI_ARGS_((Tcl_Interp* interp,
 			    Tcl_Obj* objPtr));
 static void		UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr));
@@ -2229,6 +2231,60 @@ TclLooksLikeInt(bytes, length)
 /*
  *----------------------------------------------------------------------
  *
+ * ParseInteger --
+ *
+ *	Scans up to numBytes bytes starting at bytes, and checks whether the
+ *	leading bytes look like an integer's string representation.
+ *
+ * Results:
+ *	Returns 0 if the leading bytes do not look like an integer.
+ *	Otherwise, returns the number of bytes examined that look like an
+ *	integer.  This may be less than numBytes if the integer is only the
+ *	leading part of the string.     
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseInteger(bytes, numBytes)
+    CONST char *bytes;	/* The string to examine. */
+    int numBytes;	/* Max number of bytes to scan. */
+{
+    register CONST char *p = bytes;
+
+    /* Take care of introductory "0x". */
+    if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
+	int scanned;
+	Tcl_UniChar ch;
+
+	p += 2;
+	numBytes -= 2;
+	scanned = TclParseHex(p, numBytes, &ch);
+	if (scanned) {
+	    return scanned+2;
+	}
+
+	/* Recognize the 0 as valid integer, but x is left behind. */
+	return 1;
+    }
+    while (numBytes && isdigit(UCHAR(*p))) {            /* INTL: digit */
+	numBytes--; p++;
+    }
+    if (numBytes == 0) {
+	return (p - bytes);
+    }
+    if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
+	return (p - bytes);
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclGetIntForIndex --
  *
  *	This function returns an integer corresponding to the list index held
@@ -2288,7 +2344,7 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
 	if ((*p == '+') || (*p == '-')) {
 	    p++; length--;
 	}
-	opIdx = TclParseInteger(p, length) + (int) (p-bytes);
+	opIdx = ParseInteger(p, length) + (int) (p-bytes);
 	if (opIdx) {
 	    int code, first, second;
 	    char savedOp = bytes[opIdx];