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
vsc 1f2fb8284a Two fixes:
GMP should not do error handling itself, as its execution env is
not reliable.
	allocate should check for space.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@875 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2003-09-24 14:51:42 +00:00

255 lines
5.5 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 *
Yap_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
Yap_CleanBigNum(void)
{
H = pre_alloc_base;
pre_alloc_base = NULL;
}
MP_INT *
Yap_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;
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;
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
Yap_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 *
Yap_BigIntOfTerm(Term t)
{
MP_INT *new = (MP_INT *)(RepAppl(t)+1);
new->_mp_d = (mp_limb_t *)(new+1);
return(new);
}
#endif
Term
Yap_MkULLIntTerm(YAP_ULONG_LONG n)
{
#ifdef __GNUC__
if (n != (UInt)n) {
#if USE_GMP
/* try to scan it as a bignum */
MP_INT *new = Yap_PreAllocBigNum();
mpz_init(new);
mpz_set_ui(new, n>>32);
mpz_mul_2exp(new, new, 32);
mpz_add_ui(new, new, (UInt)n);
return(Yap_MkBigIntTerm(new));
#else
return(MkFloatTerm(n));
#endif
} else {
return MkIntegerTerm(n);
}
#else
return MkIntegerTerm(n);
#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
Yap_InitBigNums(void)
{
#ifdef USE_GMP
/* YAP style memory allocation */
mp_set_memory_functions(
AllocBigNumSpace,
ReAllocBigNumSpace,
FreeBigNumSpace);
#endif
Yap_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag);
}