TIP#72 implementation. See ChangeLog for details.

This version builds clean on Solaris/SPARC, with GCC and CC, both with and
without threads and both in 32-bit and 64-bit mode.

1 files changed, 417 insertions, 7 deletions

diff --git a/generic/tclObj.c b/generic/tclObj.c
index c895237..c5f7f12 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.28 2002/01/25 21:36:09 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.29 2002/02/15 14:28:49 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -63,6 +63,11 @@ static int		SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 static void		UpdateStringOfBoolean _ANSI_ARGS_((Tcl_Obj *objPtr));
 static void		UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr));
 static void		UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
+#ifndef TCL_WIDE_INT_IS_LONG
+static int		SetWideIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr));
+#endif
 
 /*
  * Prototypes for the array hash key methods.
@@ -121,6 +126,16 @@ Tcl_ObjType tclIntType = {
     SetIntFromAny			/* setFromAnyProc */
 };
 
+#ifndef TCL_WIDE_INT_IS_LONG
+Tcl_ObjType tclWideIntType = {
+    "wideInt",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
+    UpdateStringOfWideInt,		/* updateStringProc */
+    SetWideIntFromAny			/* setFromAnyProc */
+};
+#endif
+
 /*
  * The structure below defines the Tcl obj hash key type.
  */
@@ -218,6 +233,9 @@ TclInitObjSubsystem()
     Tcl_RegisterObjType(&tclDoubleType);
     Tcl_RegisterObjType(&tclEndOffsetType);
     Tcl_RegisterObjType(&tclIntType);
+#ifndef TCL_WIDE_INT_IS_LONG
+    Tcl_RegisterObjType(&tclWideIntType);
+#endif
     Tcl_RegisterObjType(&tclStringType);
     Tcl_RegisterObjType(&tclListType);
     Tcl_RegisterObjType(&tclByteCodeType);
@@ -826,11 +844,11 @@ Tcl_GetString(objPtr)
 
 char *
 Tcl_GetStringFromObj(objPtr, lengthPtr)
