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

less invasive error handling

Browse Source
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(); saveregs();
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS); d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
setregs(); setregs();
if (d0 == 0L) {
saveregs();
Yap_PreProcessedError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
setregs();
FAIL();
}
} }
XREG(PREG->y_u.xxx.x) = d0; XREG(PREG->y_u.xxx.x) = d0;
PREG = NEXTOP(PREG, xxx); PREG = NEXTOP(PREG, xxx);

51
C/atomic.c
View File

@ -527,18 +527,23 @@ static Int number_chars(USES_REGS1) {
restart_aux: restart_aux:
t1 = Deref(ARG1); t1 = Deref(ARG1);
if (IsNumTerm(t1)) { if (IsNumTerm(t1)) {
Term tf; Term t2 = Deref(ARG2);
tf = Yap_NumberToListOfAtoms(t1 PASS_REGS); if (IsVarTerm(t2)) {
if (tf) { t1 = Yap_NumberToListOfAtoms(t1 PASS_REGS);
LOCAL_Error_TYPE = YAP_NO_ERROR; }
return Yap_unify(ARG2, tf); 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)) { } else if (IsVarTerm(t1)) {
/* ARG1 unbound */ /* ARG1 unbound */
Term t = Deref(ARG2); Term t = Deref(ARG2);
Term tf = Yap_ListToNumber(t PASS_REGS); Term tf = Yap_ListToNumber(t PASS_REGS);
if (tf) { if (tf) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return Yap_unify(ARG1, tf); return Yap_unify(ARG1, tf);
} }
} else if (IsVarTerm(t1)) { } else if (IsVarTerm(t1)) {
@ -556,15 +561,24 @@ static Int number_atom(USES_REGS1) {
restart_aux: restart_aux:
t1 = Deref(ARG1); t1 = Deref(ARG1);
if (IsNumTerm(t1)) { if (IsNumTerm(t1)) {
Term t2 = Deref(ARG2);
Atom af; Atom af;
af = Yap_NumberToAtom(t1 PASS_REGS); af = Yap_NumberToAtom(t1 PASS_REGS);
if (af) if (af) {
return Yap_unify(ARG2, MkAtomTerm(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)) { } else if (IsVarTerm(t1)) {
/* ARG1 unbound */ /* ARG1 unbound */
Term t = Deref(ARG2); Term t = Deref(ARG2);
Term tf = Yap_AtomToNumber(t PASS_REGS); Term tf = Yap_AtomToNumber(t PASS_REGS);
if (tf)
return Yap_unify(ARG1, tf); return Yap_unify(ARG1, tf);
} else if (IsVarTerm(t1)) { } else if (IsVarTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
@ -634,8 +648,8 @@ restart_aux:
i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); i = IntOfTerm(EXTRA_CBACK_ARG(3, 1));
max = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); max = IntOfTerm(EXTRA_CBACK_ARG(3, 2));
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1);
if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS) && LOCAL_Error_TYPE == if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS) &&
YAP_NO_ERROR) { LOCAL_Error_TYPE == YAP_NO_ERROR) {
cut_fail(); cut_fail();
} else { } else {
if (i < max) if (i < max)
@ -684,7 +698,6 @@ restart_aux:
return cont_atom_concat3(PASS_REGS1); return cont_atom_concat3(PASS_REGS1);
} else { } else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
at = NULL; at = NULL;
} }
if (at) { if (at) {
@ -704,7 +717,6 @@ restart_aux:
cut_fail(); cut_fail();
} }
#define CastToNumeric(x) CastToNumeric__(x PASS_REGS) #define CastToNumeric(x) CastToNumeric__(x PASS_REGS)
static Term CastToNumeric__(Atom at USES_REGS) { static Term CastToNumeric__(Atom at USES_REGS) {
@ -772,7 +784,6 @@ restart_aux:
return cont_atomic_concat3(PASS_REGS1); return cont_atomic_concat3(PASS_REGS1);
} else { } else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
at = NULL; at = NULL;
} }
if (at) { if (at) {
@ -849,7 +860,6 @@ restart_aux:
return cont_string_concat3(PASS_REGS1); return cont_string_concat3(PASS_REGS1);
} else { } else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
at = NULL; at = NULL;
} }
if (tf) { if (tf) {
@ -913,10 +923,8 @@ restart_aux:
t2 = Deref(ARG2); t2 = Deref(ARG2);
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t2;
} else if (!IsStringTerm(t2)) { } else if (!IsStringTerm(t2)) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING; LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_Error_Term = t2;
} else { } else {
s = UStringOfTerm(t2); s = UStringOfTerm(t2);
t1 = Deref(ARG1); t1 = Deref(ARG1);
@ -926,7 +934,6 @@ restart_aux:
return cont_string_code3(PASS_REGS1); return cont_string_code3(PASS_REGS1);
} else if (!IsIntegerTerm(t1)) { } else if (!IsIntegerTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; LOCAL_Error_TYPE = TYPE_ERROR_INTEGER;
LOCAL_Error_Term = t1;
} else { } else {
const unsigned char *ns = s; const unsigned char *ns = s;
utf8proc_int32_t chr; utf8proc_int32_t chr;
@ -934,7 +941,6 @@ restart_aux:
if (indx <= 0) { if (indx <= 0) {
if (indx < 0) { if (indx < 0) {
LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
LOCAL_Error_Term = t1;
} }
cut_fail(); cut_fail();
} }
@ -970,19 +976,16 @@ restart_aux:
t2 = Deref(ARG2); t2 = Deref(ARG2);
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t2;
} else if (!IsStringTerm(t2)) { } else if (!IsStringTerm(t2)) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING; LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_Error_Term = t2;
} else { } else {
s = UStringOfTerm(t2); s = UStringOfTerm(t2);
t1 = Deref(ARG1); t1 = Deref(ARG1);
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
} else if (!IsIntegerTerm(t1)) { } else if (!IsIntegerTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; LOCAL_Error_TYPE = TYPE_ERROR_INTEGER;
LOCAL_Error_Term = t1;
} else { } else {
const unsigned char *ns = s; const unsigned char *ns = s;
utf8proc_int32_t chr; utf8proc_int32_t chr;
@ -991,7 +994,6 @@ restart_aux:
if (indx <= 0) { if (indx <= 0) {
if (indx < 0) { if (indx < 0) {
LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
LOCAL_Error_Term = t1;
} else { } else {
return false; 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); src = skip_utf8((unsigned char *)src, min);
const unsigned char *cp = src; const unsigned char *cp = src;
LOCAL_TERM_ERROR(t, 4 * (len + 1));
buf = buf_from_tstring(HR); buf = buf_from_tstring(HR);
while (len) { while (len) {
utf8proc_int32_t chr; 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[0] = MkAtomTerm(AbsAtom(ap));
ti[1] = MkIntegerTerm(Arity); ti[1] = MkIntegerTerm(Arity);
t = Yap_MkApplTerm(FunctorSlash, 2, ti); t = Yap_MkApplTerm(FunctorSlash, 2, ti);
LOCAL_ErrorMessage = LOCAL_ErrorSay;
LOCAL_Error_Term = t;
LOCAL_Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE; LOCAL_Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
if (in_use) { if (in_use) {
if (Arity == 0) if (Arity == 0)
@ -2028,9 +2026,7 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
} }
if (LOCAL_ErrorMessage) { if (LOCAL_ErrorMessage) {
if (!LOCAL_Error_Term) Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
LOCAL_Error_Term = TermNil;
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
return false; return false;
} }
@ -3590,7 +3586,8 @@ static Int p_predicate_erased_statistics(USES_REGS1) {
Term tpred = ArgOfTerm(2, Deref(ARG1)); Term tpred = ArgOfTerm(2, Deref(ARG1));
Term tmod = ArgOfTerm(1, 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; return FALSE;
while (cl) { while (cl) {
if (cl->ClPred == pe) { if (cl->ClPred == pe) {

322
C/cmppreds.c
View File

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

66
C/errors.c
View File

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

207
C/eval.c
View File

@ -27,11 +27,10 @@ static char SccsId[] = "%W% %G%";
@ingroup arithmetic @ingroup arithmetic
*/ */
#include "Yap.h" #include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"
#include "Yatom.h"
#include "eval.h" #include "eval.h"
#if HAVE_STDARG_H #if HAVE_STDARG_H
#include <stdarg.h> #include <stdarg.h>
@ -46,9 +45,7 @@ static char SccsId[] = "%W% %G%";
static Term Eval(Term t1 USES_REGS); static Term Eval(Term t1 USES_REGS);
static Term static Term get_matrix_element(Term t1, Term t2 USES_REGS) {
get_matrix_element(Term t1, Term t2 USES_REGS)
{
if (!IsPairTerm(t2)) { if (!IsPairTerm(t2)) {
if (t2 == MkAtomTerm(AtomLength)) { if (t2 == MkAtomTerm(AtomLength)) {
Int sz = 1; Int sz = 1;
@ -93,12 +90,10 @@ get_matrix_element(Term t1, Term t2 USES_REGS)
return Eval(t1 PASS_REGS); return Eval(t1 PASS_REGS);
} }
static Term static Term Eval(Term t USES_REGS) {
Eval(Term t USES_REGS)
{
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic"); return Yap_ArithError(INSTANTIATION_ERROR, t, "in arithmetic");
} else if (IsNumTerm(t)) { } else if (IsNumTerm(t)) {
return t; return t;
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
@ -114,7 +109,7 @@ Eval(Term t USES_REGS)
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
if (fun == FunctorString) { if (fun == FunctorString) {
const char *s = (const char*)StringOfTerm(t); const char *s = (const char *)StringOfTerm(t);
if (s[1] == '\0') if (s[1] == '\0')
return MkIntegerTerm(s[0]); return MkIntegerTerm(s[0]);
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, return Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
@ -131,7 +126,7 @@ Eval(Term t USES_REGS)
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t), return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
"functor %s/%d for arithmetic expression", "functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,n); RepAtom(name)->StrOfAE, n);
} }
if (p->FOfEE == op_power && p->ArityOfEE == 2) { if (p->FOfEE == op_power && p->ArityOfEE == 2) {
t2 = ArgOfTerm(2, t); t2 = ArgOfTerm(2, t);
@ -140,7 +135,7 @@ Eval(Term t USES_REGS)
} }
} }
*RepAppl(t) = (CELL)AtomFoundVar; *RepAppl(t) = (CELL)AtomFoundVar;
t1 = Eval(ArgOfTerm(1,t) PASS_REGS); t1 = Eval(ArgOfTerm(1, t) PASS_REGS);
if (t1 == 0L) { if (t1 == 0L) {
*RepAppl(t) = (CELL)fun; *RepAppl(t) = (CELL)fun;
return FALSE; return FALSE;
@ -149,39 +144,36 @@ Eval(Term t USES_REGS)
*RepAppl(t) = (CELL)fun; *RepAppl(t) = (CELL)fun;
return Yap_eval_unary(p->FOfEE, t1); 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; *RepAppl(t) = (CELL)fun;
if (t2 == 0L) if (t2 == 0L)
return FALSE; 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) { if (TailOfTerm(t) != TermNil) {
return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, 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); return Eval(HeadOfTerm(t) PASS_REGS);
} }
} }
Term Term Yap_InnerEval__(Term t USES_REGS) { return Eval(t PASS_REGS); }
Yap_InnerEval__(Term t USES_REGS)
{
return Eval(t PASS_REGS);
}
#ifdef BEAM #ifdef BEAM
Int BEAM_is(void); Int BEAM_is(void);
Int Int BEAM_is(void) { /* X is Y */
BEAM_is(void)
{ /* X is Y */
union arith_ret res; union arith_ret res;
blob_type bt; blob_type bt;
bt = Eval(Deref(XREGS[2]), &res); bt = Eval(Deref(XREGS[2]), &res);
if (bt==db_ref_e) return (NULL); if (bt == db_ref_e)
return (EvalToTerm(bt,&res)); return (NULL);
return (EvalToTerm(bt, &res));
} }
#endif #endif
@ -197,21 +189,20 @@ X is 2+3*4
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
succeeds with `X = 14`. 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 /// @memberof is/2
static Int static Int p_is(USES_REGS1) { /* X is Y */
p_is( USES_REGS1 )
{ /* X is Y */
Term out; Term out;
yap_error_number err; yap_error_number err;
Term t = Deref(ARG2); Term t = Deref(ARG2);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_EvalError(INSTANTIATION_ERROR,t, "X is Y"); Yap_EvalError(INSTANTIATION_ERROR, t, "X is Y");
return(FALSE); return (FALSE);
} }
Yap_ClearExs(); Yap_ClearExs();
do { do {
@ -225,11 +216,11 @@ p_is( USES_REGS1 )
return FALSE; return FALSE;
} }
} else { } else {
Yap_EvalError(err, takeIndicator( ARG2 ), "X is Exp"); Yap_EvalError(err, takeIndicator(ARG2), "X is Exp");
return FALSE; return FALSE;
} }
} while (TRUE); } 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 /// @memberof isnan/1
static Int static Int p_isnan(USES_REGS1) { /* X isnan Y */
p_isnan( USES_REGS1 )
{ /* X isnan Y */
Term out = 0L; Term out = 0L;
while (!(out = Eval(Deref(ARG1) PASS_REGS))) { while (!(out = Eval(Deref(ARG1) PASS_REGS))) {
if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) { if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, CP)) { 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; return FALSE;
} }
} else { } else {
Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
return FALSE; return FALSE;
} }
} }
@ -274,9 +263,7 @@ p_isnan( USES_REGS1 )
*/ */
/// @memberof isnan/1 /// @memberof isnan/1
static Int static Int p_isinf(USES_REGS1) { /* X is Y */
p_isinf( USES_REGS1 )
{ /* X is Y */
Term out = 0L; Term out = 0L;
while (!(out = Eval(Deref(ARG1) PASS_REGS))) { while (!(out = Eval(Deref(ARG1) PASS_REGS))) {
@ -287,7 +274,7 @@ p_isinf( USES_REGS1 )
return FALSE; return FALSE;
} }
} else { } else {
Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
return FALSE; return FALSE;
} }
} }
@ -312,9 +299,7 @@ True if _Log1_ is the logarithm of the positive number _A1_,
*/ */
/// @memberof logsum/3 /// @memberof logsum/3
static Int static Int p_logsum(USES_REGS1) { /* X is Y */
p_logsum( USES_REGS1 )
{ /* X is Y */
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2); Term t2 = Deref(ARG2);
int done = FALSE; int done = FALSE;
@ -341,7 +326,7 @@ p_logsum( USES_REGS1 )
return FALSE; return FALSE;
} }
} else { } else {
Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
return FALSE; return FALSE;
} }
} }
@ -369,81 +354,66 @@ p_logsum( USES_REGS1 )
return FALSE; return FALSE;
} }
} else { } else {
Yap_EvalError(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage); Yap_EvalError(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
return FALSE; return FALSE;
} }
} }
} }
} }
if (f1 >= f2) { if (f1 >= f2) {
Float fi = exp(f2-f1); Float fi = exp(f2 - f1);
return Yap_unify(ARG3,MkFloatTerm(f1+log(1+fi))); return Yap_unify(ARG3, MkFloatTerm(f1 + log(1 + fi)));
} else { } else {
Float fi = exp(f1-f2); Float fi = exp(f1 - f2);
return Yap_unify(ARG3,MkFloatTerm(f2+log(1+fi))); return Yap_unify(ARG3, MkFloatTerm(f2 + log(1 + fi)));
} }
} }
Int Yap_ArithError__(const char *file, const char *function, int lineno,
Int yap_error_number type, Term where, ...) {
Yap_ArithError__(const char *file, const char *function, int lineno, yap_error_number type, Term where,...)
{
CACHE_REGS CACHE_REGS
va_list ap; va_list ap;
char *format; char *format;
char buf[MAX_ERROR_MSG_SIZE];
if (LOCAL_ArithError)
return 0L;
LOCAL_ArithError = TRUE;
LOCAL_Error_TYPE = type; LOCAL_Error_TYPE = type;
LOCAL_Error_File = file; LOCAL_Error_File = file;
LOCAL_Error_Function = function; LOCAL_Error_Function = function;
LOCAL_Error_Lineno = lineno; LOCAL_Error_Lineno = lineno;
LOCAL_Error_Term = where; va_start(ap, 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);
format = va_arg(ap, char *); format = va_arg(ap, char *);
if (format != NULL) { if (format != NULL) {
#if HAVE_VSNPRINTF #if HAVE_VSNPRINTF
(void) vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, format, ap); (void)vsnprintf(buf, MAX_ERROR_MSG_SIZE, format, ap);
#else #else
(void) vsprintf(LOCAL_ErrorMessage, format, ap); (void)vsprintf(buf, format, ap);
#endif #endif
} else { } else {
LOCAL_ErrorMessage[0] = '\0'; buf[0] = '\0';
} }
va_end (ap); va_end(ap);
return Yap_Error__(file, function, lineno, type, where, LOCAL_ErrorMessage); 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 /// @memberof between/3
static Int cont_between( USES_REGS1 ) static Int cont_between(USES_REGS1) {
{ Term t1 = EXTRA_CBACK_ARG(3, 1);
Term t1 = EXTRA_CBACK_ARG(3,1); Term t2 = EXTRA_CBACK_ARG(3, 2);
Term t2 = EXTRA_CBACK_ARG(3,2);
Yap_unify(ARG3, t1); Yap_unify(ARG3, t1);
if (IsIntegerTerm(t1)) { if (IsIntegerTerm(t1)) {
@ -475,7 +444,7 @@ static Int cont_between( USES_REGS1 )
cut_succeed(); cut_succeed();
i1 = IntegerOfTerm(t1); i1 = IntegerOfTerm(t1);
tn = add_int(i1, 1 PASS_REGS); tn = add_int(i1, 1 PASS_REGS);
EXTRA_CBACK_ARG(3,1) = tn; EXTRA_CBACK_ARG(3, 1) = tn;
HB = B->cp_h = HR; HB = B->cp_h = HR;
return TRUE; return TRUE;
} else { } else {
@ -489,16 +458,14 @@ static Int cont_between( USES_REGS1 )
t[0] = t1; t[0] = t1;
t[1] = MkIntTerm(1); t[1] = MkIntTerm(1);
tn = Eval(Yap_MkApplTerm(FunctorPlus, 2, t) PASS_REGS); 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; HB = B->cp_h = HR;
return TRUE; return TRUE;
} }
} }
/// @memberof between/3 /// @memberof between/3
static Int static Int init_between(USES_REGS1) {
init_between( USES_REGS1 )
{
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2); Term t2 = Deref(ARG2);
@ -510,14 +477,11 @@ init_between( USES_REGS1 )
Yap_EvalError(INSTANTIATION_ERROR, t1, "between/3"); Yap_EvalError(INSTANTIATION_ERROR, t1, "between/3");
return FALSE; return FALSE;
} }
if (!IsIntegerTerm(t1) && if (!IsIntegerTerm(t1) && !IsBigIntTerm(t1)) {
!IsBigIntTerm(t1)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t1, "between/3"); Yap_EvalError(TYPE_ERROR_INTEGER, t1, "between/3");
return FALSE; return FALSE;
} }
if (!IsIntegerTerm(t2) && if (!IsIntegerTerm(t2) && !IsBigIntTerm(t2) && t2 != MkAtomTerm(AtomInf) &&
!IsBigIntTerm(t2) &&
t2 != MkAtomTerm(AtomInf) &&
t2 != MkAtomTerm(AtomInfinity)) { t2 != MkAtomTerm(AtomInfinity)) {
Yap_EvalError(TYPE_ERROR_INTEGER, t2, "between/3"); Yap_EvalError(TYPE_ERROR_INTEGER, t2, "between/3");
return FALSE; return FALSE;
@ -542,7 +506,8 @@ init_between( USES_REGS1 )
cut_fail(); cut_fail();
} }
} }
if (i1 > i2) cut_fail(); if (i1 > i2)
cut_fail();
if (i1 == i2) { if (i1 == i2) {
Yap_unify(ARG3, t1); Yap_unify(ARG3, t1);
cut_succeed(); cut_succeed();
@ -575,25 +540,25 @@ init_between( USES_REGS1 )
Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3"); Yap_EvalError(TYPE_ERROR_INTEGER, t3, "between/3");
return FALSE; 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_succeed();
cut_fail(); cut_fail();
} }
cmp = Yap_acmp(t1, t2 PASS_REGS); cmp = Yap_acmp(t1, t2 PASS_REGS);
if (cmp > 0) cut_fail(); if (cmp > 0)
cut_fail();
if (cmp == 0) { if (cmp == 0) {
Yap_unify(ARG3, t1); Yap_unify(ARG3, t1);
cut_succeed(); cut_succeed();
} }
} }
EXTRA_CBACK_ARG(3,1) = t1; EXTRA_CBACK_ARG(3, 1) = t1;
EXTRA_CBACK_ARG(3,2) = t2; EXTRA_CBACK_ARG(3, 2) = t2;
return cont_between( PASS_REGS1 ); return cont_between(PASS_REGS1);
} }
void void Yap_InitEval(void) {
Yap_InitEval(void)
{
/* here are the arithmetical predicates */ /* here are the arithmetical predicates */
Yap_InitConstExps(); Yap_InitConstExps();
Yap_InitUnaryExps(); 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 /* must be done here, otherwise siglongjmp will clobber all the
* registers * 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 /* reset the registers so that we don't have trash in abstract
* machine */ * machine */
Yap_set_fpu_exceptions( Yap_set_fpu_exceptions(
@ -2080,16 +2080,16 @@ static Int jump_env(USES_REGS1) {
LOCAL_Error_TYPE = ERROR_EVENT; LOCAL_Error_TYPE = ERROR_EVENT;
t = ArgOfTerm(1, t); t = ArgOfTerm(1, t);
if (IsApplTerm(t) && IsAtomTerm((t2 = ArgOfTerm(1, t)))) { if (IsApplTerm(t) && IsAtomTerm((t2 = ArgOfTerm(1, t)))) {
LOCAL_ActiveError.errorAsText = AtomOfTerm(t2); LOCAL_ActiveError->errorAsText = AtomOfTerm(t2);
LOCAL_ActiveError.classAsText = NameOfFunctor(FunctorOfTerm(t)); LOCAL_ActiveError->classAsText = NameOfFunctor(FunctorOfTerm(t));
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
LOCAL_ActiveError.errorAsText = AtomOfTerm(t); LOCAL_ActiveError->errorAsText = AtomOfTerm(t);
LOCAL_ActiveError.classAsText = NULL; LOCAL_ActiveError->classAsText = NULL;
} }
} else { } else {
LOCAL_Error_TYPE = THROW_EVENT; LOCAL_Error_TYPE = THROW_EVENT;
} }
LOCAL_ActiveError.prologPredName = NULL; LOCAL_ActiveError->prologPredName = NULL;
Yap_PutException(t); Yap_PutException(t);
bool out = JumpToEnv(PASS_REGS1); bool out = JumpToEnv(PASS_REGS1);
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE && if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
@ -2225,10 +2225,10 @@ bool Yap_PutException(Term t) {
} }
bool Yap_ResetException(int wid) { bool Yap_ResetException(int wid) {
if (REMOTE_BallTerm(wid)) { if (REMOTE_ActiveError(wid)->errorTerm) {
Yap_PopTermFromDB(REMOTE_BallTerm(wid)); Yap_PopTermFromDB(REMOTE_ActiveError(wid)->errorTerm);
} }
REMOTE_BallTerm(wid) = NULL; REMOTE_ActiveError(wid)->errorTerm = NULL;
return true; 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, args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END); PROLOG_FLAG_PROPERTY_END);
if (args == NULL) { if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false; return false;
} }
if (!IsAtomTerm(tflag)) { if (!IsAtomTerm(tflag)) {
@ -1533,7 +1533,7 @@ static Int do_create_prolog_flag(USES_REGS1) {
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs, args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END); PROLOG_FLAG_PROPERTY_END);
if (args == NULL) { if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false; return false;
} }
fv = GetFlagProp(AtomOfTerm(tflag)); 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) { if (out == NULL) {
const char *m_os = dlerror(); const char *m_os = dlerror();
if (m_os) { 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 { } else {
LOCAL_ErrorMessage = "dlopen failed"; LOCAL_ErrorMessage = "dlopen failed";
} }
@ -177,7 +178,8 @@ static Int LoadForeign(StringList ofiles, StringList libs, char *proc_name,
NULL) NULL)
#endif #endif
{ {
strcpy(LOCAL_ErrorSay, dlerror()); LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE);
strcpy(LOCAL_ErrorMessage, dlerror());
return LOAD_FAILLED; return LOAD_FAILLED;
} }
libs = libs->next; 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 */ /* dlopen wants to follow the LD_CONFIG_PATH */
const char *file = AtomName(ofiles->name); const char *file = AtomName(ofiles->name);
if (!Yap_findFile(file, NULL, NULL, LOCAL_FileNameBuf, true, YAP_OBJ, true, true)) { 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"); "%% Trying to open unexisting file in LoadForeign");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
@ -217,7 +220,7 @@ static Int LoadForeign(StringList ofiles, StringList libs, char *proc_name,
} }
if (!*init_proc) { if (!*init_proc) {
strcpy(LOCAL_ErrorSay, "Could not locate initialization routine"); LOCAL_ErrorMessage = "Could not locate initialization routine";
return LOAD_FAILLED; 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; s = (char *)RepAtom(AtomOfTerm(t))->StrOfAE;
if ((handle = Yap_LoadForeignFile(s, IntegerOfTerm(tflags)))==NULL) { 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; return FALSE;
} else { } else {
return Yap_unify(MkIntegerTerm((Int)handle),ARG3); 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; va_list ap;
if (LOCAL_toktide == LOCAL_tokptr) { if (LOCAL_toktide == LOCAL_tokptr) {
char out[YAP_FILENAME_MAX]; LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE+1);
va_start(ap, msg); va_start(ap, msg);
vsnprintf(out, YAP_FILENAME_MAX - 1, msg, ap); vsnprintf(LOCAL_ErrorMessage, YAP_FILENAME_MAX , msg, ap);
LOCAL_Error_Term = MkStringTerm( out );
LOCAL_Error_TYPE = SYNTAX_ERROR; LOCAL_Error_TYPE = SYNTAX_ERROR;
va_end(ap); 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) do_SYSTEM_ERROR_INTERNAL(yap_error_number etype, const char *msg)
{ {
CACHE_REGS CACHE_REGS
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE+1);
#if HAVE_SNPRINTF #if HAVE_SNPRINTF
#if HAVE_STRERROR #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 #else
snprintf(LOCAL_ErrorSay,MAX_ERROR_MSG_SIZE,"%s, (system error %d when reading %s)",msg,errno,LOCAL_FileNameBuf); snprintf(LOCAL_ErrorSay,MAX_ERROR_MSG_SIZE,"%s, (system error %d when reading %s)",msg,errno,LOCAL_FileNameBuf);
#endif #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); sprintf(LOCAL_ErrorSay,"%s, (system error %d when reading %s)",msg,errno,LOCAL_FileNameBuf);
#endif #endif
#endif #endif
LOCAL_ErrorMessage = LOCAL_ErrorSay;
LOCAL_Error_TYPE = etype; LOCAL_Error_TYPE = etype;
return -1; return -1;
} }
@ -685,8 +686,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap USES_REGS)
} }
} }
if (strcmp(pp, msg) != 0) { if (strcmp(pp, msg) != 0) {
LOCAL_ErrorMessage = LOCAL_ErrorSay; strncpy(LOCAL_ErrorMessage, "saved state ", MAX_ERROR_MSG_SIZE-1);
strncpy(LOCAL_ErrorMessage, "saved state ", MAX_ERROR_MSG_SIZE);
strncat(LOCAL_ErrorMessage, LOCAL_FileNameBuf, 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); strncat(LOCAL_ErrorMessage, " failed to match version ID", MAX_ERROR_MSG_SIZE-1);
LOCAL_Error_TYPE = SYSTEM_ERROR_SAVED_STATE; 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; ef->TokNext = NULL;
LOCAL_tokptr = tokptr; LOCAL_tokptr = tokptr;
LOCAL_toktide = e; LOCAL_toktide = e;
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = Yap_syntax_error(e, inp - GLOBAL_Stream);
LOCAL_Error_Term = Yap_syntax_error(e, inp - GLOBAL_Stream);
LOCAL_Error_TYPE = SYNTAX_ERROR; 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]; Term ts[2];
void *begin; void *begin;
if (pp->ArityOfPE == 0) { if (pp->ArityOfPE == 0) {
LOCAL_ActiveError.prologPredName = (Atom)pp->FunctorOfPred; LOCAL_ActiveError->prologPredName = (Atom)pp->FunctorOfPred;
LOCAL_ActiveError.prologPredArity = 0; LOCAL_ActiveError->prologPredArity = 0;
} else { } else {
LOCAL_ActiveError.prologPredName = NameOfFunctor(pp->FunctorOfPred); LOCAL_ActiveError->prologPredName = NameOfFunctor(pp->FunctorOfPred);
LOCAL_ActiveError.prologPredArity = pp->ArityOfPE; LOCAL_ActiveError->prologPredArity = pp->ArityOfPE;
} }
LOCAL_ActiveError.prologPredModule = LOCAL_ActiveError->prologPredModule =
(pp->ModuleOfPred ? pp->ModuleOfPred : TermProlog); (pp->ModuleOfPred ? pp->ModuleOfPred : TermProlog);
LOCAL_ActiveError.prologPredFile = pp->src.OwnerFile; LOCAL_ActiveError->prologPredFile = pp->src.OwnerFile;
if (codeptr->opc == UNDEF_OPCODE) { if (codeptr->opc == UNDEF_OPCODE) {
LOCAL_ActiveError.prologPredFirstLine = 0; LOCAL_ActiveError->prologPredFirstLine = 0;
LOCAL_ActiveError.prologPredLine = 0; LOCAL_ActiveError->prologPredLine = 0;
LOCAL_ActiveError.prologPredLastLine = 0; LOCAL_ActiveError->prologPredLastLine = 0;
return true; return true;
} else if (pp->cs.p_code.NOfClauses) { } else if (pp->cs.p_code.NOfClauses) {
if ((LOCAL_ActiveError.prologPredCl = if ((LOCAL_ActiveError->prologPredCl =
find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) { find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) {
LOCAL_ActiveError.prologPredLine = 0; LOCAL_ActiveError->prologPredLine = 0;
} else { } else {
LOCAL_ActiveError.prologPredLine = IntegerOfTerm(clause_loc(begin, pp)); LOCAL_ActiveError->prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
} }
if (pp->PredFlags & LogUpdatePredFlag) { if (pp->PredFlags & LogUpdatePredFlag) {
LOCAL_ActiveError.prologPredFirstLine = IntegerOfTerm( LOCAL_ActiveError->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc( ts[0] = clause_loc(
ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp)); 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), ts[1] = clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause),
pp)); pp));
} else { } else {
LOCAL_ActiveError.prologPredFirstLine = IntegerOfTerm( LOCAL_ActiveError->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc( ts[0] = clause_loc(
ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp)); 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), ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause),
pp)); 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) #define NAN (0.0 / 0.0)
#endif #endif
void *buf__, *cur__; #ifndef MAX_PATHHNAME
#define MAX_PATHHNAME 1024
#endif
#define init_alloc(I) \ void
void *ov__ = TR, *ocur__ = LOCAL_ScannerStack; \ Yap_InitTextAllocator( void )
if (!LOCAL_ScannerStack) \ {
LOCAL_ScannerStack = (char *)TR struct TextBuffer_manager *new = malloc(sizeof(struct TextBuffer_manager)+MAX_PATHHNAME*2 );
new->prev = NULL;
#define mark_stack() \ new->ptr = new->buf = (struct TextBuffer_manager *)new+1;
void *otr__ = TR; \ LOCAL_TextBuffer = new;
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;
} }
static Term Globalize(Term v USES_REGS) { 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; unsigned char *bufc = buf;
n = SkipListCodes(&bufc, &t, &r, atoms, widep, inp PASS_REGS); n = SkipListCodes(&bufc, &t, &r, atoms, widep, inp PASS_REGS);
if (n < 0) { if (n < 0) {
LOCAL_Error_TYPE = -n;
LOCAL_Error_Term = *r;
return NULL; return NULL;
} }
*lenp = n; *lenp = n;
@ -319,7 +288,6 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) {
YAP_STRING_BIG)) == inp->type) { YAP_STRING_BIG)) == inp->type) {
LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
} }
LOCAL_Error_Term = inp->val.t;
} }
} }
if (LOCAL_Error_TYPE != YAP_NO_ERROR) 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; s = (char *)s0;
else else
s = Malloc(0); 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) { 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); *lengp = strlen(s);
Malloc(*lengp); Malloc(*lengp);

