Backout [52a52a65f0], let's see if this fixes the Windows crash

2 files changed, 81 insertions, 22 deletions

diff --git a/generic/tclLink.c b/generic/tclLink.c
index cd2c731..1973067 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -526,14 +526,56 @@ GetUWide(
     Tcl_Obj *objPtr,
     Tcl_WideUInt *uwidePtr)
 {
-    if (Tcl_GetWideUIntFromObj(NULL, objPtr, uwidePtr) != TCL_OK) {
-	int intValue;
-
-	if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
-	    return 1;
+    Tcl_WideInt *widePtr = (Tcl_WideInt *) uwidePtr;
+    void *clientData;
+    int type, intValue;
+
+    if (Tcl_GetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
+	if (type == TCL_NUMBER_INT) {
+	    *widePtr = *((const Tcl_WideInt *) clientData);
+	    return (*widePtr < 0);
+	} else if (type == TCL_NUMBER_BIG) {
+	    mp_int *numPtr = (mp_int *)clientData;
+	    Tcl_WideUInt value = 0;
+	    union {
+		Tcl_WideUInt value;
+		unsigned char bytes[sizeof(Tcl_WideUInt)];
+	    } scratch;
+	    size_t numBytes;
+	    unsigned char *bytes = scratch.bytes;
+
+	    if (numPtr->sign || (MP_OKAY != mp_to_ubin(numPtr,
+		    bytes, sizeof(Tcl_WideUInt), &numBytes))) {
+		/*
+		 * If the sign bit is set (a negative value) or if the value
+		 * can't possibly fit in the bits of an unsigned wide, there's
+		 * no point in doing further conversion.
+		 */
+		return 1;
+	    }
+#ifndef WORDS_BIGENDIAN
+	    while (numBytes-- > 0) {
+		value = (value << CHAR_BIT) | *bytes++;
+	    }
+#else /* WORDS_BIGENDIAN */
+	    /*
+	     * Big-endian can read the value directly.
+	     */
+	    value = scratch.value;
+#endif /* WORDS_BIGENDIAN */
+	    *uwidePtr = value;
+	    return 0;
 	}
-	*uwidePtr = intValue;
     }
+
+    /*
+     * Evil edge case fallback.
+     */
+
+    if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
+	return 1;
+    }
+    *uwidePtr = intValue;
     return 0;
 }
 
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 5a52e29..cc792c7 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -3124,12 +3124,15 @@ Tcl_GetLongFromObj(
 
 		{
 	    mp_int big;
-	    unsigned long value = 0;
+	    unsigned long scratch, value = 0;
+	    unsigned char *bytes = (unsigned char *) &scratch;
 	    size_t numBytes;
 
 	    TclUnpackBignum(objPtr, big);
-	    if (mp_pack(&value, 1,
-			    &numBytes, 0, sizeof(Tcl_WideUInt), 0, 0, &big) == MP_OKAY) {
+	    if (mp_to_ubin(&big, bytes, sizeof(long), &numBytes) == MP_OKAY) {
+		while (numBytes-- > 0) {
+			value = (value << CHAR_BIT) | *bytes++;
+		}
 		if (big.sign) {
 		    if (value <= 1 + (unsigned long)LONG_MAX) {
 			*longPtr = (long)(-value);
@@ -3361,10 +3364,14 @@ Tcl_GetWideIntFromObj(
 	    mp_int big;
 	    Tcl_WideUInt value = 0;
 	    size_t numBytes;
+	    Tcl_WideInt scratch;
+	    unsigned char *bytes = (unsigned char *) &scratch;
 
 	    TclUnpackBignum(objPtr, big);
-	    if (mp_pack(&value, 1,
-			    &numBytes, 0, sizeof(Tcl_WideUInt), 0, 0, &big) == MP_OKAY) {
+	    if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) {
+		while (numBytes-- > 0) {
+		    value = (value << CHAR_BIT) | *bytes++;
+		}
 		if (big.sign) {
 		    if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
 			*wideIntPtr = (Tcl_WideInt)(-value);
@@ -3440,24 +3447,27 @@ Tcl_GetWideUIntFromObj(
 	if (objPtr->typePtr == &tclBignumType) {
 	    /*
 	     * Must check for those bignum values that can fit in a
-	     * Tcl_WideInt, even when auto-narrowing is enabled.
+	     * Tcl_WideUInt, even when auto-narrowing is enabled.
 	     */
 
 	    mp_int big;
 	    Tcl_WideUInt value = 0;
 	    size_t numBytes;
+	    Tcl_WideUInt scratch;
+	    unsigned char *bytes = (unsigned char *) &scratch;
 
 	    TclUnpackBignum(objPtr, big);
-	    if (mp_pack(&value, 1,
-			    &numBytes, 0, sizeof(Tcl_WideUInt), 0, 0, &big) == MP_OKAY) {
 		if (big.sign == MP_NEG) {
 		    goto wideUIntOutOfRange;
 		}
-		if (value <= (Tcl_WideUInt)UWIDE_MAX) {
-		    *wideUIntPtr = (Tcl_WideUInt)value;
-		    return TCL_OK;
+	    if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideUInt), &numBytes) == MP_OKAY) {
+		while (numBytes-- > 0) {
+		    value = (value << CHAR_BIT) | *bytes++;
 		}
+		*wideUIntPtr = (Tcl_WideUInt)value;
+		return TCL_OK;
 	    }
+
 	    if (interp != NULL) {
 		const char *s = "integer value too large to represent";
 		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
@@ -3518,18 +3528,21 @@ TclGetWideBitsFromObj(
 	    mp_int big;
 	    mp_err err;
 
-	    Tcl_WideUInt value = 0;
+	    Tcl_WideUInt value = 0, scratch;
 	    size_t numBytes;
+	    unsigned char *bytes = (unsigned char *) &scratch;
 
 	    Tcl_GetBignumFromObj(NULL, objPtr, &big);
 	    err = mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big);
 	    if (err == MP_OKAY) {
-		err = mp_pack(&value, 1,
-			&numBytes, 0, sizeof(Tcl_WideUInt), 0, 0, &big);
+		err = mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes);
 	    }
 	    if (err != MP_OKAY) {
 		return TCL_ERROR;
 	    }
+	    while (numBytes-- > 0) {
+		value = (value << CHAR_BIT) | *bytes++;
+	    }
 	    *wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value;
 	    mp_clear(&big);
 	    return TCL_OK;
@@ -3899,15 +3912,19 @@ Tcl_SetBignumObj(
 {
     Tcl_WideUInt value = 0;
     size_t numBytes;
+    Tcl_WideUInt scratch;
+    unsigned char *bytes = (unsigned char *) &scratch;
     mp_int *bignumValue = (mp_int *) big;
 
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
     }
-    if (mp_pack(&value, 1,
-		    &numBytes, 0, sizeof(Tcl_WideUInt), 0, 0, bignumValue) != MP_OKAY) {
+    if (mp_to_ubin(bignumValue, bytes, sizeof(Tcl_WideUInt), &numBytes) != MP_OKAY) {
 	goto tooLargeForWide;
     }
+    while (numBytes-- > 0) {
+	value = (value << CHAR_BIT) | *bytes++;
+    }
     if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
 	goto tooLargeForWide;
     }