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

state

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

93
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
xarg *a;
listl = Deref(listl); listl = Deref(listl);
if (IsVarTerm(listl)) { if (IsVarTerm(listl)) {
Yap_ThrowError(INSTANTIATION_ERROR, listl, "while opening a list of options"); Yap_ThrowError__(file, function, lineno, INSTANTIATION_ERROR, listl,
"while opening listl = ArgOfTerm(2, listl ,k)");
} }
xarg *a = calloc(n, sizeof(xarg)); a = calloc(n, sizeof(xarg));
if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule)
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);
if (IsVarTerm(listl)) {
Yap_ThrowError(INSTANTIATION_ERROR, listl, "while opening a list of options");
}
xarg *a = calloc(n, sizeof(xarg)); xarg *a = calloc(n, sizeof(xarg));
if (!IsPairTerm(listl) && listl != TermNil) { if (!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;
} }

66
C/errors.c
View File

@ -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);
@ -325,9 +325,12 @@ bool Yap_PrintWarning(Term twarning) {
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;
@ -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;
@ -540,7 +543,7 @@ static char tmpbuf[YAP_BUF_SIZE];
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); \
} }
@ -580,7 +583,7 @@ 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) {
@ -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;
@ -701,7 +706,6 @@ bool Yap_MkErrorRecord( yap_error_descriptor_t *r,
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
@ -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();
@ -945,9 +948,9 @@ 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));
@ -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;
@ -1039,12 +1039,12 @@ static Int get_exception( USES_REGS1) {
(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,7 +1056,6 @@ 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;
@ -1064,7 +1063,8 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
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 {
@ -1072,7 +1072,7 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
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++) {
@ -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;

78
C/exec.c
View File

@ -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)) {
@ -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;
@ -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())
@ -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,7 +1245,6 @@ 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.
@ -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 */
@ -1467,11 +1461,10 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
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);
@ -1493,7 +1486,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
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);
@ -1513,9 +1506,10 @@ 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 ||
(CELL *)(B->cp_b) > LCL0 - LOCAL_CBorder) {
LOCAL_RestartEnv = sighold; LOCAL_RestartEnv = sighold;
LOCAL_CBorder = OldBorder; LOCAL_CBorder = OldBorder;
return false; return false;
@ -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);
@ -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;
} }
@ -2111,7 +2103,8 @@ 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);
@ -2152,7 +2145,7 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
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);
@ -2166,7 +2159,7 @@ 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;
@ -2297,7 +2290,8 @@ void Yap_InitExecFs(void) {
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);

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;

210
C/stack.c
View File

@ -73,7 +73,7 @@ static StaticIndex *find_owner_static_index(StaticIndex *, yamop *);
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;
@ -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) {
@ -1121,17 +1121,16 @@ 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 =
@ -1144,17 +1143,17 @@ 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(
@ -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,7 +1212,7 @@ 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) {
@ -1225,9 +1225,9 @@ yap_error_descriptor_t * Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_R
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);
@ -1237,7 +1237,7 @@ if ( curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE
} }
} }
return NULL; return NULL;
} }
static Term all_calls(bool internal USES_REGS) { static Term all_calls(bool internal USES_REGS) {
@ -1261,7 +1261,6 @@ 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,12 +1391,12 @@ 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);
}*/ }*/
@ -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,22 +2090,23 @@ 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);
@ -2061,7 +2117,7 @@ static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, yamop
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) {
@ -2128,7 +2184,9 @@ yap_error_descriptor_t * Yap_pc_add_location(yap_error_descriptor_t *t, void *pc
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;
@ -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,25 +2238,20 @@ 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) {

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"

25
C/text.c
View File

@ -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)) {
@ -721,7 +721,6 @@ void *write_buffer(unsigned char *s0, seq_tv_t *out USES_REGS) {
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;
} }

3
C/write.c
View File

@ -760,7 +760,8 @@ static void write_var(CELL *t, struct write_globs *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);

14
H/YapFlags.h
View File

@ -388,9 +388,19 @@ 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;

175
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
@ -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).
@ -858,7 +784,7 @@ 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);

