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

state

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 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 CACHE_REGS
listl = Deref(listl); xarg *a;
if (IsVarTerm(listl)) { listl = Deref(listl);
Yap_ThrowError(INSTANTIATION_ERROR, listl, "while opening a list of options"); if (IsVarTerm(listl)) {
} Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl,
xarg *a = calloc(n, sizeof(xarg)); "while opening listl = ArgOfTerm(2, listl ,k)");
}
if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule) a = calloc(n, sizeof(xarg));
listl = ArgOfTerm(2, listl);
if (!IsPairTerm(listl) && listl != TermNil) { if (!IsPairTerm(listl) && listl != TermNil) {
if (IsAtomTerm(listl)) { if (IsAtomTerm(listl)) {
xarg *na = matchKey(AtomOfTerm(listl), a, n, def); xarg *na = matchKey(AtomOfTerm(listl), a, n, def);
if (!na) { if (!na) {
return failed(TYPE_ERROR_LIST, listl, a); Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "match key");
} }
} else if (IsApplTerm(listl)) { } else if (IsApplTerm(listl)) {
Functor f = FunctorOfTerm(listl); Functor f = FunctorOfTerm(listl);
if (IsExtensionFunctor(f)) { 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); arity_t arity = ArityOfFunctor(f);
if (arity != 1) { 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); xarg *na = matchKey(NameOfFunctor(f), a, n, def);
if (!na) { if (!na) {
return failed(TYPE_ERROR_LIST, listl, a); Yap_ThrowError__(file, function, lineno, err, listl, "no match");
} }
na->used = true; na->used = true;
na->tvalue = ArgOfTerm(1, listl); na->tvalue = ArgOfTerm(1, listl);
return a;
} else { } else {
return failed(TYPE_ERROR_LIST, listl, a); Yap_ThrowError__(file, function, lineno, TYPE_ERROR_ATOM, listl, "not atom");
} }
listl = MkPairTerm(listl, TermNil); listl = MkPairTerm(listl, TermNil);
} }
@ -89,44 +83,45 @@ xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n) {
Term hd = HeadOfTerm(listl); Term hd = HeadOfTerm(listl);
listl = TailOfTerm(listl); listl = TailOfTerm(listl);
if (IsVarTerm(hd)) { if (IsVarTerm(hd)) {
return failed(INSTANTIATION_ERROR, hd, a); Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "sub-element");
} }
if (IsVarTerm(listl)) { if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a); Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "sub-list");
} }
if (IsAtomTerm(hd)) { if (IsAtomTerm(hd)) {
xarg *na = matchKey(AtomOfTerm(hd), a, n, def); xarg *na = matchKey(AtomOfTerm(hd), a, n, def);
if (!na) 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->used = true;
na->tvalue = TermNil; na->tvalue = TermNil;
continue; continue;
} else if (IsApplTerm(hd)) { } else if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm(hd); Functor f = FunctorOfTerm(hd);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
return failed(TYPE_ERROR_PARAMETER, hd, a); Yap_ThrowError__(file, function, lineno, err, hd, "bad compound");
} }
arity_t arity = ArityOfFunctor(f); arity_t arity = ArityOfFunctor(f);
if (arity != 1) { 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); xarg *na = matchKey(NameOfFunctor(f), a, n, def);
if (!na) { if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a); Yap_ThrowError__(file, function, lineno, err, hd, "no match");
} }
na->used = true; na->used = true;
na->tvalue = ArgOfTerm(1, hd); na->tvalue = ArgOfTerm(1, hd);
} else { } else {
return failed(TYPE_ERROR_PARAMETER, hd, a); Yap_ThrowError__(file, function, lineno, err, hd, "bad type");
} }
} }
if (IsVarTerm(listl)) { if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a); Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "unbound");
} else if (listl != TermNil) { } else if (listl != TermNil) {
return failed(TYPE_ERROR_LIST, listl, a); Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "bad list");
} }
return a; return a;
} }
static xarg *matchKey2(Atom key, xarg *e0, int n, const param2_t *def) { static xarg *matchKey2(Atom key, xarg *e0, int n, const param2_t *def) {
int i; int i;
@ -139,54 +134,53 @@ static xarg *matchKey2(Atom key, xarg *e0, int n, const param2_t *def) {
} }
return NULL; return NULL;
} }
/// Yap_ArgList2ToVector is much the same as before, /// Yap_ArgList2ToVector is much the same as before,
/// but assumes parameters also have something called a /// but assumes parameters also have something called a
/// scope /// 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 CACHE_REGS
listl = Deref(listl); xarg *a = calloc(n, sizeof(xarg));
if (IsVarTerm(listl)) {
Yap_ThrowError(INSTANTIATION_ERROR, listl, "while opening a list of options");
}
xarg *a = calloc(n, sizeof(xarg));
if (!IsPairTerm(listl) && listl != TermNil) { if (!IsPairTerm(listl) && listl != TermNil) {
if (IsVarTerm(listl)) { if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a); Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "unbound");
} }
if (IsAtomTerm(listl)) { if (IsAtomTerm(listl)) {
xarg *na = matchKey2(AtomOfTerm(listl), a, n, def); xarg *na = matchKey2(AtomOfTerm(listl), a, n, def);
if (!na) { if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a); Yap_ThrowError__(file, function, lineno, err,
listl, "bad match");
} }
} }
if (IsApplTerm(listl)) { if (IsApplTerm(listl)) {
Functor f = FunctorOfTerm(listl); Functor f = FunctorOfTerm(listl);
if (IsExtensionFunctor(f)) { 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); arity_t arity = ArityOfFunctor(f);
if (arity != 1) { 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); xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
if (!na) { if (!na) {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a); Yap_ThrowError__(file, function, lineno, DOMAIN_ERROR_GENERIC_ARGUMENT,
listl, "bad match");
} }
} else { } else {
return failed(TYPE_ERROR_LIST, listl, a); Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "");
} }
listl = MkPairTerm(listl, TermNil); listl = MkPairTerm(listl, TermNil);
} }
while (IsPairTerm(listl)) { while (IsPairTerm(listl)) {
Term hd = HeadOfTerm(listl); Term hd = HeadOfTerm(listl);
if (IsVarTerm(hd)) { if (IsVarTerm(hd)) {
return failed(INSTANTIATION_ERROR, hd, a); Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "");
} }
if (IsAtomTerm(hd)) { if (IsAtomTerm(hd)) {
xarg *na = matchKey2(AtomOfTerm(hd), a, n, def); xarg *na = matchKey2(AtomOfTerm(hd), a, n, def);
if (!na) { 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->used = true;
na->tvalue = TermNil; na->tvalue = TermNil;
@ -194,29 +188,32 @@ xarg *Yap_ArgList2ToVector(Term listl, const param2_t *def, int n) {
} else if (IsApplTerm(hd)) { } else if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm(hd); Functor f = FunctorOfTerm(hd);
if (IsExtensionFunctor(f)) { 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); arity_t arity = ArityOfFunctor(f);
if (arity != 1) { 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); xarg *na = matchKey2(NameOfFunctor(f), a, n, def);
if (na) { if (na) {
na->used = 1; na->used = 1;
na->tvalue = ArgOfTerm(1, hd); na->tvalue = ArgOfTerm(1, hd);
} else { } else {
return failed(DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a); Yap_ThrowError__(file, function, lineno, err,
hd, "bad key");
} }
return a;
} else { } else {
return failed(INSTANTIATION_ERROR, hd, a); Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, hd, "unbound");
} }
listl = TailOfTerm(listl); listl = TailOfTerm(listl);
} }
if (IsVarTerm(listl)) { if (IsVarTerm(listl)) {
return failed(INSTANTIATION_ERROR, listl, a); Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl, "");
} }
if (TermNil != listl) { if (TermNil != listl) {
return failed(TYPE_ERROR_LIST, listl, a); Yap_ThrowError__(file, function, lineno, TYPE_ERROR_LIST, listl, "");
} }
return a; return a;
} }

564
C/errors.c
View File

