Tcl Source Code

Artifact [67eba96285]
Login

Artifact 67eba96285dbb12aef066b7a1d6c9bf0e413187d:

Attachment "tip298.patch" to ticket [1601243fff] added by dgp 2006-11-27 20:15:35.
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.123
diff -u -r1.123 tcl.decls
--- generic/tcl.decls	15 Nov 2006 20:08:42 -0000	1.123
+++ generic/tcl.decls	27 Nov 2006 13:13:20 -0000
@@ -2005,7 +2005,7 @@
     int Tcl_GetBignumFromObj( Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value )
 }
 declare 559 generic {
-    int Tcl_GetBignumAndClearObj( Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value )
+    int Tcl_TakeBignumFromObj( Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value )
 }
 
 # TIP #208 ('chan' Command) jeffh
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.126
diff -u -r1.126 tclDecls.h
--- generic/tclDecls.h	15 Nov 2006 20:08:43 -0000	1.126
+++ generic/tclDecls.h	27 Nov 2006 13:13:20 -0000
@@ -3329,10 +3329,10 @@
 EXTERN int		Tcl_GetBignumFromObj (Tcl_Interp* interp, 
 				Tcl_Obj* obj, mp_int* value);
 #endif
-#ifndef Tcl_GetBignumAndClearObj_TCL_DECLARED
-#define Tcl_GetBignumAndClearObj_TCL_DECLARED
+#ifndef Tcl_TakeBignumFromObj_TCL_DECLARED
+#define Tcl_TakeBignumFromObj_TCL_DECLARED
 /* 559 */
-EXTERN int		Tcl_GetBignumAndClearObj (Tcl_Interp* interp, 
+EXTERN int		Tcl_TakeBignumFromObj (Tcl_Interp* interp, 
 				Tcl_Obj* obj, mp_int* value);
 #endif
 #ifndef Tcl_TruncateChannel_TCL_DECLARED
@@ -4054,7 +4054,7 @@
     Tcl_Obj* (*tcl_DbNewBignumObj) (mp_int* value, CONST char* file, int line); /* 556 */
     void (*tcl_SetBignumObj) (Tcl_Obj* obj, mp_int* value); /* 557 */
     int (*tcl_GetBignumFromObj) (Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value); /* 558 */
-    int (*tcl_GetBignumAndClearObj) (Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value); /* 559 */
+    int (*tcl_TakeBignumFromObj) (Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value); /* 559 */
     int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */
     Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (Tcl_ChannelType * chanTypePtr); /* 561 */
     void (*tcl_SetChannelErrorInterp) (Tcl_Interp* interp, Tcl_Obj* msg); /* 562 */
@@ -6351,9 +6351,9 @@
 #define Tcl_GetBignumFromObj \
 	(tclStubsPtr->tcl_GetBignumFromObj) /* 558 */
 #endif
-#ifndef Tcl_GetBignumAndClearObj
-#define Tcl_GetBignumAndClearObj \
-	(tclStubsPtr->tcl_GetBignumAndClearObj) /* 559 */
+#ifndef Tcl_TakeBignumFromObj
+#define Tcl_TakeBignumFromObj \
+	(tclStubsPtr->tcl_TakeBignumFromObj) /* 559 */
 #endif
 #ifndef Tcl_TruncateChannel
 #define Tcl_TruncateChannel \
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.252
diff -u -r1.252 tclExecute.c
--- generic/tclExecute.c	17 Nov 2006 21:22:18 -0000	1.252
+++ generic/tclExecute.c	27 Nov 2006 13:13:21 -0000
@@ -1102,7 +1102,7 @@
     }
 #endif
 
-    Tcl_GetBignumAndClearObj(interp, valuePtr, &value);
+    Tcl_TakeBignumFromObj(interp, valuePtr, &value);
     Tcl_GetBignumFromObj(interp, incrPtr, &incr);
     mp_add(&value, &incr, &value);
     mp_clear(&incr);
@@ -3465,11 +3465,7 @@
 		l2 = (long) d2;
 		goto longCompare;
 	    case TCL_NUMBER_BIG:
