This commit is contained in:
Vitor Santos Costa
2019-02-27 04:23:21 +00:00
parent 5d7c6378e7
commit 2d65d0463c
30 changed files with 527 additions and 424 deletions

View File

@@ -2539,7 +2539,7 @@ static Int
// if (!pe) pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate");
if (EndOfPAEntr(pe))
return FALSE;
return (pe->ModuleOfPred == 0);
return (pe->ModuleOfPred == 0 || pe-> PredFlags & UserCPredFlag);
// return true;
// PELOCK(27, pe);
// out = (pe->PredFlags & SystemPredFlags);

View File

@@ -107,6 +107,9 @@ if (strcmp(ks, q) == 0 ) \
if (i->k == NULL) return TermNil; \
Term t; if((t = Yap_BufferToTerm(i->k, TermNil) ) == 0 ) return TermNil; return t; }
static yap_error_descriptor_t *CopyException(yap_error_descriptor_t *t);
static Term queryErr(const char *q, yap_error_descriptor_t *i) {
query_key_i(errorNo, "errorNo", q, i);
query_key_i(errorClass, "errorClass", q, i);
@@ -332,15 +335,17 @@ bool Yap_PrintWarning(Term twarning) {
CACHE_REGS
PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
if (twarning)
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)",
Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f | Ignore_cyclics_f));
Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule);
bool rc;
Term ts[2], err;
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError &&
if (twarning && LOCAL_PrologMode & InErrorMode &&
LOCAL_ActiveError->errorClass != WARNING &&
(err = LOCAL_ActiveError->errorNo)) {
(err = LOCAL_ActiveError->errorNo) ) {
fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
Yap_TermToBuffer(twarning,
Quote_illegal_f | Ignore_ops_f),
@@ -352,12 +357,16 @@ bool Yap_PrintWarning(Term twarning) {
fprintf(stderr, "%s:%ld/* d:%d warning */:\n",
LOCAL_ActiveError->errorFile,
LOCAL_ActiveError->errorLine, 0 );
if (!twarning)
twarning = Yap_MkFullError();
Yap_DebugPlWriteln(twarning);
LOCAL_DoingUndefp = false;
LOCAL_PrologMode &= ~InErrorMode;
CurrentModule = cmod;
return false;
}
if (!twarning)
twarning = Yap_MkFullError();
ts[1] = twarning;
ts[0] = MkAtomTerm(AtomWarning);
rc = Yap_execute_pred(pred, ts, true PASS_REGS);
@@ -656,7 +665,7 @@ void Yap_ThrowExistingError(void) {
Term Yap_MkFullError(void)
{
yap_error_descriptor_t *i = Yap_local.ActiveError;
yap_error_descriptor_t *i = CopyException(Yap_local.ActiveError);
i->errorAsText = Yap_errorName( i->errorNo );
i->errorClass = Yap_errorClass( i-> errorNo );
i->classAsText = Yap_errorClassName(i->errorClass);
@@ -880,7 +889,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
if (LOCAL_DoingUndefp) {
LOCAL_DoingUndefp = false;
LOCAL_Signals = 0;
Yap_PrintWarning(MkErrorTerm(Yap_GetException(LOCAL_ActiveError)));
yap_error_descriptor_t *co = CopyException( LOCAL_ActiveError );
Yap_PrintWarning(MkErrorTerm(Yap_GetException( co )));
return P;
}
// LOCAL_ActiveError = Yap_GetException();
@@ -1012,6 +1022,7 @@ bool Yap_ResetException(yap_error_descriptor_t *i) {
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;
@@ -1023,6 +1034,13 @@ Term MkErrorTerm(yap_error_descriptor_t *t) {
err2list(t));
}
static yap_error_descriptor_t *CopyException(yap_error_descriptor_t *t) {
yap_error_descriptor_t *n = malloc( sizeof( yap_error_descriptor_t ));
memcpy(n, t, sizeof( yap_error_descriptor_t ) );
return n;
}
static Int read_exception(USES_REGS1) {
yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1));
Term rc = MkErrorTerm(t);

View File

@@ -1065,8 +1065,8 @@ static Int _user_expand_goal(USES_REGS1) {
ARG1 = g;
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, true PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true , omod, sl, creeping);
}
/* system:goal_expansion(A,B) */
mg_args[0] = cmod;
@@ -1076,7 +1076,7 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, true PASS_REGS)) {
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
@@ -1087,7 +1087,7 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, true PASS_REGS)) {
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
@@ -1101,7 +1101,7 @@ static Int _user_expand_goal(USES_REGS1) {
(pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, true PASS_REGS)) {
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
@@ -1164,6 +1164,12 @@ restart_exec:
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredPropByAtom(a, mod);
} else if (IsPairTerm(t)) {
Term ts[2];
ts[0] = t;
ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
t = Yap_MkApplTerm(FunctorCsult, 2, ts);
goto restart_exec;
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
register unsigned int i;
@@ -1207,8 +1213,9 @@ restart_exec:
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
return false;
//Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
//return false;
return CallMetaCall(t, mod);
}
/* N = arity; */
/* call may not define new system predicates!! */
@@ -1264,8 +1271,7 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
return FALSE;
return CallMetaCall(t, mod);
}
/* N = arity; */
/* call may not define new system predicates!! */

