[MLton-commit] r4334
Matthew Fluet
MLton@mlton.org
Thu, 2 Feb 2006 16:28:52 -0800
Moved IntInf operations into gc runtime, where it has access to objptr
representation.
Simplified IntInf_{quot,rem} by calling mpz_tdiv_{q,r}, which have the
right semantics (round _t_oward zero).
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/TODO
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.h
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc.h
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-02-03 00:28:44 UTC (rev 4334)
@@ -26,7 +26,7 @@
endif
ifeq ($(TARGET_ARCH), amd64)
-FLAGS += -m32 -mtune=opteron
+FLAGS += -m64 -mtune=opteron
endif
ifeq ($(TARGET_ARCH), sparc)
@@ -53,6 +53,7 @@
CC = gcc -std=gnu99
CFLAGS = -Wall -I. -Iplatform $(FLAGS)
OPTCFLAGS = $(CFLAGS) -O2 $(OPTFLAGS)
+GCOPTCFLAGS = --param inline-unit-growth=75 --param max-inline-insns-single=1000
DEBUGCFLAGS = $(CFLAGS) -gstabs+ -g2 -O1 -DASSERT=1
WARNFLAGS = -pedantic -Wall -Wextra -Wno-unused-parameter -Wno-unused-function \
-Wformat-nonliteral \
@@ -189,7 +190,7 @@
$(CC) $(DEBUGCFLAGS) $(DEBUGWARNFLAGS) -c -o $@ $<
gc.o: gc.c $(GCCFILES) $(HFILES)
- $(CC) $(OPTCFLAGS) $(OPTWARNFLAGS) -c -o $@ $<
+ $(CC) $(OPTCFLAGS) $(GCOPTCFLAGS) $(OPTWARNFLAGS) -c -o $@ $<
# It looks like we don't follow the C spec w.r.t. aliasing. And gcc
# -O2 catches us on the code in Real/*.c where we treat a double as a
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-02-03 00:28:44 UTC (rev 4334)
@@ -4,10 +4,9 @@
* Use C99 <assert.h> instead of util/assert.{c,h}
+Fix PackWord{16,32,64}_{sub,upadate}{,Rev} to use byte offset; This
+requires fixing the semantics of the primitives as well.
-Fix PackWord{16,32,64}_{sub,upadate}{,Rev} to use byte offset;
-This requires fixing the semantics of the primitives as well.
-
basis/Int/Word.c
basis/IntInf.c
basis/MLton/allocTooLarge.c
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -1,545 +0,0 @@
-/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- */
-
-#define MLTON_GC_INTERNAL_TYPES
-#define MLTON_GC_INTERNAL_BASIS
-#include "platform.h"
-typedef unsigned int uint;
-
-/* Import the global gcState so we can get and set the frontier. */
-extern struct GC_state gcState;
-
-/*
- * Test if a intInf is a fixnum.
- */
-static inline bool isSmall (pointer arg) {
- return ((uintptr_t)arg & 1);
-}
-
-static inline bool eitherIsSmall (pointer arg1, pointer arg2) {
- return (((uintptr_t)arg1 | (uintptr_t)arg2) & 1);
-}
-
-static inline bool areSmall (pointer arg1, pointer arg2) {
- return ((uintptr_t)arg1 & (uintptr_t)arg2 & 1);
-}
-
-/*
- * Convert a bignum intInf to a bignum pointer.
- */
-static inline GC_intInf toBignum (pointer arg) {
- GC_intInf bp;
-
- assert(not isSmall(arg));
- bp = (GC_intInf)(arg - offsetof(struct GC_intInf, isneg));
- if (DEBUG_INT_INF)
- fprintf (stderr, "bp->header = "FMTHDR"\n", bp->header);
- assert (bp->header == GC_intInfHeader ());
- return bp;
-}
-
-/*
- * Given an intInf, a pointer to an __mpz_struct and something large enough
- * to contain 2 limbs, fill in the __mpz_struct.
- */
-static inline void fill (pointer arg, __mpz_struct *res, mp_limb_t space[2]) {
- GC_intInf bp;
-
- if (DEBUG_INT_INF)
- fprintf (stderr, "fill ("FMTPTR", "FMTPTR", "FMTPTR")\n",
- (uintptr_t)arg, (uintptr_t)res, (uintptr_t)space);
- if (isSmall(arg)) {
- res->_mp_alloc = 2;
- res->_mp_d = space;
- if ((int)arg > 1) {
- res->_mp_size = 1;
- space[0] = (uint)arg >> 1;
- } else if ((int)arg < 0) {
- res->_mp_size = -1;
- space[0] = - (int)((uint)arg>>1 | (uint)1<<31);
- } else
- res->_mp_size = 0;
- } else {
- bp = toBignum(arg);
- res->_mp_alloc = bp->length - 1;
- res->_mp_d = (mp_limb_t*)(bp->limbs);
- res->_mp_size = bp->isneg ? - res->_mp_alloc
- : res->_mp_alloc;
- }
-}
-
-/*
- * Initialize an __mpz_struct to use the space provided by an ML array.
- */
-static inline void initRes (__mpz_struct *mpzp, size_t bytes) {
- GC_intInf bp;
-
- assert (bytes <= (size_t)(gcState.limitPlusSlop - gcState.frontier));
- bp = (GC_intInf)gcState.frontier;
- /* We have as much space for the limbs as there is to the end
- * of the heap. Divide by (sizeof(mp_limb_t)) to get number
- * of limbs.
- */
- mpzp->_mp_alloc = (gcState.limitPlusSlop - (pointer)bp->limbs) / (sizeof(mp_limb_t));
- mpzp->_mp_size = 0; /* is this necessary? */
- mpzp->_mp_d = (mp_limb_t*)(bp->limbs);
-}
-
-/*
- * Count number of leading zeros. The argument will not be zero.
- * This MUST be replaced with assembler.
- */
-static inline uint leadingZeros (mp_limb_t word) {
- uint res;
-
- assert(word != 0);
- res = 0;
- while ((int)word > 0) {
- ++res;
- word <<= 1;
- }
- return (res);
-}
-
-static inline void setFrontier (pointer p, size_t bytes) {
- p = GC_alignFrontier (&gcState, p);
- assert ((size_t)(p - gcState.frontier) <= bytes);
- GC_profileAllocInc (&gcState, p - gcState.frontier);
- gcState.frontier = p;
- assert (gcState.frontier <= gcState.limitPlusSlop);
-}
-
-/*
- * Given an __mpz_struct pointer which reflects the answer, set gcState.frontier
- * and return the answer.
- * If the answer fits in a fixnum, we return that, with the frontier
- * rolled back.
- * If the answer doesn't need all of the space allocated, we adjust
- * the array size and roll the frontier slightly back.
- */
-static pointer answer (__mpz_struct *ans, size_t bytes) {
- GC_intInf bp;
- int size;
-
- bp = (GC_intInf)((pointer)ans->_mp_d - offsetof(struct GC_intInf, limbs));
- assert(ans->_mp_d == (mp_limb_t*)(bp->limbs));
- size = ans->_mp_size;
- if (size < 0) {
- bp->isneg = TRUE;
- size = - size;
- } else
- bp->isneg = FALSE;
- if (size <= 1) {
- uint val,
- ans;
-
- if (size == 0)
- val = 0;
- else
- val = bp->limbs[0];
- if (bp->isneg) {
- /*
- * We only fit if val in [1, 2^30].
- */
- ans = - val;
- val = val - 1;
- } else
- /*
- * We only fit if val in [0, 2^30 - 1].
- */
- ans = val;
- if (val < (uint)1<<30) {
- return (pointer)(ans<<1 | 1);
- }
- }
- setFrontier ((pointer)(&bp->limbs[size]), bytes);
- bp->counter = 0;
- bp->length = size + 1; /* +1 for isNeg word */
- bp->header = GC_intInfHeader ();
- return (pointer)&bp->isneg;
-}
-
-static inline pointer binary (pointer lhs, pointer rhs, size_t bytes,
- void(*binop)(__mpz_struct *resmpz,
- __gmp_const __mpz_struct *lhsspace,
- __gmp_const __mpz_struct *rhsspace)) {
- __mpz_struct lhsmpz,
- rhsmpz,
- resmpz;
- mp_limb_t lhsspace[2],
- rhsspace[2];
-
- initRes (&resmpz, bytes);
- fill (lhs, &lhsmpz, lhsspace);
- fill (rhs, &rhsmpz, rhsspace);
- binop (&resmpz, &lhsmpz, &rhsmpz);
- return answer (&resmpz, bytes);
-}
-
-pointer IntInf_add (pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_add ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_add);
-}
-
-pointer IntInf_gcd (pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_gcd ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_gcd);
-}
-
-pointer IntInf_mul (pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_mul ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_mul);
-}
-
-pointer IntInf_sub (pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_sub ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_sub);
-}
-
-pointer IntInf_andb(pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_andb ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary(lhs, rhs, bytes, &mpz_and);
-}
-
-pointer IntInf_orb(pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_orb ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary(lhs, rhs, bytes, &mpz_ior);
-}
-
-pointer IntInf_xorb(pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_xorb ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary(lhs, rhs, bytes, &mpz_xor);
-}
-
-static pointer
-unary(pointer arg, size_t bytes,
- void(*unop)(__mpz_struct *resmpz,
- __gmp_const __mpz_struct *argspace))
-{
- __mpz_struct argmpz,
- resmpz;
- mp_limb_t argspace[2];
-
- initRes(&resmpz, bytes);
- fill(arg, &argmpz, argspace);
- unop(&resmpz, &argmpz);
- return answer (&resmpz, bytes);
-}
-
-pointer IntInf_neg(pointer arg, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_neg ("FMTPTR", %zu)\n",
- (uintptr_t)arg, bytes);
- return unary(arg, bytes, &mpz_neg);
-}
-
-pointer IntInf_notb(pointer arg, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_notb ("FMTPTR", %zu)\n",
- (uintptr_t)arg, bytes);
- return unary(arg, bytes, &mpz_com);
-}
-
-static pointer
-shary(pointer arg, uint shift, size_t bytes,
- void(*shop)(__mpz_struct *resmpz,
- __gmp_const __mpz_struct *argspace,
- unsigned long shift))
-{
- __mpz_struct argmpz,
- resmpz;
- mp_limb_t argspace[2];
-
- initRes(&resmpz, bytes);
- fill(arg, &argmpz, argspace);
- shop(&resmpz, &argmpz, (unsigned long)shift);
- return answer (&resmpz, bytes);
-}
-
-pointer IntInf_arshift(pointer arg, Word shift_w, size_t bytes) {
- uint shift = (uint)shift_w;
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_arshift ("FMTPTR", %u, %zu)\n",
- (uintptr_t)arg, shift, bytes);
- return shary(arg, shift, bytes, &mpz_fdiv_q_2exp);
-}
-
-pointer IntInf_lshift(pointer arg, Word shift_w, size_t bytes) {
- uint shift = (uint)shift_w;
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_lshift ("FMTPTR", %u, %zu)\n",
- (uintptr_t)arg, shift, bytes);
- return shary(arg, shift, bytes, &mpz_mul_2exp);
-}
-
-Word
-IntInf_smallMul(Word lhs, Word rhs, pointer carry)
-{
- intmax_t prod;
-
- prod = (intmax_t)(int)lhs * (int)rhs;
- *(uint *)carry = (uintmax_t)prod >> 32;
- return ((uint)(uintmax_t)prod);
-}
-
-/*
- * Return an integer which compares to 0 as the two intInf args compare
- * to each other.
- */
-Int IntInf_compare (pointer lhs, pointer rhs) {
- __mpz_struct lhsmpz,
- rhsmpz;
- mp_limb_t lhsspace[2],
- rhsspace[2];
-
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_compare ("FMTPTR", "FMTPTR")\n",
- (uintptr_t)lhs, (uintptr_t)rhs);
- fill (lhs, &lhsmpz, lhsspace);
- fill (rhs, &rhsmpz, rhsspace);
- return mpz_cmp (&lhsmpz, &rhsmpz);
-}
-
-/*
- * Check if two IntInf.int's are equal.
- */
-Bool IntInf_equal (pointer lhs, pointer rhs) {
- if (lhs == rhs)
- return TRUE;
- if (eitherIsSmall (lhs, rhs))
- return FALSE;
- else
- return 0 == IntInf_compare (lhs, rhs);
-}
-
-/*
- * Convert an intInf to a string.
- * Arg is an intInf, base is the base to use (2, 8, 10 or 16) and space is a
- * string (mutable) which is large enough.
- */
-pointer IntInf_toString (pointer arg, int base, size_t bytes) {
- GC_string sp;
- __mpz_struct argmpz;
- mp_limb_t argspace[2];
- char *str;
- uint size;
- uint i;
- char c;
-
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_toString ("FMTPTR", %d, %zu)\n",
- (uintptr_t)arg, base, bytes);
- assert (base == 2 || base == 8 || base == 10 || base == 16);
- fill (arg, &argmpz, argspace);
- sp = (GC_string)gcState.frontier;
- str = mpz_get_str(sp->chars, base, &argmpz);
- assert(str == sp->chars);
- size = strlen(str);
- if (*sp->chars == '-')
- *sp->chars = '~';
- if (base > 0)
- for (i = 0; i < size; i++) {
- c = sp->chars[i];
- if (('a' <= c) && (c <= 'z'))
- sp->chars[i] = c + ('A' - 'a');
- }
- sp->counter = 0;
- sp->length = size;
- sp->header = GC_stringHeader ();
- setFrontier ((pointer)(&sp->chars[align(size, 4)]), bytes);
- return (pointer)str;
-}
-
-/*
- * Quotient (round towards 0, remainder is returned by IntInf_rem).
- * space is a word array with enough space for the quotient
- * num limbs + 1 - den limbs
- * shifted numerator
- * num limbs + 1
- * and shifted denominator
- * den limbs
- * and the isNeg word.
- * It must be the last thing allocated.
- * num is the numerator bignum, den is the denominator and frontier is
- * the current frontier.
- */
-pointer IntInf_quot (pointer num, pointer den, size_t bytes) {
- __mpz_struct resmpz,
- nmpz,
- dmpz;
- mp_limb_t nss[2],
- dss[2],
- carry,
- *np,
- *dp;
- int nsize,
- dsize,
- qsize;
- bool resIsNeg;
- uint shift;
-
- initRes(&resmpz, bytes);
- fill(num, &nmpz, nss);
- resIsNeg = FALSE;
- nsize = nmpz._mp_size;
- if (nsize < 0) {
- nsize = - nsize;
- resIsNeg = TRUE;
- }
- fill(den, &dmpz, dss);
- dsize = dmpz._mp_size;
- if (dsize < 0) {
- dsize = - dsize;
- resIsNeg = not resIsNeg;
- }
- assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0);
- assert((nsize == 0 && dsize == 1)
- or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0));
- qsize = 1 + nsize - dsize;
- if (dsize == 1) {
- if (nsize == 0)
- return (pointer)1; /* tagged 0 */
- mpn_divrem_1(resmpz._mp_d,
- (mp_size_t)0,
- nmpz._mp_d,
- nsize,
- dmpz._mp_d[0]);
- if (resmpz._mp_d[qsize - 1] == 0)
- --qsize;
- } else {
- np = &resmpz._mp_d[qsize];
- shift = leadingZeros(dmpz._mp_d[dsize - 1]);
- if (shift == 0) {
- dp = dmpz._mp_d;
- memcpy((void *)np,
- nmpz._mp_d,
- nsize * sizeof(*nmpz._mp_d));
- } else {
- carry = mpn_lshift(np, nmpz._mp_d, nsize, shift);
- unless (carry == 0)
- np[nsize++] = carry;
- dp = &np[nsize];
- mpn_lshift(dp, dmpz._mp_d, dsize, shift);
- }
- carry = mpn_divrem(resmpz._mp_d,
- (mp_size_t)0,
- np,
- nsize,
- dp,
- dsize);
- qsize = nsize - dsize;
- if (carry != 0)
- resmpz._mp_d[qsize++] = carry;
- }
- resmpz._mp_size = resIsNeg ? - qsize : qsize;
- return answer (&resmpz, bytes);
-}
-
-
-/*
- * Remainder (sign taken from numerator, quotient is returned by IntInf_quot).
- * space is a word array with enough space for the remainder
- * den limbs
- * shifted numerator
- * num limbs + 1
- * and shifted denominator
- * den limbs
- * and the isNeg word.
- * It must be the last thing allocated.
- * num is the numerator bignum, den is the denominator and frontier is
- * the current frontier.
- */
-pointer IntInf_rem (pointer num, pointer den, size_t bytes) {
- __mpz_struct resmpz,
- nmpz,
- dmpz;
- mp_limb_t nss[2],
- dss[2],
- carry,
- *dp;
- int nsize,
- dsize;
- bool resIsNeg;
- uint shift;
-
- initRes(&resmpz, bytes);
- fill(num, &nmpz, nss);
- nsize = nmpz._mp_size;
- resIsNeg = nsize < 0;
- if (resIsNeg)
- nsize = - nsize;
- fill(den, &dmpz, dss);
- dsize = dmpz._mp_size;
- if (dsize < 0)
- dsize = - dsize;
- assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0);
- assert((nsize == 0 && dsize == 1)
- or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0));
- if (dsize == 1) {
- if (nsize == 0)
- resmpz._mp_size = 0;
- else {
- carry = mpn_mod_1(nmpz._mp_d, nsize, dmpz._mp_d[0]);
- if (carry == 0)
- nsize = 0;
- else {
- resmpz._mp_d[0] = carry;
- nsize = 1;
- }
- }
- } else {
- shift = leadingZeros(dmpz._mp_d[dsize - 1]);
- if (shift == 0) {
- dp = dmpz._mp_d;
- memcpy((void *)resmpz._mp_d,
- (void *)nmpz._mp_d,
- nsize * sizeof(*nmpz._mp_d));
- } else {
- carry = mpn_lshift(resmpz._mp_d,
- nmpz._mp_d,
- nsize,
- shift);
- unless (carry == 0)
- resmpz._mp_d[nsize++] = carry;
- dp = &resmpz._mp_d[nsize];
- mpn_lshift(dp, dmpz._mp_d, dsize, shift);
- }
- mpn_divrem(&resmpz._mp_d[dsize],
- (mp_size_t)0,
- resmpz._mp_d,
- nsize,
- dp,
- dsize);
- nsize = dsize;
- assert(nsize > 0);
- while (resmpz._mp_d[nsize - 1] == 0)
- if (--nsize == 0)
- break;
- unless (nsize == 0 || shift == 0) {
- mpn_rshift(resmpz._mp_d, resmpz._mp_d, nsize, shift);
- if (resmpz._mp_d[nsize - 1] == 0)
- --nsize;
- }
- }
- resmpz._mp_size = resIsNeg ? - nsize : nsize;
- return answer (&resmpz, bytes);
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -26,6 +26,3 @@
return (pointer)res;
}
-pointer GC_alignFrontier (GC_state s, pointer p) {
- return alignFrontier (s, p);
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -13,9 +13,3 @@
static inline pointer alignFrontier (GC_state s, pointer p);
#endif /* (defined (MLTON_GC_INTERNAL_FUNCS)) */
-
-#if (defined (MLTON_GC_INTERNAL_BASIS))
-
-pointer GC_alignFrontier (GC_state s, pointer p);
-
-#endif /* (defined (MLTON_GC_INTERNAL_BASIS)) */
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -1,17 +0,0 @@
-/* Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- */
-
-/*
- * Various assumptions about the underlying C translator. This is the
- * place for characteristics that are not dictated by the C standard,
- * but which are reasonable to assume on a wide variety of target
- * platforms. Working around these assumptions would be difficult.
- */
-void checkAssumptions (void) {
- assert(CHAR_BIT == 8);
- /* assert(repof(uintptr_t) == TWOS); */
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -19,6 +19,7 @@
DEBUG_ENTER_LEAVE = FALSE,
DEBUG_GENERATIONAL = FALSE,
DEBUG_INT_INF = FALSE,
+ DEBUG_INT_INF_DETAILED = FALSE,
DEBUG_MARK_COMPACT = FALSE,
DEBUG_MEM = FALSE,
DEBUG_PROFILE = FALSE,
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -10,27 +10,27 @@
/* Initialization */
/* ---------------------------------------------------------------- */
+size_t sizeofIntInfFromString (GC_state s, const char *str) {
+ size_t slen = strlen (str);
+
+ /* A slight overestimate. */
+ double bytesPerChar = 0.415241011861 /* = ((log(10.0) / log(2.0)) / 8.0) */ ;
+ double bytes = ceil((double)slen * bytesPerChar);
+ return align (GC_ARRAY_HEADER_SIZE
+ + sizeof(mp_limb_t) // for the sign
+ + align((size_t)bytes, sizeof(mp_limb_t)),
+ s->alignment);
+}
+
size_t sizeofInitialBytesLive (GC_state s) {
uint32_t i;
- size_t maxSLen = 0;
size_t numBytes;
size_t total;
total = 0;
for (i = 0; i < s->intInfInitsLength; ++i) {
- size_t slen = strlen (s->intInfInits[i].mlstr);
- maxSLen = max (maxSLen, slen);
- double bytesPerChar = 0.415241011861 /* = ((log(10.0) / log(2.0)) / 8.0) */ ;
- double bytes = ceil((double)slen * bytesPerChar);
- /* A slight overestimate. */
- numBytes =
- sizeof(mp_limb_t) // for the sign
- + (align((size_t)bytes, sizeof(mp_limb_t)));
- total += align (GC_ARRAY_HEADER_SIZE
- + numBytes,
- s->alignment);
+ total += sizeofIntInfFromString (s, s->intInfInits[i].mlstr);
}
- total += maxSLen;
for (i = 0; i < s->vectorInitsLength; ++i) {
numBytes =
s->vectorInits[i].bytesPerElement
@@ -46,68 +46,30 @@
void initIntInfs (GC_state s) {
struct GC_intInfInit *inits;
- pointer frontier;
+ uint32_t i;
const char *str;
- size_t slen;
- mp_size_t alen;
- uint32_t i, j;
+ size_t bytes;
bool neg;
- GC_intInf bp;
- unsigned char *cp;
+ __mpz_struct resmpz;
+ int ans;
assert (isFrontierAligned (s, s->frontier));
- frontier = s->frontier;
for (i = 0; i < s->intInfInitsLength; i++) {
inits = &(s->intInfInits[i]);
- str = inits->mlstr;
assert (inits->globalIndex < s->globalsLength);
+ str = inits->mlstr;
+ bytes = sizeofIntInfFromString (s, str);
neg = *str == '~';
if (neg)
str++;
- slen = strlen (str);
- assert (slen > 0);
- bp = (GC_intInf)frontier;
- cp = (unsigned char*)(s->heap.start + (s->heap.size - slen));
-
- for (j = 0; j != slen; j++) {
- assert ('0' <= str[j] && str[j] <= '9');
- cp[j] = str[j] - '0' + 0;
- }
- alen = mpn_set_str ((mp_limb_t*)(bp->limbs), cp, slen, 10);
- if (alen <= 1) {
- uintmax_t val, ans;
-
- if (alen == 0)
- val = 0;
- else
- val = bp->limbs[0];
- if (neg) {
- /*
- * We only fit if val in [1, 2^(CHAR_BIT * OBJPTR_SIZE - 2)].
- */
- ans = - val;
- val = val - 1;
- } else
- /*
- * We only fit if val in [0, 2^(CHAR_BIT * OBJPTR_SIZE - 2) - 1].
- */
- ans = val;
- if (val < (uintmax_t)1<<(CHAR_BIT * OBJPTR_SIZE - 2)) {
- s->globals[inits->globalIndex] = (objptr)(ans<<1 | 1);
- continue;
- }
- }
- s->globals[inits->globalIndex] = pointerToObjptr((pointer)(&bp->isneg), s->heap.start);
- bp->counter = 0;
- bp->length = alen + 1;
- bp->header = GC_INTINF_HEADER;
- bp->isneg = neg;
- frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
+ initIntInfRes (s, &resmpz, bytes);
+ ans = mpz_set_str (&resmpz, str, 10);
+ assert (ans == 0);
+ if (neg)
+ resmpz._mp_size = - resmpz._mp_size;
+ s->globals[inits->globalIndex] = finiIntInfRes (s, &resmpz, bytes);
}
- assert (isFrontierAligned (s, frontier));
- GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
- s->frontier = frontier;
- s->cumulativeStatistics.bytesAllocated += frontier - s->frontier;
+ assert (isFrontierAligned (s, s->frontier));
}
void initVectors (GC_state s) {
@@ -185,6 +147,8 @@
createCardMapAndCrossMap (s);
start = alignFrontier (s, s->heap.start);
s->frontier = start;
+ s->limitPlusSlop = s->heap.start + s->heap.size;
+ s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP;
initIntInfs (s);
initVectors (s);
assert ((size_t)(s->frontier - start) <= s->lastMajorStatistics.bytesLive);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -36,7 +36,8 @@
#if (defined (MLTON_GC_INTERNAL_FUNCS))
-static size_t sizeofInitialBytesLive (GC_state s);
+static inline size_t sizeofIntInfFromString (GC_state s, const char *str);
+static inline size_t sizeofInitialBytesLive (GC_state s);
static void initIntInfs (GC_state s);
static void initVectors (GC_state s);
static void initWorld (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -6,15 +6,6 @@
* See the file MLton-LICENSE for details.
*/
-typedef unsigned int uint;
-
-COMPILE_TIME_ASSERT(sizeof_mp_limb_t__compat__sizeof_objptr,
- (sizeof(mp_limb_t) >= sizeof(objptr)) ||
- (sizeof(objptr) % sizeof(mp_limb_t) == 0));
-#define LIMBS_PER_OBJPTR ( \
- sizeof(mp_limb_t) >= sizeof(objptr) ? \
- 1 : sizeof(objptr) / sizeof(mp_limb_t))
-
/* Import the global gcState so we can get and set the frontier. */
extern struct GC_state gcState;
@@ -25,22 +16,22 @@
return (arg & 1);
}
-static inline bool eitherIsSmall (objptr arg1, objptr arg2) {
- return ((arg1 | arg2) & 1);
+static inline bool isEitherSmall (objptr arg1, objptr arg2) {
+ return ((arg1 | arg2) & (objptr)1);
}
static inline bool areSmall (objptr arg1, objptr arg2) {
- return (arg1 & arg2 & 1);
+ return (arg1 & arg2 & (objptr)1);
}
/*
* Convert a bignum intInf to a bignum pointer.
*/
-static inline GC_intInf toBignum (objptr arg) {
+static inline GC_intInf toBignum (GC_state s, objptr arg) {
GC_intInf bp;
- assert(not isSmall(arg));
- bp = (GC_intInf)(objptrToPointer(arg, gcState.heap.start)
+ assert (not isSmall(arg));
+ bp = (GC_intInf)(objptrToPointer(arg, s->heap.start)
- offsetof(struct GC_intInf, isneg));
if (DEBUG_INT_INF)
fprintf (stderr, "bp->header = "FMTHDR"\n", bp->header);
@@ -50,29 +41,29 @@
/*
* Given an intInf, a pointer to an __mpz_struct and space large
- * enough to contain 2 * LIMBS_PER_OBJPTR limbs, fill in the
+ * enough to contain LIMBS_PER_OBJPTR + 1 limbs, fill in the
* __mpz_struct.
*/
-static inline void fill (objptr arg, __mpz_struct *res,
- mp_limb_t space[2 * LIMBS_PER_OBJPTR]) {
+void fillIntInfArg (GC_state s, objptr arg, __mpz_struct *res,
+ mp_limb_t space[LIMBS_PER_OBJPTR + 1]) {
GC_intInf bp;
if (DEBUG_INT_INF)
- fprintf (stderr, "fill ("FMTOBJPTR", "FMTPTR", "FMTPTR")\n",
+ fprintf (stderr, "fillIntInfArg ("FMTOBJPTR", "FMTPTR", "FMTPTR")\n",
arg, (uintptr_t)res, (uintptr_t)space);
if (isSmall(arg)) {
- res->_mp_alloc = 2 * LIMBS_PER_OBJPTR;
+ res->_mp_alloc = LIMBS_PER_OBJPTR + 1;
res->_mp_d = space;
- if (arg == 0) {
+ if (arg == (objptr)1) {
res->_mp_size = 0;
} else {
- objptr highBit = (objptr)1 << (CHAR_BIT * OBJPTR_SIZE - 1);
- bool neg = (arg & highBit) != (objptr)0;
+ objptr highBitMask = (objptr)1 << (CHAR_BIT * OBJPTR_SIZE - 1);
+ bool neg = (arg & highBitMask) != (objptr)0;
if (neg) {
- res->_mp_size = - LIMBS_PER_OBJPTR;
- arg = -((arg >> 1) | highBit);
+ res->_mp_size = - (mp_size_t)LIMBS_PER_OBJPTR;
+ arg = -((arg >> 1) | highBitMask);
} else {
- res->_mp_size = LIMBS_PER_OBJPTR;
+ res->_mp_size = (mp_size_t)LIMBS_PER_OBJPTR;
arg = (arg >> 1);
}
for (unsigned int i = 0; i < LIMBS_PER_OBJPTR; i++) {
@@ -81,480 +72,299 @@
}
}
} else {
- bp = toBignum(arg);
+ bp = toBignum (s, arg);
res->_mp_alloc = bp->length - 1;
res->_mp_d = (mp_limb_t*)(bp->limbs);
res->_mp_size = bp->isneg ? - res->_mp_alloc : res->_mp_alloc;
}
+ assert ((res->_mp_size == 0)
+ or (res->_mp_d[(res->_mp_size < 0
+ ? - res->_mp_size
+ : res->_mp_size) - 1] != 0));
+ if (DEBUG_INT_INF_DETAILED)
+ fprintf (stderr, "arg --> %s\n",
+ mpz_get_str (NULL, 10, res));
}
-/* /\* */
-/* * Initialize an __mpz_struct to use the space provided by an ML array. */
-/* *\/ */
-/* static inline void initRes (__mpz_struct *mpzp, size_t bytes) { */
-/* GC_intInf bp; */
+/*
+ * Initialize an __mpz_struct to use the space provided by the heap.
+ */
+void initIntInfRes (GC_state s, __mpz_struct *res, size_t bytes) {
+ GC_intInf bp;
-/* assert (bytes <= (size_t)(gcState.limitPlusSlop - gcState.frontier)); */
-/* bp = (GC_intInf)gcState.frontier; */
-/* /\* We have as much space for the limbs as there is to the end */
-/* * of the heap. Divide by (sizeof(mp_limb_t)) to get number */
-/* * of limbs. */
-/* *\/ */
-/* mpzp->_mp_alloc = (gcState.limitPlusSlop - (pointer)bp->limbs) / (sizeof(mp_limb_t)); */
-/* mpzp->_mp_size = 0; /\* is this necessary? *\/ */
-/* mpzp->_mp_d = (mp_limb_t*)(bp->limbs); */
-/* } */
+ assert (bytes <= (size_t)(s->limitPlusSlop - s->frontier));
+ bp = (GC_intInf)s->frontier;
+ /* We have as much space for the limbs as there is to the end of the
+ * heap. Divide by (sizeof(mp_limb_t)) to get number of limbs.
+ */
+ res->_mp_alloc = (s->limitPlusSlop - (pointer)bp->limbs) / (sizeof(mp_limb_t));
+ res->_mp_d = (mp_limb_t*)(bp->limbs);
+ res->_mp_size = 0; /* is this necessary? */
+}
-/* /\* */
-/* * Count number of leading zeros. The argument will not be zero. */
-/* * This MUST be replaced with assembler. */
-/* *\/ */
-/* static inline uint leadingZeros (mp_limb_t word) { */
-/* uint res; */
+/*
+ * Given an __mpz_struct pointer which reflects the answer, set
+ * gcState.frontier and return the answer.
+ * If the answer fits in a fixnum, we return that, with the frontier
+ * rolled back.
+ * If the answer doesn't need all of the space allocated, we adjust
+ * the array size and roll the frontier slightly back.
+ */
+objptr finiIntInfRes (GC_state s, __mpz_struct *res, size_t bytes) {
+ GC_intInf bp;
+ mp_size_t size;
-/* assert(word != 0); */
-/* res = 0; */
-/* while ((int)word > 0) { */
-/* ++res; */
-/* word <<= 1; */
-/* } */
-/* return (res); */
-/* } */
+ assert ((res->_mp_size == 0)
+ or (res->_mp_d[(res->_mp_size < 0
+ ? - res->_mp_size
+ : res->_mp_size) - 1] != 0));
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "finiIntInfRes ("FMTPTR", %zu)\n",
+ (uintptr_t)res, bytes);
+ if (DEBUG_INT_INF_DETAILED)
+ fprintf (stderr, "res --> %s\n",
+ mpz_get_str (NULL, 10, res));
+ bp = (GC_intInf)((pointer)res->_mp_d - offsetof(struct GC_intInf, limbs));
+ assert (res->_mp_d == (mp_limb_t*)(bp->limbs));
+ size = res->_mp_size;
+ if (size < 0) {
+ bp->isneg = TRUE;
+ size = - size;
+ } else
+ bp->isneg = FALSE;
+ if (size <= 1) {
+ uintmax_t val, ans;
-/* static inline void setFrontier (pointer p, size_t bytes) { */
-/* p = GC_alignFrontier (&gcState, p); */
-/* assert ((size_t)(p - gcState.frontier) <= bytes); */
-/* GC_profileAllocInc (&gcState, p - gcState.frontier); */
-/* gcState.frontier = p; */
-/* assert (gcState.frontier <= gcState.limitPlusSlop); */
-/* } */
+ if (size == 0)
+ val = 0;
+ else
+ val = bp->limbs[0];
+ if (bp->isneg) {
+ /*
+ * We only fit if val in [1, 2^(CHAR_BIT * OBJPTR_SIZE - 2)].
+ */
+ ans = - val;
+ val = val - 1;
+ } else
+ /*
+ * We only fit if val in [0, 2^(CHAR_BIT * OBJPTR_SIZE - 2) - 1].
+ */
+ ans = val;
+ if (val < (uintmax_t)1<<(CHAR_BIT * OBJPTR_SIZE - 2)) {
+ return (objptr)(ans<<1 | 1);
+ }
+ }
+ setFrontier (s, (pointer)(&bp->limbs[size]), bytes);
+ bp->counter = 0;
+ bp->length = size + 1; /* +1 for isneg field */
+ bp->header = GC_INTINF_HEADER;
+ return pointerToObjptr ((pointer)&bp->isneg, s->heap.start);
+}
-/* /\* */
-/* * Given an __mpz_struct pointer which reflects the answer, set gcState.frontier */
-/* * and return the answer. */
-/* * If the answer fits in a fixnum, we return that, with the frontier */
-/* * rolled back. */
-/* * If the answer doesn't need all of the space allocated, we adjust */
-/* * the array size and roll the frontier slightly back. */
-/* *\/ */
-/* static pointer answer (__mpz_struct *ans, size_t bytes) { */
-/* GC_intInf bp; */
-/* int size; */
+static inline objptr binary (objptr lhs, objptr rhs, size_t bytes,
+ void(*binop)(__mpz_struct *resmpz,
+ __gmp_const __mpz_struct *lhsspace,
+ __gmp_const __mpz_struct *rhsspace)) {
+ __mpz_struct lhsmpz, rhsmpz, resmpz;
+ mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];
+
+ initIntInfRes (&gcState, &resmpz, bytes);
+ fillIntInfArg (&gcState, lhs, &lhsmpz, lhsspace);
+ fillIntInfArg (&gcState, rhs, &rhsmpz, rhsspace);
+ binop (&resmpz, &lhsmpz, &rhsmpz);
+ return finiIntInfRes (&gcState, &resmpz, bytes);
+}
-/* bp = (GC_intInf)((pointer)ans->_mp_d - offsetof(struct GC_intInf, limbs)); */
-/* assert(ans->_mp_d == (mp_limb_t*)(bp->limbs)); */
-/* size = ans->_mp_size; */
-/* if (size < 0) { */
-/* bp->isneg = TRUE; */
-/* size = - size; */
-/* } else */
-/* bp->isneg = FALSE; */
-/* if (size <= 1) { */
-/* uint val, */
-/* ans; */
+objptr IntInf_add (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_add ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_add);
+}
-/* if (size == 0) */
-/* val = 0; */
-/* else */
-/* val = bp->limbs[0]; */
-/* if (bp->isneg) { */
-/* /\* */
-/* * We only fit if val in [1, 2^30]. */
-/* *\/ */
-/* ans = - val; */
-/* val = val - 1; */
-/* } else */
-/* /\* */
-/* * We only fit if val in [0, 2^30 - 1]. */
-/* *\/ */
-/* ans = val; */
-/* if (val < (uint)1<<30) { */
-/* return (pointer)(ans<<1 | 1); */
-/* } */
-/* } */
-/* setFrontier ((pointer)(&bp->limbs[size]), bytes); */
-/* bp->counter = 0; */
-/* bp->length = size + 1; /\* +1 for isNeg word *\/ */
-/* bp->header = GC_intInfHeader (); */
-/* return (pointer)&bp->isneg; */
-/* } */
+objptr IntInf_andb (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_andb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_and);
+}
-/* static inline pointer binary (pointer lhs, pointer rhs, size_t bytes, */
-/* void(*binop)(__mpz_struct *resmpz, */
-/* __gmp_const __mpz_struct *lhsspace, */
-/* __gmp_const __mpz_struct *rhsspace)) { */
-/* __mpz_struct lhsmpz, */
-/* rhsmpz, */
-/* resmpz; */
-/* mp_limb_t lhsspace[2], */
-/* rhsspace[2]; */
+objptr IntInf_gcd (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_gcd ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_gcd);
+}
-/* initRes (&resmpz, bytes); */
-/* fill (lhs, &lhsmpz, lhsspace); */
-/* fill (rhs, &rhsmpz, rhsspace); */
-/* binop (&resmpz, &lhsmpz, &rhsmpz); */
-/* return answer (&resmpz, bytes); */
-/* } */
+objptr IntInf_mul (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_mul ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_mul);
+}
-/* pointer IntInf_add (pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_add ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary (lhs, rhs, bytes, &mpz_add); */
-/* } */
+objptr IntInf_quot (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_quot ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_tdiv_q);
+}
-/* pointer IntInf_gcd (pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_gcd ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary (lhs, rhs, bytes, &mpz_gcd); */
-/* } */
+objptr IntInf_orb (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_orb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_ior);
+}
-/* pointer IntInf_mul (pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_mul ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary (lhs, rhs, bytes, &mpz_mul); */
-/* } */
+objptr IntInf_rem (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_quot ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_tdiv_r);
+}
-/* pointer IntInf_sub (pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_sub ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary (lhs, rhs, bytes, &mpz_sub); */
-/* } */
+objptr IntInf_sub (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_sub ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_sub);
+}
-/* pointer IntInf_andb(pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_andb ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary(lhs, rhs, bytes, &mpz_and); */
-/* } */
+objptr IntInf_xorb (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_xorb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_xor);
+}
-/* pointer IntInf_orb(pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_orb ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary(lhs, rhs, bytes, &mpz_ior); */
-/* } */
+static objptr unary (objptr arg, size_t bytes,
+ void(*unop)(__mpz_struct *resmpz,
+ __gmp_const __mpz_struct *argspace)) {
+ __mpz_struct argmpz, resmpz;
+ mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
-/* pointer IntInf_xorb(pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_xorb ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary(lhs, rhs, bytes, &mpz_xor); */
-/* } */
+ initIntInfRes (&gcState, &resmpz, bytes);
+ fillIntInfArg (&gcState, arg, &argmpz, argspace);
+ unop (&resmpz, &argmpz);
+ return finiIntInfRes (&gcState, &resmpz, bytes);
+}
-/* static pointer */
-/* unary(pointer arg, size_t bytes, */
-/* void(*unop)(__mpz_struct *resmpz, */
-/* __gmp_const __mpz_struct *argspace)) */
-/* { */
-/* __mpz_struct argmpz, */
-/* resmpz; */
-/* mp_limb_t argspace[2]; */
+objptr IntInf_neg (objptr arg, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_neg ("FMTOBJPTR", %zu)\n",
+ arg, bytes);
+ return unary (arg, bytes, &mpz_neg);
+}
-/* initRes(&resmpz, bytes); */
-/* fill(arg, &argmpz, argspace); */
-/* unop(&resmpz, &argmpz); */
-/* return answer (&resmpz, bytes); */
-/* } */
+objptr IntInf_notb (objptr arg, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_notb ("FMTOBJPTR", %zu)\n",
+ arg, bytes);
+ return unary (arg, bytes, &mpz_com);
+}
-/* pointer IntInf_neg(pointer arg, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_neg ("FMTPTR", %zu)\n", */
-/* (uintptr_t)arg, bytes); */
-/* return unary(arg, bytes, &mpz_neg); */
-/* } */
+static objptr shary (objptr arg, uint32_t shift, size_t bytes,
+ void(*shop)(__mpz_struct *resmpz,
+ __gmp_const __mpz_struct *argspace,
+ unsigned long shift))
+{
+ __mpz_struct argmpz, resmpz;
+ mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
-/* pointer IntInf_notb(pointer arg, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_notb ("FMTPTR", %zu)\n", */
-/* (uintptr_t)arg, bytes); */
-/* return unary(arg, bytes, &mpz_com); */
-/* } */
+ initIntInfRes (&gcState, &resmpz, bytes);
+ fillIntInfArg (&gcState, arg, &argmpz, argspace);
+ shop (&resmpz, &argmpz, (unsigned long)shift);
+ return finiIntInfRes (&gcState, &resmpz, bytes);
+}
-/* static pointer */
-/* shary(pointer arg, uint shift, size_t bytes, */
-/* void(*shop)(__mpz_struct *resmpz, */
-/* __gmp_const __mpz_struct *argspace, */
-/* unsigned long shift)) */
-/* { */
-/* __mpz_struct argmpz, */
-/* resmpz; */
-/* mp_limb_t argspace[2]; */
+objptr IntInf_arshift (objptr arg, uint32_t shift, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_arshift ("FMTOBJPTR", %"PRIu32", %zu)\n",
+ arg, shift, bytes);
+ return shary (arg, shift, bytes, &mpz_fdiv_q_2exp);
+}
-/* initRes(&resmpz, bytes); */
-/* fill(arg, &argmpz, argspace); */
-/* shop(&resmpz, &argmpz, (unsigned long)shift); */
-/* return answer (&resmpz, bytes); */
-/* } */
+objptr IntInf_lshift (objptr arg, uint32_t shift, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_lshift ("FMTOBJPTR", %"PRIu32", %zu)\n",
+ arg, shift, bytes);
+ return shary(arg, shift, bytes, &mpz_mul_2exp);
+}
-/* pointer IntInf_arshift(pointer arg, Word shift_w, size_t bytes) { */
-/* uint shift = (uint)shift_w; */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_arshift ("FMTPTR", %u, %zu)\n", */
-/* (uintptr_t)arg, shift, bytes); */
-/* return shary(arg, shift, bytes, &mpz_fdiv_q_2exp); */
-/* } */
+/*
+ * Return an integer which compares to 0 as the two intInf args compare
+ * to each other.
+ */
+Int32_t IntInf_compare (objptr lhs, objptr rhs) {
+ __mpz_struct lhsmpz, rhsmpz;
+ mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];
+ int res;
-/* pointer IntInf_lshift(pointer arg, Word shift_w, size_t bytes) { */
-/* uint shift = (uint)shift_w; */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_lshift ("FMTPTR", %u, %zu)\n", */
-/* (uintptr_t)arg, shift, bytes); */
-/* return shary(arg, shift, bytes, &mpz_mul_2exp); */
-/* } */
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_compare ("FMTOBJPTR", "FMTOBJPTR")\n",
+ lhs, rhs);
+ fillIntInfArg (&gcState, lhs, &lhsmpz, lhsspace);
+ fillIntInfArg (&gcState, rhs, &rhsmpz, rhsspace);
+ res = mpz_cmp (&lhsmpz, &rhsmpz);
+ if (res < 0) return -1;
+ if (res > 0) return 1;
+ return 0;
+}
-/* Word */
-/* IntInf_smallMul(Word lhs, Word rhs, pointer carry) */
-/* { */
-/* intmax_t prod; */
+/*
+ * Check if two IntInf.int's are equal.
+ */
+Bool_t IntInf_equal (objptr lhs, objptr rhs) {
+ if (lhs == rhs)
+ return TRUE;
+ if (isEitherSmall (lhs, rhs))
+ return FALSE;
+ else
+ return 0 == IntInf_compare (lhs, rhs);
+}
-/* prod = (intmax_t)(int)lhs * (int)rhs; */
-/* *(uint *)carry = (uintmax_t)prod >> 32; */
-/* return ((uint)(uintmax_t)prod); */
-/* } */
+/*
+ * Convert an intInf to a string.
+ * Arg is an intInf, base is the base to use (2, 8, 10 or 16) and
+ * space is a string (mutable) which is large enough.
+ */
+objptr IntInf_toString (objptr arg, int32_t base, size_t bytes) {
+ GC_string8 sp;
+ __mpz_struct argmpz;
+ mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
+ char *str;
+ size_t size;
-/* /\* */
-/* * Return an integer which compares to 0 as the two intInf args compare */
-/* * to each other. */
-/* *\/ */
-/* Int IntInf_compare (pointer lhs, pointer rhs) { */
-/* __mpz_struct lhsmpz, */
-/* rhsmpz; */
-/* mp_limb_t lhsspace[2], */
-/* rhsspace[2]; */
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_toString ("FMTOBJPTR", %"PRId32", %zu)\n",
+ arg, base, bytes);
+ assert (base == 2 || base == 8 || base == 10 || base == 16);
+ fillIntInfArg (&gcState, arg, &argmpz, argspace);
+ sp = (GC_string8)gcState.frontier;
+ str = mpz_get_str(sp->chars, base, &argmpz);
+ assert (str == sp->chars);
+ size = strlen(str);
+ if (*sp->chars == '-')
+ *sp->chars = '~';
+ if (base > 0)
+ for (unsigned int i = 0; i < size; i++) {
+ char c = sp->chars[i];
+ if (('a' <= c) && (c <= 'z'))
+ sp->chars[i] = c + ('A' - 'a');
+ }
+ setFrontier (&gcState, (pointer)(&sp->chars[size]), bytes);
+ sp->counter = 0;
+ sp->length = size;
+ sp->header = GC_STRING8_HEADER;
+ return pointerToObjptr ((pointer)&sp->chars, gcState.heap.start);
+}
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_compare ("FMTPTR", "FMTPTR")\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs); */
-/* fill (lhs, &lhsmpz, lhsspace); */
-/* fill (rhs, &rhsmpz, rhsspace); */
-/* return mpz_cmp (&lhsmpz, &rhsmpz); */
-/* } */
+Word32_t
+IntInf_smallMul(Word32_t lhs, Word32_t rhs, Ref(Word32_t) carry) {
+ intmax_t prod;
-/* /\* */
-/* * Check if two IntInf.int's are equal. */
-/* *\/ */
-/* Bool IntInf_equal (pointer lhs, pointer rhs) { */
-/* if (lhs == rhs) */
-/* return TRUE; */
-/* if (eitherIsSmall (lhs, rhs)) */
-/* return FALSE; */
-/* else */
-/* return 0 == IntInf_compare (lhs, rhs); */
-/* } */
-
-/* /\* */
-/* * Convert an intInf to a string. */
-/* * Arg is an intInf, base is the base to use (2, 8, 10 or 16) and space is a */
-/* * string (mutable) which is large enough. */
-/* *\/ */
-/* pointer IntInf_toString (pointer arg, int base, size_t bytes) { */
-/* GC_string sp; */
-/* __mpz_struct argmpz; */
-/* mp_limb_t argspace[2]; */
-/* char *str; */
-/* uint size; */
-/* uint i; */
-/* char c; */
-
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_toString ("FMTPTR", %d, %zu)\n", */
-/* (uintptr_t)arg, base, bytes); */
-/* assert (base == 2 || base == 8 || base == 10 || base == 16); */
-/* fill (arg, &argmpz, argspace); */
-/* sp = (GC_string)gcState.frontier; */
-/* str = mpz_get_str(sp->chars, base, &argmpz); */
-/* assert(str == sp->chars); */
-/* size = strlen(str); */
-/* if (*sp->chars == '-') */
-/* *sp->chars = '~'; */
-/* if (base > 0) */
-/* for (i = 0; i < size; i++) { */
-/* c = sp->chars[i]; */
-/* if (('a' <= c) && (c <= 'z')) */
-/* sp->chars[i] = c + ('A' - 'a'); */
-/* } */
-/* sp->counter = 0; */
-/* sp->length = size; */
-/* sp->header = GC_stringHeader (); */
-/* setFrontier ((pointer)(&sp->chars[align(size, 4)]), bytes); */
-/* return (pointer)str; */
-/* } */
-
-/* /\* */
-/* * Quotient (round towards 0, remainder is returned by IntInf_rem). */
-/* * space is a word array with enough space for the quotient */
-/* * num limbs + 1 - den limbs */
-/* * shifted numerator */
-/* * num limbs + 1 */
-/* * and shifted denominator */
-/* * den limbs */
-/* * and the isNeg word. */
-/* * It must be the last thing allocated. */
-/* * num is the numerator bignum, den is the denominator and frontier is */
-/* * the current frontier. */
-/* *\/ */
-/* pointer IntInf_quot (pointer num, pointer den, size_t bytes) { */
-/* __mpz_struct resmpz, */
-/* nmpz, */
-/* dmpz; */
-/* mp_limb_t nss[2], */
-/* dss[2], */
-/* carry, */
-/* *np, */
-/* *dp; */
-/* int nsize, */
-/* dsize, */
-/* qsize; */
-/* bool resIsNeg; */
-/* uint shift; */
-
-/* initRes(&resmpz, bytes); */
-/* fill(num, &nmpz, nss); */
-/* resIsNeg = FALSE; */
-/* nsize = nmpz._mp_size; */
-/* if (nsize < 0) { */
-/* nsize = - nsize; */
-/* resIsNeg = TRUE; */
-/* } */
-/* fill(den, &dmpz, dss); */
-/* dsize = dmpz._mp_size; */
-/* if (dsize < 0) { */
-/* dsize = - dsize; */
-/* resIsNeg = not resIsNeg; */
-/* } */
-/* assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0); */
-/* assert((nsize == 0 && dsize == 1) */
-/* or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0)); */
-/* qsize = 1 + nsize - dsize; */
-/* if (dsize == 1) { */
-/* if (nsize == 0) */
-/* return (pointer)1; /\* tagged 0 *\/ */
-/* mpn_divrem_1(resmpz._mp_d, */
-/* (mp_size_t)0, */
-/* nmpz._mp_d, */
-/* nsize, */
-/* dmpz._mp_d[0]); */
-/* if (resmpz._mp_d[qsize - 1] == 0) */
-/* --qsize; */
-/* } else { */
-/* np = &resmpz._mp_d[qsize]; */
-/* shift = leadingZeros(dmpz._mp_d[dsize - 1]); */
-/* if (shift == 0) { */
-/* dp = dmpz._mp_d; */
-/* memcpy((void *)np, */
-/* nmpz._mp_d, */
-/* nsize * sizeof(*nmpz._mp_d)); */
-/* } else { */
-/* carry = mpn_lshift(np, nmpz._mp_d, nsize, shift); */
-/* unless (carry == 0) */
-/* np[nsize++] = carry; */
-/* dp = &np[nsize]; */
-/* mpn_lshift(dp, dmpz._mp_d, dsize, shift); */
-/* } */
-/* carry = mpn_divrem(resmpz._mp_d, */
-/* (mp_size_t)0, */
-/* np, */
-/* nsize, */
-/* dp, */
-/* dsize); */
-/* qsize = nsize - dsize; */
-/* if (carry != 0) */
-/* resmpz._mp_d[qsize++] = carry; */
-/* } */
-/* resmpz._mp_size = resIsNeg ? - qsize : qsize; */
-/* return answer (&resmpz, bytes); */
-/* } */
-
-
-/* /\* */
-/* * Remainder (sign taken from numerator, quotient is returned by IntInf_quot). */
-/* * space is a word array with enough space for the remainder */
-/* * den limbs */
-/* * shifted numerator */
-/* * num limbs + 1 */
-/* * and shifted denominator */
-/* * den limbs */
-/* * and the isNeg word. */
-/* * It must be the last thing allocated. */
-/* * num is the numerator bignum, den is the denominator and frontier is */
-/* * the current frontier. */
-/* *\/ */
-/* pointer IntInf_rem (pointer num, pointer den, size_t bytes) { */
-/* __mpz_struct resmpz, */
-/* nmpz, */
-/* dmpz; */
-/* mp_limb_t nss[2], */
-/* dss[2], */
-/* carry, */
-/* *dp; */
-/* int nsize, */
-/* dsize; */
-/* bool resIsNeg; */
-/* uint shift; */
-
-/* initRes(&resmpz, bytes); */
-/* fill(num, &nmpz, nss); */
-/* nsize = nmpz._mp_size; */
-/* resIsNeg = nsize < 0; */
-/* if (resIsNeg) */
-/* nsize = - nsize; */
-/* fill(den, &dmpz, dss); */
-/* dsize = dmpz._mp_size; */
-/* if (dsize < 0) */
-/* dsize = - dsize; */
-/* assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0); */
-/* assert((nsize == 0 && dsize == 1) */
-/* or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0)); */
-/* if (dsize == 1) { */
-/* if (nsize == 0) */
-/* resmpz._mp_size = 0; */
-/* else { */
-/* carry = mpn_mod_1(nmpz._mp_d, nsize, dmpz._mp_d[0]); */
-/* if (carry == 0) */
-/* nsize = 0; */
-/* else { */
-/* resmpz._mp_d[0] = carry; */
-/* nsize = 1; */
-/* } */
-/* } */
-/* } else { */
-/* shift = leadingZeros(dmpz._mp_d[dsize - 1]); */
-/* if (shift == 0) { */
-/* dp = dmpz._mp_d; */
-/* memcpy((void *)resmpz._mp_d, */
-/* (void *)nmpz._mp_d, */
-/* nsize * sizeof(*nmpz._mp_d)); */
-/* } else { */
-/* carry = mpn_lshift(resmpz._mp_d, */
-/* nmpz._mp_d, */
-/* nsize, */
-/* shift); */
-/* unless (carry == 0) */
-/* resmpz._mp_d[nsize++] = carry; */
-/* dp = &resmpz._mp_d[nsize]; */
-/* mpn_lshift(dp, dmpz._mp_d, dsize, shift); */
-/* } */
-/* mpn_divrem(&resmpz._mp_d[dsize], */
-/* (mp_size_t)0, */
-/* resmpz._mp_d, */
-/* nsize, */
-/* dp, */
-/* dsize); */
-/* nsize = dsize; */
-/* assert(nsize > 0); */
-/* while (resmpz._mp_d[nsize - 1] == 0) */
-/* if (--nsize == 0) */
-/* break; */
-/* unless (nsize == 0 || shift == 0) { */
-/* mpn_rshift(resmpz._mp_d, resmpz._mp_d, nsize, shift); */
-/* if (resmpz._mp_d[nsize - 1] == 0) */
-/* --nsize; */
-/* } */
-/* } */
-/* resmpz._mp_size = resIsNeg ? - nsize : nsize; */
-/* return answer (&resmpz, bytes); */
-/* } */
+ prod = (intmax_t)(Int32_t)lhs * (intmax_t)(Int32_t)rhs;
+ *(Word32_t *)carry = (Word32_t)((uintmax_t)prod >> 32);
+ return ((Word32_t)(uintmax_t)prod);
+}
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -1,11 +0,0 @@
-/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- */
-
-GC_header GC_intInfHeader (void) {
- return GC_INTINF_HEADER;
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -31,10 +31,38 @@
CHAR_BIT * sizeof(mp_limb_t) == 64 ? \
GC_WORD64_VECTOR_HEADER : ( 0 ) ) )
+COMPILE_TIME_ASSERT(sizeof_mp_limb_t__compat__sizeof_objptr,
+ (sizeof(mp_limb_t) >= sizeof(objptr)) ||
+ (sizeof(objptr) % sizeof(mp_limb_t) == 0));
+#define LIMBS_PER_OBJPTR ( \
+ sizeof(mp_limb_t) >= sizeof(objptr) ? \
+ 1 : sizeof(objptr) / sizeof(mp_limb_t))
+
+static inline void fillIntInfArg (GC_state s, objptr arg, __mpz_struct *res,
+ mp_limb_t space[LIMBS_PER_OBJPTR + 1]);
+static inline void initIntInfRes (GC_state s, __mpz_struct *res, size_t bytes);
+static inline objptr finiIntInfRes (GC_state s, __mpz_struct *res, size_t bytes);
+
#endif /* (defined (MLTON_GC_INTERNAL_FUNCS)) */
#if (defined (MLTON_GC_INTERNAL_BASIS))
-GC_header GC_intInfHeader (void);
+objptr IntInf_add (objptr lhs, objptr rhs, size_t bytes);
+objptr IntInf_andb (objptr lhs, objptr rhs, size_t bytes);
+objptr IntInf_gcd (objptr lhs, objptr rhs, size_t bytes);
+objptr IntInf_mul (objptr lhs, objptr rhs, size_t bytes);
+objptr IntInf_quot (objptr lhs, objptr rhs, size_t bytes);
+objptr IntInf_orb (objptr lhs, objptr rhs, size_t bytes);
+objptr IntInf_rem (objptr lhs, objptr rhs, size_t bytes);
+objptr IntInf_sub (objptr lhs, objptr rhs, size_t bytes);
+objptr IntInf_xorb (objptr lhs, objptr rhs, size_t bytes);
+objptr IntInf_neg (objptr arg, size_t bytes);
+objptr IntInf_notb (objptr arg, size_t bytes);
+objptr IntInf_arshift (objptr arg, Word32_t shift, size_t bytes);
+objptr IntInf_lshift (objptr arg, Word32_t shift, size_t bytes);
+Int32_t IntInf_compare (objptr lhs, objptr rhs);
+Bool_t IntInf_equal (objptr lhs, objptr rhs);
+objptr IntInf_toString (objptr arg, Int32_t base, size_t bytes);
+Word32_t IntInf_smallMul (Word32_t lhs, Word32_t rhs, pointer carry);
#endif /* (defined (MLTON_GC_INTERNAL_BASIS)) */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -83,3 +83,12 @@
(uintptr_t)thread, reserved);;
return thread;
}
+
+static inline void setFrontier (GC_state s, pointer p, size_t bytes) {
+ p = alignFrontier (s, p);
+ assert ((size_t)(p - s->frontier) <= bytes);
+ GC_profileAllocInc (s, p - s->frontier);
+ s->cumulativeStatistics.bytesAllocated += p - s->frontier;
+ s->frontier = p;
+ assert (s->frontier <= s->limitPlusSlop);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -13,4 +13,6 @@
static inline GC_stack newStack (GC_state s, size_t reserved, bool allocInOldGen);
static GC_thread newThread (GC_state s, size_t stackSize);
+static inline void setFrontier (GC_state s, pointer p, size_t bytes);
+
#endif /* (defined (MLTON_GC_INTERNAL_FUNCS)) */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -11,23 +11,17 @@
/* Layout of strings.
* Note, the value passed around is a pointer to the chars member.
*/
-typedef struct GC_string {
+typedef struct GC_string8 {
GC_arrayCounter counter;
GC_arrayLength length;
GC_header header;
char chars[1];
-} *GC_string;
+} *GC_string8;
#endif /* (defined (MLTON_GC_INTERNAL_TYPES)) */
#if (defined (MLTON_GC_INTERNAL_FUNCS))
-#define GC_STRING_HEADER GC_WORD8_VECTOR_HEADER
+#define GC_STRING8_HEADER GC_WORD8_VECTOR_HEADER
#endif /* (defined (MLTON_GC_INTERNAL_FUNCS)) */
-
-#if (defined (MLTON_GC_INTERNAL_BASIS))
-
-GC_header GC_stringHeader (void);
-
-#endif /* (defined (MLTON_GC_INTERNAL_BASIS)) */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -39,7 +39,6 @@
#include "gc/heap_predicates.c"
#include "gc/init-world.c"
#include "gc/init.c"
-#include "gc/int-inf.c"
#include "gc/invariant.c"
#include "gc/mark-compact.c"
#include "gc/model.c"
@@ -56,10 +55,9 @@
#include "gc/size.c"
#include "gc/sources.c"
#include "gc/stack.c"
-#include "gc/string.c"
#include "gc/switch-thread.c"
#include "gc/thread.c"
#include "gc/translate.c"
#include "gc/weak.c"
#include "gc/world.c"
-// #include "gc/int-inf-ops.c"
+#include "gc/int-inf-ops.c"
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -11,8 +11,8 @@
#include "cenv.h"
#include "util.h"
+#include "ml-types.h"
-
#include "gc/debug.h"
struct GC_state;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -161,36 +161,6 @@
/* ---------------------------------------------------------------- */
/* ------------------------------------------------- */
-/* IntInf */
-/* ------------------------------------------------- */
-
-/* All of these routines modify the frontier in gcState. They assume that
- * there are bytes bytes free, and allocate an array to store the result
- * at the current frontier position.
- * Immediately after the bytesArg, they take a labelIndex arg. This is an index
- * into the array used for allocation profiling, and the appropriate element
- * is incremented by the amount that the function moves the frontier.
- */
-Pointer IntInf_add (Pointer lhs, Pointer rhs, size_t bytes);
-Pointer IntInf_andb (Pointer lhs, Pointer rhs, size_t bytes);
-Pointer IntInf_arshift (Pointer arg, Word shift, size_t bytes);
-Pointer IntInf_gcd (Pointer lhs, Pointer rhs, size_t bytes);
-Pointer IntInf_lshift (Pointer arg, Word shift, size_t bytes);
-Pointer IntInf_mul (Pointer lhs, Pointer rhs, size_t bytes);
-Pointer IntInf_neg (Pointer arg, size_t bytes);
-Pointer IntInf_notb (Pointer arg, size_t bytes);
-Pointer IntInf_orb (Pointer lhs, Pointer rhs, size_t bytes);
-Pointer IntInf_quot (Pointer num, Pointer den, size_t bytes);
-Pointer IntInf_rem (Pointer num, Pointer den, size_t bytes);
-Pointer IntInf_sub (Pointer lhs, Pointer rhs, size_t bytes);
-Pointer IntInf_toString (Pointer arg, int base, size_t bytes);
-Pointer IntInf_xorb (Pointer lhs, Pointer rhs, size_t bytes);
-
-Word IntInf_smallMul (Word lhs, Word rhs, Pointer carry);
-Int IntInf_compare (Pointer lhs, Pointer rhs);
-Bool IntInf_equal (Pointer lhs, Pointer rhs);
-
-/* ------------------------------------------------- */
/* MLton */
/* ------------------------------------------------- */