diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Change to simpler Eval mechanism

Browse Source 
- avoid duplicate code
- implement different optimised code.
This commit is contained in:
Vítor Santos Costa 2008-12-04 23:33:32 +00:00
parent 13dd600f88
commit e737599dc4
14 changed files with 2563 additions and 5521 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

761
C/absmi.c
View File

@ -509,44 +509,6 @@ Term Yap_XREGS[MaxTemps]; /* 29 */
#endif
inline static Functor
AritFunctorOfTerm(Term t) {
if (IsVarTerm(t)) {
return(FunctorDBRef);
}
if (IsApplTerm(t)) {
return(FunctorOfTerm(t));
} else {
if (IsIntTerm(t))
return(FunctorLongInt);
else
return(FunctorDBRef);
}
}
#define TMP_BIG() Yap_BigTmp
#define RINT(v) return(MkIntegerTerm(v))
#define RFLOAT(v) return(MkFloatTerm(v))
#if USE_GMP
#define RBIG(v) return(rbig(v))
static inline Term rbig(MP_INT *big)
{
Term t = Yap_MkBigIntTerm(big);
mpz_clear(big);
return t;
}
#endif
#define RERROR() return(TermNil)
#define ArithIEval(t,v) Yap_Eval(Deref(t),v)
#define E_FUNC Term
#define E_ARGS
#define USE_E_ARGS
#include "arith2.h"
/*
@ -11461,6 +11423,729 @@ Yap_absmi(int inp)
ENDD(d0);
ENDBOp();
#ifdef EXPERIMENTAL
Op(eqc_float, sDl);
if (!Yap_isint[PREG->u.sDl.s] && Yap_floats[PREG->u.sDl.s] == PREG->u.sDl.D) {
PREG = NEXTOP(PREG, sDl);
GONext();
}
PREG = PREG->u.sDl.F;
GONext();
ENDOp();
Op(eqc_int, snl);
if (Yap_isint[PREG->u.sDl.s] && Yap_int[PREG->u.snl.s] == PREG->u.snl.I) {
PREG = NEXTOP(PREG, snl);
GONext();
}
PREG = PREG->u.snl.F;
GONext();
ENDOp();
Op(eq, ssl);
if (Yap_isint[PREG->u.ssl.s1]) {
if (Yap_isint[PREG->u.ssl.s2] && Yap_int[PREG->u.ssl.s2] == Yap_int[PREG->u.ssl.s2]) {
PREG = NEXTOP(PREG, ssl);
GONext();
}
PREG = PREG->u.snl.F;
GONext();
} else {
if (!Yap_isint[PREG->u.ssl.s2] && Yap_floats[PREG->u.ssl.s2] == Yap_floats[PREG->u.ssl.s2]) {
PREG = NEXTOP(PREG, ssl);
GONext();
}
PREG = PREG->u.snl.F;
GONext();
}
ENDOp();
Op(ltc_float, sDl);
{
Float d0;
if (Yap_isint[PREG->u.sDl.s])
d0 = Yap_int[PREG->u.sDl.s];
else
d0 = Yap_floats[PREG->u.sDl.s];
if ( d0 > PREG->u.sDl.D) {
PREG = NEXTOP(PREG, sDl);
GONext();
}
PREG = PREG->u.sDl.F;
GONext();
}
ENDOp();
Op(ltc_int, snl);
{
Float d0;
if (Yap_isint[PREG->u.snl.s])
d0 = Yap_int[PREG->u.snl.s];
else
d0 = Yap_floats[PREG->u.snl.s];
if ( d0 > PREG->u.snl.I) {
PREG = NEXTOP(PREG, snl);
GONext();
}
PREG = PREG->u.snl.F;
GONext();
}
PREG = PREG->u.snl.F;
GONext();
ENDOp();
Op(gtc_float, sDl);
{
Float d0;
if (Yap_isint[PREG->u.sDl.s])
d0 = Yap_int[PREG->u.sDl.s];
else
d0 = Yap_floats[PREG->u.sDl.s];
if ( d0 < PREG->u.sDl.D) {
PREG = NEXTOP(PREG, sDl);
GONext();
}
PREG = PREG->u.sDl.F;
GONext();
}
ENDOp();
Op(gtc_int, snl);
{
Float d0;
if (Yap_isint[PREG->u.snl.s])
d0 = Yap_int[PREG->u.snl.s];
else
d0 = Yap_floats[PREG->u.snl.s];
if ( d0 < PREG->u.snl.I) {
PREG = NEXTOP(PREG, snl);
GONext();
}
PREG = PREG->u.snl.F;
GONext();
}
PREG = PREG->u.snl.F;
GONext();
ENDOp();
Op(lt, ssl);
if (Yap_isint[PREG->u.ssl.s1]) {
if (Yap_isint[PREG->u.ssl.s2]) {
if (Yap_int[PREG->u.ssl.s2] < Yap_int[PREG->u.ssl.s2]) {
PREG = NEXTOP(PREG, ssl);
GONext();
}
PREG = PREG->u.snl.F;
GONext();
} else {
if (Yap_int[PREG->u.ssl.s2] < Yap_floats[PREG->u.ssl.s2]) {
PREG = NEXTOP(PREG, ssl);
GONext();
}
PREG = PREG->u.snl.F;
GONext();
}
} else {
if (Yap_isint[PREG->u.ssl.s2]) {
if (Yap_floats[PREG->u.ssl.s2] < Yap_int[PREG->u.ssl.s2]) {
PREG = NEXTOP(PREG, ssl);
GONext();
}
PREG = PREG->u.snl.F;
GONext();
} else {
if (Yap_floats[PREG->u.ssl.s2] < Yap_floats[PREG->u.ssl.s2]) {
PREG = NEXTOP(PREG, ssl);
GONext();
}
PREG = PREG->u.snl.F;
GONext();
}
}
ENDOp();
Op(add_float_c, ssD);
if (Yap_isint[PREG->u.ssD.s1])
Yap_floats[PREG->u.ssD.s0] = Yap_int[PREG->u.ssDl.s1]+PREG->u.ssD.D;
else
Yap_floats[PREG->u.ssD.s0] = Yap_floats[PREG->u.ssDl.s1]+PREG->u.ssD.D;
Yap_isint[PREG->u.ssD.s0] = FALSE;
PREG = NEXTOP(PREG, ssD);
GONext();
ENDOp();
Op(add_int_c, ssn);
{
int off = PREG->u.ssn.s0;
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_floats[off] = Yap_int[PREG->u.ssn.s1]+PREG->u.ssn.I;
Yap_isint[off] = TRUE;
if (add_overflow(Yap_ints[off],Yap_int[PREG->u.ssn.s1],PREG->u.ssn.I)
PREG = Yap_EvalException(PREG);
} else {
Yap_floats[off] = Yap_floats[PREG->u.ssn.s1]+PREG->u.ssn.I;
Yap_isint[off] = FALSE;
}
}
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(add, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_ints[off] = Yap_int[PREG->u.sss.s1]+Yap_int[PREG->u.sss.s2];
Yap_isint[off] = TRUE;
if (add_overflow(Yap_ints[off],Yap_int[PREG->u.sss.s1],PREG->u.sss.s2)
PREG = Yap_EvalException(PREG);
} else {
Yap_floats[off] = Yap_int[PREG->u.sss.s1]+Yap_floats[PREG->u.sss.s2];
Yap_isint[off] = FALSE;
}
} else {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_floats[off] = Yap_floats[PREG->u.sss.s1]+Yap_int[PREG->u.sss.s2];
} else {
Yap_floats[off] = Yap_floats[PREG->u.sss.s1]+Yap_floats[PREG->u.sss.s2];
}
Yap_isint[off] = FALSE;
}
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(sub_float_c, ssD);
if (Yap_isint[PREG->u.ssD.s1])
Yap_floats[PREG->u.ssD.s0] = PREG->u.ssD.D-Yap_int[PREG->u.ssDl.s1];
else
Yap_floats[PREG->u.ssD.s0] = PREG->u.ssD.D-Yap_floats[PREG->u.ssDl.s1];
Yap_isint[PREG->u.ssD.s0] = FALSE;
PREG = NEXTOP(PREG, ssD);
GONext();
ENDOp();
Op(sub_int_c, ssn);
{
int off = PREG->u.ssn.s0;
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_floats[off] = PREG->u.ssn.I-Yap_int[PREG->u.ssn.s1];
Yap_isint[off] = TRUE;
if (sub_overflow(Yap_ints[off],PREG->u.ssn.I,Yap_int[PREG->u.ssn.s1])
PREG = Yap_EvalException(PREG);
} else {
Yap_floats[off] = PREG->u.ssn.I-Yap_floats[PREG->u.ssn.s1];
Yap_isint[off] = FALSE;
}
}
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(sub, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_ints[off] = Yap_int[PREG->u.sss.s1]-Yap_int[PREG->u.sss.s2];
Yap_isint[off] = TRUE;
if (sub_overflow(Yap_ints[off],Yap_int[PREG->u.sss.s1],Yap_int[PREG->u.sss.s2])
PREG = Yap_EvalException(PREG);
} else {
Yap_floats[off] = Yap_int[PREG->u.sss.s1]-Yap_floats[PREG->u.sss.s2];
Yap_isint[off] = FALSE;
}
} else {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_floats[off] = Yap_floats[PREG->u.sss.s1]-Yap_int[PREG->u.sss.s2];
} else {
Yap_floats[off] = Yap_floats[PREG->u.sss.s1]-Yap_floats[PREG->u.sss.s2];
}
Yap_isint[off] = FALSE;
}
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(mul_float_c, ssD);
if (Yap_isint[PREG->u.ssD.s1])
Yap_floats[PREG->u.ssD.s0] = Yap_int[PREG->u.ssDl.s1]*PREG->u.ssD.D;
else
Yap_floats[PREG->u.ssD.s0] = Yap_floats[PREG->u.ssDl.s1]*PREG->u.ssD.D;
Yap_isint[PREG->u.ssD.s0] = FALSE;
PREG = NEXTOP(PREG, ssD);
GONext();
ENDOp();
Op(mul_int_c, ssn);
{
int off = PREG->u.ssn.s0;
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_floats[off] = Yap_int[PREG->u.ssn.s1]*PREG->u.ssn.I;
Yap_isint[off] = TRUE;
if (mul_overflow(Yap_ints[off],Yap_int[PREG->u.ssn.s1],PREG->u.ssn.I)
PREG = Yap_EvalException(PREG);
} else {
Yap_floats[off] = Yap_floats[PREG->u.ssn.s1]*PREG->u.ssn.I;
Yap_isint[off] = FALSE;
}
}
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(mul, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_ints[off] = Yap_int[PREG->u.sss.s1]*Yap_int[PREG->u.sss.s2];
Yap_isint[off] = TRUE;
if (mul_overflow(Yap_ints[off],Yap_int[PREG->u.sss.s1],PREG->u.sss.s2)
PREG = Yap_EvalException(PREG);
} else {
Yap_floats[off] = Yap_int[PREG->u.sss.s1]*Yap_floats[PREG->u.sss.s2];
Yap_isint[off] = FALSE;
}
} else {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_floats[off] = Yap_floats[PREG->u.sss.s1]*Yap_int[PREG->u.sss.s2];
} else {
Yap_floats[off] = Yap_floats[PREG->u.sss.s1]*Yap_floats[PREG->u.sss.s2];
}
Yap_isint[off] = FALSE;
}
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(fdiv_c1, ssD);
if (Yap_isint[PREG->u.ssD.s1])
Yap_floats[PREG->u.ssD.s0] = PREG->u.ssD.D/Yap_int[PREG->u.ssDl.s1];
else
Yap_floats[PREG->u.ssD.s0] = PREG->u.ssD.D/Yap_floats[PREG->u.ssDl.s1];
Yap_isint[PREG->u.ssD.s0] = FALSE;
PREG = NEXTOP(PREG, ssD);
GONext();
ENDOp();
Op(fdiv_c2, ssD);
if (Yap_isint[PREG->u.ssD.s1])
Yap_floats[PREG->u.ssD.s0] = Yap_int[PREG->u.ssDl.s1]/PREG->u.ssD.D;
else
Yap_floats[PREG->u.ssD.s0] = Yap_floats[PREG->u.ssDl.s1]/PREG->u.ssD.D;
Yap_isint[PREG->u.ssD.s0] = FALSE;
PREG = NEXTOP(PREG, ssD);
GONext();
ENDOp();
Op(fdiv, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_floats[off] = ((Float)Yap_int[PREG->u.sss.s1])/Yap_int[PREG->u.sss.s2];
} else {
Yap_floats[off] = ((Float)Yap_int[PREG->u.sss.s1])/Yap_floats[PREG->u.sss.s2];
}
} else {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_floats[off] = Yap_floats[PREG->u.sss.s1]/Yap_int[PREG->u.sss.s2];
} else {
Yap_floats[off] = Yap_floats[PREG->u.sss.s1]/Yap_floats[PREG->u.sss.s2];
}
}
Yap_isint[off] = FALSE;
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(idiv_c1, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (Yap_int[PREG->u.ssn.s1] == 0) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D/Yap_int[PREG->u.ssn.s1];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssn.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(idiv_c2, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_int[PREG->u.ssn.s0] = Yap_int[PREG->u.ssn.s1]/PREG->u.ssn.D;
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssD.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(mod, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
if (Yap_int[PREG->u.sss.s2] == 0) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_ints[off] = Yap_int[PREG->u.sss.s1]/Yap_int[PREG->u.sss.s2];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[off] = TRUE;
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(mod_c1, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (Yap_int[PREG->u.ssn.s1] == 0) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_int[PREG->u.ssn.s0] = mod(PREG->u.ssn.D,Yap_int[PREG->u.ssn.s1]);
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssn.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(mod_c2, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_int[PREG->u.ssn.s0] = mod(Yap_int[PREG->u.ssnl.s1],PREG->u.ssn.D);
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssD.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(mod, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
if (Yap_int[PREG->u.sss.s2] == 0) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_ints[off] = mod(Yap_int[PREG->u.sss.s1],Yap_int[PREG->u.sss.s2]);
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[off] = TRUE;
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(rem_c1, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (Yap_int[PREG->u.ssn.s1] == 0) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D%Yap_int[PREG->u.ssn.s1];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssn.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(rem_c2, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_int[PREG->u.ssn.s0] = Yap_int[PREG->u.ssnl.s1]%PREG->u.ssn.D;
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssD.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(rem, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
if (Yap_int[PREG->u.sss.s2] == 0) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_ints[off] = Yap_int[PREG->u.sss.s1]%Yap_int[PREG->u.sss.s2];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[off] = TRUE;
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(or_c, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D|Yap_int[PREG->u.ssn.s1];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssn.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(or, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_ints[off] = Yap_int[PREG->u.sss.s1]|Yap_int[PREG->u.sss.s2];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[off] = TRUE;
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(and_c, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D&Yap_int[PREG->u.ssn.s1];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssn.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(and, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_ints[off] = Yap_int[PREG->u.sss.s1]&Yap_int[PREG->u.sss.s2];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[off] = TRUE;
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(xor_c, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D^Yap_int[PREG->u.ssn.s1];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssn.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(xor, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
Yap_ints[off] = Yap_int[PREG->u.sss.s1]^Yap_int[PREG->u.sss.s2];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[off] = TRUE;
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(uminus, ss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.ss.s1]) {
Yap_ints[off] = -Yap_int[PREG->u.ss.s1];
Yap_isint[off] = TRUE;
} else {
Yap_floats[off] = -Yap_floats[PREG->u.ss.s1];
Yap_isint[off] = FALSE;
}
}
PREG = NEXTOP(PREG, ss);
GONext();
ENDOp();
Op(sl_c1, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (sl_overflow(PREG->u.ssn.D,Yap_int[PREG->u.ssn.s1])) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D<<Yap_int[PREG->u.ssn.s1];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssn.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(sl_c2, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (sl_overflow(Yap_int[PREG->u.ssn.s1],PREG->u.ssn.D)) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_int[PREG->u.ssn.s0] = Yap_int[PREG->u.ssn.s1]<<PREG->u.ssn.D;
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssn.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(sl, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
if (sl_overflow(Yap_int[PREG->u.sss.s1],Yap_int[PREG->u.sss.s2])) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_ints[off] = Yap_int[PREG->u.sss.s1]<<Yap_int[PREG->u.sss.s2];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[off] = TRUE;
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
Op(sr_c1, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (sr_overflow(PREG->u.ssn.D,Yap_int[PREG->u.ssn.s1])) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D>>Yap_int[PREG->u.ssn.s1];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssn.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(sr_c2, ssn);
if (Yap_isint[PREG->u.ssn.s1]) {
if (sr_overflow(Yap_int[PREG->u.ssn.s1],PREG->u.ssn.D)) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_int[PREG->u.ssn.s0] = Yap_int[PREG->u.ssn.s1]>>PREG->u.ssn.D;
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[PREG->u.ssn.s0] = TRUE;
PREG = NEXTOP(PREG, ssn);
GONext();
ENDOp();
Op(sr, sss);
{
int off = PREG->u.sss.s0;
if (Yap_isint[PREG->u.sss.s1]) {
if (Yap_isint[PREG->u.sss.s2]) {
if (sr_overflow(Yap_int[PREG->u.sss.s1],Yap_int[PREG->u.sss.s2])) {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_ints[off] = Yap_int[PREG->u.sss.s1]>>Yap_int[PREG->u.sss.s2];
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
} else {
PREG = Yap_EvalException(PREG);
GONext();
}
Yap_isint[off] = TRUE;
}
PREG = NEXTOP(PREG, sss);
GONext();
ENDOp();
#endif /* EXPERIMENTAL */
Op(p_equal, e);
save_hb();
if (Yap_IUnify(ARG1, ARG2) == FALSE) {

256
C/arith0.c
View File

@ -29,13 +29,6 @@ static char SccsId[] = "%W% %G%";
#include "eval.h"
#define E_FUNC blob_type
#define E_ARGS arith_retptr o
#define RINT(v) (o)->Int = v; return(long_int_e)
#define RFLOAT(v) (o)->dbl = v; return(double_e)
#define RERROR() return(db_ref_e)
#ifndef PI
#ifdef M_PI
#define PI M_PI
@ -44,163 +37,132 @@ static char SccsId[] = "%W% %G%";
#endif
#endif
static E_FUNC
p_pi(E_ARGS)
{
RFLOAT(PI);
}
#ifndef M_E
#define M_E 2.7182818284590452354
#endif
static E_FUNC
p_e(E_ARGS)
{
RFLOAT(M_E);
}
#ifndef INFINITY
#define INFINITY (1.0/0.0)
#endif
static E_FUNC
p_inf(E_ARGS)
{
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE;
RERROR();
#else
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */
Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE;
RERROR();
} else {
RFLOAT(INFINITY);
}
#endif
}
#ifndef NAN
#define NAN (0.0/0.0)
#endif
static E_FUNC
p_nan(E_ARGS)
{
static Term
eval0(Int fi) {
arith0_op fop = fi;
switch (fop) {
case op_pi:
{
RFLOAT(PI);
}
case op_e:
{
RFLOAT(M_E);
}
case op_inf:
{
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE;
RERROR();
Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE;
RERROR();
#else
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */
Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating not-a-number");
P = (yamop *)FAILCODE;
RERROR();
} else {
RFLOAT(NAN);
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */
Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE;
RERROR();
} else {
RFLOAT(INFINITY);
}
#endif
}
case op_nan:
{
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE;
RERROR();
#else
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */
Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating not-a-number");
P = (yamop *)FAILCODE;
RERROR();
} else {
RFLOAT(NAN);
}
#endif
}
case op_random:
{
RFLOAT(Yap_random());
}
case op_cputime:
{
RFLOAT((Float)Yap_cputime()/1000.0);
}
case op_heapused:
RINT(HeapUsed);
case op_localsp:
#if SBA
RINT((Int)ASP);
#else
RINT(LCL0 - ASP);
#endif
case op_b:
#if SBA
RINT((Int)B);
#else
RINT(LCL0 - (CELL *)B);
#endif
case op_env:
#if SBA
RINT((Int)YENV);
#else
RINT(LCL0 - YENV);
#endif
case op_tr:
#if SBA
RINT(TR);
#else
RINT(((CELL *)TR)-LCL0);
#endif
case op_stackfree:
RINT(Unsigned(ASP) - Unsigned(H));
case op_globalsp:
#if SBA
RINT((Int)H);
#else
RINT(H - H0);
#endif
}
#endif
RERROR();
}
static E_FUNC
p_random(E_ARGS)
Term Yap_eval_atom(Int f)
{
RFLOAT(Yap_random());
return eval0(f);
}
static E_FUNC
p_cputime(E_ARGS)
{
RFLOAT((Float)Yap_cputime()/1000.0);
}
static E_FUNC
p_heapused(E_ARGS)
{
RINT(HeapUsed);
}
static E_FUNC
p_localsp(E_ARGS)
{
#if SBA
RINT((Int)ASP);
#else
RINT(LCL0 - ASP);
#endif
}
static E_FUNC
p_b(E_ARGS)
{
#if SBA
RINT((Int)B);
#else
RINT(LCL0 - (CELL *)B);
#endif
}
static E_FUNC
p_env(E_ARGS)
{
#if SBA
RINT((Int)YENV);
#else
RINT(LCL0 - YENV);
#endif
}
static E_FUNC
p_tr(E_ARGS)
{
#if SBA
RINT(TR);
#else
RINT(((CELL *)TR)-LCL0);
#endif
}
static E_FUNC
p_globalsp(E_ARGS)
{
#if SBA
RINT((Int)H);
#else
RINT(H - H0);
#endif
}
static E_FUNC
p_stackfree(E_ARGS)
{
RINT(Unsigned(ASP) - Unsigned(H));
}
typedef blob_type (*f_constexp)(arith_retptr);
typedef struct init_const_eval {
char *OpName;
f_constexp f;
arith0_op f;
} InitConstEntry;
static InitConstEntry InitConstTab[] = {
{"pi", p_pi},
{"e", p_e},
{"inf", p_inf},
{"nan", p_nan},
{"random", p_random},
{"cputime", p_cputime},
{"heapused", p_heapused},
{"local_sp", p_localsp},
{"global_sp", p_globalsp},
{"$last_choice_pt", p_b},
{"$env", p_env},
{"$tr", p_tr},
{"stackfree", p_stackfree},
{"pi", op_pi},
{"e", op_e},
{"inf", op_inf},
{"nan", op_nan},
{"random", op_random},
{"cputime", op_cputime},
{"heapused", op_heapused},
{"local_sp", op_localsp},
{"global_sp", op_globalsp},
{"$last_choice_pt", op_b},
{"$env", op_env},
{"$tr", op_tr},
{"stackfree", op_stackfree},
};
void
@ -224,7 +186,7 @@ Yap_InitConstExps(void)
p->KindOfPE = ExpProperty;
p->ArityOfEE = 0;
p->ENoOfEE = 0;
p->FOfEE.constant = InitConstTab[i].f;
p->FOfEE = InitConstTab[i].f;
p->NextOfPE = ae->PropsOfAE;
ae->PropsOfAE = AbsExpProp(p);
WRITE_UNLOCK(ae->ARWLock);
@ -235,20 +197,6 @@ Yap_InitConstExps(void)
int
Yap_ReInitConstExps(void)
{
unsigned int i;
Prop p;
for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) {
AtomEntry *ae = RepAtom(Yap_FullLookupAtom(InitConstTab[i].OpName));
WRITE_LOCK(ae->ARWLock);
if (!(p = Yap_GetExpPropHavingLock(ae, 0))) {
WRITE_UNLOCK(ae->ARWLock);
return FALSE;
}
RepExpProp(p)->FOfEE.constant = InitConstTab[i].f;
WRITE_UNLOCK(ae->ARWLock);
}
return TRUE;
}

