[hcoop/debian/mlton.git] / runtime / gc / int-inf.c

/* Copyright (C) 2012,2014 Matthew Fluet.
 * Copyright (C) 1999-2005, 2007-2008 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.
 */

/*
 * Test if a intInf is a fixnum.
 */
static inline bool isSmall (objptr arg) {
  return (arg & 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, obj)
                      + offsetof(struct GC_intInf_obj, 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 {
      const objptr highBitMask = (objptr)1 << (CHAR_BIT * OBJPTR_SIZE - 1);
      bool neg = (arg & highBitMask) != (objptr)0;
      if (neg) {
        arg = -((arg >> 1) | highBitMask);
      } else {
        arg = (arg >> 1);
      }
      int size;
      if (sizeof(objptr) <= sizeof(mp_limb_t)) {
        space[0] = (mp_limb_t)arg;
        size = 1;
      } else {
        size = 0;
        while (arg != 0) {
          space[size] = (mp_limb_t)arg;
          // The conditional below is to quell a gcc warning:
          //   right shift count >= width of type
          // When (sizeof(objptr) <= sizeof(mp_limb_t)),
          // this branch is unreachable,
          // so the shift doesn't matter.
          arg = arg >> (sizeof(objptr) <= sizeof(mp_limb_t) ?
                        0 : CHAR_BIT * sizeof(mp_limb_t));
          size++;
        }
      }
      if (neg)
        size = - size;
      res->_mp_size = size;
    }
  } else {
    bp = toBignum (s, arg);
    /* The _mp_alloc field is declared as int.  
     * No possibility of an overflowing assignment, as all *huge*
     * intInfs must have come from some previous GnuMP evaluation.
     */
    res->_mp_alloc = (int)(bp->length - 1);
    res->_mp_d = (mp_limb_t*)(bp->obj.limbs);
    res->_mp_size = bp->obj.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,
                    ARG_USED_FOR_ASSERT size_t bytes) {
  GC_intInf bp;
  size_t nlimbs;

  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.
   */
  nlimbs = ((size_t)(s->limitPlusSlop - (pointer)bp->obj.limbs)) / (sizeof(mp_limb_t));
  /* The _mp_alloc field is declared as int. 
   * Avoid an overflowing assignment, which could happen with huge
   * heaps.
   */
  res->_mp_alloc = (int)(min(nlimbs,(size_t)INT_MAX));
  res->_mp_d = (mp_limb_t*)(bp->obj.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;
  int 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", %"PRIuMAX")\n",
             (uintptr_t)res, (uintmax_t)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, obj)
                      + offsetof(struct GC_intInf_obj, limbs)));
  assert (res->_mp_d == (mp_limb_t*)(bp->obj.limbs));
  size = res->_mp_size;
  if (size < 0) {
    bp->obj.isneg = TRUE;
    size = - size;
  } else
    bp->obj.isneg = FALSE;
  assert (size >= 0);
  if (size == 0)
    return (objptr)1;
  if (size <= LIMBS_PER_OBJPTR) {
    if (sizeof(objptr) <= sizeof(mp_limb_t)) {
      objptr ans;
      mp_limb_t val = bp->obj.limbs[0];
      if (bp->obj.isneg) {
        /*
         * We only fit if val in [1, 2^(CHAR_BIT * OBJPTR_SIZE - 2)].
         */
        ans = (objptr)(- val);
        val = val - 1;
      } else
        /*
         * We only fit if val in [0, 2^(CHAR_BIT * OBJPTR_SIZE - 2) - 1].
         */
        ans = (objptr)val;
      // The conditional below is to quell a gcc warning:
      //   right shift count >= width of type
      // When (sizeof(objptr) > sizeof(mp_limb_t)),
      // this branch is unreachable,
      // so the shift doesn't matter.
      if (val < (mp_limb_t)1<<(sizeof(objptr) > sizeof(mp_limb_t) ?
                               0 : CHAR_BIT * OBJPTR_SIZE - 2))
        return (ans<<1 | 1);
    } else {
      objptr ans, val;
      val = (objptr)(bp->obj.limbs[0]);
      for (int i = 1; i < size; i++) {
        // The conditional below is to quell a gcc warning:
        //   left shift count >= width of type
        // When (sizeof(objptr) <= sizeof(mp_limb_t)),
        // this branch is unreachable,
        // so the shift doesn't matter.
        val = val << (sizeof(objptr) <= sizeof(mp_limb_t) ?
                      0 : CHAR_BIT * sizeof(mp_limb_t));
        val = val & (objptr)(bp->obj.limbs[i]);
      }
      if (bp->obj.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 < (objptr)1<<(CHAR_BIT * OBJPTR_SIZE - 2))
        return (ans<<1 | 1);
    }
  }
  setFrontier (s, (pointer)(&bp->obj.limbs[size]), bytes);
  bp->counter = (GC_arrayCounter)0;
  bp->length = (GC_arrayLength)(size + 1); /* +1 for isneg field */
  bp->header = GC_INTINF_HEADER;
  return pointerToObjptr ((pointer)&bp->obj, s->heap.start);
}