View File

@@ -89,10 +89,10 @@ typedef struct non_single_struct_t {
CELL *pt0, *pt0_end; \
size_t auxsz = 1024 * sizeof(struct non_single_struct_t);\
struct non_single_struct_t *to_visit0=NULL, *to_visit,* to_visit_max;\
to_visit0 = Realloc(to_visit0,auxsz); \
CELL *InitialH = HR;\
tr_fr_ptr TR0 = TR;\
reset:\
to_visit0 = Realloc(to_visit0,auxsz); \
pt0 = pt0_; pt0_end = pt0_end_; \
to_visit = to_visit0, \
to_visit_max = to_visit + auxsz/sizeof(struct non_single_struct_t);\
@@ -306,8 +306,10 @@ static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) {
reset:
pt0 = pt0_, pt0_end = pt0_end_;
to_visit= to_visit0,
to_visit_max = to_visit0 + auxsz/sizeof(struct non_single_struct_t);
to_visit0 = Realloc(to_visit0,auxsz);
to_visit= to_visit0;
to_visit_max = to_visit0 + auxsz/sizeof(struct non_single_struct_t);
auxsz *= 2;
int rc = 0;
CELL *ptf;
ptf = HR;
@@ -811,8 +813,8 @@ static Term new_vars_in_complex_term(
CELL output = TermNil;
{
tr_fr_ptr myTR0 = TR;
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
int lvl = push_text_stack();
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
n++;
@@ -827,6 +829,7 @@ static Term new_vars_in_complex_term(
}
inp = TailOfTerm(inp);
}
pop_text_stack(lvl);
}
WALK_COMPLEX_TERM();
output = MkPairTerm((CELL)ptd0, output);
@@ -958,14 +961,14 @@ static Int free_variables_in_term(
Term out;
Term t, t0;
Term found_module = 0L;
Term vlist = TermNil;
Term bounds = TermNil;
t = t0 = Deref(ARG1);
Int delta = 0;
while (!IsVarTerm(t) && IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (f == FunctorHat) {
vlist = Yap_TermAddVariables(ArgOfTerm(1,t), vlist PASS_REGS);
bounds = MkPairTerm(ArgOfTerm(1,t),bounds);
} else if (f == FunctorModule) {
found_module = ArgOfTerm(1, t);
} else if (f == FunctorCall) {
@@ -981,7 +984,7 @@ static Int free_variables_in_term(
if (IsPrimitiveTerm(t))
out = TermNil;
else {
out = new_vars_in_complex_term(&(t)-1, &(t), vlist PASS_REGS);
out = new_vars_in_complex_term(&(t)-1, &(t), Yap_TermVariables(bounds, 3) PASS_REGS);
}
if (found_module && t != t0) {

View File

@@ -152,19 +152,20 @@ clean_complex_tr(tr_fr_ptr TR0 USES_REGS) {
#define expand_stack(S0,SP,SF,TYPE) \
{ size_t sz = SF-S0, used = SP-S0; \
S0 = Realxbloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
SP = S0+used; SF = S0+sz; }
#define MIN_ARENA_SIZE (1048L)
int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
bool share, Term *split, bool copy_att_vars, CELL *ptf,
bool share, bool copy_att_vars, CELL *ptf,
CELL *HLow USES_REGS) {
// fprintf(stderr,"+++++++++\n");
//CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x);
int lvl = push_text_stack();
Term o = TermNil;
struct cp_frame *to_visit0,
*to_visit = Malloc(1024*sizeof(struct cp_frame));
struct cp_frame *to_visit_max;
@@ -188,42 +189,25 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
copy_term_nvar : {
if (IsPairTerm(d0)) {
CELL *headp = RepPair(d0);
Term head = *headp;
if (IsPairTerm(head) && RepPair(head) >= HB && RepPair(head) < HR) {
if (split) {
Term v = Yap_MkNewApplTerm(FunctorEq, 2);
RepAppl(v)[1] = AbsPair(ptf);
*headp = *ptf++ = RepAppl(v)[0];
o = MkPairTerm( v, o );
} else {
*ptf++ = RepPair(head)[0];;
}
continue;
} else if (IsApplTerm(head) && RepAppl(head) >= HB && RepAppl(head) < HR) {
*ptf++ = RepAppl(head)[0];
if (//(share && headp < HB) ||
(IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR)) {
/* If this is newer than the current term, just reuse */
*ptf++ = *headp;
continue;
}
*ptf++ = AbsPair(HR);
if (to_visit >= to_visit_max-32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
*ptf = AbsPair(HR);
ptf++;
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->curp = headp;
d0 = to_visit->oldv = head;
to_visit->ground = ground;
to_visit++;
// move to new list
if (share) {
TrailedMaBind(headp,AbsPair(HR));
} else {
/* If this is newer than the current term, just reuse */
*headp = AbsPair(HR);
}
if (split) {
TrailedMaBind(ptf,AbsPair(HR));
}
d0 = *headp;
TrailedMaBind(headp, AbsPair(HR));
pt0 = headp;
pt0_end = headp + 1;
ptf = HR;
@@ -232,47 +216,21 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
d0 = head;
ptd0 = pt0;
goto deref;
} else if (IsApplTerm(d0)) {
Functor f;
CELL *headp, head;
register Functor f;
register CELL *headp;
/* store the terms to visit */
headp = RepAppl(d0);
head = *headp;
if (IsPairTerm(head)) {
if (split) {
Term v = Yap_MkNewApplTerm(FunctorEq, 2);
RepAppl(v)[1] = AbsPair(ptf);
*headp = *ptf++ = RepAppl(v)[0];
o = MkPairTerm( v, o );
} else {
*ptf++ = RepPair(head)[0];;
}
continue;
} else if (IsApplTerm(head)) {
*ptf++ = RepAppl(head)[0];
if (IsApplTerm(*headp)//(share && headp < HB) ||
) {
/* If this is newer than the current term, just reuse */
*ptf++ = *headp;
continue;
}
f = (Functor)(head);
if (share && (ground || IsExtensionFunctor(f))) {
*ptf++ = d0;
continue;
}
/* store the terms to visit */
*ptf = AbsAppl(HR);
ptf++;
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->curp = headp;
to_visit->oldv = head;
to_visit->ground = ground;
if (++to_visit >= to_visit_max-32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
f = (Functor)(*headp);
if (IsExtensionFunctor(f)) {
switch ((CELL)f) {
case (CELL) FunctorDBRef:
@@ -321,42 +279,44 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
/* big int */
size_t sz = (sizeof(MP_INT) + 3 * CellSize +
((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) /
CellSize;
CellSize,
i;
if (HR > ASP - (MIN_ARENA_SIZE + sz)) {
goto overflow;
}
*ptf++ = AbsAppl(HR);
memmove(HR, headp, sz*sizeof(CELL));
MP_INT *new = (MP_INT *)(HR + 2);
new->_mp_d = (mp_limb_t *)(new + 1);
HR[0] = (CELL)f;
for (i = 1; i < sz; i++) {
HR[i] = headp[i];
}
HR += sz;
}
}
continue;
}
*ptf = AbsAppl(HR);
ptf++;
/* store the terms to visit */
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->ground = ground;
if (++to_visit >= to_visit_max-32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
if (share) {
TrailedMaBind(headp,AbsPair(HR));
} else {
*headp = AbsPair(HR);
}
if (split) {
// must be after trailing source term, so that we can check the source
// term and confirm it is still ok.
TrailedMaBind(ptf,AbsAppl(HR));
}
TrailedMaBind(headp,AbsAppl(HR));
ptf = HR;
ptf[0] = (CELL)f;
*ptf++ = (CELL)f;
ground = true;
arity_t a = ArityOfFunctor(f);
if (HR > ASP - MIN_ARENA_SIZE) {
HR = ptf+a;
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
ptf++;
HR = ptf+a;
pt0_end = headp+(a);
pt0 = headp;
pt0 = headp;
pt0_end = headp+a;
ground = (f != FunctorMutable);
} else {
/* just copy atoms or integers */
@@ -369,43 +329,44 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
ground = false;
/* don't need to copy variables if we want to share the global term */
if (//(share && ptd0 < HB && ptd0 > H0) ||
(ptd0 >= HB && ptd0 < HR)) {
(ptd0 >= HLow && ptd0 < HR)) {
/* we have already found this cell */
*ptf++ = (CELL)ptd0;
} else
if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) {
/* if unbound, call the standard copy term routine */
struct cp_frame *bp;
bp = to_visit;
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp,
ptf PASS_REGS)) {
goto overflow;
}
to_visit = bp;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow;
}
}
} else {
/* first time we met this term */
RESET_VARIABLE(ptf);
*ptd0 = (CELL)ptf;
ptf++;
TrailTerm(TR++) = (CELL)ptd0;
if ((ADDR)TR > LOCAL_TrailTop - 16)
goto trail_overflow;
if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) {
/* if unbound, call the standard copy term routine */
struct cp_frame *bp;
CELL new;
bp = to_visit;
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp,
ptf PASS_REGS)) {
goto overflow;
}
to_visit = bp;
new = *ptf;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow;
}
}
TrailedMaBind(ptd0, new);
ptf++;
} else {
/* first time we met this term */
RESET_VARIABLE(ptf);
if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE)
goto trail_overflow;
TrailedMaBind(ptd0, (CELL)ptf);
ptf++;
}
}
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
to_visit--;
if (!share)
*to_visit->curp = to_visit->oldv;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
@@ -414,7 +375,7 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
}
/* restore our nice, friendly, term to its original state */
clean_complex_tr(TR0 PASS_REGS);
clean_dirty_tr(TR0 PASS_REGS);
/* follow chain of multi-assigned variables */
pop_text_stack(lvl);
return 0;
@@ -491,6 +452,7 @@ handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t)
}
}
static Term
CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
Term t = Deref(inp);
@@ -505,7 +467,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
Hi = HR;
HR ++;
if ((res = Yap_copy_complex_term((&t)-1, &t, share, NULL, newattvs, Hi, HR PASS_REGS)) < 0) {
if ((res = Yap_copy_complex_term((&t)-1, &t, share, newattvs, Hi, HR PASS_REGS)) < 0) {
HR = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@@ -579,16 +541,6 @@ typedef struct copy_frame {
CELL *to;
} copy_frame_t;
static Term
add_to_list( Term inp, Term v, Term t PASS_REGS)
{
Term ta[2];
ta[0] = v;
ta[1] = t;
return MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), inp);
}
/*
@@ -2585,14 +2537,6 @@ p_is_list_or_partial_list( USES_REGS1 )
return Yap_IsListOrPartialListTerm(Deref(ARG1));
}
static Term
numbervar(Int id USES_REGS)
{
Term ts[1];
ts[0] = MkIntegerTerm(id);
return Yap_MkApplTerm(FunctorDollarVar, 1, ts);
}
#if 0
static Term
numbervar_singleton(USES_REGS1)