static Term
p_mod(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Int mod;
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " mod 0", i1);
if (i1 == Int_MIN && i2 == -1) {
return MkIntTerm(0);
}
mod = i1%i2;
if (mod && (mod ^ i2) < 0)
mod += i2;
RINT(mod);
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_mod_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
break;
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* modulo between bignum and integer */
{
Int i2 = IntegerOfTerm(t2);
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... mod 0");
return Yap_gmp_mod_big_int(t1, i2);
}
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_mod_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
}
static Term
p_rem(Term t1, Term t2) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Int mod;
if (i2 == 0) goto zero_divisor;
if (i1 == Int_MIN && i2 == -1) {
#ifdef USE_GMP
return Yap_gmp_add_ints(Int_MAX, 1);
#else
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
"rem/2 with %d and %d", i1, i2);
#endif
}
mod = i1%i2;
RINT(i1%i2);
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
}
break;
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_rem_big_int(t1, IntegerOfTerm(t2));
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_rem_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
zero_divisor:
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0");
}
static Term
p_rem(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rem 0", i1);
if (i1 == Int_MIN && i2 == -1) {
return MkIntTerm(0);
}
RINT(i1%i2);
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
}
break;
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
if (IntegerOfTerm(t2) == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rem 0");
return Yap_gmp_rem_big_int(t1, IntegerOfTerm(t2));
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_rem_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
}
static Term
p_rdiv(Term t1, Term t2 USES_REGS) {
#ifdef USE_GMP
switch (ETypeOfTerm(t1)) {
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2");
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rdiv 0", i1);
return Yap_gmq_rdiv_int_int(i1, i2);
}
case (CELL)big_int_e:
/* I know the term is much larger, so: */
return Yap_gmq_rdiv_int_big(IntegerOfTerm(t1), t2);
default:
RERROR();
}
break;
case (CELL)big_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
if (IntegerOfTerm(t2) == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rdiv 0");
/* I know the term is much larger, so: */
return Yap_gmq_rdiv_big_int(t1, IntegerOfTerm(t2));
case (CELL)big_int_e:
return Yap_gmq_rdiv_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
default:
RERROR();
}
#else
RERROR();
#endif
}
static Term
get_matrix_element(Term t1, Term t2 USES_REGS)
{
if (!IsPairTerm(t2)) {
if (t2 == MkAtomTerm(AtomLength)) {
Int sz = 1;
while (IsApplTerm(t1)) {
Functor f = FunctorOfTerm(t1);
if (NameOfFunctor(f) != AtomNil) {
return MkIntegerTerm(sz);
}
sz *= ArityOfFunctor(f);
t1 = ArgOfTerm(1, t1);
}
return MkIntegerTerm(sz);
}
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
return FALSE;
}
while (IsPairTerm(t2)) {
Int indx;
Term indxt = Eval(HeadOfTerm(t2) PASS_REGS);
if (!IsIntegerTerm(indxt)) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
return FALSE;
}
indx = IntegerOfTerm(indxt);
if (!IsApplTerm(t1)) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
return FALSE;
} else {
Functor f = FunctorOfTerm(t1);
if (ArityOfFunctor(f) < indx) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]");
return FALSE;
}
}
t1 = ArgOfTerm(indx, t1);
t2 = TailOfTerm(t2);
}
if (t2 != TermNil) {
Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]");
return FALSE;
}
return Eval(t1 PASS_REGS);
}
/*
module gcd
*/
static Term
p_gcd(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2);
i1 = (i1 >= 0 ? i1 : -i1);
i2 = (i2 >= 0 ? i2 : -i2);
RINT(gcd(i1,i2 PASS_REGS));
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_gcd_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
}
break;
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "gcd/2");
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_gcd_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
return Yap_gmp_gcd_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
RERROR();
}
/*
xor #
*/
static Term
p_xor(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_xor_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
}
break;
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "#/2");
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_xor_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
return Yap_gmp_xor_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
RERROR();
}
static Int
p_binary_is(void)
{ /* X is Y */
Term t = Deref(ARG2);
Term t1, t2;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
t1 = Yap_Eval(Deref(ARG3));
if (!Yap_FoundArithError(t1, ARG3)) {
return FALSE;
}
t2 = Yap_Eval(Deref(ARG4));
if (!Yap_FoundArithError(t2, ARG4)) {
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L);
if (!tout)
return FALSE;
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
Term out;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntTerm(1);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
Yap_Error(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,2);
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L)))
return FALSE;
return Yap_unify_constant(ARG1,out);
}
return FALSE;
}
static Int
msb(Int inp) /* calculate the most significant bit for an integer */
{
/* the obvious solution: do it by using binary search */
Int out = 0;
int off = sizeof(CELL)*4;
if (inp < 0) {
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp),
"msb/1 received %d", inp);
}
while (off) {
Int limit = ((CELL)1) << (off);
if (inp >= limit) {
out += off;
inp >>= off;
}
off >>= 1;
}
static Int
msb(Int inp USES_REGS) /* calculate the most significant bit for an integer */
{
/* the obvious solution: do it by using binary search */
Int out = 0;
if (inp < 0) {
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp),
"msb/1 received %d", inp);
}
#if HAVE__BUILTIN_FFSLL
out = __builtin_ffsll(inp);
#elif HAVE_FFSLL
out = ffsll(inp);
#else
if (inp==0)
return 0L;
#if SIZEOF_INT_P == 8
if (inp & ((CELL)0xffffffffLL << 32)) {inp >>= 32; out += 32;}
static Int
gcd(Int m11,Int m21 USES_REGS)
{
/* Blankinship algorithm, provided by Miguel Filgueiras */
Int m12=1, m22=0, k;
while (m11>0 && m21>0)
if (m11<m21) {
k = m21/m11; m21 -= k*m11; m22 -= k*m12;
} else {
k=m11/m21; m11 -= k*m21; m12 -= k*m22;
}
if (m11<0 || m21<0) { /* overflow? */
/* Oflow = 1; */
Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
"gcd/2 with %d and %d", m11, m21);
return(1);
}
if (m11) return(m11);
return(m21);
}
static Int
do_arith23(arith2_op op)
{ /* X is Y */
Term t = Deref(ARG1);
Int out;
Term t1, t2;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
t1 = Yap_Eval(t);
if (t1 == 0L)
return FALSE;
t2 = Yap_Eval(Deref(ARG2));
if (t2 == 0L)
return FALSE;
if (!(out=Yap_FoundArithError(eval2(op, t1, t2), 0L)))
return FALSE;
return Yap_unify_constant(ARG3,out);
}
Int gcdmult(Int m11,Int m21,Int *pm11) /* *pm11 gets multiplier of m11 */
{
Int m12=1, m22=0, k;
while (m11 && m21)
if (m11<m21) {
k = m21/m11; m21 -= k*m11; m22 -= k*m12;
} else {
k=m11/m21; m11 -= k*m21; m12 -= k*m22;
}
if (m11<0 || m21<0) { /* overflow? */
/* Oflow = 1; */
Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
"gcdmult/2 with %d and %d", m11, m21);
return(1);
}
if (m11) {
*pm11 = m12; return(m11);
}
*pm11 = m22;
return(m21);
}
static Term
Eval(Term t USES_REGS)
{
if (IsVarTerm(t)) {
return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic");
} else if (IsNumTerm(t)) {
return t;
} else if (IsAtomTerm(t)) {
ExpEntry *p;
Atom name = AtomOfTerm(t);
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) {
/* error */
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntTerm(0);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"atom %s in arithmetic expression",
RepAtom(name)->StrOfAE);
}
return Yap_eval_atom(p->FOfEE);
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (fun == FunctorString) {
const char *s = StringOfTerm(t);
if (s[1] == '\0')
return MkIntegerTerm(s[0]);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"string in arithmetic expression");
} else if ((Atom)fun == AtomFoundVar) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil,
"cyclic term in arithmetic expression");
} else {
Int n = ArityOfFunctor(fun);
Atom name = NameOfFunctor(fun);
ExpEntry *p;
Term t1, t2;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntegerTerm(n);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,n);
}
if (p->FOfEE == op_power && p->ArityOfEE == 2) {
t2 = ArgOfTerm(2, t);
if (IsPairTerm(t2)) {
return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS);
}
}
*RepAppl(t) = (CELL)AtomFoundVar;
t1 = Eval(ArgOfTerm(1,t) PASS_REGS);
if (t1 == 0L) {
*RepAppl(t) = (CELL)fun;
return FALSE;
}
if (n == 1) {
*RepAppl(t) = (CELL)fun;
return Yap_eval_unary(p->FOfEE, t1);
}
t2 = Eval(ArgOfTerm(2,t) PASS_REGS);
*RepAppl(t) = (CELL)fun;
if (t2 == 0L)
return FALSE;
return Yap_eval_binary(p->FOfEE,t1,t2);
}
} /* else if (IsPairTerm(t)) */ {
if (TailOfTerm(t) != TermNil) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
"string must contain a single character to be evaluated as an arithmetic expression");
}
return Eval(HeadOfTerm(t) PASS_REGS);
}
}
static Term
p_div2(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Int res, mod;
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " div 0", i1);
if (i1 == Int_MIN && i2 == -1) {
#ifdef USE_GMP
return Yap_gmp_add_ints(Int_MAX, 1);
#else
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
"// /2 with %d and %d", i1, i2);
#endif
}
mod = i1%i2;
if (mod && (mod ^ i2) < 0)
mod += i2;
res = (i1 - mod) / i2;
RINT(res);
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2");
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_div_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
break;
}
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2");
case (CELL)big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* modulo between bignum and integer */
{
Int i2 = IntegerOfTerm(t2);
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... div 0");
return Yap_gmp_div2_big_int(t1, i2);
}
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_div2_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
}
static Int a_cmp(Term t1, Term t2 USES_REGS) {
if (IsVarTerm(t1)) {
Yap_ArithError(INSTANTIATION_ERROR, t1,
"while doing arithmetic comparison");
}
if (IsVarTerm(t2)) {
Yap_ArithError(INSTANTIATION_ERROR, t2,
"while doing arithmetic comparison");
}
if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2));
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
return int_cmp(IntegerOfTerm(t1) - IntegerOfTerm(t2));
}
t1 = Yap_Eval(t1);
if (!t1) {
return FALSE;
}
if (IsIntegerTerm(t1)) {
Int i1 = IntegerOfTerm(t1);
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return int_cmp(i1 - i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
}
#endif
return flt_cmp(i1 - f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_int_big(i1, t2);
#endif
} else {
return FALSE;
}
} else if (IsFloatTerm(t1)) {
Float f1 = FloatOfTerm(t1);
#if HAVE_ISNAN
if (isnan(f1)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t1,
"trying to evaluate nan");
}
#endif
t2 = Yap_Eval(t2);
#if HAVE_ISNAN
if (isnan(f1))
return -1;
#endif
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return flt_cmp(f1 - i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
}
#endif
return flt_cmp(f1 - f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_float_big(f1, t2);
#endif
} else {
return FALSE;
}
#ifdef USE_GMP
} else if (IsBigIntTerm(t1)) {
{
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
return Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2));
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
}
#endif
return Yap_gmp_cmp_big_float(t1, f2);
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_big_big(t1, t2);
} else {
return FALSE;
}
}
#endif
} else {
return FALSE;
}
}
/*
power: x^y
*/
static Term
p_exp(Term t1, Term t2 USES_REGS)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Int pow = ipow(i1,i2);
if (i2 < 0) {
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2,
"%d ^ %d", i1, i2);
}
#ifdef USE_GMP
/* two integers */
if ((i1 && !pow)) {
/* overflow */
return Yap_gmp_exp_int_int(i1, i2);
}
#endif
RINT(pow);
}
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(pow(fl1,fl2));
}
case big_int_e:
#ifdef USE_GMP
{
Int i = IntegerOfTerm(t1);
return Yap_gmp_exp_int_big(i,t2);
}
#endif
default:
RERROR();
}
break;
case double_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float / integer */
{
Int i2 = IntegerOfTerm(t2);
RFLOAT(pow(FloatOfTerm(t1),i2));
}
case double_e:
{
Float f2 = FloatOfTerm(t2);
RFLOAT(pow(FloatOfTerm(t1),f2));
}
case big_int_e:
#ifdef USE_GMP
{
RFLOAT(pow(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
}
#endif
default:
RERROR();
}
break;
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i = IntegerOfTerm(t2);
return Yap_gmp_exp_big_int(t1,i);
}
case big_int_e:
/* two bignums, makes no sense */
return Yap_gmp_exp_big_big(t1,t2);
case double_e:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(pow(Yap_gmp_to_float(t1),dbl));
}
default:
RERROR();
}
#endif
default:
RERROR();
}
RERROR();
}
static Term
eval0(Int fi) {
CACHE_REGS
arith0_op fop = fi;
switch (fop) {
case op_pi:
{
RFLOAT(PI);
}
case op_e:
{
RFLOAT(M_E);
}
case op_epsilon:
{
RFLOAT(DBL_EPSILON);
}
case op_inf:
{
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE;
RERROR();
#else
if (isoLanguageFlag()) {/* iso */
Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE;
RERROR();
} else {
RFLOAT(INFINITY);
}
#endif
}
case op_nan:
{
#ifdef _MSC_VER /* Microsoft's Visual C++ Compi<ler */
Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
RERROR();
#else
if (isoLanguageFlag()) {/* iso */
Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "evaluating not-a-number");
RERROR();
} else {
RFLOAT(NAN);
}
#endif
}
case op_random:
{
RFLOAT(Yap_random());
}
case op_cputime:
{
RFLOAT((Float)Yap_cputime()/1000.0);
}
case op_heapused:
/// - heapused
/// Heap (data-base) space used, in bytes.
///
RINT(HeapUsed);
case op_localsp:
/// - local
/// Local stack in use, in bytes
///
#if YAPOR_SBA
RINT((Int)ASP);
#else
RINT(LCL0 - ASP);
#endif
case op_b:
/// - $b
/// current choicepoint
///
#if YAPOR_SBA
RINT((Int)B);
#else
RINT(LCL0 - (CELL *)B);
#endif
case op_env:
/// - $env
/// Environment
///
#if YAPOR_SBA
RINT((Int)YENV);
#else
RINT(LCL0 - YENV);
#endif
case op_tr:
/// - $tr
/// Trail in use
///
#if YAPOR_SBA
RINT(TR);
#else
RINT(((CELL *)TR)-LCL0);
#endif
case op_stackfree:
/// - $free_stack
///
/// Not-a-number according to the IEEE Floating-Point standard. Note that evaluating this term will generate a domain error in the `iso` language mode.
RINT(Unsigned(ASP) - Unsigned(HR));
case op_globalsp:
/// - global
/// Global stack in use, in bytes.
///
#if YAPOR_SBA
RINT((Int)HR);
#else
RINT(HR - H0);
#endif
}
/// end of switch
RERROR();
}
