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

state

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-06-14 11:27:43 +01:00
parent 59534a04f6
commit d2024c1aed
23 changed files with 1156 additions and 1125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
C/args.c
View File

@ -39,49 +39,43 @@ int Yap_ArgKey(Atom key, const param_t *def, int n) {
}
#define YAP_XARGINFO(Error, Message)
#define failed(e, t, a) failed__(e, t, a PASS_REGS)
static xarg *failed__(yap_error_number e, Term t, xarg *a USES_REGS) {
free(a);
LOCAL_ActiveError->errorNo = e;
LOCAL_ActiveError->errorRawTerm = t;
return NULL;
}
xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n) {
xarg *Yap_ArgListToVector__(const char *file, const char *function, int lineno,
Term listl, const param_t *def, int n,
yap_error_number err) {
CACHE_REGS
listl = Deref(listl);
if (IsVarTerm(listl)) {
Yap_ThrowError(INSTANTIATION_ERROR, listl, "while opening a list of options");
}
xarg *a = calloc(n, sizeof(xarg));
if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule)
listl = ArgOfTerm(2, listl);
xarg *a;
listl = Deref(listl);
if (IsVarTerm(listl)) {
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl,
"while opening listl = ArgOfTerm(2, listl ,k)");
}
a = calloc(n, sizeof(xarg));
if (!IsPairTerm(listl) && listl != TermNil) {
if (IsAtomTerm(listl)) {
xarg *na = matchKey(AtomOfTerm(listl), a, n, def);
if (!na) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "match key");
}
} else if (IsApplTerm(listl)) {
Functor f = FunctorOfTerm(listl);
if (IsExtensionFunctor(f)) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "callable");
}
arity_t arity = ArityOfFunctor(f);
if (arity != 1) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "bad arity");
}
xarg *na = matchKey(NameOfFunctor(f), a, n, def);
if (!na) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, err, listl, "no match");
}
na->used = true;
na->tvalue = ArgOfTerm(1, listl);
return a;
} else {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_ATOM, listl, "not atom");
}
listl = MkPairTerm(listl, TermNil);
}
@ -89,44 +83,45 @@ xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n) {
Term hd = HeadOfTerm(listl);
listl = TailOfTerm(listl);
if (IsVarTerm(hd)) {
return failed(INSTANTIATION_ERROR, hd, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "sub-element");
}
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "sub-list");
}
if (IsAtomTerm(hd)) {
xarg *na = matchKey(AtomOfTerm(hd), a, n, def);
if (!na)
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
Yap_ThrowError__(file, function, lineno, err, hd, "bad match in list");
na->used = true;
na->tvalue = TermNil;
continue;
} else if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm(hd);
if (IsExtensionFunctor(f)) {
return failed(TYPE_ERROR_PARAMETER, hd, a);
Yap_ThrowError__(file, function, lineno, err, hd, "bad compound");
}
arity_t arity = ArityOfFunctor(f);
if (arity != 1) {
return failed(DOMAIN_ERROR_OUT_OF_RANGE, hd, a);
Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_OUT_OF_RANGE, hd,
"high arity");
}
xarg *na = matchKey(NameOfFunctor(f), a, n, def);
if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
Yap_ThrowError__(file, function, lineno, err, hd, "no match");
}
na->used = true;
na->tvalue = ArgOfTerm(1, hd);
} else {
return failed(TYPE_ERROR_PARAMETER, hd, a);
Yap_ThrowError__(file, function, lineno, err, hd, "bad type");
}
}
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "unbound");
} else if (listl != TermNil) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "bad list");
}
return a;
}
}
static xarg *matchKey2(Atom key, xarg *e0, int n, const param2_t *def) {
int i;
@ -139,54 +134,53 @@ static xarg *matchKey2(Atom key, xarg *e0, int n, const param2_t *def) {
}
return NULL;
}
/// Yap_ArgList2ToVector is much the same as before,
/// but assumes parameters also have something called a
/// scope
xarg *Yap_ArgList2ToVector(Term listl, const param2_t *def, int n) {
xarg *Yap_ArgList2ToVector__(const char *file, const char *function, int lineno,Term listl, const param2_t *def, int n, yap_error_number err) {
CACHE_REGS
listl = Deref(listl);
if (IsVarTerm(listl)) {
Yap_ThrowError(INSTANTIATION_ERROR, listl, "while opening a list of options");
}
xarg *a = calloc(n, sizeof(xarg));
xarg *a = calloc(n, sizeof(xarg));
if (!IsPairTerm(listl) && listl != TermNil) {
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "unbound");
}
if (IsAtomTerm(listl)) {
xarg *na = matchKey2(AtomOfTerm(listl), a, n, def);
if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
Yap_ThrowError__(file, function, lineno, err,
listl, "bad match");
}
}
if (IsApplTerm(listl)) {
Functor f = FunctorOfTerm(listl);
if (IsExtensionFunctor(f)) {
return failed(TYPE_ERROR_PARAMETER, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_PARAMETER, listl,
"bad compound");
}
arity_t arity = ArityOfFunctor(f);
if (arity != 1) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "bad arity");
}
xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_GENERIC_ARGUMENT,
listl, "bad match");
}
} else {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "");
}
listl = MkPairTerm(listl, TermNil);
}
while (IsPairTerm(listl)) {
Term hd = HeadOfTerm(listl);
if (IsVarTerm(hd)) {
return failed(INSTANTIATION_ERROR, hd, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "");
}
if (IsAtomTerm(hd)) {
xarg *na = matchKey2(AtomOfTerm(hd), a, n, def);
if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_GENERIC_ARGUMENT,
hd, "bad match");
}
na->used = true;
na->tvalue = TermNil;
@ -194,29 +188,32 @@ xarg *Yap_ArgList2ToVector(Term listl, const param2_t *def, int n) {
} else if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm(hd);
if (IsExtensionFunctor(f)) {
return failed(TYPE_ERROR_PARAMETER, hd, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_PARAMETER, hd, "bad compound");
}
arity_t arity = ArityOfFunctor(f);
if (arity != 1) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_GENERIC_ARGUMENT,
hd, "bad arity");
}
xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
if (na) {
na->used = 1;
na->tvalue = ArgOfTerm(1, hd);
} else {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
Yap_ThrowError__(file, function, lineno, err,
hd, "bad key");
}
return a;
} else {
return failed(INSTANTIATION_ERROR, hd, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "unbound");
}
listl = TailOfTerm(listl);
}
if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a);
Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "");
}
if (TermNil != listl) {
return failed(TYPE_ERROR_LIST, listl, a);
Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "");
}
return a;
}

564
C/errors.c
View File