2503
C/arith1.c
View File

File diff suppressed because it is too large Load Diff

1865
C/arith2.c
View File

File diff suppressed because it is too large Load Diff

150
C/arrays.c
View File

@ -367,11 +367,9 @@ p_access_array(void)
Int indx;
if (IsNonVarTerm(ti)) {
union arith_ret v;
if (IsIntTerm(ti))
indx = IntOfTerm(ti);
else if (Yap_Eval(ti, &v) == long_int_e)
indx = v.Int;
Term nti;
if (IsIntegerTerm(nti=Yap_Eval(ti)))
indx = IntegerOfTerm(nti);
else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"access_array");
return (FALSE);
@ -413,13 +411,11 @@ p_array_arg(void)
register Int indx;
if (IsNonVarTerm(ti)) {
union arith_ret v;
if (IsIntTerm(ti))
indx = IntOfTerm(ti);
else if (Yap_Eval(ti, &v) == long_int_e)
indx = v.Int;
Term nti;
if (IsIntegerTerm(nti=Yap_Eval(ti)))
indx = IntegerOfTerm(nti);
else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"array_arg");
Yap_Error(TYPE_ERROR_INTEGER,ti,"access_array");
return (FALSE);
}
}
@ -793,11 +789,13 @@ p_create_array(void)
ti = Deref(ARG2);
t = Deref(ARG1);
{
union arith_ret v;
if (IsIntTerm(ti))
size = IntOfTerm(ti);
else if (Yap_Eval(ti, &v) == long_int_e)
size = v.Int;
Term nti;
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR,ti,"create_array");
return (FALSE);
}
if (IsIntegerTerm(nti=Yap_Eval(ti)))
size = IntegerOfTerm(nti);
else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"create_array");
return (FALSE);
@ -897,13 +895,11 @@ p_create_static_array(void)
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR,ti,"create static array");
return (FALSE);
} else if (IsIntTerm(ti))
size = IntOfTerm(ti);
else {
union arith_ret v;
if (Yap_Eval(ti, &v) == long_int_e) {
size = v.Int;
}
} else {
Term nti;
if (IsIntegerTerm(nti=Yap_Eval(ti)))
size = IntegerOfTerm(nti);
else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"create static array");
return (FALSE);
@ -1059,13 +1055,11 @@ p_resize_static_array(void)
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR,ti,"resize a static array");
return (FALSE);
} else if (IsIntTerm(ti))
size = IntOfTerm(ti);
else {
union arith_ret v;
if (Yap_Eval(ti, &v) == long_int_e) {
size = v.Int;
}
} else {
Term nti;
if (IsIntegerTerm(nti=Yap_Eval(ti)))
size = IntegerOfTerm(nti);
else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"resize a static array");
return (FALSE);
@ -1293,13 +1287,11 @@ p_create_mmapped_array(void)
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR,ti,"create_mmapped_array");
return (FALSE);
} else if (IsIntTerm(ti))
size = IntOfTerm(ti);
else {
union arith_ret v;
if (Yap_Eval(ti, &v) == long_int_e) {
size = v.Int;
}
} else {
Term nti;
if (IsIntegerTerm(nti=Yap_Eval(ti)))
size = IntegerOfTerm(nti);
else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"create_mmapped_array");
return (FALSE);
@ -1583,16 +1575,13 @@ p_assign_static(void)
t2 = Deref(ARG2);
if (IsNonVarTerm(t2)) {
if (IsIntTerm(t2))
indx = IntOfTerm(t2);
else {
union arith_ret v;
if (Yap_Eval(t2, &v) == long_int_e) {
indx = v.Int;
} else {
Yap_Error(TYPE_ERROR_INTEGER,t2,"update_array");
return (FALSE);
}
Term nti;
if (IsIntegerTerm(nti=Yap_Eval(t2)))
indx = IntegerOfTerm(nti);
else {
Yap_Error(TYPE_ERROR_INTEGER,t2,"update_array");
return (FALSE);
}
} else {
Yap_Error(INSTANTIATION_ERROR,t2,"update_array");
@ -1680,17 +1669,16 @@ p_assign_static(void)
case array_of_ints:
{
Int i;
union arith_ret v;
Term nti;
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (IsIntTerm(t3))
i = IntOfTerm(t3);
else if (Yap_Eval(t3, &v) == long_int_e)
i = v.Int;
if (IsIntegerTerm(nti=Yap_Eval(t3)))
i = IntegerOfTerm(nti);
else {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
@ -1703,17 +1691,15 @@ p_assign_static(void)
case array_of_chars:
{
Int i;
union arith_ret v;
Term nti;
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (IsIntTerm(t3))
i = IntOfTerm(t3);
else if (Yap_Eval(t3, &v) == long_int_e)
i = v.Int;
if (IsIntegerTerm(nti=Yap_Eval(t3)))
i = IntegerOfTerm(nti);
else {
Yap_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
return (FALSE);
@ -1730,17 +1716,15 @@ p_assign_static(void)
case array_of_uchars:
{
Int i;
union arith_ret v;
Term nti;
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (IsIntTerm(t3))
i = IntOfTerm(t3);
else if (Yap_Eval(t3, &v) == long_int_e)
i = v.Int;
if (IsIntegerTerm(nti=Yap_Eval(t3)))
i = IntegerOfTerm(nti);
else {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
@ -1758,17 +1742,17 @@ p_assign_static(void)
case array_of_doubles:
{
Float f;
union arith_ret v;
Term nti;
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(INSTANTIATION_ERROR,t3,"assign_static");
return FALSE;
}
if (IsFloatTerm(t3))
f = FloatOfTerm(t3);
else if (Yap_Eval(t3, &v) == double_e)
f = v.dbl;
if (IsFloatTerm(nti=Yap_Eval(t3)))
f = FloatOfTerm(nti);
else if (IsIntegerTerm(nti))
f = IntegerOfTerm(nti);
else {
WRITE_UNLOCK(ptr->ArRWLock);
Yap_Error(TYPE_ERROR_FLOAT,t3,"assign_static");
@ -1923,16 +1907,12 @@ p_assign_dynamic(void)
t2 = Deref(ARG2);
if (IsNonVarTerm(t2)) {
if (IsIntTerm(t2))
indx = IntOfTerm(t2);
else {
union arith_ret v;
if (Yap_Eval(t2, &v) == long_int_e) {
indx = v.Int;
} else {
Yap_Error(TYPE_ERROR_INTEGER,t2,"update_array");
return (FALSE);
}
Term nti;
if (IsIntegerTerm(nti=Yap_Eval(t2))) {
indx = IntegerOfTerm(nti);
} else {
Yap_Error(TYPE_ERROR_INTEGER,t2,"update_array");
return (FALSE);
}
} else {
Yap_Error(INSTANTIATION_ERROR,t2,"update_array");
@ -2067,16 +2047,12 @@ p_add_to_array_element(void)
t2 = Deref(ARG2);
if (IsNonVarTerm(t2)) {
if (IsIntTerm(t2))
indx = IntOfTerm(t2);
else {
union arith_ret v;
if (Yap_Eval(t2, &v) == long_int_e) {
indx = v.Int;
} else {
Yap_Error(TYPE_ERROR_INTEGER,t2,"add_to_array_element");
return (FALSE);
}
Term nti;
if (IsIntegerTerm(nti=Yap_Eval(t2))) {
indx = IntegerOfTerm(nti);
} else {
Yap_Error(TYPE_ERROR_INTEGER,t2,"add_to_array_element");
return (FALSE);
}
} else {
Yap_Error(INSTANTIATION_ERROR,t2,"add_to_array_element");

565
C/cmppreds.c
View File

@ -534,14 +534,9 @@ flt_cmp(Float dif)
}
static Int
p_acomp(void)
{ /* $a_compare(?R,+X,+Y) */
register blob_type bt1;
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
union arith_ret v1;
static inline int
a_cmp(Term t1, Term t2)
{
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return(FALSE);
@ -556,73 +551,81 @@ p_acomp(void)
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
return(int_cmp(IntegerOfTerm(t1)-IntegerOfTerm(t2)));
}
bt1 = Yap_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
t1 = Yap_Eval(t1);
if (IsIntegerTerm(t1)) {
t2 = Yap_Eval(t2);
Int i1 = IntegerOfTerm(t1);
switch (bt2) {
case long_int_e:
return(int_cmp(v1.Int-v2.Int));
case double_e:
return(flt_cmp(v1.Int-v2.dbl));
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return(int_cmp(i1-i2));
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(2);
return(flt_cmp(i1-f2));
} else if (IsBigIntTerm(t2)) {
#ifdef USE_GMP
case big_int_e:
return(int_cmp(-mpz_cmp_si(v2.big,v1.Int)));
MP_INT *b2 = Yap_BigIntOfTerm(t2);
return(int_cmp(-mpz_cmp_si(b2,i1)));
#endif
default:
return(FALSE);
}
} else {
return(FALSE);
}
case double_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
} else if (IsFloatTerm(t1)) {
t2 = Yap_Eval(t2);
Float f1 = FloatOfTerm(t1);
switch (bt2) {
case long_int_e:
return(flt_cmp(v1.dbl-v2.Int));
case double_e:
return(flt_cmp(v1.dbl-v2.dbl));
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return(flt_cmp(f1-i2));
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(2);
return(flt_cmp(f1-f2));
} else if (IsBigIntTerm(t2)) {
#ifdef USE_GMP
case big_int_e:
return(flt_cmp(v1.dbl-mpz_get_d(v2.big)));
MP_INT *b2 = Yap_BigIntOfTerm(t2);
return(flt_cmp(f1-mpz_get_d(b2)));
#endif
default:
return(FALSE);
}
} else {
return(FALSE);
}
} else if (IsBigIntTerm(t1)) {
#ifdef USE_GMP
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
t2 = Yap_Eval(t2);
MP_INT *b1 = Yap_BigIntOfTerm(t1);
switch (bt2) {
case long_int_e:
return(int_cmp(mpz_cmp_si(v1.big,v2.Int)));
case double_e:
return(flt_cmp(mpz_get_d(v1.big)-v2.dbl));
case big_int_e:
return(int_cmp(mpz_cmp(v1.big,v2.big)));
default:
return(FALSE);
}
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return(int_cmp(mpz_cmp_si(b1,i2)));
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(2);
return(flt_cmp(mpz_get_d(b1)-f2));
} else if (IsBigIntTerm(t2)) {
MP_INT *b2 = Yap_BigIntOfTerm(2);
return(int_cmp(mpz_cmp(b1,b2)));
} else {
return(FALSE);
}
}
#endif
default:
} else {
return(FALSE);
}
}
static Int
p_acomp(void)
{ /* $a_compare(?R,+X,+Y) */
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
return a_cmp(t1, t2);
}
static Int
a_eq(Term t1, Term t2)
{ /* A =:= B */
blob_type bt1;
union arith_ret v1;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return(FALSE);
@ -635,460 +638,74 @@ a_eq(Term t1, Term t2)
return (FloatOfTerm(t1) == FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) == IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
t1 = Yap_Eval(t1);
if (IsIntegerTerm(t1)) {
t2 = Yap_Eval(t2);
Int i1 = IntegerOfTerm(t1);
switch (bt2) {
case long_int_e:
return(v1.Int == v2.Int);
case double_e:
return(v1.Int == v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(-mpz_cmp_si(v2.big,v1.Int) == 0);
#endif
default:
return(FALSE);
}
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return(i1==i2);
} else {
return FALSE;
}
case double_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
} else if (IsFloatTerm(t1)) {
t2 = Yap_Eval(t2);
Float f1 = FloatOfTerm(t1);
switch (bt2) {
case long_int_e:
return(v1.dbl == v2.Int);
case double_e:
return(v1.dbl == v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(v1.dbl == mpz_get_d(v2.big));
#endif
default:
return(FALSE);
}
if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(2);
return(f1 == f2);
} else {
return FALSE;
}
} else if (IsBigIntTerm(t1)) {
#ifdef USE_GMP
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
t2 = Yap_Eval(t2);
MP_INT *b1 = Yap_BigIntOfTerm(t1);
switch (bt2) {
case long_int_e:
return(mpz_cmp_si(v1.big,v2.Int) == 0);
case double_e:
return(mpz_get_d(v1.big) == v2.dbl);
case big_int_e:
return(mpz_cmp(v1.big,v2.big) == 0);
default:
return(FALSE);
}
if (IsBigIntTerm(t2)) {
MP_INT *b2 = Yap_BigIntOfTerm(2);
return(mpz_cmp(b1,b2) == 0);
} else {
return(FALSE);
}
}
#endif
default:
} else {
return(FALSE);
}
}
static Int
a_dif(Term t1, Term t2)
{ /* A =\\= B */
blob_type bt1;
union arith_ret v1;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "=\\=/2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "=\\=/2");
return(FALSE);
}
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) != FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) != IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(v1.Int != v2.Int);
case double_e:
return(v1.Int != v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(-mpz_cmp_si(v2.big,v1.Int) != 0);
#endif
default:
return(FALSE);
}
}
case double_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(v1.dbl != v2.Int);
case double_e:
return(v1.dbl != v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(v1.dbl != mpz_get_d(v2.big));
#endif
default:
return(FALSE);
}
}
#ifdef USE_GMP
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(mpz_cmp_si(v1.big,v2.Int) != 0);
case double_e:
return(mpz_get_d(v1.big) != v2.dbl);
case big_int_e:
return(mpz_cmp(v1.big,v2.big) != 0);
default:
return(FALSE);
}
}
#endif
default:
return(FALSE);
}
{
return !a_eq(t1,t2);
}
static Int
a_gt(Term t1, Term t2)
{ /* A > B */
blob_type bt1;
union arith_ret v1;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, ">/2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, ">/2");
return(FALSE);
}
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) > FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) > IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(v1.Int > v2.Int);
case double_e:
return(v1.Int > v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(-mpz_cmp_si(v2.big,v1.Int) > 0);
#endif
default:
return(FALSE);
}
}
case double_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(v1.dbl > v2.Int);
case double_e:
return(v1.dbl > v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(v1.dbl > mpz_get_d(v2.big));
#endif
default:
return(FALSE);
}
}
#ifdef USE_GMP
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(mpz_cmp_si(v1.big,v2.Int) > 0);
case double_e:
return(mpz_get_d(v1.big) > v2.dbl);
case big_int_e:
return(mpz_cmp(v1.big,v2.big) > 0);
default:
return(FALSE);
}
}
#endif
default:
return(FALSE);
}
return a_cmp(t1,t2) > 0;
}
static Int
a_ge(Term t1, Term t2)
{ /* A >= B */
blob_type bt1;
union arith_ret v1;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, ">=/2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t1, ">=/2");
return(FALSE);
}
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) >= FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) >= IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(v1.Int >= v2.Int);
case double_e:
return(v1.Int >= v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(-mpz_cmp_si(v2.big,v1.Int) >= 0);
#endif
default:
return(FALSE);
}
}
case double_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(v1.dbl >= v2.Int);
case double_e:
return(v1.dbl >= v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(v1.dbl >= mpz_get_d(v2.big));
#endif
default:
return(FALSE);
}
}
#ifdef USE_GMP
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(mpz_cmp_si(v1.big,v2.Int) >= 0);
case double_e:
return(mpz_get_d(v1.big) >= v2.dbl);
case big_int_e:
return(mpz_cmp(v1.big,v2.big) >= 0);
default:
return(FALSE);
}
}
#endif
default:
return(FALSE);
}
return a_cmp(t1,t2) >= 0;
}
static Int
a_lt(Term t1, Term t2)
{ /* A < B */
blob_type bt1;
union arith_ret v1;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "</2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "</2");
return(FALSE);
}
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) < FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) < IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(v1.Int < v2.Int);
case double_e:
return(v1.Int < v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(-mpz_cmp_si(v2.big,v1.Int) < 0);
#endif
default:
return(FALSE);
}
}
case double_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(v1.dbl < v2.Int);
case double_e:
return(v1.dbl < v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(v1.dbl < mpz_get_d(v2.big));
#endif
default:
return(FALSE);
}
}
#ifdef USE_GMP
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(mpz_cmp_si(v1.big,v2.Int) < 0);
case double_e:
return(mpz_get_d(v1.big) < v2.dbl);
case big_int_e:
return(mpz_cmp(v1.big,v2.big) < 0);
default:
return(FALSE);
}
}
#endif
default:
return(FALSE);
}
return a_cmp(t1,t2) < 0;
}
static Int
a_le(Term t1, Term t2)
{ /* A <= B */
blob_type bt1;
union arith_ret v1;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "=</2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "=</2");
return(FALSE);
}
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) <= FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) <= IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(v1.Int <= v2.Int);
case double_e:
return(v1.Int <= v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(-mpz_cmp_si(v2.big,v1.Int) <= 0);
#endif
default:
return(FALSE);
}
}
case double_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(v1.dbl <= v2.Int);
case double_e:
return(v1.dbl <= v2.dbl);
#ifdef USE_GMP
case big_int_e:
return(v1.dbl <= mpz_get_d(v2.big));
#endif
default:
return(FALSE);
}
}
#ifdef USE_GMP
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Yap_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
return(mpz_cmp_si(v1.big,v2.Int) <= 0);
case double_e:
return(mpz_get_d(v1.big) <= v2.dbl);
case big_int_e:
return(mpz_cmp(v1.big,v2.big) <= 0);
default:
return(FALSE);
}
}
#endif
default:
return(FALSE);
}
return a_cmp(t1,t2) <= 0;
}