objptr IntInf_binop (GC_state s,
                     objptr lhs, objptr rhs, size_t bytes,
                     void(*binop)(__mpz_struct *resmpz,
                                  const __mpz_struct *lhsspace,
                                  const __mpz_struct *rhsspace)) {
  __mpz_struct lhsmpz, rhsmpz, resmpz;
  mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];

  if (DEBUG_INT_INF)
    fprintf (stderr, "IntInf_binop ("FMTOBJPTR", "FMTOBJPTR", %"PRIuMAX")\n",
             lhs, rhs, (uintmax_t)bytes);
  initIntInfRes (s, &resmpz, bytes);
  fillIntInfArg (s, lhs, &lhsmpz, lhsspace);
  fillIntInfArg (s, rhs, &rhsmpz, rhsspace);
  binop (&resmpz, &lhsmpz, &rhsmpz);
  return finiIntInfRes (s, &resmpz, bytes);
}

objptr IntInf_unop (GC_state s,
                    objptr arg, size_t bytes,
                    void(*unop)(__mpz_struct *resmpz,
                                const __mpz_struct *argspace)) {
  __mpz_struct argmpz, resmpz;
 mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];

  if (DEBUG_INT_INF)
    fprintf (stderr, "IntInf_unop ("FMTOBJPTR", %"PRIuMAX")\n",
             arg, (uintmax_t)bytes);

 initIntInfRes (s, &resmpz, bytes);
 fillIntInfArg (s, arg, &argmpz, argspace);
 unop (&resmpz, &argmpz);
 return finiIntInfRes (s, &resmpz, bytes);
}

objptr IntInf_shop (GC_state s,
                    objptr arg, Word32_t shift, size_t bytes,
                    void(*shop)(__mpz_struct *resmpz,
                                const __mpz_struct *argspace,
                                unsigned long shift))
{
  __mpz_struct argmpz, resmpz;
  mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];

  if (DEBUG_INT_INF)
    fprintf (stderr, "IntInf_shop ("FMTOBJPTR", %"PRIu32", %"PRIuMAX")\n",
             arg, shift, (uintmax_t)bytes);

  initIntInfRes (s, &resmpz, bytes);
  fillIntInfArg (s, arg, &argmpz, argspace);
  shop (&resmpz, &argmpz, (unsigned long)shift);
  return finiIntInfRes (s, &resmpz, bytes);
}

Int32_t IntInf_cmpop (GC_state s, objptr lhs, objptr rhs,
                      int(*cmpop)(const __mpz_struct *lhsspace,
                                  const __mpz_struct *rhsspace))
{
  __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_cmpop ("FMTOBJPTR", "FMTOBJPTR")\n",
             lhs, rhs);
  fillIntInfArg (s, lhs, &lhsmpz, lhsspace);
  fillIntInfArg (s, rhs, &rhsmpz, rhsspace);
  res = cmpop (&lhsmpz, &rhsmpz);
  if (res < 0) return -1;
  if (res > 0) return 1;
  return 0;
}