39
CXX/yapi.cpp
View File

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

10
CXX/yapie.hh
View File

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

11
CXX/yapq.hh
View File

@ -183,9 +183,16 @@ public:
bool goalt(YAPTerm t); bool goalt(YAPTerm t);
/// current directory for the engine /// current directory for the engine
bool goal(Term t); bool goal(Term t);
#if SWIGPYTHON bool unlockedGoal(Term t) {bool rc;
bool unlockedGoal(Term t) {bool rc;Py_BEGIN_ALLOW_THREADS; rc = goal(t);Py_END_ALLOW_THREADS; return rc; } #ifdef SWIGPYTHON
Py_BEGIN_ALLOW_THREADS;
#endif #endif
rc = goal(t);
#ifdef SWIGPYTHON
Py_END_ALLOW_THREADS;
#endif
return rc;
}
/// reset Prolog state /// reset Prolog state
void reSet(); void reSet();
/// release: assune that there are no stack pointers, just release memory /// 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 ArenaOverflows =0L
Int DepthArenas =0 Int DepthArenas =0
int ArithError =FALSE
struct pred_entry* LastAssertedPred =NULL struct pred_entry* LastAssertedPred =NULL
struct pred_entry* TmpPred =NULL struct pred_entry* TmpPred =NULL
char* ScannerStack =NULL char* ScannerStack =NULL
@ -194,13 +193,10 @@ ADDR LocalBase void
ADDR GlobalBase void ADDR GlobalBase void
ADDR TrailBase void ADDR TrailBase void
ADDR TrailTop void ADDR TrailTop void
char* ErrorMessage void
Term Error_Term void
/** error handling info, designed to be easy to pass to the foreign world */ /* error handling info, designed to be easy to pass to the foreign world */
struct yap_error_descriptor ActiveError void yap_error_descriptor_t* ActiveError =calloc(sizeof(yap_error_descriptor_t),1)
/// pointer to an exception term, from throw /// pointer to an exception term, from throw
struct DB_TERM* BallTerm =NULL
jmp_buf IOBotch void jmp_buf IOBotch void
TokEntry* tokptr void TokEntry* tokptr void
@ -217,6 +213,8 @@ sigjmp_buf RestartEnv void
char FileNameBuf[YAP_FILENAME_MAX+1] void char FileNameBuf[YAP_FILENAME_MAX+1] void
char FileNameBuf2[YAP_FILENAME_MAX+1] void char FileNameBuf2[YAP_FILENAME_MAX+1] void
struct TextBuffer_manager* TextBuffer =Yap_InitTextAllocator()
// Prolog State // Prolog State
UInt BreakLevel =0 UInt BreakLevel =0
Int PrologMode =BootMode Int PrologMode =BootMode
@ -237,10 +235,8 @@ YAP_ULONG_LONG 2opcount[_std_top+1][_std_top+1] void
struct db_globs* s_dbg void struct db_globs* s_dbg void
//eval.c //eval.c
yap_error_number matherror =YAP_NO_ERROR
Term mathtt void Term mathtt void
char* mathstring =NULL char* mathstring =NULL
yap_error_number CurrentError =YAP_NO_ERROR
//grow.c //grow.c
int heap_overflows =0 int heap_overflows =0

