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

bug

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-01-27 23:54:02 +00:00
parent 36fedfa321
commit 7f71184785
7 changed files with 99 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
C/globals.c
View File

@ -335,61 +335,24 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
UInt arity, Term *newarena, UInt arity, Term *newarena,
size_t min_grow USES_REGS) { size_t min_grow USES_REGS) {
size_t old_size = ArenaSz(arena); size_t old_size = ArenaSz(arena);
CELL *oldH = HR; CELL *Hi;
int res = 0;
t = Deref(t); Yap_DebugPlWriteln(t);
CELL *oldH = HR;
CELL *oldHB = HB; CELL *oldHB = HB;
CELL *oldASP = ASP; CELL *oldASP = ASP;
int res = 0;
Term tn;
restart:
t = Deref(t);
if (IsVarTerm(t)) {
ASP = ArenaLimit(arena); ASP = ArenaLimit(arena);
HR = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
#if COROUTINING Term o = MkVarTerm();
if (GlobalIsAttachedTerm(t)) { while (true) {
CELL *Hi; if ((res = Yap_copy_complex_term(&t-1, &t, share, NULL, copy_att_vars,
VarOfTerm(o), HB PASS_REGS)) == 0) {
*HR = t;
Hi = HR + 1;
HR += 2;
if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, NULL, copy_att_vars, Hi,
Hi PASS_REGS)) < 0)
goto error_handler;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
return Hi[0]; Yap_DebugPlWriteln(o);
return o;
} }
#endif
if (share && VarOfTerm(t) > ArenaPt(arena)) {
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
return t;
}
tn = MkVarTerm();
if (HR > ASP - MIN_ARENA_SIZE) {
res = -1;
goto error_handler;
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
return tn;
} else if (IsAtomOrIntTerm(t)) {
return t;
} else {
CELL *Hi;
Hi = HR;
HR++;
oldH = HR;
HR = HB = ArenaPt(arena);
ASP = ArenaLimit(arena);
if ((res = Yap_copy_complex_term(&t - 1, &t, share, NULL, copy_att_vars, Hi,
HR PASS_REGS)) < 0) {
goto error_handler;
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
return Hi[0];
}
error_handler:
HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
XREGS[arity + 1] = t; XREGS[arity + 1] = t;
XREGS[arity + 2] = arena; XREGS[arity + 2] = arena;
@ -422,7 +385,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
arena = Deref(XREGS[arity + 2]); arena = Deref(XREGS[arity + 2]);
t = XREGS[arity + 1]; t = XREGS[arity + 1];
old_size = ArenaSz(arena); old_size = ArenaSz(arena);
goto restart; }
} }
static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity,
@ -513,7 +476,7 @@ inline static GlobalEntry *GetGlobalEntry(Atom at USES_REGS)
{ {
Prop p0; Prop p0;
AtomEntry *ae = RepAtom(at); AtomEntry *ae = RepAtom(at);
GlobalEntry *new; GlobalEntry *nx;
WRITE_LOCK(ae->ARWLock); WRITE_LOCK(ae->ARWLock);
p0 = ae->PropsOfAE; p0 = ae->PropsOfAE;
@ -529,19 +492,19 @@ inline static GlobalEntry *GetGlobalEntry(Atom at USES_REGS)
} }
p0 = pe->NextOfPE; p0 = pe->NextOfPE;
} }
new = (GlobalEntry *)Yap_AllocAtomSpace(sizeof(*new)); nx = (GlobalEntry *)Yap_AllocAtomSpace(sizeof(*nx));
INIT_RWLOCK(new->GRWLock); INIT_RWLOCK(nx->GRWLock);
new->KindOfPE = GlobalProperty; nx->KindOfPE = GlobalProperty;
#if THREADS #if THREADS
new->owner_id = worker_id; nx->owner_id = worker_id;
#endif #endif
new->NextGE = LOCAL_GlobalVariables; nx->NextGE = LOCAL_GlobalVariables;
LOCAL_GlobalVariables = new; LOCAL_GlobalVariables = nx;
new->AtomOfGE = ae; nx->AtomOfGE = ae;
AddPropToAtom(ae, (PropEntry *)new); AddPropToAtom(ae, (PropEntry *)nx);
RESET_VARIABLE(&new->global); RESET_VARIABLE(&nx->global);
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
return new; return nx;
} }
static UInt garena_overflow_size(CELL *arena USES_REGS) { static UInt garena_overflow_size(CELL *arena USES_REGS) {

7
C/qlyr.c
View File

@ -863,6 +863,9 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
} while (cl != NULL); } while (cl != NULL);
} }
if (!nclauses) { if (!nclauses) {
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE;
pp->OpcodeOfPred = FAIL_OPCODE;
return; return;
} }
while ((read_tag(stream) == QLY_START_LU_CLAUSE)) { while ((read_tag(stream) == QLY_START_LU_CLAUSE)) {
@ -947,6 +950,10 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
Yap_EraseStaticClause(cl, pp, CurrentModule); Yap_EraseStaticClause(cl, pp, CurrentModule);
cl = ncl; cl = ncl;
} while (cl != NULL); } while (cl != NULL);
} else if (flags & MultiFileFlag) {
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE;
pp->OpcodeOfPred = FAIL_OPCODE;
} }
for (i = 0; i < nclauses; i++) { for (i = 0; i < nclauses; i++) {
char *base = (void *)read_UInt(stream); char *base = (void *)read_UInt(stream);

15
C/utilpreds.c
View File

@ -258,6 +258,7 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
*headp = *ptf++ = RepAppl(v)[0]; *headp = *ptf++ = RepAppl(v)[0];
o = MkPairTerm( v, o ); o = MkPairTerm( v, o );
} else { } else {
*headp = RepAppl(ptf);
*ptf++ = head; *ptf++ = head;
} }
continue; continue;
@ -326,6 +327,8 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
continue; continue;
} }
/* store the terms to visit */ /* store the terms to visit */
*ptf = AbsAppl(HR);
ptf++;
to_visit->start_cp = pt0; to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end; to_visit->end_cp = pt0_end;
to_visit->to = ptf; to_visit->to = ptf;
@ -335,8 +338,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
if (++to_visit >= to_visit_max-32) { if (++to_visit >= to_visit_max-32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
} }
*ptf = AbsAppl(HR);
ptf++;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
switch ((CELL)f) { switch ((CELL)f) {
@ -393,11 +394,10 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
goto overflow; goto overflow;
} }
*ptf++ = AbsAppl(HR); *ptf++ = AbsAppl(HR);
HR[0] = (CELL)f; memmove(HR, headp, sz*sizeof(CELL));
for (i = 1; i < sz; i++) { MP_INT *new = (MP_INT *)(HR + 2);
HR[i] = headp[i]; new->_mp_d = (mp_limb_t *)(new + 1);
}
HR += sz; HR += sz;
} }
} }
@ -462,7 +462,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
} else { } else {
/* first time we met this term */ /* first time we met this term */
RESET_VARIABLE(ptf); RESET_VARIABLE(ptf);
DO_TRAIL(ptd0, (CELL)ptf);
*ptd0 = (CELL)ptf; *ptd0 = (CELL)ptf;
ptf++; ptf++;
if ((ADDR)TR > LOCAL_TrailTop - 16) if ((ADDR)TR > LOCAL_TrailTop - 16)

82
C/write.c
View File

@ -103,9 +103,9 @@ static bool callPortray(Term t, int sno USES_REGS) {
} }
#define PROTECT(t, F) \ #define PROTECT(t, F) \
{ \ { /*yhandle_t sl = Yap_InitHandle(t);*/ \
F; \ F; \
t = Yap_GetFromSlot(wglb->sl); \ /*t = Yap_GetFromSlot(sl);*/ \
} }
static void wrputn(Int, struct write_globs *); static void wrputn(Int, struct write_globs *);
static void wrputf(Float, struct write_globs *); static void wrputf(Float, struct write_globs *);
@ -117,7 +117,7 @@ static wtype AtomIsSymbols(unsigned char *);
static void putAtom(Atom, int, struct write_globs *); static void putAtom(Atom, int, struct write_globs *);
static void writeTerm(Term, int, int, int, struct write_globs *, static void writeTerm(Term, int, int, int, struct write_globs *,
struct rewind_term *); struct rewind_term *);
static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, static void writeTerm__(Term t, Term *h, int p, int depth, int rinfixarg,
struct write_globs *wglb, struct rewind_term *rwt); struct write_globs *wglb, struct rewind_term *rwt);
static void write_list(Term t, int direction, int depth, static void write_list(Term t, int direction, int depth,
@ -273,7 +273,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg,
return; return;
} else if (big_tag == BIG_RATIONAL) { } else if (big_tag == BIG_RATIONAL) {
Term trat = Yap_RatTermToApplTerm(t); Term trat = Yap_RatTermToApplTerm(t);
writeTerm__(trat,wglb->sl, p, depth, rinfixarg, wglb, rwt); writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
return; return;
#endif #endif
} else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) { } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
@ -684,6 +684,7 @@ static void putUnquotedString(Term string, struct write_globs *wglb)
static void write_var(CELL *t, struct write_globs *wglb, static void write_var(CELL *t, struct write_globs *wglb,
struct rewind_term *rwt) { struct rewind_term *rwt) {
CACHE_REGS CACHE_REGS
// yhandle_t sl = wglb->sl;
if (lastw == alphanum) { if (lastw == alphanum) {
wrputc(' ', wglb->stream); wrputc(' ', wglb->stream);
} }
@ -706,9 +707,7 @@ static void write_var(CELL *t, struct write_globs *wglb,
wrputs("$AT(", wglb->stream); wrputs("$AT(", wglb->stream);
write_var(t, wglb, rwt); write_var(t, wglb, rwt);
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
CELL tt = (CELL)t; writeTerm(*l, 999, 1, FALSE, wglb, &nrwt);
PROTECT(tt, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
t = (CELL *)tt;
attv = RepAttVar(t); attv = RepAttVar(t);
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
l++; l++;
@ -727,23 +726,24 @@ static void write_var(CELL *t, struct write_globs *wglb,
static bool check_for_loops(Term t, struct write_globs *wglb) static bool check_for_loops(Term t, struct write_globs *wglb)
{ {
yhandle_t i, sl = wglb->sl;
if ((wglb->Write_Loops)) { if ((wglb->Write_Loops)) {
return false; return false;
} }
for (i=sl-1; i>wglb->sl0;i--) { if ((IsPairTerm(t) &&
if (Yap_GetFromHandle(i) == t) { HeadOfTerm(t) == TermFoundVar) ||
(IsApplTerm(t) &&
FunctorOfTerm(t) == (Functor)TermFoundVar)) {
char buf[64]; char buf[64];
snprintf(buf,63," @{ ^^%ld } " ,sl-i); snprintf(buf,63," @{ ^^%ld } " ,0L);
wrputs(buf, wglb->stream); wrputs(buf, wglb->stream);
return true; return true;
} }
}
return false; return false;
} }
static void write_list__(Term t, yhandle_t sl, int direction, int depth, static void write_list__(Term t, Term *hp, int direction, int depth,
struct write_globs *wglb, struct rewind_term *rwt) { struct write_globs *wglb, struct rewind_term *rwt) {
Term ti; Term ti;
struct rewind_term nrwt; struct rewind_term nrwt;
@ -755,7 +755,7 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth,
int ndirection; int ndirection;
int do_jump; int do_jump;
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); PROTECT(t, writeTerm(*hp, 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t); ti = TailOfTerm(t);
if (IsVarTerm(ti)) if (IsVarTerm(ti))
break; break;
@ -808,16 +808,18 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth,
static void write_list(Term t, int direction, int depth, static void write_list(Term t, int direction, int depth,
struct write_globs *wglb, struct rewind_term *rwt) { struct write_globs *wglb, struct rewind_term *rwt) {
if (check_for_loops(t,wglb)) return; write_list__(t, RepPair(t), direction, depth,
yhandle_t sl = wglb->sl = Yap_InitHandle(t);
write_list__(t, sl, direction, depth,
wglb, rwt); wglb, rwt);
Yap_PopHandle(sl); /* if (check_for_loops(t,wglb)) return; */
wglb->sl = sl-1; /* Term h = RepPair(t)[0]; */
/* RepPair(t)[0] = TermFoundVar; */
/* write_list__(t, &h, direction, depth, */
/* wglb, rwt); */
/* RepPair(t)[0] = h; */
} }
static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, static void writeTerm__(Term t, CELL *hp, int p, int depth, int rinfixarg,
struct write_globs *wglb, struct rewind_term *rwt) struct write_globs *wglb, struct rewind_term *rwt)
/* term to write */ /* term to write */
/* context priority */ /* context priority */
@ -841,7 +843,7 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg,
wrputs("'.'(", wglb->stream); wrputs("'.'(", wglb->stream);
lastw = separator; lastw = separator;
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); PROTECT(t, writeTerm(*hp, 999, depth + 1, FALSE, wglb, &nrwt));
wrputs(",", wglb->stream); wrputs(",", wglb->stream);
writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
@ -855,14 +857,13 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg,
putString(t, wglb); putString(t, wglb);
} else { } else {
wrputc('[', wglb->stream); wrputc('[', wglb->stream);
lastw = separator; lastw = separator;
/* we assume t was already saved in the stack */ write_list__(t, hp, 0, depth, wglb, rwt);
write_list__(t, wglb->sl, 0, depth, wglb, rwt);
wrputc(']', wglb->stream); wrputc(']', wglb->stream);
lastw = separator; lastw = separator;
} }
} else { /* compound term */ } else { /* compound term */
Functor functor = FunctorOfTerm(t); Functor functor = (Functor)*hp;
int Arity; int Arity;
Atom atom; Atom atom;
int op, lp, rp; int op, lp, rp;
@ -1129,12 +1130,30 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg,
static void writeTerm(Term t, int p, int depth, int rinfixarg, static void writeTerm(Term t, int p, int depth, int rinfixarg,
struct write_globs *wglb, struct rewind_term *rwt) struct write_globs *wglb, struct rewind_term *rwt)
{ {
if (check_for_loops(t,wglb)) return; if (IsPairTerm(t)) {
yhandle_t sl = wglb->sl = Yap_InitHandle(t); writeTerm__(t,RepPair(t), p, depth,rinfixarg,
writeTerm__(t, sl, p, depth, rinfixarg,
wglb, rwt); wglb, rwt);
Yap_PopHandle(sl); } else if (IsApplTerm(t)) {
wglb->sl = sl-1; writeTerm__(t, RepAppl(t), p, depth,rinfixarg,
wglb, rwt);
} else
writeTerm__(t, &t, p, depth,rinfixarg,
wglb, rwt);
/* if (check_for_loops(t,wglb)) return; */
/* if (IsPairTerm(t)) { */
/* Term h = HeadOfTerm(t); */
/* RepPair(t)[0] = TermFoundVar; */
/* writeTerm__(t, &h, p, depth, rinfixarg, */
/* wglb, rwt); */
/* RepPair(t)[0] = h; */
/* } else if (IsApplTerm(t)) { */
/* Term h = RepAppl(t)[0]; */
/* RepAppl(t)[0] = TermFoundVar; */
/* writeTerm__(t, &h, p, depth, rinfixarg, */
/* wglb, rwt); */
/* RepAppl(t)[0] = h; */
/* } */
} }
void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
@ -1183,8 +1202,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
} }
} }
/* protect slots for portray */ /* protect slots for portray */
wglb.sl0 = (wglb.sl = Yap_InitHandle(t))-1; writeTerm(t, priority, 1, FALSE, &wglb, &rwt);
writeTerm__(t,wglb.sl, priority, 1, FALSE, &wglb, &rwt);
if (flags & New_Line_f) { if (flags & New_Line_f) {
if (flags & Fullstop_f) { if (flags & Fullstop_f) {
wrputc('.', wglb.stream); wrputc('.', wglb.stream);

3
pl/consult.yap
View File

@ -862,6 +862,7 @@ nb_setval('$if_level',0).
'__NB_getval__'('$lf_status', TOpts, fail), '__NB_getval__'('$lf_status', TOpts, fail),
'$lf_opt'( initialization, TOpts, Ref), '$lf_opt'( initialization, TOpts, Ref),
nb:nb_queue_close(Ref, Answers, []), nb:nb_queue_close(Ref, Answers, []),
writeln(init:Answers),
'$process_init_goal'(Answers). '$process_init_goal'(Answers).
'$exec_initialization_goals'. '$exec_initialization_goals'.
@ -1449,7 +1450,9 @@ environment. Use initialization/2 for more flexible behavior.
'$initialization_queue'(G) :- '$initialization_queue'(G) :-
b_getval('$lf_status', TOpts), b_getval('$lf_status', TOpts),
'$lf_opt'( initialization, TOpts, Ref), '$lf_opt'( initialization, TOpts, Ref),
writeln(G),
nb:nb_queue_enqueue(Ref, G), nb:nb_queue_enqueue(Ref, G),
writeln(Ref),
fail. fail.
'$initialization_queue'(_). '$initialization_queue'(_).

6
pl/messages.yap
View File

@ -108,7 +108,8 @@ In YAP, the info field describes:
:- use_system_module( user, [message_hook/3]). :- use_system_module( user, [message_hook/3]).
%:- start_low_level_trace. %:- start_low_level_trace.
:- multifile prolog:message/3. :- dynamic prolog:message//1.
:- multifile prolog:message//1.
%:- stop_low_level_trace. %:- stop_low_level_trace.
:- multifile user:message_hook/3. :- multifile user:message_hook/3.
@ -374,7 +375,8 @@ display_consulting( F, Level, Info, LC) -->
'$error_descriptor'(Info, Desc), '$error_descriptor'(Info, Desc),
query_exception(prologParserFile, Desc, F0), query_exception(prologParserFile, Desc, F0),
query_exception(prologParserLine, Desc, L), query_exception(prologParserLine, Desc, L),
F \= F0 integer(L)
, F \= F0
}, !, }, !,
[ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ]. [ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ].
display_consulting( F, Level, _, LC) --> display_consulting( F, Level, _, LC) -->

7
pl/undefined.yap
View File

@ -97,7 +97,7 @@ undefined_query(G0, M0, Cut) :-
'$undefp'([M0|G0],MG) :- '$undefp'([M0|G0],MG) :-
% make sure we do not loop on undefined predicates % make sure we do not loop on undefined predicates
'$undef_setup'(M0:G0, Action,Debug,Current, MGI), '$undef_setup'(M0:G0, Action,Debug,Current, MGI),
('$get_undefined_predicates'(Current, MGI, MG ) , MG) ('$get_undefined_predicates'( MGI, MG ) , MG)
-> ->
true true
; ;
@ -119,10 +119,11 @@ undefined_query(G0, M0, Cut) :-
'$handle_error'(fail,_Goal,_Mod) :- '$handle_error'(fail,_Goal,_Mod) :-
fail. fail.
'$undef_setup'(Action,Debug,Current) :- '$undef_setup'(G0,Action,Debug,Current,GI) :-
yap_flag( unknown, Action, fail), yap_flag( unknown, Action, fail),
yap_flag( debug, Debug, false), yap_flag( debug, Debug, false),
'$stop_creeping'(Current). '$stop_creeping'(Current),
'$g2i'(G0,GI).
'$g2i'(user:G, Na/Ar ) :- '$g2i'(user:G, Na/Ar ) :-
!, !,