@ -32,28 +32,28 @@
#endif #endif
#include "Foreign.h" #include "Foreign.h"
#define set_key_b(k, ks, q, i, t) \ #define set_key_b(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \ if (strcmp(ks, q) == 0) { \
i->k = t == TermTrue ? true : false; \ i->k = t == TermTrue ? true : false; \
return i->k || t == TermFalse; \ return i->k || t == TermFalse; \
} }
#define set_key_i(k, ks, q, i, t) \ #define set_key_i(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \ if (strcmp(ks, q) == 0) { \
i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \ i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \
return IsIntegerTerm(t); \ return IsIntegerTerm(t); \
} }
#define set_key_s(k, ks, q, i, t) \ #define set_key_s(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \ if (strcmp(ks, q) == 0) { \
const char *s = IsAtomTerm(t) ? RepAtom(AtomOfTerm(t))->StrOfAE \ const char *s = IsAtomTerm(t) ? RepAtom(AtomOfTerm(t))->StrOfAE \
: IsStringTerm(t) ? StringOfTerm(t) : NULL; \ : IsStringTerm(t) ? StringOfTerm(t) : NULL; \
if (s) { \ if (s) { \
char *tmp = malloc(strlen(s) + 1); \ char *tmp = malloc(strlen(s) + 1); \
strcpy(tmp, s); \ strcpy(tmp, s); \
i->k = tmp; \ i->k = tmp; \
} \ } \
return i->k != NULL; \ return i->k != NULL; \
} }
static bool setErr(const char *q, yap_error_descriptor_t *i, Term t) { 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; return false;
} }
#define query_key_b(k, ks, q, i) \ #define query_key_b(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \ if (strcmp(ks, q) == 0) { \
return i->k ? TermTrue : TermFalse; \ return i->k ? TermTrue : TermFalse; \
} }
#define query_key_i(k, ks, q, i) \ #define query_key_i(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \ if (strcmp(ks, q) == 0) { \
return MkIntegerTerm(i->k); \ return MkIntegerTerm(i->k); \
} }
#define query_key_s(k, ks, q, i) \ #define query_key_s(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \ if (strcmp(ks, q) == 0) { \
return (i->k && i->k[0] ? MkStringTerm(i->k) : TermNil); \ return (i->k && i->k[0] ? MkStringTerm(i->k) : TermNil); \
} }
static Term queryErr(const char *q, yap_error_descriptor_t *i) { 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("errorAsText", i->errorAsText);
print_key_s("errorGoal", i->errorGoal); print_key_s("errorGoal", i->errorGoal);
print_key_s("classAsText", i->classAsText); 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("errorFunction", i->errorFunction);
print_key_s("errorFile", i->errorFile); print_key_s("errorFile", i->errorFile);
print_key_i("prologPredLine", i->prologPredLine); print_key_i("prologPredLine", i->prologPredLine);
@ -237,7 +237,7 @@ static Term err2list(yap_error_descriptor_t *i) {
bool Yap_Warning(const char *s, ...) { bool Yap_Warning(const char *s, ...) {
CACHE_REGS CACHE_REGS
va_list ap; va_list ap;
PredEntry *pred; PredEntry *pred;
bool rc; bool rc;
Term ts[2]; Term ts[2];
@ -283,7 +283,7 @@ bool Yap_Warning(const char *s, ...) {
void Yap_InitError__(const char *file, const char *function, int lineno, void Yap_InitError__(const char *file, const char *function, int lineno,
yap_error_number e, Term t, ...) { yap_error_number e, Term t, ...) {
CACHE_REGS CACHE_REGS
va_list ap; va_list ap;
va_start(ap, t); va_start(ap, t);
const char *fmt; const char *fmt;
char tmpbuf[MAXPATHLEN]; 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; yap_error_number err = LOCAL_ActiveError->errorNo;
fprintf(stderr, "%% Warning %s WITHIN ERROR %s %s\n", Yap_errorName(e), fprintf(stderr, "%% Warning %s WITHIN ERROR %s %s\n", Yap_errorName(e),
Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err)); Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
return; return;
} }
LOCAL_ActiveError->errorNo = e; LOCAL_ActiveError->errorNo = e;
LOCAL_ActiveError->errorFile = NULL; LOCAL_ActiveError->errorFile = NULL;
@ -319,15 +319,18 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
bool Yap_PrintWarning(Term twarning) { bool Yap_PrintWarning(Term twarning) {
CACHE_REGS CACHE_REGS
PredEntry *pred = RepPredProp(PredPropByFunc( PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2; FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule); Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule);
bool rc; bool rc;
Term ts[2], err; 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", 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; return false;
} }
LOCAL_PrologMode |= InErrorMode; LOCAL_PrologMode |= InErrorMode;
@ -343,7 +346,7 @@ bool Yap_PrintWarning(Term twarning) {
} }
ts[1] = twarning; ts[1] = twarning;
ts[0] = MkAtomTerm(AtomWarning); 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_within_print_message = false;
LOCAL_PrologMode &= ~InErrorMode; LOCAL_PrologMode &= ~InErrorMode;
return rc; return rc;
@ -352,7 +355,7 @@ bool Yap_PrintWarning(Term twarning) {
bool Yap_HandleError__(const char *file, const char *function, int lineno, bool Yap_HandleError__(const char *file, const char *function, int lineno,
const char *s, ...) { const char *s, ...) {
CACHE_REGS CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE; yap_error_number err = LOCAL_Error_TYPE;
const char *serr; const char *serr;
arity_t arity = 2; arity_t arity = 2;
@ -362,7 +365,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno,
} else { } else {
serr = s; serr = s;
} }
if (P!= FAILCODE) { if (P != FAILCODE) {
if (P->opc == Yap_opcode(_try_c) || P->opc == Yap_opcode(_try_userc) || 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)) { 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: default:
if (LOCAL_PrologMode == UserMode) if (LOCAL_PrologMode == UserMode)
Yap_ThrowError__( file, function, lineno, err, LOCAL_RawTerm, serr); Yap_ThrowError__(file, function, lineno, err, LOCAL_RawTerm, serr);
else else
LOCAL_PrologMode &= ~InErrorMode; LOCAL_PrologMode &= ~InErrorMode;
return false; return false;
@ -410,7 +413,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno,
int Yap_SWIHandleError(const char *s, ...) { int Yap_SWIHandleError(const char *s, ...) {
CACHE_REGS CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE; yap_error_number err = LOCAL_Error_TYPE;
char *serr; char *serr;
if (LOCAL_ErrorMessage) { if (LOCAL_ErrorMessage) {
@ -449,18 +452,18 @@ int Yap_SWIHandleError(const char *s, ...) {
void Yap_RestartYap(int flag) { void Yap_RestartYap(int flag) {
CACHE_REGS CACHE_REGS
#if PUSH_REGS #if PUSH_REGS
restore_absmi_regs(&Yap_standard_regs); restore_absmi_regs(&Yap_standard_regs);
#endif #endif
siglongjmp(*LOCAL_RestartEnv, flag); siglongjmp(*LOCAL_RestartEnv, flag);
} }
static void error_exit_yap(int value) { static void error_exit_yap(int value) {
CACHE_REGS CACHE_REGS
if (!(LOCAL_PrologMode & BootMode)) { if (!(LOCAL_PrologMode & BootMode)) {
#if DEBUG #if DEBUG
#endif #endif
} }
fprintf(stderr, "\n Exiting ....\n"); fprintf(stderr, "\n Exiting ....\n");
#if HAVE_BACKTRACE #if HAVE_BACKTRACE
void *callstack[256]; void *callstack[256];
@ -499,76 +502,76 @@ static char tmpbuf[YAP_BUF_SIZE];
#undef E2 #undef E2
#undef END_ERRORS #undef END_ERRORS
#define BEGIN_ERROR_CLASSES() \ #define BEGIN_ERROR_CLASSES() \
static Atom mkerrorct(yap_error_class_number c) { \ static Atom mkerrorct(yap_error_class_number c) { \
switch (c) { switch (c) {
#define ECLASS(CL, A, B) \ #define ECLASS(CL, A, B) \
case CL: \ case CL: \
return Yap_LookupAtom(A); return Yap_LookupAtom(A);
#define END_ERROR_CLASSES() \ #define END_ERROR_CLASSES() \
} \ } \
return NULL; \ return NULL; \
} }
#define BEGIN_ERRORS() \ #define BEGIN_ERRORS() \
static Term mkerrort(yap_error_number e, Term culprit, Term info) { \ static Term mkerrort(yap_error_number e, Term culprit, Term info) { \
switch (e) { switch (e) {
#define E0(A, B) \ #define E0(A, B) \
case A: { \ case A: { \
Term ft[2]; \ Term ft[2]; \
ft[0] = MkAtomTerm(mkerrorct(B)); \ ft[0] = MkAtomTerm(mkerrorct(B)); \
ft[1] = info; \ ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \ return Yap_MkApplTerm(FunctorError, 2, ft); \
} }
#define E(A, B, C) \ #define E(A, B, C) \
case A: { \ case A: { \
Term ft[2], nt[2]; \ Term ft[2], nt[2]; \
nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \ nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \
nt[1] = MkVarTerm(); \ nt[1] = MkVarTerm(); \
Yap_unify(nt[1], culprit); \ Yap_unify(nt[1], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 2), 2, nt); \ ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 2), 2, nt); \
ft[1] = info; \ ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \ return Yap_MkApplTerm(FunctorError, 2, ft); \
} }
#define E1(A, B, C) \ #define E1(A, B, C) \
case A: { \ case A: { \
Term ft[2], nt[1]; \ Term ft[2], nt[1]; \
nt[0] = MkVarTerm(); \ nt[0] = MkVarTerm(); \
Yap_unify(nt[0], culprit); \ Yap_unify(nt[0], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(C), 1),1 , nt); \ ft[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(C), 1), 1, nt); \
ft[1] = info; \ ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \ return Yap_MkApplTerm(FunctorError, 2, ft); \
} }
#define E2(A, B, C, D) \ #define E2(A, B, C, D) \
case A: { \ case A: { \
Term ft[2], nt[3]; \ Term ft[2], nt[3]; \
nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \ nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \
nt[1] = MkAtomTerm(Yap_LookupAtom(D)); \ nt[1] = MkAtomTerm(Yap_LookupAtom(D)); \
nt[2] = MkVarTerm(); \ nt[2] = MkVarTerm(); \
Yap_unify(nt[2], culprit); \ Yap_unify(nt[2], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 3), 3, nt); \ ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 3), 3, nt); \
ft[1] = info; \ ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \ return Yap_MkApplTerm(FunctorError, 2, ft); \
} }
#define END_ERRORS() \ #define END_ERRORS() \
} \ } \
return TermNil; \ return TermNil; \
} }
#include "YapErrors.h" #include "YapErrors.h"
bool Yap_pushErrorContext(bool pass, yap_error_descriptor_t *new_error) { bool Yap_pushErrorContext(bool pass, yap_error_descriptor_t *new_error) {
memset(new_error, 0, sizeof(yap_error_descriptor_t)); memset(new_error, 0, sizeof(yap_error_descriptor_t));
new_error->top_error = LOCAL_ActiveError; new_error->top_error = LOCAL_ActiveError;
LOCAL_ActiveError = new_error; LOCAL_ActiveError = new_error;
return true; return true;
} }
/* static void */ /* 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 *Yap_popErrorContext(bool mdnew, bool pass) {
yap_error_descriptor_t *e =LOCAL_ActiveError; yap_error_descriptor_t *e = LOCAL_ActiveError;
// last block // last block
LOCAL_ActiveError = e->top_error; LOCAL_ActiveError = e->top_error;
if (e->errorNo) { if (e->errorNo) {
if (!LOCAL_ActiveError->errorNo && pass) { if (!LOCAL_ActiveError->errorNo && pass) {
memcpy(LOCAL_ActiveError, e, sizeof(*LOCAL_ActiveError)); memcpy(LOCAL_ActiveError, e, sizeof(*LOCAL_ActiveError));
} else {
return e;
}
} else { } 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 * Throw an error directly to the error handler
* *
* @param file where * @param file where
* @param function who * @param function who
* @param lineno when * @param lineno when
@ -628,9 +631,9 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno,
Yap_exit(5); Yap_exit(5);
} }
/** /**
* complete delayed error. * complete delayed error.
* *
*/ */
void Yap_ThrowExistingError(void) { void Yap_ThrowExistingError(void) {
if (LOCAL_RestartEnv) { if (LOCAL_RestartEnv) {
@ -639,23 +642,25 @@ void Yap_ThrowExistingError(void) {
Yap_exit(5); Yap_exit(5);
} }
bool Yap_MkErrorRecord( yap_error_descriptor_t *r, bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
const char *file, const char *function, const char *function, int lineno, yap_error_number type,
int lineno, yap_error_number type, Term where, Term where, const char *s) {
const char *s) {
if (!Yap_pc_add_location(r, CP, B, ENV)) if (!Yap_pc_add_location(r, CP, B, ENV))
Yap_env_add_location(r, CP, B, ENV, 0); 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; r->culprit = NULL;
} else { } else {
r->culprit = Yap_TermToBuffer( 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->errorNo = type;
r->errorAsText = Yap_errorName(type); r->errorAsText = Yap_errorName(type);
r->errorClass = Yap_errorClass(type); r->errorClass = Yap_errorClass(type);
r->classAsText = r->classAsText = Yap_errorClassName(r->errorClass);
Yap_errorClassName(r->errorClass);
r->errorLine = lineno; r->errorLine = lineno;
r->errorFunction = function; r->errorFunction = function;
r->errorFile = file; r->errorFile = file;
@ -687,21 +692,20 @@ bool Yap_MkErrorRecord( yap_error_descriptor_t *r,
} }
// fprintf(stderr, "warning: "); // fprintf(stderr, "warning: ");
if (s && s[0]) { if (s && s[0]) {
r->errorMsgLen = strlen(s) + 1; r->errorMsgLen = strlen(s) + 1;
r->errorMsg = malloc(r->errorMsgLen); r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, s); strcpy(r->errorMsg, s);
} else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) { } else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) {
r->errorMsgLen = strlen(LOCAL_ErrorMessage) + 1; r->errorMsgLen = strlen(LOCAL_ErrorMessage) + 1;
r->errorMsg = malloc(r->errorMsgLen); r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, LOCAL_ErrorMessage); strcpy(r->errorMsg, LOCAL_ErrorMessage);
} else { } else {
r->errorMsgLen = 0; r->errorMsgLen = 0;
r->errorMsg = 0; r->errorMsg = 0;
} }
return true; return true;
} }
/** /**
* @brief Yap_Error * @brief Yap_Error
* This function handles errors in the C code. Check errors.yap for the * This function handles errors in the C code. Check errors.yap for the
@ -726,95 +730,95 @@ bool Yap_MkErrorRecord( yap_error_descriptor_t *r,
yamop *Yap_Error__(bool throw, const char *file, const char *function, yamop *Yap_Error__(bool throw, const char *file, const char *function,
int lineno, yap_error_number type, Term where, ...) { int lineno, yap_error_number type, Term where, ...) {
CACHE_REGS CACHE_REGS
va_list ap; va_list ap;
char *fmt; char *fmt;
char s[MAXPATHLEN]; char s[MAXPATHLEN];
switch (type) { switch (type) {
case SYSTEM_ERROR_INTERNAL: { case SYSTEM_ERROR_INTERNAL: {
fprintf(stderr, "%% Internal YAP Error: %s exiting....\n", tmpbuf); fprintf(stderr, "%% Internal YAP Error: %s exiting....\n", tmpbuf);
// serious = true; // serious = true;
if (LOCAL_PrologMode & BootMode) { if (LOCAL_PrologMode & BootMode) {
fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf); fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf);
} else { } else {
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE); Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
if (tmpbuf[0]) { if (tmpbuf[0]) {
fprintf(stderr, "%% Bug found while executing %s\n", tmpbuf); 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
} }
error_exit_yap(1); #if HAVE_BACKTRACE
} void *callstack[256];
case SYSTEM_ERROR_FATAL: { int i;
fprintf(stderr, "%% Fatal YAP Error: %s exiting....\n", tmpbuf); int frames = backtrace(callstack, 256);
error_exit_yap(1); char **strs = backtrace_symbols(callstack, frames);
} fprintf(stderr, "Execution stack:\n");
case INTERRUPT_EVENT: { for (i = 0; i < frames; ++i) {
error_exit_yap(1); fprintf(stderr, " %s\n", strs[i]);
} }
case ABORT_EVENT: free(strs);
// 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 #endif
va_end(ap); }
break; error_exit_yap(1);
} }
} case SYSTEM_ERROR_FATAL: {
Yap_MkErrorRecord(LOCAL_ActiveError, file, function, lineno, type, where, s); fprintf(stderr, "%% Fatal YAP Error: %s exiting....\n", tmpbuf);
if (where == 0 || where == TermNil) { 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; LOCAL_ActiveError->culprit = 0;
} }
if (P == (yamop *)(FAILCODE)) { if (P == (yamop *)(FAILCODE)) {
@ -841,7 +845,6 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
// DumpActiveGoals( USES_REGS1 ); // DumpActiveGoals( USES_REGS1 );
#endif /* DEBUG */ #endif /* DEBUG */
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
#if DEBUG #if DEBUG
// DumpActiveGoals( PASS_REGS1 ); // 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))); Yap_PrintWarning(MkErrorTerm(Yap_GetException(LOCAL_ActiveError)));
return P; return P;
} }
//LOCAL_ActiveError = Yap_GetException(); // LOCAL_ActiveError = Yap_GetException();
// reset_error_description(); // reset_error_description();
if (!throw) { if (!throw) {
Yap_JumpToEnv(); Yap_JumpToEnv();
@ -887,9 +890,9 @@ static Int close_error(USES_REGS1) {
#define ECLASS(CL, A, B) CL##__, #define ECLASS(CL, A, B) CL##__,
#define END_ERROR_CLASSES() \ #define END_ERROR_CLASSES() \
} \ } \
aux_class_t; aux_class_t;
#define BEGIN_ERRORS() #define BEGIN_ERRORS()
#define E0(X, Y) #define E0(X, Y)
@ -914,8 +917,8 @@ static Int close_error(USES_REGS1) {
#define ECLASS(CL, A, B) A, #define ECLASS(CL, A, B) A,
#define END_ERROR_CLASSES() \ #define END_ERROR_CLASSES() \
NULL \ NULL \
} }
typedef struct c_error_info { typedef struct c_error_info {
@ -928,9 +931,9 @@ typedef struct c_error_info {
#define E(X, Y, Z) {Y##__, Z}, #define E(X, Y, Z) {Y##__, Z},
#define E1(X, Y, Z) {Y##__, Z}, #define E1(X, Y, Z) {Y##__, Z},
#define E2(X, Y, Z, W) {Y##__, Z " " W}, #define E2(X, Y, Z, W) {Y##__, Z " " W},
#define END_ERRORS() \ #define END_ERRORS() \
{ YAPC_NO_ERROR, "" } \ { YAPC_NO_ERROR, "" } \
} \ } \
; ;
#include <YapErrors.h> #include <YapErrors.h>
@ -945,14 +948,14 @@ const char *Yap_errorClassName(yap_error_class_number e) {
return c_error_class_name[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 CACHE_REGS
if(i->errorNo != YAP_NO_ERROR) { if (i->errorNo != YAP_NO_ERROR) {
yap_error_descriptor_t *t = LOCAL_ActiveError, yap_error_descriptor_t *t = LOCAL_ActiveError,
*nt = malloc(sizeof(yap_error_descriptor_t)); *nt = malloc(sizeof(yap_error_descriptor_t));
memcpy(nt, t, sizeof(yap_error_descriptor_t)); memcpy(nt, t, sizeof(yap_error_descriptor_t));
return nt; return nt;
} }
return 0; return 0;
} }
@ -975,16 +978,13 @@ bool Yap_ResetException(yap_error_descriptor_t *i) {
return true; return true;
} }
static Int reset_exception(USES_REGS1) { static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); }
return Yap_ResetException(worker_id); }
Term MkErrorTerm(yap_error_descriptor_t *t) { Term MkErrorTerm(yap_error_descriptor_t *t) {
if (t->errorClass == EVENT) if (t->errorClass == EVENT)
return t->errorRawTerm; return t->errorRawTerm;
return mkerrort(t->errorNo, return mkerrort(t->errorNo,
t->culprit? t->culprit ? Yap_BufferToTerm(t->culprit, TermNil) : TermNil,
Yap_BufferToTerm(t->culprit, TermNil): TermNil,
err2list(t)); err2list(t));
} }
@ -1023,11 +1023,11 @@ static Int drop_exception(USES_REGS1) {
} }
static Int new_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); return Yap_unify(ARG1, t);
} }
static Int get_exception( USES_REGS1) { static Int get_exception(USES_REGS1) {
yap_error_descriptor_t *i; yap_error_descriptor_t *i;
Term t; Term t;
@ -1036,15 +1036,15 @@ static Int get_exception( USES_REGS1) {
Yap_ResetException(LOCAL_ActiveError); Yap_ResetException(LOCAL_ActiveError);
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
if (i->errorRawTerm && if (i->errorRawTerm &&
(i->errorClass == EVENT || i->errorNo == SYNTAX_ERROR)) { (i->errorClass == EVENT || i->errorNo == SYNTAX_ERROR)) {
t = i->errorRawTerm; t = i->errorRawTerm;
} else if (i->culprit != NULL) { } 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)); MkSysError(i));
} else { } else {
t = mkerrort(i->errorNo, TermNil, MkSysError(i)); t = mkerrort(i->errorNo, TermNil, MkSysError(i));
} }
return Yap_unify(ARG1,t); return Yap_unify(ARG1, t);
} }
return false; return false;
} }
@ -1056,42 +1056,42 @@ yap_error_descriptor_t *event(Term t, yap_error_descriptor_t *i) {
return i; return i;
} }
yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) { yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
Term n = t; Term n = t;
bool found = false, wellformed = true; bool found = false, wellformed = true;
if (!IsApplTerm(t) || FunctorOfTerm(t) != FunctorError) { if (!IsApplTerm(t) || FunctorOfTerm(t) != FunctorError) {
LOCAL_Error_TYPE = THROW_EVENT; LOCAL_Error_TYPE = THROW_EVENT;
LOCAL_ActiveError->errorClass = EVENT; LOCAL_ActiveError->errorClass = EVENT;
LOCAL_ActiveError->errorAsText = Yap_errorName(THROW_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->errorRawTerm = Yap_SaveTerm(t);
LOCAL_ActiveError->culprit = NULL; LOCAL_ActiveError->culprit = NULL;
} else { } else {
Term t1, t2; Term t1, t2;
t1 = ArgOfTerm(1, t); t1 = ArgOfTerm(1, t);
t2 = ArgOfTerm(2, t); t2 = ArgOfTerm(2, t);
// LOCAL_Error_TYPE = ERROR_EVENT; // LOCAL_Error_TYPE = ERROR_EVENT;
wellformed = wellformed && ( i->errorAsText != NULL ); wellformed = wellformed && (i->errorAsText != NULL);
if (wellformed) { if (wellformed) {
int j; int j;
for (j = 0; j < sizeof(c_error_list) / sizeof(struct c_error_info); j++) { for (j = 0; j < sizeof(c_error_list) / sizeof(struct c_error_info); j++) {
if (!strcmp(c_error_list[j].name, i->errorAsText) && if (!strcmp(c_error_list[j].name, i->errorAsText) &&
(c_error_list[j].class == 0 || (c_error_list[j].class == 0 ||
!strcmp(i->classAsText, !strcmp(i->classAsText,
c_error_class_name[c_error_list[j].class]))) { c_error_class_name[c_error_list[j].class]))) {
if (c_error_list[j].class != PERMISSION_ERROR || if (c_error_list[j].class != PERMISSION_ERROR ||
(t1 = ArgOfTerm(2, t1) && IsAtomTerm(t1) && (t1 = ArgOfTerm(2, t1) && IsAtomTerm(t1) &&
!strcmp(c_error_list[j].name, !strcmp(c_error_list[j].name,
RepAtom(AtomOfTerm(t1))->StrOfAE) && RepAtom(AtomOfTerm(t1))->StrOfAE) &&
c_error_list[j].class != EVENT)) { c_error_list[j].class != EVENT)) {
i->errorNo = j; i->errorNo = j;
i->errorClass = c_error_list[j].class; i->errorClass = c_error_list[j].class;
found = true; found = true;
break; break;
}
} }
} }
}
} else if (IsAtomTerm(t1)) { } else if (IsAtomTerm(t1)) {
const char *err = RepAtom(AtomOfTerm(t1))->StrOfAE; const char *err = RepAtom(AtomOfTerm(t1))->StrOfAE;
if (!strcmp(err, "instantiation_error")) { if (!strcmp(err, "instantiation_error")) {
@ -1119,8 +1119,8 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
if (found) { if (found) {
n = t2; n = t2;
} }
i->errorGoal = i->errorGoal = Yap_TermToBuffer(
Yap_TermToBuffer(n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
} }
Yap_prolog_add_culprit(i PASS_REGS); Yap_prolog_add_culprit(i PASS_REGS);
return i; return i;
@ -1157,21 +1157,21 @@ static Int is_callable(USES_REGS1) {
if (IsApplTerm(G)) { if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G); Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL); Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
} }
if (f == FunctorModule) { if (f == FunctorModule) {
Term tm = ArgOfTerm(1, G); Term tm = ArgOfTerm(1, G);
if (IsVarTerm(tm)) { if (IsVarTerm(tm)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL); Yap_Error(INSTANTIATION_ERROR, G, NULL);
return false; return false;
} }
if (!IsAtomTerm(tm)) { if (!IsAtomTerm(tm)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL); Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
return false; return false;
} }
G = ArgOfTerm(2, G); G = ArgOfTerm(2, G);
} else { } else {
return true; return true;
} }
} else if (IsPairTerm(G) || IsAtomTerm(G)) { } else if (IsPairTerm(G) || IsAtomTerm(G)) {
return true; return true;
@ -1212,7 +1212,7 @@ static Int is_predicate_indicator(USES_REGS1) {
void Yap_InitErrorPreds(void) { void Yap_InitErrorPreds(void) {
CACHE_REGS 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("$new_exception", 1, new_exception, 0);
Yap_InitCPred("$get_exception", 1, get_exception, 0); Yap_InitCPred("$get_exception", 1, get_exception, 0);
Yap_InitCPred("$read_exception", 2, read_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_callable", 2, is_callable, TestPredFlag);
Yap_InitCPred("is_atom", 2, is_atom, TestPredFlag); Yap_InitCPred("is_atom", 2, is_atom, TestPredFlag);
Yap_InitCPred("is_predicate_indicator", 2, is_predicate_indicator, 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 * @file exec.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan> * @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Mon Apr 30 13:48:35 2018 * @date Mon Apr 30 13:48:35 2018
* *
* @brief meta-call * @brief meta-call
* *
* @namespace prolog * @namespace prolog
* *
* *
* *
*/ */
#include "absmi.h" #include "absmi.h"
@ -59,7 +59,7 @@ static choiceptr cp_from_integer(Term cpt USES_REGS) {
*/ */
Term Yap_cp_as_integer(choiceptr cp) { Term Yap_cp_as_integer(choiceptr cp) {
CACHE_REGS 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. * Transfer control to a meta-call in ARG1, cut up to B.
* *
* @param g goal * @param g goal
* @param mod current module * @param mod current module
* @return su * @return su
*/ */
Term Yap_ExecuteCallMetaCall(Term g, Term mod) { Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
CACHE_REGS CACHE_REGS
Term ts[4]; Term ts[4];
ts[0] = g; ts[0] = g;
ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */ ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
ts[2] = g; ts[2] = g;
@ -153,8 +153,8 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
Term Yap_PredicateIndicator(Term t, Term mod) { Term Yap_PredicateIndicator(Term t, Term mod) {
CACHE_REGS CACHE_REGS
// generate predicate indicator in this case // generate predicate indicator in this case
Term ti[2]; Term ti[2];
t = Yap_YapStripModule(t, &mod); t = Yap_YapStripModule(t, &mod);
if (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) { if (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) {
ti[0] = MkAtomTerm(NameOfFunctor(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) { static PredEntry *new_pred(Term t, Term tmod, char *pname) {
Term t0 = t; Term t0 = t;
restart: restart:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname); Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL; return NULL;
@ -405,7 +405,7 @@ inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) {
int j = -n; int j = -n;
Term t0 = t, mod0 = mod; Term t0 = t, mod0 = mod;
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS); return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS);
} else if (IsAtomTerm(t)) { } 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) { if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled) {
return EnterCreepMode( return EnterCreepMode(
copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS), copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS),
mod PASS_REGS); mod PASS_REGS);
} }
if (arity > MaxTemps) { if (arity > MaxTemps) {
return CallError(TYPE_ERROR_CALLABLE, t0, mod0 PASS_REGS); 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 */ /* but no meta calls require special preprocessing */
// if (pen->PredFlags & (MetaPredFlag | UndefPredFlag)) { // if (pen->PredFlags & (MetaPredFlag | UndefPredFlag)) {
// Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS); // 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 !! */ /* now let us do what we wanted to do from the beginning !! */
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
@ -662,7 +662,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
yamop *code; yamop *code;
Term clt = Deref(ARG3); Term clt = Deref(ARG3);
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
return FALSE; return FALSE;
@ -783,16 +783,16 @@ static Int Yap_ignore(Term t, bool fail USES_REGS) {
Int oENV = LCL0 - ENV; Int oENV = LCL0 - ENV;
Int oYENV = LCL0 - YENV; Int oYENV = LCL0 - YENV;
Int oB = LCL0 - (CELL *)B; Int oB = LCL0 - (CELL *)B;
yap_error_descriptor_t ctx; yap_error_descriptor_t *ctx = malloc(sizeof(yap_error_descriptor_t));
bool newxp = Yap_pushErrorContext(true, &ctx); bool newxp = Yap_pushErrorContext(true, ctx);
bool rc = Yap_RunTopGoal(t, false); bool rc = Yap_RunTopGoal(t, false);
Yap_popErrorContext(newxp, true);
if (!rc) { if (!rc) {
complete_inner_computation((choiceptr)(LCL0 - oB)); complete_inner_computation((choiceptr)(LCL0 - oB));
// We'll pass it through // We'll pass it through
} else { } else {
prune_inner_computation((choiceptr)(LCL0 - oB)); prune_inner_computation((choiceptr)(LCL0 - oB));
} }
Yap_popErrorContext(newxp, true);
P = oP; P = oP;
CP = oCP; CP = oCP;
ENV = LCL0 - oENV; ENV = LCL0 - oENV;
@ -832,7 +832,7 @@ static bool watch_cut(Term ext USES_REGS) {
} }
CELL *port_pt = deref_ptr(RepAppl(task) + 2); CELL *port_pt = deref_ptr(RepAppl(task) + 2);
CELL *completion_pt = deref_ptr(RepAppl(task) + 4); 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); e = MkErrorTerm(LOCAL_ActiveError);
Term t; Term t;
if (active) { if (active) {
@ -849,7 +849,7 @@ static bool watch_cut(Term ext USES_REGS) {
CELL *complete_pt = deref_ptr(RepAppl(task) + 4); CELL *complete_pt = deref_ptr(RepAppl(task) + 4);
complete_pt[0] = TermTrue; complete_pt[0] = TermTrue;
if (ex_mode) { if (ex_mode) {
//Yap_PutException(e); // Yap_PutException(e);
return true; return true;
} }
if (Yap_RaiseException()) if (Yap_RaiseException())
@ -888,8 +888,7 @@ static bool watch_retry(Term d0 USES_REGS) {
// just do the frrpest // just do the frrpest
if (B >= B0 && !ex_mode && !active) if (B >= B0 && !ex_mode && !active)
return true; return true;
if (LOCAL_ActiveError && if (LOCAL_ActiveError && LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
e = MkErrorTerm(LOCAL_ActiveError); e = MkErrorTerm(LOCAL_ActiveError);
if (active) { if (active) {
t = Yap_MkApplTerm(FunctorException, 1, &e); t = Yap_MkApplTerm(FunctorException, 1, &e);
@ -909,7 +908,7 @@ static bool watch_retry(Term d0 USES_REGS) {
port_pt[0] = t; port_pt[0] = t;
Yap_ignore(cleanup, true); Yap_ignore(cleanup, true);
if (ex_mode) { if (ex_mode) {
//Yap_PutException(e); // Yap_PutException(e);
return true; return true;
} }
if (Yap_RaiseException()) 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) { static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) {
CACHE_REGS CACHE_REGS
if (creeping) { if (creeping) {
Yap_signal(YAP_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL);
} }
CurrentModule = omod; CurrentModule = omod;
Yap_CloseSlots(sl); Yap_CloseSlots(sl);
if (out) { if (out) {
@ -1031,7 +1030,7 @@ static Int _user_expand_goal(USES_REGS1) {
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args); ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
ARG2 = Yap_GetFromSlot(h2); ARG2 = Yap_GetFromSlot(h2);
if ((pe = RepPredProp( if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) && Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) { Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
@ -1041,7 +1040,7 @@ static Int _user_expand_goal(USES_REGS1) {
ARG3 = Yap_GetFromSlot(h2); ARG3 = Yap_GetFromSlot(h2);
/* user:goal_expansion(A,CurMod,B) */ /* user:goal_expansion(A,CurMod,B) */
if ((pe = RepPredProp( if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) && Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) { Yap_execute_pred(pe, NULL PASS_REGS, false)) {
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
@ -1053,7 +1052,7 @@ static Int _user_expand_goal(USES_REGS1) {
/* user:goal_expansion(A,B) */ /* user:goal_expansion(A,B) */
if (cmod != USER_MODULE && /* we have tried this before */ if (cmod != USER_MODULE && /* we have tried this before */
(pe = RepPredProp( (pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) && Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) { Yap_execute_pred(pe, NULL PASS_REGS, false)) {
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
@ -1073,7 +1072,7 @@ static Int do_term_expansion(USES_REGS1) {
ARG1 = g; ARG1 = g;
if ((pe = RepPredProp( if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) && Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) { Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping); 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); ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
ARG2 = Yap_GetFromSlot(h2); ARG2 = Yap_GetFromSlot(h2);
if ((pe = RepPredProp( if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) && Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) { Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping); 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); return EnterCreepMode(t, mod PASS_REGS);
} }
t = Yap_YapStripModule(t, &mod); t = Yap_YapStripModule(t, &mod);
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
return false; return false;
@ -1246,15 +1245,14 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
return rc; return rc;
} }
/** /**
* @brief Two argument version of non-interruptible execution: this will * @brief Two argument version of non-interruptible execution: this will
* ignore signals including debugging requests. * ignore signals including debugging requests.
* *
* @return Int succeeds if it can transfer control. * @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 t = Deref(ARG1);
Term mod = Deref(ARG2); Term mod = Deref(ARG2);
unsigned int arity; unsigned int arity;
@ -1329,20 +1327,17 @@ static Int execute_nonstop(USES_REGS1) {
} }
} }
/** /**
* @brief One argument version of non-interruptible execution: this will * @brief One argument version of non-interruptible execution: this will
* ignore signals including debugging requests. * ignore signals including debugging requests.
* *
* @return Int succeeds if it can transfer control. * @return Int succeeds if it can transfer control.
*/ */
static Int execute_nonstop1(USES_REGS1) static Int execute_nonstop1(USES_REGS1) {
{ ARG2 = CurrentModule;
ARG2 = CurrentModule; return execute_nonstop(PASS_REGS1);
return execute_nonstop( PASS_REGS1 );
} }
static Int execute_0(USES_REGS1) { /* '$execute_0'(Goal) */ static Int execute_0(USES_REGS1) { /* '$execute_0'(Goal) */
Term mod = CurrentModule; Term mod = CurrentModule;
Term t = Yap_YapStripModule(Deref(ARG1), &mod); 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; sigjmp_buf signew, *sighold = LOCAL_RestartEnv;
LOCAL_RestartEnv = &signew; LOCAL_RestartEnv = &signew;
int i = AllocLevel(); int i = AllocLevel();
if /* top &&*/( (lval = sigsetjmp(signew, 1)) != 0) { if /* top &&*/ ((lval = sigsetjmp(signew, 1)) != 0) {
switch (lval) { switch (lval) {
case 1: { /* restart */ case 1: { /* restart */
/* otherwise, SetDBForThrow will fail entering critical mode */ /* 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 */ /* H is not so important, because we're gonna backtrack */
restore_H(); restore_H();
/* set stack */ /* set stack */
ASP = (CELL *) PROTECT_FROZEN_B(B); ASP = (CELL *)PROTECT_FROZEN_B(B);
/* forget any signals active, we're reborne */ /* forget any signals active, we're reborne */
LOCAL_Signals = 0; LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
P = (yamop *) FAILCODE; P = (yamop *)FAILCODE;
} } break;
break;
case 2: { case 2: {
// LOCAL_ActiveError = err_info; // LOCAL_ActiveError = err_info;
/* arithmetic exception */ /* arithmetic exception */
@ -1466,20 +1460,19 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
* machine */ * machine */
pop_text_stack(i); pop_text_stack(i);
Yap_set_fpu_exceptions( Yap_set_fpu_exceptions(
getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG)); getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
P = (yamop *) FAILCODE; P = (yamop *)FAILCODE;
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
} } break;
break;
case 3: { /* saved state */ case 3: { /* saved state */
// LOCAL_ActiveError = err_info; // LOCAL_ActiveError = err_info;
pop_text_stack(i); pop_text_stack(i);
LOCAL_CBorder = OldBorder; LOCAL_CBorder = OldBorder;
LOCAL_RestartEnv = sighold; LOCAL_RestartEnv = sighold;
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
return false; return false;
} }
case 4: case 4:
/* abort */ /* abort */
@ -1487,16 +1480,16 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
*/ */
// LOCAL_ActiveError = err_info; // LOCAL_ActiveError = err_info;
while (B) { while (B) {
LOCAL_ActiveError->errorNo = ABORT_EVENT; LOCAL_ActiveError->errorNo = ABORT_EVENT;
pop_text_stack(i); pop_text_stack(i);
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
Yap_JumpToEnv(); Yap_JumpToEnv();
} }
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
P = (yamop *) FAILCODE; P = (yamop *)FAILCODE;
LOCAL_RestartEnv = sighold; LOCAL_RestartEnv = sighold;
Yap_CloseSlots(sls); Yap_CloseSlots(sls);
pop_text_stack(i); pop_text_stack(i);
return false; return false;
break; break;
case 5: case 5:
@ -1513,12 +1506,13 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
Yap_JumpToEnv(); Yap_JumpToEnv();
Yap_CloseTemporaryStreams(); Yap_CloseTemporaryStreams();
Yap_CloseSlots(sls); 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) { if (B == NULL || B->cp_b == NULL ||
LOCAL_RestartEnv = sighold; (CELL *)(B->cp_b) > LCL0 - LOCAL_CBorder) {
LOCAL_CBorder = OldBorder; LOCAL_RestartEnv = sighold;
return false; LOCAL_CBorder = OldBorder;
return false;
} }
P = FAILCODE; 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) { bool Yap_exec_absmi(bool top, yap_reset_t has_reset) {
CACHE_REGS 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 * Fails computation up to choice-point bb
* *
* @param USES_REGS thread support * @param USES_REGS thread support
*/ */
void Yap_fail_all(choiceptr bb USES_REGS) { 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) { bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
CACHE_REGS CACHE_REGS
Prop pe; Prop pe;
PredEntry *ppe; PredEntry *ppe;
CELL *pt; CELL *pt;
/* preserve the current restart environment */ /* 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) { void Yap_trust_last(void) {
CACHE_REGS CACHE_REGS
ASP = B->cp_env; ASP = B->cp_env;
CP = B->cp_cp; CP = B->cp_cp;
HR = B->cp_h; HR = B->cp_h;
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
@ -1797,7 +1791,7 @@ void Yap_trust_last(void) {
Term Yap_RunTopGoal(Term t, bool handle_errors) { Term Yap_RunTopGoal(Term t, bool handle_errors) {
CACHE_REGS CACHE_REGS
yamop *CodeAdr; yamop *CodeAdr;
Prop pe; Prop pe;
PredEntry *ppe; PredEntry *ppe;
CELL *pt; CELL *pt;
@ -1811,11 +1805,12 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
Yap_Error(INSTANTIATION_ERROR, t, "call/1"); Yap_Error(INSTANTIATION_ERROR, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode; LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE); return (FALSE);
} if (IsPairTerm(t)) { }
if (IsPairTerm(t)) {
Term ts[2]; Term ts[2];
ts[0] = t; ts[0] = t;
ts[1] = (CurrentModule == 0? TermProlog: CurrentModule); ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
t = Yap_MkApplTerm(FunctorCsult,2,ts); t = Yap_MkApplTerm(FunctorCsult, 2, ts);
} }
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(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) { bool Yap_Reset(yap_reset_t mode, bool hard) {
CACHE_REGS CACHE_REGS
int res = TRUE; int res = TRUE;
Yap_ResetException(worker_id); Yap_ResetException(worker_id);
/* first, backtrack to the root */ /* first, backtrack to the root */
@ -2082,12 +2077,9 @@ static Int JumpToEnv(USES_REGS1) {
so get pointers here */ so get pointers here */
/* find the first choicepoint that may be a catch */ /* find the first choicepoint that may be a catch */
// DBTerm *dbt = Yap_RefToException(); // DBTerm *dbt = Yap_RefToException();
while (handler while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch &&
&& Yap_PredForChoicePt(handler, NULL) != PredDollarCatch LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE &&
&& LOCAL_CBorder < LCL0 - (CELL *)handler handler->cp_b != NULL) {
&& handler->cp_ap != NOCODE
&& handler->cp_b != NULL
) {
handler->cp_ap = TRUSTFAILCODE; handler->cp_ap = TRUSTFAILCODE;
handler = handler->cp_b; handler = handler->cp_b;
} }
@ -2102,8 +2094,8 @@ static Int JumpToEnv(USES_REGS1) {
bool Yap_JumpToEnv(void) { bool Yap_JumpToEnv(void) {
CACHE_REGS CACHE_REGS
if (LOCAL_PrologMode & TopGoalMode) if (LOCAL_PrologMode & TopGoalMode)
return true; return true;
return JumpToEnv(PASS_REGS1); return JumpToEnv(PASS_REGS1);
} }
@ -2111,10 +2103,11 @@ bool Yap_JumpToEnv(void) {
static Int jump_env(USES_REGS1) { static Int jump_env(USES_REGS1) {
Term t = Deref(ARG1), t0 = t; Term t = Deref(ARG1), t0 = t;
if (IsVarTerm(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); // Yap_DebugPlWriteln(t);
LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError); LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError);
bool out = JumpToEnv(PASS_REGS1); bool out = JumpToEnv(PASS_REGS1);
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE && if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
LCL0 - (CELL *)B > LOCAL_CBorder) { LCL0 - (CELL *)B > LOCAL_CBorder) {
@ -2149,11 +2142,11 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#endif #endif
#endif /* PUSH_REGS */ #endif /* PUSH_REGS */
CACHE_REGS CACHE_REGS
Yap_ResetException(LOCAL_ActiveError); Yap_ResetException(LOCAL_ActiveError);
Yap_PutValue(AtomBreak, MkIntTerm(0)); Yap_PutValue(AtomBreak, MkIntTerm(0));
TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
HR = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id)) + HR = H0 = ((CELL *)REMOTE_GlobalBase(myworker_id)) +
1; // +1: hack to ensure the gc does not try to mark mistakenly 1; // +1: hack to ensure the gc does not try to mark mistakenly
LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id); LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id);
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap); CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap);
/* notice that an initial choice-point and environment /* notice that an initial choice-point and environment
@ -2166,12 +2159,12 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#endif #endif
STATIC_PREDICATES_MARKED = FALSE; STATIC_PREDICATES_MARKED = FALSE;
if (full_reset) { if (full_reset) {
HR = H0+1; HR = H0 + 1;
h0var = MkVarTerm(); h0var = MkVarTerm();
REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var); REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var);
REMOTE_GcCurrentPhase(myworker_id) = 0L; REMOTE_GcCurrentPhase(myworker_id) = 0L;
REMOTE_GcPhase(myworker_id) = REMOTE_GcPhase(myworker_id) =
Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id))); Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id)));
#if COROUTINING #if COROUTINING
REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil); REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil);
h0var = MkVarTerm(); h0var = MkVarTerm();
@ -2187,7 +2180,7 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
BSEG = BSEG =
#endif /* YAPOR_SBA */ #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); TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
@ -2209,7 +2202,7 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
BSEG = BSEG =
#endif /* YAPOR_SBA */ #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); TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
@ -2246,7 +2239,7 @@ int Yap_dogc(int extra_args, Term *tp USES_REGS) {
void Yap_InitExecFs(void) { void Yap_InitExecFs(void) {
CACHE_REGS CACHE_REGS
YAP_opaque_handler_t catcher_ops; YAP_opaque_handler_t catcher_ops;
memset(&catcher_ops, 0, sizeof(catcher_ops)); memset(&catcher_ops, 0, sizeof(catcher_ops));
catcher_ops.cut_handler = watch_cut; catcher_ops.cut_handler = watch_cut;
catcher_ops.fail_handler = watch_retry; catcher_ops.fail_handler = watch_retry;
@ -2296,17 +2289,18 @@ void Yap_InitExecFs(void) {
Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag); Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag);
CurrentModule = cm; CurrentModule = cm;
Yap_InitCPred("$restore_regs", 1, restore_regs, Yap_InitCPred("$restore_regs", 1, restore_regs,
NoTracePredFlag | SafePredFlag); NoTracePredFlag | SafePredFlag);
Yap_InitCPred("$restore_regs", 2, restore_regs2,NoTracePredFlag | SafePredFlag); Yap_InitCPred("$restore_regs", 2, restore_regs2,
NoTracePredFlag | SafePredFlag);
Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag); Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag);
Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction, Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction,
SafePredFlag); SafePredFlag);
Yap_InitCPred("throw", 1, jump_env, 0); Yap_InitCPred("throw", 1, jump_env, 0);
Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0); Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0);
Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0); Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0);
Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0); Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0);
Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup, 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("$cleanup_on_exit", 2, cleanup_on_exit, NoTracePredFlag);
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0); 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; prolog_flag_property_choices_t i;
bool rc = true; bool rc = true;
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs, args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END); PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) { if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL); Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false; return false;
@ -1612,7 +1612,7 @@ static Int do_create_prolog_flag(USES_REGS1) {
Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3); Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3);
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs, args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END); PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) { if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL); Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false; 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 *); 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)) ((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ))
static PredEntry *get_pred(Term t, Term tmod, char *pname) { static PredEntry *get_pred(Term t, Term tmod, char *pname) {
Term t0 = t; Term t0 = t;
restart: restart:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname); Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL; 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 */ /* check first environments that are younger than our latest choicepoint */
if (check_everything && env_ptr) { if (check_everything && env_ptr) {
/* /*
I do not need to check environments for asserts, I do not need to check environments for asserts,
only for retracts only for retracts
*/ */
while (env_ptr && b_ptr > (choiceptr)env_ptr) { while (env_ptr && b_ptr > (choiceptr)env_ptr) {
yamop *cp = (yamop *)env_ptr[E_CP]; yamop *cp = (yamop *)env_ptr[E_CP];
@ -286,8 +286,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
if (b_ptr) { if (b_ptr) {
pe = PredForChoicePt(b_ptr->cp_ap, NULL); pe = PredForChoicePt(b_ptr->cp_ap, NULL);
} } else
else
return false; return false;
if (pe == p) { if (pe == p) {
if (check_everything) 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 CACHE_REGS
if (pp->PredFlags & LogUpdatePredFlag) { 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) { static Term clause_loc(void *clcode, PredEntry *pp) {
CACHE_REGS CACHE_REGS
if (pp->PredFlags & LogUpdatePredFlag) { if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = clcode; LogUpdClause *cl = clcode;
if (cl->ClFlags & FactMask) { if (cl->ClFlags & FactMask) {
return MkIntegerTerm(cl->lusl.ClLine); 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);
} else { } else {
StaticClause *cl; return MkIntegerTerm(cl->lusl.ClSource->ag.line_number);
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);
} }
} 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); 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 & IndexedPredFlag) {
if (pp->PredFlags & LogUpdatePredFlag) { if (pp->PredFlags & LogUpdatePredFlag) {
if (code_in_pred_lu_index( if (code_in_pred_lu_index(
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
startp, endp)) { startp, endp)) {
UNLOCK(pp->PELock); UNLOCK(pp->PELock);
return TRUE; return TRUE;
} }
} else { } else {
if (code_in_pred_s_index( if (code_in_pred_s_index(
ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
startp, endp)) { startp, endp)) {
UNLOCK(pp->PELock); UNLOCK(pp->PELock);
return TRUE; return TRUE;
} }
@ -659,16 +659,16 @@ static Int code_in_pred(PredEntry *pp, Atom *pat, UInt *parity,
if (pp->PredFlags & IndexedPredFlag) { if (pp->PredFlags & IndexedPredFlag) {
if (pp->PredFlags & LogUpdatePredFlag) { if (pp->PredFlags & LogUpdatePredFlag) {
if (code_in_pred_lu_index( if (code_in_pred_lu_index(
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
NULL, NULL)) { NULL, NULL)) {
code_in_pred_info(pp, pat, parity); code_in_pred_info(pp, pat, parity);
UNLOCK(pp->PELock); UNLOCK(pp->PELock);
return -1; return -1;
} }
} else { } else {
if (code_in_pred_s_index( if (code_in_pred_s_index(
ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
NULL, NULL)) { NULL, NULL)) {
code_in_pred_info(pp, pat, parity); code_in_pred_info(pp, pat, parity);
UNLOCK(pp->PELock); UNLOCK(pp->PELock);
return -1; return -1;
@ -821,8 +821,8 @@ static PredEntry *found_owner_op(yamop *pc, void **startp,
static PredEntry *found_expand(yamop *pc, void **startp, static PredEntry *found_expand(yamop *pc, void **startp,
void **endp USES_REGS) { void **endp USES_REGS) {
PredEntry *pp = PredEntry *pp =
((PredEntry *)(Unsigned(pc) - ((PredEntry *)(Unsigned(pc) -
(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode)))); (CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode))));
*startp = (CODEADDR) & (pp->cs.p_code.ExpandCode); *startp = (CODEADDR) & (pp->cs.p_code.ExpandCode);
*endp = (CODEADDR)NEXTOP((yamop *)&(pp->cs.p_code.ExpandCode), e); *endp = (CODEADDR)NEXTOP((yamop *)&(pp->cs.p_code.ExpandCode), e);
return pp; return pp;
@ -898,19 +898,19 @@ static PredEntry *ClauseInfoForCode(yamop *codeptr, void **startp,
PredEntry *Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from, PredEntry *Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from,
void **startp, void **endp) { void **startp, void **endp) {
CACHE_REGS CACHE_REGS
if (where_from == FIND_PRED_FROM_CP) { if (where_from == FIND_PRED_FROM_CP) {
PredEntry *pp = PredForChoicePt(codeptr, NULL); PredEntry *pp = PredForChoicePt(codeptr, NULL);
if (cl_code_in_pred(pp, codeptr, startp, endp)) { if (cl_code_in_pred(pp, codeptr, startp, endp)) {
return pp; 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);
} }
} 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; return NULL;
} }
@ -1097,7 +1097,7 @@ static Int p_all_envs(USES_REGS1) {
static Term clause_info(yamop *codeptr, PredEntry *pp) { static Term clause_info(yamop *codeptr, PredEntry *pp) {
CACHE_REGS CACHE_REGS
Term ts[2]; Term ts[2];
void *begin; void *begin;
if (pp->ArityOfPE == 0) { if (pp->ArityOfPE == 0) {
@ -1121,22 +1121,21 @@ static Term clause_info(yamop *codeptr, PredEntry *pp) {
return Yap_MkApplTerm(FunctorModule, 2, ts); 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 CACHE_REGS
Term ts[2]; Term ts[2];
void *begin; void *begin;
if (pp->ArityOfPE == 0) { if (pp->ArityOfPE == 0) {
t->prologPredName = t->prologPredName = AtomName((Atom)pp->FunctorOfPred);
AtomName((Atom)pp->FunctorOfPred);
t->prologPredArity = 0; t->prologPredArity = 0;
} else { } else {
t->prologPredName = t->prologPredName = AtomName(NameOfFunctor(pp->FunctorOfPred));
AtomName(NameOfFunctor(pp->FunctorOfPred));
t->prologPredArity = pp->ArityOfPE; t->prologPredArity = pp->ArityOfPE;
} }
t->prologPredModule = t->prologPredModule =
(pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE (pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE
: "prolog"); : "prolog");
t->prologPredFile = RepAtom(pp->src.OwnerFile)->StrOfAE; t->prologPredFile = RepAtom(pp->src.OwnerFile)->StrOfAE;
if (codeptr->opc == UNDEF_OPCODE) { if (codeptr->opc == UNDEF_OPCODE) {
t->prologPredFirstLine = 0; t->prologPredFirstLine = 0;
@ -1144,25 +1143,25 @@ yap_error_descriptor_t * set_clause_info(yap_error_descriptor_t *t, yamop *cod
t->prologPredLastLine = 0; t->prologPredLastLine = 0;
return t; return t;
} else if (pp->cs.p_code.NOfClauses) { } else if (pp->cs.p_code.NOfClauses) {
if ((t->prologPredCl = if ((t->prologPredCl = find_code_in_clause(pp, codeptr, &begin, NULL)) <=
find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) { 0) {
t->prologPredLine = 0; t->prologPredLine = 0;
} else { } else {
t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp)); t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
} }
if (pp->PredFlags & LogUpdatePredFlag) { if (pp->PredFlags & LogUpdatePredFlag) {
t->prologPredFirstLine = clause_loc( t->prologPredFirstLine =
ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp); clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp);
t->prologPredLastLine = clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause), t->prologPredLastLine =
pp); clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause), pp);
} else { } else {
t->prologPredFirstLine = IntegerOfTerm( t->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc( ts[0] = clause_loc(
ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp)); ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp));
t->prologPredLastLine = IntegerOfTerm( t->prologPredLastLine = IntegerOfTerm(
ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause), ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause),
pp)); pp));
} }
return t; return t;
} else { } else {
@ -1198,7 +1197,8 @@ static Term error_culprit(bool internal USES_REGS) {
return TermNil; 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; PredEntry *pe;
void *startp, *endp; void *startp, *endp;
// case number 1: Yap_Error called from built-in. // 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); PredEntry *pe = EnvPreg(curCP);
while (curCP != YESCODE) { while (curCP != YESCODE) {
if (curENV ) { if (curENV) {
pe = EnvPreg(curCP); pe = EnvPreg(curCP);
curENV = (CELL *)(curENV[E_E]); curENV = (CELL *)(curENV[E_E]);
if (curENV < ASP || curENV >= LCL0) { if (curENV < ASP || curENV >= LCL0) {
break; break;
} }
curCP = (yamop *)curENV[E_CP]; curCP = (yamop *)curENV[E_CP];
if (pe == NULL) { if (pe == NULL) {
pe = PredMetaCall; pe = PredMetaCall;
} }
if (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag)) if (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag))
return set_clause_info(t, curCP, pe); return set_clause_info(t, curCP, pe);
curCP = (yamop *)(curENV[E_CP]); curCP = (yamop *)(curENV[E_CP]);
} else if (0) { } else if (0) {
if ( curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE if (curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE &&
&& curB->cp_ap != FAILCODE) { curB->cp_ap != FAILCODE) {
pe = curB->cp_ap->y_u.Otapl.p; pe = curB->cp_ap->y_u.Otapl.p;
if (pe && (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag))) if (pe && (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag)))
return set_clause_info(t, curB->cp_ap, pe); return set_clause_info(t, curB->cp_ap, pe);
} }
curB = curB->cp_b; curB = curB->cp_b;
} }
} }
} }
return NULL; return NULL;
} }
static Term all_calls(bool internal USES_REGS) { 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); return Yap_MkApplTerm(f, 6, ts);
} }
Term Yap_all_calls(void) { Term Yap_all_calls(void) {
CACHE_REGS 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) { while (pp != NULL) {
/* if (pp->ArityOfPE) { /* if (pp->ArityOfPE) {
fprintf(stderr,"%s/%d %p\n", fprintf(stderr,"\%s/%d %p\n",
RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE, RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE,
pp->ArityOfPE, pp->ArityOfPE,
pp); pp);
} else { } else {
fprintf(stderr,"%s %p\n", fprintf(stderr,"\%s %p\n",
RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE, RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE,
pp); pp);
}*/ }*/
add_code_in_pred(pp); add_code_in_pred(pp);
pp = pp->NextPredOfModule; pp = pp->NextPredOfModule;
} }
me = me->NextME; me = me->NextME;
} }
Yap_inform_profiler_of_clause( Yap_inform_profiler_of_clause(
COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)), COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)),
GPROF_INIT_COMMA); GPROF_INIT_COMMA);
Yap_inform_profiler_of_clause(FAILCODE, FAILCODE + 1, Yap_inform_profiler_of_clause(FAILCODE, FAILCODE + 1,
RepPredProp(Yap_GetPredPropByAtom(AtomFail, 0)), RepPredProp(Yap_GetPredPropByAtom(AtomFail, 0)),
GPROF_INIT_FAIL); GPROF_INIT_FAIL);
@ -1441,7 +1440,7 @@ static Int program_continuation(USES_REGS1) {
static Term BuildActivePred(PredEntry *ap, CELL *vect) { static Term BuildActivePred(PredEntry *ap, CELL *vect) {
CACHE_REGS CACHE_REGS
arity_t i; arity_t i;
if (!ap->ArityOfPE) { if (!ap->ArityOfPE) {
return MkAtomTerm((Atom)ap->FunctorOfPred); 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) && return Yap_unify(XREGS[start_arg], tmod) &&
Yap_unify(XREGS[start_arg + 1], tname) && Yap_unify(XREGS[start_arg + 1], tname) &&
Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity)); Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity));
} }
static Int ClauseId(yamop *ipc, PredEntry *pe) { 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; */ /* pe = PREVOP(env_cp,Osbpp)->y_u.Osbpp.p0; */
taddr = MkIntegerTerm((Int)env); taddr = MkIntegerTerm((Int)env);
return Yap_unify(ARG3, MkIntegerTerm((Int)env_cp)) && 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) { 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; pe = PREVOP(ipc, Osbpp)->y_u.Osbpp.p0;
return UnifyPredInfo(pe, 2 PASS_REGS) && 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) { static Int p_choicepoint_info(USES_REGS1) {
@ -1562,10 +1561,10 @@ static Int p_choicepoint_info(USES_REGS1) {
t = MkVarTerm(); t = MkVarTerm();
} else } else
#endif /* DETERMINISTIC_TABLING */ #endif /* DETERMINISTIC_TABLING */
{ {
pe = GEN_CP(cptr)->cp_pred_entry; pe = GEN_CP(cptr)->cp_pred_entry;
t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1)); t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1));
} }
#else #else
pe = UndefCode; pe = UndefCode;
t = MkVarTerm(); t = MkVarTerm();
@ -1701,8 +1700,8 @@ static Int p_choicepoint_info(USES_REGS1) {
} }
} }
return UnifyPredInfo(pe, 3 PASS_REGS) && Yap_unify(ARG2, taddr) && return UnifyPredInfo(pe, 3 PASS_REGS) && Yap_unify(ARG2, taddr) &&
Yap_unify(ARG6, t) && Yap_unify(ARG6, t) &&
Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe))); Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe)));
} }
static Int /* $parent_pred(Module, Name, Arity) */ static Int /* $parent_pred(Module, Name, Arity) */
@ -1714,11 +1713,11 @@ parent_pred(USES_REGS1) {
Term module; Term module;
if (!PredForCode(P_before_spy, &at, &arity, &module, NULL)) { if (!PredForCode(P_before_spy, &at, &arity, &module, NULL)) {
return Yap_unify(ARG1, MkIntTerm(0)) && return Yap_unify(ARG1, MkIntTerm(0)) &&
Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) && Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) &&
Yap_unify(ARG3, MkIntTerm(0)); Yap_unify(ARG3, MkIntTerm(0));
} }
return Yap_unify(ARG1, MkIntTerm(module)) && 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); void Yap_dump_stack(void);
@ -1729,7 +1728,7 @@ static int hidden(Atom);
static int legal_env(CELL *CACHE_TYPE); static int legal_env(CELL *CACHE_TYPE);
#define ONLOCAL(ptr) \ #define ONLOCAL(ptr) \
(CellPtr(ptr) > CellPtr(HR) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase)) (CellPtr(ptr) > CellPtr(HR) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase))
static int hidden(Atom at) { static int hidden(Atom at) {
@ -1788,7 +1787,7 @@ static bool handled_exception(USES_REGS1) {
void Yap_dump_stack(void) { void Yap_dump_stack(void) {
CACHE_REGS CACHE_REGS
choiceptr b_ptr = B; choiceptr b_ptr = B;
CELL *env_ptr = ENV; CELL *env_ptr = ENV;
char tp[256]; char tp[256];
yamop *ipc = CP; yamop *ipc = CP;
@ -1797,23 +1796,83 @@ void Yap_dump_stack(void) {
/* check if handled */ /* check if handled */
if (handled_exception(PASS_REGS1)) if (handled_exception(PASS_REGS1))
return; return;
#if DEBUG #if DEBU
fprintf(stderr, "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n", fprintf(stderr, "\% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",
P, CP, ASP, HR, TR, HeapTop); 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 #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) { 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); HR, ASP);
} else if (HeapTop > (ADDR)LOCAL_GlobalBase) { } else if (HeapTop > (ADDR)LOCAL_GlobalBase) {
fprintf(stderr, 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); HeapTop, LOCAL_GlobalBase);
} else { } else {
#if !USE_SYSTEM_MALLOC #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, (long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase,
HeapTop); HeapTop);
#if USE_DL_MALLOC #if USE_DL_MALLOC
@ -1826,18 +1885,14 @@ void Yap_dump_stack(void) {
} }
#endif #endif
#endif #endif
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, 256); fprintf(stderr, "\% %luKB of Global Stack (%p--%p)\n",
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",
(unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR); (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); (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, (unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024,
LOCAL_TrailBase, TR); LOCAL_TrailBase, TR);
fprintf(stderr, "%% Performed %ld garbage collections\n", fprintf(stderr, "\% Performed %ld garbage collections\n",
(unsigned long int)LOCAL_GcCalls); (unsigned long int)LOCAL_GcCalls);
#if LOW_LEVEL_TRACER #if LOW_LEVEL_TRACER
{ {
@ -1852,20 +1907,20 @@ void Yap_dump_stack(void) {
} }
} }
#endif #endif
fprintf(stderr, "%% All Active Calls and\n"); fprintf(stderr, "\% All Active Calls and\n");
fprintf(stderr, "%% Goals With Alternatives Open (Global In " fprintf(stderr, "\% Goals With Alternatives Open (Global In "
"Use--Local In Use)\n%%\n"); "Use--Local In Use)\n%%\n");
while (b_ptr != NULL) { while (b_ptr != NULL) {
while (env_ptr && env_ptr <= (CELL *)b_ptr) { while (env_ptr && env_ptr <= (CELL *)b_ptr) {
Yap_detect_bug_location(ipc, FIND_PRED_FROM_ENV, 256); Yap_detect_bug_location(ipc, FIND_PRED_FROM_ENV, 256);
if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) { if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) {
b_ptr = b_ptr->cp_b; b_ptr = b_ptr->cp_b;
fprintf(stderr, "%% %s\n", tp); fprintf(stderr, "\% %s\n", tp);
} else { } else {
fprintf(stderr, "%% %s\n", tp); fprintf(stderr, "%% %s\n", tp);
} }
if (!max_count--) { if (!max_count--) {
fprintf(stderr, "%% .....\n"); fprintf(stderr, "\% .....\n");
return; return;
} }
ipc = (yamop *)(env_ptr[E_CP]); ipc = (yamop *)(env_ptr[E_CP]);
@ -1873,7 +1928,7 @@ void Yap_dump_stack(void) {
} }
if (b_ptr) { if (b_ptr) {
if (!max_count--) { if (!max_count--) {
fprintf(stderr, "%% .....\n"); fprintf(stderr, "\%\** .....\n");
return; return;
} }
if (b_ptr->cp_ap && /* tabling */ if (b_ptr->cp_ap && /* tabling */
@ -1882,7 +1937,7 @@ void Yap_dump_stack(void) {
b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) { b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) {
/* we can safely ignore ; because there is always an upper env */ /* we can safely ignore ; because there is always an upper env */
Yap_detect_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256); 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)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024),
(unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024); (unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024);
} }
@ -1947,7 +2002,7 @@ void DumpActiveGoals(USES_REGS1) {
op_numbers opnum; op_numbers opnum;
if (!ONLOCAL(b_ptr) || b_ptr->cp_b == NULL) if (!ONLOCAL(b_ptr) || b_ptr->cp_b == NULL)
break; break;
fprintf(stderr, "%p ", b_ptr); fprintf(stderr, "\%p ", b_ptr);
pe = Yap_PredForChoicePt(b_ptr, &opnum); pe = Yap_PredForChoicePt(b_ptr, &opnum);
if (opnum == _Nstop) { if (opnum == _Nstop) {
fprintf(stderr, " ********** C-Code Interface Boundary ***********\n"); 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, if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity,
&pred_module)) == 0) { &pred_module)) == 0) {
/* system predicate */ /* system predicate */
fprintf(stderr, "%s", "meta-call"); fprintf(stderr, "\%s", "meta-call");
} else if (pred_module == 0) { } else if (pred_module == 0) {
fprintf(stderr, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE, fprintf(stderr, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE,
(unsigned long int)pred_arity); (unsigned long int)pred_arity);
} else if (cl < 0) { } 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); RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity);
} else { } else {
fprintf(stderr, "%s:%s/%lu at clause %lu", fprintf(stderr, "\%s:%s/%lu at clause %lu",
RepAtom(AtomOfTerm(pred_module))->StrOfAE, RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity, RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity,
(unsigned long int)cl); (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 CACHE_REGS
if (pe->ModuleOfPred == PROLOG_MODULE) if (pe->ModuleOfPred == PROLOG_MODULE)
p->prologPredModule = AtomName(AtomProlog); p->prologPredModule = AtomName(AtomProlog);
else else
p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred)); p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred));
if (pe->ArityOfPE) if (pe->ArityOfPE)
p->prologPredName = AtomName(NameOfFunctor(pe->FunctorOfPred)); p->prologPredName = AtomName(NameOfFunctor(pe->FunctorOfPred));
else else
p->prologPredName = AtomName((Atom)(pe->FunctorOfPred)); p->prologPredName = AtomName((Atom)(pe->FunctorOfPred));
p->prologPredArity = pe->ArityOfPE; p->prologPredArity = pe->ArityOfPE;
p->prologPredFile = AtomName( pe->src.OwnerFile ); p->prologPredFile = AtomName(pe->src.OwnerFile);
p->prologPredLine = 0; p->prologPredLine = 0;
if (pe->src.OwnerFile) { if (pe->src.OwnerFile) {
if (pe->PredFlags & MegaClausePredFlag) { 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; p->prologPredLine = 0;
} }
} }
} } else if (pe->OpcodeOfPred == UNDEF_OPCODE) {
else if (pe->OpcodeOfPred == UNDEF_OPCODE) {
p->prologPredFile = "undefined"; p->prologPredFile = "undefined";
} } else {
else {
// by default, user_input // by default, user_input
p->prologPredFile = AtomName( AtomUserIn ); p->prologPredFile = AtomName(AtomUserIn);
p->prologPredLine = 0; p->prologPredLine = 0;
} }
return p; 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 CACHE_REGS
yamop *xc = pc0; yamop *xc = pc0;
// choiceptr b_ptr = b_ptr0; // choiceptr b_ptr = b_ptr0;
//CELL *env = env0; // CELL *env = env0;
PredEntry *pe; PredEntry *pe;
if (PP == NULL) { 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 if (pe != NULL
// pe->ModuleOfPred != PROLOG_MODULE && // pe->ModuleOfPred != PROLOG_MODULE &&
// &&!(pe->PredFlags & HiddenPredFlag) // &&!(pe->PredFlags & HiddenPredFlag)
) { ) {
return add_bug_location(t, xc, pe); return add_bug_location(t, xc, pe);
} }
return NULL; 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; yamop *cp = cp0;
choiceptr b_ptr = b_ptr0; choiceptr b_ptr = b_ptr0;
CELL *env = env0; 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) if (pe == PredTrue)
return NULL; return NULL;
if (ignore_first <= 0 && if (ignore_first <= 0 &&
pe pe
// pe->ModuleOfPred != PROLOG_MODULE &&s // pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) { && !(pe->PredFlags & HiddenPredFlag)) {
return add_bug_location(t, cp, pe); return add_bug_location(t, cp, pe);
} else { } else {
if (NULL && b_ptr && b_ptr->cp_env < env) { if (NULL && b_ptr && b_ptr->cp_env < env) {
cp = b_ptr->cp_cp; cp = b_ptr->cp_cp;
env = b_ptr->cp_env; env = b_ptr->cp_env;
b_ptr = b_ptr->cp_b; b_ptr = b_ptr->cp_b;
} else { } else {
cp = (yamop *)env[E_CP]; cp = (yamop *)env[E_CP];
env = ENV_Parent(env); env = ENV_Parent(env);
} }
ignore_first--; 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) { Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first)
while (true) { { while (true) { if (b_ptr == NULL || env == NULL) return TermNil; PredEntry
if (b_ptr == NULL || env == NULL) *pe = EnvPreg(cp); if (pe == PredTrue) return TermNil; if (ignore_first <= 0
return TermNil; && pe
PredEntry *pe = EnvPreg(cp);
if (pe == PredTrue)
return TermNil;
if (ignore_first <= 0 &&
pe
// pe->ModuleOfPred != PROLOG_MODULE &&s // pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) { && !(pe->PredFlags & HiddenPredFlag)) {
return add_bug_location(cp, pe); 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) static Term mkloc(yap_error_descriptor_t *t) { return TermNil; }
{
return TermNil;
}
static Int clause_location(USES_REGS1) { static Int clause_location(USES_REGS1) {
yap_error_descriptor_t t; yap_error_descriptor_t t;
memset( &t, 0, sizeof(yap_error_descriptor_t)); memset(&t, 0, sizeof(yap_error_descriptor_t));
return Yap_unify(mkloc(Yap_pc_add_location(&t,P, B, ENV)), ARG1) && 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); Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 1)), ARG2);
} }
static Int ancestor_location(USES_REGS1) { static Int ancestor_location(USES_REGS1) {
yap_error_descriptor_t t; yap_error_descriptor_t t;
memset( &t, 0, sizeof(yap_error_descriptor_t)); memset(&t, 0, sizeof(yap_error_descriptor_t));
return 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, 2)), ARG2) && Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 3)), ARG2);
Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 3)), ARG2);
} }
void Yap_InitStInfo(void) { void Yap_InitStInfo(void) {
CACHE_REGS CACHE_REGS
Term cm = CurrentModule; Term cm = CurrentModule;
Yap_InitCPred("in_use", 2, in_use, Yap_InitCPred("in_use", 2, in_use,
HiddenPredFlag | TestPredFlag | SafePredFlag | SyncPredFlag); HiddenPredFlag | TestPredFlag | SafePredFlag | SyncPredFlag);

2
C/stackinfo.c
View File

@ -26,7 +26,7 @@
* @brief Get to know what is in your stack. * @brief Get to know what is in your stack.
* *
* *
*/ ` */
#include "Yap.h" #include "Yap.h"
#include "clause.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; LOCAL_ActiveError->errorRawTerm = inp->val.t;
} }
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
pop_text_stack(lvl); pop_text_stack(lvl);
return NULL; return NULL;
} }
@ -485,20 +485,20 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
(YAP_STRING_CODES | YAP_STRING_ATOMS)) && (YAP_STRING_CODES | YAP_STRING_ATOMS)) &&
IsPairOrNilTerm(inp->val.t)) { IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(lvl, return pop_output_text_stack(
Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS) ); lvl, Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide // this is a term, extract to a sfer, and representation is wide
} }
if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) { if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(lvl, return pop_output_text_stack(
Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS)); lvl, Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide // this is a term, extract to a sfer, and representation is wide
} }
if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) { if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t); // Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(lvl, return pop_output_text_stack(
Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS)); lvl, Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a buffer, and representation is wide // this is a term, extract to a buffer, and representation is wide
} }
if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) { 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; utf8proc_int32_t chr;
int off = get_utf8(cp, -1, &chr); int off = get_utf8(cp, -1, &chr);
if (off <= 0 || chr > 255) { if (off <= 0 || chr > 255) {
pop_text_stack(l); pop_text_stack(l);
return NULL; return NULL;
} }
if (off == max) if (off == max)
break; 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) { static Term string_to_term(void *s, seq_tv_t *out USES_REGS) {
Term o; Term o;
yap_error_descriptor_t new_error; yap_error_descriptor_t *new_error = malloc(sizeof(yap_error_descriptor_t));
bool mdnew = Yap_pushErrorContext(true, &new_error); bool mdnew = Yap_pushErrorContext(true, new_error);
o = out->val.t = Yap_BufferToTerm(s, TermNil); o = out->val.t = Yap_BufferToTerm(s, TermNil);
Yap_popErrorContext(mdnew, true); 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; void **bufv;
unsigned char *buf; unsigned char *buf;
int i, j; int i, j;
//int lvl = push_text_stack(); // int lvl = push_text_stack();
bufv = Malloc(tot * sizeof(unsigned char *)); bufv = Malloc(tot * sizeof(unsigned char *));
if (!bufv) { if (!bufv) {
//pop_text_stack(lvl); // pop_text_stack(lvl);
return NULL; return NULL;
} }
for (i = 0, j = 0; i < tot; i++) { 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); unsigned char *nbuf = Yap_readText(inp + i PASS_REGS);
if (!nbuf) { if (!nbuf) {
//pop_text_stack(lvl); // pop_text_stack(lvl);
return NULL; return NULL;
} }
// if (!nbuf[0]) // 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); buf = concat(tot, bufv PASS_REGS);
} }
bool rc = write_Text(buf, out PASS_REGS); bool rc = write_Text(buf, out PASS_REGS);
//pop_text_stack( lvl ); // pop_text_stack( lvl );
return rc; 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) if (i > 0 && cuts[i] == 0)
break; break;
void *bufi = slice(next, cuts[i], buf PASS_REGS); 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)) { if (!write_Text(bufi, outv + i PASS_REGS)) {
return false; 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; wglb->Portray_delays = FALSE;
if (ext == attvars_ext) { if (ext == attvars_ext) {
yhandle_t h = Yap_InitHandle((CELL)t); yhandle_t h = Yap_InitHandle((CELL)t);
attvar_record *attv = RepAttVar(t); attvar_record *attv = RepAttVar(t);
CELL *l = &attv->Value; /* dirty low-level hack, check atts.h */ 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); l = restore_from_write(&nrwt, wglb);
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
attv = RepAttVar((CELL *)Yap_GetFromHandle(h)); attv = RepAttVar((CELL *)Yap_GetFromHandle(h));
l = &attv->Value;; l = &attv->Value;
;
l++; l++;
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
@ -1208,10 +1209,10 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
{ {
CACHE_REGS CACHE_REGS
struct write_globs wglb; struct write_globs wglb;
struct rewind_term rwt; struct rewind_term rwt;
yhandle_t sls = Yap_CurrentSlot(); yhandle_t sls = Yap_CurrentSlot();
int lvl = push_text_stack(); int lvl = push_text_stack();
if (t == 0) if (t == 0)
return; return;
if (!mywrite) { if (!mywrite) {
@ -1258,13 +1259,13 @@ char *Yap_TermToBuffer(Term t, encoding_t enc, int flags) {
CACHE_REGS CACHE_REGS
int sno = Yap_open_buf_write_stream(enc, flags); int sno = Yap_open_buf_write_stream(enc, flags);
const char *sf; const char *sf;
if (sno < 0) if (sno < 0)
return NULL; return NULL;
if (t == 0) if (t == 0)
return NULL; return NULL;
else else
t = Deref(t); t = Deref(t);
if (enc) if (enc)
GLOBAL_Stream[sno].encoding = enc; GLOBAL_Stream[sno].encoding = enc;
else 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 START_GLOBAL_FLAGS enum GLOBAL_FLAGS {
#define END_GLOBAL_FLAGS }; #define END_GLOBAL_FLAGS };
/* */ /* */
#include "YapGFlagInfo.h" #include "YapGFlagInfo.h"
/* Local flags */ /* Local flags */
#include "YapLFlagInfo.h" #include "YapLFlagInfo.h"
#ifndef DOXYGEN #ifndef DOXYGEN
@ -388,10 +388,20 @@ Term Yap_UnknownFlag(Term mod);
bool rmdot(Term inp); 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 #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_ARRAY_TYPE, DOMAIN_ERROR, "array_type")
E(DOMAIN_ERROR_CLOSE_OPTION, DOMAIN_ERROR, "close_option") E(DOMAIN_ERROR_CLOSE_OPTION, DOMAIN_ERROR, "close_option")
E(DOMAIN_ERROR_ENCODING, DOMAIN_ERROR, "encoding") 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_ERRORS, DOMAIN_ERROR, "file_errors")
E(DOMAIN_ERROR_FILE_TYPE, DOMAIN_ERROR, "file_type") E(DOMAIN_ERROR_FILE_TYPE, DOMAIN_ERROR, "file_type")
E(DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE, DOMAIN_ERROR, "format argument " 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_INTERNAL, SYSTEM_ERROR_CLASS, "internal")
E(SYSTEM_ERROR_COMPILER, SYSTEM_ERROR_CLASS, "compiler") E(SYSTEM_ERROR_COMPILER, SYSTEM_ERROR_CLASS, "compiler")
E(SYSTEM_ERROR_FATAL, SYSTEM_ERROR_CLASS, "fatal") 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_JIT_NOT_AVAILABLE, SYSTEM_ERROR_CLASS, "jit_not_available")
E(SYSTEM_ERROR_OPERATING_SYSTEM, SYSTEM_ERROR_CLASS, "operating_system_error") E(SYSTEM_ERROR_OPERATING_SYSTEM, SYSTEM_ERROR_CLASS, "operating_system_error")
E(SYSTEM_ERROR_SAVED_STATE, SYSTEM_ERROR_CLASS, "saved_state_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 // useful in memory streams
char *nbuf; char *nbuf;
size_t nsize; size_t nsize;
union { struct {
struct { struct {
#define PLGETC_BUF_SIZE 4096 #define PLGETC_BUF_SIZE 4096
unsigned char *buf, *ptr; 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_) /** @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(- _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 and change working directory to _New_. Use the pattern
`working_directory(CWD, CWD)` to get the current directory. See `working_directory(CWD, CWD)` to get the current directory. See
also `absolute_file_name/2` and chdir/1. also `absolute_file_name/2` and chdir/1.
@ -371,10 +325,37 @@ check_int(I, Inp) :-
% file operations % file operations
% 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) :- delete_file(IFile) :-
true_file_name(IFile, File), true_file_name(IFile, File),
delete_file(File, off, on, off). 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) :- delete_file(IFile, Opts) :-
true_file_name(IFile, File), true_file_name(IFile, File),
process_delete_file_opts(Opts, Dir, Recurse, Ignore, delete_file(File,Opts)), 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)). handle_system_internal(Error, Ignore, delete_file(File)).
delete_directory(on, File, Ignore) :- delete_directory(on, File, Ignore) :-
directory_files(File, FileList, Ignore), directory_files(File, FileList),
path_separator(D), path_separator(D),
atom_concat(File, D, FileP), atom_concat(File, D, FileP),
delete_dirfiles(FileList, FileP, Ignore), 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)). 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) /** @pred environ(+E, -S)
Given an environment variable _E_ this predicate unifies the second 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) /** @pred exec(+ Command, StandardStreams, -PID)
* *
* *
* *
* Execute command _Command_ with its standard streams connected to the * Execute command _Command_ with its standard streams connected to the
* list [_InputStream_, _OutputStream_, _ErrorStream_]. A numeric * list [_InputStream_, _OutputStream_, _ErrorStream_]. A numeric
* identifier to the process that executes the command is returned as * identifier to the process that executes the command is returned as
* _PID_. The command is executed by the default shell `bin/sh -c` in * _PID_. The command is executed by the default shell `bin/sh -c` in
* Unix. * Unix.
* *
* The following example demonstrates the use of exec/3 to send a * The following example demonstrates the use of exec/3 to send a
* command and process its output: * command and process its output:
* *
* ~~~~~ * ~~~~~
go :- go :-
exec(ls,[std,pipe(S),null],P), exec(ls,[std,pipe(S),null],P),
@ -529,12 +523,12 @@ environ_split([C|S],[C|SNa],SVal) :-
get0(S,C), get0(S,C),
(C = -1, close(S) ! ; put(C)). (C = -1, close(S) ! ; put(C)).
~~~~~ ~~~~~
* *
* The streams may be one of standard stream, `std`, null stream, * The streams may be one of standard stream, `std`, null stream,
* `null`, or `pipe(S)`, where _S_ is a pipe stream. Note * `null`, or `pipe(S)`, where _S_ is a pipe stream. Note
* that it is up to the user to close the pipe. * that it is up to the user to close the pipe.
* *
* *
*/ */
exec(Command, [StdIn, StdOut, StdErr], PID) :- exec(Command, [StdIn, StdOut, StdErr], PID) :-
G = 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 * _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` * be closed using close/1, there is no need for a special `pclose`
* command. * command.
* *
* The following example demonstrates the use of popen/3 to process the * 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 * output of a command, note that popen/3 works as a simplified interface
* to the exec/3 command: * to the exec/3 command:
@ -606,8 +600,8 @@ close_temp_streams([S|Ss]) :-
X = 'C:\\cygwin\\home\\administrator' ? 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) :- popen(Command, read, Stream) :-
@ -686,75 +680,7 @@ get_shell(Shell, '/c') :-
get_shell('/bin/sh','-c'). get_shell('/bin/sh','-c').
system :- system :-
default_shell(C/** @pred directory_files(+ _Dir_,+ _List_)a default_shell(Command),
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
*/
do_system(Command, _Status, Error), do_system(Command, _Status, Error),
handle_system_internal(Error, off, system). handle_system_internal(Error, off, system).
@ -851,14 +777,14 @@ rename_file(F0, F) :-
rename_file(F0, F, Error), rename_file(F0, F, Error),
handle_system_internal(Error, off, rename_file(F0, F)). handle_system_internal(Error, off, rename_file(F0, F)).
/** /**
* @pred system(+ _S_) * @pred system(+ _S_)
Passes command _S_ to the Bourne shell (on UNIX environments) or the Passes command _S_ to the Bourne shell (on UNIX environments) or the
current command interpreter in WIN32 environments. 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 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,..,'.'] ['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~ ~~~~~
The predicates uses the `dirent` family of routines in Unix 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). list_directory(X,Y).
/** @} */ /** @} */

12
os/files.c
View File

@ -676,7 +676,8 @@ static Int list_directory(USES_REGS1) {
const char *dp; const char *dp;
if ((de = AAssetManager_openDir(mgr, dirName)) == NULL) { 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))) { while ((dp = AAssetDir_getNextFileName(de))) {
YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(dp)); YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(dp));
@ -691,10 +692,13 @@ static Int list_directory(USES_REGS1) {
struct dirent *dp; struct dirent *dp;
if ((de = opendir(buf)) == NULL) { 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))) { 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))); Yap_PutInSlot(sl, MkPairTerm(ti, Yap_GetFromSlot(sl)));
} }
closedir(de); closedir(de);
@ -796,5 +800,5 @@ void Yap_InitFiles(void) {
Yap_InitCPred("file_size", 2, file_size, SafePredFlag | SyncPredFlag); Yap_InitCPred("file_size", 2, file_size, SafePredFlag | SyncPredFlag);
Yap_InitCPred("file_name_extension", 3, file_name_extension, Yap_InitCPred("file_name_extension", 3, file_name_extension,
SafePredFlag | SyncPredFlag); 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(); sno = GetFreeStreamD();
if (sno < 0) if (sno < 0)
return -1; return -1;
st = GLOBAL_Stream + sno; st = GLOBAL_Stream + sno;
st->status = Output_Stream_f | InMemory_Stream_f | FreeOnClose_Stream_f; st->status = Output_Stream_f | InMemory_Stream_f | FreeOnClose_Stream_f;
st->linepos = 0; st->linepos = 0;
@ -198,7 +199,9 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) {
st->linecount = 1; st->linecount = 1;
st->encoding = enc; st->encoding = enc;
st->vfs = NULL; st->vfs = NULL;
st->buf.on = false; st->buf.on = true;
st->nbuf = NULL;
st->nsize = 0;
#if HAVE_OPEN_MEMSTREAM #if HAVE_OPEN_MEMSTREAM
st->file = open_memstream(&st->nbuf, &st->nsize); st->file = open_memstream(&st->nbuf, &st->nsize);
// setbuf(st->file, NULL); // 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()}; static const param_t open_defs[] = {OPEN_DEFS()};
#undef PAR #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) { static Int do_open(Term file_name, Term t2, Term tlist USES_REGS) {
Atom open_mode; Atom open_mode;
int sno;
StreamDesc *st;
bool avoid_bom = false, needs_bom = false; bool avoid_bom = false, needs_bom = false;
stream_flags_t flags;
const char *s_encoding;
encoding_t encoding;
Term tenc; Term tenc;
char io_mode[8]; 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)) { if (IsVarTerm(file_name)) {
Yap_ThrowError(INSTANTIATION_ERROR, file_name, Yap_ThrowError(INSTANTIATION_ERROR, file_name,
"while opening a list of options"); "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 // open mode
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "open/3"); Yap_Error(INSTANTIATION_ERROR, t2, "open/3");
return FALSE; return false;
} }
if (!IsAtomTerm(t2)) { if (!IsAtomTerm(t2)) {
if (IsStringTerm(t2)) { if (IsStringTerm(t2)) {
open_mode = Yap_LookupAtom(StringOfTerm(t2)); open_mode = Yap_LookupAtom(StringOfTerm(t2));
} else { } else {
Yap_Error(TYPE_ERROR_ATOM, t2, "open/3"); Yap_Error(TYPE_ERROR_ATOM, t2, "open/3");
return (FALSE); return false;
} }
} else { } else {
open_mode = AtomOfTerm(t2); open_mode = AtomOfTerm(t2);
} }
/* get options */ /* get options */
xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END); xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END,
DOMAIN_ERROR_OPEN_OPTION);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { 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"); Yap_Error(LOCAL_Error_TYPE, tlist, "option handling in open/3");
} }
return false; return false;
} }
/* done */ /* done */
flags = 0; st->status = 0;
const char *s_encoding;
if (args[OPEN_ENCODING].used) { if (args[OPEN_ENCODING].used) {
tenc = args[OPEN_ENCODING].tvalue; tenc = args[OPEN_ENCODING].tvalue;
s_encoding = RepAtom(AtomOfTerm(tenc))->StrOfAE; 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"; s_encoding = "default";
} }
// default encoding, no bom yet // 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 // only set encoding after getting BOM
char const *fname0; char const *fname0;
bool ok = (args[OPEN_EXPAND_FILENAME].used 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 #ifdef _WIN32
strncat(io_mode, "b", 8); strncat(io_mode, "b", 8);
#endif #endif
flags |= Binary_Stream_f; st->status |= Binary_Stream_f;
encoding = ENC_OCTET; st->encoding = ENC_OCTET;
avoid_bom = true; avoid_bom = true;
needs_bom = false; needs_bom = false;
} else if (t == TermText) { } 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); "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; return false;
} }
st = &GLOBAL_Stream[sno]; if (args[OPEN_BOM].used) {
// 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].tvalue == TermTrue) { if (args[OPEN_BOM].tvalue == TermTrue) {
avoid_bom = false; avoid_bom = false;
needs_bom = true; 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) { if (st - GLOBAL_Stream < 3) {
flags |= RepError_Prolog_f; st->status |= RepError_Prolog_f;
} }
#if MAC #if MAC
if (open_mode == AtomWrite) { if (open_mode == AtomWrite) {
Yap_SetTextFile(RepAtom(AtomOfTerm(file_name))->StrOfAE); Yap_SetTextFile(RepAtom(AtomOfTerm(file_name))->StrOfAE);
} }
#endif #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); // __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "open %s", fname);
if (needs_bom && !write_bom(sno, st)) { if (needs_bom && !write_bom(sno, st)) {
return false; return false;
} else if (open_mode == AtomRead && !avoid_bom) { } else if (open_mode == AtomRead && !avoid_bom) {
check_bom(sno, st); // can change encoding 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); Yap_DefaultStreamOps(st);
if (script) { if (script) {
open_header(sno, open_mode); open_header(sno, open_mode);
@ -1558,9 +1658,6 @@ int Yap_OpenStream(Term tin, const char *io_mode, Term user_name,
CACHE_REGS CACHE_REGS
int sno; int sno;
StreamDesc *st; StreamDesc *st;
struct vfs *vfsp = NULL;
int flags;
const char *fname;
sno = GetFreeStreamD(); sno = GetFreeStreamD();
if (sno < 0) { if (sno < 0) {
@ -1570,90 +1667,11 @@ int Yap_OpenStream(Term tin, const char *io_mode, Term user_name,
} }
st = GLOBAL_Stream + sno; st = GLOBAL_Stream + sno;
// fname = Yap_VF(fname); // 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 (fill_stream(sno, st, tin,io_mode,user_name,enc))
if (!buf) { return sno;
pop_text_stack(i); return -1;
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;
} }
int Yap_FileStream(FILE *fd, char *name, Term file_name, int flags, 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); UNLOCK(GLOBAL_Stream[sno].streamlock);
return TRUE; return TRUE;
} }
xarg *args = xarg *args = Yap_ArgListToVector((tlist = Deref(ARG2)), close_defs, CLOSE_END,
Yap_ArgListToVector((tlist = Deref(ARG2)), close_defs, CLOSE_END); DOMAIN_ERROR_CLOSE_OPTION);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { 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); Yap_Error(LOCAL_Error_TYPE, tlist, NULL);
} }
return false; return false;
@ -1967,11 +1983,10 @@ static Int abs_file_parameters(USES_REGS1) {
Term tlist = Deref(ARG1), tf; Term tlist = Deref(ARG1), tf;
/* get options */ /* get options */
xarg *args = Yap_ArgListToVector(tlist, absolute_file_name_search_defs, 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 (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { 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); Yap_Error(LOCAL_Error_TYPE, tlist, NULL);
} }
return false; 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) { static Term add_output(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomOutput, 1), 1); 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)); 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); return MkPairTerm(topt, tail);
} else { } else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil)); 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) { static Term add_names(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1); Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt)); 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); return MkPairTerm(topt, tail);
} else { } else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil)); 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) { static Term add_priority(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1); Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt)); 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); return MkPairTerm(topt, tail);
} else { } else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil)); 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) { if (!LOCAL_ErrorMessage) {
LOCAL_ErrorMessage = "syntax error"; LOCAL_ErrorMessage = "syntax error";
} }
tm = MkStringTerm(LOCAL_ErrorMessage); tm = MkStringTerm(LOCAL_ErrorMessage);
{ {
char *s = malloc( strlen(LOCAL_ErrorMessage)+1); char *s = malloc(strlen(LOCAL_ErrorMessage) + 1);
strcpy(s,LOCAL_ErrorMessage ); strcpy(s, LOCAL_ErrorMessage);
Yap_local.ActiveError->errorMsg = s; Yap_local.ActiveError->errorMsg = s;
} }
if (GLOBAL_Stream[sno].status & Seekable_Stream_f) { if (GLOBAL_Stream[sno].status & Seekable_Stream_f) {
if (errpos && newpos >= 0) { 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_VarTable = NULL;
LOCAL_AnonVarTable = NULL; LOCAL_AnonVarTable = NULL;
fe->enc = GLOBAL_Stream[inp_stream].encoding; 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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
return NULL; return NULL;
} }
@ -541,9 +550,9 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
if (args[READ_PRIORITY].used) { if (args[READ_PRIORITY].used) {
re->prio = IntegerOfTerm(args[READ_PRIORITY].tvalue); re->prio = IntegerOfTerm(args[READ_PRIORITY].tvalue);
if (re->prio > GLOBAL_MaxPriority) { if (re->prio > GLOBAL_MaxPriority) {
Yap_Error(DOMAIN_ERROR_OPERATOR_PRIORITY, opts, Yap_ThrowError(DOMAIN_ERROR_OPERATOR_PRIORITY, opts,
"max priority in Prolog is %d, not %ld", GLOBAL_MaxPriority, "max priority in Prolog is %d, not %ld",
re->prio); GLOBAL_MaxPriority, re->prio);
} }
} else { } else {
re->prio = LOCAL_default_priority; re->prio = LOCAL_default_priority;
@ -998,10 +1007,9 @@ Term Yap_read_term(int sno, Term opts, bool clause) {
int emacs_cares = FALSE; int emacs_cares = FALSE;
#endif #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(); int lvl = push_text_stack();
parser_state_t state = YAP_START_PARSING; parser_state_t state = YAP_START_PARSING;
while (true) { while (true) {
@ -1010,8 +1018,8 @@ Term Yap_read_term(int sno, Term opts, bool clause) {
state = initParser(opts, &fe, &re, sno, clause); state = initParser(opts, &fe, &re, sno, clause);
if (state == YAP_PARSING_FINISHED) { if (state == YAP_PARSING_FINISHED) {
pop_text_stack(lvl); pop_text_stack(lvl);
Yap_popErrorContext(err, true); Yap_popErrorContext(err, true);
return 0; return 0;
} }
break; break;
case YAP_SCANNING: 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); pop_text_stack(lvl);
return 0; 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) { static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, int sno) {
CACHE_REGS 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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
return NULL; return NULL;
} }
if (args[READ_CLAUSE_OUTPUT].used) { if (args[READ_CLAUSE_OUTPUT].used) {
@ -1387,32 +1394,33 @@ static Int style_checker(USES_REGS1) {
return TRUE; return TRUE;
} }
Term Yap_BufferToTerm(const char *s, Term opts) { Term Yap_BufferToTerm(const char *s, Term opts) {
Term rval; Term rval;
int sno; int sno;
encoding_t l = ENC_ISO_UTF8; encoding_t l = ENC_ISO_UTF8;
sno = Yap_open_buf_read_stream((char *)s, strlen((const char *)s), &l, sno = Yap_open_buf_read_stream((char *)s, strlen((const char *)s), &l,
MEM_BUF_USER); MEM_BUF_USER);
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
rval = Yap_read_term(sno, opts, false); rval = Yap_read_term(sno, opts, false);
Yap_CloseStream(sno); Yap_CloseStream(sno);
return rval; return rval;
} }
Term Yap_UBufferToTerm(const unsigned char *s, Term opts) { Term Yap_UBufferToTerm(const unsigned char *s, Term opts) {
Term rval; Term rval;
int sno; int sno;
encoding_t l = ENC_ISO_UTF8; encoding_t l = ENC_ISO_UTF8;
sno = Yap_open_buf_read_stream((char *)s, strlen((const char *)s), &l, sno = Yap_open_buf_read_stream((char *)s, strlen((const char *)s), &l,
MEM_BUF_USER); MEM_BUF_USER);
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
rval = Yap_read_term(sno, opts, false); rval = Yap_read_term(sno, opts, false);
Yap_CloseStream(sno); Yap_CloseStream(sno);
return rval; 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) { int prio) {
CACHE_REGS CACHE_REGS
Term ctl; Term ctl;

196
os/streams.c
View File

@ -1,26 +1,24 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: iopreds.c * * File: iopreds.c * Last rev: 5/2/88
* Last rev: 5/2/88 * ** mods: * comments: Input/Output C implemented predicates *
* mods: * * *
* comments: Input/Output C implemented predicates * *************************************************************************/
* *
*************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
/** /**
* *
* This file includes the definition of a miscellania of standard predicates * This file includes the definition of a miscellania of standard predicates
* for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, * 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 */ /* for O_BINARY and O_TEXT in WIN32 */
#include <fcntl.h> #include <fcntl.h>
#endif #endif
#include "YapEval.h"
#include "YapHeap.h" #include "YapHeap.h"
#include "YapText.h" #include "YapText.h"
#include "Yatom.h" #include "Yatom.h"
#include "YapEval.h"
#include "yapio.h" #include "yapio.h"
#include <stdlib.h> #include <stdlib.h>
#if HAVE_STDARG_H #if HAVE_STDARG_H
@ -144,7 +142,7 @@ int GetFreeStreamD(void) {
return -1; return -1;
} }
LOCK(GLOBAL_Stream[sno].streamlock); LOCK(GLOBAL_Stream[sno].streamlock);
GLOBAL_Stream[sno].status &= ~Free_Stream_f; GLOBAL_Stream[sno].status &= ~Free_Stream_f;
UNLOCK(GLOBAL_StreamDescLock); UNLOCK(GLOBAL_StreamDescLock);
GLOBAL_Stream[sno].encoding = LOCAL_encoding; GLOBAL_Stream[sno].encoding = LOCAL_encoding;
return sno; return sno;
@ -155,45 +153,41 @@ int Yap_GetFreeStreamD(void) { return GetFreeStreamD(); }
/** /**
* *
*/ */
bool Yap_clearInput(int sno) bool Yap_clearInput(int sno) {
{ if (!(GLOBAL_Stream[sno].status & Tty_Stream_f) || sno < 3)
if (!(GLOBAL_Stream[sno].status & Tty_Stream_f) || sno < 3) return true;
return true; if (GLOBAL_Stream[sno].vfs) {
if (GLOBAL_Stream[sno].vfs) { GLOBAL_Stream[sno].vfs->flush(sno);
GLOBAL_Stream[sno].vfs->flush(sno); return true;
return true; }
}
#if USE_READLINE #if USE_READLINE
if (GLOBAL_Stream[sno].status & Readline_Stream_f) if (GLOBAL_Stream[sno].status & Readline_Stream_f)
return Yap_readline_clear_pending_input (GLOBAL_Stream+sno); return Yap_readline_clear_pending_input(GLOBAL_Stream + sno);
#endif #endif
#if HAVE_FPURGE #if HAVE_FPURGE
fflush(NULL); fflush(NULL);
return fpurge( GLOBAL_Stream[sno].file ) == 0; return fpurge(GLOBAL_Stream[sno].file) == 0;
#elif HAVE_TCFLUSH #elif HAVE_TCFLUSH
return tcflush(fileno(GLOBAL_Stream[sno].file), TCIOFLUSH) == 0; return tcflush(fileno(GLOBAL_Stream[sno].file), TCIOFLUSH) == 0;
#elif MSC_VER #elif MSC_VER
return fflush(GLOBAL_Stream[sno].file) == 0; return fflush(GLOBAL_Stream[sno].file) == 0;
#endif #endif
return false; 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 ) bool Yap_flush(int sno) {
{ if (!(GLOBAL_Stream[sno].status & Tty_Stream_f))
int sno = Yap_CheckStream(ARG1, Input_Stream_f | Socket_Stream_f, return true;
"clear_input/1"); 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) if (sno != -1)
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_clearInput(sno); 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) */ static Int p_check_if_stream(USES_REGS1) { /* '$check_stream'(Stream) */
int sno = Yap_CheckStream(ARG1, Input_Stream_f | Output_Stream_f | int sno = Yap_CheckStream(ARG1,
Append_Stream_f | Socket_Stream_f, Input_Stream_f | Output_Stream_f | Append_Stream_f |
Socket_Stream_f,
"check_stream/1"); "check_stream/1");
if (sno != -1) if (sno != -1)
UNLOCK(GLOBAL_Stream[sno].streamlock); 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) {
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); UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(SYSTEM_ERROR_INTERNAL, pos, PlIOError(SYSTEM_ERROR_INTERNAL, pos,
"fseek failed for set_stream_position/2: %s", strerror(errno)); "fseek failed for set_stream_position/2: %s", strerror(errno));
return (FALSE); 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); UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(SYSTEM_ERROR_INTERNAL, MkIntegerTerm(0), PlIOError(SYSTEM_ERROR_INTERNAL, MkIntegerTerm(0),
"fseek failed for set_stream_position/2: %s", strerror(errno)); "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__ #if __linux__
char *path= malloc(1024); char *path = malloc(1024);
if (snprintf(path, 1023, "/proc/self/fd/%d", f) && readlink(path, nameb, maxs)) { if (snprintf(path, 1023, "/proc/self/fd/%d", f) &&
free(path); readlink(path, nameb, maxs)) {
return nameb; free(path);
return nameb;
} }
#elif __APPLE__ #elif __APPLE__
if (fcntl(f, F_GETPATH, nameb) != -1) { if (fcntl(f, F_GETPATH, nameb) != -1) {
return nameb; return nameb;
} }
#else #else
TCHAR path= malloc(MAX_PATH + 1); TCHAR path = malloc(MAX_PATH + 1);
if (!GetFullPathName(path, MAX_PATH, path, NULL)) { if (!GetFullPathName(path, MAX_PATH, path, NULL)) {
free(path); free(path);
return NULL; return NULL;
} else { } else {
int i; int i;
@ -362,7 +355,7 @@ char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) {
free(path); free(path);
return nameb; return nameb;
} }
free(path); free(path);
#endif #endif
if (!StreamName(sno)) { if (!StreamName(sno)) {
return NULL; return NULL;
@ -443,9 +436,7 @@ found_eof(int sno,
return Yap_unify(t2, MkAtomTerm(AtomAltNot)); return Yap_unify(t2, MkAtomTerm(AtomAltNot));
} }
static bool static bool stream_mode(int sno, Term t2 USES_REGS) {
stream_mode(int sno,
Term t2 USES_REGS) {
/* '$set_output'(+Stream,-ErrorMessage) */ /* '$set_output'(+Stream,-ErrorMessage) */
stream_flags_t flags = GLOBAL_Stream[sno].status; stream_flags_t flags = GLOBAL_Stream[sno].status;
if (!IsVarTerm(t2) && !(isatom(t2))) { if (!IsVarTerm(t2) && !(isatom(t2))) {
@ -455,9 +446,9 @@ stream_mode(int sno,
return Yap_unify(t2, TermRead); return Yap_unify(t2, TermRead);
if (flags & Append_Stream_f) if (flags & Append_Stream_f)
return Yap_unify(t2, TermWrite); return Yap_unify(t2, TermWrite);
if (flags & Output_Stream_f) if (flags & Output_Stream_f)
return Yap_unify(t2, TermWrite); return Yap_unify(t2, TermWrite);
return false; return false;
} }
static bool 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); Functor f = Yap_MkFunctor(Yap_LookupAtom(stream_property_defs[p].name), 1);
Yap_unify(t2, Yap_MkNewApplTerm(f, 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 */ 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); EXTRA_CBACK_ARG(2, 2) = MkIntTerm(p % STREAM_PROPERTY_END);
// otherwise, just drop through // otherwise, just drop through
} else { } 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 (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { 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); return cont_stream_property(PASS_REGS1);
} }
args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs, args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs,
STREAM_PROPERTY_END); STREAM_PROPERTY_END,
DOMAIN_ERROR_STREAM_PROPERTY_OPTION);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
@ -850,7 +844,8 @@ static bool do_set_stream(int sno,
set_stream_enum_choices_t i; set_stream_enum_choices_t i;
bool rc = true; 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 (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT) if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
@ -999,19 +994,20 @@ void Yap_CloseTemporaryStreams(void) {
static void CloseStream(int sno) { static void CloseStream(int sno) {
CACHE_REGS CACHE_REGS
//fflush(NULL); // fflush(NULL);
VFS_t *me; VFS_t *me;
if ((me = GLOBAL_Stream[sno].vfs) != NULL && GLOBAL_Stream[sno].file == NULL) { if ((me = GLOBAL_Stream[sno].vfs) != NULL &&
if (me->close) { GLOBAL_Stream[sno].file == NULL) {
me->close(sno); if (me->close) {
} me->close(sno);
}
GLOBAL_Stream[sno].vfs = NULL; GLOBAL_Stream[sno].vfs = NULL;
} else if (GLOBAL_Stream[sno].file && } 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); pclose(GLOBAL_Stream[sno].file);
} else if (GLOBAL_Stream[sno].file && } else if (GLOBAL_Stream[sno].file &&
!(GLOBAL_Stream[sno].status & !(GLOBAL_Stream[sno].status & (Null_Stream_f | Socket_Stream_f |
(Null_Stream_f | Socket_Stream_f | InMemory_Stream_f | Pipe_Stream_f))) InMemory_Stream_f | Pipe_Stream_f)))
fclose(GLOBAL_Stream[sno].file); fclose(GLOBAL_Stream[sno].file);
#if HAVE_SOCKET #if HAVE_SOCKET
else if (GLOBAL_Stream[sno].status & (Socket_Stream_f)) { 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)) { } else if (GLOBAL_Stream[sno].status & (InMemory_Stream_f)) {
Yap_CloseMemoryStream(sno); Yap_CloseMemoryStream(sno);
} }
if (LOCAL_c_input_stream == sno) { if (LOCAL_c_input_stream == sno) {
LOCAL_c_input_stream = StdInStream; LOCAL_c_input_stream = StdInStream;
} }
if (LOCAL_c_output_stream == sno) { if (LOCAL_c_output_stream == sno) {
@ -1034,7 +1030,7 @@ static void CloseStream(int sno) {
if (LOCAL_c_error_stream == sno) { if (LOCAL_c_error_stream == sno) {
LOCAL_c_error_stream = StdErrStream; LOCAL_c_error_stream = StdErrStream;
} }
Yap_DeleteAliases(sno); Yap_DeleteAliases(sno);
GLOBAL_Stream[sno].vfs = NULL; GLOBAL_Stream[sno].vfs = NULL;
GLOBAL_Stream[sno].file = NULL; GLOBAL_Stream[sno].file = NULL;
GLOBAL_Stream[sno].status = Free_Stream_f; GLOBAL_Stream[sno].status = Free_Stream_f;
@ -1051,8 +1047,8 @@ void Yap_ReleaseStream(int sno) {
CACHE_REGS CACHE_REGS
GLOBAL_Stream[sno].status = Free_Stream_f; GLOBAL_Stream[sno].status = Free_Stream_f;
GLOBAL_Stream[sno].user_name = 0; GLOBAL_Stream[sno].user_name = 0;
GLOBAL_Stream[sno].vfs = NULL; GLOBAL_Stream[sno].vfs = NULL;
GLOBAL_Stream[sno].file = NULL; GLOBAL_Stream[sno].file = NULL;
Yap_DeleteAliases(sno); Yap_DeleteAliases(sno);
if (LOCAL_c_input_stream == 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"); int sno = Yap_CheckStream(sd, Input_Stream_f, "set_input/1");
if (sno < 0) if (sno < 0)
return false; return false;
@ -1096,7 +1091,6 @@ bool Yap_SetInputStream( Term sd )
return true; return true;
} }
/** @pred set_input(+ _S_) is iso /** @pred set_input(+ _S_) is iso
* Set stream _S_ as the current input stream. Predicates like read/1 * Set stream _S_ as the current input stream. Predicates like read/1
* and get/1 will start using stream _S_ by default. * 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) */ 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) */ 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 = int sno =
Yap_CheckStream(sd, Output_Stream_f | Append_Stream_f, "set_output/2"); Yap_CheckStream(sd, Output_Stream_f | Append_Stream_f, "set_output/2");
if (sno < 0) if (sno < 0)
@ -1135,8 +1128,7 @@ bool Yap_SetOutputStream( Term sd )
return true; return true;
} }
bool Yap_SetErrorStream( Term sd ) bool Yap_SetErrorStream(Term sd) {
{
int sno = int sno =
Yap_CheckStream(sd, Output_Stream_f | Append_Stream_f, "set_error/2"); Yap_CheckStream(sd, Output_Stream_f | Append_Stream_f, "set_error/2");
if (sno < 0) if (sno < 0)
@ -1156,11 +1148,9 @@ bool Yap_SetErrorStream( Term sd )
* *
*/ */
static Int set_output(USES_REGS1) { /* '$show_stream_position'(+Stream,Pos) */ 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) { static Int p_user_file_name(USES_REGS1) {
Term tout; Term tout;
int sno = int sno =
@ -1362,14 +1352,16 @@ static Int
"set_stream_position/2"); "set_stream_position/2");
return (FALSE); return (FALSE);
} }
if(GLOBAL_Stream[sno].vfs) { 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 &&
UNLOCK(GLOBAL_Stream[sno].streamlock); GLOBAL_Stream[sno].vfs->seek(sno, 0L, SEEK_END) == -1) {
PlIOError(SYSTEM_ERROR_INTERNAL, tp, UNLOCK(GLOBAL_Stream[sno].streamlock);
"fseek failed for set_stream_position/2: %s", strerror(errno)); PlIOError(SYSTEM_ERROR_INTERNAL, tp,
return (FALSE); "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); UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(SYSTEM_ERROR_INTERNAL, tp, PlIOError(SYSTEM_ERROR_INTERNAL, tp,
"fseek failed for set_stream_position/2: %s", strerror(errno)); "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; spec = rc;
#endif #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) { if (args == NULL) {
return TermNil; 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) { const char *Yap_getcwd(char *cwd, size_t cwdlen) {
if (GLOBAL_cwd && GLOBAL_cwd[0]) { if (GLOBAL_cwd && GLOBAL_cwd[0]) {
strcpy(cwd, GLOBAL_cwd); strcpy(cwd, GLOBAL_cwd);
return cwd; return cwd;
} }
#if _WIN32 || defined(__MINGW32__) #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) { 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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, opts, NULL); Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, t, args PASS_REGS); write_term(output_stream, t, args PASS_REGS);
@ -337,10 +335,9 @@ static Int write2(USES_REGS1) {
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0) if (output_stream < 0)
return false; 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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
@ -363,10 +360,9 @@ static Int write1(USES_REGS1) {
int output_stream = LOCAL_c_output_stream; int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) if (output_stream == -1)
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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
@ -390,10 +386,9 @@ static Int write_canonical1(USES_REGS1) {
int output_stream = LOCAL_c_output_stream; int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) if (output_stream == -1)
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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
@ -416,10 +411,9 @@ static Int write_canonical(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
@ -446,10 +440,9 @@ static Int writeq1(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
@ -476,10 +469,9 @@ static Int writeq(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
@ -506,10 +498,9 @@ static Int print1(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
@ -537,10 +528,9 @@ static Int print(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
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 (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
@ -570,7 +560,8 @@ static Int writeln1(USES_REGS1) {
int output_stream = LOCAL_c_output_stream; int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) if (output_stream == -1)
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 (args == NULL) {
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); 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 /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ 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 (args == NULL) {
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
return false; return false;
} }
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "writeln/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "writeln/2");
fprintf(stderr,"writeln %d\n", output_stream); fprintf(stderr, "writeln %d\n", output_stream);
if (output_stream < 0) { if (output_stream < 0) {
free(args); free(args);
return false; return false;
@ -680,8 +672,7 @@ static Int term_to_string(USES_REGS1) {
Term t2 = Deref(ARG2), rc = false, t1 = Deref(ARG1); Term t2 = Deref(ARG2), rc = false, t1 = Deref(ARG1);
const char *s; const char *s;
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
s = Yap_TermToBuffer(ARG1, LOCAL_encoding, s = Yap_TermToBuffer(ARG1, LOCAL_encoding, Quote_illegal_f | Handle_vars_f);
Quote_illegal_f | Handle_vars_f);
if (!s || !MkStringTerm(s)) { if (!s || !MkStringTerm(s)) {
Yap_Error(RESOURCE_ERROR_HEAP, t1, Yap_Error(RESOURCE_ERROR_HEAP, t1,
"Could not get memory from the operating system"); "Could not get memory from the operating system");

43
packages/python/pyio.c
View File

@ -8,7 +8,6 @@
YAP_Term TermErrStream, TermOutStream; YAP_Term TermErrStream, TermOutStream;
static unsigned char *outbuf, *errbuf;
static void pyflush(StreamDesc *st) { static void pyflush(StreamDesc *st) {
#if 0 #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); StreamDesc *st = YAP_RepStreamFromId(sno);
st->name = YAP_LookupAtom(name); 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) if (!outbuf)
outbuf = ( unsigned char *)malloc(1024); outbuf = ( unsigned char *)malloc(1024);
st->u.w_irl.ptr = st->u.w_irl.buf = outbuf; st->u.w_irl.ptr = st->u.w_irl.buf = outbuf;
@ -125,9 +129,8 @@ static bool py_close(int sno) {
return true; return true;
} }
static bool getLine(int inp) { static bool getLine(StreamDesc *rl_iostream, int sno) {
char *myrl_line = NULL; char *myrl_line = NULL;
StreamDesc *rl_instream = YAP_RepStreamFromId(inp);
term_t ctk = python_acquire_GIL(); term_t ctk = python_acquire_GIL();
Py_ssize_t size; Py_ssize_t size;
PyObject *prompt = PyUnicode_FromString("?- "), PyObject *prompt = PyUnicode_FromString("?- "),
@ -137,9 +140,16 @@ static bool getLine(int inp) {
myrl_line = PyUnicode_AsUTF8AndSize( myrl_line = PyUnicode_AsUTF8AndSize(
PyObject_CallFunctionObjArgs(o, msg, prompt, NULL), &size); PyObject_CallFunctionObjArgs(o, msg, prompt, NULL), &size);
python_release_GIL(ctk); 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); (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; return true;
} }
@ -148,16 +158,17 @@ static int py_getc(int sno) {
int ch; int ch;
bool fetch = (s->u.irl.buf == NULL); bool fetch = (s->u.irl.buf == NULL);
if (!fetch || getLine(sno)) { if (fetch) {
const unsigned char *ttyptr = s->u.irl.ptr++, *myrl_line = s->u.irl.buf; if (!getLine(s, sno)) {
ch = *ttyptr; return EOF;
if (ch == '\0') {
ch = '\n';
free((void *)myrl_line);
s->u.irl.ptr = s->u.irl.buf = NULL;
} }
} 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; return ch;
} }
@ -182,7 +193,7 @@ static int py_peek(int sno) {
} }
return ch; return ch;
} }
if (getLine(sno)) { if (getLine(s, sno)) {
ch = s->u.irl.ptr[0]; ch = s->u.irl.ptr[0];
if (ch == '\0') { if (ch == '\0') {
ch = '\n'; 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) program,squery,stop,howmany = self.prolog_cell(s)
found = False found = False
# sys.settrace(tracefunc) # sys.settrace(tracefunc)
if self.query and self.os == squery: if self.query and self.os == program+squery:
howmany += self.iterations howmany += self.iterations
else: else:
if self.query: if self.query:
self.query.close() self.query.close()
self.os = squery self.os = program+squery
self.iterations = 0 self.iterations = 0
self.bindings = [] self.bindings = []
pg = jupyter_query( self, program, squery) 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 /** @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 ), display_consulting( File, Level, LC ),
[ '~s:~d:0 ~a in ~s:~s/~d:'-[File, FilePos,Level,M,Na,Ar] ]. [ '~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 ) --> []. 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) --> main_message(error(uninstantiation_error(T),_), Level, _LC) -->
[ ' ~a: found ~q, expected unbound variable ' - [Level,T], nl ]. [ ' ~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, { LC > 0,
source_location(F0, L), source_location(F0, L),
F \= F0 F \= F0
}, !, }, !,
[ '~a:~d:0: ~a while compiling.'-[F0,L,Level], nl ]. [ '~a:~d:0: ~a while compiling.'-[F0,L,Level], nl ].
display_consulting(_F, _, _LC) --> display_consulting(_F, _, _, _LC) -->
[]. [].
caller( error(_,Info), _) --> caller( error(_,Info), _) -->