-		if (Tcl_IsShared(value2Ptr)) {
-		    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-		} else {
-		    Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-		}
+		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 		if (mp_cmp_d(&big2, 0) == MP_LT) {
 		    compare = MP_GT;
 		} else {
@@ -3510,11 +3506,7 @@
 		w2 = (Tcl_WideInt) d2;
 		goto wideCompare;
 	    case TCL_NUMBER_BIG:
-		if (Tcl_IsShared(value2Ptr)) {
-		    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-		} else {
-		    Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-		}
+		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 		if (mp_cmp_d(&big2, 0) == MP_LT) {
 		    compare = MP_GT;
 		} else {
@@ -3575,11 +3567,7 @@
 		    compare = (d1 > 0.0) ? MP_GT : MP_LT;
 		    break;
 		}
-		if (Tcl_IsShared(value2Ptr)) {
-		    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-		} else {
-		    Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-		}
+		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 		if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
 		    if (mp_cmp_d(&big2, 0) == MP_LT) {
 			compare = MP_GT;
@@ -3601,11 +3589,7 @@
 	    break;
 
 	case TCL_NUMBER_BIG:
-	    if (Tcl_IsShared(valuePtr)) {
-		Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
 	    switch (type2) {
 #ifndef NO_WIDE_TYPE
 	    case TCL_NUMBER_WIDE:
@@ -3635,11 +3619,7 @@
 		Tcl_InitBignumFromDouble(NULL, d2, &big2);
 		goto bigCompare;
 	    case TCL_NUMBER_BIG:
-		if (Tcl_IsShared(value2Ptr)) {
-		    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-		} else {
-		    Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-		}
+		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 	    bigCompare:
 		compare = mp_cmp(&big1, &big2);
 		mp_clear(&big1);
@@ -3789,11 +3769,7 @@
 #endif
 		{
 		    mp_int big2;
-		    if (Tcl_IsShared(value2Ptr)) {
-			Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-		    } else {
-			Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-		    }
+		    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 
 		    /* TODO: internals intrusion */
 		    if ((l1 > 0) ^ (big2.sign == MP_ZPOS)) {
@@ -3837,11 +3813,7 @@
 		}
 		{
 		    mp_int big2;
-		    if (Tcl_IsShared(value2Ptr)) {
-			Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-		    } else {
-			Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-		    }
+		    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 
 		    /* TODO: internals intrusion */
 		    if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) {
@@ -4041,11 +4013,7 @@
 	{
 	    mp_int big, bigResult, bigRemainder;
 
-	    if (Tcl_IsShared(valuePtr)) {
-		Tcl_GetBignumFromObj(NULL, valuePtr, &big);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
 
 	    mp_init(&bigResult);
 	    if (*pc == INST_LSHIFT) {
@@ -4106,16 +4074,8 @@
 	    mp_int *First, *Second;
 	    int numPos;
 
-	    if (Tcl_IsShared(valuePtr)) {
-		Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1);
-	    }
-	    if (Tcl_IsShared(value2Ptr)) {
-		Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 
 	    /*
 	     * Count how many positive arguments we have. If only one of the
@@ -4720,11 +4680,7 @@
 #endif
 	    case TCL_NUMBER_BIG: {
 		mp_int big2;
-		if (Tcl_IsShared(value2Ptr)) {
-		    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-		} else {
-		    Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-		}
+		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 		negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
 		mp_mod_2d(&big2, 1, &big2);
 		oddExponent = !mp_iszero(&big2);
@@ -4866,16 +4822,8 @@
 	{
 	    mp_int big1, big2, bigResult, bigRemainder;
 	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    if (Tcl_IsShared(valuePtr)) {
-		Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1);
-	    }
-	    if (Tcl_IsShared(value2Ptr)) {
-		Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 	    mp_init(&bigResult);
 	    switch (*pc) {
 	    case INST_ADD:
@@ -4984,11 +4932,7 @@
 	    NEXT_INST_F(1, 0, 0);
 	}
 #endif
-	if (Tcl_IsShared(valuePtr)) {
-	    Tcl_GetBignumFromObj(NULL, valuePtr, &big);
-	} else {
-	    Tcl_GetBignumAndClearObj(NULL, valuePtr, &big);
-	}
+	Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
 	/* ~a = - a - 1 */
 	mp_neg(&big, &big);
 	mp_sub_d(&big, 1, &big);
@@ -5073,11 +5017,7 @@
 		break;
 #endif
 	    case TCL_NUMBER_BIG:
-		if (Tcl_IsShared(valuePtr)) {
-		    Tcl_GetBignumFromObj(NULL, valuePtr, &big);
-		} else {
-		    Tcl_GetBignumAndClearObj(NULL, valuePtr, &big);
-		}
+		Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
 	    }
 	    mp_neg(&big, &big);
 	    if (Tcl_IsShared(valuePtr)) {
Index: generic/tclMathOp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclMathOp.c,v
retrieving revision 1.1
diff -u -r1.1 tclMathOp.c
--- generic/tclMathOp.c	25 Nov 2006 17:18:10 -0000	1.1
+++ generic/tclMathOp.c	27 Nov 2006 13:13:21 -0000
@@ -242,11 +242,7 @@
 #endif
 	case TCL_NUMBER_BIG: {
 	    mp_int big2;
-	    if (Tcl_IsShared(value2Ptr)) {
-		Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 	    negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
 	    mp_mod_2d(&big2, 1, &big2);
 	    oddExponent = !mp_iszero(&big2);
@@ -375,16 +371,8 @@
   overflow:
     {
 	mp_int big1, big2, bigResult, bigRemainder;
-	if (Tcl_IsShared(valuePtr)) {
-	    Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
-	} else {
-	    Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1);
-	}
-	if (Tcl_IsShared(value2Ptr)) {
-	    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-	} else {
-	    Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-	}
+	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 	mp_init(&bigResult);
 	switch (opcode) {
 	case INST_ADD:
@@ -533,16 +521,9 @@
 	mp_int *First, *Second;
 	int numPos;
 
-	if (Tcl_IsShared(valuePtr)) {
-	    Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
-	} else {
-	    Tcl_GetBignumAndClearObj(NULL, valuePtr, &big1);
-	}
-	if (Tcl_IsShared(value2Ptr)) {
-	    Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-	} else {
-	    Tcl_GetBignumAndClearObj(NULL, value2Ptr, &big2);
-	}
+
+	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
 
 	/*
 	 * Count how many positive arguments we have. If only one of the
@@ -867,11 +848,7 @@
 	    l2 = (long) d2;
 	    goto longCompare;
 	case TCL_NUMBER_BIG:
-	    if (Tcl_IsShared(numObj2)) {
-		Tcl_GetBignumFromObj(NULL, numObj2, &big2);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, numObj2, &big2);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, numObj2, &big2);
 	    if (mp_cmp_d(&big2, 0) == MP_LT) {
 		*resultPtr = MP_GT;
 	    } else {
@@ -910,11 +887,7 @@
 	    w2 = (Tcl_WideInt) d2;
 	    goto wideCompare;
 	case TCL_NUMBER_BIG:
-	    if (Tcl_IsShared(numObj2)) {
-		Tcl_GetBignumFromObj(NULL, numObj2, &big2);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, numObj2, &big2);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, numObj2, &big2);
 	    if (mp_cmp_d(&big2, 0) == MP_LT) {
 		*resultPtr = MP_GT;
 	    } else {
@@ -973,11 +946,7 @@
 		*resultPtr = (d1 > 0.0) ? MP_GT : MP_LT;
 		return TCL_OK;
 	    }
-	    if (Tcl_IsShared(numObj2)) {
-		Tcl_GetBignumFromObj(NULL, numObj2, &big2);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, numObj2, &big2);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, numObj2, &big2);
 	    if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
 		if (mp_cmp_d(&big2, 0) == MP_LT) {
 		    *resultPtr = MP_GT;
@@ -999,11 +968,7 @@
 	return TCL_OK;
 
     case TCL_NUMBER_BIG:
-	if (Tcl_IsShared(numObj1)) {
-	    Tcl_GetBignumFromObj(NULL, numObj1, &big1);
-	} else {
-	    Tcl_GetBignumAndClearObj(NULL, numObj1, &big1);
-	}
+	Tcl_TakeBignumFromObj(NULL, numObj1, &big1);
 	switch (type2) {
 #ifndef NO_WIDE_TYPE
 	case TCL_NUMBER_WIDE:
@@ -1033,11 +998,7 @@
 	    Tcl_InitBignumFromDouble(NULL, d2, &big2);
 	    goto bigCompare;
 	case TCL_NUMBER_BIG:
-	    if (Tcl_IsShared(numObj2)) {
-		Tcl_GetBignumFromObj(NULL, numObj2, &big2);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, numObj2, &big2);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, numObj2, &big2);
 	    goto bigCompare;
 	}
     }
@@ -1122,11 +1083,7 @@
     default: {
 	mp_int big;
 
-	if (Tcl_IsShared(objv[1])) {
-	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
-	} else {
-	    Tcl_GetBignumAndClearObj(NULL, objv[1], &big);
-	}
+	Tcl_TakeBignumFromObj(NULL, objv[1], &big);
 	/* ~a = - a - 1 */
 	mp_neg(&big, &big);
 	mp_sub_d(&big, 1, &big);
@@ -1846,11 +1803,7 @@
     {
 	mp_int big, bigResult;
 
-	if (Tcl_IsShared(objv[1])) {
-	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
-	} else {
-	    Tcl_GetBignumAndClearObj(NULL, objv[1], &big);
-	}
+	Tcl_TakeBignumFromObj(NULL, objv[1], &big);
 
 	mp_init(&bigResult);
 	mp_mul_2d(&big, shift, &bigResult);
@@ -2024,11 +1977,7 @@
     {
 	mp_int big, bigResult, bigRemainder;
 
-	if (Tcl_IsShared(objv[1])) {
-	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
-	} else {
-	    Tcl_GetBignumAndClearObj(NULL, objv[1], &big);
-	}
+	Tcl_TakeBignumFromObj(NULL, objv[1], &big);
 
 	mp_init(&bigResult);
 	mp_init(&bigRemainder);
@@ -2173,11 +2122,7 @@
 #endif
 	{
 	    mp_int big2;
-	    if (Tcl_IsShared(objv[2])) {
-		Tcl_GetBignumFromObj(NULL, objv[2], &big2);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, objv[2], &big2);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, objv[2], &big2);
 
 	    /* TODO: internals intrusion */
 	    if ((l1 > 0) ^ (big2.sign == MP_ZPOS)) {
@@ -2216,11 +2161,7 @@
 	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wRemainder));
 	} else {
 	    mp_int big2;
-	    if (Tcl_IsShared(objv[2])) {
-		Tcl_GetBignumFromObj(NULL, objv[2], &big2);
-	    } else {
-		Tcl_GetBignumAndClearObj(NULL, objv[2], &big2);
-	    }
+	    Tcl_TakeBignumFromObj(NULL, objv[2], &big2);
 
 	    /* TODO: internals intrusion */
 	    if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) {
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.115
diff -u -r1.115 tclObj.c
--- generic/tclObj.c	15 Nov 2006 20:08:45 -0000	1.115
+++ generic/tclObj.c	27 Nov 2006 13:13:21 -0000
@@ -2744,12 +2744,6 @@
  *----------------------------------------------------------------------
  */
 
-/*
- * TODO: Consider a smarter Tcl_GetBignumAndClearObj() that doesn't
- * require caller to check for a shared Tcl_Obj, but falls back to
- * Tcl_GetBignumFromObj() when sharing is an issue.
- */
-
 static int
 GetBignumFromObj(
     Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
@@ -2759,14 +2753,11 @@
 {
     do {
 	if (objPtr->typePtr == &tclBignumType) {
-	    if (copy) {
+	    if (copy || Tcl_IsShared(objPtr)) {
 		mp_int temp;
 		UNPACK_BIGNUM(objPtr, temp);
 		mp_init_copy(bignumValue, &temp);
 	    } else {
-		if (Tcl_IsShared(objPtr)) {
-		    Tcl_Panic("Tcl_GetBignumAndClearObj called on shared Tcl_Obj");
-		}
 		UNPACK_BIGNUM(objPtr, *bignumValue);
 		objPtr->internalRep.ptrAndLongRep.ptr = NULL;
 		objPtr->internalRep.ptrAndLongRep.value = 0;
@@ -2841,7 +2832,7 @@
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_GetBignumAndClearObj --
+ * Tcl_TakeBignumFromObj --
  *
  *	This function retrieves a 'bignum' value from a Tcl object, converting
  *	the object if necessary.
@@ -2865,7 +2856,7 @@
  */
 
 int
-Tcl_GetBignumAndClearObj(
+Tcl_TakeBignumFromObj(
     Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
     Tcl_Obj *objPtr,		/* Object to read */
     mp_int *bignumValue)	/* Returned bignum value. */
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.137
diff -u -r1.137 tclStubInit.c
--- generic/tclStubInit.c	15 Nov 2006 20:08:45 -0000	1.137
+++ generic/tclStubInit.c	27 Nov 2006 13:13:21 -0000
@@ -1061,7 +1061,7 @@
     Tcl_DbNewBignumObj, /* 556 */
     Tcl_SetBignumObj, /* 557 */
     Tcl_GetBignumFromObj, /* 558 */
-    Tcl_GetBignumAndClearObj, /* 559 */
+    Tcl_TakeBignumFromObj, /* 559 */
     Tcl_TruncateChannel, /* 560 */
     Tcl_ChannelTruncateProc, /* 561 */
     Tcl_SetChannelErrorInterp, /* 562 */