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

91
C/args.c
View File

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

42
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("errorGoal", i->errorGoal);
print_key_s("classAsText", i->classAsText);
print_key_i("errorLineq", i->errorLine);
print_key_i("errorLine", i->errorLine);
print_key_s("errorFunction", i->errorFunction);
print_key_s("errorFile", i->errorFile);
print_key_i("prologPredLine", i->prologPredLine);
@ -325,9 +325,12 @@ bool Yap_PrintWarning(Term twarning) {
bool rc;
Term ts[2], err;
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError && (err = LOCAL_ActiveError->errorNo)) {
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError &&
(err = LOCAL_ActiveError->errorNo)) {
fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
Yap_TermToBuffer(twarning, ENC_ISO_UTF8,Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f), Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
Yap_TermToBuffer(twarning, ENC_ISO_UTF8,
Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f),
Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
return false;
}
LOCAL_PrologMode |= InErrorMode;
@ -639,10 +642,9 @@ void Yap_ThrowExistingError(void) {
Yap_exit(5);
}
bool Yap_MkErrorRecord( yap_error_descriptor_t *r,
const char *file, const char *function,
int lineno, yap_error_number type, Term where,
const char *s) {
bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
const char *function, int lineno, yap_error_number type,
Term where, const char *s) {
if (!Yap_pc_add_location(r, CP, B, ENV))
Yap_env_add_location(r, CP, B, ENV, 0);
if (where == 0L || where == TermNil || type == INSTANTIATION_ERROR) {
@ -651,11 +653,14 @@ bool Yap_MkErrorRecord( yap_error_descriptor_t *r,
r->culprit = Yap_TermToBuffer(
where, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
}
if (LOCAL_consult_level > 0) {
r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE;
r->prologParserLine = Yap_source_line_no();
}
r->errorNo = type;
r->errorAsText = Yap_errorName(type);
r->errorClass = Yap_errorClass(type);
r->classAsText =
Yap_errorClassName(r->errorClass);
r->classAsText = Yap_errorClassName(r->errorClass);
r->errorLine = lineno;
r->errorFunction = function;
r->errorFile = file;
@ -701,7 +706,6 @@ bool Yap_MkErrorRecord( yap_error_descriptor_t *r,
return true;
}
/**
* @brief Yap_Error
* 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 );
#endif /* DEBUG */
CalculateStackGap(PASS_REGS1);
#if DEBUG
// DumpActiveGoals( PASS_REGS1 );
@ -975,16 +978,13 @@ bool Yap_ResetException(yap_error_descriptor_t *i) {
return true;
}
static Int reset_exception(USES_REGS1) {
return Yap_ResetException(worker_id); }
static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); }
Term MkErrorTerm(yap_error_descriptor_t *t) {
if (t->errorClass == EVENT)
return t->errorRawTerm;
return mkerrort(t->errorNo,
t->culprit?
Yap_BufferToTerm(t->culprit, TermNil): TermNil,
t->culprit ? Yap_BufferToTerm(t->culprit, TermNil) : TermNil,
err2list(t));
}
@ -1023,7 +1023,7 @@ static Int drop_exception(USES_REGS1) {
}
static Int new_exception(USES_REGS1) {
Term t = MkSysError(malloc(sizeof(yap_error_descriptor_t)));
Term t = MkSysError(calloc(1, sizeof(yap_error_descriptor_t)));
return Yap_unify(ARG1, t);
}
@ -1056,7 +1056,6 @@ yap_error_descriptor_t *event(Term t, yap_error_descriptor_t *i) {
return i;
}
yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
Term n = t;
bool found = false, wellformed = true;
@ -1064,7 +1063,8 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
LOCAL_Error_TYPE = THROW_EVENT;
LOCAL_ActiveError->errorClass = EVENT;
LOCAL_ActiveError->errorAsText = Yap_errorName(THROW_EVENT);
LOCAL_ActiveError->classAsText = Yap_errorClassName(Yap_errorClass(THROW_EVENT));
LOCAL_ActiveError->classAsText =
Yap_errorClassName(Yap_errorClass(THROW_EVENT));
LOCAL_ActiveError->errorRawTerm = Yap_SaveTerm(t);
LOCAL_ActiveError->culprit = NULL;
} else {
@ -1119,8 +1119,8 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
if (found) {
n = t2;
}
i->errorGoal =
Yap_TermToBuffer(n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
i->errorGoal = Yap_TermToBuffer(
n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
}
Yap_prolog_add_culprit(i PASS_REGS);
return i;

42
C/exec.c
View File

@ -783,16 +783,16 @@ static Int Yap_ignore(Term t, bool fail USES_REGS) {
Int oENV = LCL0 - ENV;
Int oYENV = LCL0 - YENV;
Int oB = LCL0 - (CELL *)B;
yap_error_descriptor_t ctx;
bool newxp = Yap_pushErrorContext(true, &ctx);
yap_error_descriptor_t *ctx = malloc(sizeof(yap_error_descriptor_t));
bool newxp = Yap_pushErrorContext(true, ctx);
bool rc = Yap_RunTopGoal(t, false);
Yap_popErrorContext(newxp, true);
if (!rc) {
complete_inner_computation((choiceptr)(LCL0 - oB));
// We'll pass it through
} else {
prune_inner_computation((choiceptr)(LCL0 - oB));
}
Yap_popErrorContext(newxp, true);
P = oP;
CP = oCP;
ENV = LCL0 - oENV;
@ -888,8 +888,7 @@ static bool watch_retry(Term d0 USES_REGS) {
// just do the frrpest
if (B >= B0 && !ex_mode && !active)
return true;
if (LOCAL_ActiveError &&
LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
if (LOCAL_ActiveError && LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
e = MkErrorTerm(LOCAL_ActiveError);
if (active) {
t = Yap_MkApplTerm(FunctorException, 1, &e);
@ -1246,7 +1245,6 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
return rc;
}
/**
* @brief Two argument version of non-interruptible execution: this will
* ignore signals including debugging requests.
@ -1329,20 +1327,17 @@ static Int execute_nonstop(USES_REGS1) {
}
}
/**
* @brief One argument version of non-interruptible execution: this will
* ignore signals including debugging requests.
*
* @return Int succeeds if it can transfer control.
*/
static Int execute_nonstop1(USES_REGS1)
{
static Int execute_nonstop1(USES_REGS1) {
ARG2 = CurrentModule;
return execute_nonstop(PASS_REGS1);
}
static Int execute_0(USES_REGS1) { /* '$execute_0'(Goal) */
Term mod = CurrentModule;
Term t = Yap_YapStripModule(Deref(ARG1), &mod);
@ -1454,8 +1449,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
LOCAL_PrologMode = UserMode;
Yap_CloseSlots(sls);
P = (yamop *)FAILCODE;
}
break;
} break;
case 2: {
// LOCAL_ActiveError = err_info;
/* arithmetic exception */
@ -1470,8 +1464,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
P = (yamop *)FAILCODE;
LOCAL_PrologMode = UserMode;
Yap_CloseSlots(sls);
}
break;
} break;
case 3: { /* saved state */
// LOCAL_ActiveError = err_info;
pop_text_stack(i);
@ -1515,7 +1508,8 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
Yap_CloseSlots(sls);
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_CBorder = OldBorder;
return false;
@ -1811,7 +1805,8 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
Yap_Error(INSTANTIATION_ERROR, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
} if (IsPairTerm(t)) {
}
if (IsPairTerm(t)) {
Term ts[2];
ts[0] = t;
ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
@ -2082,12 +2077,9 @@ static Int JumpToEnv(USES_REGS1) {
so get pointers here */
/* find the first choicepoint that may be a catch */
// DBTerm *dbt = Yap_RefToException();
while (handler
&& Yap_PredForChoicePt(handler, NULL) != PredDollarCatch
&& LOCAL_CBorder < LCL0 - (CELL *)handler
&& handler->cp_ap != NOCODE
&& handler->cp_b != NULL
) {
while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch &&
LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE &&
handler->cp_b != NULL) {
handler->cp_ap = TRUSTFAILCODE;
handler = handler->cp_b;
}
@ -2111,7 +2103,8 @@ bool Yap_JumpToEnv(void) {
static Int jump_env(USES_REGS1) {
Term t = Deref(ARG1), t0 = t;
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t, "throw/1 must be called instantiated");
Yap_ThrowError(INSTANTIATION_ERROR, t,
"throw/1 must be called instantiated");
}
// Yap_DebugPlWriteln(t);
LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError);
@ -2297,7 +2290,8 @@ void Yap_InitExecFs(void) {
CurrentModule = cm;
Yap_InitCPred("$restore_regs", 1, restore_regs,
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("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction,
SafePredFlag);

4
C/flags.c
View File

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

186
C/stack.c
View File

@ -286,8 +286,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
if (b_ptr) {
pe = PredForChoicePt(b_ptr->cp_ap, NULL);
}
else
} else
return false;
if (pe == p) {
if (check_everything)
@ -539,7 +538,8 @@ static Int find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp,
}
/*
static bool put_clause_loc(yap_error_descriptor_t *t, void *clcode, PredEntry *pp) {
static bool put_clause_loc(yap_error_descriptor_t *t, void *clcode, PredEntry
*pp) {
CACHE_REGS
if (pp->PredFlags & LogUpdatePredFlag) {
@ -1121,17 +1121,16 @@ static Term clause_info(yamop *codeptr, PredEntry *pp) {
return Yap_MkApplTerm(FunctorModule, 2, ts);
}
yap_error_descriptor_t * set_clause_info(yap_error_descriptor_t *t, yamop *codeptr, PredEntry *pp) {
yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t,
yamop *codeptr, PredEntry *pp) {
CACHE_REGS
Term ts[2];
void *begin;
if (pp->ArityOfPE == 0) {
t->prologPredName =
AtomName((Atom)pp->FunctorOfPred);
t->prologPredName = AtomName((Atom)pp->FunctorOfPred);
t->prologPredArity = 0;
} else {
t->prologPredName =
AtomName(NameOfFunctor(pp->FunctorOfPred));
t->prologPredName = AtomName(NameOfFunctor(pp->FunctorOfPred));
t->prologPredArity = pp->ArityOfPE;
}
t->prologPredModule =
@ -1144,17 +1143,17 @@ yap_error_descriptor_t * set_clause_info(yap_error_descriptor_t *t, yamop *cod
t->prologPredLastLine = 0;
return t;
} else if (pp->cs.p_code.NOfClauses) {
if ((t->prologPredCl =
find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) {
if ((t->prologPredCl = find_code_in_clause(pp, codeptr, &begin, NULL)) <=
0) {
t->prologPredLine = 0;
} else {
t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
}
if (pp->PredFlags & LogUpdatePredFlag) {
t->prologPredFirstLine = clause_loc(
ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp);
t->prologPredLastLine = clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause),
pp);
t->prologPredFirstLine =
clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp);
t->prologPredLastLine =
clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause), pp);
} else {
t->prologPredFirstLine = IntegerOfTerm(
@ -1198,7 +1197,8 @@ static Term error_culprit(bool internal USES_REGS) {
return TermNil;
}
yap_error_descriptor_t * Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_REGS) {
yap_error_descriptor_t *
Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_REGS) {
PredEntry *pe;
void *startp, *endp;
// case number 1: Yap_Error called from built-in.
@ -1226,8 +1226,8 @@ yap_error_descriptor_t * Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_R
return set_clause_info(t, curCP, pe);
curCP = (yamop *)(curENV[E_CP]);
} else if (0) {
if ( curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE
&& curB->cp_ap != FAILCODE) {
if (curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE &&
curB->cp_ap != FAILCODE) {
pe = curB->cp_ap->y_u.Otapl.p;
if (pe && (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag)))
return set_clause_info(t, curB->cp_ap, pe);
@ -1261,7 +1261,6 @@ static Term all_calls(bool internal USES_REGS) {
return Yap_MkApplTerm(f, 6, ts);
}
Term Yap_all_calls(void) {
CACHE_REGS
return all_calls(true PASS_REGS);
@ -1392,12 +1391,12 @@ void Yap_dump_code_area_for_profiler(void) {
while (pp != NULL) {
/* if (pp->ArityOfPE) {
fprintf(stderr,"%s/%d %p\n",
fprintf(stderr,"\%s/%d %p\n",
RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE,
pp->ArityOfPE,
pp);
} else {
fprintf(stderr,"%s %p\n",
fprintf(stderr,"\%s %p\n",
RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE,
pp);
}*/
@ -1797,23 +1796,83 @@ void Yap_dump_stack(void) {
/* check if handled */
if (handled_exception(PASS_REGS1))
return;
#if DEBUG
fprintf(stderr, "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",
#if DEBU
fprintf(stderr, "\% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",
P, CP, ASP, HR, TR, HeapTop);
fprintf(stderr, "%% YAP mode: %ux\n", (unsigned int)LOCAL_PrologMode);
if (LOCAL_ErrorMessage)
fprintf(stderr, "%% LOCAL_ErrorMessage: %s\n", LOCAL_ErrorMessage);
#endif
fprintf(stderr, "\% \n% =====================================\n\%\n");
fprintf(stderr, "\% \n% YAP Status:\n");
fprintf(stderr, "\% \n\% -------------------------------------\n\%\n");
yap_error_descriptor_t errno = LOCAL_Error_TYPE;
yap_error_class_number classno = Yap_errorClass(errno);
fprintf(stderr, "\% Error STATUS: %s/%s\n\n", Yap_errorName(errno),
Yap_errorName(classno));
fprintf(stderr, "\% Execution mode\n");
if (LOCAL_PrologMode & BootMode)
fprintf(stderr, "\% Bootstrap\n");
if (LOCAL_PrologMode & UserMode)
fprintf(stderr, "\% User Prolo\n");
if (LOCAL_PrologMode & CritMode)
fprintf(stderr, "\% Exclusive Access Mode\n");
if (LOCAL_PrologMode & AbortMode)
fprintf(stderr, "\% Abort\n");
if (LOCAL_PrologMode & InterruptMode)
fprintf(stderr, "\% Interrupt\n");
if (LOCAL_PrologMode & InErrorMode)
fprintf(stderr, "\% Error\n");
if (LOCAL_PrologMode & ConsoleGetcMode)
fprintf(stderr, "\% Prompt Console\n");
if (LOCAL_PrologMode & ExtendStackMode)
fprintf(stderr, "\% Stack expansion \n");
if (LOCAL_PrologMode & GrowHeapMode)
fprintf(stderr, "\% Data Base Expansion\n");
if (LOCAL_PrologMode & GrowStackMode)
fprintf(stderr, "\% User Prolog\n");
if (LOCAL_PrologMode & GCMode)
fprintf(stderr, "\% Garbage Collection\n");
if (LOCAL_PrologMode & ErrorHandlingMode)
fprintf(stderr, "\% Error handler\n");
if (LOCAL_PrologMode & CCallMode)
fprintf(stderr, "\% System Foreign Code\n");
if (LOCAL_PrologMode & UnifyMode)
fprintf(stderr, "\% Off-line Foreign Code\n");
if (LOCAL_PrologMode & UserCCallMode)
fprintf(stderr, "\% User Foreig C\n");
if (LOCAL_PrologMode & MallocMode)
fprintf(stderr, "\% Heap Allocaror\n");
if (LOCAL_PrologMode & SystemMode)
fprintf(stderr, "\% Prolog Internals\n");
if (LOCAL_PrologMode & AsyncIntMode)
fprintf(stderr, "\% Async Interruot mode\n");
if (LOCAL_PrologMode & InReadlineMode)
fprintf(stderr, "\% Readline Console\n");
if (LOCAL_PrologMode & TopGoalMode)
fprintf(stderr, "\% Creating new query\n");
fprintf(stderr, "\% \n\% -------------------------------------\n\%\n");
fprintf(stderr, "\% \n% YAP Program :\n");
fprintf(stderr, "\% \n\% -------------------------------------\n\%\n");
fprintf(stderr, "\% Program Position\n\n", Yap_errorName(errno),
Yap_errorName(classno);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "\% PC: %s\n", (char *)HR);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "\% Continuation: %s\n", (char *)HR);
Yap_detect_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "\% Alternative: %s\n", (char *)HR);
if (HR > ASP || HR > LCL0) {
fprintf(stderr, "%% YAP ERROR: Global Collided against Local (%p--%p)\n",
fprintf(stderr, "\% YAP ERROR: Global Collided against Local (%p--%p)\n",
HR, ASP);
} else if (HeapTop > (ADDR)LOCAL_GlobalBase) {
fprintf(stderr,
"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n",
"\% YAP ERROR: Code Space Collided against Global (%p--%p)\n",
HeapTop, LOCAL_GlobalBase);
} else {
#if !USE_SYSTEM_MALLOC
fprintf(stderr, "%ldKB of Code Space (%p--%p)\n",
fprintf(stderr, "\%ldKB of Code Space (%p--%p)\n",
(long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase,
HeapTop);
#if USE_DL_MALLOC
@ -1826,18 +1885,14 @@ void Yap_dump_stack(void) {
}
#endif
#endif
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%%\n%% PC: %s\n", (char *)HR);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%% Continuation: %s\n", (char *)HR);
fprintf(stderr, "%% %luKB of Global Stack (%p--%p)\n",
fprintf(stderr, "\% %luKB of Global Stack (%p--%p)\n",
(unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR);
fprintf(stderr, "%% %luKB of Local Stack (%p--%p)\n",
fprintf(stderr, "\% %luKB of Local Stack (%p--%p)\n",
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0);
fprintf(stderr, "%% %luKB of Trail (%p--%p)\n",
fprintf(stderr, "\% %luKB of Trail (%p--%p)\n",
(unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024,
LOCAL_TrailBase, TR);
fprintf(stderr, "%% Performed %ld garbage collections\n",
fprintf(stderr, "\% Performed %ld garbage collections\n",
(unsigned long int)LOCAL_GcCalls);
#if LOW_LEVEL_TRACER
{
@ -1852,20 +1907,20 @@ void Yap_dump_stack(void) {
}
}
#endif
fprintf(stderr, "%% All Active Calls and\n");
fprintf(stderr, "%% Goals With Alternatives Open (Global In "
fprintf(stderr, "\% All Active Calls and\n");
fprintf(stderr, "\% Goals With Alternatives Open (Global In "
"Use--Local In Use)\n%%\n");
while (b_ptr != NULL) {
while (env_ptr && env_ptr <= (CELL *)b_ptr) {
Yap_detect_bug_location(ipc, FIND_PRED_FROM_ENV, 256);
if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) {
b_ptr = b_ptr->cp_b;
fprintf(stderr, "%% %s\n", tp);
fprintf(stderr, "\% %s\n", tp);
} else {
fprintf(stderr, "%% %s\n", tp);
}
if (!max_count--) {
fprintf(stderr, "%% .....\n");
fprintf(stderr, "\% .....\n");
return;
}
ipc = (yamop *)(env_ptr[E_CP]);
@ -1873,7 +1928,7 @@ void Yap_dump_stack(void) {
}
if (b_ptr) {
if (!max_count--) {
fprintf(stderr, "%% .....\n");
fprintf(stderr, "\%\** .....\n");
return;
}
if (b_ptr->cp_ap && /* tabling */
@ -1882,7 +1937,7 @@ void Yap_dump_stack(void) {
b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) {
/* we can safely ignore ; because there is always an upper env */
Yap_detect_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
fprintf(stderr, "%% %s (%luKB--%luKB)\n", tp,
fprintf(stderr, "\% %s (%luKB--%luKB)\n", tp,
(unsigned long int)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024),
(unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024);
}
@ -1947,7 +2002,7 @@ void DumpActiveGoals(USES_REGS1) {
op_numbers opnum;
if (!ONLOCAL(b_ptr) || b_ptr->cp_b == NULL)
break;
fprintf(stderr, "%p ", b_ptr);
fprintf(stderr, "\%p ", b_ptr);
pe = Yap_PredForChoicePt(b_ptr, &opnum);
if (opnum == _Nstop) {
fprintf(stderr, " ********** C-Code Interface Boundary ***********\n");
@ -2035,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,
&pred_module)) == 0) {
/* system predicate */
fprintf(stderr, "%s", "meta-call");
fprintf(stderr, "\%s", "meta-call");
} else if (pred_module == 0) {
fprintf(stderr, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE,
(unsigned long int)pred_arity);
} else if (cl < 0) {
fprintf(stderr, "%s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE,
fprintf(stderr, "\%s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity);
} else {
fprintf(stderr, "%s:%s/%lu at clause %lu",
fprintf(stderr, "\%s:%s/%lu at clause %lu",
RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity,
(unsigned long int)cl);
}
}
static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, yamop *codeptr, PredEntry *pe) {
static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p,
yamop *codeptr, PredEntry *pe) {
CACHE_REGS
if (pe->ModuleOfPred == PROLOG_MODULE)
p->prologPredModule = AtomName(AtomProlog);
@ -2095,11 +2151,9 @@ static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, yamop
p->prologPredLine = 0;
}
}
}
else if (pe->OpcodeOfPred == UNDEF_OPCODE) {
} else if (pe->OpcodeOfPred == UNDEF_OPCODE) {
p->prologPredFile = "undefined";
}
else {
} else {
// by default, user_input
p->prologPredFile = AtomName(AtomUserIn);
p->prologPredLine = 0;
@ -2107,7 +2161,9 @@ static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, yamop
return p;
}
yap_error_descriptor_t * Yap_pc_add_location(yap_error_descriptor_t *t, void *pc0, void *b_ptr0, void *env0) {
yap_error_descriptor_t *Yap_pc_add_location(yap_error_descriptor_t *t,
void *pc0, void *b_ptr0,
void *env0) {
CACHE_REGS
yamop *xc = pc0;
// choiceptr b_ptr = b_ptr0;
@ -2128,7 +2184,9 @@ yap_error_descriptor_t * Yap_pc_add_location(yap_error_descriptor_t *t, void *pc
return NULL;
}
yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0, void *b_ptr0, void *env0, YAP_Int ignore_first) {
yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,
void *cp0, void *b_ptr0,
void *env0, YAP_Int ignore_first) {
yamop *cp = cp0;
choiceptr b_ptr = b_ptr0;
CELL *env = env0;
@ -2158,15 +2216,10 @@ yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0
}
/*
Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) {
while (true) {
if (b_ptr == NULL || env == NULL)
return TermNil;
PredEntry *pe = EnvPreg(cp);
if (pe == PredTrue)
return TermNil;
if (ignore_first <= 0 &&
pe
Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first)
{ while (true) { if (b_ptr == NULL || env == NULL) return TermNil; PredEntry
*pe = EnvPreg(cp); if (pe == PredTrue) return TermNil; if (ignore_first <= 0
&& pe
// pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) {
return add_bug_location(cp, pe);
@ -2185,10 +2238,7 @@ yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0
}
*/
static Term mkloc(yap_error_descriptor_t *t)
{
return TermNil;
}
static Term mkloc(yap_error_descriptor_t *t) { return TermNil; }
static Int clause_location(USES_REGS1) {
yap_error_descriptor_t t;
@ -2200,10 +2250,8 @@ static Int clause_location(USES_REGS1) {
static Int ancestor_location(USES_REGS1) {
yap_error_descriptor_t t;
memset(&t, 0, sizeof(yap_error_descriptor_t));
return
Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 2)), ARG2) &&
return Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 2)), ARG2) &&
Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 3)), ARG2);
}
void Yap_InitStInfo(void) {

2
C/stackinfo.c
View File

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

17
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)) &&
IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(lvl,
Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS) );
return pop_output_text_stack(
lvl, Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide
}
if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(lvl,
Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS));
return pop_output_text_stack(
lvl, Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a sfer, and representation is wide
}
if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
return pop_output_text_stack(lvl,
Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS));
return pop_output_text_stack(
lvl, Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS));
// this is a term, extract to a buffer, and representation is wide
}
if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
@ -721,7 +721,6 @@ void *write_buffer(unsigned char *s0, seq_tv_t *out USES_REGS) {
if (off <= 0 || chr > 255) {
pop_text_stack(l);
return NULL;
}
if (off == max)
break;
@ -786,8 +785,8 @@ static Term write_number(unsigned char *s, seq_tv_t *out,
static Term string_to_term(void *s, seq_tv_t *out USES_REGS) {
Term o;
yap_error_descriptor_t new_error;
bool mdnew = Yap_pushErrorContext(true, &new_error);
yap_error_descriptor_t *new_error = malloc(sizeof(yap_error_descriptor_t));
bool mdnew = Yap_pushErrorContext(true, new_error);
o = out->val.t = Yap_BufferToTerm(s, TermNil);
Yap_popErrorContext(mdnew, true);

3
C/write.c
View File

@ -760,7 +760,8 @@ static void write_var(CELL *t, struct write_globs *wglb,
wrputc(',', wglb->stream);
attv = RepAttVar((CELL *)Yap_GetFromHandle(h));
l = &attv->Value;;
l = &attv->Value;
;
l++;
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);

14
H/YapFlags.h
View File

@ -388,9 +388,19 @@ Term Yap_UnknownFlag(Term mod);
bool rmdot(Term inp);
xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n);
#define Yap_ArgListToVector(l, def, n, e) \
Yap_ArgListToVector__(__FILE__, __FUNCTION__, __LINE__, l, def, n, e)
xarg *Yap_ArgList2ToVector(Term listl, const param2_t *def, int n);
extern xarg *Yap_ArgListToVector__(const char *file, const char *function, int lineno,Term listl, const param_t *def, int n,
yap_error_number e);
#define Yap_ArgListToVector(l, def, n, e) \
Yap_ArgListToVector__(__FILE__, __FUNCTION__, __LINE__, l, def, n, e)
extern xarg *Yap_ArgList2ToVector__(const char *file, const char *function, int lineno, Term listl, const param2_t *def, int n, yap_error_number e);
#define Yap_ArgList2ToVector(l, def, n, e) \
Yap_ArgList2ToVector__(__FILE__, __FUNCTION__, __LINE__, l, def, n, e)
#endif // YAP_FLAGS_H

3
include/YapErrors.h
View File

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

2
include/YapStreams.h
View File

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

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_)
@ -302,9 +252,13 @@ Interface with _tmpnam_: obtain a new, unique file name _File_.
*/
/** @pred working_directory(- _Old_,+ _New_)
/** @pred working_directory(- _CurDir_,? _NextDir_)
Unify _Old_ with an absolute path to the current working directory
Fetch the current directory at _CurDir_. If _NextDir_ is bound
to an atom, make its value the current working directory.
Unifies _Old_ with an absolute path to the current working directory
and change working directory to _New_. Use the pattern
`working_directory(CWD, CWD)` to get the current directory. See
also `absolute_file_name/2` and chdir/1.
@ -371,10 +325,37 @@ check_int(I, Inp) :-
% file operations
% file operations
/** @pred delete_file(+ _File_)
The delete_file/1 procedure removes file _File_. If
_File_ is a directory, remove the directory <em>and all its subdirectories</em>.
~~~~~
?- delete_file(x).
~~~~~
See delete_file/2 for a more flexible version.
*/
delete_file(IFile) :-
true_file_name(IFile, File),
delete_file(File, off, on, off).
/** @pred delete_file(+ _File_,+ _Opts_)
The `delete_file/2` procedure removes file _File_ according to
options _Opts_. These options are `directory` if one should
remove directories, `recursive` if one should remove directories
recursively, and `ignore` if errors are not to be reported.
This example is equivalent to using the delete_file/1 predicate:
~~~~~
?- delete_file(x, [recursive]).
~~~~~
*/
delete_file(IFile, Opts) :-
true_file_name(IFile, File),
process_delete_file_opts(Opts, Dir, Recurse, Ignore, delete_file(File,Opts)),
@ -421,7 +402,7 @@ rm_directory(File, Ignore) :-
handle_system_internal(Error, Ignore, delete_file(File)).
delete_directory(on, File, Ignore) :-
directory_files(File, FileList, Ignore),
directory_files(File, FileList),
path_separator(D),
atom_concat(File, D, FileP),
delete_dirfiles(FileList, FileP, Ignore),
@ -475,6 +456,19 @@ file_property(File, Type, Size, Date, Permissions, LinkName) :-
handle_system_internal(Error, off, file_property(File)).
/** @pred environ(? _EnvVar_,+ _EnvValue_)
Unify environment variable _EnvVar_ with its value _EnvValue_,
if there is one. This predicate is backtrackable in Unix systems, but
not currently in Win32 configurations.
~~~~~
?- environ('HOME',X).
X = 'C:\\cygwin\\home\\administrator' ?
~~~~~
*/
/** @pred environ(+E, -S)
Given an environment variable _E_ this predicate unifies the second
@ -686,75 +680,7 @@ get_shell(Shell, '/c') :-
get_shell('/bin/sh','-c').
system :-
default_shell(C/** @pred directory_files(+ _Dir_,+ _List_)a
Given a directory _Dir_, directory_files/2 procedures a
listing of all files and directories in the directory:
~~~~~
?- directory_files('.',L), writeq(L).
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the/** @pred directory_files(+ _Dir_,+ _List_)a
Given a directory _Dir_, directory_files/2 procedures a
listing of all files and directories in the directory:
~~~~~
?- directory_files('.',L), writeq(L).
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the/** @pred directory_files(+ _Dir_,+ _List_)a
Given a directory _Dir_, directory_files/2 procedures a
listing of all files and directories in the directory:
~~~~~
?- directory_files('.',L), writeq(L).
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the `dirent` family of routines in Unix
environments, and `findfirst` in WIN32.
*/
`dirent` family of routines in Unix
environments, and `findfirst` in WIN32.
*/
`dirent` family of routines in Unix
environments, and `findfirst` in WIN32.
*/
ommand),/** @pred directory_files(+ _Dir_,+ _List_)a
Given a directory _Dir_, directory_files/2 procedures a
listing of all files and directories in the directory:
~~~~~
?- directory_files('.',L), writeq(L).
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the/** @pred directory_files(+ _Dir_,+ _List_)a
Given a directory _Dir_, directory_files/2 procedures a
listing of all files and directories in the directory:
~~~~~
?- directory_files('.',L), writeq(L).
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the
*/
default_shell(Command),
do_system(Command, _Status, Error),
handle_system_internal(Error, off, system).
@ -858,7 +784,7 @@ Passes command _S_ to the Bourne shell (on UNIX environments) or the
current command interpreter in WIN32 environments.
*/
/** @pred directory_files(+ _Dir_,+ _List_)a
/** @pred directory_files(+ _Dir_,+ _List_)
Given a directory _Dir_, directory_files/2 procedures a
@ -869,11 +795,10 @@ listing of all files and directories in the directory:
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
~~~~~
The predicates uses the `dirent` family of routines in Unix
environments, and `findfirst` in WIN32.
environments, and `findfirst` in WIN32 through the system_library buil
*/
directory_files(X,Y) :=
directory_files(X,Y) :-
list_directory(X,Y).
/** @} */

12
os/files.c
View File

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

5
os/fmem.c
View File

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

253
os/iopreds.c
View File

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

40
os/readterm.c
View File

@ -209,8 +209,14 @@ static const param_t read_defs[] = {READ_DEFS()};
static Term add_output(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomOutput, 1), 1);
tail = Deref(tail);
if (IsVarTerm(tail)) {
Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
}
Yap_unify(t, ArgOfTerm(1, topt));
if (IsPairTerm(tail) || tail == TermNil) {
if (IsVarTerm(tail)) {
Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
} else if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
@ -220,7 +226,9 @@ static Term add_output(Term t, Term tail) {
static Term add_names(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
if (IsPairTerm(tail) || tail == TermNil) {
if (IsVarTerm(tail)) {
Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
} else if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
@ -230,7 +238,9 @@ static Term add_names(Term t, Term tail) {
static Term add_priority(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt));
if (IsPairTerm(tail) || tail == TermNil) {
if (IsVarTerm(tail)) {
Yap_ThrowError(INSTANTIATION_ERROR, tail, "unbound list of options");
} else if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
@ -469,10 +479,9 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
LOCAL_VarTable = NULL;
LOCAL_AnonVarTable = NULL;
fe->enc = GLOBAL_Stream[inp_stream].encoding;
xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END);
xarg *args =
Yap_ArgListToVector(opts, read_defs, READ_END, DOMAIN_ERROR_READ_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
return NULL;
}
@ -541,9 +550,9 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
if (args[READ_PRIORITY].used) {
re->prio = IntegerOfTerm(args[READ_PRIORITY].tvalue);
if (re->prio > GLOBAL_MaxPriority) {
Yap_Error(DOMAIN_ERROR_OPERATOR_PRIORITY, opts,
"max priority in Prolog is %d, not %ld", GLOBAL_MaxPriority,
re->prio);
Yap_ThrowError(DOMAIN_ERROR_OPERATOR_PRIORITY, opts,
"max priority in Prolog is %d, not %ld",
GLOBAL_MaxPriority, re->prio);
}
} else {
re->prio = LOCAL_default_priority;
@ -998,10 +1007,9 @@ Term Yap_read_term(int sno, Term opts, bool clause) {
int emacs_cares = FALSE;
#endif
yap_error_descriptor_t new;
yap_error_descriptor_t *new = malloc(sizeof *new);
bool err = Yap_pushErrorContext(true,&new);
bool err = Yap_pushErrorContext(true, new);
int lvl = push_text_stack();
parser_state_t state = YAP_START_PARSING;
while (true) {
@ -1104,10 +1112,9 @@ static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()};
static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, int sno) {
CACHE_REGS
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END);
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END,
DOMAIN_ERROR_READ_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
return NULL;
}
if (args[READ_CLAUSE_OUTPUT].used) {
@ -1412,7 +1419,8 @@ Term Yap_UBufferToTerm(const unsigned char *s, Term opts) {
return rval;
}
X_API Term Yap_BufferToTermWithPrioBindings(const char *s, Term opts, Term bindings, size_t len,
X_API Term Yap_BufferToTermWithPrioBindings(const char *s, Term opts,
Term bindings, size_t len,
int prio) {
CACHE_REGS
Term ctl;

82
os/streams.c
View File

@ -8,10 +8,8 @@
* *
**************************************************************************
* *
* File: iopreds.c *
* Last rev: 5/2/88 *
* mods: *
* comments: Input/Output C implemented predicates *
* File: iopreds.c * Last rev: 5/2/88
** mods: * comments: Input/Output C implemented predicates *
* *
*************************************************************************/
#ifdef SCCS
@ -31,10 +29,10 @@ static char SccsId[] = "%W% %G%";
/* for O_BINARY and O_TEXT in WIN32 */
#include <fcntl.h>
#endif
#include "YapEval.h"
#include "YapHeap.h"
#include "YapText.h"
#include "Yatom.h"
#include "YapEval.h"
#include "yapio.h"
#include <stdlib.h>
#if HAVE_STDARG_H
@ -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)
return true;
if (GLOBAL_Stream[sno].vfs) {
@ -178,9 +175,7 @@ int Yap_GetFreeStreamD(void) { return GetFreeStreamD(); }
return false;
}
bool Yap_flush(int sno)
{
bool Yap_flush(int sno) {
if (!(GLOBAL_Stream[sno].status & Tty_Stream_f))
return true;
if (GLOBAL_Stream[sno].vfs) {
@ -190,10 +185,9 @@ bool Yap_flush(int sno)
return fflush(GLOBAL_Stream[sno].file) == 0;
}
static Int clear_input( USES_REGS1 )
{
int sno = Yap_CheckStream(ARG1, Input_Stream_f | Socket_Stream_f,
"clear_input/1");
static Int clear_input(USES_REGS1) {
int sno =
Yap_CheckStream(ARG1, Input_Stream_f | Socket_Stream_f, "clear_input/1");
if (sno != -1)
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_clearInput(sno);
@ -251,8 +245,9 @@ static Int p_check_stream(USES_REGS1) { /* '$check_stream'(Stream,Mode) */
}
static Int p_check_if_stream(USES_REGS1) { /* '$check_stream'(Stream) */
int sno = Yap_CheckStream(ARG1, Input_Stream_f | Output_Stream_f |
Append_Stream_f | Socket_Stream_f,
int sno = Yap_CheckStream(ARG1,
Input_Stream_f | Output_Stream_f | Append_Stream_f |
Socket_Stream_f,
"check_stream/1");
if (sno != -1)
UNLOCK(GLOBAL_Stream[sno].streamlock);
@ -300,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->seek && GLOBAL_Stream[sno].vfs->seek(sno, 0L, SEEK_END) == -1) {
if (GLOBAL_Stream[sno].vfs->seek &&
GLOBAL_Stream[sno].vfs->seek(sno, 0L, SEEK_END) == -1) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(SYSTEM_ERROR_INTERNAL, pos,
"fseek failed for set_stream_position/2: %s", strerror(errno));
@ -340,7 +332,8 @@ char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) {
#if __linux__
char *path = malloc(1024);
if (snprintf(path, 1023, "/proc/self/fd/%d", f) && readlink(path, nameb, maxs)) {
if (snprintf(path, 1023, "/proc/self/fd/%d", f) &&
readlink(path, nameb, maxs)) {
free(path);
return nameb;
}
@ -443,9 +436,7 @@ found_eof(int sno,
return Yap_unify(t2, MkAtomTerm(AtomAltNot));
}
static bool
stream_mode(int sno,
Term t2 USES_REGS) {
static bool stream_mode(int sno, Term t2 USES_REGS) {
/* '$set_output'(+Stream,-ErrorMessage) */
stream_flags_t flags = GLOBAL_Stream[sno].status;
if (!IsVarTerm(t2) && !(isatom(t2))) {
@ -687,7 +678,8 @@ static xarg *generate_property(int sno, Term t2,
Functor f = Yap_MkFunctor(Yap_LookupAtom(stream_property_defs[p].name), 1);
Yap_unify(t2, Yap_MkNewApplTerm(f, 1));
}
return Yap_ArgListToVector(t2, stream_property_defs, STREAM_PROPERTY_END);
return Yap_ArgListToVector(t2, stream_property_defs, STREAM_PROPERTY_END,
DOMAIN_ERROR_STREAM_PROPERTY_OPTION);
}
static Int cont_stream_property(USES_REGS1) { /* current_stream */
@ -706,7 +698,8 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
EXTRA_CBACK_ARG(2, 2) = MkIntTerm(p % STREAM_PROPERTY_END);
// otherwise, just drop through
} else {
args = Yap_ArgListToVector(t2, stream_property_defs, STREAM_PROPERTY_END);
args = Yap_ArgListToVector(t2, stream_property_defs, STREAM_PROPERTY_END,
DOMAIN_ERROR_STREAM_PROPERTY_OPTION);
}
if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
@ -790,7 +783,8 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */
return cont_stream_property(PASS_REGS1);
}
args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs,
STREAM_PROPERTY_END);
STREAM_PROPERTY_END,
DOMAIN_ERROR_STREAM_PROPERTY_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
@ -850,7 +844,8 @@ static bool do_set_stream(int sno,
set_stream_enum_choices_t i;
bool rc = true;
args = Yap_ArgListToVector(opts, set_stream_defs, SET_STREAM_END);
args = Yap_ArgListToVector(opts, set_stream_defs, SET_STREAM_END,
DOMAIN_ERROR_SET_STREAM_OPTION);
if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
@ -1001,7 +996,8 @@ static void CloseStream(int sno) {
// fflush(NULL);
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) {
me->close(sno);
}
@ -1010,8 +1006,8 @@ static void CloseStream(int sno) {
(GLOBAL_Stream[sno].status & Popen_Stream_f)) {
pclose(GLOBAL_Stream[sno].file);
} else if (GLOBAL_Stream[sno].file &&
!(GLOBAL_Stream[sno].status &
(Null_Stream_f | Socket_Stream_f | InMemory_Stream_f | Pipe_Stream_f)))
!(GLOBAL_Stream[sno].status & (Null_Stream_f | Socket_Stream_f |
InMemory_Stream_f | Pipe_Stream_f)))
fclose(GLOBAL_Stream[sno].file);
#if HAVE_SOCKET
else if (GLOBAL_Stream[sno].status & (Socket_Stream_f)) {
@ -1085,8 +1081,7 @@ static Int current_input(USES_REGS1) { /* current_input(?Stream) */
}
}
bool Yap_SetInputStream( Term sd )
{
bool Yap_SetInputStream(Term sd) {
int sno = Yap_CheckStream(sd, Input_Stream_f, "set_input/1");
if (sno < 0)
return false;
@ -1096,7 +1091,6 @@ bool Yap_SetInputStream( Term sd )
return true;
}
/** @pred set_input(+ _S_) is iso
* Set stream _S_ as the current input stream. Predicates like read/1
* and get/1 will start using stream _S_ by default.
@ -1124,8 +1118,7 @@ static Int current_output(USES_REGS1) { /* current_output(?Stream) */
}
}
bool Yap_SetOutputStream( Term sd )
{
bool Yap_SetOutputStream(Term sd) {
int sno =
Yap_CheckStream(sd, Output_Stream_f | Append_Stream_f, "set_output/2");
if (sno < 0)
@ -1135,8 +1128,7 @@ bool Yap_SetOutputStream( Term sd )
return true;
}
bool Yap_SetErrorStream( Term sd )
{
bool Yap_SetErrorStream(Term sd) {
int sno =
Yap_CheckStream(sd, Output_Stream_f | Append_Stream_f, "set_error/2");
if (sno < 0)
@ -1159,8 +1151,6 @@ static Int set_output(USES_REGS1) { /* '$show_stream_position'(+Stream,Pos) */
return Yap_SetOutputStream(ARG1);
}
static Int p_user_file_name(USES_REGS1) {
Term tout;
int sno =
@ -1363,10 +1353,12 @@ static Int
return (FALSE);
}
if (GLOBAL_Stream[sno].vfs) {
if (GLOBAL_Stream[sno].vfs->seek && GLOBAL_Stream[sno].vfs->seek(sno, 0L, SEEK_END) == -1) {
if (GLOBAL_Stream[sno].vfs->seek &&
GLOBAL_Stream[sno].vfs->seek(sno, 0L, SEEK_END) == -1) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(SYSTEM_ERROR_INTERNAL, tp,
"fseek failed for set_stream_position/2: %s", strerror(errno));
"fseek failed for set_stream_position/2: %s",
strerror(errno));
return (FALSE);
}
} 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;
#endif
args = Yap_ArgListToVector(opts, expand_filename_defs, EXPAND_FILENAME_END);
args = Yap_ArgListToVector(
opts, expand_filename_defs,
EXPAND_FILENAME_END,DOMAIN_ERROR_EXPAND_FILENAME_OPTION);
if (args == NULL) {
return TermNil;
}

55
os/writeterm.c
View File

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

33
packages/python/pyio.c
View File

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

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

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

2
pl/listing.yap
View File

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

34
pl/messages.yap
View File

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