[MLton-commit] r4336
Matthew Fluet
MLton@mlton.org
Thu, 2 Feb 2006 16:35:43 -0800
Rename int-inf-ops.c to int-inf.c; needed to commit before doing rename
----------------------------------------------------------------------
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c
----------------------------------------------------------------------
Deleted: 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-02-03 00:35:24 UTC (rev 4335)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c 2006-02-03 00:35:40 UTC (rev 4336)
@@ -1,370 +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.
- */
-
-/* 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 (objptr arg) {
- return (arg & 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 & (objptr)1);
-}
-
-/*
- * Convert a bignum intInf to a bignum pointer.
- */
-static inline GC_intInf toBignum (GC_state s, objptr arg) {
- GC_intInf bp;
-
- 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);
- assert (bp->header == GC_INTINF_HEADER);
- return bp;
-}
-
-/*
- * Given an intInf, a pointer to an __mpz_struct and space large
- * enough to contain LIMBS_PER_OBJPTR + 1 limbs, fill in the
- * __mpz_struct.
- */
-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, "fillIntInfArg ("FMTOBJPTR", "FMTPTR", "FMTPTR")\n",
- arg, (uintptr_t)res, (uintptr_t)space);
- if (isSmall(arg)) {
- res->_mp_alloc = LIMBS_PER_OBJPTR + 1;
- res->_mp_d = space;
- if (arg == (objptr)1) {
- res->_mp_size = 0;
- } else {
- objptr highBitMask = (objptr)1 << (CHAR_BIT * OBJPTR_SIZE - 1);
- bool neg = (arg & highBitMask) != (objptr)0;
- if (neg) {
- res->_mp_size = - (mp_size_t)LIMBS_PER_OBJPTR;
- arg = -((arg >> 1) | highBitMask);
- } else {
- res->_mp_size = (mp_size_t)LIMBS_PER_OBJPTR;
- arg = (arg >> 1);
- }
- for (unsigned int i = 0; i < LIMBS_PER_OBJPTR; i++) {
- space[i] = (mp_limb_t)arg;
- arg = arg >> (CHAR_BIT * sizeof(mp_limb_t));
- }
- }
- } else {
- 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 the heap.
- */
-void initIntInfRes (GC_state s, __mpz_struct *res, size_t bytes) {
- GC_intInf bp;
-
- 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? */
-}
-
-/*
- * 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 ((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;
-
- 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);
-}
-
-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);
-}
-
-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);
-}
-
-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);
-}
-
-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);
-}
-
-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);
-}
-
-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);
-}
-
-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);
-}
-
-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);
-}
-
-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);
-}
-
-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);
-}
-
-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];
-
- initIntInfRes (&gcState, &resmpz, bytes);
- fillIntInfArg (&gcState, arg, &argmpz, argspace);
- unop (&resmpz, &argmpz);
- return finiIntInfRes (&gcState, &resmpz, bytes);
-}
-
-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);
-}
-
-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);
-}
-
-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];
-
- initIntInfRes (&gcState, &resmpz, bytes);
- fillIntInfArg (&gcState, arg, &argmpz, argspace);
- shop (&resmpz, &argmpz, (unsigned long)shift);
- return finiIntInfRes (&gcState, &resmpz, bytes);
-}
-
-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);
-}
-
-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);
-}
-
-/*
- * 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;
-
- 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;
-}
-
-/*
- * 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);
-}
-
-/*
- * 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;
-
- 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);
-}
-
-Word32_t
-IntInf_smallMul(Word32_t lhs, Word32_t rhs, Ref(Word32_t) carry) {
- intmax_t prod;
-
- 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);
-}