42
H/YapText.h
View File

@ -31,6 +31,48 @@
#include "../utf8proc/utf8proc.h" #include "../utf8proc/utf8proc.h"
#include "Yap.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 types for tokenizer and write.c */
/****************** character definition table **************************/ /****************** 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 #define LIMITED_PREFETCH 1
#endif /* __x86_64__ */ #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 Y_IN_MEM 1
#define S_IN_MEM 1 #define S_IN_MEM 1
@ -2075,7 +2076,8 @@ cufail:
#endif #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, static int iequ_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt1) { register CELL *pt1) {
@ -2450,4 +2452,11 @@ extern yamop *headoftrace;
ENDD(d0); ENDD(d0);
#endif #endif
#define Yap_AsmError(e) \
{ \
saveregs(); \
Yap_Error(e, 0, ""); \
setregs(); \
}
#endif // ABSMI_H #endif // ABSMI_H

17
H/eval.h
View File

@ -375,6 +375,7 @@ Functor EvalArg(Term);
eval_flt = (F); \ eval_flt = (F); \
return (FFloat); \ return (FFloat); \
} }
#define REvalError() \ #define REvalError() \
{ return (FError); } { return (FError); }
@ -407,8 +408,12 @@ yamop *Yap_EvalError__(const char *, const char *, int, yap_error_number, Term,
#define Yap_ArithError(id, t, ...) \ #define Yap_ArithError(id, t, ...) \
Yap_ArithError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__) 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" #include "inline-only.h"
@ -429,7 +434,7 @@ INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS) {
#if HAVE_FECLEAREXCEPT #if HAVE_FECLEAREXCEPT
inline static void Yap_ClearExs(void) { feclearexcept(FE_ALL_EXCEPT); } inline static void Yap_ClearExs(void) { feclearexcept(FE_ALL_EXCEPT); }
#else #else
inline static void Yap_ClearExs(void) { } inline static void Yap_ClearExs(void) {}
#endif #endif
inline static yap_error_number Yap_FoundArithError__(USES_REGS1) { 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 RINT(v) return (MkIntegerTerm(v))
#define RFLOAT(v) return (MkFloatTerm(v)) #define RFLOAT(v) return (MkFloatTerm(v))
#define RBIG(v) return (Yap_MkBigIntTerm(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) { static inline blob_type ETypeOfTerm(Term t) {
if (IsIntTerm(t)) if (IsIntTerm(t))

14
H/generated/dlocals.h
View File

@ -121,8 +121,6 @@
#define REMOTE_ArenaOverflows(wid) REMOTE(wid)->ArenaOverflows_ #define REMOTE_ArenaOverflows(wid) REMOTE(wid)->ArenaOverflows_
#define LOCAL_DepthArenas LOCAL->DepthArenas_ #define LOCAL_DepthArenas LOCAL->DepthArenas_
#define REMOTE_DepthArenas(wid) REMOTE(wid)->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 LOCAL_LastAssertedPred LOCAL->LastAssertedPred_
#define REMOTE_LastAssertedPred(wid) REMOTE(wid)->LastAssertedPred_ #define REMOTE_LastAssertedPred(wid) REMOTE(wid)->LastAssertedPred_
#define LOCAL_TmpPred LOCAL->TmpPred_ #define LOCAL_TmpPred LOCAL->TmpPred_
@ -288,16 +286,10 @@
#define REMOTE_TrailBase(wid) REMOTE(wid)->TrailBase_ #define REMOTE_TrailBase(wid) REMOTE(wid)->TrailBase_
#define LOCAL_TrailTop LOCAL->TrailTop_ #define LOCAL_TrailTop LOCAL->TrailTop_
#define REMOTE_TrailTop(wid) REMOTE(wid)->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 LOCAL_ActiveError LOCAL->ActiveError_
#define REMOTE_ActiveError(wid) REMOTE(wid)->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 LOCAL_IOBotch LOCAL->IOBotch_
#define REMOTE_IOBotch(wid) REMOTE(wid)->IOBotch_ #define REMOTE_IOBotch(wid) REMOTE(wid)->IOBotch_
#define LOCAL_tokptr LOCAL->tokptr_ #define LOCAL_tokptr LOCAL->tokptr_
@ -326,6 +318,8 @@
#define REMOTE_FileNameBuf(wid) REMOTE(wid)->FileNameBuf_ #define REMOTE_FileNameBuf(wid) REMOTE(wid)->FileNameBuf_
#define LOCAL_FileNameBuf2 LOCAL->FileNameBuf2_ #define LOCAL_FileNameBuf2 LOCAL->FileNameBuf2_
#define REMOTE_FileNameBuf2(wid) REMOTE(wid)->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 LOCAL_BreakLevel LOCAL->BreakLevel_
#define REMOTE_BreakLevel(wid) REMOTE(wid)->BreakLevel_ #define REMOTE_BreakLevel(wid) REMOTE(wid)->BreakLevel_
@ -350,14 +344,10 @@
#define LOCAL_s_dbg LOCAL->s_dbg_ #define LOCAL_s_dbg LOCAL->s_dbg_
#define REMOTE_s_dbg(wid) REMOTE(wid)->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 LOCAL_mathtt LOCAL->mathtt_
#define REMOTE_mathtt(wid) REMOTE(wid)->mathtt_ #define REMOTE_mathtt(wid) REMOTE(wid)->mathtt_
#define LOCAL_mathstring LOCAL->mathstring_ #define LOCAL_mathstring LOCAL->mathstring_
#define REMOTE_mathstring(wid) REMOTE(wid)->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 LOCAL_heap_overflows LOCAL->heap_overflows_
#define REMOTE_heap_overflows(wid) REMOTE(wid)->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_; UInt GlobalArenaOverflows_;
Int ArenaOverflows_; Int ArenaOverflows_;
Int DepthArenas_; Int DepthArenas_;
int ArithError_;
struct pred_entry* LastAssertedPred_; struct pred_entry* LastAssertedPred_;
struct pred_entry* TmpPred_; struct pred_entry* TmpPred_;
char* ScannerStack_; char* ScannerStack_;
@ -164,12 +163,9 @@ typedef struct worker_local {
ADDR GlobalBase_; ADDR GlobalBase_;
ADDR TrailBase_; ADDR TrailBase_;
ADDR TrailTop_; ADDR TrailTop_;
char* ErrorMessage_; /* error handling info, designed to be easy to pass to the foreign world */
Term Error_Term_; yap_error_descriptor_t* ActiveError_;
/** error handling info, designed to be easy to pass to the foreign world */
struct yap_error_descriptor ActiveError_;
/// pointer to an exception term, from throw /// pointer to an exception term, from throw
struct DB_TERM* BallTerm_;
jmp_buf IOBotch_; jmp_buf IOBotch_;
TokEntry* tokptr_; TokEntry* tokptr_;
TokEntry* toktide_; TokEntry* toktide_;
@ -184,6 +180,7 @@ typedef struct worker_local {
sigjmp_buf RestartEnv_; sigjmp_buf RestartEnv_;
char FileNameBuf_[YAP_FILENAME_MAX+1]; char FileNameBuf_[YAP_FILENAME_MAX+1];
char FileNameBuf2_[YAP_FILENAME_MAX+1]; char FileNameBuf2_[YAP_FILENAME_MAX+1];
struct TextBuffer_manager* TextBuffer_;
// Prolog State // Prolog State
UInt BreakLevel_; UInt BreakLevel_;
Int PrologMode_; Int PrologMode_;
@ -200,10 +197,8 @@ typedef struct worker_local {
//dbase.c //dbase.c
struct db_globs* s_dbg_; struct db_globs* s_dbg_;
//eval.c //eval.c
yap_error_number matherror_;
Term mathtt_; Term mathtt_;
char* mathstring_; char* mathstring_;
yap_error_number CurrentError_;
//grow.c //grow.c
int heap_overflows_; int heap_overflows_;
Int total_heap_overflow_time_; 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_GlobalArenaOverflows(wid) = 0L;
REMOTE_ArenaOverflows(wid) = 0L; REMOTE_ArenaOverflows(wid) = 0L;
REMOTE_DepthArenas(wid) = 0; REMOTE_DepthArenas(wid) = 0;
REMOTE_ArithError(wid) = FALSE;
REMOTE_LastAssertedPred(wid) = NULL; REMOTE_LastAssertedPred(wid) = NULL;
REMOTE_TmpPred(wid) = NULL; REMOTE_TmpPred(wid) = NULL;
REMOTE_ScannerStack(wid) = NULL; REMOTE_ScannerStack(wid) = NULL;
@ -165,11 +164,7 @@ static void InitWorker(int wid) {
REMOTE_ActiveError(wid) = calloc(sizeof(yap_error_descriptor_t),1);
REMOTE_BallTerm(wid) = NULL;
@ -185,6 +180,8 @@ static void InitWorker(int wid) {
REMOTE_TextBuffer(wid) = Yap_InitTextAllocator();
REMOTE_BreakLevel(wid) = 0; REMOTE_BreakLevel(wid) = 0;
REMOTE_PrologMode(wid) = BootMode; REMOTE_PrologMode(wid) = BootMode;
REMOTE_CritLocks(wid) = 0; REMOTE_CritLocks(wid) = 0;
@ -200,10 +197,8 @@ static void InitWorker(int wid) {
REMOTE_matherror(wid) = YAP_NO_ERROR;
REMOTE_mathstring(wid) = NULL; REMOTE_mathstring(wid) = NULL;
REMOTE_CurrentError(wid) = YAP_NO_ERROR;
REMOTE_heap_overflows(wid) = 0; REMOTE_heap_overflows(wid) = 0;
REMOTE_total_heap_overflow_time(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 #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 #ifdef LOAD_DYLD
#endif #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 */ please do not update */
while (TRUE) {
while (TRUE) {
op_numbers op; op_numbers op;
op = Yap_op_from_opcode(pc->opc); op = Yap_op_from_opcode(pc->opc);
@ -11,39 +9,39 @@
switch (op) { switch (op) {
/* instructions type D */ /* instructions type D */
case _write_dbterm: case _write_dbterm:
pc = NEXTOP(pc,D); pc = NEXTOP(pc, D);
break; break;
/* instructions type Illss */ /* instructions type Illss */
case _enter_lu_pred: case _enter_lu_pred:
return walk_got_lu_block(pc->y_u.Illss.I, startp, endp); return walk_got_lu_block(pc->y_u.Illss.I, startp, endp);
/* instructions type J */ /* instructions type J */
#ifdef YAP_JIT #ifdef YAP_JIT
case _jit_handler: case _jit_handler:
#endif #endif
pc = NEXTOP(pc,J); pc = NEXTOP(pc, J);
break; break;
/* instructions type L */ /* instructions type L */
case _alloc_for_logical_pred: case _alloc_for_logical_pred:
return walk_got_lu_clause(pc->y_u.L.ClBase, startp, endp); return walk_got_lu_clause(pc->y_u.L.ClBase, startp, endp);
/* instructions type N */ /* instructions type N */
case _write_bigint: case _write_bigint:
pc = NEXTOP(pc,N); pc = NEXTOP(pc, N);
break; break;
/* instructions type Osblp */ /* instructions type Osblp */
case _either: case _either:
case _or_else: case _or_else:
clause_code = TRUE; clause_code = TRUE;
pp = pc->y_u.Osblp.p0; pp = pc->y_u.Osblp.p0;
pc = NEXTOP(pc,Osblp); pc = NEXTOP(pc, Osblp);
break; break;
/* instructions type Osbmp */ /* instructions type Osbmp */
case _p_execute: case _p_execute:
case _p_execute_tail: case _p_execute_tail:
pc = NEXTOP(pc,Osbmp); pc = NEXTOP(pc, Osbmp);
break; break;
/* instructions type Osbpa */ /* instructions type Osbpa */
case _ensure_space: case _ensure_space:
pc = NEXTOP(pc,Osbpa); pc = NEXTOP(pc, Osbpa);
break; break;
/* instructions type Osbpp */ /* instructions type Osbpp */
case _call_cpred: case _call_cpred:
@ -58,7 +56,7 @@
case _fcall: case _fcall:
clause_code = TRUE; clause_code = TRUE;
pp = pc->y_u.Osbpp.p0; pp = pc->y_u.Osbpp.p0;
pc = NEXTOP(pc,Osbpp); pc = NEXTOP(pc, Osbpp);
break; break;
/* instructions type OtILl */ /* instructions type OtILl */
case _count_trust_logical: case _count_trust_logical:
@ -81,7 +79,7 @@
case _try_userc: case _try_userc:
clause_code = TRUE; clause_code = TRUE;
pp = pc->y_u.OtapFs.p; pp = pc->y_u.OtapFs.p;
pc = NEXTOP(pc,OtapFs); pc = NEXTOP(pc, OtapFs);
break; break;
/* instructions type Otapl */ /* instructions type Otapl */
case _count_retry_and_mark: case _count_retry_and_mark:
@ -101,39 +99,39 @@
case _try_me: case _try_me:
clause_code = FALSE; clause_code = FALSE;
pp = pc->y_u.Otapl.p; pp = pc->y_u.Otapl.p;
pc = NEXTOP(pc,Otapl); pc = NEXTOP(pc, Otapl);
break; break;
/* instructions type c */ /* instructions type c */
case _write_atom: case _write_atom:
pc = NEXTOP(pc,c); pc = NEXTOP(pc, c);
break; break;
/* instructions type cc */ /* instructions type cc */
case _get_2atoms: case _get_2atoms:
pc = NEXTOP(pc,cc); pc = NEXTOP(pc, cc);
break; break;
/* instructions type ccc */ /* instructions type ccc */
case _get_3atoms: case _get_3atoms:
pc = NEXTOP(pc,ccc); pc = NEXTOP(pc, ccc);
break; break;
/* instructions type cccc */ /* instructions type cccc */
case _get_4atoms: case _get_4atoms:
pc = NEXTOP(pc,cccc); pc = NEXTOP(pc, cccc);
break; break;
/* instructions type ccccc */ /* instructions type ccccc */
case _get_5atoms: case _get_5atoms:
pc = NEXTOP(pc,ccccc); pc = NEXTOP(pc, ccccc);
break; break;
/* instructions type cccccc */ /* instructions type cccccc */
case _get_6atoms: case _get_6atoms:
pc = NEXTOP(pc,cccccc); pc = NEXTOP(pc, cccccc);
break; break;
/* instructions type clll */ /* instructions type clll */
case _if_not_then: case _if_not_then:
pc = NEXTOP(pc,clll); pc = NEXTOP(pc, clll);
break; break;
/* instructions type d */ /* instructions type d */
case _write_float: case _write_float:
pc = NEXTOP(pc,d); pc = NEXTOP(pc, d);
break; break;
/* instructions type e */ /* instructions type e */
case _Nstop: case _Nstop:
@ -149,14 +147,14 @@
case _op_fail: case _op_fail:
if (codeptr == FAILCODE) if (codeptr == FAILCODE)
return found_fail(pc, startp, endp PASS_REGS); return found_fail(pc, startp, endp PASS_REGS);
pc = NEXTOP(pc,e); pc = NEXTOP(pc, e);
break; break;
case _spy_pred: case _spy_pred:
return found_owner_op(pc, startp, endp PASS_REGS); return found_owner_op(pc, startp, endp PASS_REGS);
case _trust_fail: case _trust_fail:
if (codeptr == TRUSTFAILCODE) if (codeptr == TRUSTFAILCODE)
return found_fail(pc, startp, endp PASS_REGS); return found_fail(pc, startp, endp PASS_REGS);
pc = NEXTOP(pc,e); pc = NEXTOP(pc, e);
break; break;
case _undef_p: case _undef_p:
return found_owner_op(pc, startp, endp PASS_REGS); return found_owner_op(pc, startp, endp PASS_REGS);
@ -180,16 +178,16 @@
case _write_l_list: case _write_l_list:
case _write_list: case _write_list:
case _write_void: case _write_void:
pc = NEXTOP(pc,e); pc = NEXTOP(pc, e);
break; break;
/* instructions type fa */ /* instructions type fa */
case _write_l_struc: case _write_l_struc:
case _write_struct: case _write_struct:
pc = NEXTOP(pc,fa); pc = NEXTOP(pc, fa);
break; break;
/* instructions type i */ /* instructions type i */
case _write_longint: case _write_longint:
pc = NEXTOP(pc,i); pc = NEXTOP(pc, i);
break; break;
/* instructions type l */ /* instructions type l */
case _Ystop: case _Ystop:
@ -209,11 +207,11 @@
case _try_clause3: case _try_clause3:
case _try_clause4: case _try_clause4:
case _try_in: case _try_in:
pc = NEXTOP(pc,l); pc = NEXTOP(pc, l);
break; break;
/* instructions type llll */ /* instructions type llll */
case _switch_on_type: case _switch_on_type:
pc = NEXTOP(pc,llll); pc = NEXTOP(pc, llll);
break; break;
/* instructions type lp */ /* instructions type lp */
case _retry_all_exo: case _retry_all_exo:
@ -223,7 +221,7 @@
case _try_exo: case _try_exo:
case _try_exo_udi: case _try_exo_udi:
case _user_switch: case _user_switch:
pc = NEXTOP(pc,lp); pc = NEXTOP(pc, lp);
break; break;
/* instructions type o */ /* instructions type o */
case _unify_l_list: case _unify_l_list:
@ -234,51 +232,51 @@
case _unify_list_write: case _unify_list_write:
case _unify_void: case _unify_void:
case _unify_void_write: case _unify_void_write:
pc = NEXTOP(pc,o); pc = NEXTOP(pc, o);
break; break;
/* instructions type oD */ /* instructions type oD */
case _unify_dbterm: case _unify_dbterm:
case _unify_l_dbterm: case _unify_l_dbterm:
pc = NEXTOP(pc,oD); pc = NEXTOP(pc, oD);
break; break;
/* instructions type oN */ /* instructions type oN */
case _unify_bigint: case _unify_bigint:
case _unify_l_bigint: case _unify_l_bigint:
pc = NEXTOP(pc,oN); pc = NEXTOP(pc, oN);
break; break;
/* instructions type oc */ /* instructions type oc */
case _unify_atom: case _unify_atom:
case _unify_atom_write: case _unify_atom_write:
case _unify_l_atom: case _unify_l_atom:
case _unify_l_atom_write: case _unify_l_atom_write:
pc = NEXTOP(pc,oc); pc = NEXTOP(pc, oc);
break; break;
/* instructions type od */ /* instructions type od */
case _unify_float: case _unify_float:
case _unify_float_write: case _unify_float_write:
case _unify_l_float: case _unify_l_float:
case _unify_l_float_write: case _unify_l_float_write:
pc = NEXTOP(pc,od); pc = NEXTOP(pc, od);
break; break;
/* instructions type ofa */ /* instructions type ofa */
case _unify_l_struc: case _unify_l_struc:
case _unify_l_struc_write: case _unify_l_struc_write:
case _unify_struct: case _unify_struct:
case _unify_struct_write: case _unify_struct_write:
pc = NEXTOP(pc,ofa); pc = NEXTOP(pc, ofa);
break; break;
/* instructions type oi */ /* instructions type oi */
case _unify_l_longint: case _unify_l_longint:
case _unify_l_longint_write: case _unify_l_longint_write:
case _unify_longint: case _unify_longint:
case _unify_longint_write: case _unify_longint_write:
pc = NEXTOP(pc,oi); pc = NEXTOP(pc, oi);
break; break;
/* instructions type ollll */ /* instructions type ollll */
case _switch_list_nl: case _switch_list_nl:
pc = NEXTOP(pc,ollll); pc = NEXTOP(pc, ollll);
break; break;
/* instructions type os */ /* instructions type os */
#ifdef BEAM #ifdef BEAM
case _run_eam: case _run_eam:
#endif #endif
@ -286,17 +284,17 @@
case _unify_l_n_voids_write: case _unify_l_n_voids_write:
case _unify_n_voids: case _unify_n_voids:
case _unify_n_voids_write: case _unify_n_voids_write:
pc = NEXTOP(pc,os); pc = NEXTOP(pc, os);
break; break;
/* instructions type osc */ /* instructions type osc */
case _unify_n_atoms: case _unify_n_atoms:
case _unify_n_atoms_write: case _unify_n_atoms_write:
pc = NEXTOP(pc,osc); pc = NEXTOP(pc, osc);
break; break;
/* instructions type ou */ /* instructions type ou */
case _unify_l_string: case _unify_l_string:
case _unify_string: case _unify_string:
pc = NEXTOP(pc,ou); pc = NEXTOP(pc, ou);
break; break;
/* instructions type ox */ /* instructions type ox */
case _save_appl_x: case _save_appl_x:
@ -315,14 +313,14 @@
case _unify_x_val_write: case _unify_x_val_write:
case _unify_x_var: case _unify_x_var:
case _unify_x_var_write: case _unify_x_var_write:
pc = NEXTOP(pc,ox); pc = NEXTOP(pc, ox);
break; break;
/* instructions type oxx */ /* instructions type oxx */
case _unify_l_x_var2: case _unify_l_x_var2:
case _unify_l_x_var2_write: case _unify_l_x_var2_write:
case _unify_x_var2: case _unify_x_var2:
case _unify_x_var2_write: case _unify_x_var2_write:
pc = NEXTOP(pc,oxx); pc = NEXTOP(pc, oxx);
break; break;
/* instructions type oy */ /* instructions type oy */
case _save_appl_y: case _save_appl_y:
@ -341,7 +339,7 @@
case _unify_y_val_write: case _unify_y_val_write:
case _unify_y_var: case _unify_y_var:
case _unify_y_var_write: case _unify_y_var_write:
pc = NEXTOP(pc,oy); pc = NEXTOP(pc, oy);
break; break;
/* instructions type p */ /* instructions type p */
case _lock_lu: case _lock_lu:
@ -350,7 +348,7 @@
if (pp->PredFlags & MegaClausePredFlag) if (pp->PredFlags & MegaClausePredFlag)
return found_mega_clause(pp, startp, endp); return found_mega_clause(pp, startp, endp);
clause_code = TRUE; clause_code = TRUE;
pc = NEXTOP(pc,p); pc = NEXTOP(pc, p);
break; break;
case _count_call: case _count_call:
case _count_retry: case _count_retry:
@ -359,20 +357,20 @@
case _retry_profiled: case _retry_profiled:
case _retry_udi: case _retry_udi:
case _try_udi: case _try_udi:
pc = NEXTOP(pc,p); pc = NEXTOP(pc, p);
break; break;
/* instructions type plxxs */ /* instructions type plxxs */
case _call_bfunc_xx: case _call_bfunc_xx:
pc = NEXTOP(pc,plxxs); pc = NEXTOP(pc, plxxs);
break; break;
/* instructions type plxys */ /* instructions type plxys */
case _call_bfunc_xy: case _call_bfunc_xy:
case _call_bfunc_yx: case _call_bfunc_yx:
pc = NEXTOP(pc,plxys); pc = NEXTOP(pc, plxys);
break; break;
/* instructions type plyys */ /* instructions type plyys */
case _call_bfunc_yy: case _call_bfunc_yy:
pc = NEXTOP(pc,plyys); pc = NEXTOP(pc, plyys);
break; break;
/* instructions type pp */ /* instructions type pp */
case _execute_cpred: case _execute_cpred:
@ -382,7 +380,7 @@
case _execute: case _execute:
clause_code = TRUE; clause_code = TRUE;
pp = pc->y_u.pp.p0; pp = pc->y_u.pp.p0;
pc = NEXTOP(pc,pp); pc = NEXTOP(pc, pp);
break; break;
/* instructions type s */ /* instructions type s */
case _cut: case _cut:
@ -390,15 +388,15 @@
case _cut_t: case _cut_t:
case _pop_n: case _pop_n:
case _write_n_voids: case _write_n_voids:
pc = NEXTOP(pc,s); pc = NEXTOP(pc, s);
break; break;
/* instructions type sc */ /* instructions type sc */
case _write_n_atoms: case _write_n_atoms:
pc = NEXTOP(pc,sc); pc = NEXTOP(pc, sc);
break; break;
/* instructions type sllll */ /* instructions type sllll */
case _switch_on_sub_arg_type: case _switch_on_sub_arg_type:
pc = NEXTOP(pc,sllll); pc = NEXTOP(pc, sllll);
break; break;
/* instructions type slpp */ /* instructions type slpp */
case _call_c_wfail: case _call_c_wfail:
@ -411,12 +409,12 @@
case _if_func: case _if_func:
case _switch_on_cons: case _switch_on_cons:
case _switch_on_func: case _switch_on_func:
pc = NEXTOP(pc,sssl); pc = NEXTOP(pc, sssl);
break; break;
/* instructions type sssllp */ /* instructions type sssllp */
case _expand_clauses: case _expand_clauses:
return found_expand_index(pc, startp, endp, codeptr PASS_REGS); return found_expand_index(pc, startp, endp, codeptr PASS_REGS);
pc = NEXTOP(pc,sssllp); pc = NEXTOP(pc, sssllp);
break; break;
/* instructions type x */ /* instructions type x */
case _get_atom_exo: case _get_atom_exo:
@ -426,37 +424,37 @@
case _write_x_loc: case _write_x_loc:
case _write_x_val: case _write_x_val:
case _write_x_var: case _write_x_var:
pc = NEXTOP(pc,x); pc = NEXTOP(pc, x);
break; break;
/* instructions type xD */ /* instructions type xD */
case _get_dbterm: case _get_dbterm:
case _put_dbterm: case _put_dbterm:
pc = NEXTOP(pc,xD); pc = NEXTOP(pc, xD);
break; break;
/* instructions type xN */ /* instructions type xN */
case _get_bigint: case _get_bigint:
case _put_bigint: case _put_bigint:
pc = NEXTOP(pc,xN); pc = NEXTOP(pc, xN);
break; break;
/* instructions type xc */ /* instructions type xc */
case _get_atom: case _get_atom:
case _put_atom: case _put_atom:
pc = NEXTOP(pc,xc); pc = NEXTOP(pc, xc);
break; break;
/* instructions type xd */ /* instructions type xd */
case _get_float: case _get_float:
case _put_float: case _put_float:
pc = NEXTOP(pc,xd); pc = NEXTOP(pc, xd);
break; break;
/* instructions type xfa */ /* instructions type xfa */
case _get_struct: case _get_struct:
case _put_struct: case _put_struct:
pc = NEXTOP(pc,xfa); pc = NEXTOP(pc, xfa);
break; break;
/* instructions type xi */ /* instructions type xi */
case _get_longint: case _get_longint:
case _put_longint: case _put_longint:
pc = NEXTOP(pc,xi); pc = NEXTOP(pc, xi);
break; break;
/* instructions type xl */ /* instructions type xl */
case _p_atom_x: case _p_atom_x:
@ -469,23 +467,23 @@
case _p_number_x: case _p_number_x:
case _p_primitive_x: case _p_primitive_x:
case _p_var_x: case _p_var_x:
pc = NEXTOP(pc,xl); pc = NEXTOP(pc, xl);
break; break;
/* instructions type xll */ /* instructions type xll */
case _jump_if_nonvar: case _jump_if_nonvar:
pc = NEXTOP(pc,xll); pc = NEXTOP(pc, xll);
break; break;
/* instructions type xllll */ /* instructions type xllll */
case _switch_on_arg_type: case _switch_on_arg_type:
pc = NEXTOP(pc,xllll); pc = NEXTOP(pc, xllll);
break; break;
/* instructions type xps */ /* instructions type xps */
case _commit_b_x: case _commit_b_x:
pc = NEXTOP(pc,xps); pc = NEXTOP(pc, xps);
break; break;
/* instructions type xu */ /* instructions type xu */
case _get_string: case _get_string:
pc = NEXTOP(pc,xu); pc = NEXTOP(pc, xu);
break; break;
/* instructions type xx */ /* instructions type xx */
case _get_x_val: case _get_x_val:
@ -495,11 +493,11 @@
case _glist_valx: case _glist_valx:
case _put_x_val: case _put_x_val:
case _put_x_var: case _put_x_var:
pc = NEXTOP(pc,xx); pc = NEXTOP(pc, xx);
break; break;
/* instructions type xxc */ /* instructions type xxc */
case _p_func2s_cv: case _p_func2s_cv:
pc = NEXTOP(pc,xxc); pc = NEXTOP(pc, xxc);
break; break;
/* instructions type xxn */ /* instructions type xxn */
case _p_and_vc: case _p_and_vc:
@ -515,7 +513,7 @@
case _p_slr_cv: case _p_slr_cv:
case _p_slr_vc: case _p_slr_vc:
case _p_times_vc: case _p_times_vc:
pc = NEXTOP(pc,xxn); pc = NEXTOP(pc, xxn);
break; break;
/* instructions type xxx */ /* instructions type xxx */
case _p_and_vv: case _p_and_vv:
@ -529,22 +527,22 @@
case _p_sll_vv: case _p_sll_vv:
case _p_slr_vv: case _p_slr_vv:
case _p_times_vv: case _p_times_vv:
pc = NEXTOP(pc,xxx); pc = NEXTOP(pc, xxx);
break; break;
/* instructions type xxxx */ /* instructions type xxxx */
case _put_xx_val: case _put_xx_val:
pc = NEXTOP(pc,xxxx); pc = NEXTOP(pc, xxxx);
break; break;
/* instructions type xxy */ /* instructions type xxy */
case _p_func2f_xy: case _p_func2f_xy:
pc = NEXTOP(pc,xxy); pc = NEXTOP(pc, xxy);
break; break;
/* instructions type y */ /* instructions type y */
case _save_b_y: case _save_b_y:
case _write_y_loc: case _write_y_loc:
case _write_y_val: case _write_y_val:
case _write_y_var: case _write_y_var:
pc = NEXTOP(pc,y); pc = NEXTOP(pc, y);
break; break;
/* instructions type yl */ /* instructions type yl */
case _p_atom_y: case _p_atom_y:
@ -557,11 +555,11 @@
case _p_number_y: case _p_number_y:
case _p_primitive_y: case _p_primitive_y:
case _p_var_y: case _p_var_y:
pc = NEXTOP(pc,yl); pc = NEXTOP(pc, yl);
break; break;
/* instructions type yps */ /* instructions type yps */
case _commit_b_y: case _commit_b_y:
pc = NEXTOP(pc,yps); pc = NEXTOP(pc, yps);
break; break;
/* instructions type yx */ /* instructions type yx */
case _get_y_val: case _get_y_val:
@ -572,11 +570,11 @@
case _put_unsafe: case _put_unsafe:
case _put_y_val: case _put_y_val:
case _put_y_var: case _put_y_var:
pc = NEXTOP(pc,yx); pc = NEXTOP(pc, yx);
break; break;
/* instructions type yxc */ /* instructions type yxc */
case _p_func2s_y_cv: case _p_func2s_y_cv:
pc = NEXTOP(pc,yxc); pc = NEXTOP(pc, yxc);
break; break;
/* instructions type yxn */ /* instructions type yxn */
case _p_and_y_vc: case _p_and_y_vc:
@ -592,7 +590,7 @@
case _p_slr_y_cv: case _p_slr_y_cv:
case _p_slr_y_vc: case _p_slr_y_vc:
case _p_times_y_vc: case _p_times_y_vc:
pc = NEXTOP(pc,yxn); pc = NEXTOP(pc, yxn);
break; break;
/* instructions type yxx */ /* instructions type yxx */
case _p_and_y_vv: case _p_and_y_vv:
@ -606,16 +604,16 @@
case _p_sll_y_vv: case _p_sll_y_vv:
case _p_slr_y_vv: case _p_slr_y_vv:
case _p_times_y_vv: case _p_times_y_vv:
pc = NEXTOP(pc,yxx); pc = NEXTOP(pc, yxx);
break; break;
/* instructions type yyx */ /* instructions type yyx */
case _p_func2f_yy: case _p_func2f_yy:
pc = NEXTOP(pc,yyx); pc = NEXTOP(pc, yyx);
break; break;
/* instructions type yyxx */ /* instructions type yyxx */
case _get_yy_var: case _get_yy_var:
case _put_y_vals: case _put_y_vals:
pc = NEXTOP(pc,yyxx); pc = NEXTOP(pc, yyxx);
break; break;
#ifdef YAPOR #ifdef YAPOR
/* instructions type Otapl */ /* instructions type Otapl */
@ -624,11 +622,11 @@
case _sync: case _sync:
clause_code = FALSE; clause_code = FALSE;
pp = pc->y_u.Otapl.p; pp = pc->y_u.Otapl.p;
pc = NEXTOP(pc,Otapl); pc = NEXTOP(pc, Otapl);
break; break;
/* instructions type e */ /* instructions type e */
case _getwork_first_time: case _getwork_first_time:
pc = NEXTOP(pc,e); pc = NEXTOP(pc, e);
break; break;
#endif #endif
#ifdef TABLING #ifdef TABLING
@ -649,17 +647,17 @@
case _table_try_single: case _table_try_single:
clause_code = FALSE; clause_code = FALSE;
pp = pc->y_u.Otapl.p; pp = pc->y_u.Otapl.p;
pc = NEXTOP(pc,Otapl); pc = NEXTOP(pc, Otapl);
break; break;
/* instructions type e */ /* instructions type e */
#ifdef TABLING_INNER_CUTS #ifdef TABLING_INNER_CUTS
case _clause_with_cut: case _clause_with_cut:
#endif #endif
pc = NEXTOP(pc,e); pc = NEXTOP(pc, e);
break; break;
/* instructions type s */ /* instructions type s */
case _table_new_answer: case _table_new_answer:
pc = NEXTOP(pc,s); pc = NEXTOP(pc, s);
break; break;
/* instructions type e */ /* instructions type e */
case _trie_do_appl: case _trie_do_appl:
@ -726,7 +724,7 @@
case _trie_try_val_in_pair: case _trie_try_val_in_pair:
case _trie_try_var: case _trie_try_var:
case _trie_try_var_in_pair: case _trie_try_var_in_pair:
pc = NEXTOP(pc,e); pc = NEXTOP(pc, e);
break; break;
#endif #endif
/* this instruction is hardwired */ /* this instruction is hardwired */
@ -736,13 +734,13 @@
if (pp->PredFlags & MegaClausePredFlag) if (pp->PredFlags & MegaClausePredFlag)
return found_mega_clause(pp, startp, endp); return found_mega_clause(pp, startp, endp);
clause_code = TRUE; clause_code = TRUE;
pc = NEXTOP(pc,Osblp); pc = NEXTOP(pc, Osblp);
#else #else
pp = pc->y_u.p.p; pp = pc->y_u.p.p;
if (pp->PredFlags & MegaClausePredFlag) if (pp->PredFlags & MegaClausePredFlag)
return found_mega_clause(pp, startp, endp); return found_mega_clause(pp, startp, endp);
clause_code = TRUE; clause_code = TRUE;
pc = NEXTOP(pc,p); pc = NEXTOP(pc, p);
#endif #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) \ #define JMP_LOCAL_ERROR(v, LAB) \
if (H + 2 * (v) > ASP - 1024) { \ if (H + 2 * (v) > ASP - 1024) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = 2 * (v) * sizeof(CELL); \ LOCAL_Error_Size = 2 * (v) * sizeof(CELL); \
goto LAB; \ 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) \ #define LOCAL_ERROR(t, v) \
if (HR + (v) > ASP - 1024) { \ if (HR + (v) > ASP - 1024) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = 2 * (v) * sizeof(CELL); \ LOCAL_Error_Size = 2 * (v) * sizeof(CELL); \
return NULL; \ 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) \ #define LOCAL_TERM_ERROR(t, v) \
if (HR + (v) > ASP - 1024) { \ if (HR + (v) > ASP - 1024) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = 2 * (v) * sizeof(CELL); \ LOCAL_Error_Size = 2 * (v) * sizeof(CELL); \
return 0L; \ 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) \ #define AUX_ERROR(t, n, s, TYPE) \
if (s + (n + 1) > (TYPE *)AuxSp) { \ if (s + (n + 1) > (TYPE *)AuxSp) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; \ LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \ LOCAL_Error_Size = n * sizeof(TYPE); \
return NULL; \ 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) \ #define AUX_TERM_ERROR(t, n, s, TYPE) \
if (s + (n + 1) > (TYPE *)AuxSp) { \ if (s + (n + 1) > (TYPE *)AuxSp) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; \ LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \ LOCAL_Error_Size = n * sizeof(TYPE); \
return 0L; \ 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) \ #define JMP_AUX_ERROR(n, s, t, TYPE, LAB) \
if (s + (n + 1) > (TYPE *)AuxSp) { \ if (s + (n + 1) > (TYPE *)AuxSp) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; \ LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \ LOCAL_Error_Size = n * sizeof(TYPE); \
goto LAB; \ 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) \ #define HEAP_ERROR(a, TYPE) \
if (a == NIL) { \ if (a == NIL) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \ LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \ LOCAL_Error_Size = n * sizeof(TYPE); \
return NULL; \ 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) \ #define HEAP_TERM_ERROR(a, TYPE, n) \
if (a == NIL) { \ if (a == NIL) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \ LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \ LOCAL_Error_Size = n * sizeof(TYPE); \
return 0L; \ 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) \ #define JMP_HEAP_ERROR(a, n, t, TYPE, LAB) \
if (a == NIL) { \ if (a == NIL) { \
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \ LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \
LOCAL_Error_Term = t; \
LOCAL_Error_Size = n * sizeof(TYPE); \ LOCAL_Error_Size = n * sizeof(TYPE); \
goto LAB; \ goto LAB; \
} }
@ -174,6 +165,21 @@ INLINE_ONLY extern inline Term Yap_ensure_atom__(const char *fu, const char *fi,
/// go back t /// go back t
} yap_error_stage_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 /// all we need to know about an error/throw
typedef struct yap_error_descriptor { typedef struct yap_error_descriptor {
enum yap_error_status status; 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; YAP_Int errorLine;
const char *errorFunction; const char *errorFunction;
const char *errorFile; const char *errorFile;
// struct error_prolog_source *errorSource;
YAP_Int prologPredCl; YAP_Int prologPredCl;
YAP_UInt prologPredLine; YAP_UInt prologPredLine;
YAP_UInt prologPredFirstLine; 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_UInt prologPredArity;
YAP_Term prologPredModule; YAP_Term prologPredModule;
YAP_Atom prologPredFile; 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; struct DB_TERM *errorTerm;
char errorComment[MAX_ERROR_MSG_SIZE]; char *errorMsg;
size_t errorMsgLen; size_t errorMsgLen;
struct yap_error_descriptor *top_error;
} yap_error_descriptor_t; } yap_error_descriptor_t;
/// compatibility with existing code.. /// compatibility with existing code..
#define LOCAL_Error_TYPE LOCAL_ActiveError.errorNo #define LOCAL_Error_TYPE LOCAL_ActiveError->errorNo
#define LOCAL_Error_File LOCAL_ActiveError.errorFile #define LOCAL_Error_File LOCAL_ActiveError->errorFile
#define LOCAL_Error_Function LOCAL_ActiveError.errorFunction #define LOCAL_Error_Function LOCAL_ActiveError->errorFunction
#define LOCAL_Error_Lineno LOCAL_ActiveError.errorLine #define LOCAL_Error_Lineno LOCAL_ActiveError->errorLine
#define LOCAL_Error_Size LOCAL_ActiveError.errorMsgLen #define LOCAL_Error_Size LOCAL_ActiveError->errorMsgLen
#define LOCAL_ErrorSay LOCAL_ActiveError.errorComment #define LOCAL_BallTerm LOCAL_ActiveError->errorTerm
#define LOCAL_ErrorMessage LOCAL_ActiveError->errorMsg
extern bool Yap_find_prolog_culprit(); extern bool Yap_find_prolog_culprit();
extern yap_error_class_number Yap_errorClass(yap_error_number e); extern yap_error_class_number Yap_errorClass(yap_error_number e);
extern const char *Yap_errorName(yap_error_number e); extern const char *Yap_errorName(yap_error_number e);
extern const char *Yap_errorClassName(yap_error_class_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 #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_DebugErrorPuts(const char *s) { Yap_DebugPuts(stderr, s); }
void Yap_DebugPlWrite(Term t) { void Yap_DebugPlWrite(Term t) {
if (t==0) if (t == 0)
fprintf(stderr,"NULL"); fprintf(stderr, "NULL");
Yap_plwrite(t, GLOBAL_Stream + 2, 0, 0, GLOBAL_MaxPriority); Yap_plwrite(t, GLOBAL_Stream + 2, 0, 0, GLOBAL_MaxPriority);
} }
void Yap_DebugPlWriteln(Term t) { void Yap_DebugPlWriteln(Term t) {
CACHE_REGS CACHE_REGS
if (t==0) if (t == 0)
fprintf(stderr,"NULL"); fprintf(stderr, "NULL");
Yap_plwrite(t, NULL, 15, 0, GLOBAL_MaxPriority); 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, '.');
Yap_DebugPutc(GLOBAL_Stream[LOCAL_c_error_stream].file, 10); 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) { if (ch == EOF) {
return post_process_weof(s); return post_process_weof(s);
} }
#if DEBUG #if DEBUG
if (GLOBAL_Option[1]) { if (GLOBAL_Option[1]) {
static int v; static int v;
fprintf(stderr, "%d %C\n", v, ch); 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 != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_OPEN_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_OPEN_OPTION;
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, Yap_Error(LOCAL_Error_TYPE, tlist, "option handling in open/3");
"option handling in open/3");
} }
return false; 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 != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_CLOSE_OPTION; 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;
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 != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION; 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; return false;
} }

55
os/iopreds.h
View File

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

82
os/readterm.c
View File

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

117
os/sig.c
View File

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

3
os/sysbits.h
View File

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

341
os/time.c
View File

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

69
os/writeterm.c
View File

@ -88,7 +88,6 @@ static char SccsId[] = "%W% %G%";
#endif #endif
#include "iopreds.h" #include "iopreds.h"
static Term readFromBuffer(const char *s, Term opts) { static Term readFromBuffer(const char *s, Term opts) {
Term rval; Term rval;
int sno; int sno;
@ -291,21 +290,20 @@ end:
/** /**
* *
*/ */
bool Yap_WriteTerm( int output_stream, Term t, Term opts USES_REGS) bool Yap_WriteTerm(int output_stream, Term t, Term opts USES_REGS) {
{ xarg *args = Yap_ArgListToVector(opts, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector( opts, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, t, args PASS_REGS); write_term(output_stream, t, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -316,7 +314,7 @@ static Int write_term2(USES_REGS1) {
/* '$write'(+Flags,?Term) */ /* '$write'(+Flags,?Term) */
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ 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) { static Int write_term3(USES_REGS1) {
@ -325,7 +323,7 @@ static Int write_term3(USES_REGS1) {
if (output_stream < 0) { if (output_stream < 0) {
return false; 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) { static Int write2(USES_REGS1) {
@ -343,7 +341,7 @@ static Int write2(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
mySlots = Yap_StartSlots(); mySlots = Yap_StartSlots();
@ -351,7 +349,7 @@ static Int write2(USES_REGS1) {
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -369,7 +367,7 @@ static Int write1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
@ -378,7 +376,7 @@ static Int write1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -396,7 +394,7 @@ static Int write_canonical1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
@ -407,7 +405,7 @@ static Int write_canonical1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -422,12 +420,12 @@ static Int write_canonical(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0) { if (output_stream < 0) {
free( args ); free(args);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
@ -437,7 +435,7 @@ static Int write_canonical(USES_REGS1) {
args[WRITE_QUOTED].tvalue = TermTrue; args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -452,13 +450,13 @@ static Int writeq1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
int output_stream = LOCAL_c_output_stream; int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) { if (output_stream == -1) {
free( args ); free(args);
output_stream = 1; output_stream = 1;
} }
args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].used = true;
@ -467,7 +465,7 @@ static Int writeq1(USES_REGS1) {
args[WRITE_QUOTED].tvalue = TermTrue; args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG1, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -482,12 +480,12 @@ static Int writeq(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0) { if (output_stream < 0) {
free( args ); free(args);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
@ -497,7 +495,7 @@ static Int writeq(USES_REGS1) {
args[WRITE_QUOTED].tvalue = TermTrue; args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -512,13 +510,13 @@ static Int print1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
int output_stream = LOCAL_c_output_stream; int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) { if (output_stream == -1) {
free( args ); free(args);
output_stream = 1; output_stream = 1;
} }
args[WRITE_PORTRAY].used = true; args[WRITE_PORTRAY].used = true;
@ -528,7 +526,7 @@ static Int print1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -543,12 +541,12 @@ static Int print(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0) { if (output_stream < 0) {
free( args ); free(args);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
@ -558,7 +556,7 @@ static Int print(USES_REGS1) {
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -574,7 +572,7 @@ static Int writeln1(USES_REGS1) {
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END); xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
@ -585,7 +583,7 @@ static Int writeln1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -598,13 +596,13 @@ static Int writeln(USES_REGS1) {
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END); xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "writeln/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "writeln/2");
if (output_stream < 0) { if (output_stream < 0) {
free( args ); free(args);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
args[WRITE_NL].used = true; args[WRITE_NL].used = true;
@ -613,7 +611,7 @@ return false;
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args ); free(args);
Yap_CloseSlots(mySlots); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
@ -676,7 +674,6 @@ static Int dollar_var(USES_REGS1) {
return Yap_unify(tv, ARG2); return Yap_unify(tv, ARG2);
} }
static Int term_to_string(USES_REGS1) { static Int term_to_string(USES_REGS1) {
Term t2 = Deref(ARG2), rc = false, t1 = Deref(ARG1); Term t2 = Deref(ARG2), rc = false, t1 = Deref(ARG1);
const char *s; 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; 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) { static inline Py_ssize_t get_p_int(PyObject *o, Py_ssize_t def) {
if (o == NULL) if (o == NULL)
return def; 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_pyeval(term_t t, functor_t fun);
extern PyObject *compound_to_pytree(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 *yap_to_python(YAP_Term t, bool eval);
extern PyObject *term_to_python(term_t t, bool eval); extern PyObject *term_to_python(term_t t, bool eval);
extern foreign_t python_to_ptr(PyObject *pVal, term_t t); 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 = 'YAP'
implementation_version = release.version implementation_version = release.version
language_info = { language_info = {
'name': 'python', 'name': 'prolog',
'version': sys.version.split()[0], 'version': sys.version.split()[0],
'mimetype': 'text/x-python', 'mimetype': 'text/x-prolog',
'codemirror_mode': { 'codemirror_mode': {
'name': 'prolog', 'name': 'prolog',
'version': sys.version_info[0] '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, * Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301, USA. * Boston, MA 02110-1301, USA.
*/ */
#include <stdio.h>
#include <stdarg.h> #include <stdarg.h>
#include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include "raptor_config.h"
#include "YapInterface.h" #include "YapInterface.h"
#include "raptor_config.h"
#ifdef HAVE_RAPTOR2_RAPTOR2_H #ifdef HAVE_RAPTOR2_RAPTOR2_H
#include "raptor2/raptor2.h" #include "raptor2/raptor2.h"
#else #else
#include "raptor2.h" #include "raptor2.h"
#endif #endif
void raptor_yap_init (void); void raptor_yap_init(void);
raptor_world* world; raptor_world *world;
struct exo_aux { struct exo_aux {
YAP_Functor functor; YAP_Functor functor;
@ -38,25 +38,26 @@ struct exo_aux {
size_t n; size_t n;
}; };
static YAP_Atom static YAP_Atom term_load(const raptor_term *term) {
term_load(const raptor_term *term)
{
size_t len; size_t len;
switch(term->type) { switch (term->type) {
case RAPTOR_TERM_TYPE_LITERAL: 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); return YAP_LookupAtom((const char *)term->value.literal.string);
case RAPTOR_TERM_TYPE_BLANK: 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); return YAP_LookupAtom((const char *)term->value.blank.string);
case RAPTOR_TERM_TYPE_URI: case RAPTOR_TERM_TYPE_URI:
// fprintf(stderr, "%s,", raptor_uri_as_counted_string(term->value.uri, &len)); // fprintf(stderr, "%s,",
return YAP_LookupAtom((const char *)raptor_uri_as_counted_string(term->value.uri, &len)); // 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: case RAPTOR_TERM_TYPE_UNKNOWN:
default: default:
raptor_log_error_formatted(term->world, RAPTOR_LOG_LEVEL_ERROR, NULL, raptor_log_error_formatted(term->world, RAPTOR_LOG_LEVEL_ERROR, NULL,
"Triple has unsupported term type %d", "Triple has unsupported term type %d",
term->type); term->type);
@ -68,42 +69,36 @@ term_load(const raptor_term *term)
static int so_far = 0; static int so_far = 0;
static void static void load_triples(void *user_data, raptor_statement *triple) {
load_triples(void* user_data, raptor_statement* triple) struct exo_aux *aux = (struct exo_aux *)user_data;
{
struct exo_aux *aux = (struct exo_aux *) user_data;
YAP_Term args[4]; 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[0] = YAP_MkAtomTerm(term_load(triple->subject));
args[1] = YAP_MkAtomTerm(term_load(triple->predicate)); args[1] = YAP_MkAtomTerm(term_load(triple->predicate));
args[2] = YAP_MkAtomTerm(term_load(triple->object)); 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 static void count_triples(void *user_data, raptor_statement *triple) {
count_triples(void* user_data, raptor_statement* triple) unsigned int *count_p = (unsigned int *)user_data;
{
unsigned int* count_p = (unsigned int*)user_data;
(*count_p)++; (*count_p)++;
term_load(triple->subject); term_load(triple->subject);
term_load(triple->predicate); term_load(triple->predicate);
term_load(triple->object); term_load(triple->object);
// fprintf(stderr, "\n"); // fprintf(stderr, "\n");
} }
static YAP_Bool static YAP_Bool load(void) {
load(void)
{
YAP_Term tfn = YAP_ARG1; YAP_Term tfn = YAP_ARG1;
YAP_Term mod = YAP_ARG2; YAP_Term mod = YAP_ARG2;
YAP_Term tfunctor = YAP_ARG3; YAP_Term tfunctor = YAP_ARG3;
const char *filename; const char *filename;
raptor_parser* rdf_parser = NULL; raptor_parser *rdf_parser = NULL;
unsigned int count; unsigned int count;
unsigned char *uri_string; unsigned char *uri_string;
raptor_uri *uri, *base_uri; raptor_uri *uri, *base_uri;
@ -123,8 +118,8 @@ load(void)
base_uri = raptor_uri_copy(uri); base_uri = raptor_uri_copy(uri);
count = 0; count = 0;
if(!raptor_parser_parse_file(rdf_parser, uri, base_uri)) { if (!raptor_parser_parse_file(rdf_parser, uri, base_uri)) {
// fprintf(stderr, "%s : %d triples\n", filename, count); // fprintf(stderr, "%s : %d triples\n", filename, count);
} else { } else {
fprintf(stderr, "%s : failed to parse\n", filename); fprintf(stderr, "%s : failed to parse\n", filename);
return FALSE; return FALSE;
@ -136,17 +131,17 @@ load(void)
size_t sz; size_t sz;
aux.functor = YAP_MkFunctor(YAP_AtomOfTerm(tfunctor), 3); aux.functor = YAP_MkFunctor(YAP_AtomOfTerm(tfunctor), 3);
aux.pred = YAP_FunctorToPredInModule( aux.functor, mod ); aux.pred = YAP_FunctorToPredInModule(aux.functor, mod);
sz = 3*sizeof(YAP_CELL)*count; 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"); fprintf(stderr, "Failed to alocate space\n");
return FALSE; return FALSE;
} }
aux.n = 0; aux.n = 0;
raptor_parser_set_statement_handler(rdf_parser, (void *) &aux, load_triples); raptor_parser_set_statement_handler(rdf_parser, (void *)&aux, load_triples);
if(!raptor_parser_parse_file(rdf_parser, uri, base_uri)) { if (!raptor_parser_parse_file(rdf_parser, uri, base_uri)) {
fprintf(stderr, "%s : %d triples\n", filename, count); fprintf(stderr, "%s : %d triples\n", filename, count);
} }
} }
@ -160,16 +155,13 @@ load(void)
return TRUE; return TRUE;
} }
static inline void static inline void raptor_yap_halt(int exit, void *world) {
raptor_yap_halt (int exit, void* world) raptor_free_world((raptor_world *)world);
{
raptor_free_world((raptor_world*) world);
} }
void raptor_yap_init (void) void raptor_yap_init(void) {
{
world = raptor_new_world(); world = raptor_new_world();
YAP_HaltRegisterHook (raptor_yap_halt, (void *) world); YAP_HaltRegisterHook(raptor_yap_halt, (void *)world);
YAP_UserCPredicate("rdf_load", load, 3); YAP_UserCPredicate("rdf_load", load, 3);
} }

44
pl/dbload.yap
View File

@ -27,41 +27,16 @@
:- dynamic dbloading/6, dbprocess/2. :- dynamic dbloading/6, dbprocess/2.
dbload_from_stream(R, M0, Type) :- dbload_from_stream(R, M0, rdf, term ) :-
repeat, '$lines_in_file'(R, Lines),
read(R,T), '$input_lines'(R, Type, Lines),
( T == end_of_file -> !, close_dbload(R, Type); dbload_from_stream(R, M0, Type, Storage ) :-
dbload_count(T, M0), '$lines_in_file'(R, Lines),
fail '$input_lines'(R, Type, Lines),
).
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(_, _).
'$input_lines'(R, csv, yeLines ) :-
'$process_lines'(R, Lines, Type ),
close(R).
prolog:load_db(Fs) :- prolog:load_db(Fs) :-
'$current_module'(M0), '$current_module'(M0),
@ -199,4 +174,3 @@ clean_up :-
retractall(dbprocess(_,_)), retractall(dbprocess(_,_)),
fail. fail.
clean_up. clean_up.

5
pl/signals.yap
View File

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