objptr IntInf_strop (GC_state s, objptr arg, Int32_t base, size_t bytes,
                     char*(*strop)(char *str,
                                   int base,
                                   const __mpz_struct *argspace))
{
  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_strop ("FMTOBJPTR", %"PRId32", %"PRIuMAX")\n",
             arg, base, (uintmax_t)bytes);
  assert (base == 2 || base == 8 || base == 10 || base == 16);
  fillIntInfArg (s, arg, &argmpz, argspace);
  assert (bytes <= (size_t)(s->limitPlusSlop - s->frontier));
  sp = (GC_string8)s->frontier;
  str = strop ((void*)&sp->obj, -base, &argmpz);
  assert (str == (char*)&sp->obj);
  size = strlen(str);
  if (sp->obj.chars[0] == '-')
    sp->obj.chars[0] = '~';
  setFrontier (s, (pointer)&sp->obj + size, bytes);
  sp->counter = (GC_arrayCounter)0;
  sp->length = (GC_arrayLength)size;
  sp->header = GC_STRING8_HEADER;
  return pointerToObjptr ((pointer)&sp->obj, s->heap.start);
}

/*
static GC_state intInfMemoryFuncsState;

static void * wrap_alloc_func(size_t size) {
  if (DEBUG_INT_INF)
    fprintf (stderr, "alloc_func (size = %"PRIuMAX") = ", 
             (uintmax_t)size);
  void * res = (*alloc_func_ptr)(size);
  if (DEBUG_INT_INF)
    fprintf (stderr, FMTPTR"\n", (uintptr_t)res);
  return res;
}

static void * wrap_realloc_func(void *ptr, size_t old_size, size_t new_size) {
  if (DEBUG_INT_INF)
    fprintf (stderr, "realloc_func (ptr = "FMTPTR", "
             "old_size = %"PRIuMAX", new_size = %"PRIuMAX") = ", 
             (uintptr_t)ptr, (uintmax_t)old_size, (uintmax_t)new_size);
  assert (! isPointerInHeap(intInfMemoryFuncsState, (pointer)ptr));
  void * res = (*realloc_func_ptr)(ptr, old_size, new_size);
  if (DEBUG_INT_INF)
    fprintf (stderr, FMTPTR"\n", (uintptr_t)res);
  return res;
}

static void wrap_free_func(void *ptr, size_t size) {
  if (DEBUG_INT_INF)
    fprintf (stderr, "free_func (ptr = "FMTPTR", size = %"PRIuMAX")", 
             (uintptr_t)ptr, (uintmax_t)size);
  assert (! isPointerInHeap(intInfMemoryFuncsState, (pointer)ptr));
  (*free_func_ptr)(ptr, size);
  if (DEBUG_INT_INF)
    fprintf (stderr, "\n");
  return;
}

void initIntInf (GC_state s) {
  intInfMemoryFuncsState = s;
  mp_get_memory_functions (&alloc_func_ptr, &realloc_func_ptr, &free_func_ptr);
  mp_set_memory_functions (&wrap_alloc_func, &wrap_realloc_func, &wrap_free_func);
  return;
}
*/

