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

less invasive error handling

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

7
C/absmi_insts.i
View File

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

89
C/atomic.c
View File

@ -527,18 +527,23 @@ static Int number_chars(USES_REGS1) {
restart_aux:
t1 = Deref(ARG1);
if (IsNumTerm(t1)) {
Term tf;
tf = Yap_NumberToListOfAtoms(t1 PASS_REGS);
if (tf) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return Yap_unify(ARG2, tf);
Term t2 = Deref(ARG2);
if (IsVarTerm(t2)) {
t1 = Yap_NumberToListOfAtoms(t1 PASS_REGS);
}
if (t1) {
return Yap_unify(t1, t2);
} else {
t2 = Yap_ListToNumber(t2 PASS_REGS);
if (t2) {
return Yap_unify(t1, t2);
}
}
} else if (IsVarTerm(t1)) {
/* ARG1 unbound */
Term t = Deref(ARG2);
Term tf = Yap_ListToNumber(t PASS_REGS);
if (tf) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return Yap_unify(ARG1, tf);
}
} else if (IsVarTerm(t1)) {
@ -556,16 +561,25 @@ static Int number_atom(USES_REGS1) {
restart_aux:
t1 = Deref(ARG1);
if (IsNumTerm(t1)) {
Term t2 = Deref(ARG2);
Atom af;
af = Yap_NumberToAtom(t1 PASS_REGS);
if (af)
return Yap_unify(ARG2, MkAtomTerm(af));
if (af) {
if (IsVarTerm(t2)) {
return Yap_unify(t1, t2);
} else {
t2 = Yap_AtomToNumber(t2 PASS_REGS);
if (t2) {
return Yap_unify(t1, t2);
}
}
}
} else if (IsVarTerm(t1)) {
/* ARG1 unbound */
Term t = Deref(ARG2);
Term tf = Yap_AtomToNumber(t PASS_REGS);
if (tf)
return Yap_unify(ARG1, tf);
return Yap_unify(ARG1, tf);
} else if (IsVarTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
} /* error handling */
@ -634,8 +648,8 @@ restart_aux:
i = IntOfTerm(EXTRA_CBACK_ARG(3, 1));
max = IntOfTerm(EXTRA_CBACK_ARG(3, 2));
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1);
if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS) && LOCAL_Error_TYPE ==
YAP_NO_ERROR) {
if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS) &&
LOCAL_Error_TYPE == YAP_NO_ERROR) {
cut_fail();
} else {
if (i < max)
@ -666,9 +680,9 @@ restart_aux:
t1 = Deref(ARG1);
t2 = Deref(ARG2);
t3 = Deref(ARG3);
g1 = Yap_IsGroundTerm(t1);
g2 = Yap_IsGroundTerm(t2);
g3 = Yap_IsGroundTerm(t3);
g1 = Yap_IsGroundTerm(t1);
g2 = Yap_IsGroundTerm(t2);
g3 = Yap_IsGroundTerm(t3);
if (g1 && g2) {
at = Yap_ConcatAtoms(t1, t2 PASS_REGS);
ot = ARG3;
@ -677,15 +691,14 @@ restart_aux:
ot = ARG2;
} else if (g2 && g3) {
at = Yap_SubtractTailAtom(t3, t2 PASS_REGS);
ot = ARG1;
ot = ARG1;
} else if (g3) {
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0);
EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_AtomToLength(t3 PASS_REGS));
return cont_atom_concat3(PASS_REGS1);
} else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
at = NULL;
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
at = NULL;
}
if (at) {
if (Yap_unify(ot, MkAtomTerm(at)))
@ -704,7 +717,6 @@ restart_aux:
cut_fail();
}
#define CastToNumeric(x) CastToNumeric__(x PASS_REGS)
static Term CastToNumeric__(Atom at USES_REGS) {
@ -754,9 +766,9 @@ restart_aux:
t1 = Deref(ARG1);
t2 = Deref(ARG2);
t3 = Deref(ARG3);
g1 = Yap_IsGroundTerm(t1);
g2 = Yap_IsGroundTerm(t2);
g3 = Yap_IsGroundTerm(t3);
g1 = Yap_IsGroundTerm(t1);
g2 = Yap_IsGroundTerm(t2);
g3 = Yap_IsGroundTerm(t3);
if (g1 && g2) {
at = Yap_ConcatAtomics(t1, t2 PASS_REGS);
ot = ARG3;
@ -765,15 +777,14 @@ restart_aux:
ot = ARG2;
} else if (g2 && g3) {
at = Yap_SubtractTailAtom(t3, t2 PASS_REGS);
ot = ARG1;
ot = ARG1;
} else if (g3) {
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0);
EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_AtomicToLength(t3 PASS_REGS));
return cont_atomic_concat3(PASS_REGS1);
} else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
at = NULL;
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
at = NULL;
}
if (at) {
if (Yap_unify(ot, MkAtomTerm(at)))
@ -831,9 +842,9 @@ restart_aux:
t1 = Deref(ARG1);
t2 = Deref(ARG2);
t3 = Deref(ARG3);
g1 = Yap_IsGroundTerm(t1);
g2 = Yap_IsGroundTerm(t2);
g3 = Yap_IsGroundTerm(t3);
g1 = Yap_IsGroundTerm(t1);
g2 = Yap_IsGroundTerm(t2);
g3 = Yap_IsGroundTerm(t3);
if (g1 && g2) {
tf = Yap_ConcatStrings(t1, t2 PASS_REGS);
ot = ARG3;
@ -842,15 +853,14 @@ restart_aux:
ot = ARG2;
} else if (g2 && g3) {
tf = Yap_SubtractTailString(t3, t2 PASS_REGS);
ot = ARG1;
ot = ARG1;
} else if (g3) {
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0);
EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_StringToLength(t3 PASS_REGS));
return cont_string_concat3(PASS_REGS1);
} else {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
at = NULL;
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
at = NULL;
}
if (tf) {
if (Yap_unify(ot, tf))
@ -913,10 +923,8 @@ restart_aux:
t2 = Deref(ARG2);
if (IsVarTerm(t2)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t2;
} else if (!IsStringTerm(t2)) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_Error_Term = t2;
} else {
s = UStringOfTerm(t2);
t1 = Deref(ARG1);
@ -926,7 +934,6 @@ restart_aux:
return cont_string_code3(PASS_REGS1);
} else if (!IsIntegerTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_INTEGER;
LOCAL_Error_Term = t1;
} else {
const unsigned char *ns = s;
utf8proc_int32_t chr;
@ -934,7 +941,6 @@ restart_aux:
if (indx <= 0) {
if (indx < 0) {
LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
LOCAL_Error_Term = t1;
}
cut_fail();
}
@ -970,19 +976,16 @@ restart_aux:
t2 = Deref(ARG2);
if (IsVarTerm(t2)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t2;
} else if (!IsStringTerm(t2)) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_Error_Term = t2;
} else {
s = UStringOfTerm(t2);
t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t1;
} else if (!IsIntegerTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_INTEGER;
LOCAL_Error_Term = t1;
} else {
const unsigned char *ns = s;
utf8proc_int32_t chr;
@ -991,7 +994,6 @@ restart_aux:
if (indx <= 0) {
if (indx < 0) {
LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
LOCAL_Error_Term = t1;
} else {
return false;
}
@ -1813,7 +1815,6 @@ static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p,
src = skip_utf8((unsigned char *)src, min);
const unsigned char *cp = src;
LOCAL_TERM_ERROR(t, 4 * (len + 1));
buf = buf_from_tstring(HR);
while (len) {
utf8proc_int32_t chr;

9
C/cdmgr.c
View File

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

846
C/cmppreds.c
View File

File diff suppressed because it is too large Load Diff

2869
C/compiler.c
View File

File diff suppressed because it is too large Load Diff

12
C/dbase.c
View File

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

70
C/errors.c
View File

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

343
C/eval.c
View File

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

18
C/exec.c
View File

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

4
C/flags.c
View File

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

11
C/load_dl.c
View File

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

3
C/load_foreign.c
View File

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

7
C/parser.c
View File

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

1855
C/prim_absmi_insts.h
View File

File diff suppressed because it is too large Load Diff

8
C/save.c
View File

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

3
C/scanner.c
View File

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

32
C/stack.c
View File

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

56
C/text.c
View File

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

41
CXX/yapi.cpp
View File

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

10
CXX/yapie.hh
View File

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

11
CXX/yapq.hh
View File

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

12
H/LOCALS
View File

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

42
H/YapText.h
View File

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

57
H/absmi.h
View File

@ -99,7 +99,8 @@ register struct yami *P1REG asm("bp"); /* can't use yamop before Yap.h */
#define LIMITED_PREFETCH 1
#endif /* __x86_64__ */
#if defined(__arm__) || defined(__thumb__) || defined(mips) || defined(__mips64) || defined(__aarch64__)
#if defined(__arm__) || defined(__thumb__) || defined(mips) || \
defined(__mips64) || defined(__aarch64__)
#define Y_IN_MEM 1
#define S_IN_MEM 1
@ -215,13 +216,13 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define BEGP(TMP) \
{ \
register CELL *TMP
register CELL *TMP
#define ENDP(TMP) }
#define BEGD(TMP) \
{ \
register CELL TMP
register CELL TMP
#define ENDD(TMP) }
@ -229,7 +230,7 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define BEGCHO(TMP) \
{ \
register choiceptr TMP
register choiceptr TMP
#define ENDCHO(TMP) }
@ -242,7 +243,7 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define CACHE_Y(A) \
{ \
register CELL *S_YREG = ((CELL *)(A))
register CELL *S_YREG = ((CELL *)(A))
#define ENDCACHE_Y() \
YREG = S_YREG; \
@ -258,7 +259,7 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define CACHE_Y(A) \
{ \
YREG = ((CELL *)(A))
YREG = ((CELL *)(A))
#define ENDCACHE_Y() }
@ -268,7 +269,7 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define CACHE_Y_AS_ENV(A) \
{ \
register CELL *ENV_YREG = (A)
register CELL *ENV_YREG = (A)
#define FETCH_Y_FROM_ENV(A) ENV_YREG = (A)
@ -292,7 +293,7 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define CACHE_Y_AS_ENV(A) \
{ \
YREG = (A)
YREG = (A)
#define FETCH_Y_FROM_ENV(A) (A)
@ -345,7 +346,7 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define CACHE_TR(A) \
{ \
register tr_fr_ptr S_TR = (A)
register tr_fr_ptr S_TR = (A)
#define RESTORE_TR() TR = S_TR
@ -467,7 +468,7 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define ALWAYS_START_PREFETCH(TYPE) \
{ \
register void *to_go; \
DO_PREFETCH(TYPE)
DO_PREFETCH(TYPE)
#if YAP_JIT
#define ALWAYS_LOOKAHEAD(WHAT) \
@ -487,7 +488,7 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define ALWAYS_START_PREFETCH_W(TYPE) \
{ \
register void *to_go; \
DO_PREFETCH_W(TYPE)
DO_PREFETCH_W(TYPE)
#else
@ -909,14 +910,14 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
(ExpEnv.config_struc.current_displacement) \
? print_instruction(PREG, ON_PROFILED_INTERPRETER) \
: print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH(Type)
START_PREFETCH(Type)
#define OpW(Label, Type) \
_##Label : { \
(ExpEnv.config_struc.current_displacement) \
? print_instruction(PREG, ON_PROFILED_INTERPRETER) \
: print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH_W(Type)
START_PREFETCH_W(Type)
#define BOp(Label, Type) \
_##Label : { \
@ -929,7 +930,7 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
(ExpEnv.config_struc.current_displacement) \
? print_instruction(PREG, ON_PROFILED_INTERPRETER) \
: print_instruction(PREG, ON_INTERPRETER); \
INIT_PREFETCH()
INIT_PREFETCH()
#define OpRW(Label, Type) \
_##Label : { \
@ -942,12 +943,12 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define Op(Label, Type) \
_##Label : { \
print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH(Type)
START_PREFETCH(Type)
#define OpW(Label, Type) \
_##Label : { \
print_instruction(PREG, ON_INTERPRETER); \
START_PREFETCH_W(Type)
START_PREFETCH_W(Type)
#define BOp(Label, Type) \
_##Label : { \
@ -956,7 +957,7 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define PBOp(Label, Type) \
_##Label : { \
print_instruction(PREG, ON_INTERPRETER); \
INIT_PREFETCH()
INIT_PREFETCH()
#define OpRW(Label, Type) \
_##Label : { \
@ -968,17 +969,17 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define Op(Label, Type) \
_##Label : { \
START_PREFETCH(Type)
START_PREFETCH(Type)
#define OpW(Label, Type) \
_##Label : { \
START_PREFETCH_W(Type)
START_PREFETCH_W(Type)
#define BOp(Label, Type) _##Label : {
#define PBOp(Label, Type) \
_##Label : { \
INIT_PREFETCH()
INIT_PREFETCH()
#define OpRW(Label, Type) _##Label : {
@ -1000,17 +1001,17 @@ INLINE_ONLY inline EXTERN void restore_absmi_regs(REGSTORE *old_regs) {
#define Op(Label, Type) \
case _##Label: { \
START_PREFETCH(Type)
START_PREFETCH(Type)
#define OpW(Label, Type) \
case _##Label: { \
START_PREFETCH_W(Type)
START_PREFETCH_W(Type)
#define BOp(Label, Type) case _##Label: {
#define PBOp(Label, Type) \
case _##Label: { \
INIT_PREFETCH()
INIT_PREFETCH()
#define OpRW(Label, Type) case _##Label: {
@ -2075,7 +2076,8 @@ cufail:
#endif
#if /* defined(IN_ABSMI_C) ||*/ defined(IN_INLINES_C) /*|| defined(IN_TRACED_ABSMI_C) */
#if /* defined(IN_ABSMI_C) ||*/ defined( \
IN_INLINES_C) /*|| defined(IN_TRACED_ABSMI_C) */
static int iequ_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt1) {
@ -2450,4 +2452,11 @@ extern yamop *headoftrace;
ENDD(d0);
#endif
#define Yap_AsmError(e) \
{ \
saveregs(); \
Yap_Error(e, 0, ""); \
setregs(); \
}
#endif // ABSMI_H

17
H/eval.h
View File

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

14
H/generated/dlocals.h
View File

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

11
H/generated/hlocals.h
View File

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

11
H/generated/ilocals.h
View File

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

5
H/generated/rlocals.h
View File

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

1444
H/walkclause.h
View File

File diff suppressed because it is too large Load Diff

50
include/YapError.h
View File

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

27
os/iopreds.c
View File

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

55
os/iopreds.h
View File

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

308
os/readterm.c
View File

@ -8,9 +8,9 @@
* *
**************************************************************************
* *
* File: iopreds.c *
* File: iopreds.c *
* Last rev: 5/2/88 *
* mods: *
* mods: *
* comments: Input/Output C implemented predicates *
* *
*************************************************************************/
@ -95,7 +95,7 @@ static char SccsId[] = "%W% %G%";
#define SYSTEM_STAT stat
#endif
static Term syntax_error(TokEntry *errtok, int sno, Term cmod);
static char *syntax_error(TokEntry *errtok, int sno, Term cmod);
static void clean_vars(VarEntry *p) {
if (p == NULL)
@ -120,9 +120,9 @@ reflects the location in the real file.
static Int qq_open(USES_REGS1) {
PRED_LD
Term t = Deref(ARG1);
Term t = Deref(ARG1);
if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) =
FunctorDQuasiQuotation) {
FunctorDQuasiQuotation) {
void *ptr;
char *start;
size_t l int s;
@ -173,26 +173,26 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) {
} else
return TRUE;
} else if (_PL_rd->quasi_quotations) /* user option, but no quotes */
{
return PL_unify_nil(_PL_rd->quasi_quotations);
} else
{
return PL_unify_nil(_PL_rd->quasi_quotations);
} else
return TRUE;
}
#endif /*O_QUASIQUOTATIONS*/
#define READ_DEFS() \
PAR("comments", list_filler, READ_COMMENTS) \
, PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \
PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \
PAR("term_position", filler, READ_TERM_POSITION), \
PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \
PAR("singletons", filler, READ_SINGLETONS), \
PAR("variables", filler, READ_VARIABLES), \
PAR("variable_names", filler, READ_VARIABLE_NAMES), \
PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \
PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \
PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END)
#define READ_DEFS() \
PAR("comments", list_filler, READ_COMMENTS) \
, PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \
PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \
PAR("term_position", filler, READ_TERM_POSITION), \
PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \
PAR("singletons", filler, READ_SINGLETONS), \
PAR("variables", filler, READ_VARIABLES), \
PAR("variable_names", filler, READ_VARIABLE_NAMES), \
PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \
PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \
PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END)
#define PAR(x, y, z) z
@ -200,7 +200,7 @@ typedef enum open_enum_choices { READ_DEFS() } read_choices_t;
#undef PAR
#define PAR(x, y, z) \
#define PAR(x, y, z) \
{ x, y, z }
static const param_t read_defs[] = {READ_DEFS()};
@ -215,9 +215,9 @@ static const param_t read_defs[] = {READ_DEFS()};
* Implicit arguments:
* +
*/
static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
static char * syntax_error(TokEntry *errtok, int sno, Term cmod) {
CACHE_REGS
Term info;
Term info;
Term startline, errline, endline;
Term tf[4];
Term *tailp = tf + 3;
@ -264,85 +264,67 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
t0[0] = TermNil;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
}
break;
case QuasiQuotes_tok:
{
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
}
break;
case WQuasiQuotes_tok:
{
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
}
break;
} break;
case QuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case WQuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo));
break;
case Var_tok:
{
Term t[2];
VarEntry *varinfo = (VarEntry *)info;
case Var_tok: {
Term t[2];
VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
t[0] = MkIntTerm(0);
t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
} break;
case String_tok: {
Term t0 = Yap_CharsToTDQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
if (!t0) {
return 0;
}
break;
case String_tok:
{
Term t0 = Yap_CharsToTDQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
if (!t0) {
return 0;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
}
break;
case WString_tok:
{
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS);
if (!t0)
return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
}
break;
case BQString_tok:
{
Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
}
break;
case WBQString_tok:
{
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
}
break;
case Error_tok:
{
ts[0] = MkAtomTerm(AtomError);
}
break;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case WString_tok: {
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS);
if (!t0)
return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case BQString_tok: {
Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case WBQString_tok: {
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case Error_tok: {
ts[0] = MkAtomTerm(AtomError);
} break;
case eot_tok:
endline = MkIntegerTerm(tok->TokPos);
ts[0] = MkAtomTerm(Yap_LookupAtom("EOT"));
break;
case Ponctuation_tok:
{
char s[2];
s[1] = '\0';
if ((info) == 'l') {
s[0] = '(';
} else {
s[0] = (char)info;
}
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
case Ponctuation_tok: {
char s[2];
s[1] = '\0';
if ((info) == 'l') {
s[0] = '(';
} else {
s[0] = (char)info;
}
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
}
}
if (tok->TokNext) {
tok = tok->TokNext;
@ -379,10 +361,10 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
Yap_DebugPlWriteln(terr);
}
#endif
return terr;
return NULL;
}
Term Yap_syntax_error(TokEntry *errtok, int sno) {
char * Yap_syntax_error(TokEntry *errtok, int sno) {
return syntax_error(errtok, sno, CurrentModule);
}
@ -420,7 +402,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
int inp_stream);
static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
CACHE_REGS
LOCAL_VarTable = NULL;
LOCAL_VarTable = NULL;
LOCAL_AnonVarTable = NULL;
fe->enc = GLOBAL_Stream[inp_stream].encoding;
xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END);
@ -517,7 +499,7 @@ typedef enum {
Int Yap_FirstLineInParse(void) {
CACHE_REGS
return LOCAL_StartLineCount;
return LOCAL_StartLineCount;
}
#define PUSHFET(X) *HR++ = fe->X
@ -526,7 +508,7 @@ Int Yap_FirstLineInParse(void) {
static void reset_regs(TokEntry *tokstart, FEnv *fe) {
CACHE_REGS
restore_machine_regs();
restore_machine_regs();
/* restart global */
PUSHFET(qq);
@ -553,7 +535,7 @@ static void reset_regs(TokEntry *tokstart, FEnv *fe) {
static Term get_variables(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v;
Term v;
if (fe->vp) {
while (true) {
fe->old_H = HR;
@ -573,7 +555,7 @@ static Term get_variables(FEnv *fe, TokEntry *tokstart) {
static Term get_varnames(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v;
Term v;
if (fe->np) {
while (true) {
fe->old_H = HR;
@ -593,7 +575,7 @@ static Term get_varnames(FEnv *fe, TokEntry *tokstart) {
static Term get_singletons(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v;
Term v;
if (fe->sp) {
while (TRUE) {
fe->old_H = HR;
@ -611,7 +593,7 @@ static Term get_singletons(FEnv *fe, TokEntry *tokstart) {
static void warn_singletons(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v;
Term v;
fe->sp = TermNil;
v = get_singletons(fe, tokstart);
if (v && v != TermNil) {
@ -633,7 +615,7 @@ static void warn_singletons(FEnv *fe, TokEntry *tokstart) {
static Term get_stream_position(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v;
Term v;
if (fe->tp) {
while (true) {
fe->old_H = HR;
@ -651,7 +633,7 @@ static Term get_stream_position(FEnv *fe, TokEntry *tokstart) {
static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v1, v2, v3, vc, tp;
Term v1, v2, v3, vc, tp;
if (fe->t && fe->vp)
v1 = get_variables(fe, tokstart);
@ -679,15 +661,15 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
// trail must be ok by now.]
if (fe->t) {
return (!v1 || Yap_unify(v1, fe->vp)) && (!v2 || Yap_unify(v2, fe->np)) &&
(!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) &&
(!vc || Yap_unify(vc, fe->tcomms));
(!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) &&
(!vc || Yap_unify(vc, fe->tcomms));
}
return true;
}
static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v_vp, v_vnames, v_comments, v_pos;
Term v_vp, v_vnames, v_comments, v_pos;
if (fe->t && fe->vp)
v_vp = get_variables(fe, tokstart);
@ -713,9 +695,9 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
// trail must be ok by now.]
if (fe->t) {
return (!v_vp || Yap_unify(v_vp, fe->vp)) &&
(!v_vnames || Yap_unify(v_vnames, fe->np)) &&
(!v_pos || Yap_unify(v_pos, fe->tp)) &&
(!v_comments || Yap_unify(v_comments, fe->tcomms));
(!v_vnames || Yap_unify(v_vnames, fe->np)) &&
(!v_pos || Yap_unify(v_pos, fe->tp)) &&
(!v_comments || Yap_unify(v_comments, fe->tcomms));
}
return true;
}
@ -733,8 +715,8 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream);
static parser_state_t scanEOF(FEnv *fe, int inp_stream) {
CACHE_REGS
// bool store_comments = false;
TokEntry *tokstart = LOCAL_tokptr;
// bool store_comments = false;
TokEntry *tokstart = LOCAL_tokptr;
// check for an user abort
if (tokstart != NULL && tokstart->Tok != Ord(eot_tok)) {
/* we got the end of file from an abort */
@ -774,7 +756,7 @@ static parser_state_t scanEOF(FEnv *fe, int inp_stream) {
static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
int nargs) {
CACHE_REGS
LOCAL_ErrorMessage = NULL;
LOCAL_ErrorMessage = NULL;
fe->old_TR = TR;
LOCAL_Error_TYPE = YAP_NO_ERROR;
LOCAL_SourceFileName = GLOBAL_Stream[inp_stream].name;
@ -790,10 +772,10 @@ static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
fe->args = setReadEnv(opts, fe, re, inp_stream);
}
if (fe->args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_READ_OPTION)
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
fe->t = 0;
return YAP_PARSING_FINISHED;
;
@ -811,11 +793,11 @@ static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
CACHE_REGS
/* preserve value of H after scanning: otherwise we may lose strings
and floats */
LOCAL_tokptr = LOCAL_toktide =
/* preserve value of H after scanning: otherwise we may lose strings
and floats */
LOCAL_tokptr = LOCAL_toktide =
Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos);
Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos);
if (LOCAL_ErrorMessage)
return YAP_SCANNING_ERROR;
if (LOCAL_tokptr->Tok != Ord(eot_tok)) {
@ -828,7 +810,6 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
strncpy(out, "Empty clause", len);
LOCAL_ErrorMessage = out;
LOCAL_Error_TYPE = SYNTAX_ERROR;
LOCAL_Error_Term = TermEof;
return YAP_PARSING_ERROR;
}
return scanEOF(fe, inp_stream);
@ -836,7 +817,7 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) {
CACHE_REGS
fe->t = 0;
fe->t = 0;
// running out of memory
if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -876,7 +857,7 @@ static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) {
static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
CACHE_REGS
fe->t = 0;
fe->t = 0;
if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL ||
LOCAL_Error_TYPE == RESOURCE_ERROR_AUXILIARY_STACK ||
LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP ||
@ -889,13 +870,14 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return YAP_PARSING_FINISHED;
} else {
Term terr = syntax_error(fe->toklast, inp_stream, fe->cmod);
const char*s = syntax_error(fe->toklast, inp_stream, fe->cmod);
if (ParserErrorStyle == TermError) {
LOCAL_ErrorMessage = NULL;
LOCAL_ErrorMessage = s;
LOCAL_Error_TYPE = SYNTAX_ERROR;
return YAP_PARSING_FINISHED;
// dec-10
} else if (Yap_PrintWarning(terr)) {
} else if (Yap_PrintWarning(MkStringTerm(s))) {
free(s);
LOCAL_Error_TYPE = YAP_NO_ERROR;
return YAP_SCANNING;
}
@ -906,7 +888,7 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) {
CACHE_REGS
TokEntry *tokstart = LOCAL_tokptr;
TokEntry *tokstart = LOCAL_tokptr;
fe->t = Yap_Parse(re->prio, fe->enc, fe->cmod);
fe->toklast = LOCAL_tokptr;
LOCAL_tokptr = tokstart;
@ -961,34 +943,33 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
case YAP_PARSING_ERROR:
state = parseError(&re, &fe, inp_stream);
break;
case YAP_PARSING_FINISHED:
{
CACHE_REGS
bool done;
if (fe.reading_clause)
done = complete_clause_processing(&fe, LOCAL_tokptr);
else
done = complete_processing(&fe, LOCAL_tokptr);
if (!done) {
state = YAP_PARSING_ERROR;
fe.t = 0;
break;
}
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
}
#if EMACS
first_char = tokstart->TokPos;
#endif /* EMACS */
return fe.t;
case YAP_PARSING_FINISHED: {
CACHE_REGS
bool done;
if (fe.reading_clause)
done = complete_clause_processing(&fe, LOCAL_tokptr);
else
done = complete_processing(&fe, LOCAL_tokptr);
if (!done) {
state = YAP_PARSING_ERROR;
fe.t = 0;
break;
}
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
}
#if EMACS
first_char = tokstart->TokPos;
#endif /* EMACS */
return fe.t;
}
}
}
return 0;
}
static Int
read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
Term rc;
yhandle_t h = Yap_PushHandle(ARG1);
if ((rc = Yap_read_term(LOCAL_c_input_stream, ARG2, 2)) == 0)
@ -998,7 +979,7 @@ read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
}
static Int read_term(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
int inp_stream;
Term out;
@ -1015,14 +996,14 @@ static Int read_term(
return out != 0L && Yap_unify(tf, out);
}
#define READ_CLAUSE_DEFS() \
PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \
, PAR("module", isatom, READ_CLAUSE_MODULE), \
PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \
PAR("variables", filler, READ_CLAUSE_VARIABLES), \
PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \
PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \
PAR(NULL, ok, READ_CLAUSE_END)
#define READ_CLAUSE_DEFS() \
PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \
, PAR("module", isatom, READ_CLAUSE_MODULE), \
PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \
PAR("variables", filler, READ_CLAUSE_VARIABLES), \
PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \
PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \
PAR(NULL, ok, READ_CLAUSE_END)
#define PAR(x, y, z) z
@ -1032,7 +1013,7 @@ typedef enum read_clause_enum_choices {
#undef PAR
#define PAR(x, y, z) \
#define PAR(x, y, z) \
{ x, y, z }
static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()};
@ -1042,7 +1023,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
int inp_stream) {
CACHE_REGS
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END);
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END);
if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
@ -1136,7 +1117,7 @@ static Int read_clause2(USES_REGS1) {
* + The `singletons` option is set from the single var flag
*/
static Int read_clause(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
int inp_stream;
Term out;
Term t3 = Deref(ARG3);
@ -1165,7 +1146,8 @@ static Int read_clause(
/**
* @pred source_location( - _File_ , _Line_ )
*
* unify _File_ and _Line_ wuth the position of the last term read, if the term
* unify _File_ and _Line_ wuth the position of the last term read, if the
*term
* comes from a stream created by opening a file-system path with open/3 and
*friends.>position
* It ignores user_input or
@ -1178,7 +1160,7 @@ static Int read_clause(
*/
static Int source_location(USES_REGS1) {
return Yap_unify(ARG1, MkAtomTerm(LOCAL_SourceFileName)) &&
Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno));
Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno));
}
/**
@ -1192,7 +1174,7 @@ static Int source_location(USES_REGS1) {
*
*/
static Int read2(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
int inp_stream;
Int out;
@ -1217,7 +1199,7 @@ the same stream may cause an error failure (see open/3).
*/
static Int read1(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
Term out = Yap_read_term(LOCAL_c_input_stream, TermNil, 1);
return out && Yap_unify(ARG1, out);
}
@ -1242,7 +1224,7 @@ static Int fileerrors(USES_REGS1) {
*/
static Int nofileerrors(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
return setYapFlag(TermFileerrors, TermFalse);
}
@ -1293,7 +1275,7 @@ static Int style_checker(USES_REGS1) {
X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp,
int prio, Term *bindings) {
CACHE_REGS
Term bvar = MkVarTerm(), ctl;
Term bvar = MkVarTerm(), ctl;
yhandle_t sl;
if (len == 0) {

121
os/sig.c
View File

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

3
os/sysbits.h
View File

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

485
os/time.c
View File

@ -27,10 +27,10 @@
#if THREADS
#define StartOfTimes (*(LOCAL_ThreadHandle.start_of_timesp))
#define last_time (*(LOCAL_ThreadHandle.last_timep))
#define last_time (*(LOCAL_ThreadHandle.last_timep))
#define StartOfTimes_sys (*(LOCAL_ThreadHandle.start_of_times_sysp))
#define last_time_sys (*(LOCAL_ThreadHandle.last_time_sysp))
#define last_time_sys (*(LOCAL_ThreadHandle.last_time_sysp))
#else
/* since the point YAP was started */
@ -45,82 +45,71 @@ static struct timeval StartOfTimes_sys;
#endif
/* store user time in this variable */
void
Yap_InitTime (int wid)
{
struct rusage rusage;
void Yap_InitTime(int wid) {
struct rusage rusage;
#if THREADS
REMOTE_ThreadHandle(wid).start_of_timesp = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).last_timep = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).start_of_times_sysp = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).last_time_sysp = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).start_of_timesp =
(struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).last_timep =
(struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).start_of_times_sysp =
(struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).last_time_sysp =
(struct timeval *)malloc(sizeof(struct timeval));
getrusage(RUSAGE_SELF, &rusage);
(*REMOTE_ThreadHandle(wid).last_timep).tv_sec =
(*REMOTE_ThreadHandle(wid).start_of_timesp).tv_sec =
rusage.ru_utime.tv_sec;
(*REMOTE_ThreadHandle(wid).start_of_timesp).tv_sec =
rusage.ru_utime.tv_sec;
(*REMOTE_ThreadHandle(wid).last_timep).tv_usec =
(*REMOTE_ThreadHandle(wid).start_of_timesp).tv_usec =
rusage.ru_utime.tv_usec;
(*REMOTE_ThreadHandle(wid).start_of_timesp).tv_usec =
rusage.ru_utime.tv_usec;
(*REMOTE_ThreadHandle(wid).last_time_sysp).tv_sec =
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).tv_sec =
rusage.ru_stime.tv_sec;
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).tv_sec =
rusage.ru_stime.tv_sec;
(*REMOTE_ThreadHandle(wid).last_time_sysp).tv_usec =
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).tv_usec =
rusage.ru_stime.tv_usec;
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).tv_usec =
rusage.ru_stime.tv_usec;
#else
getrusage(RUSAGE_SELF, &rusage);
last_time.tv_sec =
StartOfTimes.tv_sec =
rusage.ru_utime.tv_sec;
last_time.tv_usec =
StartOfTimes.tv_usec =
rusage.ru_utime.tv_usec;
last_time_sys.tv_sec =
StartOfTimes_sys.tv_sec =
rusage.ru_stime.tv_sec;
last_time_sys.tv_usec =
StartOfTimes_sys.tv_usec =
rusage.ru_stime.tv_usec;
last_time.tv_sec = StartOfTimes.tv_sec = rusage.ru_utime.tv_sec;
last_time.tv_usec = StartOfTimes.tv_usec = rusage.ru_utime.tv_usec;
last_time_sys.tv_sec = StartOfTimes_sys.tv_sec = rusage.ru_stime.tv_sec;
last_time_sys.tv_usec = StartOfTimes_sys.tv_usec = rusage.ru_stime.tv_usec;
#endif
}
UInt
Yap_cputime ( void )
{
UInt Yap_cputime(void) {
CACHE_REGS
struct rusage rusage;
struct rusage rusage;
getrusage(RUSAGE_SELF, &rusage);
return((rusage.ru_utime.tv_sec - StartOfTimes.tv_sec)) * 1000 +
((rusage.ru_utime.tv_usec - StartOfTimes.tv_usec) / 1000);
return ((rusage.ru_utime.tv_sec - StartOfTimes.tv_sec)) * 1000 +
((rusage.ru_utime.tv_usec - StartOfTimes.tv_usec) / 1000);
}
void Yap_cputime_interval(Int *now,Int *interval)
{
void Yap_cputime_interval(Int *now, Int *interval) {
CACHE_REGS
struct rusage rusage;
struct rusage rusage;
getrusage(RUSAGE_SELF, &rusage);
*now = (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;
*interval = (rusage.ru_utime.tv_sec - last_time.tv_sec) * 1000 +
(rusage.ru_utime.tv_usec - last_time.tv_usec) / 1000;
(rusage.ru_utime.tv_usec - last_time.tv_usec) / 1000;
last_time.tv_usec = rusage.ru_utime.tv_usec;
last_time.tv_sec = rusage.ru_utime.tv_sec;
}
void Yap_systime_interval(Int *now,Int *interval)
{
void Yap_systime_interval(Int *now, Int *interval) {
CACHE_REGS
struct rusage rusage;
struct rusage rusage;
getrusage(RUSAGE_SELF, &rusage);
*now = (rusage.ru_stime.tv_sec - StartOfTimes_sys.tv_sec) * 1000 +
(rusage.ru_stime.tv_usec - StartOfTimes_sys.tv_usec) / 1000;
(rusage.ru_stime.tv_usec - StartOfTimes_sys.tv_usec) / 1000;
*interval = (rusage.ru_stime.tv_sec - last_time_sys.tv_sec) * 1000 +
(rusage.ru_stime.tv_usec - last_time_sys.tv_usec) / 1000;
(rusage.ru_stime.tv_usec - last_time_sys.tv_usec) / 1000;
last_time_sys.tv_usec = rusage.ru_stime.tv_usec;
last_time_sys.tv_sec = rusage.ru_stime.tv_sec;
}
@ -132,24 +121,25 @@ void Yap_systime_interval(Int *now,Int *interval)
/* This is stolen from the Linux kernel.
The problem is that mingw32 does not seem to have acces to div */
#ifndef do_div
#define do_div(n,base) ({ \
unsigned long __upper, __low, __high, __mod; \
asm("":"=a" (__low), "=d" (__high):"A" (n)); \
__upper = __high; \
if (__high) { \
__upper = __high % (base); \
__high = __high / (base); \
} \
asm("divl %2":"=a" (__low), "=d" (__mod):"rm" (base), "0" (__low), "1" (__upper)); \
asm("":"=A" (n):"a" (__low),"d" (__high)); \
__mod; \
})
#define do_div(n, base) \
({ \
unsigned long __upper, __low, __high, __mod; \
asm("" : "=a"(__low), "=d"(__high) : "A"(n)); \
__upper = __high; \
if (__high) { \
__upper = __high % (base); \
__high = __high / (base); \
} \
asm("divl %2" \
: "=a"(__low), "=d"(__mod) \
: "rm"(base), "0"(__low), "1"(__upper)); \
asm("" : "=A"(n) : "a"(__low), "d"(__high)); \
__mod; \
})
#endif
#endif
#include <time.h>
static FILETIME StartOfTimes, last_time;
@ -159,148 +149,134 @@ static FILETIME StartOfTimes_sys, last_time_sys;
static clock_t TimesStartOfTimes, Times_last_time;
/* store user time in this variable */
void
Yap_InitTime (int wid)
{
void Yap_InitTime(int wid) {
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime,
&UserTime)) {
/* WIN98 */
clock_t t;
t = clock ();
t = clock();
Times_last_time = TimesStartOfTimes = t;
} else {
#if THREADS
REMOTE_ThreadHandle(wid).start_of_timesp = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).last_timep = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).start_of_times_sysp = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).last_time_sysp = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).start_of_timesp =
(struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).last_timep =
(struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).start_of_times_sysp =
(struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).last_time_sysp =
(struct _FILETIME *)malloc(sizeof(FILETIME));
(*REMOTE_ThreadHandle(wid).last_timep).dwLowDateTime =
UserTime.dwLowDateTime;
UserTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).last_timep).dwHighDateTime =
UserTime.dwHighDateTime;
UserTime.dwHighDateTime;
(*REMOTE_ThreadHandle(wid).start_of_timesp).dwLowDateTime =
UserTime.dwLowDateTime;
UserTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).start_of_timesp).dwHighDateTime =
UserTime.dwHighDateTime;
UserTime.dwHighDateTime;
(*REMOTE_ThreadHandle(wid).last_time_sysp).dwLowDateTime =
KernelTime.dwLowDateTime;
KernelTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).last_time_sysp).dwHighDateTime =
KernelTime.dwHighDateTime;
KernelTime.dwHighDateTime;
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).dwLowDateTime =
KernelTime.dwLowDateTime;
KernelTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).dwHighDateTime =
KernelTime.dwHighDateTime;
KernelTime.dwHighDateTime;
#else
last_time.dwLowDateTime =
UserTime.dwLowDateTime;
last_time.dwHighDateTime =
UserTime.dwHighDateTime;
StartOfTimes.dwLowDateTime =
UserTime.dwLowDateTime;
StartOfTimes.dwHighDateTime =
UserTime.dwHighDateTime;
last_time_sys.dwLowDateTime =
KernelTime.dwLowDateTime;
last_time_sys.dwHighDateTime =
KernelTime.dwHighDateTime;
StartOfTimes_sys.dwLowDateTime =
KernelTime.dwLowDateTime;
StartOfTimes_sys.dwHighDateTime =
KernelTime.dwHighDateTime;
last_time.dwLowDateTime = UserTime.dwLowDateTime;
last_time.dwHighDateTime = UserTime.dwHighDateTime;
StartOfTimes.dwLowDateTime = UserTime.dwLowDateTime;
StartOfTimes.dwHighDateTime = UserTime.dwHighDateTime;
last_time_sys.dwLowDateTime = KernelTime.dwLowDateTime;
last_time_sys.dwHighDateTime = KernelTime.dwHighDateTime;
StartOfTimes_sys.dwLowDateTime = KernelTime.dwLowDateTime;
StartOfTimes_sys.dwHighDateTime = KernelTime.dwHighDateTime;
#endif
}
}
#ifdef __GNUC__
static unsigned long long int
sub_utime(FILETIME t1, FILETIME t2)
{
static unsigned long long int sub_utime(FILETIME t1, FILETIME t2) {
ULARGE_INTEGER u[2];
memcpy((void *)u,(void *)&t1,sizeof(FILETIME));
memcpy((void *)(u+1),(void *)&t2,sizeof(FILETIME));
return
u[0].QuadPart - u[1].QuadPart;
memcpy((void *)u, (void *)&t1, sizeof(FILETIME));
memcpy((void *)(u + 1), (void *)&t2, sizeof(FILETIME));
return u[0].QuadPart - u[1].QuadPart;
}
#endif
UInt
Yap_cputime ( void )
{
UInt Yap_cputime(void) {
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime,
&UserTime)) {
clock_t t;
t = clock ();
return(((t - TimesStartOfTimes)*1000) / CLOCKS_PER_SEC);
t = clock();
return (((t - TimesStartOfTimes) * 1000) / CLOCKS_PER_SEC);
} else {
#ifdef __GNUC__
unsigned long long int t =
sub_utime(UserTime,StartOfTimes);
do_div(t,10000);
return((Int)t);
unsigned long long int t = sub_utime(UserTime, StartOfTimes);
do_div(t, 10000);
return ((Int)t);
#endif
#ifdef _MSC_VER
__int64 t = *(__int64 *)&UserTime - *(__int64 *)&StartOfTimes;
return((Int)(t/10000));
return ((Int)(t / 10000));
#endif
}
}
void Yap_cputime_interval(Int *now,Int *interval)
{
void Yap_cputime_interval(Int *now, Int *interval) {
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime,
&UserTime)) {
clock_t t;
t = clock ();
*now = ((t - TimesStartOfTimes)*1000) / CLOCKS_PER_SEC;
t = clock();
*now = ((t - TimesStartOfTimes) * 1000) / CLOCKS_PER_SEC;
*interval = (t - Times_last_time) * 1000 / CLOCKS_PER_SEC;
Times_last_time = t;
} else {
#ifdef __GNUC__
unsigned long long int t1 =
sub_utime(UserTime, StartOfTimes);
unsigned long long int t2 =
sub_utime(UserTime, last_time);
do_div(t1,10000);
unsigned long long int t1 = sub_utime(UserTime, StartOfTimes);
unsigned long long int t2 = sub_utime(UserTime, last_time);
do_div(t1, 10000);
*now = (Int)t1;
do_div(t2,10000);
do_div(t2, 10000);
*interval = (Int)t2;
#endif
#ifdef _MSC_VER
__int64 t1 = *(__int64 *)&UserTime - *(__int64 *)&StartOfTimes;
__int64 t2 = *(__int64 *)&UserTime - *(__int64 *)&last_time;
*now = (Int)(t1/10000);
*interval = (Int)(t2/10000);
*now = (Int)(t1 / 10000);
*interval = (Int)(t2 / 10000);
#endif
last_time.dwLowDateTime = UserTime.dwLowDateTime;
last_time.dwHighDateTime = UserTime.dwHighDateTime;
}
}
void Yap_systime_interval(Int *now,Int *interval)
{
void Yap_systime_interval(Int *now, Int *interval) {
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime, &UserTime)) {
if (!GetProcessTimes(hProcess, &CreationTime, &ExitTime, &KernelTime,
&UserTime)) {
*now = *interval = 0; /* not available */
} else {
#ifdef __GNUC__
unsigned long long int t1 =
sub_utime(KernelTime, StartOfTimes_sys);
unsigned long long int t2 =
sub_utime(KernelTime, last_time_sys);
do_div(t1,10000);
unsigned long long int t1 = sub_utime(KernelTime, StartOfTimes_sys);
unsigned long long int t2 = sub_utime(KernelTime, last_time_sys);
do_div(t1, 10000);
*now = (Int)t1;
do_div(t2,10000);
do_div(t2, 10000);
*interval = (Int)t2;
#endif
#ifdef _MSC_VER
__int64 t1 = *(__int64 *)&KernelTime - *(__int64 *)&StartOfTimes_sys;
__int64 t2 = *(__int64 *)&KernelTime - *(__int64 *)&last_time_sys;
*now = (Int)(t1/10000);
*interval = (Int)(t2/10000);
*now = (Int)(t1 / 10000);
*interval = (Int)(t2 / 10000);
#endif
last_time_sys.dwLowDateTime = KernelTime.dwLowDateTime;
last_time_sys.dwHighDateTime = KernelTime.dwHighDateTime;
@ -313,7 +289,7 @@ void Yap_systime_interval(Int *now,Int *interval)
#include <time.h>
#define TicksPerSec CLOCKS_PER_SEC
#define TicksPerSec CLOCKS_PER_SEC
#else
@ -329,16 +305,17 @@ void Yap_systime_interval(Int *now,Int *interval)
#include <limits.h>
#endif
#define TicksPerSec CLK_TCK
#define TicksPerSec CLK_TCK
#endif
#if defined(__alpha) || defined(__FreeBSD__) || defined(__linux__) || defined(__DragonFly__)
#if defined(__alpha) || defined(__FreeBSD__) || defined(__linux__) || \
defined(__DragonFly__)
#if HAVE_TIME_H
#include <time.h>
#endif
#define TicksPerSec sysconf(_SC_CLK_TCK)
#define TicksPerSec sysconf(_SC_CLK_TCK)
#endif
@ -353,37 +330,31 @@ static clock_t StartOfTimes, last_time;
static clock_t StartOfTimes_sys, last_time_sys;
/* store user time in this variable */
static void
InitTime (void)
{
static void InitTime(void) {
struct tms t;
times (&t);
times(&t);
(*REMOTE_ThreadHandle(wid).last_timep) = StartOfTimes = t.tms_utime;
last_time_sys = StartOfTimes_sys = t.tms_stime;
}
UInt
Yap_cputime (void)
{
UInt Yap_cputime(void) {
struct tms t;
times(&t);
return((t.tms_utime - StartOfTimes)*1000 / TicksPerSec);
return ((t.tms_utime - StartOfTimes) * 1000 / TicksPerSec);
}
void Yap_cputime_interval(Int *now,Int *interval)
{
void Yap_cputime_interval(Int *now, Int *interval) {
struct tms t;
times (&t);
*now = ((t.tms_utime - StartOfTimes)*1000) / TicksPerSec;
times(&t);
*now = ((t.tms_utime - StartOfTimes) * 1000) / TicksPerSec;
*interval = (t.tms_utime - last_time) * 1000 / TicksPerSec;
last_time = t.tms_utime;
}
void Yap_systime_interval(Int *now,Int *interval)
{
void Yap_systime_interval(Int *now, Int *interval) {
struct tms t;
times (&t);
*now = ((t.tms_stime - StartOfTimes_sys)*1000) / TicksPerSec;
times(&t);
*now = ((t.tms_stime - StartOfTimes_sys) * 1000) / TicksPerSec;
*interval = (t.tms_stime - last_time_sys) * 1000 / TicksPerSec;
last_time_sys = t.tms_stime;
}
@ -401,47 +372,42 @@ static struct timeval StartOfTimes;
static struct timeval last_time;
/* store user time in this variable */
static void
InitTime (int wid)
{
struct timeval tp;
static void InitTime(int wid) {
struct timeval tp;
gettimeofday(&tp,NULL);
(*REMOTE_ThreadHandle(wid).last_timep).tv_sec = (*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_sec = tp.tv_sec;
(*REMOTE_ThreadHandle(wid).last_timep).tv_usec = (*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_usec = tp.tv_usec;
gettimeofday(&tp, NULL);
(*REMOTE_ThreadHandle(wid).last_timep).tv_sec =
(*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_sec = tp.tv_sec;
(*REMOTE_ThreadHandle(wid).last_timep).tv_usec =
(*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_usec = tp.tv_usec;
}
UInt Yap_cputime(void) {
struct timeval tp;
UInt
Yap_cputime (void)
{
struct timeval tp;
gettimeofday(&tp,NULL);
gettimeofday(&tp, NULL);
if (StartOfTimes.tv_usec > tp.tv_usec)
return((tp.tv_sec - StartOfTimes.tv_sec - 1) * 1000 +
(StartOfTimes.tv_usec - tp.tv_usec) /1000);
return ((tp.tv_sec - StartOfTimes.tv_sec - 1) * 1000 +
(StartOfTimes.tv_usec - tp.tv_usec) / 1000);
else
return((tp.tv_sec - StartOfTimes.tv_sec)) * 1000 +
((tp.tv_usec - StartOfTimes.tv_usec) / 1000);
return ((tp.tv_sec - StartOfTimes.tv_sec)) * 1000 +
((tp.tv_usec - StartOfTimes.tv_usec) / 1000);
}
void Yap_cputime_interval(Int *now,Int *interval)
{
struct timeval tp;
void Yap_cputime_interval(Int *now, Int *interval) {
struct timeval tp;
gettimeofday(&tp,NULL);
gettimeofday(&tp, NULL);
*now = (tp.tv_sec - StartOfTimes.tv_sec) * 1000 +
(tp.tv_usec - StartOfTimes.tv_usec) / 1000;
(tp.tv_usec - StartOfTimes.tv_usec) / 1000;
*interval = (tp.tv_sec - last_time.tv_sec) * 1000 +
(tp.tv_usec - last_time.tv_usec) / 1000;
(tp.tv_usec - last_time.tv_usec) / 1000;
last_time.tv_usec = tp.tv_usec;
last_time.tv_sec = tp.tv_sec;
}
void Yap_systime_interval(Int *now,Int *interval)
{
*now = *interval = 0; /* not available */
void Yap_systime_interval(Int *now, Int *interval) {
*now = *interval = 0; /* not available */
}
#endif /* SIMICS */
@ -450,16 +416,12 @@ void Yap_systime_interval(Int *now,Int *interval)
/* This code is not working properly. I left it here to help future ports */
#ifdef MPW
#include <files.h>
#include <Events.h>
#include <files.h>
#define TicksPerSec 60.0
static double
real_cputime ()
{
return (((double) TickCount ()) / TicksPerSec);
}
static double real_cputime() { return (((double)TickCount()) / TicksPerSec); }
#endif /* MPW */
@ -469,18 +431,13 @@ real_cputime ()
static long *ptime;
gettime ()
{
*ptime = *(long *) 0x462;
}
gettime() { *ptime = *(long *)0x462; }
static double
real_cputime ()
{
static double real_cputime() {
long thetime;
ptime = &thetime;
xbios (38, gettime);
return (((double) thetime) / (Getrez () == 2 ? 70 : 60));
xbios(38, gettime);
return (((double)thetime) / (Getrez() == 2 ? 70 : 60));
}
#endif /* LATTICE */
@ -492,18 +449,12 @@ real_cputime ()
static long *ptime;
static long
readtime ()
{
return (*((long *) 0x4ba));
}
static long readtime() { return (*((long *)0x4ba)); }
static double
real_cputime ()
{
static double real_cputime() {
long time;
time = Supexec (readtime);
time = Supexec(readtime);
return (time / 200.0);
}
@ -518,11 +469,7 @@ real_cputime ()
#define TicksPerSec 60.0
static double
real_cputime ()
{
return (((double) TickCount ()) / TicksPerSec);
}
static double real_cputime() { return (((double)TickCount()) / TicksPerSec); }
#endif /* LIGHT */
@ -540,48 +487,35 @@ uint64_t Yap_StartOfWTimes;
/* since the point YAP was started */
void
Yap_InitWTime (void)
{
Yap_StartOfWTimes = (uint64_t)gethrtime();
}
void Yap_InitWTime(void) { Yap_StartOfWTimes = (uint64_t)gethrtime(); }
/// returns time since Jan 1 1980 in nano-seconds
uint64_t Yap_walltime(uint64_t old)
{
hrtime_t tp = gethrtime();
/* return time in milliseconds */
return = (uint64_t)tp;
uint64_t Yap_walltime(uint64_t old) {
hrtime_t tp = gethrtime();
/* return time in milliseconds */
return (uint64_t)tp;
}
#elif HAVE_GETTIMEOFDAY
/* since the point YAP was started */
/* store user time in this variable */
void
Yap_InitWTime (void)
{
struct timeval tp;
void Yap_InitWTime(void) {
struct timeval tp;
gettimeofday(&tp, NULL);
Yap_StartOfWTimes = (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
gettimeofday(&tp, NULL);
Yap_StartOfWTimes =
(uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
}
/// returns time in nano-secs since the epoch
uint64_t Yap_walltime(void) {
struct timeval tp;
/// returns time in nano-secs since the epoch
uint64_t
Yap_walltime(void)
{
struct timeval tp;
gettimeofday(&tp, NULL);
return (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
gettimeofday(&tp, NULL);
return (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000;
}
#elif defined(_WIN32)
#include <sys/timeb.h>
@ -591,67 +525,50 @@ Yap_walltime(void)
static LARGE_INTEGER Frequency;
/* store user time in this variable */
void
Yap_InitWTime (void)
{
LARGE_INTEGER ElapsedNanoseconds;
QueryPerformanceFrequency(&Frequency);
QueryPerformanceCounter(&ElapsedNanoseconds);
ElapsedNanoseconds.QuadPart *= 1000000;
ElapsedNanoseconds.QuadPart /= Frequency.QuadPart;
Yap_StartOfWTimes = (uint64_t)ElapsedNanoseconds.QuadPart;
void Yap_InitWTime(void) {
LARGE_INTEGER ElapsedNanoseconds;
QueryPerformanceFrequency(&Frequency);
QueryPerformanceCounter(&ElapsedNanoseconds);
ElapsedNanoseconds.QuadPart *= 1000000;
ElapsedNanoseconds.QuadPart /= Frequency.QuadPart;
Yap_StartOfWTimes = (uint64_t)ElapsedNanoseconds.QuadPart;
}
uint64_t Yap_walltime(void) {
LARGE_INTEGER ElapsedNanoseconds;
QueryPerformanceCounter(&ElapsedNanoseconds);
//
// We now have the elapsed number of ticks, along with the
// number of ticks-per-second. We use these values
// to convert to the number of elapsed microseconds.
// To guard against loss-of-precision, we convert
// to microseconds *before* dividing by ticks-per-second.
//
uint64_t
Yap_walltime (void)
{
LARGE_INTEGER ElapsedNanoseconds;
QueryPerformanceCounter(&ElapsedNanoseconds);
//
// We now have the elapsed number of ticks, along with the
// number of ticks-per-second. We use these values
// to convert to the number of elapsed microseconds.
// To guard against loss-of-precision, we convert
// to microseconds *before* dividing by ticks-per-second.
//
ElapsedNanoseconds.QuadPart *= 1000000;
ElapsedNanoseconds.QuadPart /= Frequency.QuadPart;
return ElapsedNanoseconds.QuadPart;
ElapsedNanoseconds.QuadPart *= 1000000;
ElapsedNanoseconds.QuadPart /= Frequency.QuadPart;
return ElapsedNanoseconds.QuadPart;
}
#elif HAVE_TIMES
/* store user time in this variable */
void
Yap_InitWTime (void)
{
void Yap_InitWTime(void) {
// start thread 0
REMOTE_LastWTime(0) =
Yap_StartOfWTimes = ((uint64_t)times(NULL))*10000000/TicksPerSec;
REMOTE_LastWTime(0) = Yap_StartOfWTimes =
((uint64_t)times(NULL)) * 10000000 / TicksPerSec;
}
uint64_t
Yap_walltime (void)
{
uint64_t Yap_walltime(void) {
clock_t t;
t = times(NULL);
return = ((uint64_t)times(NULL)) * 10000000 / TicksPerSec;
}
#endif /* HAVE_TIMES */
void
Yap_ReInitWTime (void)
{
Yap_InitWTime();
}
void Yap_ReInitWTime(void) { Yap_InitWTime(); }
void
Yap_InitTimePreds(void)
{
/* can only do after heap is initialized */
Yap_InitWTime();
void Yap_InitTimePreds(void) {
/* can only do after heap is initialized */
Yap_InitWTime();
}

85
os/writeterm.c
View File

@ -88,7 +88,6 @@ static char SccsId[] = "%W% %G%";
#endif
#include "iopreds.h"
static Term readFromBuffer(const char *s, Term opts) {
Term rval;
int sno;
@ -100,7 +99,7 @@ static Term readFromBuffer(const char *s, Term opts) {
Yap_CloseStream(sno);
return rval;
}
#if _MSC_VER || defined(__MINGW32__)
#define SYSTEM_STAT _stat
#else
@ -291,21 +290,20 @@ end:
/**
*
*/
bool Yap_WriteTerm( int output_stream, Term t, Term opts USES_REGS)
{
xarg *args = Yap_ArgListToVector( opts, write_defs, WRITE_END);
bool Yap_WriteTerm(int output_stream, Term t, Term opts USES_REGS) {
xarg *args = Yap_ArgListToVector(opts, write_defs, WRITE_END);
if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, t, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -316,16 +314,16 @@ static Int write_term2(USES_REGS1) {
/* '$write'(+Flags,?Term) */
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
return Yap_WriteTerm( LOCAL_c_output_stream, ARG1, ARG2 PASS_REGS);
return Yap_WriteTerm(LOCAL_c_output_stream, ARG1, ARG2 PASS_REGS);
}
static Int write_term3(USES_REGS1) {
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) {
return false;
}
return Yap_WriteTerm( output_stream, ARG2, ARG3 PASS_REGS);
return Yap_WriteTerm(output_stream, ARG2, ARG3 PASS_REGS);
}
static Int write2(USES_REGS1) {
@ -343,7 +341,7 @@ static Int write2(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
mySlots = Yap_StartSlots();
@ -351,7 +349,7 @@ static Int write2(USES_REGS1) {
args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -369,7 +367,7 @@ static Int write1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -378,7 +376,7 @@ static Int write1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -396,7 +394,7 @@ static Int write_canonical1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -407,7 +405,7 @@ static Int write_canonical1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -422,12 +420,12 @@ static Int write_canonical(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0) {
free( args );
free(args);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -437,7 +435,7 @@ static Int write_canonical(USES_REGS1) {
args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -452,13 +450,13 @@ static Int writeq1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) {
free( args );
free(args);
output_stream = 1;
}
args[WRITE_NUMBERVARS].used = true;
@ -467,7 +465,7 @@ static Int writeq1(USES_REGS1) {
args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -482,12 +480,12 @@ static Int writeq(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0) {
free( args );
free(args);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -497,7 +495,7 @@ static Int writeq(USES_REGS1) {
args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -512,13 +510,13 @@ static Int print1(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) {
free( args );
free(args);
output_stream = 1;
}
args[WRITE_PORTRAY].used = true;
@ -528,7 +526,7 @@ static Int print1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -543,12 +541,12 @@ static Int print(USES_REGS1) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0) {
free( args );
free(args);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -558,7 +556,7 @@ static Int print(USES_REGS1) {
args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -574,7 +572,7 @@ static Int writeln1(USES_REGS1) {
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) {
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
@ -585,7 +583,7 @@ static Int writeln1(USES_REGS1) {
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -598,13 +596,13 @@ static Int writeln(USES_REGS1) {
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) {
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "writeln/2");
if (output_stream < 0) {
free( args );
return false;
free(args);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
args[WRITE_NL].used = true;
@ -613,7 +611,7 @@ return false;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free( args );
free(args);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
@ -676,7 +674,6 @@ static Int dollar_var(USES_REGS1) {
return Yap_unify(tv, ARG2);
}
static Int term_to_string(USES_REGS1) {
Term t2 = Deref(ARG2), rc = false, t1 = Deref(ARG1);
const char *s;
@ -703,9 +700,9 @@ static Int term_to_atom(USES_REGS1) {
Term t2 = Deref(ARG2), ctl, rc = false;
Atom at;
if (IsVarTerm(t2)) {
size_t length;
const char *s = Yap_TermToString(Deref(ARG1), &length, LOCAL_encoding,
Quote_illegal_f | Handle_vars_f);
size_t length;
const char *s = Yap_TermToString(Deref(ARG1), &length, LOCAL_encoding,
Quote_illegal_f | Handle_vars_f);
if (!s || !(at = Yap_UTF8ToAtom((const unsigned char *)s))) {
Yap_Error(RESOURCE_ERROR_HEAP, t2,
"Could not get memory from the operating system");
@ -737,9 +734,9 @@ void Yap_InitWriteTPreds(void) {
Yap_InitCPred("print", 2, print, SyncPredFlag);
Yap_InitCPred("write_depth", 3, p_write_depth, SafePredFlag | SyncPredFlag);
;
Yap_InitCPred("term_to_string", 3, term_to_string, 0);
Yap_InitCPred("term_to_atom", 3, term_to_atom, 0);
Yap_InitCPred("term_to_string", 3, term_to_string, 0);
Yap_InitCPred("term_to_atom", 3, term_to_atom, 0);
Yap_InitCPred("write_depth", 3, p_write_depth, SafePredFlag | SyncPredFlag);
;
Yap_InitCPred("$VAR", 2, dollar_var, SafePredFlag);

62
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])

5
packages/python/python.h
View File

@ -21,7 +21,7 @@
typedef YAP_Arity arity_t;
extern atom_t ATOM_true, ATOM_false, ATOM_colon, ATOM_dot, ATOM_none, ATOM_t,
ATOM_comma, ATOM_builtin, ATOM_V, ATOM_A, ATOM_self;
ATOM_comma, ATOM_builtin, ATOM_V, ATOM_A, ATOM_self;
extern functor_t FUNCTOR_dollar1, FUNCTOR_abs1, FUNCTOR_all1, FUNCTOR_any1,
FUNCTOR_bin1, FUNCTOR_brackets1, FUNCTOR_comma2, FUNCTOR_dir1,
@ -39,6 +39,8 @@ extern PyObject *py_F2P;
extern bool python_in_python;
#define PythonReturn PyGILState_Release(gstate) && return
static inline Py_ssize_t get_p_int(PyObject *o, Py_ssize_t def) {
if (o == NULL)
return def;
@ -94,7 +96,6 @@ static inline PyObject *atom_to_python_string(term_t t) {
extern PyObject *compound_to_pyeval(term_t t, functor_t fun);
extern PyObject *compound_to_pytree(term_t t, functor_t fun);
extern PyObject *yap_to_python(YAP_Term t, bool eval);
extern PyObject *term_to_python(term_t t, bool eval);
extern foreign_t python_to_ptr(PyObject *pVal, term_t t);

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

@ -138,9 +138,9 @@ class YAPKernel(KernelBase):
implementation = 'YAP'
implementation_version = release.version
language_info = {
'name': 'python',
'name': 'prolog',
'version': sys.version.split()[0],
'mimetype': 'text/x-python',
'mimetype': 'text/x-prolog',
'codemirror_mode': {
'name': 'prolog',
'version': sys.version_info[0]
@ -333,7 +333,7 @@ class YAPKernel(KernelBase):
elif hist_access_type == 'range':
hist = self.shell.history_manager.get_range(session, start, stop,
raw=raw, output=output)
raw=raw, output=output)
elif hist_access_type == 'search':
hist = self.shell.history_manager.search(

116
packages/raptor/raptor_yap.c
View File

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

58
pl/dbload.yap
View File

@ -27,44 +27,19 @@
:- dynamic dbloading/6, dbprocess/2.
dbload_from_stream(R, M0, Type) :-
repeat,
read(R,T),
( T == end_of_file -> !, close_dbload(R, Type);
dbload_count(T, M0),
fail
).
close_dbload(_R, exo) :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
exo_db_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
close_dbload(R, exo) :-
seek(R, 0, bof, _),
exodb_add_facts(R, _M),
fail.
close_dbload(_R, mega) :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
dbload_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
close_dbload(R, mega) :-
seek(R, 0, bof, _),
dbload_add_facts(R, _M),
fail.
close_dbload(_, _) :-
retractall(dbloading(_Na,_Arity,_M,_T,_NaAr,_Handle)),
fail.
close_dbload(_, _).
dbload_from_stream(R, M0, rdf, term ) :-
'$lines_in_file'(R, Lines),
'$input_lines'(R, Type, Lines),
dbload_from_stream(R, M0, Type, Storage ) :-
'$lines_in_file'(R, Lines),
'$input_lines'(R, Type, Lines),
'$input_lines'(R, csv, yeLines ) :-
'$process_lines'(R, Lines, Type ),
close(R).
prolog:load_db(Fs) :-
'$current_module'(M0),
'$current_module'(M0),
prolog_flag(agc_margin,Old,0),
dbload(Fs,M0,load_db(Fs)),
load_facts,
@ -73,8 +48,8 @@ prolog:load_db(Fs) :-
dbload(Fs, _, G) :-
var(Fs),
'$do_error'(instantiation_error,G).
dbload([], _, _) :- !.
'$do_error'(instantiation_error,G).
dbload([], _, _) :- !.
dbload([F|Fs], M0, G) :- !,
dbload(F, M0, G),
dbload(Fs, M0, G).
@ -99,7 +74,7 @@ check_dbload_stream(R, M0) :-
catch(read(R,T), _, fail),
( T = end_of_file -> !;
dbload_count(T, M0),
fail
fail
).
dbload_count(T0, M0) :-
@ -121,7 +96,7 @@ get_module(M1:T0,_,T,M) :- !,
get_module(T0, M1, T , M).
get_module(T,M,T,M).
load_facts :-
!, % yap_flag(exo_compilation, on), !.
load_exofacts.
@ -145,7 +120,7 @@ dbload_add_facts(R, M) :-
catch(read(R,T), _, fail),
( T = end_of_file -> !;
dbload_add_fact(T, M),
fail
fail
).
dbload_add_fact(T0, M0) :-
@ -182,7 +157,7 @@ protected_exodb_add_fact(R, M) :-
read(R,T),
( T == end_of_file -> !;
exodb_add_fact(T, M),
fail
fail
).
exodb_add_fact(T0, M0) :-
@ -199,4 +174,3 @@ clean_up :-
retractall(dbprocess(_,_)),
fail.
clean_up.

5
pl/signals.yap
View File

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