More efficient version (after feedback from KBK). Better test too.

4 files changed, 42 insertions, 27 deletions

diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9fc778b..89d7ff9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4514,6 +4514,31 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 
 /*
  *----------------------------------------------------------------
+ * Macro used by the Tcl core to get the bignum out of the bignum
+ * representation of a Tcl_Obj.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE void	TclUnpackBignum(Tcl_Obj *objPtr, mp_int bignum);
+ *----------------------------------------------------------------
+ */
+
+#define TclUnpackBignum(objPtr, bignum) \
+    do {								\
+	register Tcl_Obj *bignumObj = (objPtr);				\
+	register int bignumPayload =					\
+		PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2);	\
+	if (bignumPayload == -1) {					\
+	    (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \
+	} else {							\
+	    (bignum).dp = bignumObj->internalRep.twoPtrValue.ptr1;	\
+	    (bignum).sign = bignumPayload >> 30;			\
+	    (bignum).alloc = (bignumPayload >> 15) & 0x7fff;		\
+	    (bignum).used = bignumPayload & 0x7fff;			\
+	}								\
+    } while (0) 
+
+/*
+ *----------------------------------------------------------------
  * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
  * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
  * "prototype" for this macro is:
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 06a283f..09ba2ed 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -503,7 +503,7 @@ GetUWide(
 	    *widePtr = *((const Tcl_WideInt *) clientData);
 	    return (*widePtr < 0);
 	} else if (type == TCL_NUMBER_BIG) {
-	    mp_int num;
+	    mp_int *numPtr = clientData;
 	    Tcl_WideUInt value = 0;
 	    union {
 		Tcl_WideUInt value;
@@ -512,15 +512,13 @@ GetUWide(
 	    unsigned long numBytes = sizeof(Tcl_WideUInt);
 	    unsigned char *bytes = scratch.bytes;
 
-	    Tcl_GetBignumFromObj(NULL, objPtr, &num);
-	    if (num.sign || (MP_OKAY != mp_to_unsigned_bin_n(&num, bytes,
-		    &numBytes))) {
+	    if (numPtr->sign || (MP_OKAY != mp_to_unsigned_bin_n(numPtr,
+		    bytes, &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.
 		 */
-		mp_clear(&num);
 		return 1;
 	    }
 #ifdef WORDS_BIGENDIAN
@@ -528,10 +526,12 @@ GetUWide(
 		value = (value << CHAR_BIT) | *bytes++;
 	    }
 #else /* !WORDS_BIGENDIAN */
+	    /*
+	     * Little-endian can read the value directly.
+	     */
 	    value = scratch.value;
 #endif /* WORDS_BIGENDIAN */
 	    *uwidePtr = value;
-	    mp_clear(&num);
 	    return 0;
 	}
     }
diff --git a/generic/tclObj.c b/generic/tclObj.c
index f233038..d329aba 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -191,17 +191,6 @@ static Tcl_ThreadDataKey pendingObjDataKey;
 		| ((bignum).alloc << 15) | ((bignum).used));            \
     }
 
