From 7f71184785f0b1f88397e9a5af153c3fbb8b965d Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 27 Jan 2019 23:54:02 +0000 Subject: [PATCH] bug --- C/globals.c | 85 ++++++++++++++---------------------------------- C/qlyr.c | 7 ++++ C/utilpreds.c | 15 ++++----- C/write.c | 82 ++++++++++++++++++++++++++++------------------ pl/consult.yap | 3 ++ pl/messages.yap | 6 ++-- pl/undefined.yap | 7 ++-- 7 files changed, 99 insertions(+), 106 deletions(-) diff --git a/C/globals.c b/C/globals.c index 56aa0a41e..52bafa947 100644 --- a/C/globals.c +++ b/C/globals.c @@ -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) { diff --git a/C/qlyr.c b/C/qlyr.c index 53907c602..c961dc7b9 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -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); diff --git a/C/utilpreds.c b/C/utilpreds.c index 2067b0ea4..9a7763814 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -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) diff --git a/C/write.c b/C/write.c index d2c49ab89..c6812904c 100644 --- a/C/write.c +++ b/C/write.c @@ -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); diff --git a/pl/consult.yap b/pl/consult.yap index 5920f944e..59c57672a 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -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'(_). diff --git a/pl/messages.yap b/pl/messages.yap index 9209911f1..a1fb3a93e 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -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) --> diff --git a/pl/undefined.yap b/pl/undefined.yap index 963a481a5..811891732 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -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 ) :- !,