Term
Yap_MkBigIntTerm(MP_INT *big)
{
CACHE_REGS
Int nlimbs;
MP_INT *dst = (MP_INT *)(H+2);
CELL *ret = H;
Int bytes;
if (mpz_fits_slong_p(big)) {
long int out = mpz_get_si(big);
return MkIntegerTerm((Int)out);
}
// bytes = big->_mp_alloc * sizeof(mp_limb_t);
// nlimbs = ALIGN_YAPTYPE(bytes,CELL)/CellSize;
// this works, but it shouldn't need to do this...
nlimbs = big->_mp_alloc;
bytes = nlimbs*sizeof(CELL);
if (nlimbs > (ASP-ret)-1024) {
return TermNil;
}
H[0] = (CELL)FunctorBigInt;
H[1] = BIG_INT;
dst->_mp_size = big->_mp_size;
dst->_mp_alloc = nlimbs*(CellSize/sizeof(mp_limb_t));
memmove((void *)(dst+1), (const void *)(big->_mp_d), bytes);
H = (CELL *)(dst+1)+nlimbs;
H[0] = EndSpecials;
H++;
return AbsAppl(ret);
}
static CELL *
mark_global_cell(CELL *pt)
{
CELL reg = *pt;
if (IsVarTerm(reg)) {
/* skip bitmaps */
switch(reg) {
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
return pt + 4;
#else
return pt + 3;
#endif
case (CELL)FunctorString:
return pt + 3 + pt[1];
case (CELL)FunctorBigInt:
{
Int sz = 3 +
(sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
Opaque_CallOnGCMark f;
Opaque_CallOnGCRelocate f2;
Term t = AbsAppl(pt);
if ( (f = Yap_blob_gc_mark_handler(t)) ) {
CELL ar[256];
Int i,n = (f)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, 256);
if (n < 0) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"not enough space for slot internal variables in agc");
}
for (i = 0; i< n; i++) {
CELL *pt = ar+i;
CELL reg = *pt;
if (!IsVarTerm(reg) && IsAtomTerm(reg)) {
*pt = AtomTermAdjust(reg);
}
}
if ( (f2 = Yap_blob_gc_relocate_handler(t)) < 0 ) {
int out = (f2)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, n);
if (out < 0)
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"bad restore of slot internal variables in agc");
}
}
return pt + sz;
}
case (CELL)FunctorLongInt:
return pt + 3;
break;
}
} else if (IsAtomTerm(reg)) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
return pt+1;
}
return pt+1;
}
Term
Yap_MkApplTerm(Functor f, unsigned int n, register Term *a)
/* build compound term with functor f and n
* args a */
{
CACHE_REGS
CELL *t = HR;
if (n == 0)
return (MkAtomTerm(NameOfFunctor(f)));
if (f == FunctorList)
return MkPairTerm(a[0], a[1]);
*HR++ = (CELL) f;
while (n--)
*HR++ = (CELL) * a++;
return (AbsAppl(t));
}
static Term
NewTimedVar(CELL val USES_REGS)
{
Term out;
timed_var *tv;
if (IsVarTerm(val) &&
VarOfTerm(val) > H) {
Term nval = MkVarTerm();
Bind_Local(VarOfTerm(val), nval);
val = nval;
}
out = AbsAppl(H);
*H++ = (CELL)FunctorMutable;
tv = (timed_var *)H;
RESET_VARIABLE(&(tv->clock));
tv->value = val;
H += sizeof(timed_var)/sizeof(CELL);
return(out);
}
Term
Yap_MkNewApplTerm(Functor f, unsigned int n)
/* build compound term with functor f and n
* args a */
{
CACHE_REGS
CELL *t = HR;
if (n == 0)
return (MkAtomTerm(NameOfFunctor(f)));
if (f == FunctorList) {
RESET_VARIABLE(HR);
RESET_VARIABLE(HR+1);
HR+=2;
return (AbsPair(t));
}
*HR++ = (CELL) f;
while (n--) {
RESET_VARIABLE(HR);
HR++;
}
return (AbsAppl(t));
}
static int
unifiable(CELL d0, CELL d1)
{
CACHE_REGS
#if THREADS
#undef Yap_REGS
register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
register REGSTORE *regp = &Yap_REGS;
#define Yap_REGS (*regp)
#endif /* defined(B) || defined(TR) */
#endif
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
register CELL *pt0, *pt1;
deref_head(d0, unifiable_unk);
unifiable_nvar:
/* d0 is bound */
deref_head(d1, unifiable_nvar_unk);
unifiable_nvar_nvar:
/* both arguments are bound */
if (d0 == d1)
return TRUE;
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
return (FALSE);
}
pt0 = RepPair(d0);
pt1 = RepPair(d1);
return (unifiable_complex(pt0 - 1, pt0 + 1, pt1 - 1));
}
else if (IsApplTerm(d0)) {
pt0 = RepAppl(d0);
d0 = *pt0;
if (!IsApplTerm(d1))
return (FALSE);
pt1 = RepAppl(d1);
d1 = *pt1;
if (d0 != d1) {
return (FALSE);
} else {
if (IsExtensionFunctor((Functor)d0)) {
switch(d0) {
case (CELL)FunctorDBRef:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#ifdef USE_GMP
case (CELL)FunctorBigInt:
return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
#endif /* USE_GMP */
default:
return(FALSE);
}
}
return (unifiable_complex(pt0, pt0 + ArityOfFunctor((Functor) d0),
pt1));
}
} else {
return (FALSE);
}
deref_body(d1, pt1, unifiable_nvar_unk, unifiable_nvar_nvar);
/* d0 is bound and d1 is unbound */
*(pt1) = d0;
DO_TRAIL(pt1, d0);
return (TRUE);
deref_body(d0, pt0, unifiable_unk, unifiable_nvar);
/* pt0 is unbound */
deref_head(d1, unifiable_var_unk);
unifiable_var_nvar:
/* pt0 is unbound and d1 is bound */
*pt0 = d1;
DO_TRAIL(pt0, d1);
return TRUE;
deref_body(d1, pt1, unifiable_var_unk, unifiable_var_nvar);
/* d0 and pt1 are unbound */
UnifyAndTrailCells(pt0, pt1);
return (TRUE);
#if THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
#undef Yap_REGS
#endif /* defined(B) || defined(TR) */
#endif
}
static int
OCUnify(register CELL d0, register CELL d1)
{
CACHE_REGS
register CELL *pt0, *pt1;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
deref_head(d0, oc_unify_unk);
oc_unify_nvar:
/* d0 is bound */
deref_head(d1, oc_unify_nvar_unk);
oc_unify_nvar_nvar:
if (d0 == d1) {
return (!rational_tree(d0));
}
/* both arguments are bound */
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
return (FALSE);
}
pt0 = RepPair(d0);
pt1 = RepPair(d1);
return (OCUnify_complex(pt0 - 1, pt0 + 1, pt1 - 1));
}
else if (IsApplTerm(d0)) {
if (!IsApplTerm(d1))
return (FALSE);
pt0 = RepAppl(d0);
d0 = *pt0;
pt1 = RepAppl(d1);
d1 = *pt1;
if (d0 != d1) {
return (FALSE);
} else {
if (IsExtensionFunctor((Functor)d0)) {
switch(d0) {
case (CELL)FunctorDBRef:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
#ifdef USE_GMP
case (CELL)FunctorBigInt:
return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
#endif /* USE_GMP */
default:
return(FALSE);
}
}
return (OCUnify_complex(pt0, pt0 + ArityOfFunctor((Functor) d0),
pt1));
}
} else {
return(FALSE);
}
deref_body(d1, pt1, oc_unify_nvar_unk, oc_unify_nvar_nvar);
/* d0 is bound and d1 is unbound */
YapBind(pt1, d0);
/* local variables cannot be in a term */
if (pt1 > HR && pt1 < LCL0)
return TRUE;
if (rational_tree(d0))
return(FALSE);
return (TRUE);
deref_body(d0, pt0, oc_unify_unk, oc_unify_nvar);
/* pt0 is unbound */
deref_head(d1, oc_unify_var_unk);
oc_unify_var_nvar:
/* pt0 is unbound and d1 is bound */
YapBind(pt0, d1);
/* local variables cannot be in a term */
if (pt0 > HR && pt0 < LCL0)
return TRUE;
if (rational_tree(d1))
return(FALSE);
return (TRUE);
deref_body(d1, pt1, oc_unify_var_unk, oc_unify_var_nvar);
/* d0 and pt1 are unbound */
UnifyCells(pt0, pt1);
return (TRUE);
return (TRUE);
}