-#define UNPACK_BIGNUM(objPtr, bignum) \
-    if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
-	(bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
-    } else {                                                            \
-	(bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1;          \
-	(bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \
-	(bignum).alloc =                                                \
-		(PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7fff; \
-	(bignum).used = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) & 0x7fff; \
-    }
-
 /*
  * Prototypes for functions defined later in this file:
  */
@@ -2517,7 +2506,7 @@ Tcl_GetDoubleFromObj(
 	if (objPtr->typePtr == &tclBignumType) {
 	    mp_int big;
 
-	    UNPACK_BIGNUM(objPtr, big);
+	    TclUnpackBignum(objPtr, big);
 	    *dblPtr = TclBignumToDouble(&big);
 	    return TCL_OK;
 	}
@@ -3033,7 +3022,7 @@ Tcl_GetLongFromObj(
 	    unsigned long scratch, value = 0, numBytes = sizeof(unsigned long);
 	    unsigned char *bytes = (unsigned char *) &scratch;
 
-	    UNPACK_BIGNUM(objPtr, big);
+	    TclUnpackBignum(objPtr, big);
 	    if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
 		while (numBytes-- > 0) {
 			value = (value << CHAR_BIT) | *bytes++;
@@ -3273,7 +3262,7 @@ Tcl_GetWideIntFromObj(
 	    Tcl_WideInt scratch;
 	    unsigned char *bytes = (unsigned char *) &scratch;
 
-	    UNPACK_BIGNUM(objPtr, big);
+	    TclUnpackBignum(objPtr, big);
 	    if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
 		while (numBytes-- > 0) {
 		    value = (value << CHAR_BIT) | *bytes++;
@@ -3387,7 +3376,7 @@ FreeBignum(
 {
     mp_int toFree;		/* Bignum to free */
 
-    UNPACK_BIGNUM(objPtr, toFree);
+    TclUnpackBignum(objPtr, toFree);
     mp_clear(&toFree);
     if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
 	ckfree(objPtr->internalRep.twoPtrValue.ptr1);
@@ -3420,7 +3409,7 @@ DupBignum(
     mp_int bignumCopy;
 
     copyPtr->typePtr = &tclBignumType;
-    UNPACK_BIGNUM(srcPtr, bignumVal);
+    TclUnpackBignum(srcPtr, bignumVal);
     if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
 	Tcl_Panic("initialization failure in DupBignum");
     }
@@ -3455,7 +3444,7 @@ UpdateStringOfBignum(
     int size;
     char *stringVal;
 
-    UNPACK_BIGNUM(objPtr, bignumVal);
+    TclUnpackBignum(objPtr, bignumVal);
     if (MP_OKAY != mp_radix_size(&bignumVal, 10, &size)) {
 	Tcl_Panic("radix size failure in UpdateStringOfBignum");
     }
@@ -3594,10 +3583,10 @@ GetBignumFromObj(
 	    if (copy || Tcl_IsShared(objPtr)) {
 		mp_int temp;
 
-		UNPACK_BIGNUM(objPtr, temp);
+		TclUnpackBignum(objPtr, temp);
 		mp_init_copy(bignumValue, &temp);
 	    } else {
-		UNPACK_BIGNUM(objPtr, *bignumValue);
+		TclUnpackBignum(objPtr, *bignumValue);
 		/* Optimized TclFreeIntRep */
 		objPtr->internalRep.twoPtrValue.ptr1 = NULL;
 		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
@@ -3838,7 +3827,7 @@ TclGetNumberFromObj(
 	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
 		    (int) sizeof(mp_int));
 
-	    UNPACK_BIGNUM(objPtr, *bigPtr);
+	    TclUnpackBignum(objPtr, *bigPtr);
 	    *typePtr = TCL_NUMBER_BIG;
 	    *clientDataPtr = bigPtr;
 	    return TCL_OK;
diff --git a/tests/link.test b/tests/link.test
index e04059f..4c4cf99 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -781,10 +781,11 @@ test link-20.1 {linkarray unsigned wide} -setup {
     lappend mylist [set ::my(var) 120]
     catch {set ::my(var) 1e33} msg
     lappend mylist $msg
+    lappend mylist [set ::my(var) 0xbabed00dbabed00d]
 } -cleanup {
     testlinkarray remove ::my(var)
     unset -nocomplain my
-} -result {{can't set "::my(var)": variable must have unsigned wide int value} 120 {can't set "::my(var)": variable must have unsigned wide int value}}
+} -result {{can't set "::my(var)": variable must have unsigned wide int value} 120 {can't set "::my(var)": variable must have unsigned wide int value} 0xbabed00dbabed00d}
 test link-20.2 {linkarray unsigned wide} -body {
     testlinkarray create uwide 1 ::my(var)
     set ::my(var) 120