@ -32,28 +32,28 @@
#endif
#include "Foreign.h"
#define set_key_b(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
i->k = t == TermTrue ? true : false; \
return i->k || t == TermFalse; \
#define set_key_b(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
i->k = t == TermTrue ? true : false; \
return i->k || t == TermFalse; \
}
#define set_key_i(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \
return IsIntegerTerm(t); \
#define set_key_i(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \
return IsIntegerTerm(t); \
}
#define set_key_s(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
const char *s = IsAtomTerm(t) ? RepAtom(AtomOfTerm(t))->StrOfAE \
: IsStringTerm(t) ? StringOfTerm(t) : NULL; \
if (s) { \
char *tmp = malloc(strlen(s) + 1); \
strcpy(tmp, s); \
i->k = tmp; \
} \
return i->k != NULL; \
#define set_key_s(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
const char *s = IsAtomTerm(t) ? RepAtom(AtomOfTerm(t))->StrOfAE \
: IsStringTerm(t) ? StringOfTerm(t) : NULL; \
if (s) { \
char *tmp = malloc(strlen(s) + 1); \
strcpy(tmp, s); \
i->k = tmp; \
} \
return i->k != NULL; \
}
static bool setErr(const char *q, yap_error_descriptor_t *i, Term t) {
@ -85,19 +85,19 @@ static bool setErr(const char *q, yap_error_descriptor_t *i, Term t) {
return false;
}
#define query_key_b(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return i->k ? TermTrue : TermFalse; \
#define query_key_b(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return i->k ? TermTrue : TermFalse; \
}
#define query_key_i(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return MkIntegerTerm(i->k); \
#define query_key_i(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return MkIntegerTerm(i->k); \
}
#define query_key_s(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return (i->k && i->k[0] ? MkStringTerm(i->k) : TermNil); \
#define query_key_s(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return (i->k && i->k[0] ? MkStringTerm(i->k) : TermNil); \
}
static Term queryErr(const char *q, yap_error_descriptor_t *i) {
@ -152,7 +152,7 @@ static void printErr(yap_error_descriptor_t *i) {
print_key_s("errorAsText", i->errorAsText);
print_key_s("errorGoal", i->errorGoal);
print_key_s("classAsText", i->classAsText);
print_key_i("errorLineq", i->errorLine);
print_key_i("errorLine", i->errorLine);
print_key_s("errorFunction", i->errorFunction);
print_key_s("errorFile", i->errorFile);
print_key_i("prologPredLine", i->prologPredLine);
@ -237,7 +237,7 @@ static Term err2list(yap_error_descriptor_t *i) {
bool Yap_Warning(const char *s, ...) {
CACHE_REGS
va_list ap;
va_list ap;
PredEntry *pred;
bool rc;
Term ts[2];
@ -283,7 +283,7 @@ bool Yap_Warning(const char *s, ...) {
void Yap_InitError__(const char *file, const char *function, int lineno,
yap_error_number e, Term t, ...) {
CACHE_REGS
va_list ap;
va_list ap;
va_start(ap, t);
const char *fmt;
char tmpbuf[MAXPATHLEN];
@ -302,7 +302,7 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
yap_error_number err = LOCAL_ActiveError->errorNo;
fprintf(stderr, "%% Warning %s WITHIN ERROR %s %s\n", Yap_errorName(e),
Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
return;
return;
}
LOCAL_ActiveError->errorNo = e;
LOCAL_ActiveError->errorFile = NULL;
@ -319,15 +319,18 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
bool Yap_PrintWarning(Term twarning) {
CACHE_REGS
PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule);
bool rc;
Term ts[2], err;
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError && (err = LOCAL_ActiveError->errorNo)) {
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError &&
(err = LOCAL_ActiveError->errorNo)) {
fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
Yap_TermToBuffer(twarning, ENC_ISO_UTF8,Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f), Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
Yap_TermToBuffer(twarning, ENC_ISO_UTF8,
Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f),
Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
return false;
}
LOCAL_PrologMode |= InErrorMode;
@ -343,7 +346,7 @@ bool Yap_PrintWarning(Term twarning) {
}
ts[1] = twarning;
ts[0] = MkAtomTerm(AtomWarning);
rc = Yap_execute_pred(pred, ts, true PASS_REGS);
rc = Yap_execute_pred(pred, ts, true PASS_REGS);
LOCAL_within_print_message = false;
LOCAL_PrologMode &= ~InErrorMode;
return rc;
@ -352,7 +355,7 @@ bool Yap_PrintWarning(Term twarning) {
bool Yap_HandleError__(const char *file, const char *function, int lineno,
const char *s, ...) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
yap_error_number err = LOCAL_Error_TYPE;
const char *serr;
arity_t arity = 2;
@ -362,7 +365,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno,
} else {
serr = s;
}
if (P!= FAILCODE) {
if (P != FAILCODE) {
if (P->opc == Yap_opcode(_try_c) || P->opc == Yap_opcode(_try_userc) ||
P->opc == Yap_opcode(_retry_c) || P->opc == Yap_opcode(_retry_userc)) {
@ -401,7 +404,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno,
default:
if (LOCAL_PrologMode == UserMode)
Yap_ThrowError__( file, function, lineno, err, LOCAL_RawTerm, serr);
Yap_ThrowError__(file, function, lineno, err, LOCAL_RawTerm, serr);
else
LOCAL_PrologMode &= ~InErrorMode;
return false;
@ -410,7 +413,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno,
int Yap_SWIHandleError(const char *s, ...) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
if (LOCAL_ErrorMessage) {
@ -449,18 +452,18 @@ int Yap_SWIHandleError(const char *s, ...) {
void Yap_RestartYap(int flag) {
CACHE_REGS
#if PUSH_REGS
restore_absmi_regs(&Yap_standard_regs);
restore_absmi_regs(&Yap_standard_regs);
#endif
siglongjmp(*LOCAL_RestartEnv, flag);
}
static void error_exit_yap(int value) {
CACHE_REGS
if (!(LOCAL_PrologMode & BootMode)) {
if (!(LOCAL_PrologMode & BootMode)) {
#if DEBUG
#endif
}
}
fprintf(stderr, "\n Exiting ....\n");
#if HAVE_BACKTRACE
void *callstack[256];
@ -499,76 +502,76 @@ static char tmpbuf[YAP_BUF_SIZE];
#undef E2
#undef END_ERRORS
#define BEGIN_ERROR_CLASSES() \
static Atom mkerrorct(yap_error_class_number c) { \
#define BEGIN_ERROR_CLASSES() \
static Atom mkerrorct(yap_error_class_number c) { \
switch (c) {
#define ECLASS(CL, A, B) \
case CL: \
return Yap_LookupAtom(A);
#define ECLASS(CL, A, B) \
case CL: \
return Yap_LookupAtom(A);
#define END_ERROR_CLASSES() \
} \
return NULL; \
}
#define END_ERROR_CLASSES() \
} \
return NULL; \
}
#define BEGIN_ERRORS() \
static Term mkerrort(yap_error_number e, Term culprit, Term info) { \
#define BEGIN_ERRORS() \
static Term mkerrort(yap_error_number e, Term culprit, Term info) { \
switch (e) {
#define E0(A, B) \
case A: { \
Term ft[2]; \
ft[0] = MkAtomTerm(mkerrorct(B)); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
#define E0(A, B) \
case A: { \
Term ft[2]; \
ft[0] = MkAtomTerm(mkerrorct(B)); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
}
#define E(A, B, C) \
case A: { \
Term ft[2], nt[2]; \
nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \
nt[1] = MkVarTerm(); \
Yap_unify(nt[1], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 2), 2, nt); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
#define E(A, B, C) \
case A: { \
Term ft[2], nt[2]; \
nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \
nt[1] = MkVarTerm(); \
Yap_unify(nt[1], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 2), 2, nt); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
}
#define E1(A, B, C) \
case A: { \
Term ft[2], nt[1]; \
nt[0] = MkVarTerm(); \
Yap_unify(nt[0], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(C), 1),1 , nt); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
#define E1(A, B, C) \
case A: { \
Term ft[2], nt[1]; \
nt[0] = MkVarTerm(); \
Yap_unify(nt[0], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(C), 1), 1, nt); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
}
#define E2(A, B, C, D) \
case A: { \
Term ft[2], nt[3]; \
nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \
nt[1] = MkAtomTerm(Yap_LookupAtom(D)); \
nt[2] = MkVarTerm(); \
Yap_unify(nt[2], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 3), 3, nt); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
#define E2(A, B, C, D) \
case A: { \
Term ft[2], nt[3]; \
nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \
nt[1] = MkAtomTerm(Yap_LookupAtom(D)); \
nt[2] = MkVarTerm(); \
Yap_unify(nt[2], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 3), 3, nt); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
}
#define END_ERRORS() \
} \
return TermNil; \
}
#define END_ERRORS() \
} \
return TermNil; \
}
#include "YapErrors.h"
bool Yap_pushErrorContext(bool pass, yap_error_descriptor_t *new_error) {
memset(new_error, 0, sizeof(yap_error_descriptor_t));
new_error->top_error = LOCAL_ActiveError;
LOCAL_ActiveError = new_error;
return true;
memset(new_error, 0, sizeof(yap_error_descriptor_t));
new_error->top_error = LOCAL_ActiveError;
LOCAL_ActiveError = new_error;
return true;
}
/* static void */
@ -580,24 +583,24 @@ bool Yap_pushErrorContext(bool pass, yap_error_descriptor_t *new_error) {
/* } */
yap_error_descriptor_t *Yap_popErrorContext(bool mdnew, bool pass) {
yap_error_descriptor_t *e =LOCAL_ActiveError;
// last block
LOCAL_ActiveError = e->top_error;
if (e->errorNo) {
if (!LOCAL_ActiveError->errorNo && pass) {
memcpy(LOCAL_ActiveError, e, sizeof(*LOCAL_ActiveError));
} else {
return e;
}
yap_error_descriptor_t *e = LOCAL_ActiveError;
// last block
LOCAL_ActiveError = e->top_error;
if (e->errorNo) {
if (!LOCAL_ActiveError->errorNo && pass) {
memcpy(LOCAL_ActiveError, e, sizeof(*LOCAL_ActiveError));
} else {
if (e->errorNo)
return e;
return e;
}
return NULL;
} else {
if (e->errorNo)
return e;
}
return NULL;
}
/**
/**
* Throw an error directly to the error handler
*
*
* @param file where
* @param function who
* @param lineno when
@ -628,9 +631,9 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno,
Yap_exit(5);
}
/**
/**
* complete delayed error.
*
*
*/
void Yap_ThrowExistingError(void) {
if (LOCAL_RestartEnv) {
@ -639,23 +642,25 @@ void Yap_ThrowExistingError(void) {
Yap_exit(5);
}
bool Yap_MkErrorRecord( yap_error_descriptor_t *r,
const char *file, const char *function,
int lineno, yap_error_number type, Term where,
const char *s) {
bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
const char *function, int lineno, yap_error_number type,
Term where, const char *s) {
if (!Yap_pc_add_location(r, CP, B, ENV))
Yap_env_add_location(r, CP, B, ENV, 0);
if (where == 0L || where == TermNil||type==INSTANTIATION_ERROR) {
if (where == 0L || where == TermNil || type == INSTANTIATION_ERROR) {
r->culprit = NULL;
} else {
r->culprit = Yap_TermToBuffer(
where, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
where, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
}
if (LOCAL_consult_level > 0) {
r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE;
r->prologParserLine = Yap_source_line_no();
}
r->errorNo = type;
r->errorAsText = Yap_errorName(type);
r->errorClass = Yap_errorClass(type);
r->classAsText =
Yap_errorClassName(r->errorClass);
r->classAsText = Yap_errorClassName(r->errorClass);
r->errorLine = lineno;
r->errorFunction = function;
r->errorFile = file;
@ -687,21 +692,20 @@ bool Yap_MkErrorRecord( yap_error_descriptor_t *r,
}
// fprintf(stderr, "warning: ");
if (s && s[0]) {
r->errorMsgLen = strlen(s) + 1;
r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, s);
} else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) {
r->errorMsgLen = strlen(LOCAL_ErrorMessage) + 1;
r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, LOCAL_ErrorMessage);
} else {
r->errorMsgLen = strlen(s) + 1;
r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, s);
} else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) {
r->errorMsgLen = strlen(LOCAL_ErrorMessage) + 1;
r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, LOCAL_ErrorMessage);
} else {
r->errorMsgLen = 0;
r->errorMsg = 0;
}
return true;
r->errorMsg = 0;
}
return true;
}
/**
* @brief Yap_Error
* This function handles errors in the C code. Check errors.yap for the
@ -726,95 +730,95 @@ bool Yap_MkErrorRecord( yap_error_descriptor_t *r,
yamop *Yap_Error__(bool throw, const char *file, const char *function,
int lineno, yap_error_number type, Term where, ...) {
CACHE_REGS
va_list ap;
va_list ap;
char *fmt;
char s[MAXPATHLEN];
switch (type) {
case SYSTEM_ERROR_INTERNAL: {
fprintf(stderr, "%% Internal YAP Error: %s exiting....\n", tmpbuf);
// serious = true;
if (LOCAL_PrologMode & BootMode) {
fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf);
} else {
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
if (tmpbuf[0]) {
fprintf(stderr, "%% Bug found while executing %s\n", tmpbuf);
}
#if HAVE_BACKTRACE
void *callstack[256];
int i;
int frames = backtrace(callstack, 256);
char **strs = backtrace_symbols(callstack, frames);
fprintf(stderr, "Execution stack:\n");
for (i = 0; i < frames; ++i) {
fprintf(stderr, " %s\n", strs[i]);
}
free(strs);
#endif
switch (type) {
case SYSTEM_ERROR_INTERNAL: {
fprintf(stderr, "%% Internal YAP Error: %s exiting....\n", tmpbuf);
// serious = true;
if (LOCAL_PrologMode & BootMode) {
fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf);
} else {
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
if (tmpbuf[0]) {
fprintf(stderr, "%% Bug found while executing %s\n", tmpbuf);
}
error_exit_yap(1);
}
case SYSTEM_ERROR_FATAL: {
fprintf(stderr, "%% Fatal YAP Error: %s exiting....\n", tmpbuf);
error_exit_yap(1);
}
case INTERRUPT_EVENT: {
error_exit_yap(1);
}
case ABORT_EVENT:
// fun = FunctorDollarVar;
// serious = true;
LOCAL_ActiveError->errorNo = ABORT_EVENT;
Yap_JumpToEnv();
P = FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return P;
case CALL_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
LOCAL_ActiveError->errorNo = CALL_COUNTER_UNDERFLOW_EVENT;
Yap_JumpToEnv();
P = FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return P;
case PRED_ENTRY_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
LOCAL_ActiveError->errorNo = PRED_ENTRY_COUNTER_UNDERFLOW_EVENT;
Yap_JumpToEnv();
P = FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return P;
case RETRY_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
LOCAL_ActiveError->errorNo = RETRY_COUNTER_UNDERFLOW_EVENT;
Yap_JumpToEnv();
P = FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return P;
default:
va_start(ap, where);
fmt = va_arg(ap, char *);
if (fmt != NULL) {
#if HAVE_VSNPRINTF
(void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap);
#else
(void)vsprintf(s, fmt, ap);
#if HAVE_BACKTRACE
void *callstack[256];
int i;
int frames = backtrace(callstack, 256);
char **strs = backtrace_symbols(callstack, frames);
fprintf(stderr, "Execution stack:\n");
for (i = 0; i < frames; ++i) {
fprintf(stderr, " %s\n", strs[i]);
}
free(strs);
#endif
va_end(ap);
break;
}
error_exit_yap(1);
}
}
Yap_MkErrorRecord(LOCAL_ActiveError, file, function, lineno, type, where, s);
if (where == 0 || where == TermNil) {
case SYSTEM_ERROR_FATAL: {
fprintf(stderr, "%% Fatal YAP Error: %s exiting....\n", tmpbuf);
error_exit_yap(1);
}
case INTERRUPT_EVENT: {
error_exit_yap(1);
}
case ABORT_EVENT:
// fun = FunctorDollarVar;
// serious = true;
LOCAL_ActiveError->errorNo = ABORT_EVENT;
Yap_JumpToEnv();
P = FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return P;
case CALL_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
LOCAL_ActiveError->errorNo = CALL_COUNTER_UNDERFLOW_EVENT;
Yap_JumpToEnv();
P = FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return P;
case PRED_ENTRY_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
LOCAL_ActiveError->errorNo = PRED_ENTRY_COUNTER_UNDERFLOW_EVENT;
Yap_JumpToEnv();
P = FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return P;
case RETRY_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
LOCAL_ActiveError->errorNo = RETRY_COUNTER_UNDERFLOW_EVENT;
Yap_JumpToEnv();
P = FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return P;
default:
va_start(ap, where);
fmt = va_arg(ap, char *);
if (fmt != NULL) {
#if HAVE_VSNPRINTF
(void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap);
#else
(void)vsprintf(s, fmt, ap);
#endif
va_end(ap);
break;
}
}
Yap_MkErrorRecord(LOCAL_ActiveError, file, function, lineno, type, where, s);
if (where == 0 || where == TermNil) {
LOCAL_ActiveError->culprit = 0;
}
if (P == (yamop *)(FAILCODE)) {
@ -841,7 +845,6 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
// DumpActiveGoals( USES_REGS1 );
#endif /* DEBUG */
CalculateStackGap(PASS_REGS1);
#if DEBUG
// DumpActiveGoals( PASS_REGS1 );
@ -855,7 +858,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
Yap_PrintWarning(MkErrorTerm(Yap_GetException(LOCAL_ActiveError)));
return P;
}
//LOCAL_ActiveError = Yap_GetException();
// LOCAL_ActiveError = Yap_GetException();
// reset_error_description();
if (!throw) {
Yap_JumpToEnv();
@ -887,9 +890,9 @@ static Int close_error(USES_REGS1) {
#define ECLASS(CL, A, B) CL##__,
#define END_ERROR_CLASSES() \
} \
aux_class_t;
#define END_ERROR_CLASSES() \
} \
aux_class_t;
#define BEGIN_ERRORS()
#define E0(X, Y)
@ -914,8 +917,8 @@ static Int close_error(USES_REGS1) {
#define ECLASS(CL, A, B) A,
#define END_ERROR_CLASSES() \
NULL \
#define END_ERROR_CLASSES() \
NULL \
}
typedef struct c_error_info {
@ -928,9 +931,9 @@ typedef struct c_error_info {
#define E(X, Y, Z) {Y##__, Z},
#define E1(X, Y, Z) {Y##__, Z},
#define E2(X, Y, Z, W) {Y##__, Z " " W},
#define END_ERRORS() \
{ YAPC_NO_ERROR, "" } \
} \
#define END_ERRORS() \
{ YAPC_NO_ERROR, "" } \
} \
;
#include <YapErrors.h>
@ -945,14 +948,14 @@ const char *Yap_errorClassName(yap_error_class_number e) {
return c_error_class_name[e];
}
yap_error_descriptor_t *Yap_GetException(yap_error_descriptor_t *i ) {
yap_error_descriptor_t *Yap_GetException(yap_error_descriptor_t *i) {
CACHE_REGS
if(i->errorNo != YAP_NO_ERROR) {
yap_error_descriptor_t *t = LOCAL_ActiveError,
*nt = malloc(sizeof(yap_error_descriptor_t));
memcpy(nt, t, sizeof(yap_error_descriptor_t));
return nt;
}
if (i->errorNo != YAP_NO_ERROR) {
yap_error_descriptor_t *t = LOCAL_ActiveError,
*nt = malloc(sizeof(yap_error_descriptor_t));
memcpy(nt, t, sizeof(yap_error_descriptor_t));
return nt;
}
return 0;
}
@ -975,16 +978,13 @@ bool Yap_ResetException(yap_error_descriptor_t *i) {
return true;
}
static Int reset_exception(USES_REGS1) {
return Yap_ResetException(worker_id); }
static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); }
Term MkErrorTerm(yap_error_descriptor_t *t) {
if (t->errorClass == EVENT)
return t->errorRawTerm;
return mkerrort(t->errorNo,
t->culprit?
Yap_BufferToTerm(t->culprit, TermNil): TermNil,
t->culprit ? Yap_BufferToTerm(t->culprit, TermNil) : TermNil,
err2list(t));
}
@ -1023,11 +1023,11 @@ static Int drop_exception(USES_REGS1) {
}
static Int new_exception(USES_REGS1) {
Term t = MkSysError(malloc(sizeof(yap_error_descriptor_t)));
Term t = MkSysError(calloc(1, sizeof(yap_error_descriptor_t)));
return Yap_unify(ARG1, t);
}
static Int get_exception( USES_REGS1) {
static Int get_exception(USES_REGS1) {
yap_error_descriptor_t *i;
Term t;
@ -1036,15 +1036,15 @@ static Int get_exception( USES_REGS1) {
Yap_ResetException(LOCAL_ActiveError);
LOCAL_PrologMode = UserMode;
if (i->errorRawTerm &&
(i->errorClass == EVENT || i->errorNo == SYNTAX_ERROR)) {
(i->errorClass == EVENT || i->errorNo == SYNTAX_ERROR)) {
t = i->errorRawTerm;
} else if (i->culprit != NULL) {
t = mkerrort(i->errorNo, Yap_BufferToTerm(i->culprit,TermNil),
t = mkerrort(i->errorNo, Yap_BufferToTerm(i->culprit, TermNil),
MkSysError(i));
} else {
t = mkerrort(i->errorNo, TermNil, MkSysError(i));
}
return Yap_unify(ARG1,t);
return Yap_unify(ARG1, t);
}
return false;
}
@ -1056,42 +1056,42 @@ yap_error_descriptor_t *event(Term t, yap_error_descriptor_t *i) {
return i;
}
yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
Term n = t;
bool found = false, wellformed = true;
if (!IsApplTerm(t) || FunctorOfTerm(t) != FunctorError) {
LOCAL_Error_TYPE = THROW_EVENT;
LOCAL_Error_TYPE = THROW_EVENT;
LOCAL_ActiveError->errorClass = EVENT;
LOCAL_ActiveError->errorAsText = Yap_errorName(THROW_EVENT);
LOCAL_ActiveError->classAsText = Yap_errorClassName(Yap_errorClass(THROW_EVENT));
LOCAL_ActiveError->classAsText =
Yap_errorClassName(Yap_errorClass(THROW_EVENT));
LOCAL_ActiveError->errorRawTerm = Yap_SaveTerm(t);
LOCAL_ActiveError->culprit = NULL;
} else {
Term t1, t2;
t1 = ArgOfTerm(1, t);
t2 = ArgOfTerm(2, t);
// LOCAL_Error_TYPE = ERROR_EVENT;
wellformed = wellformed && ( i->errorAsText != NULL );
if (wellformed) {
int j;
for (j = 0; j < sizeof(c_error_list) / sizeof(struct c_error_info); j++) {
if (!strcmp(c_error_list[j].name, i->errorAsText) &&
(c_error_list[j].class == 0 ||
!strcmp(i->classAsText,
c_error_class_name[c_error_list[j].class]))) {
if (c_error_list[j].class != PERMISSION_ERROR ||
(t1 = ArgOfTerm(2, t1) && IsAtomTerm(t1) &&
!strcmp(c_error_list[j].name,
RepAtom(AtomOfTerm(t1))->StrOfAE) &&
c_error_list[j].class != EVENT)) {
i->errorNo = j;
i->errorClass = c_error_list[j].class;
found = true;
break;
}
Term t1, t2;
t1 = ArgOfTerm(1, t);
t2 = ArgOfTerm(2, t);
// LOCAL_Error_TYPE = ERROR_EVENT;
wellformed = wellformed && (i->errorAsText != NULL);
if (wellformed) {
int j;
for (j = 0; j < sizeof(c_error_list) / sizeof(struct c_error_info); j++) {
if (!strcmp(c_error_list[j].name, i->errorAsText) &&
(c_error_list[j].class == 0 ||
!strcmp(i->classAsText,
c_error_class_name[c_error_list[j].class]))) {
if (c_error_list[j].class != PERMISSION_ERROR ||
(t1 = ArgOfTerm(2, t1) && IsAtomTerm(t1) &&
!strcmp(c_error_list[j].name,
RepAtom(AtomOfTerm(t1))->StrOfAE) &&
c_error_list[j].class != EVENT)) {
i->errorNo = j;
i->errorClass = c_error_list[j].class;
found = true;
break;
}
}
}
} else if (IsAtomTerm(t1)) {
const char *err = RepAtom(AtomOfTerm(t1))->StrOfAE;
if (!strcmp(err, "instantiation_error")) {
@ -1119,8 +1119,8 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
if (found) {
n = t2;
}
i->errorGoal =
Yap_TermToBuffer(n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
i->errorGoal = Yap_TermToBuffer(
n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
}
Yap_prolog_add_culprit(i PASS_REGS);
return i;
@ -1157,21 +1157,21 @@ static Int is_callable(USES_REGS1) {
if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
}
if (f == FunctorModule) {
Term tm = ArgOfTerm(1, G);
if (IsVarTerm(tm)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (!IsAtomTerm(tm)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
G = ArgOfTerm(2, G);
Term tm = ArgOfTerm(1, G);
if (IsVarTerm(tm)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (!IsAtomTerm(tm)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
G = ArgOfTerm(2, G);
} else {
return true;
return true;
}
} else if (IsPairTerm(G) || IsAtomTerm(G)) {
return true;
@ -1212,7 +1212,7 @@ static Int is_predicate_indicator(USES_REGS1) {
void Yap_InitErrorPreds(void) {
CACHE_REGS
Yap_InitCPred("$reset_exception", 1, reset_exception, 0);
Yap_InitCPred("$reset_exception", 1, reset_exception, 0);
Yap_InitCPred("$new_exception", 1, new_exception, 0);
Yap_InitCPred("$get_exception", 1, get_exception, 0);
Yap_InitCPred("$read_exception", 2, read_exception, 0);
@ -1223,5 +1223,5 @@ void Yap_InitErrorPreds(void) {
Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag);
Yap_InitCPred("is_atom", 2, is_atom, TestPredFlag);
Yap_InitCPred("is_predicate_indicator", 2, is_predicate_indicator,
TestPredFlag);
TestPredFlag);
}

184
C/exec.c
View File

@ -22,13 +22,13 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
* @file exec.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Mon Apr 30 13:48:35 2018
*
*
* @brief meta-call
*
* @namespace prolog
*
*
*
*
*
*/
#include "absmi.h"
@ -59,7 +59,7 @@ static choiceptr cp_from_integer(Term cpt USES_REGS) {
*/
Term Yap_cp_as_integer(choiceptr cp) {
CACHE_REGS
return cp_as_integer(cp PASS_REGS);
return cp_as_integer(cp PASS_REGS);
}
/**
@ -133,14 +133,14 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
/**
* Transfer control to a meta-call in ARG1, cut up to B.
*
*
* @param g goal
* @param mod current module
* @return su
*/
Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
CACHE_REGS
Term ts[4];
Term ts[4];
ts[0] = g;
ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
ts[2] = g;
@ -153,8 +153,8 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
Term Yap_PredicateIndicator(Term t, Term mod) {
CACHE_REGS
// generate predicate indicator in this case
Term ti[2];
// generate predicate indicator in this case
Term ti[2];
t = Yap_YapStripModule(t, &mod);
if (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) {
ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t)));
@ -227,7 +227,7 @@ static Int save_env_b(USES_REGS1) {
static PredEntry *new_pred(Term t, Term tmod, char *pname) {
Term t0 = t;
restart:
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
@ -405,7 +405,7 @@ inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) {
int j = -n;
Term t0 = t, mod0 = mod;
restart_exec:
restart_exec:
if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS);
} else if (IsAtomTerm(t)) {
@ -444,8 +444,8 @@ inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) {
}
if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled) {
return EnterCreepMode(
copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS),
mod PASS_REGS);
copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS),
mod PASS_REGS);
}
if (arity > MaxTemps) {
return CallError(TYPE_ERROR_CALLABLE, t0, mod0 PASS_REGS);
@ -455,7 +455,7 @@ inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) {
/* but no meta calls require special preprocessing */
// if (pen->PredFlags & (MetaPredFlag | UndefPredFlag)) {
// Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS);
//return (CallMetaCall(t0, mod0 PASS_REGS));
// return (CallMetaCall(t0, mod0 PASS_REGS));
//}
/* now let us do what we wanted to do from the beginning !! */
/* I cannot use the standard macro here because
@ -662,7 +662,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
yamop *code;
Term clt = Deref(ARG3);
restart_exec:
restart_exec:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
return FALSE;
@ -783,16 +783,16 @@ static Int Yap_ignore(Term t, bool fail USES_REGS) {
Int oENV = LCL0 - ENV;
Int oYENV = LCL0 - YENV;
Int oB = LCL0 - (CELL *)B;
yap_error_descriptor_t ctx;
bool newxp = Yap_pushErrorContext(true, &ctx);
yap_error_descriptor_t *ctx = malloc(sizeof(yap_error_descriptor_t));
bool newxp = Yap_pushErrorContext(true, ctx);
bool rc = Yap_RunTopGoal(t, false);
Yap_popErrorContext(newxp, true);
if (!rc) {
complete_inner_computation((choiceptr)(LCL0 - oB));
// We'll pass it through
} else {
prune_inner_computation((choiceptr)(LCL0 - oB));
}
Yap_popErrorContext(newxp, true);
P = oP;
CP = oCP;
ENV = LCL0 - oENV;
@ -832,7 +832,7 @@ static bool watch_cut(Term ext USES_REGS) {
}
CELL *port_pt = deref_ptr(RepAppl(task) + 2);
CELL *completion_pt = deref_ptr(RepAppl(task) + 4);
if (LOCAL_ActiveError && LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
if (LOCAL_ActiveError && LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
e = MkErrorTerm(LOCAL_ActiveError);
Term t;
if (active) {
@ -849,7 +849,7 @@ static bool watch_cut(Term ext USES_REGS) {
CELL *complete_pt = deref_ptr(RepAppl(task) + 4);
complete_pt[0] = TermTrue;
if (ex_mode) {
//Yap_PutException(e);
// Yap_PutException(e);
return true;
}
if (Yap_RaiseException())
@ -888,8 +888,7 @@ static bool watch_retry(Term d0 USES_REGS) {
// just do the frrpest
if (B >= B0 && !ex_mode && !active)
return true;
if (LOCAL_ActiveError &&
LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
if (LOCAL_ActiveError && LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
e = MkErrorTerm(LOCAL_ActiveError);
if (active) {
t = Yap_MkApplTerm(FunctorException, 1, &e);
@ -909,7 +908,7 @@ static bool watch_retry(Term d0 USES_REGS) {
port_pt[0] = t;
Yap_ignore(cleanup, true);
if (ex_mode) {
//Yap_PutException(e);
// Yap_PutException(e);
return true;
}
if (Yap_RaiseException())
@ -999,9 +998,9 @@ static Int cleanup_on_exit(USES_REGS1) {
static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) {
CACHE_REGS
if (creeping) {
Yap_signal(YAP_CREEP_SIGNAL);
}
if (creeping) {
Yap_signal(YAP_CREEP_SIGNAL);
}
CurrentModule = omod;
Yap_CloseSlots(sl);
if (out) {
@ -1031,7 +1030,7 @@ static Int _user_expand_goal(USES_REGS1) {
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
ARG2 = Yap_GetFromSlot(h2);
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) &&
Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
@ -1041,7 +1040,7 @@ static Int _user_expand_goal(USES_REGS1) {
ARG3 = Yap_GetFromSlot(h2);
/* user:goal_expansion(A,CurMod,B) */
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
return complete_ge(true, omod, sl, creeping);
@ -1053,7 +1052,7 @@ static Int _user_expand_goal(USES_REGS1) {
/* user:goal_expansion(A,B) */
if (cmod != USER_MODULE && /* we have tried this before */
(pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
return complete_ge(true, omod, sl, creeping);
@ -1073,7 +1072,7 @@ static Int do_term_expansion(USES_REGS1) {
ARG1 = g;
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) &&
Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
@ -1092,7 +1091,7 @@ static Int do_term_expansion(USES_REGS1) {
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
ARG2 = Yap_GetFromSlot(h2);
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) &&
Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
@ -1110,7 +1109,7 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
return EnterCreepMode(t, mod PASS_REGS);
}
t = Yap_YapStripModule(t, &mod);
restart_exec:
restart_exec:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
return false;
@ -1246,15 +1245,14 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
return rc;
}
/**
* @brief Two argument version of non-interruptible execution: this will
* ignore signals including debugging requests.
*
*
* @return Int succeeds if it can transfer control.
*/
static Int execute_nonstop(USES_REGS1) {
static Int execute_nonstop(USES_REGS1) {
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
unsigned int arity;
@ -1329,20 +1327,17 @@ static Int execute_nonstop(USES_REGS1) {
}
}
/**
* @brief One argument version of non-interruptible execution: this will
* ignore signals including debugging requests.
*
*
* @return Int succeeds if it can transfer control.
*/
static Int execute_nonstop1(USES_REGS1)
{
ARG2 = CurrentModule;
return execute_nonstop( PASS_REGS1 );
static Int execute_nonstop1(USES_REGS1) {
ARG2 = CurrentModule;
return execute_nonstop(PASS_REGS1);
}
static Int execute_0(USES_REGS1) { /* '$execute_0'(Goal) */
Term mod = CurrentModule;
Term t = Yap_YapStripModule(Deref(ARG1), &mod);
@ -1433,7 +1428,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
sigjmp_buf signew, *sighold = LOCAL_RestartEnv;
LOCAL_RestartEnv = &signew;
int i = AllocLevel();
if /* top &&*/( (lval = sigsetjmp(signew, 1)) != 0) {
if /* top &&*/ ((lval = sigsetjmp(signew, 1)) != 0) {
switch (lval) {
case 1: { /* restart */
/* otherwise, SetDBForThrow will fail entering critical mode */
@ -1447,15 +1442,14 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
/* H is not so important, because we're gonna backtrack */
restore_H();
/* set stack */
ASP = (CELL *) PROTECT_FROZEN_B(B);
ASP = (CELL *)PROTECT_FROZEN_B(B);
/* forget any signals active, we're reborne */
LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode = UserMode;
Yap_CloseSlots(sls);
P = (yamop *) FAILCODE;
}
break;
P = (yamop *)FAILCODE;
} break;
case 2: {
// LOCAL_ActiveError = err_info;
/* arithmetic exception */
@ -1466,20 +1460,19 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
* machine */
pop_text_stack(i);
Yap_set_fpu_exceptions(
getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
P = (yamop *) FAILCODE;
getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
P = (yamop *)FAILCODE;
LOCAL_PrologMode = UserMode;
Yap_CloseSlots(sls);
}
break;
} break;
case 3: { /* saved state */
// LOCAL_ActiveError = err_info;
pop_text_stack(i);
LOCAL_CBorder = OldBorder;
LOCAL_RestartEnv = sighold;
LOCAL_PrologMode = UserMode;
Yap_CloseSlots(sls);
return false;
Yap_CloseSlots(sls);
return false;
}
case 4:
/* abort */
@ -1487,16 +1480,16 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
*/
// LOCAL_ActiveError = err_info;
while (B) {
LOCAL_ActiveError->errorNo = ABORT_EVENT;
pop_text_stack(i);
Yap_CloseSlots(sls);
Yap_JumpToEnv();
LOCAL_ActiveError->errorNo = ABORT_EVENT;
pop_text_stack(i);
Yap_CloseSlots(sls);
Yap_JumpToEnv();
}
LOCAL_PrologMode = UserMode;
P = (yamop *) FAILCODE;
P = (yamop *)FAILCODE;
LOCAL_RestartEnv = sighold;
Yap_CloseSlots(sls);
pop_text_stack(i);
pop_text_stack(i);
return false;
break;
case 5:
@ -1513,12 +1506,13 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
Yap_JumpToEnv();
Yap_CloseTemporaryStreams();
Yap_CloseSlots(sls);
ASP = (CELL *) PROTECT_FROZEN_B(B);
ASP = (CELL *)PROTECT_FROZEN_B(B);
if (B == NULL || B->cp_b == NULL || (CELL*)(B->cp_b) > LCL0 - LOCAL_CBorder) {
LOCAL_RestartEnv = sighold;
LOCAL_CBorder = OldBorder;
return false;
if (B == NULL || B->cp_b == NULL ||
(CELL *)(B->cp_b) > LCL0 - LOCAL_CBorder) {
LOCAL_RestartEnv = sighold;
LOCAL_CBorder = OldBorder;
return false;
}
P = FAILCODE;
}
@ -1600,12 +1594,12 @@ static bool do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) {
bool Yap_exec_absmi(bool top, yap_reset_t has_reset) {
CACHE_REGS
return exec_absmi(top, has_reset PASS_REGS);
return exec_absmi(top, has_reset PASS_REGS);
}
/**
* Fails computation up to choice-point bb
*
*
* @param USES_REGS thread support
*/
void Yap_fail_all(choiceptr bb USES_REGS) {
@ -1742,7 +1736,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
CACHE_REGS
Prop pe;
Prop pe;
PredEntry *ppe;
CELL *pt;
/* preserve the current restart environment */
@ -1779,7 +1773,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
void Yap_trust_last(void) {
CACHE_REGS
ASP = B->cp_env;
ASP = B->cp_env;
CP = B->cp_cp;
HR = B->cp_h;
#ifdef DEPTH_LIMIT
@ -1797,7 +1791,7 @@ void Yap_trust_last(void) {
Term Yap_RunTopGoal(Term t, bool handle_errors) {
CACHE_REGS
yamop *CodeAdr;
yamop *CodeAdr;
Prop pe;
PredEntry *ppe;
CELL *pt;
@ -1811,11 +1805,12 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
Yap_Error(INSTANTIATION_ERROR, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
} if (IsPairTerm(t)) {
}
if (IsPairTerm(t)) {
Term ts[2];
ts[0] = t;
ts[1] = (CurrentModule == 0? TermProlog: CurrentModule);
t = Yap_MkApplTerm(FunctorCsult,2,ts);
ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
t = Yap_MkApplTerm(FunctorCsult, 2, ts);
}
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@ -2035,7 +2030,7 @@ static Int cut_up_to_next_disjunction(USES_REGS1) {
*/
bool Yap_Reset(yap_reset_t mode, bool hard) {
CACHE_REGS
int res = TRUE;
int res = TRUE;
Yap_ResetException(worker_id);
/* first, backtrack to the root */
@ -2082,12 +2077,9 @@ static Int JumpToEnv(USES_REGS1) {
so get pointers here */
/* find the first choicepoint that may be a catch */
// DBTerm *dbt = Yap_RefToException();
while (handler
&& Yap_PredForChoicePt(handler, NULL) != PredDollarCatch
&& LOCAL_CBorder < LCL0 - (CELL *)handler
&& handler->cp_ap != NOCODE
&& handler->cp_b != NULL
) {
while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch &&
LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE &&
handler->cp_b != NULL) {
handler->cp_ap = TRUSTFAILCODE;
handler = handler->cp_b;
}
@ -2102,8 +2094,8 @@ static Int JumpToEnv(USES_REGS1) {
bool Yap_JumpToEnv(void) {
CACHE_REGS
if (LOCAL_PrologMode & TopGoalMode)
return true;
if (LOCAL_PrologMode & TopGoalMode)
return true;
return JumpToEnv(PASS_REGS1);
}
@ -2111,10 +2103,11 @@ bool Yap_JumpToEnv(void) {
static Int jump_env(USES_REGS1) {
Term t = Deref(ARG1), t0 = t;
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t, "throw/1 must be called instantiated");
Yap_ThrowError(INSTANTIATION_ERROR, t,
"throw/1 must be called instantiated");
}
// Yap_DebugPlWriteln(t);
LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError);
// Yap_DebugPlWriteln(t);
LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError);
bool out = JumpToEnv(PASS_REGS1);
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
LCL0 - (CELL *)B > LOCAL_CBorder) {
@ -2149,11 +2142,11 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#endif
#endif /* PUSH_REGS */
CACHE_REGS
Yap_ResetException(LOCAL_ActiveError);
Yap_ResetException(LOCAL_ActiveError);
Yap_PutValue(AtomBreak, MkIntTerm(0));
TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
HR = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id)) +
1; // +1: hack to ensure the gc does not try to mark mistakenly
HR = H0 = ((CELL *)REMOTE_GlobalBase(myworker_id)) +
1; // +1: hack to ensure the gc does not try to mark mistakenly
LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id);
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap);
/* notice that an initial choice-point and environment
@ -2166,12 +2159,12 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#endif
STATIC_PREDICATES_MARKED = FALSE;
if (full_reset) {
HR = H0+1;
HR = H0 + 1;
h0var = MkVarTerm();
REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var);
REMOTE_GcCurrentPhase(myworker_id) = 0L;
REMOTE_GcPhase(myworker_id) =
Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id)));
Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id)));
#if COROUTINING
REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil);
h0var = MkVarTerm();
@ -2187,7 +2180,7 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#ifdef YAPOR_SBA
BSEG =
#endif /* YAPOR_SBA */
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
#endif /* FROZEN_STACKS */
CalculateStackGap(PASS_REGS1);
@ -2209,7 +2202,7 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#ifdef YAPOR_SBA
BSEG =
#endif /* YAPOR_SBA */
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
#endif /* FROZEN_STACKS */
CalculateStackGap(PASS_REGS1);
@ -2246,7 +2239,7 @@ int Yap_dogc(int extra_args, Term *tp USES_REGS) {
void Yap_InitExecFs(void) {
CACHE_REGS
YAP_opaque_handler_t catcher_ops;
YAP_opaque_handler_t catcher_ops;
memset(&catcher_ops, 0, sizeof(catcher_ops));
catcher_ops.cut_handler = watch_cut;
catcher_ops.fail_handler = watch_retry;
@ -2296,17 +2289,18 @@ void Yap_InitExecFs(void) {
Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag);
CurrentModule = cm;
Yap_InitCPred("$restore_regs", 1, restore_regs,
NoTracePredFlag | SafePredFlag);
Yap_InitCPred("$restore_regs", 2, restore_regs2,NoTracePredFlag | SafePredFlag);
NoTracePredFlag | SafePredFlag);
Yap_InitCPred("$restore_regs", 2, restore_regs2,
NoTracePredFlag | SafePredFlag);
Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag);
Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction,
SafePredFlag);
SafePredFlag);
Yap_InitCPred("throw", 1, jump_env, 0);
Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0);
Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0);
Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0);
Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup,
0);
0);
Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, NoTracePredFlag);
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
}

4
C/flags.c
View File

@ -1444,7 +1444,7 @@ do_prolog_flag_property(Term tflag,
prolog_flag_property_choices_t i;
bool rc = true;
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END);
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
@ -1612,7 +1612,7 @@ static Int do_create_prolog_flag(USES_REGS1) {
Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3);
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END);
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;

442
C/stack.c
View File

@ -67,13 +67,13 @@ static LogUpdIndex *find_owner_log_index(LogUpdIndex *, yamop *);
static StaticIndex *find_owner_static_index(StaticIndex *, yamop *);
#define IN_BLOCK(P, B, SZ) \
#define IN_BLOCK(P, B, SZ) \
((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ))
static PredEntry *get_pred(Term t, Term tmod, char *pname) {
Term t0 = t;
restart:
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
@ -268,8 +268,8 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
/* check first environments that are younger than our latest choicepoint */
if (check_everything && env_ptr) {
/*
I do not need to check environments for asserts,
only for retracts
I do not need to check environments for asserts,
only for retracts
*/
while (env_ptr && b_ptr > (choiceptr)env_ptr) {
yamop *cp = (yamop *)env_ptr[E_CP];
@ -286,8 +286,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
if (b_ptr) {
pe = PredForChoicePt(b_ptr->cp_ap, NULL);
}
else
} else
return false;
if (pe == p) {
if (check_everything)
@ -539,7 +538,8 @@ static Int find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp,
}
/*
static bool put_clause_loc(yap_error_descriptor_t *t, void *clcode, PredEntry *pp) {
static bool put_clause_loc(yap_error_descriptor_t *t, void *clcode, PredEntry
*pp) {
CACHE_REGS
if (pp->PredFlags & LogUpdatePredFlag) {
@ -575,33 +575,33 @@ static Int find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp,
static Term clause_loc(void *clcode, PredEntry *pp) {
CACHE_REGS
if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = clcode;
if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = clcode;
if (cl->ClFlags & FactMask) {
return MkIntegerTerm(cl->lusl.ClLine);
} else {
return MkIntegerTerm(cl->lusl.ClSource->ag.line_number);
}
} else if (pp->PredFlags & DynamicPredFlag) {
// DynamicClause *cl;
// cl = ClauseCodeToDynamicClause(clcode);
return MkIntTerm(0);
} else if (pp->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause);
return MkIntTerm(mcl->ClLine);
if (cl->ClFlags & FactMask) {
return MkIntegerTerm(cl->lusl.ClLine);
} else {
StaticClause *cl;
cl = clcode;
if (cl->ClFlags & FactMask) {
return MkIntTerm(cl->usc.ClLine);
} else if (cl->ClFlags & SrcMask) {
return MkIntTerm(cl->usc.ClSource->ag.line_number);
} else
return MkIntTerm(0);
return MkIntegerTerm(cl->lusl.ClSource->ag.line_number);
}
} else if (pp->PredFlags & DynamicPredFlag) {
// DynamicClause *cl;
// cl = ClauseCodeToDynamicClause(clcode);
return MkIntTerm(0);
} else if (pp->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause);
return MkIntTerm(mcl->ClLine);
} else {
StaticClause *cl;
cl = clcode;
if (cl->ClFlags & FactMask) {
return MkIntTerm(cl->usc.ClLine);
} else if (cl->ClFlags & SrcMask) {
return MkIntTerm(cl->usc.ClSource->ag.line_number);
} else
return MkIntTerm(0);
}
return MkIntTerm(0);
}
@ -614,15 +614,15 @@ static int cl_code_in_pred(PredEntry *pp, yamop *codeptr, void **startp,
if (pp->PredFlags & IndexedPredFlag) {
if (pp->PredFlags & LogUpdatePredFlag) {
if (code_in_pred_lu_index(
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
startp, endp)) {
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
startp, endp)) {
UNLOCK(pp->PELock);
return TRUE;
}
} else {
if (code_in_pred_s_index(
ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
startp, endp)) {
ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
startp, endp)) {
UNLOCK(pp->PELock);
return TRUE;
}
@ -659,16 +659,16 @@ static Int code_in_pred(PredEntry *pp, Atom *pat, UInt *parity,
if (pp->PredFlags & IndexedPredFlag) {
if (pp->PredFlags & LogUpdatePredFlag) {
if (code_in_pred_lu_index(
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
NULL, NULL)) {
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
NULL, NULL)) {
code_in_pred_info(pp, pat, parity);
UNLOCK(pp->PELock);
return -1;
}
} else {
if (code_in_pred_s_index(
ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
NULL, NULL)) {
ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
NULL, NULL)) {
code_in_pred_info(pp, pat, parity);
UNLOCK(pp->PELock);
return -1;
@ -821,8 +821,8 @@ static PredEntry *found_owner_op(yamop *pc, void **startp,
static PredEntry *found_expand(yamop *pc, void **startp,
void **endp USES_REGS) {
PredEntry *pp =
((PredEntry *)(Unsigned(pc) -
(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode))));
((PredEntry *)(Unsigned(pc) -
(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode))));
*startp = (CODEADDR) & (pp->cs.p_code.ExpandCode);
*endp = (CODEADDR)NEXTOP((yamop *)&(pp->cs.p_code.ExpandCode), e);
return pp;
@ -898,19 +898,19 @@ static PredEntry *ClauseInfoForCode(yamop *codeptr, void **startp,
PredEntry *Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from,
void **startp, void **endp) {
CACHE_REGS
if (where_from == FIND_PRED_FROM_CP) {
PredEntry *pp = PredForChoicePt(codeptr, NULL);
if (cl_code_in_pred(pp, codeptr, startp, endp)) {
return pp;
}
} else if (where_from == FIND_PRED_FROM_ENV) {
PredEntry *pp = EnvPreg(codeptr);
if (cl_code_in_pred(pp, codeptr, startp, endp)) {
return pp;
}
} else {
return ClauseInfoForCode(codeptr, startp, endp PASS_REGS);
if (where_from == FIND_PRED_FROM_CP) {
PredEntry *pp = PredForChoicePt(codeptr, NULL);
if (cl_code_in_pred(pp, codeptr, startp, endp)) {
return pp;
}
} else if (where_from == FIND_PRED_FROM_ENV) {
PredEntry *pp = EnvPreg(codeptr);
if (cl_code_in_pred(pp, codeptr, startp, endp)) {
return pp;
}
} else {
return ClauseInfoForCode(codeptr, startp, endp PASS_REGS);
}
return NULL;
}
@ -1097,7 +1097,7 @@ static Int p_all_envs(USES_REGS1) {
static Term clause_info(yamop *codeptr, PredEntry *pp) {
CACHE_REGS
Term ts[2];
Term ts[2];
void *begin;
if (pp->ArityOfPE == 0) {
@ -1121,22 +1121,21 @@ static Term clause_info(yamop *codeptr, PredEntry *pp) {
return Yap_MkApplTerm(FunctorModule, 2, ts);
}
yap_error_descriptor_t * set_clause_info(yap_error_descriptor_t *t, yamop *codeptr, PredEntry *pp) {
yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t,
yamop *codeptr, PredEntry *pp) {
CACHE_REGS
Term ts[2];
Term ts[2];
void *begin;
if (pp->ArityOfPE == 0) {
t->prologPredName =
AtomName((Atom)pp->FunctorOfPred);
t->prologPredName = AtomName((Atom)pp->FunctorOfPred);
t->prologPredArity = 0;
} else {
t->prologPredName =
AtomName(NameOfFunctor(pp->FunctorOfPred));
t->prologPredName = AtomName(NameOfFunctor(pp->FunctorOfPred));
t->prologPredArity = pp->ArityOfPE;
}
t->prologPredModule =
(pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE
: "prolog");
(pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE
: "prolog");
t->prologPredFile = RepAtom(pp->src.OwnerFile)->StrOfAE;
if (codeptr->opc == UNDEF_OPCODE) {
t->prologPredFirstLine = 0;
@ -1144,25 +1143,25 @@ yap_error_descriptor_t * set_clause_info(yap_error_descriptor_t *t, yamop *cod
t->prologPredLastLine = 0;
return t;
} else if (pp->cs.p_code.NOfClauses) {
if ((t->prologPredCl =
find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) {
if ((t->prologPredCl = find_code_in_clause(pp, codeptr, &begin, NULL)) <=
0) {
t->prologPredLine = 0;
} else {
t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
}
if (pp->PredFlags & LogUpdatePredFlag) {
t->prologPredFirstLine = clause_loc(
ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp);
t->prologPredLastLine = clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause),
pp);
t->prologPredFirstLine =
clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp);
t->prologPredLastLine =
clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause), pp);
} else {
t->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc(
ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp));
ts[0] = clause_loc(
ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp));
t->prologPredLastLine = IntegerOfTerm(
ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause),
pp));
ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause),
pp));
}
return t;
} else {
@ -1198,7 +1197,8 @@ static Term error_culprit(bool internal USES_REGS) {
return TermNil;
}
yap_error_descriptor_t * Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_REGS) {
yap_error_descriptor_t *
Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_REGS) {
PredEntry *pe;
void *startp, *endp;
// case number 1: Yap_Error called from built-in.
@ -1212,32 +1212,32 @@ yap_error_descriptor_t * Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_R
PredEntry *pe = EnvPreg(curCP);
while (curCP != YESCODE) {
if (curENV ) {
pe = EnvPreg(curCP);
curENV = (CELL *)(curENV[E_E]);
if (curENV < ASP || curENV >= LCL0) {
break;
}
curCP = (yamop *)curENV[E_CP];
if (pe == NULL) {
pe = PredMetaCall;
}
if (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag))
return set_clause_info(t, curCP, pe);
curCP = (yamop *)(curENV[E_CP]);
} else if (0) {
if ( curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE
&& curB->cp_ap != FAILCODE) {
pe = curB->cp_ap->y_u.Otapl.p;
if (pe && (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag)))
return set_clause_info(t, curB->cp_ap, pe);
}
curB = curB->cp_b;
if (curENV) {
pe = EnvPreg(curCP);
curENV = (CELL *)(curENV[E_E]);
if (curENV < ASP || curENV >= LCL0) {
break;
}
curCP = (yamop *)curENV[E_CP];
if (pe == NULL) {
pe = PredMetaCall;
}
if (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag))
return set_clause_info(t, curCP, pe);
curCP = (yamop *)(curENV[E_CP]);
} else if (0) {
if (curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE &&
curB->cp_ap != FAILCODE) {
pe = curB->cp_ap->y_u.Otapl.p;
if (pe && (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag)))
return set_clause_info(t, curB->cp_ap, pe);
}
curB = curB->cp_b;
}
}
}
return NULL;
return NULL;
}
static Term all_calls(bool internal USES_REGS) {
@ -1261,10 +1261,9 @@ static Term all_calls(bool internal USES_REGS) {
return Yap_MkApplTerm(f, 6, ts);
}
Term Yap_all_calls(void) {
CACHE_REGS
return all_calls(true PASS_REGS);
return all_calls(true PASS_REGS);
}
/**
@ -1392,23 +1391,23 @@ void Yap_dump_code_area_for_profiler(void) {
while (pp != NULL) {
/* if (pp->ArityOfPE) {
fprintf(stderr,"%s/%d %p\n",
RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE,
pp->ArityOfPE,
pp);
} else {
fprintf(stderr,"%s %p\n",
RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE,
pp);
}*/
fprintf(stderr,"\%s/%d %p\n",
RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE,
pp->ArityOfPE,
pp);
} else {
fprintf(stderr,"\%s %p\n",
RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE,
pp);
}*/
add_code_in_pred(pp);
pp = pp->NextPredOfModule;
}
me = me->NextME;
}
Yap_inform_profiler_of_clause(
COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)),
GPROF_INIT_COMMA);
COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)),
GPROF_INIT_COMMA);
Yap_inform_profiler_of_clause(FAILCODE, FAILCODE + 1,
RepPredProp(Yap_GetPredPropByAtom(AtomFail, 0)),
GPROF_INIT_FAIL);
@ -1441,7 +1440,7 @@ static Int program_continuation(USES_REGS1) {
static Term BuildActivePred(PredEntry *ap, CELL *vect) {
CACHE_REGS
arity_t i;
arity_t i;
if (!ap->ArityOfPE) {
return MkAtomTerm((Atom)ap->FunctorOfPred);
@ -1489,8 +1488,8 @@ static int UnifyPredInfo(PredEntry *pe, int start_arg USES_REGS) {
}
return Yap_unify(XREGS[start_arg], tmod) &&
Yap_unify(XREGS[start_arg + 1], tname) &&
Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity));
Yap_unify(XREGS[start_arg + 1], tname) &&
Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity));
}
static Int ClauseId(yamop *ipc, PredEntry *pe) {
@ -1512,7 +1511,7 @@ static Int env_info(USES_REGS1) {
/* pe = PREVOP(env_cp,Osbpp)->y_u.Osbpp.p0; */
taddr = MkIntegerTerm((Int)env);
return Yap_unify(ARG3, MkIntegerTerm((Int)env_cp)) &&
Yap_unify(ARG2, taddr) && Yap_unify(ARG4, env_b);
Yap_unify(ARG2, taddr) && Yap_unify(ARG4, env_b);
}
static Int p_cpc_info(USES_REGS1) {
@ -1521,7 +1520,7 @@ static Int p_cpc_info(USES_REGS1) {
pe = PREVOP(ipc, Osbpp)->y_u.Osbpp.p0;
return UnifyPredInfo(pe, 2 PASS_REGS) &&
Yap_unify(ARG5, MkIntegerTerm(ClauseId(ipc, pe)));
Yap_unify(ARG5, MkIntegerTerm(ClauseId(ipc, pe)));
}
static Int p_choicepoint_info(USES_REGS1) {
@ -1562,10 +1561,10 @@ static Int p_choicepoint_info(USES_REGS1) {
t = MkVarTerm();
} else
#endif /* DETERMINISTIC_TABLING */
{
pe = GEN_CP(cptr)->cp_pred_entry;
t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1));
}
{
pe = GEN_CP(cptr)->cp_pred_entry;
t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1));
}
#else
pe = UndefCode;
t = MkVarTerm();
@ -1701,8 +1700,8 @@ static Int p_choicepoint_info(USES_REGS1) {
}
}
return UnifyPredInfo(pe, 3 PASS_REGS) && Yap_unify(ARG2, taddr) &&
Yap_unify(ARG6, t) &&
Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe)));
Yap_unify(ARG6, t) &&
Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe)));
}
static Int /* $parent_pred(Module, Name, Arity) */
@ -1714,11 +1713,11 @@ parent_pred(USES_REGS1) {
Term module;
if (!PredForCode(P_before_spy, &at, &arity, &module, NULL)) {
return Yap_unify(ARG1, MkIntTerm(0)) &&
Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) &&
Yap_unify(ARG3, MkIntTerm(0));
Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) &&
Yap_unify(ARG3, MkIntTerm(0));
}
return Yap_unify(ARG1, MkIntTerm(module)) &&
Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity));
Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity));
}
void Yap_dump_stack(void);
@ -1729,7 +1728,7 @@ static int hidden(Atom);
static int legal_env(CELL *CACHE_TYPE);
#define ONLOCAL(ptr) \
#define ONLOCAL(ptr) \
(CellPtr(ptr) > CellPtr(HR) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase))
static int hidden(Atom at) {
@ -1788,7 +1787,7 @@ static bool handled_exception(USES_REGS1) {
void Yap_dump_stack(void) {
CACHE_REGS
choiceptr b_ptr = B;
choiceptr b_ptr = B;
CELL *env_ptr = ENV;
char tp[256];
yamop *ipc = CP;
@ -1797,23 +1796,83 @@ void Yap_dump_stack(void) {
/* check if handled */
if (handled_exception(PASS_REGS1))
return;
#if DEBUG
fprintf(stderr, "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",
#if DEBU
fprintf(stderr, "\% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",
P, CP, ASP, HR, TR, HeapTop);
fprintf(stderr, "%% YAP mode: %ux\n", (unsigned int)LOCAL_PrologMode);
if (LOCAL_ErrorMessage)
fprintf(stderr, "%% LOCAL_ErrorMessage: %s\n", LOCAL_ErrorMessage);
#endif
fprintf(stderr, "\% \n% =====================================\n\%\n");
fprintf(stderr, "\% \n% YAP Status:\n");
fprintf(stderr, "\% \n\% -------------------------------------\n\%\n");
yap_error_descriptor_t errno = LOCAL_Error_TYPE;
yap_error_class_number classno = Yap_errorClass(errno);
fprintf(stderr, "\% Error STATUS: %s/%s\n\n", Yap_errorName(errno),
Yap_errorName(classno));
fprintf(stderr, "\% Execution mode\n");
if (LOCAL_PrologMode & BootMode)
fprintf(stderr, "\% Bootstrap\n");
if (LOCAL_PrologMode & UserMode)
fprintf(stderr, "\% User Prolo\n");
if (LOCAL_PrologMode & CritMode)
fprintf(stderr, "\% Exclusive Access Mode\n");
if (LOCAL_PrologMode & AbortMode)
fprintf(stderr, "\% Abort\n");
if (LOCAL_PrologMode & InterruptMode)
fprintf(stderr, "\% Interrupt\n");
if (LOCAL_PrologMode & InErrorMode)
fprintf(stderr, "\% Error\n");
if (LOCAL_PrologMode & ConsoleGetcMode)
fprintf(stderr, "\% Prompt Console\n");
if (LOCAL_PrologMode & ExtendStackMode)
fprintf(stderr, "\% Stack expansion \n");
if (LOCAL_PrologMode & GrowHeapMode)
fprintf(stderr, "\% Data Base Expansion\n");
if (LOCAL_PrologMode & GrowStackMode)
fprintf(stderr, "\% User Prolog\n");
if (LOCAL_PrologMode & GCMode)
fprintf(stderr, "\% Garbage Collection\n");
if (LOCAL_PrologMode & ErrorHandlingMode)
fprintf(stderr, "\% Error handler\n");
if (LOCAL_PrologMode & CCallMode)
fprintf(stderr, "\% System Foreign Code\n");
if (LOCAL_PrologMode & UnifyMode)
fprintf(stderr, "\% Off-line Foreign Code\n");
if (LOCAL_PrologMode & UserCCallMode)
fprintf(stderr, "\% User Foreig C\n");
if (LOCAL_PrologMode & MallocMode)
fprintf(stderr, "\% Heap Allocaror\n");
if (LOCAL_PrologMode & SystemMode)
fprintf(stderr, "\% Prolog Internals\n");
if (LOCAL_PrologMode & AsyncIntMode)
fprintf(stderr, "\% Async Interruot mode\n");
if (LOCAL_PrologMode & InReadlineMode)
fprintf(stderr, "\% Readline Console\n");
if (LOCAL_PrologMode & TopGoalMode)
fprintf(stderr, "\% Creating new query\n");
fprintf(stderr, "\% \n\% -------------------------------------\n\%\n");
fprintf(stderr, "\% \n% YAP Program :\n");
fprintf(stderr, "\% \n\% -------------------------------------\n\%\n");
fprintf(stderr, "\% Program Position\n\n", Yap_errorName(errno),
Yap_errorName(classno);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "\% PC: %s\n", (char *)HR);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "\% Continuation: %s\n", (char *)HR);
Yap_detect_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "\% Alternative: %s\n", (char *)HR);
if (HR > ASP || HR > LCL0) {
fprintf(stderr, "%% YAP ERROR: Global Collided against Local (%p--%p)\n",
fprintf(stderr, "\% YAP ERROR: Global Collided against Local (%p--%p)\n",
HR, ASP);
} else if (HeapTop > (ADDR)LOCAL_GlobalBase) {
fprintf(stderr,
"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n",
"\% YAP ERROR: Code Space Collided against Global (%p--%p)\n",
HeapTop, LOCAL_GlobalBase);
} else {
#if !USE_SYSTEM_MALLOC
fprintf(stderr, "%ldKB of Code Space (%p--%p)\n",
fprintf(stderr, "\%ldKB of Code Space (%p--%p)\n",
(long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase,
HeapTop);
#if USE_DL_MALLOC
@ -1826,18 +1885,14 @@ void Yap_dump_stack(void) {
}
#endif
#endif
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%%\n%% PC: %s\n", (char *)HR);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%% Continuation: %s\n", (char *)HR);
fprintf(stderr, "%% %luKB of Global Stack (%p--%p)\n",
fprintf(stderr, "\% %luKB of Global Stack (%p--%p)\n",
(unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR);
fprintf(stderr, "%% %luKB of Local Stack (%p--%p)\n",
fprintf(stderr, "\% %luKB of Local Stack (%p--%p)\n",
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0);
fprintf(stderr, "%% %luKB of Trail (%p--%p)\n",
fprintf(stderr, "\% %luKB of Trail (%p--%p)\n",
(unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024,
LOCAL_TrailBase, TR);
fprintf(stderr, "%% Performed %ld garbage collections\n",
fprintf(stderr, "\% Performed %ld garbage collections\n",
(unsigned long int)LOCAL_GcCalls);
#if LOW_LEVEL_TRACER
{
@ -1852,20 +1907,20 @@ void Yap_dump_stack(void) {
}
}
#endif
fprintf(stderr, "%% All Active Calls and\n");
fprintf(stderr, "%% Goals With Alternatives Open (Global In "
"Use--Local In Use)\n%%\n");
fprintf(stderr, "\% All Active Calls and\n");
fprintf(stderr, "\% Goals With Alternatives Open (Global In "
"Use--Local In Use)\n%%\n");
while (b_ptr != NULL) {
while (env_ptr && env_ptr <= (CELL *)b_ptr) {
Yap_detect_bug_location(ipc, FIND_PRED_FROM_ENV, 256);
if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) {
b_ptr = b_ptr->cp_b;
fprintf(stderr, "%% %s\n", tp);
fprintf(stderr, "\% %s\n", tp);
} else {
fprintf(stderr, "%% %s\n", tp);
}
if (!max_count--) {
fprintf(stderr, "%% .....\n");
fprintf(stderr, "\% .....\n");
return;
}
ipc = (yamop *)(env_ptr[E_CP]);
@ -1873,7 +1928,7 @@ void Yap_dump_stack(void) {
}
if (b_ptr) {
if (!max_count--) {
fprintf(stderr, "%% .....\n");
fprintf(stderr, "\%\** .....\n");
return;
}
if (b_ptr->cp_ap && /* tabling */
@ -1882,7 +1937,7 @@ void Yap_dump_stack(void) {
b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) {
/* we can safely ignore ; because there is always an upper env */
Yap_detect_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
fprintf(stderr, "%% %s (%luKB--%luKB)\n", tp,
fprintf(stderr, "\% %s (%luKB--%luKB)\n", tp,
(unsigned long int)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024),
(unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024);
}
@ -1947,7 +2002,7 @@ void DumpActiveGoals(USES_REGS1) {
op_numbers opnum;
if (!ONLOCAL(b_ptr) || b_ptr->cp_b == NULL)
break;
fprintf(stderr, "%p ", b_ptr);
fprintf(stderr, "\%p ", b_ptr);
pe = Yap_PredForChoicePt(b_ptr, &opnum);
if (opnum == _Nstop) {
fprintf(stderr, " ********** C-Code Interface Boundary ***********\n");
@ -2035,33 +2090,34 @@ void Yap_detect_bug_location(yamop *yap_pc, int where_from, int psize) {
if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity,
&pred_module)) == 0) {
/* system predicate */
fprintf(stderr, "%s", "meta-call");
fprintf(stderr, "\%s", "meta-call");
} else if (pred_module == 0) {
fprintf(stderr, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE,
(unsigned long int)pred_arity);
} else if (cl < 0) {
fprintf(stderr, "%s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE,
fprintf(stderr, "\%s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity);
} else {
fprintf(stderr, "%s:%s/%lu at clause %lu",
fprintf(stderr, "\%s:%s/%lu at clause %lu",
RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity,
(unsigned long int)cl);
}
}
static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, yamop *codeptr, PredEntry *pe) {
static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p,
yamop *codeptr, PredEntry *pe) {
CACHE_REGS
if (pe->ModuleOfPred == PROLOG_MODULE)
p->prologPredModule = AtomName(AtomProlog);
else
p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred));
if (pe->ModuleOfPred == PROLOG_MODULE)
p->prologPredModule = AtomName(AtomProlog);
else
p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred));
if (pe->ArityOfPE)
p->prologPredName = AtomName(NameOfFunctor(pe->FunctorOfPred));
else
p->prologPredName = AtomName((Atom)(pe->FunctorOfPred));
p->prologPredArity = pe->ArityOfPE;
p->prologPredFile = AtomName( pe->src.OwnerFile );
p->prologPredFile = AtomName(pe->src.OwnerFile);
p->prologPredLine = 0;
if (pe->src.OwnerFile) {
if (pe->PredFlags & MegaClausePredFlag) {
@ -2095,23 +2151,23 @@ static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, yamop
p->prologPredLine = 0;
}
}
}
else if (pe->OpcodeOfPred == UNDEF_OPCODE) {
} else if (pe->OpcodeOfPred == UNDEF_OPCODE) {
p->prologPredFile = "undefined";
}
else {
} else {
// by default, user_input
p->prologPredFile = AtomName( AtomUserIn );
p->prologPredFile = AtomName(AtomUserIn);
p->prologPredLine = 0;
}
return p;
}
yap_error_descriptor_t * Yap_pc_add_location(yap_error_descriptor_t *t, void *pc0, void *b_ptr0, void *env0) {
yap_error_descriptor_t *Yap_pc_add_location(yap_error_descriptor_t *t,
void *pc0, void *b_ptr0,
void *env0) {
CACHE_REGS
yamop *xc = pc0;
yamop *xc = pc0;
// choiceptr b_ptr = b_ptr0;
//CELL *env = env0;
// CELL *env = env0;
PredEntry *pe;
if (PP == NULL) {
@ -2122,13 +2178,15 @@ yap_error_descriptor_t * Yap_pc_add_location(yap_error_descriptor_t *t, void *pc
if (pe != NULL
// pe->ModuleOfPred != PROLOG_MODULE &&
// &&!(pe->PredFlags & HiddenPredFlag)
) {
) {
return add_bug_location(t, xc, pe);
}
return NULL;
}
yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0, void *b_ptr0, void *env0, YAP_Int ignore_first) {
yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,
void *cp0, void *b_ptr0,
void *env0, YAP_Int ignore_first) {
yamop *cp = cp0;
choiceptr b_ptr = b_ptr0;
CELL *env = env0;
@ -2139,18 +2197,18 @@ yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0
if (pe == PredTrue)
return NULL;
if (ignore_first <= 0 &&
pe
// pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) {
pe
// pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) {
return add_bug_location(t, cp, pe);
} else {
if (NULL && b_ptr && b_ptr->cp_env < env) {
cp = b_ptr->cp_cp;
env = b_ptr->cp_env;
b_ptr = b_ptr->cp_b;
cp = b_ptr->cp_cp;
env = b_ptr->cp_env;
b_ptr = b_ptr->cp_b;
} else {
cp = (yamop *)env[E_CP];
env = ENV_Parent(env);
cp = (yamop *)env[E_CP];
env = ENV_Parent(env);
}
ignore_first--;
}
@ -2158,15 +2216,10 @@ yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0
}
/*
Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) {
while (true) {
if (b_ptr == NULL || env == NULL)
return TermNil;
PredEntry *pe = EnvPreg(cp);
if (pe == PredTrue)
return TermNil;
if (ignore_first <= 0 &&
pe
Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first)
{ while (true) { if (b_ptr == NULL || env == NULL) return TermNil; PredEntry
*pe = EnvPreg(cp); if (pe == PredTrue) return TermNil; if (ignore_first <= 0
&& pe
// pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) {
return add_bug_location(cp, pe);
@ -2185,30 +2238,25 @@ yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0
}
*/
static Term mkloc(yap_error_descriptor_t *t)
{
return TermNil;
}
static Term mkloc(yap_error_descriptor_t *t) { return TermNil; }
static Int clause_location(USES_REGS1) {
yap_error_descriptor_t t;
memset( &t, 0, sizeof(yap_error_descriptor_t));
return Yap_unify(mkloc(Yap_pc_add_location(&t,P, B, ENV)), ARG1) &&
Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 1)), ARG2);
memset(&t, 0, sizeof(yap_error_descriptor_t));
return Yap_unify(mkloc(Yap_pc_add_location(&t, P, B, ENV)), ARG1) &&
Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 1)), ARG2);
}
static Int ancestor_location(USES_REGS1) {
yap_error_descriptor_t t;
memset( &t, 0, sizeof(yap_error_descriptor_t));
return
Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 2)), ARG2) &&
Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 3)), ARG2);
memset(&t, 0, sizeof(yap_error_descriptor_t));
return Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 2)), ARG2) &&
Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 3)), ARG2);
}
void Yap_InitStInfo(void) {
CACHE_REGS
Term cm = CurrentModule;
Term cm = CurrentModule;
Yap_InitCPred("in_use", 2, in_use,
HiddenPredFlag | TestPredFlag | SafePredFlag | SyncPredFlag);

2
C/stackinfo.c
View File

@ -26,7 +26,7 @@
* @brief Get to know what is in your stack.
*
*
*/
` */
#include "Yap.h"
#include "clause.h"

31
C/text.c
View File

@ -441,7 +441,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
LOCAL_ActiveError->errorRawTerm = inp->val.t;
}
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
pop_text_stack(lvl);
pop_text_stack(lvl);
return NULL;
}
@ -485,20 +485,20 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
(YAP_STRING_CODES | YAP_STRING_ATOMS)) &&
IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(lvl,
Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS) );
return pop_output_text_stack(
lvl, Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide
}
if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(lvl,
Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS));
return pop_output_text_stack(
lvl, Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide
}
if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(lvl,
Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS));
return pop_output_text_stack(
lvl, Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a buffer, and representation is wide
}
if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
@ -719,9 +719,8 @@ void *write_buffer(unsigned char *s0, seq_tv_t *out USES_REGS) {
utf8proc_int32_t chr;
int off = get_utf8(cp, -1, &chr);
if (off <= 0 || chr > 255) {
pop_text_stack(l);
pop_text_stack(l);
return NULL;
}
if (off == max)
break;
@ -786,8 +785,8 @@ static Term write_number(unsigned char *s, seq_tv_t *out,
static Term string_to_term(void *s, seq_tv_t *out USES_REGS) {
Term o;
yap_error_descriptor_t new_error;
bool mdnew = Yap_pushErrorContext(true, &new_error);
yap_error_descriptor_t *new_error = malloc(sizeof(yap_error_descriptor_t));
bool mdnew = Yap_pushErrorContext(true, new_error);
o = out->val.t = Yap_BufferToTerm(s, TermNil);
Yap_popErrorContext(mdnew, true);
@ -1008,10 +1007,10 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
void **bufv;
unsigned char *buf;
int i, j;
//int lvl = push_text_stack();
// int lvl = push_text_stack();
bufv = Malloc(tot * sizeof(unsigned char *));
if (!bufv) {
//pop_text_stack(lvl);
// pop_text_stack(lvl);
return NULL;
}
for (i = 0, j = 0; i < tot; i++) {
@ -1019,7 +1018,7 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
unsigned char *nbuf = Yap_readText(inp + i PASS_REGS);
if (!nbuf) {
//pop_text_stack(lvl);
// pop_text_stack(lvl);
return NULL;
}
// if (!nbuf[0])
@ -1035,7 +1034,7 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
buf = concat(tot, bufv PASS_REGS);
}
bool rc = write_Text(buf, out PASS_REGS);
//pop_text_stack( lvl );
// pop_text_stack( lvl );
return rc;
}
@ -1117,7 +1116,7 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
if (i > 0 && cuts[i] == 0)
break;
void *bufi = slice(next, cuts[i], buf PASS_REGS);
bufi = pop_output_text_stack(lvl, bufi);
bufi = pop_output_text_stack(lvl, bufi);
if (!write_Text(bufi, outv + i PASS_REGS)) {
return false;
}

17
C/write.c
View File

@ -748,7 +748,7 @@ static void write_var(CELL *t, struct write_globs *wglb,
wglb->Portray_delays = FALSE;
if (ext == attvars_ext) {
yhandle_t h = Yap_InitHandle((CELL)t);
yhandle_t h = Yap_InitHandle((CELL)t);
attvar_record *attv = RepAttVar(t);
CELL *l = &attv->Value; /* dirty low-level hack, check atts.h */
@ -759,8 +759,9 @@ static void write_var(CELL *t, struct write_globs *wglb,
l = restore_from_write(&nrwt, wglb);
wrputc(',', wglb->stream);
attv = RepAttVar((CELL *)Yap_GetFromHandle(h));
l = &attv->Value;;
attv = RepAttVar((CELL *)Yap_GetFromHandle(h));
l = &attv->Value;
;
l++;
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
@ -1208,10 +1209,10 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
{
CACHE_REGS
struct write_globs wglb;
struct rewind_term rwt;
yhandle_t sls = Yap_CurrentSlot();
struct rewind_term rwt;
yhandle_t sls = Yap_CurrentSlot();
int lvl = push_text_stack();
if (t == 0)
return;
if (!mywrite) {
@ -1258,13 +1259,13 @@ char *Yap_TermToBuffer(Term t, encoding_t enc, int flags) {
CACHE_REGS
int sno = Yap_open_buf_write_stream(enc, flags);
const char *sf;
if (sno < 0)
return NULL;
if (t == 0)
return NULL;
else
t = Deref(t);
t = Deref(t);
if (enc)
GLOBAL_Stream[sno].encoding = enc;
else

18
H/YapFlags.h
View File

@ -244,10 +244,10 @@ Set or read system properties for _Param_:
#define START_GLOBAL_FLAGS enum GLOBAL_FLAGS {
#define END_GLOBAL_FLAGS };
/* */
/* */
#include "YapGFlagInfo.h"
/* Local flags */
/* Local flags */
#include "YapLFlagInfo.h"
#ifndef DOXYGEN
@ -388,10 +388,20 @@ Term Yap_UnknownFlag(Term mod);
bool rmdot(Term inp);
xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n);
#define Yap_ArgListToVector(l, def, n, e) \
Yap_ArgListToVector__(__FILE__, __FUNCTION__, __LINE__, l, def, n, e)
xarg *Yap_ArgList2ToVector(Term listl, const param2_t *def, int n);
extern xarg *Yap_ArgListToVector__(const char *file, const char *function, int lineno,Term listl, const param_t *def, int n,
yap_error_number e);
#define Yap_ArgListToVector(l, def, n, e) \
Yap_ArgListToVector__(__FILE__, __FUNCTION__, __LINE__, l, def, n, e)
extern xarg *Yap_ArgList2ToVector__(const char *file, const char *function, int lineno, Term listl, const param2_t *def, int n, yap_error_number e);
#define Yap_ArgList2ToVector(l, def, n, e) \
Yap_ArgList2ToVector__(__FILE__, __FUNCTION__, __LINE__, l, def, n, e)
#endif // YAP_FLAGS_H
/// @}

3
include/YapErrors.h
View File

@ -49,6 +49,7 @@ E(DOMAIN_ERROR_ARRAY_OVERFLOW, DOMAIN_ERROR, "array_overflow")
E(DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR, "array_type")
E(DOMAIN_ERROR_CLOSE_OPTION, DOMAIN_ERROR, "close_option")
E(DOMAIN_ERROR_ENCODING, DOMAIN_ERROR, "encoding")
E(DOMAIN_ERROR_EXPAND_FILENAME_OPTION, DOMAIN_ERROR, "expand_filename")
E(DOMAIN_ERROR_FILE_ERRORS, DOMAIN_ERROR, "file_errors")
E(DOMAIN_ERROR_FILE_TYPE, DOMAIN_ERROR, "file_type")
E(DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE, DOMAIN_ERROR, "format argument "
@ -148,6 +149,8 @@ E1(SYNTAX_ERROR_NUMBER, SYNTAX_ERROR_CLASS, "syntax_error")
E(SYSTEM_ERROR_INTERNAL, SYSTEM_ERROR_CLASS, "internal")
E(SYSTEM_ERROR_COMPILER, SYSTEM_ERROR_CLASS, "compiler")
E(SYSTEM_ERROR_FATAL, SYSTEM_ERROR_CLASS, "fatal")
E(SYSTEM_ERROR_GET_FAILED, SYSTEM_ERROR_CLASS, "get_failed")
E(SYSTEM_ERROR_PUT_FAILED, SYSTEM_ERROR_CLASS, "put_failed")
E(SYSTEM_ERROR_JIT_NOT_AVAILABLE, SYSTEM_ERROR_CLASS, "jit_not_available")
E(SYSTEM_ERROR_OPERATING_SYSTEM, SYSTEM_ERROR_CLASS, "operating_system_error")
E(SYSTEM_ERROR_SAVED_STATE, SYSTEM_ERROR_CLASS, "saved_state_error")

2
include/YapStreams.h
View File

@ -213,7 +213,7 @@ typedef struct stream_desc {
// useful in memory streams
char *nbuf;
size_t nsize;
union {
struct {
struct {
#define PLGETC_BUF_SIZE 4096
unsigned char *buf, *ptr;

195
library/system.yap
View File

@ -75,56 +75,6 @@ are available through the `use_module(library(system))` command.
*/
/** @pred working_directory(- _CurDir_,? _NextDir_)
Fetch the current directory at _CurDir_. If _NextDir_ is bound
to an atom, make its value the current working directory.
*/
/** @pred delete_file(+ _File_)
The delete_file/1 procedure removes file _File_. If
_File_ is a directory, remove the directory <em>and all its subdirectories</em>.
~~~~~
?- delete_file(x).
~~~~~
*/
/** @pred delete_file(+ _File_,+ _Opts_)
The `delete_file/2` procedure removes file _File_ according to
options _Opts_. These options are `directory` if one should
remove directories, `recursive` if one should remove directories
recursively, and `ignore` if errors are not to be reported.
This example is equivalent to using the delete_file/1 predicate:
~~~~~
?- delete_file(x, [recursive]).
~~~~~
*/
/** @pred environ(? _EnvVar_,+ _EnvValue_)
Unify environment variable _EnvVar_ with its value _EnvValue_,
if there is one. This predicate is backtrackable in Unix systems, but
not currently in Win32 configurations.
~~~~~
?- environ('HOME',X).
X = 'C:\\cygwin\\home\\administrator' ?
~~~~~
*/
/** @pred file_exists(+ _File_)
@ -302,9 +252,13 @@ Interface with _tmpnam_: obtain a new, unique file name _File_.
*/
/** @pred working_directory(- _Old_,+ _New_)
/** @pred working_directory(- _CurDir_,? _NextDir_)
Unify _Old_ with an absolute path to the current working directory
Fetch the current directory at _CurDir_. If _NextDir_ is bound
to an atom, make its value the current working directory.
Unifies _Old_ with an absolute path to the current working directory
and change working directory to _New_. Use the pattern
`working_directory(CWD, CWD)` to get the current directory. See
also `absolute_file_name/2` and chdir/1.
@ -371,10 +325,37 @@ check_int(I, Inp) :-
% file operations
% file operations
/** @pred delete_file(+ _File_)
The delete_file/1 procedure removes file _File_. If
_File_ is a directory, remove the directory <em>and all its subdirectories</em>.
~~~~~
?- delete_file(x).
~~~~~
See delete_file/2 for a more flexible version.
*/
delete_file(IFile) :-
true_file_name(IFile, File),
delete_file(File, off, on, off).
/** @pred delete_file(+ _File_,+ _Opts_)
The `delete_file/2` procedure removes file _File_ according to
options _Opts_. These options are `directory` if one should
remove directories, `recursive` if one should remove directories
recursively, and `ignore` if errors are not to be reported.
This example is equivalent to using the delete_file/1 predicate:
~~~~~
?- delete_file(x, [recursive]).
~~~~~
*/
delete_file(IFile, Opts) :-
true_file_name(IFile, File),
process_delete_file_opts(Opts, Dir, Recurse, Ignore, delete_file(File,Opts)),
@ -421,7 +402,7 @@ rm_directory(File, Ignore) :-
handle_system_internal(Error, Ignore, delete_file(File)).
delete_directory(on, File, Ignore) :-
directory_files(File, FileList, Ignore),
directory_files(File, FileList),
path_separator(D),
atom_concat(File, D, FileP),
delete_dirfiles(FileList, FileP, Ignore),
@ -475,6 +456,19 @@ file_property(File, Type, Size, Date, Permissions, LinkName) :-
handle_system_internal(Error, off, file_property(File)).
/** @pred environ(? _EnvVar_,+ _EnvValue_)
Unify environment variable _EnvVar_ with its value _EnvValue_,
if there is one. This predicate is backtrackable in Unix systems, but
not currently in Win32 configurations.
~~~~~
?- environ('HOME',X).
X = 'C:\\cygwin\\home\\administrator' ?
~~~~~
*/
/** @pred environ(+E, -S)
Given an environment variable _E_ this predicate unifies the second
@ -512,16 +506,16 @@ environ_split([C|S],[C|SNa],SVal) :-
/** @pred exec(+ Command, StandardStreams, -PID)
*
*
*
*
* Execute command _Command_ with its standard streams connected to the
* list [_InputStream_, _OutputStream_, _ErrorStream_]. A numeric
* identifier to the process that executes the command is returned as
* _PID_. The command is executed by the default shell `bin/sh -c` in
* Unix.
*
*
* The following example demonstrates the use of exec/3 to send a
* command and process its output:
*
*
* ~~~~~
go :-
exec(ls,[std,pipe(S),null],P),
@ -529,12 +523,12 @@ environ_split([C|S],[C|SNa],SVal) :-
get0(S,C),
(C = -1, close(S) ! ; put(C)).
~~~~~
*
*
* The streams may be one of standard stream, `std`, null stream,
* `null`, or `pipe(S)`, where _S_ is a pipe stream. Note
* that it is up to the user to close the pipe.
*
*
*
*
*/
exec(Command, [StdIn, StdOut, StdErr], PID) :-
G = exec(Command, [StdIn, StdOut, StdErr], PID),
@ -596,7 +590,7 @@ close_temp_streams([S|Ss]) :-
* _Type_ argument may be `read` or `write`, not both. The stream should
* be closed using close/1, there is no need for a special `pclose`
* command.
*
*
* The following example demonstrates the use of popen/3 to process the
* output of a command, note that popen/3 works as a simplified interface
* to the exec/3 command:
@ -606,8 +600,8 @@ close_temp_streams([S|Ss]) :-
X = 'C:\\cygwin\\home\\administrator' ?
~~~~~
*
* The implementation of popen/3 relies on exec/3.
*
* The implementation of popen/3 relies on exec/3.
*
*/
popen(Command, read, Stream) :-
@ -686,75 +680,7 @@ get_shell(Shell, '/c') :-
get_shell('/bin/sh','-c').
system :-
default_shell(C/** @pred directory_files(+ _Dir_,+ _List_)a
Given a directory _Dir_, directory_files/2 procedures a
listing of all files and directories in the directory:
~~~~~
?- directory_files('.',L), writeq(L).
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the/** @pred directory_files(+ _Dir_,+ _List_)a
Given a directory _Dir_, directory_files/2 procedures a
listing of all files and directories in the directory:
~~~~~
?- directory_files('.',L), writeq(L).
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the/** @pred directory_files(+ _Dir_,+ _List_)a
Given a directory _Dir_, directory_files/2 procedures a
listing of all files and directories in the directory:
~~~~~
?- directory_files('.',L), writeq(L).
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the `dirent` family of routines in Unix
environments, and `findfirst` in WIN32.
*/
`dirent` family of routines in Unix
environments, and `findfirst` in WIN32.
*/
`dirent` family of routines in Unix
environments, and `findfirst` in WIN32.
*/
ommand),/** @pred directory_files(+ _Dir_,+ _List_)a
Given a directory _Dir_, directory_files/2 procedures a
listing of all files and directories in the directory:
~~~~~
?- directory_files('.',L), writeq(L).
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the/** @pred directory_files(+ _Dir_,+ _List_)a
Given a directory _Dir_, directory_files/2 procedures a
listing of all files and directories in the directory:
~~~~~
?- directory_files('.',L), writeq(L).
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the
*/
default_shell(Command),
do_system(Command, _Status, Error),
handle_system_internal(Error, off, system).
@ -851,14 +777,14 @@ rename_file(F0, F) :-
rename_file(F0, F, Error),
handle_system_internal(Error, off, rename_file(F0, F)).
/**
/**
* @pred system(+ _S_)
Passes command _S_ to the Bourne shell (on UNIX environments) or the
current command interpreter in WIN32 environments.
*/
/** @pred directory_files(+ _Dir_,+ _List_)a
/** @pred directory_files(+ _Dir_,+ _List_)
Given a directory _Dir_, directory_files/2 procedures a
@ -869,11 +795,10 @@ listing of all files and directories in the directory:
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the `dirent` family of routines in Unix
environments, and `findfirst` in WIN32.
environments, and `findfirst` in WIN32 through the system_library buil
*/
directory_files(X,Y) :=
directory_files(X,Y) :-
list_directory(X,Y).
/** @} */

12
os/files.c
View File

@ -676,7 +676,8 @@ static Int list_directory(USES_REGS1) {
const char *dp;
if ((de = AAssetManager_openDir(mgr, dirName)) == NULL) {
return (YAP_Unify(ARD3, YAP_MkIntTerm(errno)));
PlIOError(PERMISSION_ERROR_INPUT_STREAM, ARG1, "%s in list_directory",
strerror(errno));
}
while ((dp = AAssetDir_getNextFileName(de))) {
YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(dp));
@ -691,10 +692,13 @@ static Int list_directory(USES_REGS1) {
struct dirent *dp;
if ((de = opendir(buf)) == NULL) {
return (YAP_unify(ARG3, MkIntegerTerm(errno)));
PlIOError(PERMISSION_ERROR_INPUT_STREAM, ARG1, "%s in list_directory",
strerror(errno));
return false;
}
while ((dp = readdir(de))) {
Term ti = Yap_MkAtomTerm(Yap_LookupAtom(dp->d_name));
Term ti = MkAtomTerm(Yap_LookupAtom(dp->d_name));
Yap_PutInSlot(sl, MkPairTerm(ti, Yap_GetFromSlot(sl)));
}
closedir(de);
@ -796,5 +800,5 @@ void Yap_InitFiles(void) {
Yap_InitCPred("file_size", 2, file_size, SafePredFlag | SyncPredFlag);
Yap_InitCPred("file_name_extension", 3, file_name_extension,
SafePredFlag | SyncPredFlag);
YAP_InitPredt("list_directory", list_directory, 2, SyncPredFlag);
Yap_InitCPred("list_directory", 2, list_directory, SyncPredFlag);
}

5
os/fmem.c
View File

@ -191,6 +191,7 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) {
sno = GetFreeStreamD();
if (sno < 0)
return -1;
st = GLOBAL_Stream + sno;
st->status = Output_Stream_f | InMemory_Stream_f | FreeOnClose_Stream_f;
st->linepos = 0;
@ -198,7 +199,9 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) {
st->linecount = 1;
st->encoding = enc;
st->vfs = NULL;
st->buf.on = false;
st->buf.on = true;
st->nbuf = NULL;
st->nsize = 0;
#if HAVE_OPEN_MEMSTREAM
st->file = open_memstream(&st->nbuf, &st->nsize);
// setbuf(st->file, NULL);

263
os/iopreds.c
View File

@ -1227,17 +1227,120 @@ typedef enum open_enum_choices { OPEN_DEFS() } open_choices_t;
static const param_t open_defs[] = {OPEN_DEFS()};
#undef PAR
static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode, Term user_name,
encoding_t enc)
{
struct vfs *vfsp = NULL;
const char *fname;
if (IsAtomTerm(tin))
fname = RepAtom(AtomOfTerm(tin))->StrOfAE;
else if (IsStringTerm(tin))
fname = StringOfTerm(tin);
else
fname = NULL;
st->file = NULL;
if (fname) {
if ((vfsp = vfs_owner(fname)) != NULL &&
vfsp->open(vfsp, fname, io_mode, sno)) {
// read, write, append
user_name = st->user_name;
st->vfs = vfsp;
UNLOCK(st->streamlock);
} else {
st->file = fopen(fname, io_mode);
if (st->file == NULL) {
UNLOCK(st->streamlock);
if (errno == ENOENT && !strchr(io_mode, 'r')) {
PlIOError(EXISTENCE_ERROR_SOURCE_SINK, tin, "%s: %s", fname,
strerror(errno));
} else {
PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, tin, "%s: %s", fname,
strerror(errno));
}
}
st->vfs = NULL;
}
if (!st->file && !st->vfs) {
PlIOError(EXISTENCE_ERROR_SOURCE_SINK, tin, "%s", fname);
/* extract BACK info passed through the stream descriptor */
return false;
}
} else if (IsApplTerm(tin)) {
Functor f = FunctorOfTerm(tin);
if (f == FunctorAtom || f == FunctorString || f == FunctorCodes1 ||
f == FunctorCodes || f == FunctorChars1 || f == FunctorChars) {
if (strchr(io_mode, 'r')) {
return Yap_OpenBufWriteStream(PASS_REGS1);
} else {
int i = push_text_stack();
const char *buf;
buf = Yap_TextTermToText(tin PASS_REGS);
if (!buf) {
pop_text_stack(i);
return false;
}
buf = pop_output_text_stack(i, buf);
sno = Yap_open_buf_read_stream(buf, strlen(buf) + 1, &LOCAL_encoding,
MEM_BUF_MALLOC);
return Yap_OpenBufWriteStream(PASS_REGS1);
}
} else if (!strcmp(RepAtom(NameOfFunctor(f))->StrOfAE, "popen")) {
const char *buf;
int i = push_text_stack();
buf = Yap_TextTermToText(ArgOfTerm(1, tin) PASS_REGS);
if (buf == NULL) {
pop_text_stack(i);
return false;
}
#if _WIN32
st->file = _popen(buf, io_mode);
#else
st->file = popen(buf, io_mode);
#endif
fname = "popen";
user_name = tin;
st->status |= Popen_Stream_f;
pop_text_stack(i);
} else {
Yap_ThrowError(DOMAIN_ERROR_SOURCE_SINK, tin, "open");
}
}
if (!strchr(io_mode, 'b') && binary_file(fname)) {
st->status |= Binary_Stream_f;
}
Yap_initStream(sno, st->file, fname, io_mode, user_name, LOCAL_encoding,
st->status, vfsp);
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exists %s <%d>", fname,
sno);
return true;
}
static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
Atom open_mode;
int sno;
StreamDesc *st;
bool avoid_bom = false, needs_bom = false;
stream_flags_t flags;
const char *s_encoding;
encoding_t encoding;
Term tenc;
char io_mode[8];
file_name = Deref(file_name);
int sno = GetFreeStreamD();
if (sno < 0)
return (PlIOError(RESOURCE_ERROR_MAX_STREAMS, file_name,
"new stream not available for opening"));
StreamDesc *st = GLOBAL_Stream + sno;
memset(st, 0, sizeof(*st));
// user requested encoding?
// BOM mess
st->encoding = LOCAL_encoding;
if (st->encoding == ENC_UTF16_BE || st->encoding == ENC_UTF16_LE ||
st->encoding == ENC_UCS2_BE || st->encoding == ENC_UCS2_LE ||
st->encoding == ENC_ISO_UTF32_BE || st->encoding == ENC_ISO_UTF32_LE) {
st->status |= HAS_BOM_f;
}
st->user_name = Deref(file_name);
if (IsVarTerm(file_name)) {
Yap_ThrowError(INSTANTIATION_ERROR, file_name,
"while opening a list of options");
@ -1245,30 +1348,30 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
// open mode
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "open/3");
return FALSE;
return false;
}
if (!IsAtomTerm(t2)) {
if (IsStringTerm(t2)) {
open_mode = Yap_LookupAtom(StringOfTerm(t2));
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "open/3");
return (FALSE);
return false;
}
} else {
open_mode = AtomOfTerm(t2);
}
/* get options */
xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END);
/* get options */
xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END,
DOMAIN_ERROR_OPEN_OPTION);
if (args == NULL) {
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, tlist, "option handling in open/3");
}
return false;
}
/* done */
flags = 0;
st->status = 0;
const char *s_encoding;
if (args[OPEN_ENCODING].used) {
tenc = args[OPEN_ENCODING].tvalue;
s_encoding = RepAtom(AtomOfTerm(tenc))->StrOfAE;
@ -1276,7 +1379,7 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
s_encoding = "default";
}
// default encoding, no bom yet
encoding = enc_id(s_encoding, ENC_OCTET);
st->encoding = enc_id(s_encoding, ENC_OCTET);
// only set encoding after getting BOM
char const *fname0;
bool ok = (args[OPEN_EXPAND_FILENAME].used
@ -1315,8 +1418,8 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
#ifdef _WIN32
strncat(io_mode, "b", 8);
#endif
flags |= Binary_Stream_f;
encoding = ENC_OCTET;
st->status |= Binary_Stream_f;
st->encoding = ENC_OCTET;
avoid_bom = true;
needs_bom = false;
} else if (t == TermText) {
@ -1329,19 +1432,14 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
"type is ~a, must be one of binary or text", t);
}
}
if ((sno = Yap_OpenStream(file_name, io_mode, file_name, encoding)) < 0) {
st = &GLOBAL_Stream[sno];
if (!fill_stream(sno, st, file_name,io_mode,st->user_name,st->encoding)) {
return false;
}
st = &GLOBAL_Stream[sno];
// user requested encoding?
// BOM mess
if (encoding == ENC_UTF16_BE || encoding == ENC_UTF16_LE ||
encoding == ENC_UCS2_BE || encoding == ENC_UCS2_LE ||
encoding == ENC_ISO_UTF32_BE || encoding == ENC_ISO_UTF32_LE) {
needs_bom = true;
}
if (args[OPEN_BOM].used) {
if (args[OPEN_BOM].used) {
if (args[OPEN_BOM].tvalue == TermTrue) {
avoid_bom = false;
needs_bom = true;
@ -1361,24 +1459,26 @@ static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
}
}
if (st - GLOBAL_Stream < 3) {
flags |= RepError_Prolog_f;
st->status |= RepError_Prolog_f;
}
#if MAC
if (open_mode == AtomWrite) {
Yap_SetTextFile(RepAtom(AtomOfTerm(file_name))->StrOfAE);
}
#endif
// interactive streams do not have a start, so they probably don't have
// a BOM
avoid_bom = avoid_bom || (st->status & Tty_Stream_f);
// __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "open %s", fname);
if (needs_bom && !write_bom(sno, st)) {
return false;
} else if (open_mode == AtomRead && !avoid_bom) {
check_bom(sno, st); // can change encoding
// follow declaration unless there is v
if (st->status & HAS_BOM_f) {
st->encoding = enc_id(s_encoding, st->encoding);
}
}
// follow declaration unless there is v
if (st->status & HAS_BOM_f) {
st->encoding = enc_id(s_encoding, st->encoding);
} else
st->encoding = encoding;
Yap_DefaultStreamOps(st);
if (script) {
open_header(sno, open_mode);
@ -1558,9 +1658,6 @@ int Yap_OpenStream(Term tin, const char *io_mode, Term user_name,
CACHE_REGS
int sno;
StreamDesc *st;
struct vfs *vfsp = NULL;
int flags;
const char *fname;
sno = GetFreeStreamD();
if (sno < 0) {
@ -1570,90 +1667,11 @@ int Yap_OpenStream(Term tin, const char *io_mode, Term user_name,
}
st = GLOBAL_Stream + sno;
// fname = Yap_VF(fname);
flags = 0;
if (IsAtomTerm(tin))
fname = RepAtom(AtomOfTerm(tin))->StrOfAE;
else if (IsStringTerm(tin))
fname = StringOfTerm(tin);
else
fname = NULL;
st->file = NULL;
if (fname) {
if ((vfsp = vfs_owner(fname)) != NULL &&
vfsp->open(vfsp, fname, io_mode, sno)) {
// read, write, append
user_name = st->user_name;
st->vfs = vfsp;
UNLOCK(st->streamlock);
} else {
st->file = fopen(fname, io_mode);
if (st->file == NULL) {
UNLOCK(st->streamlock);
if (errno == ENOENT && !strchr(io_mode, 'r')) {
PlIOError(EXISTENCE_ERROR_SOURCE_SINK, tin, "%s: %s", fname,
strerror(errno));
} else {
PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, tin, "%s: %s", fname,
strerror(errno));
}
}
st->vfs = NULL;
}
if (!st->file && !st->vfs) {
PlIOError(EXISTENCE_ERROR_SOURCE_SINK, tin, "%s", fname);
/* extract BACK info passed through the stream descriptor */
return -1;
}
} else if (IsApplTerm(tin)) {
Functor f = FunctorOfTerm(tin);
if (f == FunctorAtom || f == FunctorString || f == FunctorCodes1 ||
f == FunctorCodes || f == FunctorChars1 || f == FunctorChars) {
if (strchr(io_mode, 'r')) {
return Yap_OpenBufWriteStream(PASS_REGS1);
} else {
int i = push_text_stack();
const char *buf;
buf = Yap_TextTermToText(tin PASS_REGS);
if (!buf) {
pop_text_stack(i);
return false;
}
buf = pop_output_text_stack(i, buf);
sno = Yap_open_buf_read_stream(buf, strlen(buf) + 1, &LOCAL_encoding,
MEM_BUF_MALLOC);
return Yap_OpenBufWriteStream(PASS_REGS1);
}
} else if (!strcmp(RepAtom(NameOfFunctor(f))->StrOfAE, "popen")) {
const char *buf;
int i = push_text_stack();
buf = Yap_TextTermToText(ArgOfTerm(1, tin) PASS_REGS);
if (buf == NULL) {
pop_text_stack(i);
return -1;
}
#if _WIN32
st->file = _popen(buf, io_mode);
#else
st->file = popen(buf, io_mode);
#endif
fname = "popen";
user_name = tin;
flags |= Popen_Stream_f;
pop_text_stack(i);
} else {
Yap_ThrowError(DOMAIN_ERROR_SOURCE_SINK, tin, "open");
}
}
if (!strchr(io_mode, 'b') && binary_file(fname)) {
flags |= Binary_Stream_f;
}
Yap_initStream(sno, st->file, fname, io_mode, user_name, LOCAL_encoding,
flags, vfsp);
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exists %s <%d>", fname,
sno);
return sno;
if (fill_stream(sno, st, tin,io_mode,user_name,enc))
return sno;
return -1;
}
int Yap_FileStream(FILE *fd, char *name, Term file_name, int flags,
@ -1905,12 +1923,10 @@ static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
UNLOCK(GLOBAL_Stream[sno].streamlock);
return TRUE;
}
xarg *args =
Yap_ArgListToVector((tlist = Deref(ARG2)), close_defs, CLOSE_END);
xarg *args = Yap_ArgListToVector((tlist = Deref(ARG2)), close_defs, CLOSE_END,
DOMAIN_ERROR_CLOSE_OPTION);
if (args == NULL) {
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, tlist, NULL);
}
return false;
@ -1967,11 +1983,10 @@ static Int abs_file_parameters(USES_REGS1) {
Term tlist = Deref(ARG1), tf;
/* get options */
xarg *args = Yap_ArgListToVector(tlist, absolute_file_name_search_defs,
ABSOLUTE_FILE_NAME_END);
ABSOLUTE_FILE_NAME_END,
DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION);
if (args == NULL) {
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, tlist, NULL);
}
return false;

94
os/readterm.c
View File

@ -209,8 +209,14 @@ static const param_t read_defs[] = {READ_DEFS()};
static Term add_output(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomOutput, 1), 1);
tail = Deref(tail);
if (IsVarTerm(tail)) {
Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
}
Yap_unify(t, ArgOfTerm(1, topt));
if (IsPairTerm(tail) || tail == TermNil) {
if (IsVarTerm(tail)) {
Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
} else if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
@ -220,7 +226,9 @@ static Term add_output(Term t, Term tail) {
static Term add_names(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
if (IsPairTerm(tail) || tail == TermNil) {
if (IsVarTerm(tail)) {
Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
} else if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
@ -230,7 +238,9 @@ static Term add_names(Term t, Term tail) {
static Term add_priority(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
if (IsPairTerm(tail) || tail == TermNil) {
if (IsVarTerm(tail)) {
Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
} else if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
@ -342,11 +352,11 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos) {
if (!LOCAL_ErrorMessage) {
LOCAL_ErrorMessage = "syntax error";
}
tm = MkStringTerm(LOCAL_ErrorMessage);
tm = MkStringTerm(LOCAL_ErrorMessage);
{
char *s = malloc( strlen(LOCAL_ErrorMessage)+1);
strcpy(s,LOCAL_ErrorMessage );
Yap_local.ActiveError->errorMsg = s;
char *s = malloc(strlen(LOCAL_ErrorMessage) + 1);
strcpy(s, LOCAL_ErrorMessage);
Yap_local.ActiveError->errorMsg = s;
}
if (GLOBAL_Stream[sno].status & Seekable_Stream_f) {
if (errpos && newpos >= 0) {
@ -469,10 +479,9 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
LOCAL_VarTable = NULL;
LOCAL_AnonVarTable = NULL;
fe->enc = GLOBAL_Stream[inp_stream].encoding;
xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END);
xarg *args =
Yap_ArgListToVector(opts, read_defs, READ_END, DOMAIN_ERROR_READ_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
return NULL;
}
@ -541,9 +550,9 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
if (args[READ_PRIORITY].used) {
re->prio = IntegerOfTerm(args[READ_PRIORITY].tvalue);
if (re->prio > GLOBAL_MaxPriority) {
Yap_Error(DOMAIN_ERROR_OPERATOR_PRIORITY, opts,
"max priority in Prolog is %d, not %ld", GLOBAL_MaxPriority,
re->prio);
Yap_ThrowError(DOMAIN_ERROR_OPERATOR_PRIORITY, opts,
"max priority in Prolog is %d, not %ld",
GLOBAL_MaxPriority, re->prio);
}
} else {
re->prio = LOCAL_default_priority;
@ -998,10 +1007,9 @@ Term Yap_read_term(int sno, Term opts, bool clause) {
int emacs_cares = FALSE;
#endif
yap_error_descriptor_t new;
yap_error_descriptor_t *new = malloc(sizeof *new);
bool err = Yap_pushErrorContext(true,&new);
bool err = Yap_pushErrorContext(true, new);
int lvl = push_text_stack();
parser_state_t state = YAP_START_PARSING;
while (true) {
@ -1010,8 +1018,8 @@ Term Yap_read_term(int sno, Term opts, bool clause) {
state = initParser(opts, &fe, &re, sno, clause);
if (state == YAP_PARSING_FINISHED) {
pop_text_stack(lvl);
Yap_popErrorContext(err, true);
return 0;
Yap_popErrorContext(err, true);
return 0;
}
break;
case YAP_SCANNING:
@ -1050,7 +1058,7 @@ Term Yap_read_term(int sno, Term opts, bool clause) {
}
}
}
Yap_popErrorContext(err,true);
Yap_popErrorContext(err, true);
pop_text_stack(lvl);
return 0;
}
@ -1104,10 +1112,9 @@ static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()};
static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, int sno) {
CACHE_REGS
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END);
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END,
DOMAIN_ERROR_READ_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
return NULL;
}
if (args[READ_CLAUSE_OUTPUT].used) {
@ -1387,32 +1394,33 @@ static Int style_checker(USES_REGS1) {
return TRUE;
}
Term Yap_BufferToTerm(const char *s, Term opts) {
Term rval;
int sno;
encoding_t l = ENC_ISO_UTF8;
sno = Yap_open_buf_read_stream((char *)s, strlen((const char *)s), &l,
MEM_BUF_USER);
Term Yap_BufferToTerm(const char *s, Term opts) {
Term rval;
int sno;
encoding_t l = ENC_ISO_UTF8;
sno = Yap_open_buf_read_stream((char *)s, strlen((const char *)s), &l,
MEM_BUF_USER);
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
rval = Yap_read_term(sno, opts, false);
Yap_CloseStream(sno);
return rval;
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
rval = Yap_read_term(sno, opts, false);
Yap_CloseStream(sno);
return rval;
}
Term Yap_UBufferToTerm(const unsigned char *s, Term opts) {
Term rval;
int sno;
encoding_t l = ENC_ISO_UTF8;
sno = Yap_open_buf_read_stream((char *)s, strlen((const char *)s), &l,
MEM_BUF_USER);
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
rval = Yap_read_term(sno, opts, false);
Yap_CloseStream(sno);
return rval;
Term Yap_UBufferToTerm(const unsigned char *s, Term opts) {
Term rval;
int sno;
encoding_t l = ENC_ISO_UTF8;
sno = Yap_open_buf_read_stream((char *)s, strlen((const char *)s), &l,
MEM_BUF_USER);
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
rval = Yap_read_term(sno, opts, false);
Yap_CloseStream(sno);
return rval;
}
X_API Term Yap_BufferToTermWithPrioBindings(const char *s, Term opts, Term bindings, size_t len,
X_API Term Yap_BufferToTermWithPrioBindings(const char *s, Term opts,
Term bindings, size_t len,
int prio) {
CACHE_REGS
Term ctl;

196
os/streams.c
View File

@ -1,26 +1,24 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: iopreds.c *
* Last rev: 5/2/88 *
* mods: *
* comments: Input/Output C implemented predicates *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: iopreds.c * Last rev: 5/2/88
** mods: * comments: Input/Output C implemented predicates *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
/**
*
* This file includes the definition of a miscellania of standard predicates
* for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
*
@ -31,10 +29,10 @@ static char SccsId[] = "%W% %G%";
/* for O_BINARY and O_TEXT in WIN32 */
#include <fcntl.h>
#endif
#include "YapEval.h"
#include "YapHeap.h"
#include "YapText.h"
#include "Yatom.h"
#include "YapEval.h"
#include "yapio.h"
#include <stdlib.h>
#if HAVE_STDARG_H
@ -144,7 +142,7 @@ int GetFreeStreamD(void) {
return -1;
}
LOCK(GLOBAL_Stream[sno].streamlock);
GLOBAL_Stream[sno].status &= ~Free_Stream_f;
GLOBAL_Stream[sno].status &= ~Free_Stream_f;
UNLOCK(GLOBAL_StreamDescLock);
GLOBAL_Stream[sno].encoding = LOCAL_encoding;
return sno;
@ -155,45 +153,41 @@ int Yap_GetFreeStreamD(void) { return GetFreeStreamD(); }
/**
*
*/
bool Yap_clearInput(int sno)
{
if (!(GLOBAL_Stream[sno].status & Tty_Stream_f) || sno < 3)
return true;
if (GLOBAL_Stream[sno].vfs) {
GLOBAL_Stream[sno].vfs->flush(sno);
return true;
}
bool Yap_clearInput(int sno) {
if (!(GLOBAL_Stream[sno].status & Tty_Stream_f) || sno < 3)
return true;
if (GLOBAL_Stream[sno].vfs) {
GLOBAL_Stream[sno].vfs->flush(sno);
return true;
}
#if USE_READLINE
if (GLOBAL_Stream[sno].status & Readline_Stream_f)
return Yap_readline_clear_pending_input (GLOBAL_Stream+sno);
if (GLOBAL_Stream[sno].status & Readline_Stream_f)
return Yap_readline_clear_pending_input(GLOBAL_Stream + sno);
#endif
#if HAVE_FPURGE
fflush(NULL);
return fpurge( GLOBAL_Stream[sno].file ) == 0;
fflush(NULL);
return fpurge(GLOBAL_Stream[sno].file) == 0;
#elif HAVE_TCFLUSH
return tcflush(fileno(GLOBAL_Stream[sno].file), TCIOFLUSH) == 0;
#elif MSC_VER
return fflush(GLOBAL_Stream[sno].file) == 0;
#endif
return false;
}
bool Yap_flush(int sno)
{
if (!(GLOBAL_Stream[sno].status & Tty_Stream_f))
return true;
if (GLOBAL_Stream[sno].vfs) {
GLOBAL_Stream[sno].vfs->flush(sno);
return true;
}
return fflush(GLOBAL_Stream[sno].file) == 0;
}
static Int clear_input( USES_REGS1 )
{
int sno = Yap_CheckStream(ARG1, Input_Stream_f | Socket_Stream_f,
"clear_input/1");
bool Yap_flush(int sno) {
if (!(GLOBAL_Stream[sno].status & Tty_Stream_f))
return true;
if (GLOBAL_Stream[sno].vfs) {
GLOBAL_Stream[sno].vfs->flush(sno);
return true;
}
return fflush(GLOBAL_Stream[sno].file) == 0;
}
static Int clear_input(USES_REGS1) {
int sno =
Yap_CheckStream(ARG1, Input_Stream_f | Socket_Stream_f, "clear_input/1");
if (sno != -1)
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_clearInput(sno);
@ -251,8 +245,9 @@ static Int p_check_stream(USES_REGS1) { /* '$check_stream'(Stream,Mode) */
}
static Int p_check_if_stream(USES_REGS1) { /* '$check_stream'(Stream) */
int sno = Yap_CheckStream(ARG1, Input_Stream_f | Output_Stream_f |
Append_Stream_f | Socket_Stream_f,
int sno = Yap_CheckStream(ARG1,
Input_Stream_f | Output_Stream_f | Append_Stream_f |
Socket_Stream_f,
"check_stream/1");
if (sno != -1)
UNLOCK(GLOBAL_Stream[sno].streamlock);
@ -300,21 +295,18 @@ has_reposition(int sno,
}
}
bool Yap_SetCurInpPos(int sno, Int pos
USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
bool Yap_SetCurInpPos(
int sno, Int pos USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
if (GLOBAL_Stream[sno].vfs) {
if (GLOBAL_Stream[sno].vfs->seek && GLOBAL_Stream[sno].vfs->seek(sno, 0L, SEEK_END) == -1) {
if (GLOBAL_Stream[sno].vfs->seek &&
GLOBAL_Stream[sno].vfs->seek(sno, 0L, SEEK_END) == -1) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(SYSTEM_ERROR_INTERNAL, pos,
"fseek failed for set_stream_position/2: %s", strerror(errno));
return (FALSE);
}
} else if (fseek(GLOBAL_Stream[sno].file, pos, SEEK_SET) == -1) {
} else if (fseek(GLOBAL_Stream[sno].file, pos, SEEK_SET) == -1) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(SYSTEM_ERROR_INTERNAL, MkIntegerTerm(0),
"fseek failed for set_stream_position/2: %s", strerror(errno));
@ -339,19 +331,20 @@ char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) {
}
#if __linux__
char *path= malloc(1024);
if (snprintf(path, 1023, "/proc/self/fd/%d", f) && readlink(path, nameb, maxs)) {
free(path);
return nameb;
char *path = malloc(1024);
if (snprintf(path, 1023, "/proc/self/fd/%d", f) &&
readlink(path, nameb, maxs)) {
free(path);
return nameb;
}
#elif __APPLE__
if (fcntl(f, F_GETPATH, nameb) != -1) {
return nameb;
}
#else
TCHAR path= malloc(MAX_PATH + 1);
TCHAR path = malloc(MAX_PATH + 1);
if (!GetFullPathName(path, MAX_PATH, path, NULL)) {
free(path);
free(path);
return NULL;
} else {
int i;
@ -362,7 +355,7 @@ char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) {
free(path);
return nameb;
}
free(path);
free(path);
#endif
if (!StreamName(sno)) {
return NULL;
@ -443,9 +436,7 @@ found_eof(int sno,
return Yap_unify(t2, MkAtomTerm(AtomAltNot));
}
static bool
stream_mode(int sno,
Term t2 USES_REGS) {
static bool stream_mode(int sno, Term t2 USES_REGS) {
/* '$set_output'(+Stream,-ErrorMessage) */
stream_flags_t flags = GLOBAL_Stream[sno].status;
if (!IsVarTerm(t2) && !(isatom(t2))) {
@ -455,9 +446,9 @@ stream_mode(int sno,
return Yap_unify(t2, TermRead);
if (flags & Append_Stream_f)
return Yap_unify(t2, TermWrite);
if (flags & Output_Stream_f)
if (flags & Output_Stream_f)
return Yap_unify(t2, TermWrite);
return false;
return false;
}
static bool
@ -687,7 +678,8 @@ static xarg *generate_property(int sno, Term t2,
Functor f = Yap_MkFunctor(Yap_LookupAtom(stream_property_defs[p].name), 1);
Yap_unify(t2, Yap_MkNewApplTerm(f, 1));
}
return Yap_ArgListToVector(t2, stream_property_defs, STREAM_PROPERTY_END);
return Yap_ArgListToVector(t2, stream_property_defs, STREAM_PROPERTY_END,
DOMAIN_ERROR_STREAM_PROPERTY_OPTION);
}
static Int cont_stream_property(USES_REGS1) { /* current_stream */
@ -706,7 +698,8 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
EXTRA_CBACK_ARG(2, 2) = MkIntTerm(p % STREAM_PROPERTY_END);
// otherwise, just drop through
} else {
args = Yap_ArgListToVector(t2, stream_property_defs, STREAM_PROPERTY_END);
args = Yap_ArgListToVector(t2, stream_property_defs, STREAM_PROPERTY_END,
DOMAIN_ERROR_STREAM_PROPERTY_OPTION);
}
if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
@ -790,7 +783,8 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */
return cont_stream_property(PASS_REGS1);
}
args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs,
STREAM_PROPERTY_END);
STREAM_PROPERTY_END,
DOMAIN_ERROR_STREAM_PROPERTY_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
@ -850,7 +844,8 @@ static bool do_set_stream(int sno,
set_stream_enum_choices_t i;
bool rc = true;
args = Yap_ArgListToVector(opts, set_stream_defs, SET_STREAM_END);
args = Yap_ArgListToVector(opts, set_stream_defs, SET_STREAM_END,
DOMAIN_ERROR_SET_STREAM_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
@ -999,19 +994,20 @@ void Yap_CloseTemporaryStreams(void) {
static void CloseStream(int sno) {
CACHE_REGS
//fflush(NULL);
// fflush(NULL);
VFS_t *me;
if ((me = GLOBAL_Stream[sno].vfs) != NULL && GLOBAL_Stream[sno].file == NULL) {
if (me->close) {
me->close(sno);
}
if ((me = GLOBAL_Stream[sno].vfs) != NULL &&
GLOBAL_Stream[sno].file == NULL) {
if (me->close) {
me->close(sno);
}
GLOBAL_Stream[sno].vfs = NULL;
} else if (GLOBAL_Stream[sno].file &&
(GLOBAL_Stream[sno].status &Popen_Stream_f)) {
(GLOBAL_Stream[sno].status & Popen_Stream_f)) {
pclose(GLOBAL_Stream[sno].file);
} else if (GLOBAL_Stream[sno].file &&
!(GLOBAL_Stream[sno].status &
(Null_Stream_f | Socket_Stream_f | InMemory_Stream_f | Pipe_Stream_f)))
!(GLOBAL_Stream[sno].status & (Null_Stream_f | Socket_Stream_f |
InMemory_Stream_f | Pipe_Stream_f)))
fclose(GLOBAL_Stream[sno].file);
#if HAVE_SOCKET
else if (GLOBAL_Stream[sno].status & (Socket_Stream_f)) {
@ -1025,7 +1021,7 @@ static void CloseStream(int sno) {
} else if (GLOBAL_Stream[sno].status & (InMemory_Stream_f)) {
Yap_CloseMemoryStream(sno);
}
if (LOCAL_c_input_stream == sno) {
if (LOCAL_c_input_stream == sno) {
LOCAL_c_input_stream = StdInStream;
}
if (LOCAL_c_output_stream == sno) {
@ -1034,7 +1030,7 @@ static void CloseStream(int sno) {
if (LOCAL_c_error_stream == sno) {
LOCAL_c_error_stream = StdErrStream;
}
Yap_DeleteAliases(sno);
Yap_DeleteAliases(sno);
GLOBAL_Stream[sno].vfs = NULL;
GLOBAL_Stream[sno].file = NULL;
GLOBAL_Stream[sno].status = Free_Stream_f;
@ -1051,8 +1047,8 @@ void Yap_ReleaseStream(int sno) {
CACHE_REGS
GLOBAL_Stream[sno].status = Free_Stream_f;
GLOBAL_Stream[sno].user_name = 0;
GLOBAL_Stream[sno].vfs = NULL;
GLOBAL_Stream[sno].vfs = NULL;
GLOBAL_Stream[sno].file = NULL;
Yap_DeleteAliases(sno);
if (LOCAL_c_input_stream == sno) {
@ -1085,8 +1081,7 @@ static Int current_input(USES_REGS1) { /* current_input(?Stream) */
}
}
bool Yap_SetInputStream( Term sd )
{
bool Yap_SetInputStream(Term sd) {
int sno = Yap_CheckStream(sd, Input_Stream_f, "set_input/1");
if (sno < 0)
return false;
@ -1096,7 +1091,6 @@ bool Yap_SetInputStream( Term sd )
return true;
}
/** @pred set_input(+ _S_) is iso
* Set stream _S_ as the current input stream. Predicates like read/1
* and get/1 will start using stream _S_ by default.
@ -1106,7 +1100,7 @@ bool Yap_SetInputStream( Term sd )
*
*/
static Int set_input(USES_REGS1) { /* '$show_stream_position'(+Stream,Pos) */
return Yap_SetInputStream( ARG1 );
return Yap_SetInputStream(ARG1);
}
static Int current_output(USES_REGS1) { /* current_output(?Stream) */
@ -1124,8 +1118,7 @@ static Int current_output(USES_REGS1) { /* current_output(?Stream) */
}
}
bool Yap_SetOutputStream( Term sd )
{
bool Yap_SetOutputStream(Term sd) {
int sno =
Yap_CheckStream(sd, Output_Stream_f | Append_Stream_f, "set_output/2");
if (sno < 0)
@ -1135,8 +1128,7 @@ bool Yap_SetOutputStream( Term sd )
return true;
}
bool Yap_SetErrorStream( Term sd )
{
bool Yap_SetErrorStream(Term sd) {
int sno =
Yap_CheckStream(sd, Output_Stream_f | Append_Stream_f, "set_error/2");
if (sno < 0)
@ -1156,11 +1148,9 @@ bool Yap_SetErrorStream( Term sd )
*
*/
static Int set_output(USES_REGS1) { /* '$show_stream_position'(+Stream,Pos) */
return Yap_SetOutputStream( ARG1);
return Yap_SetOutputStream(ARG1);
}
static Int p_user_file_name(USES_REGS1) {
Term tout;
int sno =
@ -1362,14 +1352,16 @@ static Int
"set_stream_position/2");
return (FALSE);
}
if(GLOBAL_Stream[sno].vfs) {
if (GLOBAL_Stream[sno].vfs->seek && GLOBAL_Stream[sno].vfs->seek(sno, 0L, SEEK_END) == -1) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(SYSTEM_ERROR_INTERNAL, tp,
"fseek failed for set_stream_position/2: %s", strerror(errno));
return (FALSE);
if (GLOBAL_Stream[sno].vfs) {
if (GLOBAL_Stream[sno].vfs->seek &&
GLOBAL_Stream[sno].vfs->seek(sno, 0L, SEEK_END) == -1) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(SYSTEM_ERROR_INTERNAL, tp,
"fseek failed for set_stream_position/2: %s",
strerror(errno));
return (FALSE);
}
} else if (fseek(GLOBAL_Stream[sno].file, 0L, SEEK_END) == -1) {
} else if (fseek(GLOBAL_Stream[sno].file, 0L, SEEK_END) == -1) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(SYSTEM_ERROR_INTERNAL, tp,
"fseek failed for set_stream_position/2: %s", strerror(errno));

6
os/sysbits.c
View File

@ -814,7 +814,9 @@ static Term do_expand_file_name(Term t1, Term opts USES_REGS) {
spec = rc;
#endif
args = Yap_ArgListToVector(opts, expand_filename_defs, EXPAND_FILENAME_END);
args = Yap_ArgListToVector(
opts, expand_filename_defs,
EXPAND_FILENAME_END,DOMAIN_ERROR_EXPAND_FILENAME_OPTION);
if (args == NULL) {
return TermNil;
}
@ -1122,7 +1124,7 @@ int Yap_volume_header(char *file) { return volume_header(file); }
const char *Yap_getcwd(char *cwd, size_t cwdlen) {
if (GLOBAL_cwd && GLOBAL_cwd[0]) {
strcpy(cwd, GLOBAL_cwd);
strcpy(cwd, GLOBAL_cwd);
return cwd;
}
#if _WIN32 || defined(__MINGW32__)

57
os/writeterm.c
View File

@ -291,16 +291,14 @@ end:
*
*/
bool Yap_WriteTerm(int output_stream, Term t, Term opts USES_REGS) {
xarg *args = Yap_ArgListToVector(opts, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector(opts, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
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, opts, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, t, args PASS_REGS);
@ -337,10 +335,9 @@ static Int write2(USES_REGS1) {
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0)
return false;
args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
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, TermNil, NULL);
return false;
@ -363,10 +360,9 @@ static Int write1(USES_REGS1) {
int output_stream = LOCAL_c_output_stream;
if (output_stream == -1)
output_stream = 1;
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
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, TermNil, NULL);
return false;
@ -390,10 +386,9 @@ static Int write_canonical1(USES_REGS1) {
int output_stream = LOCAL_c_output_stream;
if (output_stream == -1)
output_stream = 1;
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
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, TermNil, NULL);
return false;
@ -416,10 +411,9 @@ static Int write_canonical(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
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, TermNil, NULL);
return false;
@ -446,10 +440,9 @@ static Int writeq1(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
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, TermNil, NULL);
return false;
@ -476,10 +469,9 @@ static Int writeq(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
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, TermNil, NULL);
return false;
@ -506,10 +498,9 @@ static Int print1(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
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, TermNil, NULL);
return false;
@ -537,10 +528,9 @@ static Int print(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
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, TermNil, NULL);
return false;
@ -570,7 +560,8 @@ static Int writeln1(USES_REGS1) {
int output_stream = LOCAL_c_output_stream;
if (output_stream == -1)
output_stream = 1;
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
@ -594,14 +585,15 @@ static Int writeln(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END,
DOMAIN_ERROR_WRITE_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false;
}
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "writeln/2");
fprintf(stderr,"writeln %d\n", output_stream);
fprintf(stderr, "writeln %d\n", output_stream);
if (output_stream < 0) {
free(args);
return false;
@ -680,8 +672,7 @@ static Int term_to_string(USES_REGS1) {
Term t2 = Deref(ARG2), rc = false, t1 = Deref(ARG1);
const char *s;
if (IsVarTerm(t2)) {
s = Yap_TermToBuffer(ARG1, LOCAL_encoding,
Quote_illegal_f | Handle_vars_f);
s = Yap_TermToBuffer(ARG1, LOCAL_encoding, Quote_illegal_f | Handle_vars_f);
if (!s || !MkStringTerm(s)) {
Yap_Error(RESOURCE_ERROR_HEAP, t1,
"Could not get memory from the operating system");

43
packages/python/pyio.c
View File

@ -8,7 +8,6 @@
YAP_Term TermErrStream, TermOutStream;
static unsigned char *outbuf, *errbuf;
static void pyflush(StreamDesc *st) {
#if 0
@ -76,7 +75,12 @@ static void *py_open(VFS_t *me, const char *name, const char *io_mode,
}
StreamDesc *st = YAP_RepStreamFromId(sno);
st->name = YAP_LookupAtom(name);
/* if (strcmp(name, "sys.stdout") == 0) {
if (strcmp(name, "sys.stdout") == 0 ||
strcmp(name, "sys.stderr") == 0 ||
strcmp(name, "input") == 0) {
st->status |= Tty_Stream_f;
}
/*
if (!outbuf)
outbuf = ( unsigned char *)malloc(1024);
st->u.w_irl.ptr = st->u.w_irl.buf = outbuf;
@ -125,9 +129,8 @@ static bool py_close(int sno) {
return true;
}
static bool getLine(int inp) {
static bool getLine(StreamDesc *rl_iostream, int sno) {
char *myrl_line = NULL;
StreamDesc *rl_instream = YAP_RepStreamFromId(inp);
term_t ctk = python_acquire_GIL();
Py_ssize_t size;
PyObject *prompt = PyUnicode_FromString("?- "),
@ -137,9 +140,16 @@ static bool getLine(int inp) {
myrl_line = PyUnicode_AsUTF8AndSize(
PyObject_CallFunctionObjArgs(o, msg, prompt, NULL), &size);
python_release_GIL(ctk);
rl_instream->u.irl.ptr = rl_instream->u.irl.buf =
PyObject *err;
if ((err = PyErr_Occurred())) {
PyErr_SetString(
err,
"Error in getLine\n");
Yap_ThrowError(SYSTEM_ERROR_GET_FAILED, YAP_MkIntTerm(sno), err);
}
rl_iostream->u.irl.ptr = rl_iostream->u.irl.buf =
(const unsigned char *)malloc(size);
memcpy((void *)rl_instream->u.irl.buf, myrl_line, size);
memcpy((void *)rl_iostream->u.irl.buf, myrl_line, size);
return true;
}
@ -148,16 +158,17 @@ static int py_getc(int sno) {
int ch;
bool fetch = (s->u.irl.buf == NULL);
if (!fetch || getLine(sno)) {
const unsigned char *ttyptr = s->u.irl.ptr++, *myrl_line = s->u.irl.buf;
ch = *ttyptr;
if (ch == '\0') {
ch = '\n';
free((void *)myrl_line);
s->u.irl.ptr = s->u.irl.buf = NULL;
if (fetch) {
if (!getLine(s, sno)) {
return EOF;
}
} else {
return EOF;
}
const unsigned char *ttyptr = s->u.irl.ptr++, *myrl_line = s->u.irl.buf;
ch = *ttyptr;
if (ch == '\0') {
ch = '\n';
free((void *)myrl_line);
s->u.irl.ptr = s->u.irl.buf = NULL;
}
return ch;
}
@ -182,7 +193,7 @@ static int py_peek(int sno) {
}
return ch;
}
if (getLine(sno)) {
if (getLine(s, sno)) {
ch = s->u.irl.ptr[0];
if (ch == '\0') {
ch = '\n';

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

@ -540,12 +540,12 @@ class YAPRun:
program,squery,stop,howmany = self.prolog_cell(s)
found = False
# sys.settrace(tracefunc)
if self.query and self.os == squery:
if self.query and self.os == program+squery:
howmany += self.iterations
else:
if self.query:
self.query.close()
self.os = squery
self.os = program+squery
self.iterations = 0
self.bindings = []
pg = jupyter_query( self, program, squery)

2
pl/listing.yap
View File

@ -40,8 +40,6 @@
*/
:- use_system_module( '$_errors', ['$do_error'/2]).
'$current_predicate'/4]).
/** @brief listing : Listing clauses in the database
*

34
pl/messages.yap
View File

@ -268,6 +268,28 @@ location( error(_,Info), Level, LC ) -->
!,
display_consulting( File, Level, LC ),
[ '~s:~d:0 ~a in ~s:~s/~d:'-[File, FilePos,Level,M,Na,Ar] ].
location( error(_,Info), Level, LC ) -->
{ '$error_descriptor'(Info, Desc) },
{
'$query_exception'(prologPredFile, Desc, File),
'$query_exception'(prologPredLine, Desc, FilePos),
'$query_exception'(prologPredModule, Desc, M),
'$query_exception'(prologPredName, Desc, Na),
'$query_exception'(prologPredArity, Desc, Ar)
},
!,
display_consulting( File, Level, Info, LC ),
[ '~s:~d:0 ~a in ~s:~s/~d:'-[File, FilePos,Level,M,Na,Ar] ].
location( error(_,Info), Level, LC ) -->
{ '$error_descriptor'(Info, Desc) },
{
'$query_exception'(errorFile, Desc, File),
'$query_exception'(errorLine, Desc, FilePos),
'$query_exception'(errorFunction, Desc, F)
},
!,
display_consulting( File, Level, Info, LC ),
[ '~s:~d:0 ~a in ~s():'-[File, FilePos,Level,F] ].
location( _Ball, _Level, _LC ) --> [].
@ -329,13 +351,21 @@ main_message(error(system_error(Who), _What), Level, _LC) -->
main_message(error(uninstantiation_error(T),_), Level, _LC) -->
[ ' ~a: found ~q, expected unbound variable ' - [Level,T], nl ].
display_consulting( F, Level, LC) -->
display_consulting( F, Level, Info, LC) -->
{ LC > 0,
'$error_descriptor'(Info, Desc),
'$query_exception'(prologParserFile, Desc, F0),
'$query_exception'(prologarserLine, Desc, L),
F \= F0
}, !,
[ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ].
display_consulting( F, Level, _, LC) -->
{ LC > 0,
source_location(F0, L),
F \= F0
}, !,
[ '~a:~d:0: ~a while compiling.'-[F0,L,Level], nl ].
display_consulting(_F, _, _LC) -->
display_consulting(_F, _, _, _LC) -->
[].
caller( error(_,Info), _) -->