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(); }