255
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 // follow declaration unless there is v
if (st->status & HAS_BOM_f) { if (st->status & HAS_BOM_f) {
st->encoding = enc_id(s_encoding, st->encoding); 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) {
pop_text_stack(i);
return false;
}
buf = pop_output_text_stack(i, buf);
sno = Yap_open_buf_read_stream(buf, strlen(buf) + 1, &LOCAL_encoding,
MEM_BUF_MALLOC);
return Yap_OpenBufWriteStream(PASS_REGS1);
}
} else if (!strcmp(RepAtom(NameOfFunctor(f))->StrOfAE, "popen")) {
const char *buf;
int i = push_text_stack();
buf = Yap_TextTermToText(ArgOfTerm(1, tin) PASS_REGS);
if (buf == NULL) {
pop_text_stack(i);
return -1;
}
#if _WIN32
st->file = _popen(buf, io_mode);
#else
st->file = popen(buf, io_mode);
#endif
fname = "popen";
user_name = tin;
flags |= Popen_Stream_f;
pop_text_stack(i);
} else {
Yap_ThrowError(DOMAIN_ERROR_SOURCE_SINK, tin, "open");
}
}
if (!strchr(io_mode, 'b') && binary_file(fname)) {
flags |= Binary_Stream_f;
}
Yap_initStream(sno, st->file, fname, io_mode, user_name, LOCAL_encoding,
flags, vfsp);
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exists %s <%d>", fname,
sno);
return sno; return sno;
return -1;
} }
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;

46
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));
@ -344,8 +354,8 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos) {
} }
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) {
@ -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) {
@ -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) {
@ -1412,7 +1419,8 @@ Term Yap_UBufferToTerm(const unsigned char *s, Term opts) {
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;

124
os/streams.c
View File

@ -1,19 +1,17 @@
/************************************************************************* /*************************************************************************
* * * *
* 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
@ -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
@ -155,8 +153,7 @@ 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) {
@ -165,22 +162,20 @@ int Yap_GetFreeStreamD(void) { return GetFreeStreamD(); }
} }
#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) {
bool Yap_flush(int sno)
{
if (!(GLOBAL_Stream[sno].status & Tty_Stream_f)) if (!(GLOBAL_Stream[sno].status & Tty_Stream_f))
return true; return true;
if (GLOBAL_Stream[sno].vfs) { if (GLOBAL_Stream[sno].vfs) {
@ -190,10 +185,9 @@ bool Yap_flush(int sno)
return fflush(GLOBAL_Stream[sno].file) == 0; return fflush(GLOBAL_Stream[sno].file) == 0;
} }
static Int clear_input( USES_REGS1 ) static Int clear_input(USES_REGS1) {
{ int sno =
int sno = Yap_CheckStream(ARG1, Input_Stream_f | Socket_Stream_f, Yap_CheckStream(ARG1, Input_Stream_f | Socket_Stream_f, "clear_input/1");
"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,15 +295,12 @@ 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));
@ -339,8 +331,9 @@ 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) &&
readlink(path, nameb, maxs)) {
free(path); free(path);
return nameb; return nameb;
} }
@ -349,7 +342,7 @@ char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) {
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;
@ -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))) {
@ -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 &&
GLOBAL_Stream[sno].file == NULL) {
if (me->close) { if (me->close) {
me->close(sno); 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)) {
@ -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,11 +1352,13 @@ 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 &&
GLOBAL_Stream[sno].vfs->seek(sno, 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));
return (FALSE); return (FALSE);
} }
} else if (fseek(GLOBAL_Stream[sno].file, 0L, SEEK_END) == -1) { } else if (fseek(GLOBAL_Stream[sno].file, 0L, SEEK_END) == -1) {

4
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;
} }

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");

33
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,7 +158,11 @@ 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) {
if (!getLine(s, sno)) {
return EOF;
}
}
const unsigned char *ttyptr = s->u.irl.ptr++, *myrl_line = s->u.irl.buf; const unsigned char *ttyptr = s->u.irl.ptr++, *myrl_line = s->u.irl.buf;
ch = *ttyptr; ch = *ttyptr;
if (ch == '\0') { if (ch == '\0') {
@ -156,9 +170,6 @@ static int py_getc(int sno) {
free((void *)myrl_line); free((void *)myrl_line);
s->u.irl.ptr = s->u.irl.buf = NULL; s->u.irl.ptr = s->u.irl.buf = NULL;
} }
} else {
return EOF;
}
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), _) -->