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

write_loops

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-01-24 13:27:23 +00:00
parent 2a090f3484
commit 92089074f1
3 changed files with 134 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

145
C/utilpreds.c
View File

@ -176,6 +176,42 @@ clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
TR = TR0; TR = TR0;
} }
/// @brief recover original term while fixing direct refs.
///
/// @param USES_REGS
///
static inline void
clean_complex_tr(tr_fr_ptr TR0 USES_REGS) {
tr_fr_ptr pt0 = TR;
while (pt0 != TR0) {
Term p = TrailTerm(--pt0);
if (IsApplTerm(p)) {
/// pt: points to the address of the new term we may want to fix.
CELL *pt = RepAppl(p);
if (pt >= HB && pt < HR) { /// is it new?
Term v = pt[0];
if (IsApplTerm(v)) {
/// yes, more than a single ref
*pt = (CELL)RepAppl(v);
}
#ifndef FROZEN_STACKS
pt0 --;
#endif /* FROZEN_STACKS */
continue;
}
#ifdef FROZEN_STACKS
pt[0] = TrailVal(pt0);
#else
pt[0] = TrailTerm(pt0 - 1);
pt0 --;
#endif /* FROZEN_STACKS */
} else {
RESET_VARIABLE(p);
}
}
TR = TR0;
}
#define expand_stack(S0,SP,SF,TYPE) \ #define expand_stack(S0,SP,SF,TYPE) \
{ size_t sz = SF-S0, used = SP-S0; \ { size_t sz = SF-S0, used = SP-S0; \
S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
@ -214,69 +250,79 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
copy_term_nvar : { copy_term_nvar : {
if (IsPairTerm(d0)) { if (IsPairTerm(d0)) {
CELL *headp = RepPair(d0); CELL *headp = RepPair(d0);
if (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR) { Term head = *headp;
if (IsPairTerm(head) && RepPair(head) >= HB && RepPair(head) < HR) {
if (split) { if (split) {
Term v = Yap_MkNewApplTerm(FunctorEq, 2); Term v = Yap_MkNewApplTerm(FunctorEq, 2);
RepAppl(v)[1] = *headp; RepAppl(v)[1] = AbsPair(ptf);
*headp = *ptf++ = RepAppl(v)[0]; *headp = *ptf++ = RepAppl(v)[0];
o = MkPairTerm( v, o ); o = MkPairTerm( v, o );
} else { } else {
/* If this is newer than the current term, just reuse */ *ptf++ = head;
*ptf++ = (CELL)RepAppl(*headp);
} }
} continue;
else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) { } else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) {
*ptf++ = AbsPair(RepAppl(*headp)); *ptf++ = AbsPair(RepAppl(*headp));
continue; continue;
} }
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 = AbsPair(HR); *ptf = AbsPair(HR);
ptf++; 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;
to_visit->curp = headp; to_visit->curp = headp;
d0 = *headp; to_visit->oldv = head;
to_visit->oldv = d0; to_visit->ground = ground;
to_visit->ground = ground; to_visit++;
to_visit++; // move to new list
// move to new list if (share) {
if (share) { TrailedMaBind(headp,AbsPair(HR));
TrailedMaBind(headp,AbsPair(HR)); } else {
} else { /* If this is newer than the current term, just reuse */
*headp = AbsPair(HR); *headp = AbsPair(HR);
} }
pt0 = headp; if (split) {
pt0_end = headp + 1; TrailedMaBind(ptf,AbsPair(HR));
ptf = HR; }
ground = true; pt0 = headp;
HR += 2; pt0_end = headp + 1;
if (HR > ASP - MIN_ARENA_SIZE) { ptf = HR;
goto overflow; ground = true;
} HR += 2;
ptd0 = pt0; if (HR > ASP - MIN_ARENA_SIZE) {
goto deref; goto overflow;
} else if (IsApplTerm(d0)) { }
ptd0 = pt0;
goto deref;
} else if (IsApplTerm(d0)) {
register Functor f; register Functor f;
register CELL *headp; register CELL *headp, head;
/* store the terms to visit */ /* store the terms to visit */
headp = RepAppl(d0); headp = RepAppl(d0);
if (IsPairTerm(*headp)//(share && headp < HB) || head = *headp;
if (IsPairTerm(head)//(share && headp < HB) ||
) { ) {
if (split) { if (split) {
Term v = Yap_MkNewApplTerm(FunctorEq, 2); Term v = Yap_MkNewApplTerm(FunctorEq, 2);
RepAppl(v)[1] = *headp; RepAppl(v)[1] = head;
*headp = *ptf++ = RepAppl(v)[0]; *headp = *ptf++ = RepAppl(v)[0];
o = MkPairTerm( v, o ); o = MkPairTerm( v, o );
} else { } else {
/* If this is newer than the current term, just reuse */ /* If this is newer than the current term, just reuse */
*ptf++ = AbsPair(RepAppl(*headp)); *ptf++ = AbsAppl(RepPair(head));
} }
continue; continue;
} }
f = (Functor)(*headp); if (IsApplTerm(head)//(share && headp < HB) ||
) {
*ptf++ = head;
continue;
}
f = (Functor)(head);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
if (share) { if (share) {
@ -365,6 +411,11 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
} else { } else {
*headp = AbsPair(HR); *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));
}
ptf = HR; ptf = HR;
ptf[-1] = (CELL)f; ptf[-1] = (CELL)f;
ground = true; ground = true;
@ -435,10 +486,10 @@ if (to_visit > to_visit0) {
} }
/* restore our nice, friendly, term to its original state */ /* restore our nice, friendly, term to its original state */
clean_dirty_tr(TR0 PASS_REGS); clean_complex_tr(TR0 PASS_REGS);
/* follow chain of multi-assigned variables */ /* follow chain of multi-assigned variables */
pop_text_stack(lvl); pop_text_stack(lvl);
return 0; return 0;
overflow: overflow:

52
C/write.c
View File

@ -77,6 +77,7 @@ typedef struct write_globs {
int last_atom_minus; int last_atom_minus;
UInt MaxDepth, MaxArgs; UInt MaxDepth, MaxArgs;
wtype lw; wtype lw;
int sl0;
} wglbs; } wglbs;
#define lastw wglb->lw #define lastw wglb->lw
@ -100,11 +101,20 @@ static bool callPortray(Term t, int sno USES_REGS) {
return false; return false;
} }
#define PROTECT(t, F) \ #define PROTECT(t, F) \
{ \ { \
yhandle_t yt = Yap_InitHandle(t); \ yhandle_t yt = Yap_InitHandle(t); \
F; \ if (wglb->Write_Loops) { \
t = Yap_PopHandle(yt); \ yhandle_t i; \
for (i=wglb->sl0;i<yt;i++) { \
if (Yap_GetFromHandle(i) == t) { \
char buf[63]; snprintf(buf, 63, " @( ^^^%ld^^^ ) ",yt-i); \
wrputs(buf,wglb->stream ); return; \
} \
} \
} \
F; \
t = Yap_PopHandle(yt);\
} }
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 *);
@ -267,7 +277,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, p, depth, rinfixarg, wglb, rwt); PROTECT(t,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) {
@ -701,11 +711,11 @@ 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);
PROTECT(*t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); PROTECT(t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
attv = RepAttVar(t); attv = RepAttVar(t);
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
l++; l++;
writeTerm(*l, 999, 1, FALSE, wglb, &nrwt); PROTECT(t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
wglb->Portray_delays = TRUE; wglb->Portray_delays = TRUE;
@ -767,14 +777,14 @@ static void write_list(Term t, int direction, int depth,
/* we found an infinite loop */ /* we found an infinite loop */
/* keep going on the list */ /* keep going on the list */
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
write_list(ti, direction, depth, wglb, &nrwt); PROTECT(t,write_list(ti, direction, depth, wglb, &nrwt));
} else if (ti != MkAtomTerm(AtomNil)) { } else if (ti != MkAtomTerm(AtomNil)) {
if (lastw == symbol || lastw == separator) { if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream); wrputc(' ', wglb->stream);
} }
wrputc('|', wglb->stream); wrputc('|', wglb->stream);
lastw = separator; lastw = separator;
writeTerm(ti, 999, depth, FALSE, wglb, &nrwt); PROTECT(ti,writeTerm(ti, 999, depth, FALSE, wglb, &nrwt));
} }
} }
@ -807,7 +817,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
wrputs(",", wglb->stream); wrputs(",", wglb->stream);
writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt); PROTECT(t, writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
return; return;
} }
@ -901,7 +911,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} else if (atom == AtomMinus) { } else if (atom == AtomMinus) {
last_minus = TRUE; last_minus = TRUE;
} }
writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt); PROTECT(t,writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt));
if (bracket_right) { if (bracket_right) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
@ -934,7 +944,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (bracket_left) { if (bracket_left) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
} }
writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt); PROTECT(t,writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt));
if (bracket_left) { if (bracket_left) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
@ -999,7 +1009,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (bracket_right) { if (bracket_right) {
wropen_bracket(wglb, TRUE); wropen_bracket(wglb, TRUE);
} }
writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt); PROTECT(t,writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt));
if (bracket_right) { if (bracket_right) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
@ -1039,14 +1049,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} else { } else {
wrputs("'$VAR'(", wglb->stream); wrputs("'$VAR'(", wglb->stream);
lastw = separator; lastw = separator;
writeTerm(ArgOfTerm(1, t), 999, depth + 1, FALSE, wglb, &nrwt); PROTECT(t,writeTerm(ArgOfTerm(1, t), 999, depth + 1, FALSE, wglb, &nrwt));
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} else if (!wglb->Ignore_ops && functor == FunctorBraces) { } else if (!wglb->Ignore_ops && functor == FunctorBraces) {
wrputc('{', wglb->stream); wrputc('{', wglb->stream);
lastw = separator; lastw = separator;
writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb, PROTECT(t,writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb,
&nrwt); &nrwt));
wrputc('}', wglb->stream); wrputc('}', wglb->stream);
lastw = separator; lastw = separator;
} else if (atom == AtomArray) { } else if (atom == AtomArray) {
@ -1057,7 +1067,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputs("...", wglb->stream); wrputs("...", wglb->stream);
break; break;
} }
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt));
if (op != Arity) { if (op != Arity) {
PROTECT(t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, PROTECT(t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb,
&nrwt)); &nrwt));
@ -1065,7 +1075,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
lastw = separator; lastw = separator;
} }
} }
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt));
wrputc('}', wglb->stream); wrputc('}', wglb->stream);
lastw = separator; lastw = separator;
} else { } else {
@ -1084,7 +1094,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
lastw = separator; lastw = separator;
} }
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt));
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} }
@ -1102,6 +1112,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
yhandle_t sls = Yap_CurrentSlot(); yhandle_t sls = Yap_CurrentSlot();
int lvl = push_text_stack(); int lvl = push_text_stack();
wglb.sl0 = sls;
if (t == 0) if (t == 0)
return; return;
if (!mywrite) { if (!mywrite) {
@ -1124,6 +1135,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
rwt.parent = NULL; rwt.parent = NULL;
wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Ignore_ops = flags & Ignore_ops_f;
wglb.Write_strings = flags & BackQuote_String_f; wglb.Write_strings = flags & BackQuote_String_f;
wglb.Write_Loops = !(flags &Ignore_cyclics_f);
if (!(flags & Ignore_cyclics_f) && false) { if (!(flags & Ignore_cyclics_f) && false) {
Term ts[2]; Term ts[2];
ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS); ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS);

4
os/writeterm.c
View File

@ -573,6 +573,8 @@ static Int writeln1(USES_REGS1) {
args[WRITE_NL].tvalue = TermTrue; args[WRITE_NL].tvalue = TermTrue;
args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].tvalue = TermTrue;
args[WRITE_CYCLES].used = true;
args[WRITE_CYCLES].tvalue = TermTrue;
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
@ -603,6 +605,8 @@ static Int writeln(USES_REGS1) {
args[WRITE_NL].tvalue = TermTrue; args[WRITE_NL].tvalue = TermTrue;
args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].tvalue = TermTrue;
args[WRITE_CYCLES].used = true;
args[WRITE_CYCLES].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free(args); free(args);