TIP#237 IMPLEMENTATION

        [kennykb-numerics-branch] Resynchronized with the HEAD; at this
         checkpoint [-rkennykb-numerics-branch-20051008], the HEAD and
        kennykb-numerics-branch contain identical code.

1 files changed, 99 insertions, 22 deletions

diff --git a/generic/tclInt.h b/generic/tclInt.h
index b810845..6dd07b0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,13 +12,20 @@
  * 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.252 2005/09/14 03:46:50 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.253 2005/10/08 14:42:45 dgp Exp $
  */
 
 #ifndef _TCLINT
 #define _TCLINT
 
 /*
+ * Some numerics configuration options
+ */
+
+#undef NO_WIDE_TYPE
+#undef ACCEPT_NAN
+
+/*
  * Common include files needed by most of the Tcl source files are included
  * here, so that system-dependent personalizations for the include files only
  * have to be made in once place. This results in a few extra includes, but
@@ -98,6 +105,14 @@ typedef int ptrdiff_t;
 #endif
 
 /*
+ * When Tcl_WideInt and long are the same type, there's no value in
+ * having a tclWideIntType separate from the tclIntType.
+ */
+#ifdef TCL_WIDE_INT_IS_LONG
+#define NO_WIDE_TYPE
+#endif
+
+/*
  * The following procedures allow namespaces to be customized to support
  * special name resolution rules for commands/variables.
  */
@@ -1873,6 +1888,35 @@ typedef struct ProcessGlobalValue {
 } ProcessGlobalValue;
 
 /*
+ *----------------------------------------------------------------------
+ * Flags for TclParseNumber
+ *----------------------------------------------------------------------
+ */
+
+#define TCL_PARSE_DECIMAL_ONLY		1
+				/* Leading zero doesn't denote octal or hex */
+#define TCL_PARSE_OCTAL_ONLY		2
+				/* Parse octal even without prefix */
+#define TCL_PARSE_HEXADECIMAL_ONLY	4
+				/* Parse hexadecimal even without prefix */
+#define TCL_PARSE_INTEGER_ONLY		8
+				/* Disable floating point parsing */
+#define TCL_PARSE_SCAN_PREFIXES		16
+				/* Use [scan] rules dealing with 0? prefixes */
+
+/*
+ *----------------------------------------------------------------------
+ * Type values TclGetNumberFromObj
+ *----------------------------------------------------------------------
+ */
+
+#define TCL_NUMBER_LONG		1
+#define TCL_NUMBER_WIDE		2
+#define TCL_NUMBER_BIG		3
+#define TCL_NUMBER_DOUBLE	4
+#define TCL_NUMBER_NAN		5
+
+/*
  *----------------------------------------------------------------
  * Variables shared among Tcl modules but not used by the outside world.
  *----------------------------------------------------------------
@@ -1897,6 +1941,7 @@ MODULE_SCOPE ClientData		tclTimeClientData;
  * Variables denoting the Tcl object types defined in the core.
  */
 
+MODULE_SCOPE Tcl_ObjType tclBignumType;
 MODULE_SCOPE Tcl_ObjType tclBooleanType;
 MODULE_SCOPE Tcl_ObjType tclByteArrayType;
 MODULE_SCOPE Tcl_ObjType tclByteCodeType;
@@ -1909,7 +1954,9 @@ MODULE_SCOPE Tcl_ObjType tclProcBodyType;
 MODULE_SCOPE Tcl_ObjType tclStringType;
 MODULE_SCOPE Tcl_ObjType tclArraySearchType;
 MODULE_SCOPE Tcl_ObjType tclNsNameType;
+#ifndef NO_WIDE_TYPE
 MODULE_SCOPE Tcl_ObjType tclWideIntType;