void initIntInf (__attribute__ ((unused)) GC_state s) {
  return;
}
Commit	Line	Data
7f918cf1 CE	1	/* Copyright (C) 2012,2014 Matthew Fluet.
	2	* Copyright (C) 1999-2005, 2007-2008 Henry Cejtin, Matthew Fluet,
	3	* Suresh Jagannathan, and Stephen Weeks.
	4	* Copyright (C) 1997-2000 NEC Research Institute.
	5	*
	6	* MLton is released under a BSD-style license.
	7	* See the file MLton-LICENSE for details.
	8	*/
	9
	10	/*
	11	* Test if a intInf is a fixnum.
	12	*/
	13	static inline bool isSmall (objptr arg) {
	14	return (arg & 1);
	15	}
	16
	17	static inline bool areSmall (objptr arg1, objptr arg2) {
	18	return ((arg1 & arg2) & (objptr)1);
	19	}
	20
	21	/*
	22	* Convert a bignum intInf to a bignum pointer.
	23	*/
	24	static inline GC_intInf toBignum (GC_state s, objptr arg) {
	25	GC_intInf bp;
	26
	27	assert (not isSmall(arg));
	28	bp = (GC_intInf)(objptrToPointer(arg, s->heap.start)
	29	- (offsetof(struct GC_intInf, obj)
	30	+ offsetof(struct GC_intInf_obj, isneg)));
	31	if (DEBUG_INT_INF)
	32	fprintf (stderr, "bp->header = "FMTHDR"\n", bp->header);
	33	assert (bp->header == GC_INTINF_HEADER);
	34	return bp;
	35	}
	36
	37	/*
	38	* Given an intInf, a pointer to an __mpz_struct and space large
	39	* enough to contain LIMBS_PER_OBJPTR + 1 limbs, fill in the
	40	* __mpz_struct.
	41	*/
	42	void fillIntInfArg (GC_state s, objptr arg, __mpz_struct *res,
	43	mp_limb_t space[LIMBS_PER_OBJPTR + 1]) {
	44	GC_intInf bp;
	45
	46	if (DEBUG_INT_INF)
	47	fprintf (stderr, "fillIntInfArg ("FMTOBJPTR", "FMTPTR", "FMTPTR")\n",
	48	arg, (uintptr_t)res, (uintptr_t)space);
	49	if (isSmall(arg)) {
	50	res->_mp_alloc = LIMBS_PER_OBJPTR + 1;
	51	res->_mp_d = space;
	52	if (arg == (objptr)1) {
	53	res->_mp_size = 0;
	54	} else {
	55	const objptr highBitMask = (objptr)1 << (CHAR_BIT * OBJPTR_SIZE - 1);
	56	bool neg = (arg & highBitMask) != (objptr)0;
	57	if (neg) {
	58	arg = -((arg >> 1) \| highBitMask);
	59	} else {
	60	arg = (arg >> 1);
	61	}
	62	int size;
	63	if (sizeof(objptr) <= sizeof(mp_limb_t)) {
	64	space[0] = (mp_limb_t)arg;
65	size = 1;
66	} else {
67	size = 0;
68	while (arg != 0) {
69	space[size] = (mp_limb_t)arg;
70	// The conditional below is to quell a gcc warning:
71	// right shift count >= width of type
72	// When (sizeof(objptr) <= sizeof(mp_limb_t)),
73	// this branch is unreachable,
74	// so the shift doesn't matter.
75	arg = arg >> (sizeof(objptr) <= sizeof(mp_limb_t) ?
76	0 : CHAR_BIT * sizeof(mp_limb_t));
77	size++;
78	}
79	}
80	if (neg)
81	size = - size;
82	res->_mp_size = size;
83	}
84	} else {
85	bp = toBignum (s, arg);
86	/* The _mp_alloc field is declared as int.
87	* No possibility of an overflowing assignment, as all huge
88	* intInfs must have come from some previous GnuMP evaluation.
89	*/
90	res->_mp_alloc = (int)(bp->length - 1);
91	res->_mp_d = (mp_limb_t*)(bp->obj.limbs);
92	res->_mp_size = bp->obj.isneg ? - res->_mp_alloc : res->_mp_alloc;
93	}
94	assert ((res->_mp_size == 0)
95	or (res->_mp_d[(res->_mp_size < 0
96	? - res->_mp_size
97	: res->_mp_size) - 1] != 0));
98	if (DEBUG_INT_INF_DETAILED)
99	fprintf (stderr, "arg --> %s\n",
100	mpz_get_str (NULL, 10, res));
101	}
102
103	/*
104	* Initialize an __mpz_struct to use the space provided by the heap.
105	*/
106	void initIntInfRes (GC_state s, __mpz_struct *res,
107	ARG_USED_FOR_ASSERT size_t bytes) {
108	GC_intInf bp;
109	size_t nlimbs;
110
111	assert (bytes <= (size_t)(s->limitPlusSlop - s->frontier));
112	bp = (GC_intInf)s->frontier;
113	/* We have as much space for the limbs as there is to the end of the
114	* heap. Divide by (sizeof(mp_limb_t)) to get number of limbs.
115	*/
116	nlimbs = ((size_t)(s->limitPlusSlop - (pointer)bp->obj.limbs)) / (sizeof(mp_limb_t));
117	/* The _mp_alloc field is declared as int.
118	* Avoid an overflowing assignment, which could happen with huge
119	* heaps.
120	*/
121	res->_mp_alloc = (int)(min(nlimbs,(size_t)INT_MAX));
122	res->_mp_d = (mp_limb_t*)(bp->obj.limbs);
123	res->_mp_size = 0; /* is this necessary? */
124	}
125
126	/*
127	* Given an __mpz_struct pointer which reflects the answer, set
128	* gcState.frontier and return the answer.
129	* If the answer fits in a fixnum, we return that, with the frontier
130	* rolled back.
131	* If the answer doesn't need all of the space allocated, we adjust
132	* the array size and roll the frontier slightly back.
133	*/
134	objptr finiIntInfRes (GC_state s, __mpz_struct *res, size_t bytes) {
135	GC_intInf bp;
136	int size;
137
138	assert ((res->_mp_size == 0)
139	or (res->_mp_d[(res->_mp_size < 0
140	? - res->_mp_size
141	: res->_mp_size) - 1] != 0));
142	if (DEBUG_INT_INF)
143	fprintf (stderr, "finiIntInfRes ("FMTPTR", %"PRIuMAX")\n",
144	(uintptr_t)res, (uintmax_t)bytes);
145	if (DEBUG_INT_INF_DETAILED)
146	fprintf (stderr, "res --> %s\n",
147	mpz_get_str (NULL, 10, res));
148	bp = (GC_intInf)((pointer)res->_mp_d
149	- (offsetof(struct GC_intInf, obj)
150	+ offsetof(struct GC_intInf_obj, limbs)));
151	assert (res->_mp_d == (mp_limb_t*)(bp->obj.limbs));
152	size = res->_mp_size;
153	if (size < 0) {
154	bp->obj.isneg = TRUE;
155	size = - size;
156	} else
157	bp->obj.isneg = FALSE;
158	assert (size >= 0);
159	if (size == 0)
160	return (objptr)1;
161	if (size <= LIMBS_PER_OBJPTR) {
162	if (sizeof(objptr) <= sizeof(mp_limb_t)) {
163	objptr ans;
164	mp_limb_t val = bp->obj.limbs[0];
165	if (bp->obj.isneg) {
166	/*
167	* We only fit if val in [1, 2^(CHAR_BIT * OBJPTR_SIZE - 2)].
168	*/
169	ans = (objptr)(- val);
170	val = val - 1;
171	} else
172	/*
173	* We only fit if val in [0, 2^(CHAR_BIT * OBJPTR_SIZE - 2) - 1].
174	*/
175	ans = (objptr)val;
176	// The conditional below is to quell a gcc warning:
177	// right shift count >= width of type
178	// When (sizeof(objptr) > sizeof(mp_limb_t)),
179	// this branch is unreachable,
180	// so the shift doesn't matter.
181	if (val < (mp_limb_t)1<<(sizeof(objptr) > sizeof(mp_limb_t) ?
182	0 : CHAR_BIT * OBJPTR_SIZE - 2))
183	return (ans<<1 \| 1);
184	} else {
185	objptr ans, val;
186	val = (objptr)(bp->obj.limbs[0]);
187	for (int i = 1; i < size; i++) {
188	// The conditional below is to quell a gcc warning:
189	// left shift count >= width of type
190	// When (sizeof(objptr) <= sizeof(mp_limb_t)),
191	// this branch is unreachable,
192	// so the shift doesn't matter.
193	val = val << (sizeof(objptr) <= sizeof(mp_limb_t) ?
194	0 : CHAR_BIT * sizeof(mp_limb_t));
195	val = val & (objptr)(bp->obj.limbs[i]);
196	}
197	if (bp->obj.isneg) {
198	/*
199	* We only fit if val in [1, 2^(CHAR_BIT * OBJPTR_SIZE - 2)].
200	*/
201	ans = - val;
202	val = val - 1;
203	} else
204	/*
205	* We only fit if val in [0, 2^(CHAR_BIT * OBJPTR_SIZE - 2) - 1].
206	*/
207	ans = val;
208	if (val < (objptr)1<<(CHAR_BIT * OBJPTR_SIZE - 2))
209	return (ans<<1 \| 1);
210	}
211	}
212	setFrontier (s, (pointer)(&bp->obj.limbs[size]), bytes);
213	bp->counter = (GC_arrayCounter)0;
214	bp->length = (GC_arrayLength)(size + 1); /* +1 for isneg field */
215	bp->header = GC_INTINF_HEADER;
216	return pointerToObjptr ((pointer)&bp->obj, s->heap.start);
217	}
218
219	objptr IntInf_binop (GC_state s,
220	objptr lhs, objptr rhs, size_t bytes,
221	void(binop)(__mpz_struct resmpz,
222	const __mpz_struct *lhsspace,
223	const __mpz_struct *rhsspace)) {
224	__mpz_struct lhsmpz, rhsmpz, resmpz;
225	mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];
226
227	if (DEBUG_INT_INF)
228	fprintf (stderr, "IntInf_binop ("FMTOBJPTR", "FMTOBJPTR", %"PRIuMAX")\n",
229	lhs, rhs, (uintmax_t)bytes);
230	initIntInfRes (s, &resmpz, bytes);
231	fillIntInfArg (s, lhs, &lhsmpz, lhsspace);
232	fillIntInfArg (s, rhs, &rhsmpz, rhsspace);
233	binop (&resmpz, &lhsmpz, &rhsmpz);
234	return finiIntInfRes (s, &resmpz, bytes);
235	}
236
237	objptr IntInf_unop (GC_state s,
238	objptr arg, size_t bytes,
239	void(unop)(__mpz_struct resmpz,
240	const __mpz_struct *argspace)) {
241	__mpz_struct argmpz, resmpz;
242	mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
243
244	if (DEBUG_INT_INF)
245	fprintf (stderr, "IntInf_unop ("FMTOBJPTR", %"PRIuMAX")\n",
246	arg, (uintmax_t)bytes);
247
248	initIntInfRes (s, &resmpz, bytes);
249	fillIntInfArg (s, arg, &argmpz, argspace);
250	unop (&resmpz, &argmpz);
251	return finiIntInfRes (s, &resmpz, bytes);
252	}
253
254	objptr IntInf_shop (GC_state s,
255	objptr arg, Word32_t shift, size_t bytes,
256	void(shop)(__mpz_struct resmpz,
257	const __mpz_struct *argspace,
258	unsigned long shift))
259	{
260	__mpz_struct argmpz, resmpz;
261	mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
262
263	if (DEBUG_INT_INF)
264	fprintf (stderr, "IntInf_shop ("FMTOBJPTR", %"PRIu32", %"PRIuMAX")\n",
265	arg, shift, (uintmax_t)bytes);
266
267	initIntInfRes (s, &resmpz, bytes);
268	fillIntInfArg (s, arg, &argmpz, argspace);
269	shop (&resmpz, &argmpz, (unsigned long)shift);
270	return finiIntInfRes (s, &resmpz, bytes);
271	}
272
273	Int32_t IntInf_cmpop (GC_state s, objptr lhs, objptr rhs,
274	int(cmpop)(const __mpz_struct lhsspace,
275	const __mpz_struct *rhsspace))
276	{
277	__mpz_struct lhsmpz, rhsmpz;
278	mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];
279	int res;
280
281	if (DEBUG_INT_INF)
282	fprintf (stderr, "IntInf_cmpop ("FMTOBJPTR", "FMTOBJPTR")\n",
283	lhs, rhs);
284	fillIntInfArg (s, lhs, &lhsmpz, lhsspace);
285	fillIntInfArg (s, rhs, &rhsmpz, rhsspace);
286	res = cmpop (&lhsmpz, &rhsmpz);
287	if (res < 0) return -1;
288	if (res > 0) return 1;
289	return 0;
290	}
291
292	objptr IntInf_strop (GC_state s, objptr arg, Int32_t base, size_t bytes,
293	char(strop)(char *str,
294	int base,
295	const __mpz_struct *argspace))
296	{
297	GC_string8 sp;
298	__mpz_struct argmpz;
299	mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
300	char *str;
301	size_t size;
302
303	if (DEBUG_INT_INF)
304	fprintf (stderr, "IntInf_strop ("FMTOBJPTR", %"PRId32", %"PRIuMAX")\n",
305	arg, base, (uintmax_t)bytes);
306	assert (base == 2 \|\| base == 8 \|\| base == 10 \|\| base == 16);
307	fillIntInfArg (s, arg, &argmpz, argspace);
308	assert (bytes <= (size_t)(s->limitPlusSlop - s->frontier));
309	sp = (GC_string8)s->frontier;
310	str = strop ((void*)&sp->obj, -base, &argmpz);
311	assert (str == (char*)&sp->obj);
312	size = strlen(str);
313	if (sp->obj.chars[0] == '-')
314	sp->obj.chars[0] = '~';
315	setFrontier (s, (pointer)&sp->obj + size, bytes);
316	sp->counter = (GC_arrayCounter)0;
317	sp->length = (GC_arrayLength)size;
318	sp->header = GC_STRING8_HEADER;
319	return pointerToObjptr ((pointer)&sp->obj, s->heap.start);
320	}
321
322	/*
323	static GC_state intInfMemoryFuncsState;
324
325	static void * wrap_alloc_func(size_t size) {
326	if (DEBUG_INT_INF)
327	fprintf (stderr, "alloc_func (size = %"PRIuMAX") = ",
328	(uintmax_t)size);
329	void * res = (*alloc_func_ptr)(size);
330	if (DEBUG_INT_INF)
331	fprintf (stderr, FMTPTR"\n", (uintptr_t)res);
332	return res;
333	}
334
335	static void * wrap_realloc_func(void *ptr, size_t old_size, size_t new_size) {
336	if (DEBUG_INT_INF)
337	fprintf (stderr, "realloc_func (ptr = "FMTPTR", "
338	"old_size = %"PRIuMAX", new_size = %"PRIuMAX") = ",
339	(uintptr_t)ptr, (uintmax_t)old_size, (uintmax_t)new_size);
340	assert (! isPointerInHeap(intInfMemoryFuncsState, (pointer)ptr));
341	void * res = (*realloc_func_ptr)(ptr, old_size, new_size);
342	if (DEBUG_INT_INF)
343	fprintf (stderr, FMTPTR"\n", (uintptr_t)res);
344	return res;
345	}
346
347	static void wrap_free_func(void *ptr, size_t size) {
348	if (DEBUG_INT_INF)
349	fprintf (stderr, "free_func (ptr = "FMTPTR", size = %"PRIuMAX")",
350	(uintptr_t)ptr, (uintmax_t)size);
351	assert (! isPointerInHeap(intInfMemoryFuncsState, (pointer)ptr));
352	(*free_func_ptr)(ptr, size);
353	if (DEBUG_INT_INF)
354	fprintf (stderr, "\n");
355	return;
356	}
357
358	void initIntInf (GC_state s) {
359	intInfMemoryFuncsState = s;
360	mp_get_memory_functions (&alloc_func_ptr, &realloc_func_ptr, &free_func_ptr);
361	mp_set_memory_functions (&wrap_alloc_func, &wrap_realloc_func, &wrap_free_func);
362	return;
363	}
364	*/
365
366	void initIntInf (__attribute__ ((unused)) GC_state s) {
367	return;
368	}