This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/bignum.c
2002-06-19 21:46:56 +00:00

234 lines
5.2 KiB
C

/*************************************************************************
* *
* 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);
}
void
CleanBigNum(void)
{
H = pre_alloc_base;
pre_alloc_base = NULL;
}
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);
if (pre_alloc_base == NULL) {
return((void *)malloc(size));
}
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;
if (pre_alloc_base == NULL) {
return((void *)realloc(optr,size));
}
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;
if (pre_alloc_base == NULL) {
free(optr);
return;
}
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);
}