172
C/eval.c
View File

@ -29,97 +29,16 @@ static char SccsId[] = "%W% %G%";
yap_error_number Yap_matherror = YAP_NO_ERROR;
#define E_FUNC blob_type
#define E_ARGS arith_retptr o
#define USE_E_ARGS o
#define TMP_BIG() ((o)->big)
#define RBIG(v) return(big_int_e)
#define RINT(v) (o)->Int = v; return(long_int_e)
#define RFLOAT(v) (o)->dbl = v; return(double_e)
#define RERROR() return(db_ref_e)
static Term
EvalToTerm(blob_type bt, union arith_ret *res)
{
switch (bt) {
case long_int_e:
return MkIntegerTerm(res->Int);
case double_e:
return MkFloatTerm(res->dbl);
#ifdef USE_GMP
case big_int_e:
{
Term t = Yap_MkBigIntTerm(res->big);
mpz_clear(res->big);
return t;
}
#endif
default:
return TermNil;
}
}
static E_FUNC
Eval(Term t, E_ARGS)
Eval(Term t)
{
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic");
P = (yamop *)FAILCODE;
RERROR();
}
if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
switch ((CELL)fun) {
case (CELL)FunctorLongInt:
RINT(LongIntOfTerm(t));
case (CELL)FunctorDouble:
RFLOAT(FloatOfTerm(t));
#ifdef USE_GMP
case (CELL)FunctorBigInt:
{
MP_INT *new = TMP_BIG();
mpz_init_set(new, Yap_BigIntOfTerm(t));
RBIG(new);
}
#endif
default:
{
Int n = ArityOfFunctor(fun);
Atom name = NameOfFunctor(fun);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntegerTerm(n);
t = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("/"),2), 2, ti);
Yap_Error(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,n);
P = (yamop *)FAILCODE;
RERROR();
}
if (n == 1)
return(p->FOfEE.unary(ArgOfTerm(1,t), USE_E_ARGS));
return(p->FOfEE.binary(ArgOfTerm(1,t),ArgOfTerm(2,t), USE_E_ARGS));
}
}
} else if (IsPairTerm(t)) {
if (TailOfTerm(t) != TermNil) {
Yap_Error(TYPE_ERROR_EVALUABLE, t,
"string must contain a single character to be evaluated as an arithmetic expression");
P = (yamop *)FAILCODE;
RERROR();
}
return(Eval(HeadOfTerm(t), USE_E_ARGS));
} else if (IsIntTerm(t)) {
RINT(IntOfTerm(t));
} else {
Atom name = AtomOfTerm(t);
return 0L;;
} else if (IsAtomTerm(t)) {
ExpEntry *p;
Atom name = AtomOfTerm(t);
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) {
Term ti[2], terror;
@ -133,41 +52,26 @@ Eval(Term t, E_ARGS)
"atom %s for arithmetic expression",
RepAtom(name)->StrOfAE);
P = (yamop *)FAILCODE;
RERROR();
return 0L;
}
return(p->FOfEE.constant(USE_E_ARGS));
}
}
E_FUNC
Yap_Eval(Term t, E_ARGS)
{
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic");
P = (yamop *)FAILCODE;
RERROR();
}
if (IsApplTerm(t)) {
return Yap_eval_atom(p->FOfEE);
} else if (IsIntTerm(t)) {
return t;
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
switch ((CELL)fun) {
case (CELL)FunctorLongInt:
RINT(LongIntOfTerm(t));
case (CELL)FunctorDouble:
RFLOAT(FloatOfTerm(t));
#ifdef USE_GMP
case (CELL)FunctorBigInt:
{
MP_INT *new = TMP_BIG();
mpz_init_set(new, Yap_BigIntOfTerm(t));
RBIG(new);
}
#endif
return t;
default:
{
Int n = ArityOfFunctor(fun);
Atom name = NameOfFunctor(fun);
ExpEntry *p;
Term t1, t2;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
Term ti[2];
@ -182,45 +86,34 @@ Yap_Eval(Term t, E_ARGS)
P = (yamop *)FAILCODE;
RERROR();
}
if (n == 1) {
return p->FOfEE.unary(ArgOfTerm(1,t), USE_E_ARGS);
}
return
p->FOfEE.binary(ArgOfTerm(1,t),ArgOfTerm(2,t), USE_E_ARGS);
t1 = Eval(ArgOfTerm(1,t));
if (t1 == 0L)
return FALSE;
if (n == 1)
return Yap_eval_unary(p->FOfEE, t1);
t2 = Eval(ArgOfTerm(2,t));
if (t2 == 0L)
return FALSE;
return Yap_eval_binary(p->FOfEE,t1,t2);
}
}
} else if (IsPairTerm(t)) {
} /* else if (IsPairTerm(t)) */ {
if (TailOfTerm(t) != TermNil) {
Yap_Error(TYPE_ERROR_EVALUABLE, t,
"string must contain a single character to be evaluated as an arithmetic expression");
P = (yamop *)FAILCODE;
RERROR();
return 0L;
}
return(Eval(HeadOfTerm(t), USE_E_ARGS));
} else if (IsIntTerm(t)) {
RINT(IntOfTerm(t));
} else {
Atom name = AtomOfTerm(t);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) {
Term ti[2], terror;
/* error */
ti[0] = t;
ti[1] = MkIntegerTerm(0);
/* error */
terror = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("/"),2), 2, ti);
Yap_Error(TYPE_ERROR_EVALUABLE, terror,
"atom %s for arithmetic expression",
RepAtom(name)->StrOfAE);
P = (yamop *)FAILCODE;
RERROR();
}
return(p->FOfEE.constant(USE_E_ARGS));
return Eval(HeadOfTerm(t));
}
}
Term
Yap_Eval(Term t)
{
return Eval(t);
}
#ifdef BEAM
Int BEAM_is(void);
@ -240,13 +133,10 @@ BEAM_is(void)
static Int
p_is(void)
{ /* X is Y */
union arith_ret res;
blob_type bt;
Term out;
bt = Eval(Deref(ARG2), &res);
out = EvalToTerm(bt,&res);
if (out == TermNil) {
out = Eval(Deref(ARG2));
if (out == 0L) {
Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, ARG2, "is/2");
return FALSE;
}

254
C/gmp_support.c
View File

@ -22,214 +22,250 @@
#if USE_GMP
/* add i + j using temporary bigint new */
MP_INT *
Yap_gmp_add_ints(Int i, Int j, MP_INT *new)
Term
Yap_gmp_add_ints(Int i, Int j)
{
mpz_init_set_si(new,i);
MP_INT new;
mpz_init_set_si(&new,i);
if (j > 0) {
mpz_add_ui(new, new, j);
mpz_add_ui(&new, &new, j);
} else {
if (j-1 > 0) { /* negative overflow */
mpz_sub_ui(new, new, -(j+1));
mpz_sub_ui(new, new, 1);
mpz_sub_ui(&new, &new, -(j+1));
mpz_sub_ui(&new, &new, 1);
} else {
mpz_sub_ui(new, new, -j);
mpz_sub_ui(&new, &new, -j);
}
}
return new;
return Yap_MkBigIntTerm(&new);
}
MP_INT *
Yap_gmp_sub_ints(Int i, Int j, MP_INT *new)
Term
Yap_gmp_sub_ints(Int i, Int j)
{
mpz_init_set_si(new,i);
MP_INT new;
mpz_init_set_si(&new,i);
if (j > 0) {
mpz_sub_ui(new, new, j);
mpz_sub_ui(&new, &new, j);
} else {
if (j-1 > 0) { /* negative overflow */
mpz_add_ui(new, new, -(j+1));
mpz_add_ui(new, new, 1);
mpz_add_ui(&new, &new, -(j+1));
mpz_add_ui(&new, &new, 1);
} else {
mpz_add_ui(new, new, -j);
mpz_add_ui(&new, &new, -j);
}
}
return new;
return Yap_MkBigIntTerm(&new);
}
MP_INT *
Yap_gmp_mul_ints(Int i, Int j, MP_INT *new)
Term
Yap_gmp_mul_ints(Int i, Int j)
{
mpz_init_set_si(new,i);
mpz_mul_si(new, new, j);
return new;
MP_INT new;
mpz_init_set_si(&new,i);
mpz_mul_si(&new, &new, j);
return Yap_MkBigIntTerm(&new);
}
MP_INT *
Yap_gmp_sll_ints(Int i, Int j, MP_INT *new)
Term
Yap_gmp_sll_ints(Int i, Int j)
{
mpz_init_set_si(new,i);
mpz_mul_2exp(new, new, j);
return new;
MP_INT new;
mpz_init_set_si(&new,i);
mpz_mul_2exp(&new, &new, j);
return Yap_MkBigIntTerm(&new);
}
/* add i + b using temporary bigint new */
MP_INT *
Yap_gmp_add_int_big(Int i, MP_INT *b, MP_INT *new)
Term
Yap_gmp_add_int_big(Int i, MP_INT *b)
{
mpz_init_set_si(new, i);
mpz_add(new, new, b);
return new;
MP_INT new;
mpz_init_set_si(&new, i);
mpz_add(&new, &new, b);
return Yap_MkBigIntTerm(&new);
}
/* sub i - b using temporary bigint new */
MP_INT *
Yap_gmp_sub_int_big(Int i, MP_INT *b, MP_INT *new)
Term
Yap_gmp_sub_int_big(Int i, MP_INT *b)
{
mpz_init_set_si(new, i);
mpz_sub(new, new, b);
return new;
MP_INT new;
mpz_init_set_si(&new, i);
mpz_sub(&new, &new, b);
return Yap_MkBigIntTerm(&new);
}
/* add i + b using temporary bigint new */
MP_INT *
Yap_gmp_mul_int_big(Int i, MP_INT *b, MP_INT *new)
Term
Yap_gmp_mul_int_big(Int i, MP_INT *b)
{
mpz_init_set_si(new, i);
mpz_mul(new, new, b);
return new;
MP_INT new;
mpz_init_set_si(&new, i);
mpz_mul(&new, &new, b);
return Yap_MkBigIntTerm(&new);
}
/* sub i - b using temporary bigint new */
MP_INT *
Yap_gmp_sub_big_int(MP_INT *b, Int i, MP_INT *new)
Term
Yap_gmp_sub_big_int(MP_INT *b, Int i)
{
mpz_init_set_si(new, i);
mpz_neg(new, new);
mpz_add(new, new, b);
return new;
MP_INT new;
mpz_init_set_si(&new, i);
mpz_neg(&new, &new);
mpz_add(&new, &new, b);
return Yap_MkBigIntTerm(&new);
}
/* div i / b using temporary bigint new */
MP_INT *
Yap_gmp_div_big_int(MP_INT *b, Int i, MP_INT *new)
Term
Yap_gmp_div_big_int(MP_INT *b, Int i)
{
MP_INT new;
mpz_init_set(new, b);
mpz_init_set(&new, b);
if (yap_flags[INTEGER_ROUNDING_FLAG] == 0) {
if (i > 0) {
mpz_fdiv_q_ui(new, new, i);
mpz_fdiv_q_ui(&new, &new, i);
} else if (i == 0) {
Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
return NULL;
return 0L;
} else {
/* we do not handle MIN_INT */
mpz_fdiv_q_ui(new, new, -i);
mpz_neg(new, new);
mpz_fdiv_q_ui(&new, &new, -i);
mpz_neg(&new, &new);
}
} else {
if (i > 0) {
mpz_tdiv_q_ui(new, new, i);
mpz_tdiv_q_ui(&new, &new, i);
} else if (i == 0) {
Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
return NULL;
return 0L;
} else {
/* we do not handle MIN_INT */
mpz_tdiv_q_ui(new, new, -i);
mpz_neg(new, new);
mpz_tdiv_q_ui(&new, &new, -i);
mpz_neg(&new, &new);
}
}
return new;
return Yap_MkBigIntTerm(&new);
}
/* sub i - b using temporary bigint new */
MP_INT *
Yap_gmp_and_int_big(Int i, MP_INT *b, MP_INT *new)
Term
Yap_gmp_and_int_big(Int i, MP_INT *b)
{
mpz_init_set_si(new, i);
mpz_and(new, new, b);
return new;
MP_INT new;
mpz_init_set_si(&new, i);
mpz_and(&new, &new, b);
return Yap_MkBigIntTerm(&new);
}
/* sub i - b using temporary bigint new */
MP_INT *
Yap_gmp_ior_int_big(Int i, MP_INT *b, MP_INT *new)
Term
Yap_gmp_ior_int_big(Int i, MP_INT *b)
{
mpz_init_set_si(new, i);
mpz_ior(new, new, b);
return new;
MP_INT new;
mpz_init_set_si(&new, i);
mpz_ior(&new, &new, b);
return Yap_MkBigIntTerm(&new);
}
/* add i + b using temporary bigint new */
MP_INT *
Yap_gmp_sll_big_int(MP_INT *b, Int i, MP_INT *new)
Term
Yap_gmp_sll_big_int(MP_INT *b, Int i)
{
MP_INT new;
if (i > 0) {
mpz_init_set(new, b);
mpz_mul_2exp(new, new, i);
mpz_init_set(&new, b);
mpz_mul_2exp(&new, &new, i);
} else if (i == 0) {
mpz_init_set(new, b);
mpz_init_set(&new, b);
} else {
mpz_init_set(new, b);
mpz_init_set(&new, b);
if (i == Int_MIN) {
return NULL;
return 0L;
}
mpz_tdiv_q_2exp(new, new, -i);
mpz_tdiv_q_2exp(&new, &new, -i);
}
return new;
return Yap_MkBigIntTerm(&new);
}
MP_INT *
Yap_gmp_add_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
Term
Yap_gmp_add_big_big(MP_INT *b1, MP_INT *b2)
{
mpz_init_set(new, b1);
mpz_add(new, new, b2);
return new;
MP_INT new;
mpz_init_set(&new, b1);
mpz_add(&new, &new, b2);
return Yap_MkBigIntTerm(&new);
}
MP_INT *
Yap_gmp_sub_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
Term
Yap_gmp_sub_big_big(MP_INT *b1, MP_INT *b2)
{
mpz_init_set(new, b1);
mpz_sub(new, new, b2);
return new;
MP_INT new;
mpz_init_set(&new, b1);
mpz_sub(&new, &new, b2);
return Yap_MkBigIntTerm(&new);
}
MP_INT *
Yap_gmp_mul_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
Term
Yap_gmp_mul_big_big(MP_INT *b1, MP_INT *b2)
{
mpz_init_set(new, b1);
mpz_mul(new, new, b2);
return new;
MP_INT new;
mpz_init_set(&new, b1);
mpz_mul(&new, &new, b2);
return Yap_MkBigIntTerm(&new);
}
/* div i / b using temporary bigint new */
MP_INT *
Yap_gmp_div_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
Term
Yap_gmp_div_big_big(MP_INT *b1, MP_INT *b2)
{
MP_INT new;
mpz_init_set(new, b1);
mpz_init_set(&new, b1);
if (yap_flags[INTEGER_ROUNDING_FLAG] == 0) {
mpz_fdiv_q(new, new, b2);
mpz_fdiv_q(&new, &new, b2);
} else {
mpz_tdiv_q(new, new, b2);
mpz_tdiv_q(&new, &new, b2);
}
return new;
return Yap_MkBigIntTerm(&new);
}
MP_INT *
Yap_gmp_and_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
Term
Yap_gmp_and_big_big(MP_INT *b1, MP_INT *b2)
{
mpz_init_set(new, b1);
mpz_and(new, new, b2);
return new;
MP_INT new;
mpz_init_set(&new, b1);
mpz_and(&new, &new, b2);
return Yap_MkBigIntTerm(&new);
}
MP_INT *
Yap_gmp_ior_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
Term
Yap_gmp_ior_big_big(MP_INT *b1, MP_INT *b2)
{
mpz_init_set(new, b1);
mpz_ior(new, new, b2);
return new;
MP_INT new;
mpz_init_set(&new, b1);
mpz_ior(&new, &new, b2);
return Yap_MkBigIntTerm(&new);
}
Float

6
C/mavar.c
View File

@ -49,9 +49,9 @@ p_setarg(void)
if (IsIntTerm(ti))
i = IntOfTerm(ti);
else {
union arith_ret v;
if (Yap_Eval(ti, &v) == long_int_e) {
i = v.Int;
Term te = Yap_Eval(ti);
if (IsIntegerTerm(te)) {
i = IntegerOfTerm(te);
} else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
return FALSE;

6
C/stdpreds.c
View File

@ -2996,10 +2996,10 @@ p_flags(void)
UNLOCK(pe->PELock);
return (TRUE);
} else if (!IsIntegerTerm(ARG4)) {
union arith_ret v;
Term te = Yap_Eval(ARG4);
if (Yap_Eval(ARG4, &v) == long_int_e) {
newFl = v.Int;
if (IsIntegerTerm(te)) {
newFl = IntegerOfTerm(te);
} else {
UNLOCK(pe->PELock);
Yap_Error(TYPE_ERROR_INTEGER, ARG4, "flags");

7
H/Yatom.h
View File

@ -499,12 +499,7 @@ typedef struct
BITS16 ENoOfEE;
BITS16 FlagsOfEE;
/* operations that implement the expression */
union
{
blob_type (*constant) (eval_ret);
blob_type (*unary) (Term, eval_ret);
blob_type (*binary) (Term, Term, eval_ret);
} FOfEE;
int FOfEE;
} ExpEntry;
#if USE_OFFSETS_IN_PROPS

1383
H/arith2.h
View File

File diff suppressed because it is too large Load Diff

154
H/eval.h
View File

@ -39,23 +39,83 @@
#define Int_MIN (-Int_MAX-(CELL)1)
#endif
typedef union arith_ret {
Int Int;
Float dbl;
#ifdef USE_GMP
mpz_t big;
#endif
} *arith_retptr;
typedef enum {
op_pi,
op_e,
op_inf,
op_nan,
op_random,
op_cputime,
op_heapused,
op_localsp,
op_globalsp,
op_b,
op_env,
op_tr,
op_stackfree
} arith0_op;
/*
#define RINT(v) return(MkIntegerTerm(v))
#define RFLOAT(v) return(MkFloatTerm(v))
#define RBIG(v) return(Yap_MkBigIntTerm(v))
#define RBIG_FL(v) return(Yap_MkBigIntTerm((MP_INT *)(Int)v))
#define RERROR() return(MkIntTerm(0))
*/
typedef enum {
op_uplus,
op_uminus,
op_unot,
op_exp,
op_log,
op_log10,
op_sqrt,
op_sin,
op_cos,
op_tan,
op_sinh,
op_cosh,
op_tanh,
op_asin,
op_acos,
op_atan,
op_asinh,
op_acosh,
op_atanh,
op_floor,
op_ceiling,
op_round,
op_truncate,
op_integer,
op_float,
op_abs,
op_msb,
op_ffracp,
op_fintp,
op_sign,
op_lgamma,
op_random1
} arith1_op;
Functor STD_PROTO(EvalArg,(Term,arith_retptr));
typedef enum {
op_plus,
op_minus,
op_times,
op_fdiv,
op_mod,
op_rem,
op_div,
op_sll,
op_slr,
op_and,
op_or,
op_xor,
op_atan2,
/* C-Prolog exponentiation */
op_power,
/* ISO-Prolog exponentiation */
/* op_power, */
/* Quintus exponentiation */
/* op_power, */
op_gcd,
op_min,
op_max
} arith2_op;
Functor STD_PROTO(EvalArg,(Term));
/* Needed to handle numbers:
these two macros are fundamental in the integer/float conversions */
@ -98,27 +158,53 @@ int STD_PROTO(Yap_ReInitConstExps,(void));
int STD_PROTO(Yap_ReInitUnaryExps,(void));
int STD_PROTO(Yap_ReInitBinaryExps,(void));
blob_type STD_PROTO(Yap_Eval,(Term, union arith_ret *));
Term STD_PROTO(Yap_eval_atom,(Int));
Term STD_PROTO(Yap_eval_unary,(Int,Term));
Term STD_PROTO(Yap_eval_binary,(Int,Term,Term));
blob_type STD_PROTO(Yap_Eval,(Term));
#define RINT(v) return(MkIntegerTerm(v))
#define RFLOAT(v) return(MkFloatTerm(v))
#define RBIG(v) return(Yap_MkBigIntTerm(v))
#define RERROR() return(0L)
static inline blob_type
ETypeOfTerm(Term t)
{
if (IsIntTerm(t))
return long_int_e;
if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (f == FunctorDouble)
return double_e;
if (f == FunctorLongInt)
return long_int_e;
if (f == FunctorBigInt)
return big_int_e;
}
return db_ref_e;
}
#if USE_GMP
MP_INT *STD_PROTO(Yap_gmp_add_ints,(Int, Int, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_sub_ints,(Int, Int, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_mul_ints,(Int, Int, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_sll_ints,(Int, Int, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_add_int_big,(Int, MP_INT *, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_sub_int_big,(Int, MP_INT *, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_sub_big_int,(MP_INT *, Int, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_mul_int_big,(Int, MP_INT *, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_div_big_int,(MP_INT *, Int, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_and_int_big,(Int, MP_INT *, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_ior_int_big,(Int, MP_INT *, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_sll_big_int,(MP_INT *, Int, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_add_big_big,(MP_INT *, MP_INT *, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_sub_big_big,(MP_INT *, MP_INT *, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_mul_big_big,(MP_INT *, MP_INT *, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_div_big_big,(MP_INT *, MP_INT *, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_and_big_big,(MP_INT *, MP_INT *, MP_INT *));
MP_INT *STD_PROTO(Yap_gmp_ior_big_big,(MP_INT *, MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_add_ints,(Int, Int));
Term STD_PROTO(Yap_gmp_sub_ints,(Int, Int));
Term STD_PROTO(Yap_gmp_mul_ints,(Int, Int));
Term STD_PROTO(Yap_gmp_sll_ints,(Int, Int));
Term STD_PROTO(Yap_gmp_add_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_sub_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_sub_big_int,(MP_INT *, Int));
Term STD_PROTO(Yap_gmp_mul_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_div_big_int,(MP_INT *, Int));
Term STD_PROTO(Yap_gmp_and_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_ior_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_sll_big_int,(MP_INT *, Int));
Term STD_PROTO(Yap_gmp_add_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_sub_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_mul_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_div_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_and_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_ior_big_big,(MP_INT *, MP_INT *));

2
pl/arith.yap
View File

@ -79,6 +79,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
'$clean_cuts'(NG0, NG),
'$do_c_built_in'(A,M,NA).
'$do_c_built_in'('C'(A,B,C), _, (A=[B|C])) :- !.
/*
'$do_c_built_in'(X is Y, _, P) :-
nonvar(Y), % Don't rewrite variables
!,
@ -97,6 +98,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
'$expand_expr'(F, Q, V),
'$do_and'(P, Q, R0),
'$do_and'(R0, Comp, R).
*/
'$do_c_built_in'(P, _, P).
'$do_c_built_metacall'(G1, Mod, '$execute_wo_mod'(G1,Mod)) :-