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),
--------------------------------------------------------------------------------