gmp

Stephen Weeks MLton@sourcelight.com
Tue, 22 Jan 2002 17:02:21 -0800


> As to the Polyspace implementation of gcd, did they do it from scratch or
> hook to the GMP version. 

They hook to the GMP.

> The latter is tricky since it unconditionally does
> allocation (at least in the version in GMP 2.*) and the former is non-trivial.
> Can you send me a pointer?

Below are the diffs they sent me.

> As to shared vs. static linking, as you say, that is orthogonal to including
> or not GMP in MLton except that if we don't include it and we use shared
> libraries then it won't work on machines that don't have it.

Which is why I went for static linking, but not including gmp.

--------------------------------------------------------------------------------

diff -w -c -r mlton-20000906.org/src/basis-library/integer/int-inf.sml /usr/local/mlton-6/src/basis-library/integer/int-inf.sml
*** mlton-20000906.org/src/basis-library/integer/int-inf.sml	Thu Jun 15 02:20:53 2000
--- /usr/local/mlton-6/src/basis-library/integer/int-inf.sml	Fri Feb  2 14:39:53 2001
***************
*** 15,20 ****
--- 15,23 ----
   *)
  structure IntInf: INT_INF_EXTRA =
     struct
+        datatype rep =
+ 	   Small of Word.word
+ 	 | Big of Word.word Vector.vector
        local
  	 structure Prim = Primitive.IntInf
  	 type bigInt = Prim.int
***************
*** 125,130 ****
--- 128,138 ----
  			   end
  		end
  
