This commit was generated by cvs2svn to compensate for changes in r4,

which included commits to RCS files with non-trunk default branches.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/bignum.c

@@ -0,0 +1,216 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		arith1.c						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	bignum support through gmp				 *
+*									 *
+*************************************************************************/
+#ifdef SCCS
+static char     SccsId[] = "%W% %G%";
+#endif
+
+#include "Yap.h"
+#include "Yatom.h"
+
+#ifdef USE_GMP
+
+#include "Heap.h"
+#include "eval.h"
+#include "alloc.h"
+#if HAVE_STRING_H
+#include <string.h>
+#endif
+
+/* This global variable tells how things are going */
+
+static CELL *pre_alloc_base = NULL, *alloc_ptr;
+
+MP_INT *
+PreAllocBigNum(void)
+{
+  MP_INT *ret;
+
+  if (pre_alloc_base != H) {
+    /* inform where we are allocating */
+    alloc_ptr = pre_alloc_base = H;
+  }
+  ret = (MP_INT *)(alloc_ptr+1);
+  /* first reserve space for the functor */
+  alloc_ptr[0] = 0L;
+  /* now allocate space for mpz_t */
+  alloc_ptr = (CELL *)(ret+1);
+  /* initialise the fields */
+  mpz_init(ret);
+  return(ret);
+}
+
+MP_INT *
+InitBigNum(Int in)
+{
+  MP_INT *ret;
+
+  if (pre_alloc_base == NULL) {
+    /* inform where we are allocating */
+    alloc_ptr = pre_alloc_base = H;
+  }
+  ret = (MP_INT *)(alloc_ptr+1);
+  /* first reserve space for the functor */
+  /* I use a 0 to indicate this is the first time
+     we are building the bignum */
+  alloc_ptr[0] = 0L;
+  /* now allocate space for mpz_t */
+  alloc_ptr = (CELL *)(ret+1);
+  /* initialise the fields */
+  mpz_init_set_si(ret, in);
+  return(ret);
+}
+
+/* This is a trivial allocator that use the global space:
+
+   Each unit has a:
+     size;
+     nof elements;
+ */
+static void *
+AllocBigNumSpace(size_t size)
+{
+  void *ret = (void *)(alloc_ptr+1);
+
+  size = AdjustSize(size)/CellSize;
+  alloc_ptr[0] = size;
+  alloc_ptr += size+1;
+  if (alloc_ptr > ASP-1024)
+    Error(SYSTEM_ERROR,TermNil,"no space for bignum");
+  return(ret);
+}
+
+static void *
+ReAllocBigNumSpace(void *optr, size_t osize, size_t size)
+{
+  void *out;
+
+  size = AdjustSize(size)/CellSize;
+  osize = AdjustSize(osize)/CellSize;
+  if (((CELL *)optr)+osize == alloc_ptr) {
+    alloc_ptr += (size-osize);
+    ((CELL *)optr)[-1] = size;
+    if (alloc_ptr > ASP-1024)
+      Error(SYSTEM_ERROR,TermNil,"no space for bignum");
+    return(optr);
+  }
+  out = AllocBigNumSpace(size);
+  memcpy(out, (const void *)optr, size*CellSize);
+  return(out);
+}
+
+static void
+FreeBigNumSpace(void *optr, size_t size)
+{
+  CELL *bp = (CELL *)optr;
+
+  size = AdjustSize(size)/CellSize;
+  if (bp+size == alloc_ptr) {
+    alloc_ptr = bp-1;
+    return;
+  }
+  /* just say it is free */
+  bp[-1] = -bp[-1];
+}
+
+/* This can be done in several different situations:
+ - we did BigIntOf and want to recover now (check through ret[0]);
+ - we have done PreAlloc() and then a lot happened in between:
+   o our final computation fits in an Int;
+   o our final computation is the first we PreAlloced();
+   o our final computation is not the first term we PreAlloced();
+
+  The result may be an Int, the old BigInt, or a BigInt moved to
+  pre_alloc_base; 
+*/
+Term
+MkBigIntTerm(MP_INT *big)
+{
+  CELL *new = (CELL *)(big+1);
+  Int nlimbs = (big->_mp_alloc)*(sizeof(mp_limb_t)/CellSize);
+  Int sz;
+  CELL *ret = ((CELL *)big)-1;
+
+  sz = mpz_sizeinbase(big, 2);
+  /* was already there */
+  if (ret[0] == (CELL)FunctorBigInt) {
+    /* don't need to do no nothing */
+    return(AbsAppl(ret));
+  }
+  if (sz < SIZEOF_LONG_INT*8-1) {
+    Int out;
+    
+    H = pre_alloc_base;
+    pre_alloc_base = NULL;
+    out = mpz_get_si(big);
+    return(MkIntegerTerm(out));
+  } else {
+    /* we may have created a lot of bignums since we did the first
+       PreAlloc().  We want to recover the space, not leave "holes" on
+       the global stack */
+    if (pre_alloc_base != ret) {
+      /* copy everything to the start of the temp area */
+      MP_INT *dst = (MP_INT *)(pre_alloc_base+1);
+
+      dst->_mp_size = big->_mp_size;
+      dst->_mp_alloc = big->_mp_alloc;
+      new = (CELL *)(dst+1);
+      ret = pre_alloc_base;
+    }
+    ret[0] = (CELL)FunctorBigInt;
+    memmove((void *)new, (const void *)(big->_mp_d), nlimbs*CellSize);
+    H = (CELL *)(new+nlimbs);
+    H[0] = ((H-ret)*sizeof(CELL)+EndSpecials)|MBIT;
+    H++;
+    pre_alloc_base = NULL;
+    return(AbsAppl(ret));
+  }
+}
+
+MP_INT *
+BigIntOfTerm(Term t)
+{
+  MP_INT *new = (MP_INT *)(RepAppl(t)+1);
+
+  new->_mp_d = (mp_limb_t *)(new+1);
+  return(new);
+}
+
+#endif
+
+static Int 
+p_is_bignum(void)
+{
+#ifdef USE_GMP
+  Term t = Deref(ARG1);
+  return(IsNonVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorBigInt);
+#else
+  return(FALSE);
+#endif
+}
+
+void
+InitBigNums(void)
+{
+#ifdef USE_GMP
+  /* YAP style memory allocation */
+  mp_set_memory_functions(
+			  AllocBigNumSpace,
+			  ReAllocBigNumSpace,
+			  FreeBigNumSpace);
+#endif
+  InitCPred("$bignum", 1, p_is_bignum, SafePredFlag);
+}