-    register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
-				 * should be returned. */
-    register int *lengthPtr;	/* If non-NULL, the location where the
-				 * string rep's byte array length should be
-				 * stored. If NULL, no length is stored. */
+    register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer should
+				 * be returned. */
+    register int *lengthPtr;	/* If non-NULL, the location where the string
+				 * rep's byte array length should * be stored.
+				 * If NULL, no length is stored. */
 {
     if (objPtr->bytes == NULL) {
 	if (objPtr->typePtr->updateStringProc == NULL) {
@@ -1092,7 +1110,6 @@ SetBooleanFromAny(interp, objPtr)
     char lowerCase[10];
     int newBool, length;
     register int i;
-    double dbl;
 
     /*
      * Get the string representation. Make it up-to-date if necessary.
@@ -1148,6 +1165,24 @@ SetBooleanFromAny(interp, objPtr)
 	    goto badBoolean;
 	}
     } else {
+	double dbl;
+#ifndef TCL_WIDE_INT_IS_LONG
+	Tcl_WideInt wide = strtoll(string, &end, 0);
+	if (end != string) {
+	    /*
+	     * Make sure the string has no garbage after the end of
+	     * the wide int.
+	     */
+	    while ((end < (string+length))
+		   && isspace(UCHAR(*end))) { /* INTL: ISO only */
+		end++;
+	    }
+	    if (end == (string+length)) {
+		newBool = (wide != Tcl_LongAsWide(0));
+		goto goodBoolean;
+	    }
+	}
+#endif
         /*
          * Still might be a string containing the characters representing an
          * int or double that wasn't handled above. This would be a string
@@ -1182,6 +1217,7 @@ SetBooleanFromAny(interp, objPtr)
      * Tcl_GetStringFromObj, to use that old internalRep.
      */
 
+    goodBoolean:
     if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
 	oldTypePtr->freeIntRepProc(objPtr);
     }
@@ -2060,6 +2096,380 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * SetWideIntFromAny --
+ *
+ *	Attempt to generate an integer internal form for the Tcl object
+ *	"objPtr".
+ *
+ * Results:
+ *	The return value is a standard object Tcl result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If no error occurs, an int is stored as "objPtr"s internal
+ *	representation. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef TCL_WIDE_INT_IS_LONG
+static int
+SetWideIntFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string, *end;
+    int length;
+    register char *p;
+    Tcl_WideInt newWide;
+
+    /*
+     * Get the string representation. Make it up-to-date if necessary.
+     */
+
+    string = Tcl_GetStringFromObj(objPtr, &length);
+
+    /*
+     * Now parse "objPtr"s string as an int. We use an implementation here
+     * that doesn't report errors in interp if interp is NULL. Note: use
+     * strtoull instead of strtoll for integer conversions to allow full-size
+     * unsigned numbers, but don't depend on strtoull to handle sign
+     * characters; it won't in some implementations.
+     */
+
+    errno = 0;
+    for (p = string;  isspace(UCHAR(*p));  p++) { /* INTL: ISO space. */
+	/* Empty loop body. */
+    }
+    if (*p == '-') {
+	p++;
+	newWide = -((Tcl_WideInt)strtoull(p, &end, 0));
+    } else if (*p == '+') {
+	p++;
+	newWide = strtoull(p, &end, 0);
+    } else {
+	newWide = strtoull(p, &end, 0);
+    }
+    if (end == p) {
+	badInteger:
+	if (interp != NULL) {
+	    /*
+	     * Must copy string before resetting the result in case a caller
+	     * is trying to convert the interpreter's result to an int.
+	     */
+	    
+	    char buf[100];
+	    sprintf(buf, "expected integer but got \"%.50s\"", string);
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	    TclCheckBadOctal(interp, string);
+	}
+	return TCL_ERROR;
+    }
+    if (errno == ERANGE) {
+	if (interp != NULL) {
+	    char *s = "integer value too large to represent";
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure that the string has no garbage after the end of the int.
+     */
+    
+    while ((end < (string+length))
+	    && isspace(UCHAR(*end))) { /* INTL: ISO space. */
+	end++;
+    }
+    if (end != (string+length)) {
+	goto badInteger;
+    }
+
+    /*
+     * The conversion to int succeeded. Free the old internalRep before
+     * setting the new one. We do this as late as possible to allow the
+     * conversion code, in particular Tcl_GetStringFromObj, to use that old
+     * internalRep.
+     */
+
+    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.wideValue = newWide;
+    objPtr->typePtr = &tclWideIntType;
+    return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfWideInt --
+ *
+ *	Update the string representation for a wide integer object.
+ *	Note: This procedure does not free an existing old string rep
+ *	so storage will be lost if this has not already been done. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the wideInt-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef TCL_WIDE_INT_IS_LONG
+static void
+UpdateStringOfWideInt(objPtr)
+    register Tcl_Obj *objPtr;	/* Int object whose string rep to update. */
+{
+    char buffer[TCL_INTEGER_SPACE+2];
+    register unsigned len;
+    register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
+
+    sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
+    len = strlen(buffer);
+    objPtr->bytes = ckalloc((unsigned) len + 1);
+    memcpy(objPtr->bytes, buffer, len + 1);
+    objPtr->length = len;
+}
+#endif /* TCL_WIDE_INT_IS_LONG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewWideIntObj --
+ *
+ *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
+ *	Tcl_NewWideIntObj to create a new 64-bit integer object end up calling
+ *	the debugging procedure Tcl_DbNewWideIntObj instead.
+ *
+ *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
+ *	calls to Tcl_NewWideIntObj result in a call to one of the two
+ *	Tcl_NewWideIntObj implementations below. We provide two implementations
+ *	so that the Tcl core can be compiled to do memory debugging of the 
+ *	core even if a client does not request it for itself.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have an
+ *	invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewWideIntObj
+
+Tcl_Obj *
+Tcl_NewWideIntObj(wideValue)
+    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
+					 * the new object. */
+{
+    return Tcl_DbNewWideIntObj(wideValue, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewWideIntObj(wideValue)
+    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
+					 * the new object. */
+{
+#ifdef TCL_WIDE_INT_IS_LONG
+    return Tcl_NewLongObj(wideValue);
+#else
+    register Tcl_Obj *objPtr;
+
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.wideValue = wideValue;
+    objPtr->typePtr = &tclWideIntType;
+    return objPtr;
+#endif /* TCL_WIDE_INT_IS_LONG */
+}
+#endif /* if TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewWideIntObj --
+ *
+ *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
+ *	Tcl_NewWideIntObj to create new wide integer end up calling
+ *	the debugging procedure Tcl_DbNewWideIntObj instead. We
+ *	provide two implementations of Tcl_DbNewWideIntObj so that
+ *	whether the Tcl core is compiled to do memory debugging of the
+ *	core is independent of whether a client requests debugging for
+ *	itself.
+ *
+ *	When the core is compiled with TCL_MEM_DEBUG defined,
+ *	Tcl_DbNewWideIntObj calls Tcl_DbCkalloc directly with the file
+ *	name and line number from its caller. This simplifies
+ *	debugging since then the checkmem command will report the
+ *	caller's file name and line number when reporting objects that
+ *	haven't been freed.
+ *
+ *	Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
+ *	this procedure just returns the result of calling Tcl_NewWideIntObj.
+ *
+ * Results:
+ *	The newly created wide integer object is returned. This object
+ *	will have an invalid string representation. The returned object has
+ *	ref count 0.
+ *
+ * Side effects:
+ *	Allocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewWideIntObj(wideValue, file, line)
+    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
+					 * the new object. */
+    CONST char *file;			/* The name of the source file
+					 * calling this procedure; used for
+					 * debugging. */
+    int line;				/* Line number in the source file;
+					 * used for debugging. */
+{
+#ifdef TCL_WIDE_INT_IS_LONG
+    return Tcl_DbNewLongObj(wideValue, file, line);
+#else
+    register Tcl_Obj *objPtr;
+
+    TclDbNewObj(objPtr, file, line);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.wideValue = wideValue;
+    objPtr->typePtr = &tclWideIntType;
+    return objPtr;
+#endif
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewWideIntObj(wideValue, file, line)
+    register Tcl_WideInt wideValue;	/* Long integer used to initialize
+					 * the new object. */
+    CONST char *file;			/* The name of the source file
+					 * calling this procedure; used for
+					 * debugging. */
+    int line;				/* Line number in the source file;
+					 * used for debugging. */
+{
+    return Tcl_NewWideIntObj(wideValue);
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetWideIntObj --
+ *
+ *	Modify an object to be a wide integer object and to have the
+ *	specified wide integer value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetWideIntObj(objPtr, wideValue)
+    register Tcl_Obj *objPtr;		/* Object w. internal rep to init. */
+    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
+					 * the object's value. */
+{
+#ifdef TCL_WIDE_INT_IS_LONG
+    Tcl_SetLongObj(objPtr, wideValue);
+#else
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (Tcl_IsShared(objPtr)) {
+	panic("Tcl_SetWideIntObj called with shared object");
+    }
+
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.wideValue = wideValue;
+    objPtr->typePtr = &tclWideIntType;
+    Tcl_InvalidateStringRep(objPtr);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetWideIntFromObj --
+ *
+ *	Attempt to return a wide integer from the Tcl object "objPtr". If
+ *	the object is not already a wide int object, an attempt will be made
+ *	to convert it to one.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already an int object, the conversion will free
+ *	any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* Object from which to get a wide int. */
+    register Tcl_WideInt *wideIntPtr; /* Place to store resulting long. */
+{
+#ifdef TCL_WIDE_INT_IS_LONG
+    /*
+     * Next line is type-safe because we only do this when long = Tcl_WideInt
+     */
+    return Tcl_GetLongFromObj(interp, objPtr, wideIntPtr);
+#else
+    register int result;
+
+    if (objPtr->typePtr == &tclWideIntType) {
+	*wideIntPtr = objPtr->internalRep.wideValue;
+	return TCL_OK;
+    }
+    result = SetWideIntFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*wideIntPtr = objPtr->internalRep.wideValue;
+    }
+    return result;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_DbIncrRefCount --
  *
  *	This procedure is normally called when debugging: i.e., when