+ 	 fun rep(x) =
+ 	     if Prim.isSmall(x) then
+ 		 Small(stripTag(x))
+ 	     else
+ 		 Big(Prim.toVector(x));
  	 (*
  	  * Convert a biglInt to a smallInt, raising overflow if it
  	  * is too big.
***************
*** 249,254 ****
--- 257,315 ----
  			end
  
  	 (*
+ 	  * bigInt gcd.
+ 	  *)
+ 	 local fun expensive (lhs: bigInt, rhs: bigInt): bigInt =
+ 		      let val tsize = max (size lhs, size rhs)
+ 		      in Prim.gcd (lhs, rhs, allocate tsize)
+ 		      end
+ 
+ 	       open Int;
+ 
+ 	       fun mod2(x) = Word.toIntX(Word.andb(Word.fromInt(x), 0w1));
+ 	       fun div2(x) = Word.toIntX(Word.>>(Word.fromInt(x), 0w1));
+ 
+ 	       fun gcd_int(0, b, acc) = b*acc
+ 		 | gcd_int(a, 0, acc) = a*acc
+ 		 | gcd_int(a, 1, acc) = acc
+ 		 | gcd_int(1, b, acc) = acc
+ 		 | gcd_int(a, b, acc) =
+ 		   if (a = b) then
+ 		       a*acc
+ 		   else
+ 		       let val a_2 = div2(a);
+ 			   val a_r2 = mod2(a);
+ 			   val b_2 = div2(b);
+ 			   val b_r2 = mod2(b);
+ 		       in
+ 			   if (a_r2 = 0) then
+ 			       if (b_r2 = 0) then
+ 				   gcd_int(a_2, b_2, acc+acc)
+ 			       else
+ 				   gcd_int(a_2, b, acc)
+ 			   else
+ 			       if (b_r2 = 0) then
+ 				   gcd_int(a, b_2, acc)
+ 			       else
+ 				   if (a >= b) then
+ 				       gcd_int(div2(a-b), b, acc)
+ 				   else
+ 				       gcd_int(a, div2(b-a), acc)
+ 		       end;
+ 
+ 	 in fun bigGcd (lhs: bigInt, rhs: bigInt): bigInt =
+ 	     if Prim.areSmall (lhs, rhs)
+ 		 then
+ 		     let val ansv = Word.fromInt(gcd_int(Int.abs(Word.toIntX(stripTag lhs)), Int.abs(Word.toIntX(stripTag rhs)), 1))
+ 			 val ans = addTag ansv
+ 		     in
+ 			 Prim.fromWord ans
+ 		     end
+ 	     else 
+ 		 expensive (lhs, rhs)
+ 	 end
+ 
+ 	 (*
  	  * bigInt addition.
  	  *)
  	 local fun expensive (lhs: bigInt, rhs: bigInt): bigInt =
***************
*** 731,736 ****
--- 792,799 ----
  			  then rem(x + one, y) - one + y
  		       else raise Div
  
+ 	  fun gcd(x, y) =
+ 	      bigGcd(x, y);
         end
  
         fun divMod(x, y) = (x div y, x mod y)
***************
*** 771,776 ****
--- 834,842 ----
  	 val toString = bigToString
  	 val fromString = bigFromString
  	 val scan = bigScan
+ 	 val size = size;
+ 	 val rep = rep;
+ 	 val gcd = gcd;
        end
     end

--------------------------------------------------------------------------------

diff -w -c -r mlton-20000906.org/src/basis-library/misc/primitive.sml /usr/local/mlton-6/src/basis-library/misc/primitive.sml
*** mlton-20000906.org/src/basis-library/misc/primitive.sml	Wed Sep  6 02:03:35 2000
--- /usr/local/mlton-6/src/basis-library/misc/primitive.sml	Fri Feb  2 14:40:00 2001
***************
*** 139,145 ****
  	       
  	    val ascTime = _ffi "Date_asctime": unit -> cstring;
  	    val gmTime = _ffi "Date_gmtime": time ref -> unit;
! 	    val localOffset = _ffi "Date_localOffset": unit -> int;
  	    val localTime = _ffi "Date_localtime": time ref -> unit;
  	    val mkTime = _ffi "Date_mktime": unit -> time;
  	    val strfTime =
--- 139,145 ----
  	       
  	    val ascTime = _ffi "Date_asctime": unit -> cstring;
  	    val gmTime = _ffi "Date_gmtime": time ref -> unit;
! 	    val localOffset = _ffi "Date_localoffset": unit -> int;
  	    val localTime = _ffi "Date_localtime": time ref -> unit;
  	    val mkTime = _ffi "Date_mktime": unit -> time;
  	    val strfTime =
***************
*** 193,198 ****
--- 193,199 ----
  	    val * = _prim "IntInf_mul": int * int * word array -> int;
  	    val + = _prim "IntInf_add": int * int * word array -> int;
  	    val - = _prim "IntInf_sub": int * int * word array -> int;
+ 	    val gcd = _ffi "IntInf_gcd": int * int * word array -> int;
  	    val areSmall = _prim "IntInf_areSmall": int * int -> bool;
  	    val compare = _ffi "IntInf_compare": int * int -> Int.int;
  	    val fromArray = _prim "IntInf_fromArray": word array -> int;

--------------------------------------------------------------------------------

diff -w -c -r mlton-20000906.org/src/runtime/int-inf.c /usr/local/mlton-6/src/runtime/int-inf.c
*** mlton-20000906.org/src/runtime/int-inf.c	Tue Jul 18 20:00:48 2000
--- /usr/local/mlton-6/src/runtime/int-inf.c	Thu Aug  9 15:03:47 2001
***************
*** 200,205 ****
--- 200,229 ----
  
  
  struct intInfRes_t	*
+ IntInf_do_gcd(pointer lhs, pointer rhs, pointer rspace, pointer frontier)
+ {
+ 	bignum		*bp;
+ 	__mpz_struct	lhsmpz,
+ 			rhsmpz,
+ 			resmpz;
+ 	mp_limb_t	lhsspace[2],
+ 			rhsspace[2];
+ 	static struct intInfRes_t	res;
+ 
+ 	bp = toBignum(rspace);
+ 	assert(frontier == (pointer)&bp->limbs[bp->card - 1]);
+ 	fill(lhs, &lhsmpz, lhsspace);
+ 	fill(rhs, &rhsmpz, rhsspace);
+ 	init(bp, &resmpz);
+ 	mpz_gcd(&resmpz, &lhsmpz, &rhsmpz);
+ 	assert((resmpz._mp_alloc < bp->card)
+ 	and (resmpz._mp_d == bp->limbs));
+ 	answer(&resmpz, &res);
+ 	assert((pointer)bp <= res.frontier);
+ 	return (&res);
+ }
+ 
+ struct intInfRes_t	*
  IntInf_do_add(pointer lhs, pointer rhs, pointer rspace, pointer frontier)
  {
  	bignum		*bp;
diff -w -c -r mlton-20000906.org/src/runtime/int-inf.h /usr/local/mlton-6/src/runtime/int-inf.h
*** mlton-20000906.org/src/runtime/int-inf.h	Tue Jul 18 19:59:06 2000
--- /usr/local/mlton-6/src/runtime/int-inf.h	Tue Aug  7 17:57:57 2001
***************
*** 57,62 ****
--- 57,67 ----
  #define	IntInf_areSmall(lhs, rhs)					\
  	(((uint)(lhs) & (uint)(rhs) & 0x1) != 0)
  
+ #define IntInf_gcd(lhs, rhs, space)	(				\
+ 	intInfRes = IntInf_do_gcd((lhs), (rhs), (space), frontier),	\
+ 	frontier = intInfRes->frontier,					\
+ 	intInfRes->value)
+ 
  #define IntInf_add(lhs, rhs, space)	(				\
  	intInfRes = IntInf_do_add((lhs), (rhs), (space), frontier),	\
  	frontier = intInfRes->frontier,					\
***************
*** 94,100 ****
  
  
  extern void	IntInf_init(GC_state state, struct intInfInit inits[]);
! extern struct intInfRes_t	*IntInf_do_add(pointer lhs,
  					     pointer rhs,
  					     pointer rspace,
  					     pointer frontier),
--- 99,109 ----
  
  
  extern void	IntInf_init(GC_state state, struct intInfInit inits[]);
! extern struct intInfRes_t	*IntInf_do_gcd(pointer lhs,
! 					     pointer rhs,
! 					     pointer rspace,
! 					     pointer frontier),
!                                 *IntInf_do_add(pointer lhs,
  					     pointer rhs,
  					     pointer rspace,
  					     pointer frontier),
--------------------------------------------------------------------------------