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,
size_t min_grow USES_REGS) {
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 *oldASP = ASP;
int res = 0;
Term tn;
restart:
t = Deref(t);
if (IsVarTerm(t)) {
ASP = ArenaLimit(arena);
HR = HB = ArenaPt(arena);
#if COROUTINING
if (GlobalIsAttachedTerm(t)) {
CELL *Hi;
*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;
Term o = MkVarTerm();
while (true) {
if ((res = Yap_copy_complex_term(&t-1, &t, share, NULL, copy_att_vars,
VarOfTerm(o), HB PASS_REGS)) == 0) {
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);
XREGS[arity + 1] = t;
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]);
t = XREGS[arity + 1];
old_size = ArenaSz(arena);
goto restart;
}
}
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;
AtomEntry *ae = RepAtom(at);
GlobalEntry *new;
GlobalEntry *nx;
WRITE_LOCK(ae->ARWLock);
p0 = ae->PropsOfAE;
@ -529,19 +492,19 @@ inline static GlobalEntry *GetGlobalEntry(Atom at USES_REGS)
}
p0 = pe->NextOfPE;
}
new = (GlobalEntry *)Yap_AllocAtomSpace(sizeof(*new));
INIT_RWLOCK(new->GRWLock);
new->KindOfPE = GlobalProperty;
nx = (GlobalEntry *)Yap_AllocAtomSpace(sizeof(*nx));
INIT_RWLOCK(nx->GRWLock);
nx->KindOfPE = GlobalProperty;
#if THREADS
new->owner_id = worker_id;
nx->owner_id = worker_id;
#endif
new->NextGE = LOCAL_GlobalVariables;
LOCAL_GlobalVariables = new;
new->AtomOfGE = ae;
AddPropToAtom(ae, (PropEntry *)new);
RESET_VARIABLE(&new->global);
nx->NextGE = LOCAL_GlobalVariables;
LOCAL_GlobalVariables = nx;
nx->AtomOfGE = ae;
AddPropToAtom(ae, (PropEntry *)nx);
RESET_VARIABLE(&nx->global);
WRITE_UNLOCK(ae->ARWLock);
return new;
return nx;
}
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);
}
if (!nclauses) {
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE;
pp->OpcodeOfPred = FAIL_OPCODE;
return;
}
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);
cl = ncl;
} 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++) {
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];
o = MkPairTerm( v, o );
} else {
*headp = RepAppl(ptf);
*ptf++ = head;
}
continue;
@ -326,6 +327,8 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
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;
@ -335,8 +338,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
if (++to_visit >= to_visit_max-32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
*ptf = AbsAppl(HR);
ptf++;
if (IsExtensionFunctor(f)) {
switch ((CELL)f) {
@ -393,11 +394,10 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
goto overflow;
}
*ptf++ = AbsAppl(HR);
HR[0] = (CELL)f;
for (i = 1; i < sz; i++) {
HR[i] = headp[i];
}
memmove(HR, headp, sz*sizeof(CELL));
MP_INT *new = (MP_INT *)(HR + 2);
new->_mp_d = (mp_limb_t *)(new + 1);
HR += sz;
}
}
@ -462,7 +462,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
} else {
/* first time we met this term */
RESET_VARIABLE(ptf);
DO_TRAIL(ptd0, (CELL)ptf);
*ptd0 = (CELL)ptf;
ptf++;
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) \
{ \
{ /*yhandle_t sl = Yap_InitHandle(t);*/ \
F; \
t = Yap_GetFromSlot(wglb->sl); \
/*t = Yap_GetFromSlot(sl);*/ \
}
static void wrputn(Int, 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 writeTerm(Term, int, int, int, struct write_globs *,
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);
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;
} else if (big_tag == BIG_RATIONAL) {
Term trat = Yap_RatTermToApplTerm(t);
writeTerm__(trat,wglb->sl, p, depth, rinfixarg, wglb, rwt);
writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
return;
#endif
} 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,
struct rewind_term *rwt) {
CACHE_REGS
// yhandle_t sl = wglb->sl;
if (lastw == alphanum) {
wrputc(' ', wglb->stream);
}
@ -706,9 +707,7 @@ static void write_var(CELL *t, struct write_globs *wglb,
wrputs("$AT(", wglb->stream);
write_var(t, wglb, rwt);
wrputc(',', wglb->stream);
CELL tt = (CELL)t;
PROTECT(tt, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
t = (CELL *)tt;
writeTerm(*l, 999, 1, FALSE, wglb, &nrwt);
attv = RepAttVar(t);
wrputc(',', wglb->stream);
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)
{
yhandle_t i, sl = wglb->sl;
if ((wglb->Write_Loops)) {
return false;
}
for (i=sl-1; i>wglb->sl0;i--) {
if (Yap_GetFromHandle(i) == t) {
if ((IsPairTerm(t) &&
HeadOfTerm(t) == TermFoundVar) ||
(IsApplTerm(t) &&
FunctorOfTerm(t) == (Functor)TermFoundVar)) {
char buf[64];
snprintf(buf,63," @{ ^^%ld } " ,sl-i);
snprintf(buf,63," @{ ^^%ld } " ,0L);
wrputs(buf, wglb->stream);
return true;
}
}
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) {
Term ti;
struct rewind_term nrwt;
@ -755,7 +755,7 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth,
int ndirection;
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);
if (IsVarTerm(ti))
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,
struct write_globs *wglb, struct rewind_term *rwt) {
if (check_for_loops(t,wglb)) return;
yhandle_t sl = wglb->sl = Yap_InitHandle(t);
write_list__(t, sl, direction, depth,
write_list__(t, RepPair(t), direction, depth,
wglb, rwt);
Yap_PopHandle(sl);
wglb->sl = sl-1;
/* if (check_for_loops(t,wglb)) return; */
/* 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)
/* term to write */
/* context priority */
@ -841,7 +843,7 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg,
wrputs("'.'(", wglb->stream);
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);
writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt);
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);
} else {
wrputc('[', wglb->stream);
lastw = separator;
/* we assume t was already saved in the stack */
write_list__(t, wglb->sl, 0, depth, wglb, rwt);
lastw = separator;
write_list__(t, hp, 0, depth, wglb, rwt);
wrputc(']', wglb->stream);
lastw = separator;
}
} else { /* compound term */
Functor functor = FunctorOfTerm(t);
Functor functor = (Functor)*hp;
int Arity;
Atom atom;
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,
struct write_globs *wglb, struct rewind_term *rwt)
{
if (check_for_loops(t,wglb)) return;
yhandle_t sl = wglb->sl = Yap_InitHandle(t);
writeTerm__(t, sl, p, depth, rinfixarg,
if (IsPairTerm(t)) {
writeTerm__(t,RepPair(t), p, depth,rinfixarg,
wglb, rwt);
Yap_PopHandle(sl);
wglb->sl = sl-1;
} else if (IsApplTerm(t)) {
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,
@ -1183,8 +1202,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
}
}
/* protect slots for portray */
wglb.sl0 = (wglb.sl = Yap_InitHandle(t))-1;
writeTerm__(t,wglb.sl, priority, 1, FALSE, &wglb, &rwt);
writeTerm(t, priority, 1, FALSE, &wglb, &rwt);
if (flags & New_Line_f) {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);

3
pl/consult.yap
View File

@ -862,6 +862,7 @@ nb_setval('$if_level',0).
'__NB_getval__'('$lf_status', TOpts, fail),
'$lf_opt'( initialization, TOpts, Ref),
nb:nb_queue_close(Ref, Answers, []),
writeln(init:Answers),
'$process_init_goal'(Answers).
'$exec_initialization_goals'.
@ -1449,7 +1450,9 @@ environment. Use initialization/2 for more flexible behavior.
'$initialization_queue'(G) :-
b_getval('$lf_status', TOpts),
'$lf_opt'( initialization, TOpts, Ref),
writeln(G),
nb:nb_queue_enqueue(Ref, G),
writeln(Ref),
fail.
'$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]).
%:- start_low_level_trace.
:- multifile prolog:message/3.
:- dynamic prolog:message//1.
:- multifile prolog:message//1.
%:- stop_low_level_trace.
:- multifile user:message_hook/3.
@ -374,7 +375,8 @@ display_consulting( F, Level, Info, LC) -->
'$error_descriptor'(Info, Desc),
query_exception(prologParserFile, Desc, F0),
query_exception(prologParserLine, Desc, L),
F \= F0
integer(L)
, F \= F0
}, !,
[ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ].
display_consulting( F, Level, _, LC) -->

7
pl/undefined.yap
View File

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