+#endif
 MODULE_SCOPE Tcl_ObjType tclRegexpType;
 
 /*
@@ -1961,6 +2008,7 @@ MODULE_SCOPE void	TclAppendObjToErrorInfo(Tcl_Interp *interp,
 MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
 			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
 MODULE_SCOPE double	TclBignumToDouble(mp_int* bignum);
+MODULE_SCOPE double	TclCeil(mp_int* a);
 MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp,CONST char *value);
 MODULE_SCOPE int	TclChanCreateObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
@@ -2000,6 +2048,7 @@ MODULE_SCOPE void	TclFinalizeObjects(void);
 MODULE_SCOPE void	TclFinalizePreserve(void);
 MODULE_SCOPE void	TclFinalizeSynchronization(void);
 MODULE_SCOPE void	TclFinalizeThreadData(void);
+MODULE_SCOPE double	TclFloor(mp_int* a);
 MODULE_SCOPE void	TclFormatNaN(double value, char* buffer);
 MODULE_SCOPE int	TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    CONST char *format, ...);
@@ -2012,6 +2061,9 @@ MODULE_SCOPE int	TclGetEncodingFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr);
 MODULE_SCOPE int	TclGetNamespaceFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
+MODULE_SCOPE int	TclGetNumberFromObj(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, ClientData *clientDataPtr,
+			    int *typePtr);
 MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
 			    CONST char *modeString, int *seekFlagPtr,
 			    int *binaryPtr);
@@ -2019,7 +2071,13 @@ MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
 MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
 			    Tcl_Obj *unquotedPrefix, int globFlags,
 			    Tcl_GlobTypeData* types);
+MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
+			    Tcl_Obj *incrPtr);
+MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
 MODULE_SCOPE void	TclInitAlloc(void);
+MODULE_SCOPE int	TclInitBignumFromDouble(Tcl_Interp *interp, double d,
+			    mp_int *b);
 MODULE_SCOPE void	TclInitDbCkalloc(void);
 MODULE_SCOPE void	TclInitDoubleConversion(void);
 MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation(
@@ -2062,9 +2120,14 @@ MODULE_SCOPE int	TclParseBackslash(CONST char *src,
 			    int numBytes, int *readPtr, char *dst);
 MODULE_SCOPE int	TclParseHex(CONST char *src, int numBytes,
 			    Tcl_UniChar *resultPtr);
+MODULE_SCOPE int	TclParseNumber(Tcl_Interp* interp, Tcl_Obj* objPtr,
+			    CONST char* type, CONST char* string,
+			    size_t length, CONST char** endPtrPtr, int flags);
 MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, CONST char *string,
 			    int numBytes, Tcl_Parse *parsePtr);
+#if 0
 MODULE_SCOPE int	TclParseInteger(CONST char *string, int numBytes);
+#endif
 MODULE_SCOPE int	TclParseWhiteSpace(CONST char *src,
 			    int numBytes, Tcl_Parse *parsePtr, char *typePtr);
 MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
@@ -2134,10 +2197,11 @@ MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
 MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
 MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
 			    Tcl_Obj *cmdPrefix);
+MODULE_SCOPE void	TclSetBignumIntRep (Tcl_Obj *objPtr,
+			    mp_int *bignumValue);
 MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
 			    Tcl_Obj *newValue, Tcl_Encoding encoding);
 MODULE_SCOPE VOID	TclSignalExitThread(Tcl_ThreadId id, int result);
-MODULE_SCOPE double	TclStrToD(CONST char* string, CONST char** endPtr);
 MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
 			    int count, int *tokensLeftPtr);
 MODULE_SCOPE void	TclTransferResult(Tcl_Interp *sourceInterp, int result,
@@ -2516,6 +2580,11 @@ MODULE_SCOPE Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp,
 			    Var *varPtr, Var *arrayPtr, CONST char *part1,
 			    CONST char *part2, Tcl_Obj *newValuePtr,
 			    CONST int flags);
+MODULE_SCOPE Tcl_Obj *	TclPtrIncrObjVar (Tcl_Interp *interp,
+			    Var *varPtr, Var *arrayPtr, CONST char *part1,
+			    CONST char *part2, Tcl_Obj *incrPtr,
+			    CONST int flags);
+#if 0
 MODULE_SCOPE Tcl_Obj *	TclPtrIncrVar(Tcl_Interp *interp,
 			    Var *varPtr, Var *arrayPtr, CONST char *part1,
 			    CONST char *part2, CONST long i, CONST int flags);
@@ -2523,6 +2592,7 @@ MODULE_SCOPE Tcl_Obj *	TclPtrIncrWideVar(Tcl_Interp *interp,
 			    Var *varPtr, Var *arrayPtr, CONST char *part1,
 			    CONST char *part2, CONST Tcl_WideInt i,
 			    CONST int flags);
+#endif
 MODULE_SCOPE void	TclInvalidateNsPath(Namespace *nsPtr);
 
 /*
@@ -2737,25 +2807,21 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr);
     }\
 
 
+#if 0
 /*
  *----------------------------------------------------------------
  * Macro used by the Tcl core to get a Tcl_WideInt value out of a Tcl_Obj of
- * the "wideInt" type. Different implementation on different platforms
- * depending whether TCL_WIDE_INT_IS_LONG.
+ * the "wideInt" type.  
  *----------------------------------------------------------------
  */
 
