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

less invasive error handling

This commit is contained in:
Vitor Santos Costa 2016-10-19 22:44:59 -05:00
parent 8a6de8b157
commit d082af605d
44 changed files with 4258 additions and 5045 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
C/absmi_insts.i
View File

@ -8160,12 +8160,7 @@
saveregs();
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs();
if (d0 == 0L) {
saveregs();
Yap_PreProcessedError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
setregs();
FAIL();
}
}
XREG(PREG->y_u.xxx.x) = d0;
PREG = NEXTOP(PREG, xxx);

51
C/atomic.c
View File

@ -527,18 +527,23 @@ static Int number_chars(USES_REGS1) {
restart_aux:
t1 = Deref(ARG1);
if (IsNumTerm(t1)) {
Term tf;
tf = Yap_NumberToListOfAtoms(t1 PASS_REGS);
if (tf) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return Yap_unify(ARG2, tf);
Term t2 = Deref(ARG2);
if (IsVarTerm(t2)) {
t1 = Yap_NumberToListOfAtoms(t1 PASS_REGS);
}
if (t1) {
return Yap_unify(t1, t2);
} else {
t2 = Yap_ListToNumber(t2 PASS_REGS);
if (t2) {
return Yap_unify(t1, t2);
}
}
} else if (IsVarTerm(t1)) {
/* ARG1 unbound */
Term t = Deref(ARG2);
Term tf = Yap_ListToNumber(t PASS_REGS);
if (tf) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return Yap_unify(ARG1, tf);
}
} else if (IsVarTerm(t1)) {
@ -556,15 +561,24 @@ static Int number_atom(USES_REGS1) {
restart_aux:
t1 = Deref(ARG1);
if (IsNumTerm(t1)) {
Term t2 = Deref(ARG2);
Atom af;
af = Yap_NumberToAtom(t1 PASS_REGS);
if (af)
return Yap_unify(ARG2, MkAtomTerm(af));
if (af) {
if (IsVarTerm(t2)) {
return Yap_unify(t1, t2);
} else {
t2 = Yap_AtomToNumber(t2 PASS_REGS);
if (t2) {
return Yap_unify(t1, t2);
}
}
}
} else if (IsVarTerm(t1)) {
/* ARG1 unbound */
Term t = Deref(ARG2);
Term tf = Yap_AtomToNumber(t PASS_REGS);
if (tf)
return Yap_unify(ARG1, tf);
} else if (IsVarTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
@ -634,8 +648,8 @@ restart_aux:
i = IntOfTerm(EXTRA_CBACK_ARG(3, 1));
max = IntOfTerm(EXTRA_CBACK_ARG(3, 2));
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1);
if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS) && LOCAL_Error_TYPE ==
YAP_NO_ERROR) {
if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS) &&
LOCAL_Error_TYPE == YAP_NO_ERROR) {
cut_fail();
} else {
if (i < max)
@ -684,7 +698,6 @@ restart_aux:
return cont_atom_concat3(PASS_REGS1);
} else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
at = NULL;
}
if (at) {
@ -704,7 +717,6 @@ restart_aux:
cut_fail();
}
#define CastToNumeric(x) CastToNumeric__(x PASS_REGS)
static Term CastToNumeric__(Atom at USES_REGS) {
@ -772,7 +784,6 @@ restart_aux:
return cont_atomic_concat3(PASS_REGS1);
} else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
at = NULL;
}
if (at) {
@ -849,7 +860,6 @@ restart_aux:
return cont_string_concat3(PASS_REGS1);
} else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
at = NULL;
}
if (tf) {
@ -913,10 +923,8 @@ restart_aux:
t2 = Deref(ARG2);
if (IsVarTerm(t2)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t2;
} else if (!IsStringTerm(t2)) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_Error_Term = t2;
} else {
s = UStringOfTerm(t2);
t1 = Deref(ARG1);
@ -926,7 +934,6 @@ restart_aux:
return cont_string_code3(PASS_REGS1);
} else if (!IsIntegerTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_INTEGER;
LOCAL_Error_Term = t1;
} else {
const unsigned char *ns = s;
utf8proc_int32_t chr;
@ -934,7 +941,6 @@ restart_aux:
if (indx <= 0) {
if (indx < 0) {
LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
LOCAL_Error_Term = t1;
}
cut_fail();
}
@ -970,19 +976,16 @@ restart_aux:
t2 = Deref(ARG2);
if (IsVarTerm(t2)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t2;
} else if (!IsStringTerm(t2)) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_Error_Term = t2;
} else {
s = UStringOfTerm(t2);
t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
} else if (!IsIntegerTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_INTEGER;
LOCAL_Error_Term = t1;
} else {
const unsigned char *ns = s;
utf8proc_int32_t chr;
@ -991,7 +994,6 @@ restart_aux:
if (indx <= 0) {
if (indx < 0) {
LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
LOCAL_Error_Term = t1;
} else {
return false;
}
@ -1813,7 +1815,6 @@ static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p,
src = skip_utf8((unsigned char *)src, min);
const unsigned char *cp = src;
LOCAL_TERM_ERROR(t, 4 * (len + 1));
buf = buf_from_tstring(HR);
while (len) {
utf8proc_int32_t chr;

9
C/cdmgr.c
View File

@ -1452,8 +1452,6 @@ static void addcl_permission_error(AtomEntry *ap, Int Arity, int in_use) {
ti[0] = MkAtomTerm(AbsAtom(ap));
ti[1] = MkIntegerTerm(Arity);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
LOCAL_ErrorMessage = LOCAL_ErrorSay;
LOCAL_Error_Term = t;
LOCAL_Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
if (in_use) {
if (Arity == 0)
@ -2028,9 +2026,7 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
YAPLeaveCriticalSection();
}
if (LOCAL_ErrorMessage) {
if (!LOCAL_Error_Term)
LOCAL_Error_Term = TermNil;
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
YAPLeaveCriticalSection();
return false;
}
@ -3590,7 +3586,8 @@ static Int p_predicate_erased_statistics(USES_REGS1) {
Term tpred = ArgOfTerm(2, Deref(ARG1));
Term tmod = ArgOfTerm(1, Deref(ARG1));
if (EndOfPAEntr(pe = Yap_get_pred(tpred, tmod, "predicate_erased_statistics")))
if (EndOfPAEntr(pe =
Yap_get_pred(tpred, tmod, "predicate_erased_statistics")))
return FALSE;
while (cl) {
if (cl->ClPred == pe) {

322
C/cmppreds.c
View File

@ -18,8 +18,6 @@
/// @file cmppreds.c
/**
@defgroup Comparing_Terms Comparing Terms
@ingroup builtins
@ -52,14 +50,13 @@ left-to-right order.
*/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "Yatom.h"
#include "eval.h"
#if HAVE_STRING_H
#include <string.h>
@ -67,39 +64,39 @@ static char SccsId[] = "%W% %G%";
#include <wchar.h>
static Int compare(Term, Term);
static Int p_compare( USES_REGS1 );
static Int p_acomp( USES_REGS1 );
static Int a_eq(Term,Term);
static Int a_dif(Term,Term);
static Int p_compare(USES_REGS1);
static Int p_acomp(USES_REGS1);
static Int a_eq(Term, Term);
static Int a_dif(Term, Term);
static Int a_gt(Term, Term);
static Int a_ge(Term,Term);
static Int a_lt(Term,Term);
static Int a_le(Term,Term);
static Int a_noteq(Term,Term);
static Int a_gen_lt(Term,Term);
static Int a_gen_le(Term,Term);
static Int a_gen_gt(Term,Term);
static Int a_gen_ge(Term,Term);
static Int a_ge(Term, Term);
static Int a_lt(Term, Term);
static Int a_le(Term, Term);
static Int a_noteq(Term, Term);
static Int a_gen_lt(Term, Term);
static Int a_gen_le(Term, Term);
static Int a_gen_gt(Term, Term);
static Int a_gen_ge(Term, Term);
#define rfloat(X) ( X > 0.0 ? 1 : ( X == 0.0 ? 0 : -1))
#define rfloat(X) (X > 0.0 ? 1 : (X == 0.0 ? 0 : -1))
static int
cmp_atoms(Atom a1, Atom a2)
{
static int cmp_atoms(Atom a1, Atom a2) {
if (IsWideAtom(a1)) {
if (IsWideAtom(a2)) {
return wcscmp((wchar_t *)RepAtom(a1)->StrOfAE,(wchar_t *)RepAtom(a2)->StrOfAE);
return wcscmp((wchar_t *)RepAtom(a1)->StrOfAE,
(wchar_t *)RepAtom(a2)->StrOfAE);
} else {
/* The standard does not seem to have nothing on this */
unsigned char *s1 = (unsigned char *)RepAtom(a1)->StrOfAE;
wchar_t *s2 = (wchar_t *)RepAtom(a2)->StrOfAE;
while (*s1 == *s2) {
if (!*s1) return 0;
if (!*s1)
return 0;
s1++;
s2++;
}
return *s1-*s2;
return *s1 - *s2;
}
} else if (IsWideAtom(a2)) {
/* The standard does not seem to have nothing on this */
@ -107,36 +104,36 @@ cmp_atoms(Atom a1, Atom a2)
unsigned char *s2 = (unsigned char *)RepAtom(a2)->StrOfAE;
while (*s1 == *s2) {
if (!*s1) return 0;
if (!*s1)
return 0;
s1++;
s2++;
}
return *s1-*s2;
return *s1 - *s2;
} else {
return strcmp((char *)RepAtom(a1)->StrOfAE,(char *)RepAtom(a2)->StrOfAE);
return strcmp((char *)RepAtom(a1)->StrOfAE, (char *)RepAtom(a2)->StrOfAE);
}
}
static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
CELL *pt1)
{
static Int compare_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt1) {
CACHE_REGS
register CELL **to_visit = (CELL **)HR;
register Int out = 0;
loop:
loop:
while (pt0 < pt0_end) {
register CELL d0, d1;
++ pt0;
++ pt1;
++pt0;
++pt1;
d0 = Derefa(pt0);
d1 = Derefa(pt1);
if (IsVarTerm(d0)) {
if (IsVarTerm(d1)) {
out = Signed(d0) - Signed(d1);
if (out) goto done;
}
else {
if (out)
goto done;
} else {
out = -1;
goto done;
}
@ -144,17 +141,18 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
out = 1;
goto done;
} else {
if (d0 == d1) continue;
if (d0 == d1)
continue;
else if (IsAtomTerm(d0)) {
if (IsAtomTerm(d1))
out = cmp_atoms(AtomOfTerm(d0), AtomOfTerm(d1));
else if (IsPrimitiveTerm(d1))
out = 1;
else out = -1;
else
out = -1;
/* I know out must be != 0 */
goto done;
}
else if (IsIntTerm(d0)) {
} else if (IsIntTerm(d0)) {
if (IsIntTerm(d1))
out = IntOfTerm(d0) - IntOfTerm(d1);
else if (IsFloatTerm(d1)) {
@ -166,12 +164,13 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
out = Yap_gmp_tcmp_int_big(IntOfTerm(d0), d1);
#endif
} else if (IsRefTerm(d1))
out = 1 ;
else out = -1;
out = 1;
else
out = -1;
if (out != 0)
goto done;
} else if (IsFloatTerm(d0)) {
if (IsFloatTerm(d1)){
if (IsFloatTerm(d1)) {
out = rfloat(FloatOfTerm(d0) - FloatOfTerm(d1));
} else if (IsRefTerm(d1)) {
out = 1;
@ -181,8 +180,8 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
if (out != 0)
goto done;
} else if (IsStringTerm(d0)) {
if (IsStringTerm(d1)){
out = strcmp((char *)StringOfTerm(d0) , (char *)StringOfTerm(d1));
if (IsStringTerm(d1)) {
out = strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1));
} else if (IsIntTerm(d1))
out = 1;
else if (IsFloatTerm(d1)) {
@ -194,7 +193,7 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
out = 1;
#endif
} else if (IsRefTerm(d1)) {
out = 1 ;
out = 1;
} else {
out = -1;
}
@ -212,7 +211,7 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
out = Yap_gmp_tcmp_int_big(LongIntOfTerm(d0), d1);
#endif
} else if (IsRefTerm(d1)) {
out = 1 ;
out = 1;
} else {
out = -1;
}
@ -230,8 +229,9 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
} else if (IsBigIntTerm(d1)) {
out = Yap_gmp_tcmp_big_big(d0, d1);
} else if (IsRefTerm(d1))
out = 1 ;
else out = -1;
out = 1;
else
out = -1;
if (out != 0)
goto done;
}
@ -242,9 +242,10 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
Functor f = FunctorOfTerm(d1);
if (IsExtensionFunctor(f))
out = 1;
else if (!(out = 2-ArityOfFunctor(f)))
out = strcmp(".",(char *)RepAtom(NameOfFunctor(f))->StrOfAE);
} else out = 1;
else if (!(out = 2 - ArityOfFunctor(f)))
out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE);
} else
out = 1;
goto done;
}
#ifdef RATIONAL_TREES
@ -267,18 +268,17 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
pt0_end = RepPair(d0) + 1;
pt1 = RepPair(d1) - 1;
continue;
}
else if (IsRefTerm(d0)) {
} else if (IsRefTerm(d0)) {
if (IsRefTerm(d1))
out = Unsigned(RefOfTerm(d1)) -
Unsigned(RefOfTerm(d0));
else out = -1;
out = Unsigned(RefOfTerm(d1)) - Unsigned(RefOfTerm(d0));
else
out = -1;
goto done;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2, *ap3;
if (!IsApplTerm(d1)) {
out = 1 ;
out = 1;
goto done;
} else {
/* store the terms to visit */
@ -297,7 +297,7 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
}
/* compare functors */
if (f != (Functor)*ap3) {
if (!(out = ArityOfFunctor(f)-ArityOfFunctor(f2)))
if (!(out = ArityOfFunctor(f) - ArityOfFunctor(f2)))
out = cmp_atoms(NameOfFunctor(f), NameOfFunctor(f2));
goto done;
}
@ -324,7 +324,6 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
continue;
}
}
}
}
/* Do we still have compound terms to visit */
@ -344,8 +343,8 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
goto loop;
}
done:
/* failure */
done:
/* failure */
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)HR) {
to_visit -= 4;
@ -355,11 +354,10 @@ static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register
*pt0 = (CELL)to_visit[3];
}
#endif
return(out);
return (out);
}
inline static Int
compare(Term t1, Term t2) /* compare terms t1 and t2 */
inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2 */
{
if (t1 == t2)
@ -375,7 +373,7 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
if (IsAtomOrIntTerm(t1)) {
if (IsAtomTerm(t1)) {
if (IsAtomTerm(t2))
return cmp_atoms(AtomOfTerm(t1),AtomOfTerm(t2));
return cmp_atoms(AtomOfTerm(t1), AtomOfTerm(t2));
if (IsPrimitiveTerm(t2))
return 1;
if (IsStringTerm(t2))
@ -411,17 +409,16 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
return 1;
else {
int out;
if (!(out = 2-ArityOfFunctor(f)))
out = strcmp(".",(char *)RepAtom(NameOfFunctor(f))->StrOfAE);
return(out);
if (!(out = 2 - ArityOfFunctor(f)))
out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE);
return (out);
}
}
if (IsPairTerm(t2)) {
return(compare_complex(RepPair(t1)-1,
RepPair(t1)+1,
RepPair(t2)-1));
}
else return 1;
return (
compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepPair(t2) - 1));
} else
return 1;
} else {
/* compound term */
Functor fun1 = FunctorOfTerm(t1);
@ -429,16 +426,14 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
if (IsExtensionFunctor(fun1)) {
/* float, long, big, dbref */
switch ((CELL)fun1) {
case double_e:
{
case double_e: {
if (IsFloatTerm(t2))
return(rfloat(FloatOfTerm(t1) - FloatOfTerm(t2)));
return (rfloat(FloatOfTerm(t1) - FloatOfTerm(t2)));
if (IsRefTerm(t2))
return 1;
return -1;
}
case long_int_e:
{
case long_int_e: {
if (IsIntTerm(t2))
return LongIntOfTerm(t1) - IntOfTerm(t2);
if (IsFloatTerm(t2)) {
@ -456,8 +451,7 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
return -1;
}
#ifdef USE_GMP
case big_int_e:
{
case big_int_e: {
if (IsIntTerm(t2))
return Yap_gmp_tcmp_big_int(t1, IntOfTerm(t2));
if (IsFloatTerm(t2)) {
@ -473,8 +467,7 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
return -1;
}
#endif
case string_e:
{
case string_e: {
if (IsApplTerm(t2)) {
Functor fun2 = FunctorOfTerm(t2);
switch ((CELL)fun2) {
@ -497,8 +490,7 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
}
case db_ref_e:
if (IsRefTerm(t2))
return Unsigned(RefOfTerm(t2)) -
Unsigned(RefOfTerm(t1));
return Unsigned(RefOfTerm(t2)) - Unsigned(RefOfTerm(t1));
return -1;
}
}
@ -507,8 +499,8 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
Int out;
Functor f = FunctorOfTerm(t1);
if (!(out = ArityOfFunctor(f))-2)
out = strcmp((char *)RepAtom(NameOfFunctor(f))->StrOfAE,".");
if (!(out = ArityOfFunctor(f)) - 2)
out = strcmp((char *)RepAtom(NameOfFunctor(f))->StrOfAE, ".");
return out;
}
return 1;
@ -526,16 +518,14 @@ compare(Term t1, Term t2) /* compare terms t1 and t2 */
if (r)
return r;
else
return(compare_complex(RepAppl(t1),
RepAppl(t1)+ArityOfFunctor(fun1),
return (compare_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(fun1),
RepAppl(t2)));
}
}
}
Int Yap_compare_terms(Term d0, Term d1)
{
return compare(Deref(d0),Deref(d1));
Int Yap_compare_terms(Term d0, Term d1) {
return compare(Deref(d0), Deref(d1));
}
/** @pred compare( _C_, _X_, _Y_) is iso
@ -552,9 +542,7 @@ the following values:
`>` if _Y_ precedes _X_ in the defined order;
*/
Int
p_compare( USES_REGS1 )
{ /* compare(?Op,?T1,?T2) */
Int p_compare(USES_REGS1) { /* compare(?Op,?T1,?T2) */
Int r = compare(Deref(ARG2), Deref(ARG3));
Atom p;
Term t = Deref(ARG1);
@ -569,9 +557,7 @@ p_compare( USES_REGS1 )
Atom a = AtomOfTerm(t);
if (a == p)
return true;
if (a != AtomLT &&
a != AtomGT &&
a != AtomEq)
if (a != AtomLT && a != AtomGT && a != AtomEq)
Yap_Error(DOMAIN_ERROR_ORDER, ARG1, NULL);
} else {
Yap_Error(TYPE_ERROR_ATOM, ARG1, NULL);
@ -582,22 +568,13 @@ p_compare( USES_REGS1 )
return Yap_unify_constant(ARG1, MkAtomTerm(p));
}
/** @pred _X_ \== _Y_ is iso
Terms _X_ and _Y_ are not strictly identical.
*/
static Int
a_noteq(Term t1, Term t2)
{
return (compare(t1, t2) != 0);
}
static Int a_noteq(Term t1, Term t2) { return (compare(t1, t2) != 0); }
static Int
a_gen_lt(Term t1, Term t2)
{
return (compare(t1, t2) < 0);
}
static Int a_gen_lt(Term t1, Term t2) { return (compare(t1, t2) < 0); }
/** @pred _X_ @=< _Y_ is iso
@ -605,33 +582,20 @@ a_gen_lt(Term t1, Term t2)
Term _X_ does not follow term _Y_ in the standard order.
*/
static Int
a_gen_le(Term t1, Term t2)
{
return (compare(t1, t2) <= 0);
}
static Int a_gen_le(Term t1, Term t2) { return (compare(t1, t2) <= 0); }
/** @pred _X_ @> _Y_ is iso
Term _X_ does not follow term _Y_ in the standard order
*/
static Int
a_gen_gt(Term t1, Term t2)
{
return compare(t1, t2) > 0;
}
static Int a_gen_gt(Term t1, Term t2) { return compare(t1, t2) > 0; }
/** @pred _X_ @>= _Y_ is iso
Term _X_ does not precede term _Y_ in the standard order.
*/
static Int
a_gen_ge(Term t1, Term t2)
{
return compare(t1, t2) >= 0;
}
static Int a_gen_ge(Term t1, Term t2) { return compare(t1, t2) >= 0; }
/**
@}
@ -642,19 +606,14 @@ a_gen_ge(Term t1, Term t2)
@defgroup arithmetic_cmps Arithmetic Comparison Predicates
@ingroup arithmetic
Comparison of Numeric Expressions. Both arguments must be valid ground expressions at time of call.
Comparison of Numeric Expressions. Both arguments must be valid ground
expressions at time of call.
@{
*/
inline static Int
int_cmp(Int dif)
{
return dif;
}
inline static Int int_cmp(Int dif) { return dif; }
inline static Int
flt_cmp(Float dif)
{
inline static Int flt_cmp(Float dif) {
if (dif < 0.0)
return -1;
if (dif > 0.0)
@ -662,26 +621,20 @@ flt_cmp(Float dif)
return dif = 0.0;
}
static inline Int
a_cmp(Term t1, Term t2 USES_REGS)
{
LOCAL_ArithError = FALSE;
static inline Int a_cmp(Term t1, Term t2 USES_REGS) {
if (IsVarTerm(t1)) {
LOCAL_ArithError = TRUE;
Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return FALSE;
}
if (IsVarTerm(t2)) {
LOCAL_ArithError = TRUE;
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return FALSE;
}
if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return flt_cmp(FloatOfTerm(t1)-FloatOfTerm(t2));
return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2));
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
return int_cmp(IntegerOfTerm(t1)-IntegerOfTerm(t2));
return int_cmp(IntegerOfTerm(t1) - IntegerOfTerm(t2));
}
t1 = Yap_Eval(t1);
if (!t1) {
@ -693,21 +646,19 @@ a_cmp(Term t1, Term t2 USES_REGS)
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return int_cmp(i1-i2);
return int_cmp(i1 - i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
LOCAL_Error_Term = t2;
LOCAL_ErrorMessage = "trying to evaluate nan";
LOCAL_ArithError = TRUE;
}
#endif
return flt_cmp(i1-f2);
return flt_cmp(i1 - f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_int_big(i1,t2);
return Yap_gmp_cmp_int_big(i1, t2);
#endif
} else {
return FALSE;
@ -717,9 +668,7 @@ a_cmp(Term t1, Term t2 USES_REGS)
#if HAVE_ISNAN
if (isnan(f1)) {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
LOCAL_Error_Term = t1;
LOCAL_ErrorMessage = "trying to evaluate nan";
LOCAL_ArithError = TRUE;
}
#endif
t2 = Yap_Eval(t2);
@ -730,21 +679,19 @@ a_cmp(Term t1, Term t2 USES_REGS)
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return flt_cmp(f1-i2);
return flt_cmp(f1 - i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
LOCAL_Error_Term = t2;
LOCAL_ErrorMessage = "trying to evaluate nan";
LOCAL_ArithError = TRUE;
}
#endif
return flt_cmp(f1-f2);
return flt_cmp(f1 - f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_float_big(f1,t2);
return Yap_gmp_cmp_float_big(f1, t2);
#endif
} else {
return FALSE;
@ -761,9 +708,7 @@ a_cmp(Term t1, Term t2 USES_REGS)
#if HAVE_ISNAN
if (isnan(f2)) {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
LOCAL_Error_Term = t2;
LOCAL_ErrorMessage = "trying to evaluate nan";
LOCAL_ArithError = TRUE;
}
#endif
return Yap_gmp_cmp_big_float(t1, f2);
@ -779,23 +724,17 @@ a_cmp(Term t1, Term t2 USES_REGS)
}
}
Int
Yap_acmp(Term t1, Term t2 USES_REGS)
{
Int Yap_acmp(Term t1, Term t2 USES_REGS) {
Int out = a_cmp(t1, t2 PASS_REGS);
if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; }
return out;
}
static Int
p_acomp( USES_REGS1 )
{ /* $a_compare(?R,+X,+Y) */
static Int p_acomp(USES_REGS1) { /* $a_compare(?R,+X,+Y) */
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
Int out;
out = a_cmp(t1, t2 PASS_REGS);
if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; }
return out;
}
@ -806,9 +745,7 @@ p_acomp( USES_REGS1 )
The value of the expression _X_ is equal to the value of expression _Y_.
*/
/// @memberof =:=/2
static Int
a_eq(Term t1, Term t2)
{
static Int a_eq(Term t1, Term t2) {
CACHE_REGS
/* A =:= B */
Int out;
@ -817,11 +754,11 @@ a_eq(Term t1, Term t2)
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return(FALSE);
return (FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return(FALSE);
return (FALSE);
}
if (IsFloatTerm(t1)) {
if (IsFloatTerm(t2))
@ -837,25 +774,22 @@ a_eq(Term t1, Term t2)
return (FloatOfTerm(t2) == IntegerOfTerm(t1));
}
}
out = a_cmp(t1,t2 PASS_REGS);
if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; }
out = a_cmp(t1, t2 PASS_REGS);
Yap_Error(LOCAL_Error_TYPE, t1, LOCAL_ErrorMessage);
return out == 0;
}
/*
@pred +_X_ =\\= _Y_ is iso
Difference of arithmetic expressions
The value of the expression _X_ is different from the value of expression _Y_.
The value of the expression _X_ is different from the value of expression
_Y_.
*/
/// @memberof =\\=/2
static Int
a_dif(Term t1, Term t2)
{
static Int a_dif(Term t1, Term t2) {
CACHE_REGS
Int out = a_cmp(Deref(t1),Deref(t2) PASS_REGS);
if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; }
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
return out != 0;
}
@ -866,12 +800,9 @@ a_dif(Term t1, Term t2)
The value of the expression _X_ is less than or equal to the value
of expression _Y_.
*/
static Int
a_gt(Term t1, Term t2)
{ /* A > B */
static Int a_gt(Term t1, Term t2) { /* A > B */
CACHE_REGS
Int out = a_cmp(Deref(t1),Deref(t2) PASS_REGS);
if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; }
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
return out > 0;
}
@ -882,12 +813,9 @@ a_gt(Term t1, Term t2)
The value of the expression _X_ is greater than or equal to the
value of expression _Y_.
*/
static Int
a_ge(Term t1, Term t2)
{ /* A >= B */
static Int a_ge(Term t1, Term t2) { /* A >= B */
CACHE_REGS
Int out = a_cmp(Deref(t1),Deref(t2) PASS_REGS);
if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; }
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
return out >= 0;
}
@ -899,12 +827,9 @@ a_ge(Term t1, Term t2)
_Y_.
*/
/// @memberof </2
static Int
a_lt(Term t1, Term t2)
{ /* A < B */
static Int a_lt(Term t1, Term t2) { /* A < B */
CACHE_REGS
Int out = a_cmp(Deref(t1),Deref(t2) PASS_REGS);
if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; }
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
return out < 0;
}
@ -918,12 +843,9 @@ a_lt(Term t1, Term t2)
of expression _Y_.
*/
/// @memberof =</2
static Int
a_le(Term t1, Term t2)
{ /* A <= B */
static Int a_le(Term t1, Term t2) { /* A <= B */
CACHE_REGS
Int out = a_cmp(Deref(t1),Deref(t2) PASS_REGS);
if (LOCAL_ArithError) { Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); return FALSE; }
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
return out <= 0;
}
@ -931,9 +853,7 @@ a_le(Term t1, Term t2)
@}
*/
void
Yap_InitCmpPreds(void)
{
void Yap_InitCmpPreds(void) {
Yap_InitCmpPred("=:=", 2, a_eq, SafePredFlag | BinaryPredFlag);
Yap_InitCmpPred("=\\=", 2, a_dif, SafePredFlag | BinaryPredFlag);
Yap_InitCmpPred(">", 2, a_gt, SafePredFlag | BinaryPredFlag);

1185
C/compiler.c
View File

File diff suppressed because it is too large Load Diff

12
C/dbase.c
View File

@ -336,19 +336,18 @@ static int recover_from_record_error(int nargs) {
goto recover_record;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, LOCAL_Error_Term, LOCAL_ErrorMessage);
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
goto recover_record;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (!Yap_ExpandPreAllocCodeSpace(LOCAL_Error_Size, NULL, TRUE)) {
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, LOCAL_Error_Term,
LOCAL_ErrorMessage);
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
goto recover_record;
default:
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
Yap_Error(LOCAL_Error_TYPE, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
recover_record:
@ -1121,7 +1120,6 @@ static void sf_include(SFKeep *sfp, struct db_globs *dbg) SFKeep *sfp;
j += 2;
} else {
LOCAL_Error_TYPE = TYPE_ERROR_DBTERM;
LOCAL_Error_Term = d0;
LOCAL_ErrorMessage = "wrong term in SF";
return (NULL);
}
@ -1242,7 +1240,6 @@ static DBRef generate_dberror_msg(int errnumb, UInt sz, char *msg) {
CACHE_REGS
LOCAL_Error_Size = sz;
LOCAL_Error_TYPE = errnumb;
LOCAL_Error_Term = TermNil;
LOCAL_ErrorMessage = msg;
return NULL;
}
@ -2611,7 +2608,6 @@ static int resize_int_keys(UInt new_size) {
if (new == NULL) {
YAPLeaveCriticalSection();
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
LOCAL_Error_Term = TermNil;
LOCAL_ErrorMessage = "could not allocate space";
return FALSE;
}
@ -2693,7 +2689,6 @@ static PredEntry *new_lu_int_key(Int key) {
if (INT_LU_KEYS == NULL) {
CACHE_REGS
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
LOCAL_Error_Term = TermNil;
LOCAL_ErrorMessage = "could not allocate space";
return NULL;
}
@ -2825,7 +2820,6 @@ static DBProp FetchIntDBPropFromKey(Int key, int flag, int new,
if (INT_KEYS == NULL) {
CACHE_REGS
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
LOCAL_Error_Term = TermNil;
LOCAL_ErrorMessage = "could not allocate space";
return NULL;
}

66
C/errors.c
View File

@ -74,16 +74,17 @@ bool Yap_Warning(const char *s, ...) {
return rc;
}
void Yap_InitError(yap_error_number e, Term t, const char *msg) {
if (LOCAL_ActiveError.status) {
if (LOCAL_ActiveError->status) {
Yap_exit(1);
}
LOCAL_ActiveError.errorNo = e;
LOCAL_ActiveError.errorFile = NULL;
LOCAL_ActiveError.errorFunction = NULL;
LOCAL_ActiveError.errorLine = 0;
LOCAL_ActiveError->errorNo = e;
LOCAL_ActiveError->errorFile = NULL;
LOCAL_ActiveError->errorFunction = NULL;
LOCAL_ActiveError->errorLine = 0;
if (msg) {
LOCAL_Error_Size = strlen(msg);
strcpy(LOCAL_ActiveError.errorComment, msg);
LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1);
strcpy(LOCAL_ActiveError->errorMsg, msg);
} else {
LOCAL_Error_Size = 0;
}
@ -158,7 +159,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno,
return false;
}
default:
Yap_Error__(file, function, lineno, err, LOCAL_Error_Term, serr);
Yap_Error__(file, function, lineno, err, TermNil, serr);
return false;
}
}
@ -196,7 +197,7 @@ int Yap_SWIHandleError(const char *s, ...) {
return FALSE;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
Yap_Error(err, TermNil, serr);
return (FALSE);
}
}
@ -292,11 +293,23 @@ static char tmpbuf[YAP_BUF_SIZE];
return mkerrorct(B, ts);
#define END_ERRORS() \
} return TermNil; \
} \
return TermNil; \
}
#include "YapErrors.h"
void Yap_pushErrorContext(yap_error_descriptor_t *new_error) {
new_error->top_error = LOCAL_ActiveError;
LOCAL_ActiveError = new_error;
}
yap_error_descriptor_t *Yap_popErrorContext(void) {
yap_error_descriptor_t *new_error = LOCAL_ActiveError;
LOCAL_ActiveError = LOCAL_ActiveError->top_error;
return new_error;
}
/**
* @brief Yap_Error
* This function handles errors in the C code. Check errors.yap for the
@ -343,17 +356,17 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
/* disallow recursive error handling */
if (LOCAL_PrologMode & InErrorMode) {
fprintf(stderr, "%% ERROR WITHIN ERROR %d: %s\n", LOCAL_CurrentError,
tmpbuf);
fprintf(stderr, "%% ERROR WITHIN ERROR %d: %s\n", LOCAL_Error_TYPE, tmpbuf);
Yap_RestartYap(1);
}
LOCAL_ActiveError.errorNo = type;
LOCAL_ActiveError.errorAsText = Yap_LookupAtom(Yap_errorName( type ));
LOCAL_ActiveError.errorClass = Yap_errorClass( type);
LOCAL_ActiveError.classAsText = Yap_LookupAtom(Yap_errorClassName( LOCAL_ActiveError.errorClass ));
LOCAL_ActiveError.errorLine = lineno;
LOCAL_ActiveError.errorFunction = function;
LOCAL_ActiveError.errorFile = file;
LOCAL_ActiveError->errorNo = type;
LOCAL_ActiveError->errorAsText = Yap_LookupAtom(Yap_errorName(type));
LOCAL_ActiveError->errorClass = Yap_errorClass(type);
LOCAL_ActiveError->classAsText =
Yap_LookupAtom(Yap_errorClassName(LOCAL_ActiveError->errorClass));
LOCAL_ActiveError->errorLine = lineno;
LOCAL_ActiveError->errorFunction = function;
LOCAL_ActiveError->errorFile = file;
Yap_find_prolog_culprit(PASS_REGS1);
LOCAL_PrologMode |= InErrorMode;
Yap_ClearExs();
@ -380,7 +393,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
}
if (LOCAL_within_print_message) {
/* error within error */
fprintf(stderr, "%% ERROR WITHIN WARNING %d: %s\n", LOCAL_CurrentError,
fprintf(stderr, "%% ERROR WITHIN WARNING %d: %s\n", LOCAL_Error_TYPE,
tmpbuf);
LOCAL_PrologMode &= ~InErrorMode;
Yap_exit(1);
@ -395,8 +408,8 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
#endif
// fprintf(stderr, "warning: ");
comment = MkAtomTerm(Yap_LookupAtom(s));
} else if (LOCAL_ErrorSay && LOCAL_ErrorSay[0]) {
comment = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorSay));
} else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) {
comment = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
} else {
comment = TermNil;
}
@ -410,7 +423,6 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
if (type == ABORT_EVENT || LOCAL_PrologMode & BootMode) {
where = TermNil;
LOCAL_PrologMode &= ~AbortMode;
LOCAL_CurrentError = type;
LOCAL_PrologMode &= ~InErrorMode;
/* make sure failure will be seen at next port */
// no need to lock & unlock
@ -426,7 +438,6 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
}
/* Exit Abort Mode, if we were there */
LOCAL_PrologMode &= ~AbortMode;
LOCAL_CurrentError = type;
LOCAL_PrologMode |= InErrorMode;
if (!(where = Yap_CopyTerm(where))) {
where = TermNil;
@ -528,14 +539,11 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
/* This is used by some complex procedures to detect there was an error */
if (IsAtomTerm(nt[0])) {
strncpy(LOCAL_ErrorSay, (char *)RepAtom(AtomOfTerm(nt[0]))->StrOfAE,
strncpy(LOCAL_ErrorMessage, (char *)RepAtom(AtomOfTerm(nt[0]))->StrOfAE,
MAX_ERROR_MSG_SIZE);
LOCAL_ErrorMessage = LOCAL_ErrorSay;
} else {
strncpy(LOCAL_ErrorSay,
(char *)RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE,
MAX_ERROR_MSG_SIZE);
LOCAL_ErrorMessage = LOCAL_ErrorSay;
LOCAL_ErrorMessage =
(char *)RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE;
}
nt[1] = TermNil;
switch (type) {

207
C/eval.c
View File

@ -27,11 +27,10 @@ static char SccsId[] = "%W% %G%";
@ingroup arithmetic
*/
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "Yatom.h"
#include "eval.h"
#if HAVE_STDARG_H
#include <stdarg.h>
@ -46,9 +45,7 @@ static char SccsId[] = "%W% %G%";
static Term Eval(Term t1 USES_REGS);
static Term
get_matrix_element(Term t1, Term t2 USES_REGS)
{
static Term get_matrix_element(Term t1, Term t2 USES_REGS) {
if (!IsPairTerm(t2)) {
if (t2 == MkAtomTerm(AtomLength)) {
Int sz = 1;
@ -93,12 +90,10 @@ get_matrix_element(Term t1, Term t2 USES_REGS)
return Eval(t1 PASS_REGS);
}
static Term
Eval(Term t USES_REGS)
{
static Term Eval(Term t USES_REGS) {
if (IsVarTerm(t)) {
return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic");
return Yap_ArithError(INSTANTIATION_ERROR, t, "in arithmetic");
} else if (IsNumTerm(t)) {
return t;
} else if (IsAtomTerm(t)) {
@ -114,7 +109,7 @@ Eval(Term t USES_REGS)
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (fun == FunctorString) {
const char *s = (const char*)StringOfTerm(t);
const char *s = (const char *)StringOfTerm(t);
if (s[1] == '\0')
return MkIntegerTerm(s[0]);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
@ -131,7 +126,7 @@ Eval(Term t USES_REGS)
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,n);
RepAtom(name)->StrOfAE, n);
}
if (p->FOfEE == op_power && p->ArityOfEE == 2) {
t2 = ArgOfTerm(2, t);
@ -140,7 +135,7 @@ Eval(Term t USES_REGS)
}
}
*RepAppl(t) = (CELL)AtomFoundVar;
t1 = Eval(ArgOfTerm(1,t) PASS_REGS);
t1 = Eval(ArgOfTerm(1, t) PASS_REGS);
if (t1 == 0L) {
*RepAppl(t) = (CELL)fun;
return FALSE;
@ -149,39 +144,36 @@ Eval(Term t USES_REGS)
*RepAppl(t) = (CELL)fun;
return Yap_eval_unary(p->FOfEE, t1);
}
t2 = Eval(ArgOfTerm(2,t) PASS_REGS);
t2 = Eval(ArgOfTerm(2, t) PASS_REGS);
*RepAppl(t) = (CELL)fun;
if (t2 == 0L)
return FALSE;
return Yap_eval_binary(p->FOfEE,t1,t2);
return Yap_eval_binary(p->FOfEE, t1, t2);
}
} /* else if (IsPairTerm(t)) */ {
} /* 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");
"string must contain a single character to be "
"evaluated as an arithmetic expression");
}
return Eval(HeadOfTerm(t) PASS_REGS);
}
}
Term
Yap_InnerEval__(Term t USES_REGS)
{
return Eval(t PASS_REGS);
}
Term Yap_InnerEval__(Term t USES_REGS) { return Eval(t PASS_REGS); }
#ifdef BEAM
Int BEAM_is(void);
Int
BEAM_is(void)
{ /* X is Y */
Int BEAM_is(void) { /* X is Y */
union arith_ret res;
blob_type bt;
bt = Eval(Deref(XREGS[2]), &res);
if (bt==db_ref_e) return (NULL);
return (EvalToTerm(bt,&res));
if (bt == db_ref_e)
return (NULL);
return (EvalToTerm(bt, &res));
}
#endif
@ -197,21 +189,20 @@ X is 2+3*4
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
succeeds with `X = 14`.
Consult @ref arithmetic_operators for the complete list of arithmetic_operators
Consult @ref arithmetic_operators for the complete list of
arithmetic_operators
*/
/// @memberof is/2
static Int
p_is( USES_REGS1 )
{ /* X is Y */
static Int p_is(USES_REGS1) { /* X is Y */
Term out;
yap_error_number err;
Term t = Deref(ARG2);
if (IsVarTerm(t)) {
Yap_EvalError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
Yap_EvalError(INSTANTIATION_ERROR, t, "X is Y");
return (FALSE);
}
Yap_ClearExs();
do {
@ -225,11 +216,11 @@ p_is( USES_REGS1 )
return FALSE;
}
} else {
Yap_EvalError(err, takeIndicator( ARG2 ), "X is Exp");
Yap_EvalError(err, takeIndicator(ARG2), "X is Exp");
return FALSE;
}
} while (TRUE);
return Yap_unify_constant(ARG1,out);
return Yap_unify_constant(ARG1, out);
}
/**
@ -239,20 +230,18 @@ p_is( USES_REGS1 )
*/
/// @memberof isnan/1
static Int
p_isnan( USES_REGS1 )
{ /* X isnan Y */
static Int p_isnan(USES_REGS1) { /* X isnan Y */
Term out = 0L;
while (!(out = Eval(Deref(ARG1) PASS_REGS))) {
if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, CP)) {
Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
Yap_EvalError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
} else {
Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
return FALSE;
}
}
@ -274,9 +263,7 @@ p_isnan( USES_REGS1 )
*/
/// @memberof isnan/1
static Int
p_isinf( USES_REGS1 )
{ /* X is Y */
static Int p_isinf(USES_REGS1) { /* X is Y */
Term out = 0L;
while (!(out = Eval(Deref(ARG1) PASS_REGS))) {
@ -287,7 +274,7 @@ p_isinf( USES_REGS1 )
return FALSE;
}
} else {
Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
return FALSE;
}
}
@ -312,9 +299,7 @@ True if _Log1_ is the logarithm of the positive number _A1_,
*/
/// @memberof logsum/3
static Int
p_logsum( USES_REGS1 )
{ /* X is Y */
static Int p_logsum(USES_REGS1) { /* X is Y */
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
int done = FALSE;
@ -341,7 +326,7 @@ p_logsum( USES_REGS1 )
return FALSE;
}
} else {
Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
return FALSE;
}
}
@ -369,81 +354,66 @@ p_logsum( USES_REGS1 )
return FALSE;
}
} else {
Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
return FALSE;
}
}
}
}
if (f1 >= f2) {
Float fi = exp(f2-f1);
return Yap_unify(ARG3,MkFloatTerm(f1+log(1+fi)));
Float fi = exp(f2 - f1);
return Yap_unify(ARG3, MkFloatTerm(f1 + log(1 + fi)));
} else {
Float fi = exp(f1-f2);
return Yap_unify(ARG3,MkFloatTerm(f2+log(1+fi)));
Float fi = exp(f1 - f2);
return Yap_unify(ARG3, MkFloatTerm(f2 + log(1 + fi)));
}
}
Int
Yap_ArithError__(const char *file, const char *function, int lineno, yap_error_number type, Term where,...)
{
Int Yap_ArithError__(const char *file, const char *function, int lineno,
yap_error_number type, Term where, ...) {
CACHE_REGS
va_list ap;
char *format;
char buf[MAX_ERROR_MSG_SIZE];
if (LOCAL_ArithError)
return 0L;
LOCAL_ArithError = TRUE;
LOCAL_Error_TYPE = type;
LOCAL_Error_File = file;
LOCAL_Error_Function = function;
LOCAL_Error_Lineno = lineno;
LOCAL_Error_Term = where;
if (!LOCAL_ErrorMessage)
LOCAL_ErrorMessage = LOCAL_ErrorSay;
va_start (ap, where);
format = va_arg( ap, char *);
if (format != NULL) {
#if HAVE_VSNPRINTF
(void) vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, format, ap);
#else
(void) vsprintf(LOCAL_ErrorMessage, format, ap);
#endif
} else {
LOCAL_ErrorMessage[0] = '\0';
}
va_end (ap);
return 0L;
}
yamop *
Yap_EvalError__(const char *file, const char *function, int lineno,yap_error_number type, Term where,...)
{
CACHE_REGS
va_list ap;
char *format;
if (LOCAL_ArithError) {
LOCAL_ArithError = YAP_NO_ERROR;
return Yap_Error__(file, function, lineno, LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
}
if (!LOCAL_ErrorMessage)
LOCAL_ErrorMessage = LOCAL_ErrorSay;
va_start (ap, where);
va_start(ap, where);
format = va_arg(ap, char *);
if (format != NULL) {
#if HAVE_VSNPRINTF
(void) vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, format, ap);
(void)vsnprintf(buf, MAX_ERROR_MSG_SIZE, format, ap);
#else
(void) vsprintf(LOCAL_ErrorMessage, format, ap);
(void)vsprintf(buf, format, ap);
#endif
} else {
LOCAL_ErrorMessage[0] = '\0';
buf[0] = '\0';
}
va_end (ap);
return Yap_Error__(file, function, lineno, type, where, LOCAL_ErrorMessage);
va_end(ap);
return 0L;
}
yamop *Yap_EvalError__(const char *file, const char *function, int lineno,
yap_error_number type, Term where, ...) {
CACHE_REGS
va_list ap;
char *format, buf[MAX_ERROR_MSG_SIZE];
va_start(ap, where);
format = va_arg(ap, char *);
if (format != NULL) {
#if HAVE_VSNPRINTF
(void)vsnprintf(buf, MAX_ERROR_MSG_SIZE, format, ap);
#else
(void)vsprintf(buf, format, ap);
#endif
} else {
buf[0] = '\0';
}
va_end(ap);
return Yap_Error__(file, function, lineno, type, where, buf);
}
/**
@ -461,10 +431,9 @@ Yap_EvalError__(const char *file, const char *function, int lineno,yap_error_num
*/
/// @memberof between/3
static Int cont_between( USES_REGS1 )
{
Term t1 = EXTRA_CBACK_ARG(3,1);
Term t2 = EXTRA_CBACK_ARG(3,2);
static Int cont_between(USES_REGS1) {
Term t1 = EXTRA_CBACK_ARG(3, 1);
Term t2 = EXTRA_CBACK_ARG(3, 2);
Yap_unify(ARG3, t1);
if (IsIntegerTerm(t1)) {
@ -475,7 +444,7 @@ static Int cont_between( USES_REGS1 )
cut_succeed();
i1 = IntegerOfTerm(t1);
tn = add_int(i1, 1 PASS_REGS);
EXTRA_CBACK_ARG(3,1) = tn;
EXTRA_CBACK_ARG(3, 1) = tn;
HB = B->cp_h = HR;
return TRUE;
} else {
@ -489,16 +458,14 @@ static Int cont_between( USES_REGS1 )
t[0] = t1;
t[1] = MkIntTerm(1);
tn = Eval(Yap_MkApplTerm(FunctorPlus, 2, t) PASS_REGS);
EXTRA_CBACK_ARG(3,1) = tn;
EXTRA_CBACK_ARG(3, 1) = tn;
HB = B->cp_h = HR;
return TRUE;
}
}
/// @memberof between/3
static Int
init_between( USES_REGS1 )
{
static Int init_between(USES_REGS1) {
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
@ -510,14 +477,11 @@ init_between( USES_REGS1 )
Yap_EvalError(INSTANTIATION_ERROR, t1, "between/3");
return FALSE;
}
if (!IsIntegerTerm(t1) &&
!IsBigIntTerm(t1)) {
if (!IsIntegerTerm(t1) && !IsBigIntTerm(t1)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t1, "between/3");
return FALSE;
}
if (!IsIntegerTerm(t2) &&
!IsBigIntTerm(t2) &&
t2 != MkAtomTerm(AtomInf) &&
if (!IsIntegerTerm(t2) && !IsBigIntTerm(t2) && t2 != MkAtomTerm(AtomInf) &&
t2 != MkAtomTerm(AtomInfinity)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t2, "between/3");
return FALSE;
@ -542,7 +506,8 @@ init_between( USES_REGS1 )
cut_fail();
}
}
if (i1 > i2) cut_fail();
if (i1 > i2)
cut_fail();
if (i1 == i2) {
Yap_unify(ARG3, t1);
cut_succeed();
@ -575,25 +540,25 @@ init_between( USES_REGS1 )
Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
return FALSE;
}
if (Yap_acmp(t3, t1 PASS_REGS) >= 0 && Yap_acmp(t2,t3 PASS_REGS) >= 0 && P != FAILCODE)
if (Yap_acmp(t3, t1 PASS_REGS) >= 0 && Yap_acmp(t2, t3 PASS_REGS) >= 0 &&
P != FAILCODE)
cut_succeed();
cut_fail();
}
cmp = Yap_acmp(t1, t2 PASS_REGS);
if (cmp > 0) cut_fail();
if (cmp > 0)
cut_fail();
if (cmp == 0) {
Yap_unify(ARG3, t1);
cut_succeed();
}
}
EXTRA_CBACK_ARG(3,1) = t1;
EXTRA_CBACK_ARG(3,2) = t2;
return cont_between( PASS_REGS1 );
EXTRA_CBACK_ARG(3, 1) = t1;
EXTRA_CBACK_ARG(3, 2) = t2;
return cont_between(PASS_REGS1);
}
void
Yap_InitEval(void)
{
void Yap_InitEval(void) {
/* here are the arithmetical predicates */
Yap_InitConstExps();
Yap_InitUnaryExps();

18
C/exec.c
View File

@ -1446,7 +1446,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
/* must be done here, otherwise siglongjmp will clobber all the
* registers
*/
Yap_Error(LOCAL_matherror, TermNil, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
/* reset the registers so that we don't have trash in abstract
* machine */
Yap_set_fpu_exceptions(
@ -2080,16 +2080,16 @@ static Int jump_env(USES_REGS1) {
LOCAL_Error_TYPE = ERROR_EVENT;
t = ArgOfTerm(1, t);
if (IsApplTerm(t) && IsAtomTerm((t2 = ArgOfTerm(1, t)))) {
LOCAL_ActiveError.errorAsText = AtomOfTerm(t2);
LOCAL_ActiveError.classAsText = NameOfFunctor(FunctorOfTerm(t));
LOCAL_ActiveError->errorAsText = AtomOfTerm(t2);
LOCAL_ActiveError->classAsText = NameOfFunctor(FunctorOfTerm(t));
} else if (IsAtomTerm(t)) {
LOCAL_ActiveError.errorAsText = AtomOfTerm(t);
LOCAL_ActiveError.classAsText = NULL;
LOCAL_ActiveError->errorAsText = AtomOfTerm(t);
LOCAL_ActiveError->classAsText = NULL;
}
} else {
LOCAL_Error_TYPE = THROW_EVENT;
}
LOCAL_ActiveError.prologPredName = NULL;
LOCAL_ActiveError->prologPredName = NULL;
Yap_PutException(t);
bool out = JumpToEnv(PASS_REGS1);
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
@ -2225,10 +2225,10 @@ bool Yap_PutException(Term t) {
}
bool Yap_ResetException(int wid) {
if (REMOTE_BallTerm(wid)) {
Yap_PopTermFromDB(REMOTE_BallTerm(wid));
if (REMOTE_ActiveError(wid)->errorTerm) {
Yap_PopTermFromDB(REMOTE_ActiveError(wid)->errorTerm);
}
REMOTE_BallTerm(wid) = NULL;
REMOTE_ActiveError(wid)->errorTerm = NULL;
return true;
}

4
C/flags.c
View File

@ -1369,7 +1369,7 @@ do_prolog_flag_property(Term tflag,
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
}
if (!IsAtomTerm(tflag)) {
@ -1533,7 +1533,7 @@ static Int do_create_prolog_flag(USES_REGS1) {
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
}
fv = GetFlagProp(AtomOfTerm(tflag));

11
C/load_dl.c
View File

@ -127,7 +127,8 @@ void *Yap_LoadForeignFile(char *file, int flags) {
if (out == NULL) {
const char *m_os = dlerror();
if (m_os) {
strncpy(LOCAL_ErrorSay, m_os, MAX_ERROR_MSG_SIZE - 1);
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE);
strncpy(LOCAL_ErrorMessage, m_os, MAX_ERROR_MSG_SIZE - 1);
} else {
LOCAL_ErrorMessage = "dlopen failed";
}
@ -177,7 +178,8 @@ static Int LoadForeign(StringList ofiles, StringList libs, char *proc_name,
NULL)
#endif
{
strcpy(LOCAL_ErrorSay, dlerror());
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE);
strcpy(LOCAL_ErrorMessage, dlerror());
return LOAD_FAILLED;
}
libs = libs->next;
@ -192,7 +194,8 @@ static Int LoadForeign(StringList ofiles, StringList libs, char *proc_name,
/* dlopen wants to follow the LD_CONFIG_PATH */
const char *file = AtomName(ofiles->name);
if (!Yap_findFile(file, NULL, NULL, LOCAL_FileNameBuf, true, YAP_OBJ, true, true)) {
strcpy(LOCAL_ErrorSay,
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE);
strcpy(LOCAL_ErrorMessage,
"%% Trying to open unexisting file in LoadForeign");
return LOAD_FAILLED;
}
@ -217,7 +220,7 @@ static Int LoadForeign(StringList ofiles, StringList libs, char *proc_name,
}
if (!*init_proc) {
strcpy(LOCAL_ErrorSay, "Could not locate initialization routine");
LOCAL_ErrorMessage = "Could not locate initialization routine";
return LOAD_FAILLED;
}

3
C/load_foreign.c
View File

@ -140,7 +140,8 @@ p_open_shared_object( USES_REGS1 ) {
s = (char *)RepAtom(AtomOfTerm(t))->StrOfAE;
if ((handle = Yap_LoadForeignFile(s, IntegerOfTerm(tflags)))==NULL) {
Yap_Error(EXISTENCE_ERROR_SOURCE_SINK,t,"open_shared_object_failed for %s with %s\n", s, LOCAL_ErrorSay);
Yap_Error(EXISTENCE_ERROR_SOURCE_SINK,t,"open_shared_object_failed for %s"
" with %s\n", s, LOCAL_ErrorMessage);
return FALSE;
} else {
return Yap_unify(MkIntegerTerm((Int)handle),ARG3);

5
C/parser.c
View File

@ -175,10 +175,9 @@ static void syntax_msg(const char *msg, ...) {
va_list ap;
if (LOCAL_toktide == LOCAL_tokptr) {
char out[YAP_FILENAME_MAX];
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE+1);
va_start(ap, msg);
vsnprintf(out, YAP_FILENAME_MAX - 1, msg, ap);
LOCAL_Error_Term = MkStringTerm( out );
vsnprintf(LOCAL_ErrorMessage, YAP_FILENAME_MAX , msg, ap);
LOCAL_Error_TYPE = SYNTAX_ERROR;
va_end(ap);
}

1369
C/prim_absmi_insts.h
View File

File diff suppressed because it is too large Load Diff

8
C/save.c
View File

@ -165,9 +165,11 @@ static Int
do_SYSTEM_ERROR_INTERNAL(yap_error_number etype, const char *msg)
{
CACHE_REGS
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE+1);
#if HAVE_SNPRINTF
#if HAVE_STRERROR
snprintf(LOCAL_ErrorSay,MAX_ERROR_MSG_SIZE,"%s (%s when reading %s)", msg, strerror(errno), LOCAL_FileNameBuf);
snprintf(LOCAL_ErrorMessage,MAX_ERROR_MSG_SIZE,"%s (%s when reading %s)", msg,
strerror(errno), LOCAL_FileNameBuf);
#else
snprintf(LOCAL_ErrorSay,MAX_ERROR_MSG_SIZE,"%s, (system error %d when reading %s)",msg,errno,LOCAL_FileNameBuf);
#endif
@ -178,7 +180,6 @@ do_SYSTEM_ERROR_INTERNAL(yap_error_number etype, const char *msg)
sprintf(LOCAL_ErrorSay,"%s, (system error %d when reading %s)",msg,errno,LOCAL_FileNameBuf);
#endif
#endif
LOCAL_ErrorMessage = LOCAL_ErrorSay;
LOCAL_Error_TYPE = etype;
return -1;
}
@ -685,8 +686,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS)
}
}
if (strcmp(pp, msg) != 0) {
LOCAL_ErrorMessage = LOCAL_ErrorSay;
strncpy(LOCAL_ErrorMessage, "saved state ", MAX_ERROR_MSG_SIZE);
strncpy(LOCAL_ErrorMessage, "saved state ", MAX_ERROR_MSG_SIZE-1);
strncat(LOCAL_ErrorMessage, LOCAL_FileNameBuf, MAX_ERROR_MSG_SIZE-1);
strncat(LOCAL_ErrorMessage, " failed to match version ID", MAX_ERROR_MSG_SIZE-1);
LOCAL_Error_TYPE = SYSTEM_ERROR_SAVED_STATE;

3
C/scanner.c
View File

@ -1192,8 +1192,7 @@ Term Yap_scan_num(StreamDesc *inp) {
ef->TokNext = NULL;
LOCAL_tokptr = tokptr;
LOCAL_toktide = e;
LOCAL_ErrorMessage = NULL;
LOCAL_Error_Term = Yap_syntax_error(e, inp - GLOBAL_Stream);
LOCAL_ErrorMessage = Yap_syntax_error(e, inp - GLOBAL_Stream);
LOCAL_Error_TYPE = SYNTAX_ERROR;
}
}

32
C/stack.c
View File

@ -1074,40 +1074,40 @@ bool set_clause_info(yamop *codeptr, PredEntry *pp) {
Term ts[2];
void *begin;
if (pp->ArityOfPE == 0) {
LOCAL_ActiveError.prologPredName = (Atom)pp->FunctorOfPred;
LOCAL_ActiveError.prologPredArity = 0;
LOCAL_ActiveError->prologPredName = (Atom)pp->FunctorOfPred;
LOCAL_ActiveError->prologPredArity = 0;
} else {
LOCAL_ActiveError.prologPredName = NameOfFunctor(pp->FunctorOfPred);
LOCAL_ActiveError.prologPredArity = pp->ArityOfPE;
LOCAL_ActiveError->prologPredName = NameOfFunctor(pp->FunctorOfPred);
LOCAL_ActiveError->prologPredArity = pp->ArityOfPE;
}
LOCAL_ActiveError.prologPredModule =
LOCAL_ActiveError->prologPredModule =
(pp->ModuleOfPred ? pp->ModuleOfPred : TermProlog);
LOCAL_ActiveError.prologPredFile = pp->src.OwnerFile;
LOCAL_ActiveError->prologPredFile = pp->src.OwnerFile;
if (codeptr->opc == UNDEF_OPCODE) {
LOCAL_ActiveError.prologPredFirstLine = 0;
LOCAL_ActiveError.prologPredLine = 0;
LOCAL_ActiveError.prologPredLastLine = 0;
LOCAL_ActiveError->prologPredFirstLine = 0;
LOCAL_ActiveError->prologPredLine = 0;
LOCAL_ActiveError->prologPredLastLine = 0;
return true;
} else if (pp->cs.p_code.NOfClauses) {
if ((LOCAL_ActiveError.prologPredCl =
if ((LOCAL_ActiveError->prologPredCl =
find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) {
LOCAL_ActiveError.prologPredLine = 0;
LOCAL_ActiveError->prologPredLine = 0;
} else {
LOCAL_ActiveError.prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
LOCAL_ActiveError->prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
}
if (pp->PredFlags & LogUpdatePredFlag) {
LOCAL_ActiveError.prologPredFirstLine = IntegerOfTerm(
LOCAL_ActiveError->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc(
ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp));
LOCAL_ActiveError.prologPredLastLine = IntegerOfTerm(
LOCAL_ActiveError->prologPredLastLine = IntegerOfTerm(
ts[1] = clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause),
pp));
} else {
LOCAL_ActiveError.prologPredFirstLine = IntegerOfTerm(
LOCAL_ActiveError->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc(
ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp));
LOCAL_ActiveError.prologPredLastLine = IntegerOfTerm(
LOCAL_ActiveError->prologPredLastLine = IntegerOfTerm(
ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause),
pp));
}

56
C/text.c
View File

@ -35,46 +35,17 @@ inline static size_t min_size(size_t i, size_t j) { return (i < j ? i : j); }
#define NAN (0.0 / 0.0)
#endif
void *buf__, *cur__;
#ifndef MAX_PATHHNAME
#define MAX_PATHHNAME 1024
#endif
#define init_alloc(I) \
void *ov__ = TR, *ocur__ = LOCAL_ScannerStack; \
if (!LOCAL_ScannerStack) \
LOCAL_ScannerStack = (char *)TR
#define mark_stack() \
void *otr__ = TR; \
void *ost__ = LOCAL_ScannerStack; \
TR = (tr_fr_ptr)LOCAL_ScannerStack
#define restore_stack() \
TR = otr__; \
LOCAL_ScannerStack = ost__
#define export_buf(s) \
{}
#define unprotect_stack(s) TR = ov__, LOCAL_ScannerStack = ocur__
// LOCAL_ScannerStack = ov__, TR = ot__
static bool alloc_ovfl(size_t sz) {
return (char *)+(sz + 4096) > (char *)LOCAL_TrailTop;
}
static void *Malloc(size_t sz USES_REGS) {
sz = ALIGN_BY_TYPE(sz, CELL);
if (alloc_ovfl(sz))
return NULL;
void *o = LOCAL_ScannerStack;
LOCAL_ScannerStack = (void *)((char *)LOCAL_ScannerStack + sz);
return o;
}
static size_t MaxTmp(USES_REGS1) {
if (LOCAL_ScannerStack) {
return (char *)LOCAL_TrailTop - (char *)LOCAL_ScannerStack;
}
return 0;
void
Yap_InitTextAllocator( void )
{
struct TextBuffer_manager *new = malloc(sizeof(struct TextBuffer_manager)+MAX_PATHHNAME*2 );
new->prev = NULL;
new->ptr = new->buf = (struct TextBuffer_manager *)new+1;
LOCAL_TextBuffer = new;
}
static Term Globalize(Term v USES_REGS) {
@ -244,8 +215,6 @@ static unsigned char *to_buffer(unsigned char *buf, Term t, seq_tv_t *inp,
unsigned char *bufc = buf;
n = SkipListCodes(&bufc, &t, &r, atoms, widep, inp PASS_REGS);
if (n < 0) {
LOCAL_Error_TYPE = -n;
LOCAL_Error_Term = *r;
return NULL;
}
*lenp = n;
@ -319,7 +288,6 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) {
YAP_STRING_BIG)) == inp->type) {
LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
}
LOCAL_Error_Term = inp->val.t;
}
}
if (LOCAL_Error_TYPE != YAP_NO_ERROR)
@ -370,9 +338,9 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) {
s = (char *)s0;
else
s = Malloc(0);
if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
if (snprintf(s, MAX_PATHNAME - 1, Int_FORMAT,
IntegerOfTerm(inp->val.t)) < 0) {
AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char);
AUX_ERROR(inp->val.t, 2 * (MAX_PATHNAME), s, char);
}
*lengp = strlen(s);
Malloc(*lengp);

39
CXX/yapi.cpp
View File

@ -612,11 +612,14 @@ Term YAPEngine::fun(Term t) {
} else if (IsAtomTerm(t)) {
name = AtomOfTerm(t);
f = nullptr;
} else if (IsAtomTerm(t)) {
} else if (IsPairTerm(t)) {
XREGS[1] = ts[0];
XREGS[2] = ts[1];
name = AtomDot;
f = FunctorDot;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, 0);
return 0L;
}
XREGS[arity+1] = MkVarTerm();
arity ++;
@ -1027,37 +1030,37 @@ const char *YAPError::text() {
char buf[256];
std::string s = "";
if (LOCAL_ActiveError.errorFunction) {
s += LOCAL_ActiveError.errorFile;
if (LOCAL_ActiveError->errorFunction) {
s += LOCAL_ActiveError->errorFile;
s += ":";
sprintf(buf, "%ld", (long int)LOCAL_ActiveError.errorLine);
sprintf(buf, "%ld", (long int)LOCAL_ActiveError->errorLine);
s += buf;
s += ":0 in C-code";
}
if (LOCAL_ActiveError.prologPredLine) {
if (LOCAL_ActiveError->prologPredLine) {
s += "\n";
s += LOCAL_ActiveError.prologPredFile->StrOfAE;
s += LOCAL_ActiveError->prologPredFile->StrOfAE;
s += ":";
sprintf(buf, "%ld", (long int)LOCAL_ActiveError.prologPredLine);
s += buf; // std::to_string(LOCAL_ActiveError.prologPredLine) ;
// YAPIntegerTerm(LOCAL_ActiveError.prologPredLine).text();
sprintf(buf, "%ld", (long int)LOCAL_ActiveError->prologPredLine);
s += buf; // std::to_string(LOCAL_ActiveError->prologPredLine) ;
// YAPIntegerTerm(LOCAL_ActiveError->prologPredLine).text();
s += ":0 ";
s += LOCAL_ActiveError.prologPredModule;
s += LOCAL_ActiveError->prologPredModule;
s += ":";
s += (LOCAL_ActiveError.prologPredName)->StrOfAE;
s += (LOCAL_ActiveError->prologPredName)->StrOfAE;
s += "/";
sprintf(buf, "%ld", (long int)LOCAL_ActiveError.prologPredArity);
s += // std::to_string(LOCAL_ActiveError.prologPredArity);
sprintf(buf, "%ld", (long int)LOCAL_ActiveError->prologPredArity);
s += // std::to_string(LOCAL_ActiveError->prologPredArity);
buf;
}
s += " error ";
if (LOCAL_ActiveError.classAsText != nullptr)
s += LOCAL_ActiveError.classAsText->StrOfAE;
if (LOCAL_ActiveError->classAsText != nullptr)
s += LOCAL_ActiveError->classAsText->StrOfAE;
s += ".";
s += LOCAL_ActiveError.errorAsText->StrOfAE;
s += LOCAL_ActiveError->errorAsText->StrOfAE;
s += ".\n";
if (LOCAL_ActiveError.errorTerm) {
Term t = Yap_PopTermFromDB(LOCAL_ActiveError.errorTerm);
if (LOCAL_ActiveError->errorTerm) {
Term t = Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm);
if (t) {
s += "error term is: ";
s += YAPTerm(t).text();

10
CXX/yapie.hh
View File

@ -15,17 +15,17 @@ public:
YAPError(){};
/// we just know the error number
/// exact error ID
yap_error_number getID() { return LOCAL_ActiveError.errorNo; };
yap_error_number getID() { return LOCAL_ActiveError->errorNo; };
/// class of error
yap_error_class_number getErrorClass() {
return Yap_errorClass(LOCAL_ActiveError.errorNo);
return Yap_errorClass(LOCAL_ActiveError->errorNo);
};
/// where in the code things happened;
const char *getFile() { return LOCAL_ActiveError.errorFile; };
const char *getFile() { return LOCAL_ActiveError->errorFile; };
/// predicate things happened;
Int getLine() { return LOCAL_ActiveError.errorLine; };
Int getLine() { return LOCAL_ActiveError->errorLine; };
/// the term that caused the bug
// YAPTerm getCulprit(LOCAL_ActiveError.errorFile){};
// YAPTerm getCulprit(LOCAL_ActiveError->errorFile){};
/// text describing the Error
const char *text();
};

11
CXX/yapq.hh
View File

@ -183,9 +183,16 @@ public:
bool goalt(YAPTerm t);
/// current directory for the engine
bool goal(Term t);
#if SWIGPYTHON
bool unlockedGoal(Term t) {bool rc;Py_BEGIN_ALLOW_THREADS; rc = goal(t);Py_END_ALLOW_THREADS; return rc; }
bool unlockedGoal(Term t) {bool rc;
#ifdef SWIGPYTHON
Py_BEGIN_ALLOW_THREADS;
#endif
rc = goal(t);
#ifdef SWIGPYTHON
Py_END_ALLOW_THREADS;
#endif
return rc;
}
/// reset Prolog state
void reSet();
/// release: assune that there are no stack pointers, just release memory

12
H/LOCALS
View File

@ -79,7 +79,6 @@ UInt GlobalArenaOverflows =0L
Int ArenaOverflows =0L
Int DepthArenas =0
int ArithError =FALSE
struct pred_entry* LastAssertedPred =NULL
struct pred_entry* TmpPred =NULL
char* ScannerStack =NULL
@ -194,13 +193,10 @@ ADDR LocalBase void
ADDR GlobalBase void
ADDR TrailBase void
ADDR TrailTop void
char* ErrorMessage void
Term Error_Term void
/** error handling info, designed to be easy to pass to the foreign world */
struct yap_error_descriptor ActiveError void
/* error handling info, designed to be easy to pass to the foreign world */
yap_error_descriptor_t* ActiveError =calloc(sizeof(yap_error_descriptor_t),1)
/// pointer to an exception term, from throw
struct DB_TERM* BallTerm =NULL
jmp_buf IOBotch void
TokEntry* tokptr void
@ -217,6 +213,8 @@ sigjmp_buf RestartEnv void
char FileNameBuf[YAP_FILENAME_MAX+1] void
char FileNameBuf2[YAP_FILENAME_MAX+1] void
struct TextBuffer_manager* TextBuffer =Yap_InitTextAllocator()
// Prolog State
UInt BreakLevel =0
Int PrologMode =BootMode
@ -237,10 +235,8 @@ YAP_ULONG_LONG 2opcount[_std_top+1][_std_top+1] void
struct db_globs* s_dbg void
//eval.c
yap_error_number matherror =YAP_NO_ERROR
Term mathtt void
char* mathstring =NULL
yap_error_number CurrentError =YAP_NO_ERROR
//grow.c
int heap_overflows =0

42
H/YapText.h
View File

@ -31,6 +31,48 @@
#include "../utf8proc/utf8proc.h"
#include "Yap.h"
typedef struct TextBuffer_manager {
void *buf, *ptr;
size_t sz;
struct TextBuffer_manager *prev;
} text_buffer_t;
/**
* TextBuffer is allocated as a chain of blocks, They area
* recovered at the end if the translation.
*/
inline void init_alloc(int line) {
while (LOCAL_TextBuffer->prev ) {
struct TextBuffer_manager *old = LOCAL_TextBuffer;
LOCAL_TextBuffer = LOCAL_TextBuffer->prev;
free(old);
}
LOCAL_TextBuffer->sz = (YAP_FILENAME_MAX + 1);
LOCAL_TextBuffer->buf = LOCAL_TextBuffer->ptr = realloc(LOCAL_TextBuffer->ptr, YAP_FILENAME_MAX + 1 );
}
extern inline void mark_stack(void) {}
extern inline void restore_stack(void ) {} \
extern inline void unprotect_stack(void *ptr) {} \
extern inline void *Malloc(size_t sz USES_REGS) {
sz = ALIGN_BY_TYPE(sz, CELL);
void *o = LOCAL_TextBuffer->ptr;
if ((char*)LOCAL_TextBuffer->ptr+sz>(char*)LOCAL_TextBuffer->buf + LOCAL_TextBuffer->sz) {
struct TextBuffer_manager *new = malloc(sizeof(struct TextBuffer_manager)+YAP_FILENAME_MAX + 1);
new->prev = LOCAL_TextBuffer;
new->buf = (struct TextBuffer_manager *)new+1;
new->ptr = new->buf + sz;
LOCAL_TextBuffer= new;
return new->buf;
}
LOCAL_TextBuffer->ptr += sz;
return o;
}
/* Character types for tokenizer and write.c */
/****************** character definition table **************************/

13
H/absmi.h
View File

@ -99,7 +99,8 @@ register struct yami *P1REG asm("bp"); /* can't use yamop before Yap.h */
#define LIMITED_PREFETCH 1
#endif /* __x86_64__ */
#if defined(__arm__) || defined(__thumb__) || defined(mips) || defined(__mips64) || defined(__aarch64__)
#if defined(__arm__) || defined(__thumb__) || defined(mips) || \
defined(__mips64) || defined(__aarch64__)
#define Y_IN_MEM 1
#define S_IN_MEM 1
@ -2075,7 +2076,8 @@ cufail:
#endif
#if /* defined(IN_ABSMI_C) ||*/ defined(IN_INLINES_C) /*|| defined(IN_TRACED_ABSMI_C) */
#if /* defined(IN_ABSMI_C) ||*/ defined( \
IN_INLINES_C) /*|| defined(IN_TRACED_ABSMI_C) */
static int iequ_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt1) {
@ -2450,4 +2452,11 @@ extern yamop *headoftrace;
ENDD(d0);
#endif
#define Yap_AsmError(e) \
{ \
saveregs(); \
Yap_Error(e, 0, ""); \
setregs(); \
}
#endif // ABSMI_H

17
H/eval.h
View File

@ -375,6 +375,7 @@ Functor EvalArg(Term);
eval_flt = (F); \
return (FFloat); \
}
#define REvalError() \
{ return (FError); }
@ -407,8 +408,12 @@ yamop *Yap_EvalError__(const char *, const char *, int, yap_error_number, Term,
#define Yap_ArithError(id, t, ...) \
Yap_ArithError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
Int Yap_ArithError__(const char *, const char *, int, yap_error_number, Term,
...);
#define Yap_BinError(id) \
Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, 0L, "")
#define Yap_AbsmiError(id) \
Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, 0L, "")
extern Int Yap_ArithError__(const char *, const char *, int, yap_error_number,
Term, ...);
#include "inline-only.h"
@ -429,7 +434,7 @@ INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS) {
#if HAVE_FECLEAREXCEPT
inline static void Yap_ClearExs(void) { feclearexcept(FE_ALL_EXCEPT); }
#else
inline static void Yap_ClearExs(void) { }
inline static void Yap_ClearExs(void) {}
#endif
inline static yap_error_number Yap_FoundArithError__(USES_REGS1) {
@ -463,7 +468,11 @@ Atom Yap_NameOfBinaryOp(int i);
#define RINT(v) return (MkIntegerTerm(v))
#define RFLOAT(v) return (MkFloatTerm(v))
#define RBIG(v) return (Yap_MkBigIntTerm(v))
#define RERROR() return (0L)
#define RERROR() \
{ \
Yap_BinError(LOCAL_Error_TYPE); \
return (0L); \
}
static inline blob_type ETypeOfTerm(Term t) {
if (IsIntTerm(t))

14
H/generated/dlocals.h
View File

@ -121,8 +121,6 @@
#define REMOTE_ArenaOverflows(wid) REMOTE(wid)->ArenaOverflows_
#define LOCAL_DepthArenas LOCAL->DepthArenas_
#define REMOTE_DepthArenas(wid) REMOTE(wid)->DepthArenas_
#define LOCAL_ArithError LOCAL->ArithError_
#define REMOTE_ArithError(wid) REMOTE(wid)->ArithError_
#define LOCAL_LastAssertedPred LOCAL->LastAssertedPred_
#define REMOTE_LastAssertedPred(wid) REMOTE(wid)->LastAssertedPred_
#define LOCAL_TmpPred LOCAL->TmpPred_
@ -288,16 +286,10 @@
#define REMOTE_TrailBase(wid) REMOTE(wid)->TrailBase_
#define LOCAL_TrailTop LOCAL->TrailTop_
#define REMOTE_TrailTop(wid) REMOTE(wid)->TrailTop_
#define LOCAL_ErrorMessage LOCAL->ErrorMessage_
#define REMOTE_ErrorMessage(wid) REMOTE(wid)->ErrorMessage_
#define LOCAL_Error_Term LOCAL->Error_Term_
#define REMOTE_Error_Term(wid) REMOTE(wid)->Error_Term_
#define LOCAL_ActiveError LOCAL->ActiveError_
#define REMOTE_ActiveError(wid) REMOTE(wid)->ActiveError_
#define LOCAL_BallTerm LOCAL->BallTerm_
#define REMOTE_BallTerm(wid) REMOTE(wid)->BallTerm_
#define LOCAL_IOBotch LOCAL->IOBotch_
#define REMOTE_IOBotch(wid) REMOTE(wid)->IOBotch_
#define LOCAL_tokptr LOCAL->tokptr_
@ -326,6 +318,8 @@
#define REMOTE_FileNameBuf(wid) REMOTE(wid)->FileNameBuf_
#define LOCAL_FileNameBuf2 LOCAL->FileNameBuf2_
#define REMOTE_FileNameBuf2(wid) REMOTE(wid)->FileNameBuf2_
#define LOCAL_TextBuffer LOCAL->TextBuffer_
#define REMOTE_TextBuffer(wid) REMOTE(wid)->TextBuffer_
#define LOCAL_BreakLevel LOCAL->BreakLevel_
#define REMOTE_BreakLevel(wid) REMOTE(wid)->BreakLevel_
@ -350,14 +344,10 @@
#define LOCAL_s_dbg LOCAL->s_dbg_
#define REMOTE_s_dbg(wid) REMOTE(wid)->s_dbg_
#define LOCAL_matherror LOCAL->matherror_
#define REMOTE_matherror(wid) REMOTE(wid)->matherror_
#define LOCAL_mathtt LOCAL->mathtt_
#define REMOTE_mathtt(wid) REMOTE(wid)->mathtt_
#define LOCAL_mathstring LOCAL->mathstring_
#define REMOTE_mathstring(wid) REMOTE(wid)->mathstring_
#define LOCAL_CurrentError LOCAL->CurrentError_
#define REMOTE_CurrentError(wid) REMOTE(wid)->CurrentError_
#define LOCAL_heap_overflows LOCAL->heap_overflows_
#define REMOTE_heap_overflows(wid) REMOTE(wid)->heap_overflows_

11
H/generated/hlocals.h
View File

@ -69,7 +69,6 @@ typedef struct worker_local {
UInt GlobalArenaOverflows_;
Int ArenaOverflows_;
Int DepthArenas_;
int ArithError_;
struct pred_entry* LastAssertedPred_;
struct pred_entry* TmpPred_;
char* ScannerStack_;
@ -164,12 +163,9 @@ typedef struct worker_local {
ADDR GlobalBase_;
ADDR TrailBase_;
ADDR TrailTop_;
char* ErrorMessage_;
Term Error_Term_;
/** error handling info, designed to be easy to pass to the foreign world */
struct yap_error_descriptor ActiveError_;
/* error handling info, designed to be easy to pass to the foreign world */
yap_error_descriptor_t* ActiveError_;
/// pointer to an exception term, from throw
struct DB_TERM* BallTerm_;
jmp_buf IOBotch_;
TokEntry* tokptr_;
TokEntry* toktide_;
@ -184,6 +180,7 @@ typedef struct worker_local {
sigjmp_buf RestartEnv_;
char FileNameBuf_[YAP_FILENAME_MAX+1];
char FileNameBuf2_[YAP_FILENAME_MAX+1];
struct TextBuffer_manager* TextBuffer_;
// Prolog State
UInt BreakLevel_;
Int PrologMode_;
@ -200,10 +197,8 @@ typedef struct worker_local {
//dbase.c
struct db_globs* s_dbg_;
//eval.c
yap_error_number matherror_;
Term mathtt_;
char* mathstring_;
yap_error_number CurrentError_;
//grow.c
int heap_overflows_;
Int total_heap_overflow_time_;

11
H/generated/ilocals.h
View File

@ -69,7 +69,6 @@ static void InitWorker(int wid) {
REMOTE_GlobalArenaOverflows(wid) = 0L;
REMOTE_ArenaOverflows(wid) = 0L;
REMOTE_DepthArenas(wid) = 0;
REMOTE_ArithError(wid) = FALSE;
REMOTE_LastAssertedPred(wid) = NULL;
REMOTE_TmpPred(wid) = NULL;
REMOTE_ScannerStack(wid) = NULL;
@ -165,11 +164,7 @@ static void InitWorker(int wid) {
REMOTE_BallTerm(wid) = NULL;
REMOTE_ActiveError(wid) = calloc(sizeof(yap_error_descriptor_t),1);
@ -185,6 +180,8 @@ static void InitWorker(int wid) {
REMOTE_TextBuffer(wid) = Yap_InitTextAllocator();
REMOTE_BreakLevel(wid) = 0;
REMOTE_PrologMode(wid) = BootMode;
REMOTE_CritLocks(wid) = 0;
@ -200,10 +197,8 @@ static void InitWorker(int wid) {
REMOTE_matherror(wid) = YAP_NO_ERROR;
REMOTE_mathstring(wid) = NULL;
REMOTE_CurrentError(wid) = YAP_NO_ERROR;
REMOTE_heap_overflows(wid) = 0;
REMOTE_total_heap_overflow_time(wid) = 0;

5
H/generated/rlocals.h
View File

@ -86,7 +86,6 @@ static void RestoreWorker(int wid USES_REGS) {
#ifdef COROUTINING
@ -188,8 +187,6 @@ static void RestoreWorker(int wid USES_REGS) {
@ -214,8 +211,6 @@ static void RestoreWorker(int wid USES_REGS) {
#ifdef LOAD_DYLD
#endif

184
H/walkclause.h
View File

@ -1,9 +1,7 @@
/* This file was generated automatically by "yap -L misc/buildops"
/* This file was generated automatically by "yap -L misc/buildops"
please do not update */
while (TRUE) {
while (TRUE) {
op_numbers op;
op = Yap_op_from_opcode(pc->opc);
@ -11,39 +9,39 @@
switch (op) {
/* instructions type D */
case _write_dbterm:
pc = NEXTOP(pc,D);
pc = NEXTOP(pc, D);
break;
/* instructions type Illss */
case _enter_lu_pred:
return walk_got_lu_block(pc->y_u.Illss.I, startp, endp);
/* instructions type J */
/* instructions type J */
#ifdef YAP_JIT
case _jit_handler:
#endif
pc = NEXTOP(pc,J);
pc = NEXTOP(pc, J);
break;
/* instructions type L */
case _alloc_for_logical_pred:
return walk_got_lu_clause(pc->y_u.L.ClBase, startp, endp);
/* instructions type N */
case _write_bigint:
pc = NEXTOP(pc,N);
pc = NEXTOP(pc, N);
break;
/* instructions type Osblp */
case _either:
case _or_else:
clause_code = TRUE;
pp = pc->y_u.Osblp.p0;
pc = NEXTOP(pc,Osblp);
pc = NEXTOP(pc, Osblp);
break;
/* instructions type Osbmp */
case _p_execute:
case _p_execute_tail:
pc = NEXTOP(pc,Osbmp);
pc = NEXTOP(pc, Osbmp);
break;
/* instructions type Osbpa */
case _ensure_space:
pc = NEXTOP(pc,Osbpa);
pc = NEXTOP(pc, Osbpa);
break;
/* instructions type Osbpp */
case _call_cpred:
@ -58,7 +56,7 @@
case _fcall:
clause_code = TRUE;
pp = pc->y_u.Osbpp.p0;
pc = NEXTOP(pc,Osbpp);
pc = NEXTOP(pc, Osbpp);
break;
/* instructions type OtILl */
case _count_trust_logical:
@ -81,7 +79,7 @@
case _try_userc:
clause_code = TRUE;
pp = pc->y_u.OtapFs.p;
pc = NEXTOP(pc,OtapFs);
pc = NEXTOP(pc, OtapFs);
break;
/* instructions type Otapl */
case _count_retry_and_mark:
@ -101,39 +99,39 @@
case _try_me:
clause_code = FALSE;
pp = pc->y_u.Otapl.p;
pc = NEXTOP(pc,Otapl);
pc = NEXTOP(pc, Otapl);
break;
/* instructions type c */
case _write_atom:
pc = NEXTOP(pc,c);
pc = NEXTOP(pc, c);
break;
/* instructions type cc */
case _get_2atoms:
pc = NEXTOP(pc,cc);
pc = NEXTOP(pc, cc);
break;
/* instructions type ccc */
case _get_3atoms:
pc = NEXTOP(pc,ccc);
pc = NEXTOP(pc, ccc);
break;
/* instructions type cccc */
case _get_4atoms:
pc = NEXTOP(pc,cccc);
pc = NEXTOP(pc, cccc);
break;
/* instructions type ccccc */
case _get_5atoms:
pc = NEXTOP(pc,ccccc);
pc = NEXTOP(pc, ccccc);
break;
/* instructions type cccccc */
case _get_6atoms:
pc = NEXTOP(pc,cccccc);
pc = NEXTOP(pc, cccccc);
break;
/* instructions type clll */
case _if_not_then:
pc = NEXTOP(pc,clll);
pc = NEXTOP(pc, clll);
break;
/* instructions type d */
case _write_float:
pc = NEXTOP(pc,d);
pc = NEXTOP(pc, d);
break;
/* instructions type e */
case _Nstop:
@ -149,14 +147,14 @@
case _op_fail:
if (codeptr == FAILCODE)
return found_fail(pc, startp, endp PASS_REGS);
pc = NEXTOP(pc,e);
pc = NEXTOP(pc, e);
break;
case _spy_pred:
return found_owner_op(pc, startp, endp PASS_REGS);
case _trust_fail:
if (codeptr == TRUSTFAILCODE)
return found_fail(pc, startp, endp PASS_REGS);
pc = NEXTOP(pc,e);
pc = NEXTOP(pc, e);
break;
case _undef_p:
return found_owner_op(pc, startp, endp PASS_REGS);
@ -180,16 +178,16 @@
case _write_l_list:
case _write_list:
case _write_void:
pc = NEXTOP(pc,e);
pc = NEXTOP(pc, e);
break;
/* instructions type fa */
case _write_l_struc:
case _write_struct:
pc = NEXTOP(pc,fa);
pc = NEXTOP(pc, fa);
break;
/* instructions type i */
case _write_longint:
pc = NEXTOP(pc,i);
pc = NEXTOP(pc, i);
break;
/* instructions type l */
case _Ystop:
@ -209,11 +207,11 @@
case _try_clause3:
case _try_clause4:
case _try_in:
pc = NEXTOP(pc,l);
pc = NEXTOP(pc, l);
break;
/* instructions type llll */
case _switch_on_type:
pc = NEXTOP(pc,llll);
pc = NEXTOP(pc, llll);
break;
/* instructions type lp */
case _retry_all_exo:
@ -223,7 +221,7 @@
case _try_exo:
case _try_exo_udi:
case _user_switch:
pc = NEXTOP(pc,lp);
pc = NEXTOP(pc, lp);
break;
/* instructions type o */
case _unify_l_list:
@ -234,51 +232,51 @@
case _unify_list_write:
case _unify_void:
case _unify_void_write:
pc = NEXTOP(pc,o);
pc = NEXTOP(pc, o);
break;
/* instructions type oD */
case _unify_dbterm:
case _unify_l_dbterm:
pc = NEXTOP(pc,oD);
pc = NEXTOP(pc, oD);
break;
/* instructions type oN */
case _unify_bigint:
case _unify_l_bigint:
pc = NEXTOP(pc,oN);
pc = NEXTOP(pc, oN);
break;
/* instructions type oc */
case _unify_atom:
case _unify_atom_write:
case _unify_l_atom:
case _unify_l_atom_write:
pc = NEXTOP(pc,oc);
pc = NEXTOP(pc, oc);
break;
/* instructions type od */
case _unify_float:
case _unify_float_write:
case _unify_l_float:
case _unify_l_float_write:
pc = NEXTOP(pc,od);
pc = NEXTOP(pc, od);
break;
/* instructions type ofa */
case _unify_l_struc:
case _unify_l_struc_write:
case _unify_struct:
case _unify_struct_write:
pc = NEXTOP(pc,ofa);
pc = NEXTOP(pc, ofa);
break;
/* instructions type oi */
case _unify_l_longint:
case _unify_l_longint_write:
case _unify_longint:
case _unify_longint_write:
pc = NEXTOP(pc,oi);
pc = NEXTOP(pc, oi);
break;
/* instructions type ollll */
case _switch_list_nl:
pc = NEXTOP(pc,ollll);
pc = NEXTOP(pc, ollll);
break;
/* instructions type os */
/* instructions type os */
#ifdef BEAM
case _run_eam:
#endif
@ -286,17 +284,17 @@
case _unify_l_n_voids_write:
case _unify_n_voids:
case _unify_n_voids_write:
pc = NEXTOP(pc,os);
pc = NEXTOP(pc, os);
break;
/* instructions type osc */
case _unify_n_atoms:
case _unify_n_atoms_write:
pc = NEXTOP(pc,osc);
pc = NEXTOP(pc, osc);
break;
/* instructions type ou */
case _unify_l_string:
case _unify_string:
pc = NEXTOP(pc,ou);
pc = NEXTOP(pc, ou);
break;
/* instructions type ox */
case _save_appl_x:
@ -315,14 +313,14 @@
case _unify_x_val_write:
case _unify_x_var:
case _unify_x_var_write:
pc = NEXTOP(pc,ox);
pc = NEXTOP(pc, ox);
break;
/* instructions type oxx */
case _unify_l_x_var2:
case _unify_l_x_var2_write:
case _unify_x_var2:
case _unify_x_var2_write:
pc = NEXTOP(pc,oxx);
pc = NEXTOP(pc, oxx);
break;
/* instructions type oy */
case _save_appl_y:
@ -341,7 +339,7 @@
case _unify_y_val_write:
case _unify_y_var:
case _unify_y_var_write:
pc = NEXTOP(pc,oy);
pc = NEXTOP(pc, oy);
break;
/* instructions type p */
case _lock_lu:
@ -350,7 +348,7 @@
if (pp->PredFlags & MegaClausePredFlag)
return found_mega_clause(pp, startp, endp);
clause_code = TRUE;
pc = NEXTOP(pc,p);
pc = NEXTOP(pc, p);
break;
case _count_call:
case _count_retry:
@ -359,20 +357,20 @@
case _retry_profiled:
case _retry_udi:
case _try_udi:
pc = NEXTOP(pc,p);
pc = NEXTOP(pc, p);
break;
/* instructions type plxxs */
case _call_bfunc_xx:
pc = NEXTOP(pc,plxxs);
pc = NEXTOP(pc, plxxs);
break;
/* instructions type plxys */
case _call_bfunc_xy:
case _call_bfunc_yx:
pc = NEXTOP(pc,plxys);
pc = NEXTOP(pc, plxys);
break;
/* instructions type plyys */
case _call_bfunc_yy:
pc = NEXTOP(pc,plyys);
pc = NEXTOP(pc, plyys);
break;
/* instructions type pp */
case _execute_cpred:
@ -382,7 +380,7 @@
case _execute:
clause_code = TRUE;
pp = pc->y_u.pp.p0;
pc = NEXTOP(pc,pp);
pc = NEXTOP(pc, pp);
break;
/* instructions type s */
case _cut:
@ -390,15 +388,15 @@
case _cut_t:
case _pop_n:
case _write_n_voids:
pc = NEXTOP(pc,s);
pc = NEXTOP(pc, s);
break;
/* instructions type sc */
case _write_n_atoms:
pc = NEXTOP(pc,sc);
pc = NEXTOP(pc, sc);
break;
/* instructions type sllll */
case _switch_on_sub_arg_type:
pc = NEXTOP(pc,sllll);
pc = NEXTOP(pc, sllll);
break;
/* instructions type slpp */
case _call_c_wfail:
@ -411,12 +409,12 @@
case _if_func:
case _switch_on_cons:
case _switch_on_func:
pc = NEXTOP(pc,sssl);
pc = NEXTOP(pc, sssl);
break;
/* instructions type sssllp */
case _expand_clauses:
return found_expand_index(pc, startp, endp, codeptr PASS_REGS);
pc = NEXTOP(pc,sssllp);
pc = NEXTOP(pc, sssllp);
break;
/* instructions type x */
case _get_atom_exo:
@ -426,37 +424,37 @@
case _write_x_loc:
case _write_x_val:
case _write_x_var:
pc = NEXTOP(pc,x);
pc = NEXTOP(pc, x);
break;
/* instructions type xD */
case _get_dbterm:
case _put_dbterm:
pc = NEXTOP(pc,xD);
pc = NEXTOP(pc, xD);
break;
/* instructions type xN */
case _get_bigint:
case _put_bigint:
pc = NEXTOP(pc,xN);
pc = NEXTOP(pc, xN);
break;
/* instructions type xc */
case _get_atom:
case _put_atom:
pc = NEXTOP(pc,xc);
pc = NEXTOP(pc, xc);
break;
/* instructions type xd */
case _get_float:
case _put_float:
pc = NEXTOP(pc,xd);
pc = NEXTOP(pc, xd);
break;
/* instructions type xfa */
case _get_struct:
case _put_struct:
pc = NEXTOP(pc,xfa);
pc = NEXTOP(pc, xfa);
break;
/* instructions type xi */
case _get_longint:
case _put_longint:
pc = NEXTOP(pc,xi);
pc = NEXTOP(pc, xi);
break;
/* instructions type xl */
case _p_atom_x:
@ -469,23 +467,23 @@
case _p_number_x:
case _p_primitive_x:
case _p_var_x:
pc = NEXTOP(pc,xl);
pc = NEXTOP(pc, xl);
break;
/* instructions type xll */
case _jump_if_nonvar:
pc = NEXTOP(pc,xll);
pc = NEXTOP(pc, xll);
break;
/* instructions type xllll */
case _switch_on_arg_type:
pc = NEXTOP(pc,xllll);
pc = NEXTOP(pc, xllll);
break;
/* instructions type xps */
case _commit_b_x:
pc = NEXTOP(pc,xps);
pc = NEXTOP(pc, xps);
break;
/* instructions type xu */
case _get_string:
pc = NEXTOP(pc,xu);
pc = NEXTOP(pc, xu);
break;
/* instructions type xx */
case _get_x_val:
@ -495,11 +493,11 @@
case _glist_valx:
case _put_x_val:
case _put_x_var:
pc = NEXTOP(pc,xx);
pc = NEXTOP(pc, xx);
break;
/* instructions type xxc */
case _p_func2s_cv:
pc = NEXTOP(pc,xxc);
pc = NEXTOP(pc, xxc);
break;
/* instructions type xxn */
case _p_and_vc:
@ -515,7 +513,7 @@
case _p_slr_cv:
case _p_slr_vc:
case _p_times_vc:
pc = NEXTOP(pc,xxn);
pc = NEXTOP(pc, xxn);
break;
/* instructions type xxx */
case _p_and_vv:
@ -529,22 +527,22 @@
case _p_sll_vv:
case _p_slr_vv:
case _p_times_vv:
pc = NEXTOP(pc,xxx);
pc = NEXTOP(pc, xxx);
break;
/* instructions type xxxx */
case _put_xx_val:
pc = NEXTOP(pc,xxxx);
pc = NEXTOP(pc, xxxx);
break;
/* instructions type xxy */
case _p_func2f_xy:
pc = NEXTOP(pc,xxy);
pc = NEXTOP(pc, xxy);
break;
/* instructions type y */
case _save_b_y:
case _write_y_loc:
case _write_y_val:
case _write_y_var:
pc = NEXTOP(pc,y);
pc = NEXTOP(pc, y);
break;
/* instructions type yl */
case _p_atom_y:
@ -557,11 +555,11 @@
case _p_number_y:
case _p_primitive_y:
case _p_var_y:
pc = NEXTOP(pc,yl);
pc = NEXTOP(pc, yl);
break;
/* instructions type yps */
case _commit_b_y:
pc = NEXTOP(pc,yps);
pc = NEXTOP(pc, yps);
break;
/* instructions type yx */
case _get_y_val:
@ -572,11 +570,11 @@
case _put_unsafe:
case _put_y_val:
case _put_y_var:
pc = NEXTOP(pc,yx);
pc = NEXTOP(pc, yx);
break;
/* instructions type yxc */
case _p_func2s_y_cv:
pc = NEXTOP(pc,yxc);
pc = NEXTOP(pc, yxc);
break;
/* instructions type yxn */
case _p_and_y_vc:
@ -592,7 +590,7 @@
case _p_slr_y_cv:
case _p_slr_y_vc:
case _p_times_y_vc:
pc = NEXTOP(pc,yxn);
pc = NEXTOP(pc, yxn);
break;
/* instructions type yxx */
case _p_and_y_vv:
@ -606,16 +604,16 @@
case _p_sll_y_vv:
case _p_slr_y_vv:
case _p_times_y_vv:
pc = NEXTOP(pc,yxx);
pc = NEXTOP(pc, yxx);
break;
/* instructions type yyx */
case _p_func2f_yy:
pc = NEXTOP(pc,yyx);
pc = NEXTOP(pc, yyx);
break;
/* instructions type yyxx */
case _get_yy_var:
case _put_y_vals:
pc = NEXTOP(pc,yyxx);
pc = NEXTOP(pc, yyxx);
break;
#ifdef YAPOR
/* instructions type Otapl */
@ -624,11 +622,11 @@
case _sync:
clause_code = FALSE;
pp = pc->y_u.Otapl.p;
pc = NEXTOP(pc,Otapl);
pc = NEXTOP(pc, Otapl);
break;
/* instructions type e */
case _getwork_first_time:
pc = NEXTOP(pc,e);
pc = NEXTOP(pc, e);
break;
#endif
#ifdef TABLING
@ -649,17 +647,17 @@
case _table_try_single:
clause_code = FALSE;
pp = pc->y_u.Otapl.p;
pc = NEXTOP(pc,Otapl);
pc = NEXTOP(pc, Otapl);
break;
/* instructions type e */
/* instructions type e */
#ifdef TABLING_INNER_CUTS
case _clause_with_cut:
#endif
pc = NEXTOP(pc,e);
pc = NEXTOP(pc, e);
break;
/* instructions type s */
case _table_new_answer:
pc = NEXTOP(pc,s);
pc = NEXTOP(pc, s);
break;
/* instructions type e */
case _trie_do_appl:
@ -726,7 +724,7 @@
case _trie_try_val_in_pair:
case _trie_try_var:
case _trie_try_var_in_pair:
pc = NEXTOP(pc,e);
pc = NEXTOP(pc, e);
break;
#endif
/* this instruction is hardwired */
@ -736,13 +734,13 @@
if (pp->PredFlags & MegaClausePredFlag)
return found_mega_clause(pp, startp, endp);
clause_code = TRUE;
pc = NEXTOP(pc,Osblp);
pc = NEXTOP(pc, Osblp);
#else
pp = pc->y_u.p.p;
if (pp->PredFlags & MegaClausePredFlag)
return found_mega_clause(pp, startp, endp);
clause_code = TRUE;
pc = NEXTOP(pc,p);
pc = NEXTOP(pc, p);
#endif
}
}
}

50
include/YapError.h
View File

@ -76,7 +76,6 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
#define JMP_LOCAL_ERROR(v, LAB) \
if (H + 2 * (v) > ASP - 1024) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = 2 * (v) * sizeof(CELL); \
goto LAB; \
}
@ -84,7 +83,6 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
#define LOCAL_ERROR(t, v) \
if (HR + (v) > ASP - 1024) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = 2 * (v) * sizeof(CELL); \
return NULL; \
}
@ -92,7 +90,6 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
#define LOCAL_TERM_ERROR(t, v) \
if (HR + (v) > ASP - 1024) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = 2 * (v) * sizeof(CELL); \
return 0L; \
}
@ -100,7 +97,6 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
#define AUX_ERROR(t, n, s, TYPE) \
if (s + (n + 1) > (TYPE *)AuxSp) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \
return NULL; \
}
@ -108,7 +104,6 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
#define AUX_TERM_ERROR(t, n, s, TYPE) \
if (s + (n + 1) > (TYPE *)AuxSp) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \
return 0L; \
}
@ -116,7 +111,6 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
#define JMP_AUX_ERROR(n, s, t, TYPE, LAB) \
if (s + (n + 1) > (TYPE *)AuxSp) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \
goto LAB; \
}
@ -124,7 +118,6 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
#define HEAP_ERROR(a, TYPE) \
if (a == NIL) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \
return NULL; \
}
@ -132,7 +125,6 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
#define HEAP_TERM_ERROR(a, TYPE, n) \
if (a == NIL) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \
return 0L; \
}
@ -140,7 +132,6 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
#define JMP_HEAP_ERROR(a, n, t, TYPE, LAB) \
if (a == NIL) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \
goto LAB; \
}
@ -174,6 +165,21 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
/// go back t
} yap_error_stage_t;
/// a Prolo goal that caused a bug
typedef struct error_prolog_source {
YAP_Int prologPredCl;
YAP_UInt prologPredLine;
YAP_UInt prologPredFirstLine;
YAP_UInt prologPredLastLine;
YAP_Atom prologPredName;
YAP_UInt prologPredArity;
YAP_Term prologPredModule;
YAP_Atom prologPredFile;
struct DB_TERM *errorGoal;
struct error_prolog_source *errorParent;
} error_prolog_source_t;
/// all we need to know about an error/throw
typedef struct yap_error_descriptor {
enum yap_error_status status;
@ -184,6 +190,7 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
YAP_Int errorLine;
const char *errorFunction;
const char *errorFile;
// struct error_prolog_source *errorSource;
YAP_Int prologPredCl;
YAP_UInt prologPredLine;
YAP_UInt prologPredFirstLine;
@ -192,22 +199,33 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
YAP_UInt prologPredArity;
YAP_Term prologPredModule;
YAP_Atom prologPredFile;
YAP_UInt prologParserLine;
YAP_UInt prologParserFirstLine;
YAP_UInt prologParserLastLine;
YAP_Atom prologParserName;
YAP_Atom prologParserFile;
YAP_Bool prologConsulting;
struct DB_TERM *errorTerm;
char errorComment[MAX_ERROR_MSG_SIZE];
char *errorMsg;
size_t errorMsgLen;
struct yap_error_descriptor *top_error;
} yap_error_descriptor_t;
/// compatibility with existing code..
#define LOCAL_Error_TYPE LOCAL_ActiveError.errorNo
#define LOCAL_Error_File LOCAL_ActiveError.errorFile
#define LOCAL_Error_Function LOCAL_ActiveError.errorFunction
#define LOCAL_Error_Lineno LOCAL_ActiveError.errorLine
#define LOCAL_Error_Size LOCAL_ActiveError.errorMsgLen
#define LOCAL_ErrorSay LOCAL_ActiveError.errorComment
#define LOCAL_Error_TYPE LOCAL_ActiveError->errorNo
#define LOCAL_Error_File LOCAL_ActiveError->errorFile
#define LOCAL_Error_Function LOCAL_ActiveError->errorFunction
#define LOCAL_Error_Lineno LOCAL_ActiveError->errorLine
#define LOCAL_Error_Size LOCAL_ActiveError->errorMsgLen
#define LOCAL_BallTerm LOCAL_ActiveError->errorTerm
#define LOCAL_ErrorMessage LOCAL_ActiveError->errorMsg
extern bool Yap_find_prolog_culprit();
extern yap_error_class_number Yap_errorClass(yap_error_number e);
extern const char *Yap_errorName(yap_error_number e);
extern const char *Yap_errorClassName(yap_error_class_number e);
extern void Yap_pushErrorContext(yap_error_descriptor_t * new_error);
extern yap_error_descriptor_t *Yap_popErrorContext(void);
#endif

17
os/iopreds.c
View File

@ -454,15 +454,15 @@ int Yap_DebugPuts(FILE *s, const char *sch) {
void Yap_DebugErrorPuts(const char *s) { Yap_DebugPuts(stderr, s); }
void Yap_DebugPlWrite(Term t) {
if (t==0)
fprintf(stderr,"NULL");
if (t == 0)
fprintf(stderr, "NULL");
Yap_plwrite(t, GLOBAL_Stream + 2, 0, 0, GLOBAL_MaxPriority);
}
void Yap_DebugPlWriteln(Term t) {
CACHE_REGS
if (t==0)
fprintf(stderr,"NULL");
if (t == 0)
fprintf(stderr, "NULL");
Yap_plwrite(t, NULL, 15, 0, GLOBAL_MaxPriority);
Yap_DebugPutc(GLOBAL_Stream[LOCAL_c_error_stream].file, '.');
Yap_DebugPutc(GLOBAL_Stream[LOCAL_c_error_stream].file, 10);
@ -616,7 +616,7 @@ int post_process_read_wchar(int ch, size_t n, StreamDesc *s) {
if (ch == EOF) {
return post_process_weof(s);
}
#if DEBUG
#if DEBUG
if (GLOBAL_Option[1]) {
static int v;
fprintf(stderr, "%d %C\n", v, ch);
@ -1193,8 +1193,7 @@ do_open(Term file_name, Term t2,
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_OPEN_OPTION;
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term,
"option handling in open/3");
Yap_Error(LOCAL_Error_TYPE, tlist, "option handling in open/3");
}
return false;
}
@ -1700,7 +1699,7 @@ static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_CLOSE_OPTION;
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, tlist, NULL);
}
return false;
return FALSE;
@ -1762,7 +1761,7 @@ static Int abs_file_parameters(USES_REGS1) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION;
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, tlist, NULL);
}
return false;
}

55
os/iopreds.h
View File

@ -24,7 +24,8 @@
#include "YapStreams.h"
static inline bool IsStreamTerm(Term t) {
INLINE_ONLY EXTERN inline UInt PRED_HASH(FunctorEntry *, Term, UInt);
INLINE_ONLY EXTERN inline bool IsStreamTerm(Term t) {
return !IsVarTerm(t) &&
(IsAtomTerm(t) ||
(IsApplTerm(t) && (FunctorOfTerm(t) == FunctorStream)));
@ -121,28 +122,28 @@ extern bool Yap_ReadlineOps(StreamDesc *st);
extern int Yap_OpenBufWriteStream(USES_REGS1);
extern void Yap_ConsoleOps(StreamDesc *s);
void Yap_InitRandomPreds(void);
void Yap_InitSignalPreds(void);
void Yap_InitTimePreds(void);
extern void Yap_InitRandomPreds(void);
extern void Yap_InitSignalPreds(void);
extern void Yap_InitTimePreds(void);
void Yap_init_socks(char *host, long interface_port);
void Yap_InitPipes(void);
void Yap_InitMem(void);
void Yap_InitSockets(void);
void Yap_InitSocketLayer(void);
void Yap_InitMems(void);
void Yap_InitConsole(void);
void Yap_InitReadlinePreds(void);
extern void Yap_init_socks(char *host, long interface_port);
extern void Yap_InitPipes(void);
extern void Yap_InitMem(void);
extern void Yap_InitSockets(void);
extern void Yap_InitSocketLayer(void);
extern void Yap_InitMems(void);
extern void Yap_InitConsole(void);
extern void Yap_InitReadlinePreds(void);
bool Yap_InitReadline(Term);
void Yap_InitChtypes(void);
void Yap_InitCharsio(void);
void Yap_InitFormat(void);
void Yap_InitFiles(void);
void Yap_InitIOStreams(void);
void Yap_InitWriteTPreds(void);
void Yap_InitReadTPreds(void);
void Yap_socketStream(StreamDesc *s);
void Yap_ReadlineFlush(int sno);
extern void Yap_InitChtypes(void);
extern void Yap_InitCharsio(void);
extern void Yap_InitFormat(void);
extern void Yap_InitFiles(void);
extern void Yap_InitIOStreams(void);
extern void Yap_InitWriteTPreds(void);
extern void Yap_InitReadTPreds(void);
extern void Yap_socketStream(StreamDesc *s);
extern void Yap_ReadlineFlush(int sno);
Int Yap_ReadlinePeekChar(int sno);
int Yap_ReadlineForSIGINT(void);
bool Yap_DoPrompt(StreamDesc *s);
@ -150,7 +151,7 @@ bool Yap_DoPrompt(StreamDesc *s);
Int Yap_peek(int sno);
int Yap_MemPeekc(int sno);
Term Yap_syntax_error(TokEntry *tokptr, int sno);
char *Yap_syntax_error(TokEntry *tokptr, int sno);
int console_post_process_read_char(int, StreamDesc *);
int console_post_process_eof(StreamDesc *);
@ -173,15 +174,15 @@ int ResetEOF(StreamDesc *s);
int EOFPeek(int sno);
int EOFWPeek(int sno);
void Yap_SetAlias(Atom arg, int sno);
extern void Yap_SetAlias(Atom arg, int sno);
bool Yap_AddAlias(Atom arg, int sno);
int Yap_CheckAlias(Atom arg);
int Yap_RemoveAlias(Atom arg, int snoinline);
void Yap_SetAlias(Atom arg, int sno);
extern void Yap_SetAlias(Atom arg, int sno);
void Yap_InitAliases(void);
void Yap_DeleteAliases(int sno);
bool Yap_FindStreamForAlias(Atom al);
bool Yap_FetchStreamAlias(int sno, Term t2 USES_REGS);
extern bool Yap_FindStreamForAlias(Atom al);
extern bool Yap_FetchStreamAlias(int sno, Term t2 USES_REGS);
INLINE_ONLY inline EXTERN void count_output_char(int ch, StreamDesc *s);
@ -270,7 +271,7 @@ extern FILE *Yap_stderr;
char *Yap_MemExportStreamPtr(int sno);
bool Yap_Exists(const char *f);
extern bool Yap_Exists(const char *f);
static inline void freeBuffer(const void *ptr) {
CACHE_REGS

82
os/readterm.c
View File

@ -95,7 +95,7 @@ static char SccsId[] = "%W% %G%";
#define SYSTEM_STAT stat
#endif
static Term syntax_error(TokEntry *errtok, int sno, Term cmod);
static char *syntax_error(TokEntry *errtok, int sno, Term cmod);
static void clean_vars(VarEntry *p) {
if (p == NULL)
@ -215,7 +215,7 @@ static const param_t read_defs[] = {READ_DEFS()};
* Implicit arguments:
* +
*/
static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
static char * syntax_error(TokEntry *errtok, int sno, Term cmod) {
CACHE_REGS
Term info;
Term startline, errline, endline;
@ -264,76 +264,58 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
t0[0] = TermNil;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
}
break;
case QuasiQuotes_tok:
{
} break;
case QuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
}
break;
case WQuasiQuotes_tok:
{
} break;
case WQuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
}
break;
} break;
case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo));
break;
case Var_tok:
{
case Var_tok: {
Term t[2];
VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
}
break;
case String_tok:
{
} break;
case String_tok: {
Term t0 = Yap_CharsToTDQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
if (!t0) {
return 0;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
}
break;
case WString_tok:
{
} break;
case WString_tok: {
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS);
if (!t0)
return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
}
break;
case BQString_tok:
{
} break;
case BQString_tok: {
Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
}
break;
case WBQString_tok:
{
} break;
case WBQString_tok: {
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
}
break;
case Error_tok:
{
} break;
case Error_tok: {
ts[0] = MkAtomTerm(AtomError);
}
break;
} break;
case eot_tok:
endline = MkIntegerTerm(tok->TokPos);
ts[0] = MkAtomTerm(Yap_LookupAtom("EOT"));
break;
case Ponctuation_tok:
{
case Ponctuation_tok: {
char s[2];
s[1] = '\0';
if ((info) == 'l') {
@ -379,10 +361,10 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
Yap_DebugPlWriteln(terr);
}
#endif
return terr;
return NULL;
}
Term Yap_syntax_error(TokEntry *errtok, int sno) {
char * Yap_syntax_error(TokEntry *errtok, int sno) {
return syntax_error(errtok, sno, CurrentModule);
}
@ -790,10 +772,10 @@ static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
fe->args = setReadEnv(opts, fe, re, inp_stream);
}
if (fe->args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_READ_OPTION)
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
fe->t = 0;
return YAP_PARSING_FINISHED;
;
@ -828,7 +810,6 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
strncpy(out, "Empty clause", len);
LOCAL_ErrorMessage = out;
LOCAL_Error_TYPE = SYNTAX_ERROR;
LOCAL_Error_Term = TermEof;
return YAP_PARSING_ERROR;
}
return scanEOF(fe, inp_stream);
@ -889,13 +870,14 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return YAP_PARSING_FINISHED;
} else {
Term terr = syntax_error(fe->toklast, inp_stream, fe->cmod);
const char*s = syntax_error(fe->toklast, inp_stream, fe->cmod);
if (ParserErrorStyle == TermError) {
LOCAL_ErrorMessage = NULL;
LOCAL_ErrorMessage = s;
LOCAL_Error_TYPE = SYNTAX_ERROR;
return YAP_PARSING_FINISHED;
// dec-10
} else if (Yap_PrintWarning(terr)) {
} else if (Yap_PrintWarning(MkStringTerm(s))) {
free(s);
LOCAL_Error_TYPE = YAP_NO_ERROR;
return YAP_SCANNING;
}
@ -961,8 +943,7 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
case YAP_PARSING_ERROR:
state = parseError(&re, &fe, inp_stream);
break;
case YAP_PARSING_FINISHED:
{
case YAP_PARSING_FINISHED: {
CACHE_REGS
bool done;
if (fe.reading_clause)
@ -988,7 +969,7 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
}
static Int
read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
Term rc;
yhandle_t h = Yap_PushHandle(ARG1);
if ((rc = Yap_read_term(LOCAL_c_input_stream, ARG2, 2)) == 0)
@ -1165,7 +1146,8 @@ static Int read_clause(
/**
* @pred source_location( - _File_ , _Line_ )
*
* unify _File_ and _Line_ wuth the position of the last term read, if the term
* unify _File_ and _Line_ wuth the position of the last term read, if the
*term
* comes from a stream created by opening a file-system path with open/3 and
*friends.>position
* It ignores user_input or

117
os/sig.c
View File

@ -1,7 +1,6 @@
#include "sysbits.h"
#if HAVE_SIGINFO_H
#include <siginfo.h>
#endif
@ -15,105 +14,103 @@
#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */
#define SIG_EXCEPTION (SIG_PROLOG_OFFSET+0)
#define SIG_EXCEPTION (SIG_PROLOG_OFFSET + 0)
#ifdef O_ATOMGC
#define SIG_ATOM_GC (SIG_PROLOG_OFFSET+1)
#define SIG_ATOM_GC (SIG_PROLOG_OFFSET + 1)
#endif
#define SIG_GC (SIG_PROLOG_OFFSET+2)
#define SIG_GC (SIG_PROLOG_OFFSET + 2)
#ifdef O_PLMT
#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET+3)
#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET + 3)
#endif
#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET+4)
#define SIG_PLABORT (SIG_PROLOG_OFFSET+5)
#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET + 4)
#define SIG_PLABORT (SIG_PROLOG_OFFSET + 5)
static struct signame
{ int sig;
static struct signame {
int sig;
const char *name;
int flags;
} signames[] =
{
} signames[] = {
#ifdef SIGHUP
{ SIGHUP, "hup", 0},
{SIGHUP, "hup", 0},
#endif
{ SIGINT, "int", 0},
{SIGINT, "int", 0},
#ifdef SIGQUIT
{ SIGQUIT, "quit", 0},
{SIGQUIT, "quit", 0},
#endif
{ SIGILL, "ill", 0},
{ SIGABRT, "abrt", 0},
{ SIGFPE, "fpe", 0},
{SIGILL, "ill", 0},
{SIGABRT, "abrt", 0},
{SIGFPE, "fpe", 0},
#ifdef SIGKILL
{ SIGKILL, "kill", 0},
{SIGKILL, "kill", 0},
#endif
{ SIGSEGV, "segv", 0},
{SIGSEGV, "segv", 0},
#ifdef SIGPIPE
{ SIGPIPE, "pipe", 0},
{SIGPIPE, "pipe", 0},
#endif
#ifdef SIGALRM
{ SIGALRM, "alrm", 0},
{SIGALRM, "alrm", 0},
#endif
{ SIGTERM, "term", 0},
{SIGTERM, "term", 0},
#ifdef SIGUSR1
{ SIGUSR1, "usr1", 0},
{SIGUSR1, "usr1", 0},
#endif
#ifdef SIGUSR2
{ SIGUSR2, "usr2", 0},
{SIGUSR2, "usr2", 0},
#endif
#ifdef SIGCHLD
{ SIGCHLD, "chld", 0},
{SIGCHLD, "chld", 0},
#endif
#ifdef SIGCONT
{ SIGCONT, "cont", 0},
{SIGCONT, "cont", 0},
#endif
#ifdef SIGSTOP
{ SIGSTOP, "stop", 0},
{SIGSTOP, "stop", 0},
#endif
#ifdef SIGTSTP
{ SIGTSTP, "tstp", 0},
{SIGTSTP, "tstp", 0},
#endif
#ifdef SIGTTIN
{ SIGTTIN, "ttin", 0},
{SIGTTIN, "ttin", 0},
#endif
#ifdef SIGTTOU
{ SIGTTOU, "ttou", 0},
{SIGTTOU, "ttou", 0},
#endif
#ifdef SIGTRAP
{ SIGTRAP, "trap", 0},
{SIGTRAP, "trap", 0},
#endif
#ifdef SIGBUS
{ SIGBUS, "bus", 0},
{SIGBUS, "bus", 0},
#endif
#ifdef SIGSTKFLT
{ SIGSTKFLT, "stkflt", 0},
{SIGSTKFLT, "stkflt", 0},
#endif
#ifdef SIGURG
{ SIGURG, "urg", 0},
{SIGURG, "urg", 0},
#endif
#ifdef SIGIO
{ SIGIO, "io", 0},
{SIGIO, "io", 0},
#endif
#ifdef SIGPOLL
{ SIGPOLL, "poll", 0},
{SIGPOLL, "poll", 0},
#endif
#ifdef SIGXCPU
{ SIGXCPU, "xcpu", 0},
{SIGXCPU, "xcpu", 0},
#endif
#ifdef SIGXFSZ
{ SIGXFSZ, "xfsz", 0},
{SIGXFSZ, "xfsz", 0},
#endif
#ifdef SIGVTALRM
{ SIGVTALRM, "vtalrm", 0},
{SIGVTALRM, "vtalrm", 0},
#endif
#ifdef SIGPROF
{ SIGPROF, "prof", 0},
{SIGPROF, "prof", 0},
#endif
#ifdef SIGPWR
{ SIGPWR, "pwr", 0},
{SIGPWR, "pwr", 0},
#endif
{ SIG_EXCEPTION, "prolog:exception", 0 },
{SIG_EXCEPTION, "prolog:exception", 0},
#ifdef SIG_ATOM_GC
{ SIG_ATOM_GC, "prolog:atom_gc", 0 },
{SIG_ATOM_GC, "prolog:atom_gc", 0},
#endif
{SIG_GC, "prolog:gc", 0},
#ifdef SIG_THREAD_SIGNAL
@ -122,7 +119,6 @@ static struct signame
{-1, NULL, 0}};
#if HAVE_SIGACTION
static void my_signal_info(int sig, void *handler) {
struct sigaction sigact;
@ -146,13 +142,13 @@ static void my_signal(int sig, void *handler) {
#else
static void my_signal(int sig, void *handler) {
#if HAVE_SIGNAL
#if HAVE_SIGNAL
signal(sig, handler);
#endif
}
static void my_signal_info(int sig, void *handler) {
#if HAVE_SIGNAL
#if HAVE_SIGNAL
if (signal(sig, (void *)handler) == SIG_ERR)
exit(1);
#endif
@ -160,15 +156,13 @@ static void my_signal_info(int sig, void *handler) {
#endif
static void HandleMatherr(int sig, void *sipv, void *uapv) {
CACHE_REGS
LOCAL_matherror = Yap_MathException();
LOCAL_Error_TYPE = Yap_MathException();
/* reset the registers so that we don't have trash in abstract machine */
Yap_external_signal(worker_id, YAP_FPE_SIGNAL);
}
/* SWI emulation */
int Yap_signal_index(const char *name) {
struct signame *sn = signames;
@ -318,10 +312,8 @@ static bool set_fpu_exceptions(Term flag) {
return true;
}
#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__)
static void ReceiveSignal(int s, void *x, void *y) {
CACHE_REGS
LOCAL_PrologMode |= InterruptMode;
@ -412,7 +404,6 @@ static BOOL WINAPI MSCHandleSignal(DWORD dwCtrlType) {
}
#endif
/* wrapper for alarm system call */
#if _MSC_VER || defined(__MINGW32__)
@ -671,7 +662,6 @@ VaxFixFrame(dummy) {
#if defined(_WIN32)
int WINAPI win_yap(HANDLE, DWORD, LPVOID);
int WINAPI win_yap(HANDLE hinst, DWORD reason, LPVOID reserved) {
@ -821,15 +811,7 @@ yap_error_number Yap_MathException__(USES_REGS1) {
set_fpu_exceptions(0);
#endif
return LOCAL_matherror;
}
static Int fpe_error(USES_REGS1) {
Yap_Error(LOCAL_matherror, LOCAL_mathtt, LOCAL_mathstring);
LOCAL_matherror = YAP_NO_ERROR;
LOCAL_mathtt = TermNil;
LOCAL_mathstring = NULL;
return FALSE;
return LOCAL_Error_TYPE;
}
/* SIGINT can cause problems, if caught before full initialization */
@ -865,18 +847,11 @@ void Yap_InitOSSignals(int wid) {
}
}
bool Yap_set_fpu_exceptions(Term flag) {
return set_fpu_exceptions(flag);
}
bool Yap_set_fpu_exceptions(Term flag) { return set_fpu_exceptions(flag); }
void Yap_InitSignalPreds(void) {
CACHE_REGS
Term cm = CurrentModule;
Yap_InitCPred("$fpe_error", 0, fpe_error, 0);
Yap_InitCPred("$alarm", 4, alarm4, SafePredFlag | SyncPredFlag);
CurrentModule = HACKS_MODULE;
Yap_InitCPred("virtual_alarm", 4, virtual_alarm, SafePredFlag | SyncPredFlag);

3
os/sysbits.h
View File

@ -37,11 +37,10 @@
#include <io.h>
#include <windows.h>
#ifndef S_ISDIR
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR)
#endif
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

341
os/time.c
View File

@ -45,16 +45,18 @@ static struct timeval StartOfTimes_sys;
#endif
/* store user time in this variable */
void
Yap_InitTime (int wid)
{
void Yap_InitTime(int wid) {
struct rusage rusage;
#if THREADS
REMOTE_ThreadHandle(wid).start_of_timesp = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).last_timep = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).start_of_times_sysp = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).last_time_sysp = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).start_of_timesp =
(struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).last_timep =
(struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).start_of_times_sysp =
(struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).last_time_sysp =
(struct timeval *)malloc(sizeof(struct timeval));
getrusage(RUSAGE_SELF, &rusage);
(*REMOTE_ThreadHandle(wid).last_timep).tv_sec =
(*REMOTE_ThreadHandle(wid).start_of_timesp).tv_sec =
@ -70,35 +72,23 @@ Yap_InitTime (int wid)
rusage.ru_stime.tv_usec;
#else
getrusage(RUSAGE_SELF, &rusage);
last_time.tv_sec =
StartOfTimes.tv_sec =
rusage.ru_utime.tv_sec;
last_time.tv_usec =
StartOfTimes.tv_usec =
rusage.ru_utime.tv_usec;
last_time_sys.tv_sec =
StartOfTimes_sys.tv_sec =
rusage.ru_stime.tv_sec;
last_time_sys.tv_usec =
StartOfTimes_sys.tv_usec =
rusage.ru_stime.tv_usec;
last_time.tv_sec = StartOfTimes.tv_sec = rusage.ru_utime.tv_sec;
last_time.tv_usec = StartOfTimes.tv_usec = rusage.ru_utime.tv_usec;
last_time_sys.tv_sec = StartOfTimes_sys.tv_sec = rusage.ru_stime.tv_sec;
last_time_sys.tv_usec = StartOfTimes_sys.tv_usec = rusage.ru_stime.tv_usec;
#endif
}
UInt
Yap_cputime ( void )
{
UInt Yap_cputime(void) {
CACHE_REGS
struct rusage rusage;
getrusage(RUSAGE_SELF, &rusage);
return((rusage.ru_utime.tv_sec - StartOfTimes.tv_sec)) * 1000 +
return ((rusage.ru_utime.tv_sec - StartOfTimes.tv_sec)) * 1000 +
((rusage.ru_utime.tv_usec - StartOfTimes.tv_usec) / 1000);
}
void Yap_cputime_interval(Int *now,Int *interval)
{
void Yap_cputime_interval(Int *now, Int *interval) {
CACHE_REGS
struct rusage rusage;
@ -111,8 +101,7 @@ void Yap_cputime_interval(Int *now,Int *interval)
last_time.tv_sec = rusage.ru_utime.tv_sec;
}
void Yap_systime_interval(Int *now,Int *interval)
{
void Yap_systime_interval(Int *now, Int *interval) {
CACHE_REGS
struct rusage rusage;
@ -132,24 +121,25 @@ void Yap_systime_interval(Int *now,Int *interval)
/* This is stolen from the Linux kernel.
The problem is that mingw32 does not seem to have acces to div */
#ifndef do_div
#define do_div(n,base) ({ \
#define do_div(n, base) \
({ \
unsigned long __upper, __low, __high, __mod; \
asm("":"=a" (__low), "=d" (__high):"A" (n)); \
asm("" : "=a"(__low), "=d"(__high) : "A"(n)); \
__upper = __high; \
if (__high) { \
__upper = __high % (base); \
__high = __high / (base); \
} \
asm("divl %2":"=a" (__low), "=d" (__mod):"rm" (base), "0" (__low), "1" (__upper)); \
asm("":"=A" (n):"a" (__low),"d" (__high)); \
asm("divl %2" \
: "=a"(__low), "=d"(__mod) \
: "rm"(base), "0"(__low), "1"(__upper)); \
asm("" : "=A"(n) : "a"(__low), "d"(__high)); \
__mod; \
})
#endif
#endif
#include <time.h>
static FILETIME StartOfTimes, last_time;
@ -159,22 +149,25 @@ static FILETIME StartOfTimes_sys, last_time_sys;
static clock_t TimesStartOfTimes, Times_last_time;
/* store user time in this variable */
void
Yap_InitTime (int wid)
{
void Yap_InitTime(int wid) {
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime,
&UserTime)) {
/* WIN98 */
clock_t t;
t = clock ();
t = clock();
Times_last_time = TimesStartOfTimes = t;
} else {
#if THREADS
REMOTE_ThreadHandle(wid).start_of_timesp = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).last_timep = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).start_of_times_sysp = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).last_time_sysp = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).start_of_timesp =
(struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).last_timep =
(struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).start_of_times_sysp =
(struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).last_time_sysp =
(struct _FILETIME *)malloc(sizeof(FILETIME));
(*REMOTE_ThreadHandle(wid).last_timep).dwLowDateTime =
UserTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).last_timep).dwHighDateTime =
@ -192,115 +185,98 @@ Yap_InitTime (int wid)
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).dwHighDateTime =
KernelTime.dwHighDateTime;
#else
last_time.dwLowDateTime =
UserTime.dwLowDateTime;
last_time.dwHighDateTime =
UserTime.dwHighDateTime;
StartOfTimes.dwLowDateTime =
UserTime.dwLowDateTime;
StartOfTimes.dwHighDateTime =
UserTime.dwHighDateTime;
last_time_sys.dwLowDateTime =
KernelTime.dwLowDateTime;
last_time_sys.dwHighDateTime =
KernelTime.dwHighDateTime;
StartOfTimes_sys.dwLowDateTime =
KernelTime.dwLowDateTime;
StartOfTimes_sys.dwHighDateTime =
KernelTime.dwHighDateTime;
last_time.dwLowDateTime = UserTime.dwLowDateTime;
last_time.dwHighDateTime = UserTime.dwHighDateTime;
StartOfTimes.dwLowDateTime = UserTime.dwLowDateTime;
StartOfTimes.dwHighDateTime = UserTime.dwHighDateTime;
last_time_sys.dwLowDateTime = KernelTime.dwLowDateTime;
last_time_sys.dwHighDateTime = KernelTime.dwHighDateTime;
StartOfTimes_sys.dwLowDateTime = KernelTime.dwLowDateTime;
StartOfTimes_sys.dwHighDateTime = KernelTime.dwHighDateTime;
#endif
}
}
#ifdef __GNUC__
static unsigned long long int
sub_utime(FILETIME t1, FILETIME t2)
{
static unsigned long long int sub_utime(FILETIME t1, FILETIME t2) {
ULARGE_INTEGER u[2];
memcpy((void *)u,(void *)&t1,sizeof(FILETIME));
memcpy((void *)(u+1),(void *)&t2,sizeof(FILETIME));
return
u[0].QuadPart - u[1].QuadPart;
memcpy((void *)u, (void *)&t1, sizeof(FILETIME));
memcpy((void *)(u + 1), (void *)&t2, sizeof(FILETIME));
return u[0].QuadPart - u[1].QuadPart;
}
#endif
UInt
Yap_cputime ( void )
{
UInt Yap_cputime(void) {
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime,
&UserTime)) {
clock_t t;
t = clock ();
return(((t - TimesStartOfTimes)*1000) / CLOCKS_PER_SEC);
t = clock();
return (((t - TimesStartOfTimes) * 1000) / CLOCKS_PER_SEC);
} else {
#ifdef __GNUC__
unsigned long long int t =
sub_utime(UserTime,StartOfTimes);
do_div(t,10000);
return((Int)t);
unsigned long long int t = sub_utime(UserTime, StartOfTimes);
do_div(t, 10000);
return ((Int)t);
#endif
#ifdef _MSC_VER
__int64 t = *(__int64 *)&UserTime - *(__int64 *)&StartOfTimes;
return((Int)(t/10000));
return ((Int)(t / 10000));
#endif
}
}
void Yap_cputime_interval(Int *now,Int *interval)
{
void Yap_cputime_interval(Int *now, Int *interval) {
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime,
&UserTime)) {
clock_t t;
t = clock ();
*now = ((t - TimesStartOfTimes)*1000) / CLOCKS_PER_SEC;
t = clock();
*now = ((t - TimesStartOfTimes) * 1000) / CLOCKS_PER_SEC;
*interval = (t - Times_last_time) * 1000 / CLOCKS_PER_SEC;
Times_last_time = t;
} else {
#ifdef __GNUC__
unsigned long long int t1 =
sub_utime(UserTime, StartOfTimes);
unsigned long long int t2 =
sub_utime(UserTime, last_time);
do_div(t1,10000);
unsigned long long int t1 = sub_utime(UserTime, StartOfTimes);
unsigned long long int t2 = sub_utime(UserTime, last_time);
do_div(t1, 10000);
*now = (Int)t1;
do_div(t2,10000);
do_div(t2, 10000);
*interval = (Int)t2;
#endif
#ifdef _MSC_VER
__int64 t1 = *(__int64 *)&UserTime - *(__int64 *)&StartOfTimes;
__int64 t2 = *(__int64 *)&UserTime - *(__int64 *)&last_time;
*now = (Int)(t1/10000);
*interval = (Int)(t2/10000);
*now = (Int)(t1 / 10000);
*interval = (Int)(t2 / 10000);
#endif
last_time.dwLowDateTime = UserTime.dwLowDateTime;
last_time.dwHighDateTime = UserTime.dwHighDateTime;
}
}
void Yap_systime_interval(Int *now,Int *interval)
{
void Yap_systime_interval(Int *now, Int *interval) {
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime,
&UserTime)) {
*now = *interval = 0; /* not available */
} else {
#ifdef __GNUC__
unsigned long long int t1 =
sub_utime(KernelTime, StartOfTimes_sys);
unsigned long long int t2 =
sub_utime(KernelTime, last_time_sys);
do_div(t1,10000);
unsigned long long int t1 = sub_utime(KernelTime, StartOfTimes_sys);
unsigned long long int t2 = sub_utime(KernelTime, last_time_sys);
do_div(t1, 10000);
*now = (Int)t1;
do_div(t2,10000);
do_div(t2, 10000);
*interval = (Int)t2;
#endif
#ifdef _MSC_VER
__int64 t1 = *(__int64 *)&KernelTime - *(__int64 *)&StartOfTimes_sys;
__int64 t2 = *(__int64 *)&KernelTime - *(__int64 *)&last_time_sys;
*now = (Int)(t1/10000);
*interval = (Int)(t2/10000);
*now = (Int)(t1 / 10000);
*interval = (Int)(t2 / 10000);
#endif
last_time_sys.dwLowDateTime = KernelTime.dwLowDateTime;
last_time_sys.dwHighDateTime = KernelTime.dwHighDateTime;
@ -332,7 +308,8 @@ void Yap_systime_interval(Int *now,Int *interval)
#define TicksPerSec CLK_TCK
#endif
#if defined(__alpha) || defined(__FreeBSD__) || defined(__linux__) || defined(__DragonFly__)
#if defined(__alpha) || defined(__FreeBSD__) || defined(__linux__) || \
defined(__DragonFly__)
#if HAVE_TIME_H
#include <time.h>
@ -353,37 +330,31 @@ static clock_t StartOfTimes, last_time;
static clock_t StartOfTimes_sys, last_time_sys;
/* store user time in this variable */
static void
InitTime (void)
{
static void InitTime(void) {
struct tms t;
times (&t);
times(&t);
(*REMOTE_ThreadHandle(wid).last_timep) = StartOfTimes = t.tms_utime;
last_time_sys = StartOfTimes_sys = t.tms_stime;
}
UInt
Yap_cputime (void)
{
UInt Yap_cputime(void) {
struct tms t;
times(&t);
return((t.tms_utime - StartOfTimes)*1000 / TicksPerSec);
return ((t.tms_utime - StartOfTimes) * 1000 / TicksPerSec);
}
void Yap_cputime_interval(Int *now,Int *interval)
{
void Yap_cputime_interval(Int *now, Int *interval) {
struct tms t;
times (&t);
*now = ((t.tms_utime - StartOfTimes)*1000) / TicksPerSec;
times(&t);
*now = ((t.tms_utime - StartOfTimes) * 1000) / TicksPerSec;
*interval = (t.tms_utime - last_time) * 1000 / TicksPerSec;
last_time = t.tms_utime;
}
void Yap_systime_interval(Int *now,Int *interval)
{
void Yap_systime_interval(Int *now, Int *interval) {
struct tms t;
times (&t);
*now = ((t.tms_stime - StartOfTimes_sys)*1000) / TicksPerSec;
times(&t);
*now = ((t.tms_stime - StartOfTimes_sys) * 1000) / TicksPerSec;
*interval = (t.tms_stime - last_time_sys) * 1000 / TicksPerSec;
last_time_sys = t.tms_stime;
}
@ -401,36 +372,32 @@ static struct timeval StartOfTimes;
static struct timeval last_time;
/* store user time in this variable */
static void
InitTime (int wid)
{
static void InitTime(int wid) {
struct timeval tp;
gettimeofday(&tp,NULL);
(*REMOTE_ThreadHandle(wid).last_timep).tv_sec = (*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_sec = tp.tv_sec;
(*REMOTE_ThreadHandle(wid).last_timep).tv_usec = (*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_usec = tp.tv_usec;
gettimeofday(&tp, NULL);
(*REMOTE_ThreadHandle(wid).last_timep).tv_sec =
(*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_sec = tp.tv_sec;
(*REMOTE_ThreadHandle(wid).last_timep).tv_usec =
(*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_usec = tp.tv_usec;
}
UInt
Yap_cputime (void)
{
UInt Yap_cputime(void) {
struct timeval tp;
gettimeofday(&tp,NULL);
gettimeofday(&tp, NULL);
if (StartOfTimes.tv_usec > tp.tv_usec)
return((tp.tv_sec - StartOfTimes.tv_sec - 1) * 1000 +
(StartOfTimes.tv_usec - tp.tv_usec) /1000);
return ((tp.tv_sec - StartOfTimes.tv_sec - 1) * 1000 +
(StartOfTimes.tv_usec - tp.tv_usec) / 1000);
else
return((tp.tv_sec - StartOfTimes.tv_sec)) * 1000 +
return ((tp.tv_sec - StartOfTimes.tv_sec)) * 1000 +
((tp.tv_usec - StartOfTimes.tv_usec) / 1000);
}
void Yap_cputime_interval(Int *now,Int *interval)
{
void Yap_cputime_interval(Int *now, Int *interval) {
struct timeval tp;
gettimeofday(&tp,NULL);
gettimeofday(&tp, NULL);
*now = (tp.tv_sec - StartOfTimes.tv_sec) * 1000 +
(tp.tv_usec - StartOfTimes.tv_usec) / 1000;
*interval = (tp.tv_sec - last_time.tv_sec) * 1000 +
@ -439,8 +406,7 @@ void Yap_cputime_interval(Int *now,Int *interval)
last_time.tv_sec = tp.tv_sec;
}
void Yap_systime_interval(Int *now,Int *interval)
{
void Yap_systime_interval(Int *now, Int *interval) {
*now = *interval = 0; /* not available */
}
@ -450,16 +416,12 @@ void Yap_systime_interval(Int *now,Int *interval)
/* This code is not working properly. I left it here to help future ports */
#ifdef MPW
#include <files.h>
#include <Events.h>
#include <files.h>
#define TicksPerSec 60.0
static double
real_cputime ()
{
return (((double) TickCount ()) / TicksPerSec);
}
static double real_cputime() { return (((double)TickCount()) / TicksPerSec); }
#endif /* MPW */
@ -469,18 +431,13 @@ real_cputime ()
static long *ptime;
gettime ()
{
*ptime = *(long *) 0x462;
}
gettime() { *ptime = *(long *)0x462; }
static double
real_cputime ()
{
static double real_cputime() {
long thetime;
ptime = &thetime;
xbios (38, gettime);
return (((double) thetime) / (Getrez () == 2 ? 70 : 60));
xbios(38, gettime);
return (((double)thetime) / (Getrez() == 2 ? 70 : 60));
}
#endif /* LATTICE */
@ -492,18 +449,12 @@ real_cputime ()
static long *ptime;
static long
readtime ()
{
return (*((long *) 0x4ba));
}
static long readtime() { return (*((long *)0x4ba)); }
static double
real_cputime ()
{
static double real_cputime() {
long time;
time = Supexec (readtime);
time = Supexec(readtime);
return (time / 200.0);
}
@ -518,11 +469,7 @@ real_cputime ()
#define TicksPerSec 60.0
static double
real_cputime ()
{
return (((double) TickCount ()) / TicksPerSec);
}
static double real_cputime() { return (((double)TickCount()) / TicksPerSec); }
#endif /* LIGHT */
@ -540,48 +487,35 @@ uint64_t Yap_StartOfWTimes;
/* since the point YAP was started */
void
Yap_InitWTime (void)
{
Yap_StartOfWTimes = (uint64_t)gethrtime();
}
void Yap_InitWTime(void) { Yap_StartOfWTimes = (uint64_t)gethrtime(); }
/// returns time since Jan 1 1980 in nano-seconds
uint64_t Yap_walltime(uint64_t old)
{
uint64_t Yap_walltime(uint64_t old) {
hrtime_t tp = gethrtime();
/* return time in milliseconds */
return = (uint64_t)tp;
return (uint64_t)tp;
}
#elif HAVE_GETTIMEOFDAY
/* since the point YAP was started */
/* store user time in this variable */
void
Yap_InitWTime (void)
{
void Yap_InitWTime(void) {
struct timeval tp;
gettimeofday(&tp, NULL);
Yap_StartOfWTimes = (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
Yap_StartOfWTimes =
(uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
}
/// returns time in nano-secs since the epoch
uint64_t
Yap_walltime(void)
{
/// returns time in nano-secs since the epoch
uint64_t Yap_walltime(void) {
struct timeval tp;
gettimeofday(&tp, NULL);
return (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
}
#elif defined(_WIN32)
#include <sys/timeb.h>
@ -591,9 +525,7 @@ Yap_walltime(void)
static LARGE_INTEGER Frequency;
/* store user time in this variable */
void
Yap_InitWTime (void)
{
void Yap_InitWTime(void) {
LARGE_INTEGER ElapsedNanoseconds;
QueryPerformanceFrequency(&Frequency);
QueryPerformanceCounter(&ElapsedNanoseconds);
@ -602,11 +534,7 @@ Yap_InitWTime (void)
Yap_StartOfWTimes = (uint64_t)ElapsedNanoseconds.QuadPart;
}
uint64_t
Yap_walltime (void)
{
uint64_t Yap_walltime(void) {
LARGE_INTEGER ElapsedNanoseconds;
QueryPerformanceCounter(&ElapsedNanoseconds);
//
@ -625,33 +553,22 @@ Yap_walltime (void)
#elif HAVE_TIMES
/* store user time in this variable */
void
Yap_InitWTime (void)
{
void Yap_InitWTime(void) {
// start thread 0
REMOTE_LastWTime(0) =
Yap_StartOfWTimes = ((uint64_t)times(NULL))*10000000/TicksPerSec;
REMOTE_LastWTime(0) = Yap_StartOfWTimes =
((uint64_t)times(NULL)) * 10000000 / TicksPerSec;
}
uint64_t
Yap_walltime (void)
{
uint64_t Yap_walltime(void) {
clock_t t;
t = times(NULL);
return = ((uint64_t)times(NULL)) * 10000000 / TicksPerSec;
}
#endif /* HAVE_TIMES */
void
Yap_ReInitWTime (void)
{
Yap_InitWTime();
}
void Yap_ReInitWTime(void) { Yap_InitWTime(); }
void
Yap_InitTimePreds(void)
{
void Yap_InitTimePreds(void) {
/* can only do after heap is initialized */
Yap_InitWTime();
}

69
os/writeterm.c
View File

@ -88,7 +88,6 @@ static char SccsId[] = "%W% %G%";
#endif
#include "iopreds.h"
static Term readFromBuffer(const char *s, Term opts) {
Term rval;
int sno;
@ -291,21 +290,20 @@ end:
/**
*
*/
bool Yap_WriteTerm( int output_stream, Term t, Term opts USES_REGS)
{
xarg *args = Yap_ArgListToVector( opts, write_defs, WRITE_END);
bool Yap_WriteTerm(int output_stream, Term t, Term opts USES_REGS) {
xarg *args = Yap_ArgListToVector(opts, write_defs, WRITE_END);
if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, t, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -316,7 +314,7 @@ static Int write_term2(USES_REGS1) {
/* '$write'(+Flags,?Term) */
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
return Yap_WriteTerm( LOCAL_c_output_stream, ARG1, ARG2 PASS_REGS);
return Yap_WriteTerm(LOCAL_c_output_stream, ARG1, ARG2 PASS_REGS);
}
static Int write_term3(USES_REGS1) {
@ -325,7 +323,7 @@ static Int write_term3(USES_REGS1) {
if (output_stream < 0) {
return false;
}
return Yap_WriteTerm( output_stream, ARG2, ARG3 PASS_REGS);
return Yap_WriteTerm(output_stream, ARG2, ARG3 PASS_REGS);
}
static Int write2(USES_REGS1) {
@ -343,7 +341,7 @@ static Int write2(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
mySlots = Yap_StartSlots();
@ -351,7 +349,7 @@ static Int write2(USES_REGS1) {
args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -369,7 +367,7 @@ static Int write1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -378,7 +376,7 @@ static Int write1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -396,7 +394,7 @@ static Int write_canonical1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -407,7 +405,7 @@ static Int write_canonical1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -422,12 +420,12 @@ static Int write_canonical(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0) {
free( args );
free(args);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -437,7 +435,7 @@ static Int write_canonical(USES_REGS1) {
args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -452,13 +450,13 @@ static Int writeq1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) {
free( args );
free(args);
output_stream = 1;
}
args[WRITE_NUMBERVARS].used = true;
@ -467,7 +465,7 @@ static Int writeq1(USES_REGS1) {
args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -482,12 +480,12 @@ static Int writeq(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0) {
free( args );
free(args);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -497,7 +495,7 @@ static Int writeq(USES_REGS1) {
args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -512,13 +510,13 @@ static Int print1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) {
free( args );
free(args);
output_stream = 1;
}
args[WRITE_PORTRAY].used = true;
@ -528,7 +526,7 @@ static Int print1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -543,12 +541,12 @@ static Int print(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0) {
free( args );
free(args);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -558,7 +556,7 @@ static Int print(USES_REGS1) {
args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -574,7 +572,7 @@ static Int writeln1(USES_REGS1) {
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) {
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -585,7 +583,7 @@ static Int writeln1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -598,13 +596,13 @@ static Int writeln(USES_REGS1) {
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) {
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "writeln/2");
if (output_stream < 0) {
free( args );
return false;
free(args);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
args[WRITE_NL].used = true;
@ -613,7 +611,7 @@ return false;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -676,7 +674,6 @@ static Int dollar_var(USES_REGS1) {
return Yap_unify(tv, ARG2);
}
static Int term_to_string(USES_REGS1) {
Term t2 = Deref(ARG2), rc = false, t1 = Deref(ARG1);
const char *s;

60
packages/python/pandas.yap
View File

@ -1,7 +1,61 @@
%matplotlib inline
import numpy as np
import seaborn as sns
import matplotlib.pyplot as plt
sns.set(style="white", context="talk")
rs = np.random.RandomState(7)
:- use_module( library(python) ).
pos={0:(0,0),
1:(1,0),
2:(0,1),
3:(1,1),
4:(0.1,0.9),
5:(0.3,1.1),
6:(0.9,0.9)
}
:- := import(pandas)).
names={4:'MMM',
5:'XXX',
6:'ZZZ'}
pred2panda(Pred, Obj) :-
def plot1(y10,y20):
def gen(f,f0):
return [f[0],f[1],-f[2]]/max(f,f0)
ax1 = plt.subplot2grid((1,2), (0,0), colspan=2)
ax2 = plt.subplot2grid((1,2), (0,1), colspan=2)
ax3 = plt.subplot2grid((2,2), (2,0), colspan=2, rowspan=2)
xs = ["+-","++","--"]
y1 = gen(y10, y20)
sns.barplot(xs, y1, palette="RdBu_r", ax=ax1)
y2 = gen(y20,y10)
sns.barplot(xs, y2, palette="Set3", ax=ax2)
# Finalize the plot
# sns.despine(bottom=True)
G=nx.Graph()
i=0
G.pos={} # location
G.pop={} # size
lpos={0:(0,0),1:(0,0),2:(0,0),3:(0,0)}
last=len(pos)-1
for i in range(4,len(pos)):
G.pos[i]=pos[i]
G.pop[i]=2000
(x,y) = pos[i]
lpos[i] = (x,y-0.05)
if i > 4:
G.add_edge(i-1,i)
else:
G.add_edge(2,i)
G.add_edge(3,last)
nx.draw_networkx_nodes(G,pos,nodelist=range(4,len(pos)),ax=ax3)
nx.draw_networkx_nodes(G,pos,nodelist=[0,1,2,3],node_color='b',ax=ax3)
nx.draw_networkx_edges(G,pos,alpha=0.5,ax=ax3)
nx.draw_networkx_labels(G,lpos,names,alpha=0.5,ax=ax3)
plt.axis('off')
plt.tight_layout(h_pad=3)
plt.savefig("house_with_colors.png") # save as png
plot1([20,30,10],[30,30,5])

3
packages/python/python.h
View File

@ -39,6 +39,8 @@ extern PyObject *py_F2P;
extern bool python_in_python;
#define PythonReturn PyGILState_Release(gstate) && return
static inline Py_ssize_t get_p_int(PyObject *o, Py_ssize_t def) {
if (o == NULL)
return def;
@ -94,7 +96,6 @@ static inline PyObject *atom_to_python_string(term_t t) {
extern PyObject *compound_to_pyeval(term_t t, functor_t fun);
extern PyObject *compound_to_pytree(term_t t, functor_t fun);
extern PyObject *yap_to_python(YAP_Term t, bool eval);
extern PyObject *term_to_python(term_t t, bool eval);
extern foreign_t python_to_ptr(PyObject *pVal, term_t t);

4
packages/python/yap_kernel/yap_kernel.py
View File

@ -138,9 +138,9 @@ class YAPKernel(KernelBase):
implementation = 'YAP'
implementation_version = release.version
language_info = {
'name': 'python',
'name': 'prolog',
'version': sys.version.split()[0],
'mimetype': 'text/x-python',
'mimetype': 'text/x-prolog',
'codemirror_mode': {
'name': 'prolog',
'version': sys.version_info[0]

76
packages/raptor/raptor_yap.c
View File

@ -15,22 +15,22 @@
* Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301, USA.
*/
#include <stdio.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "raptor_config.h"
#include "YapInterface.h"
#include "raptor_config.h"
#ifdef HAVE_RAPTOR2_RAPTOR2_H
#include "raptor2/raptor2.h"
#else
#include "raptor2.h"
#endif
void raptor_yap_init (void);
void raptor_yap_init(void);
raptor_world* world;
raptor_world *world;
struct exo_aux {
YAP_Functor functor;
@ -38,25 +38,26 @@ struct exo_aux {
size_t n;
};
static YAP_Atom
term_load(const raptor_term *term)
{
static YAP_Atom term_load(const raptor_term *term) {
size_t len;
switch(term->type) {
switch (term->type) {
case RAPTOR_TERM_TYPE_LITERAL:
// fprintf(stderr, "%s,", term->value.literal.string);
// fprintf(stderr, "%s,", term->value.literal.string);
return YAP_LookupAtom((const char *)term->value.literal.string);
case RAPTOR_TERM_TYPE_BLANK:
// fprintf(stderr, "%s,", term->value.blank.string);
// fprintf(stderr, "%s,", term->value.blank.string);
return YAP_LookupAtom((const char *)term->value.blank.string);
case RAPTOR_TERM_TYPE_URI:
// fprintf(stderr, "%s,", raptor_uri_as_counted_string(term->value.uri, &len));
return YAP_LookupAtom((const char *)raptor_uri_as_counted_string(term->value.uri, &len));
// fprintf(stderr, "%s,",
// raptor_uri_as_counted_string(term->value.uri, &len));
return YAP_LookupAtom(
(const char *)raptor_uri_as_counted_string(term->value.uri, &len));
case RAPTOR_TERM_TYPE_UNKNOWN:
default:
raptor_log_error_formatted(term->world, RAPTOR_LOG_LEVEL_ERROR, NULL,
"Triple has unsupported term type %d",
term->type);
@ -68,42 +69,36 @@ term_load(const raptor_term *term)
static int so_far = 0;
static void
load_triples(void* user_data, raptor_statement* triple)
{
struct exo_aux *aux = (struct exo_aux *) user_data;
static void load_triples(void *user_data, raptor_statement *triple) {
struct exo_aux *aux = (struct exo_aux *)user_data;
YAP_Term args[4];
//args[0] = (YAP_CELL)aux->functor;
// args[0] = (YAP_CELL)aux->functor;
args[0] = YAP_MkAtomTerm(term_load(triple->subject));
args[1] = YAP_MkAtomTerm(term_load(triple->predicate));
args[2] = YAP_MkAtomTerm(term_load(triple->object));
// fprintf(stderr, "\n");
// fprintf(stderr, "\n");
YAP_AssertTuples( aux->pred, args, so_far++, 1 );
YAP_AssertTuples(aux->pred, args, so_far++, 1);
}
static void
count_triples(void* user_data, raptor_statement* triple)
{
unsigned int* count_p = (unsigned int*)user_data;
static void count_triples(void *user_data, raptor_statement *triple) {
unsigned int *count_p = (unsigned int *)user_data;
(*count_p)++;
term_load(triple->subject);
term_load(triple->predicate);
term_load(triple->object);
// fprintf(stderr, "\n");
// fprintf(stderr, "\n");
}
static YAP_Bool
load(void)
{
static YAP_Bool load(void) {
YAP_Term tfn = YAP_ARG1;
YAP_Term mod = YAP_ARG2;
YAP_Term tfunctor = YAP_ARG3;
const char *filename;
raptor_parser* rdf_parser = NULL;
raptor_parser *rdf_parser = NULL;
unsigned int count;
unsigned char *uri_string;
raptor_uri *uri, *base_uri;
@ -123,8 +118,8 @@ load(void)
base_uri = raptor_uri_copy(uri);
count = 0;
if(!raptor_parser_parse_file(rdf_parser, uri, base_uri)) {
// fprintf(stderr, "%s : %d triples\n", filename, count);
if (!raptor_parser_parse_file(rdf_parser, uri, base_uri)) {
// fprintf(stderr, "%s : %d triples\n", filename, count);
} else {
fprintf(stderr, "%s : failed to parse\n", filename);
return FALSE;
@ -136,17 +131,17 @@ load(void)
size_t sz;
aux.functor = YAP_MkFunctor(YAP_AtomOfTerm(tfunctor), 3);
aux.pred = YAP_FunctorToPredInModule( aux.functor, mod );
sz = 3*sizeof(YAP_CELL)*count;
aux.pred = YAP_FunctorToPredInModule(aux.functor, mod);
sz = 3 * sizeof(YAP_CELL) * count;
if (!YAP_NewExo( aux.pred, sz, NULL)){
if (!YAP_NewExo(aux.pred, sz, NULL)) {
fprintf(stderr, "Failed to alocate space\n");
return FALSE;
}
aux.n = 0;
raptor_parser_set_statement_handler(rdf_parser, (void *) &aux, load_triples);
if(!raptor_parser_parse_file(rdf_parser, uri, base_uri)) {
raptor_parser_set_statement_handler(rdf_parser, (void *)&aux, load_triples);
if (!raptor_parser_parse_file(rdf_parser, uri, base_uri)) {
fprintf(stderr, "%s : %d triples\n", filename, count);
}
}
@ -160,16 +155,13 @@ load(void)
return TRUE;
}
static inline void
raptor_yap_halt (int exit, void* world)
{
raptor_free_world((raptor_world*) world);
static inline void raptor_yap_halt(int exit, void *world) {
raptor_free_world((raptor_world *)world);
}
void raptor_yap_init (void)
{
void raptor_yap_init(void) {
world = raptor_new_world();
YAP_HaltRegisterHook (raptor_yap_halt, (void *) world);
YAP_HaltRegisterHook(raptor_yap_halt, (void *)world);
YAP_UserCPredicate("rdf_load", load, 3);
}

44
pl/dbload.yap
View File

@ -27,41 +27,16 @@
:- dynamic dbloading/6, dbprocess/2.
dbload_from_stream(R, M0, Type) :-
repeat,
read(R,T),
( T == end_of_file -> !, close_dbload(R, Type);
dbload_count(T, M0),
fail
).
close_dbload(_R, exo) :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
exo_db_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
close_dbload(R, exo) :-
seek(R, 0, bof, _),
exodb_add_facts(R, _M),
fail.
close_dbload(_R, mega) :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
dbload_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
close_dbload(R, mega) :-
seek(R, 0, bof, _),
dbload_add_facts(R, _M),
fail.
close_dbload(_, _) :-
retractall(dbloading(_Na,_Arity,_M,_T,_NaAr,_Handle)),
fail.
close_dbload(_, _).
dbload_from_stream(R, M0, rdf, term ) :-
'$lines_in_file'(R, Lines),
'$input_lines'(R, Type, Lines),
dbload_from_stream(R, M0, Type, Storage ) :-
'$lines_in_file'(R, Lines),
'$input_lines'(R, Type, Lines),
'$input_lines'(R, csv, yeLines ) :-
'$process_lines'(R, Lines, Type ),
close(R).
prolog:load_db(Fs) :-
'$current_module'(M0),
@ -199,4 +174,3 @@ clean_up :-
retractall(dbprocess(_,_)),
fail.
clean_up.

5
pl/signals.yap
View File

@ -191,9 +191,8 @@ order of dispatch.
'$continue_signals',
'$hacks':'$stack_dump',
'$execute0'(G,M).
'$do_signal'(sig_fpe, [_M|_G]) :-
'$fpe_error'.
% Unix signals
'$do_signal'(sig_fpe,G) :-
'$signal_handler'(sig_fpe, G)
'$do_signal'(sig_alarm, G) :-
'$signal_handler'(sig_alarm, G).
'$do_signal'(sig_vtalarm, G) :-