-#ifdef TCL_WIDE_INT_IS_LONG
-#    define TclGetWide(resultVar, objPtr) \
-	(resultVar) = (objPtr)->internalRep.longValue
-#    define TclGetLongFromWide(resultVar, objPtr) \
-	(resultVar) = (objPtr)->internalRep.longValue
-#else
+#ifndef NO_WIDE_TYPE
 #    define TclGetWide(resultVar, objPtr) \
 	(resultVar) = (objPtr)->internalRep.wideValue
 #    define TclGetLongFromWide(resultVar, objPtr) \
 	(resultVar) = Tcl_WideAsLong((objPtr)->internalRep.wideValue)
 #endif
+#endif
 
 /*
  *----------------------------------------------------------------
@@ -2818,7 +2884,10 @@ MODULE_SCOPE void *	TclBNAlloc(size_t nBytes);
 MODULE_SCOPE void *	TclBNRealloc(void *oldBlock, size_t newNBytes);
 MODULE_SCOPE void	TclBNFree(void *block);
 MODULE_SCOPE void	TclBNInitBignumFromLong(mp_int *bignum, long initVal);
-
+MODULE_SCOPE void	TclBNInitBignumFromWideInt(mp_int* bignum,
+			    Tcl_WideInt initVal);
+MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int* bignum,
+			    Tcl_WideUInt initVal);
 
 /*
  *----------------------------------------------------------------
@@ -2876,11 +2945,13 @@ MODULE_SCOPE void	TclBNInitBignumFromLong(mp_int *bignum, long initVal);
 #define TclSetBooleanObj(objPtr, b) \
     TclSetIntObj((objPtr), ((b)? 1 : 0));
 
+#ifndef NO_WIDE_TYPE
 #define TclSetWideIntObj(objPtr, w) \
     TclInvalidateStringRep(objPtr);\
     TclFreeIntRep(objPtr); \
     (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
     (objPtr)->typePtr = &tclWideIntType
+#endif
 
 #define TclSetDoubleObj(objPtr, d) \
     TclInvalidateStringRep(objPtr);\
@@ -2923,14 +2994,6 @@ MODULE_SCOPE void	TclBNInitBignumFromLong(mp_int *bignum, long initVal);
 #define TclNewBooleanObj(objPtr, b) \
     TclNewIntObj((objPtr), ((b)? 1 : 0))
 
-#define TclNewWideIntObj(objPtr, w) \
-    TclIncrObjsAllocated(); \
-    TclAllocObjStorage(objPtr); \
-    (objPtr)->refCount = 0; \
-    (objPtr)->bytes = NULL; \
-    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
-    (objPtr)->typePtr = &tclWideIntType
-
 #define TclNewDoubleObj(objPtr, d) \
     TclIncrObjsAllocated(); \
     TclAllocObjStorage(objPtr); \
@@ -2953,9 +3016,6 @@ MODULE_SCOPE void	TclBNInitBignumFromLong(mp_int *bignum, long initVal);
 #define TclNewBooleanObj(objPtr, b) \
     (objPtr) = Tcl_NewBooleanObj(b)
 
-#define TclNewWideIntObj(objPtr, w)\
-    (objPtr) = Tcl_NewWideIntObj(w)
-
 #define TclNewDoubleObj(objPtr, d) \
     (objPtr) = Tcl_NewDoubleObj(d)
 
@@ -2963,6 +3023,23 @@ MODULE_SCOPE void	TclBNInitBignumFromLong(mp_int *bignum, long initVal);
     (objPtr) = Tcl_NewStringObj((s), (len))
 #endif /* TCL_MEM_DEBUG */
 
+/*
+ *----------------------------------------------------------------
+ * Macros used by the Tcl core to test for some special double values.
+ * The ANSI C "prototypes" for these macros are: 
+ *
+ * MODULE_SCOPE int	TclIsInfinite _ANSI_ARGS_((double d));
+ * MODULE_SCOPE int	TclIsNaN _ANSI_ARGS_((double d));
+ */
+
+#ifdef _MSC_VER
+#define TclIsInfinite(d)	( ! (_finite((d))) )
+#define TclIsNaN(d)		(_isnan((d)))
+#else
+#define TclIsInfinite(d)	( (d) > DBL_MAX || (d) < -DBL_MAX )
+#define TclIsNaN(d)		((d) != (d))
+#endif
+
 #include "tclPort.h"
 #include "tclIntDecls.h"
 #include "tclIntPlatDecls.h"