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;
}
/// @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) \
{ size_t sz = SF-S0, used = SP-S0; \
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 : {
if (IsPairTerm(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) {
Term v = Yap_MkNewApplTerm(FunctorEq, 2);
RepAppl(v)[1] = *headp;
RepAppl(v)[1] = AbsPair(ptf);
*headp = *ptf++ = RepAppl(v)[0];
o = MkPairTerm( v, o );
} else {
/* If this is newer than the current term, just reuse */
*ptf++ = (CELL)RepAppl(*headp);
*ptf++ = head;
}
}
else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) {
continue;
} else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) {
*ptf++ = AbsPair(RepAppl(*headp));
continue;
}
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 = *headp;
to_visit->oldv = d0;
to_visit->ground = ground;
to_visit++;
// move to new list
if (share) {
TrailedMaBind(headp,AbsPair(HR));
} else {
*headp = AbsPair(HR);
}
pt0 = headp;
pt0_end = headp + 1;
ptf = HR;
ground = true;
HR += 2;
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
ptd0 = pt0;
goto deref;
} else if (IsApplTerm(d0)) {
continue;
}
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;
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));
}
pt0 = headp;
pt0_end = headp + 1;
ptf = HR;
ground = true;
HR += 2;
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
ptd0 = pt0;
goto deref;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *headp;
register CELL *headp, head;
/* store the terms to visit */
headp = RepAppl(d0);
if (IsPairTerm(*headp)//(share && headp < HB) ||
head = *headp;
if (IsPairTerm(head)//(share && headp < HB) ||
) {
if (split) {
Term v = Yap_MkNewApplTerm(FunctorEq, 2);
RepAppl(v)[1] = *headp;
RepAppl(v)[1] = head;
*headp = *ptf++ = RepAppl(v)[0];
o = MkPairTerm( v, o );
} else {
/* If this is newer than the current term, just reuse */
*ptf++ = AbsPair(RepAppl(*headp));
*ptf++ = AbsAppl(RepPair(head));
}
continue;
}
f = (Functor)(*headp);
if (IsApplTerm(head)//(share && headp < HB) ||
) {
*ptf++ = head;
continue;
}
f = (Functor)(head);
if (IsExtensionFunctor(f)) {
if (share) {
@ -365,6 +411,11 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
} 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));
}
ptf = HR;
ptf[-1] = (CELL)f;
ground = true;
@ -435,10 +486,10 @@ if (to_visit > to_visit0) {
}
/* restore our nice, friendly, term to its original state */
clean_dirty_tr(TR0 PASS_REGS);
/* follow chain of multi-assigned variables */
pop_text_stack(lvl);
return 0;
clean_complex_tr(TR0 PASS_REGS);
/* follow chain of multi-assigned variables */
pop_text_stack(lvl);
return 0;
overflow:

52
C/write.c
View File

@ -77,6 +77,7 @@ typedef struct write_globs {
int last_atom_minus;
UInt MaxDepth, MaxArgs;
wtype lw;
int sl0;
} wglbs;
#define lastw wglb->lw
@ -100,11 +101,20 @@ static bool callPortray(Term t, int sno USES_REGS) {
return false;
}
#define PROTECT(t, F) \
{ \
yhandle_t yt = Yap_InitHandle(t); \
F; \
t = Yap_PopHandle(yt); \
#define PROTECT(t, F) \
{ \
yhandle_t yt = Yap_InitHandle(t); \
if (wglb->Write_Loops) { \
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 wrputf(Float, struct write_globs *);
@ -267,7 +277,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, p, depth, rinfixarg, wglb, rwt);
PROTECT(t,writeTerm(trat, p, depth, rinfixarg, wglb, rwt));
return;
#endif
} 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);
write_var(t, wglb, rwt);
wrputc(',', wglb->stream);
PROTECT(*t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
PROTECT(t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
attv = RepAttVar(t);
wrputc(',', wglb->stream);
l++;
writeTerm(*l, 999, 1, FALSE, wglb, &nrwt);
PROTECT(t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
wrclose_bracket(wglb, TRUE);
}
wglb->Portray_delays = TRUE;
@ -767,14 +777,14 @@ static void write_list(Term t, int direction, int depth,
/* we found an infinite loop */
/* keep going on the list */
wrputc(',', wglb->stream);
write_list(ti, direction, depth, wglb, &nrwt);
PROTECT(t,write_list(ti, direction, depth, wglb, &nrwt));
} else if (ti != MkAtomTerm(AtomNil)) {
if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
}
wrputc('|', wglb->stream);
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));
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);
return;
}
@ -901,7 +911,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} else if (atom == AtomMinus) {
last_minus = TRUE;
}
writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt);
PROTECT(t,writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt));
if (bracket_right) {
wrclose_bracket(wglb, TRUE);
}
@ -934,7 +944,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (bracket_left) {
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) {
wrclose_bracket(wglb, TRUE);
}
@ -999,7 +1009,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (bracket_right) {
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) {
wrclose_bracket(wglb, TRUE);
}
@ -1039,14 +1049,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} else {
wrputs("'$VAR'(", wglb->stream);
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);
}
} else if (!wglb->Ignore_ops && functor == FunctorBraces) {
wrputc('{', wglb->stream);
lastw = separator;
writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb,
&nrwt);
PROTECT(t,writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb,
&nrwt));
wrputc('}', wglb->stream);
lastw = separator;
} else if (atom == AtomArray) {
@ -1057,7 +1067,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputs("...", wglb->stream);
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) {
PROTECT(t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb,
&nrwt));
@ -1065,7 +1075,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
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);
lastw = separator;
} else {
@ -1084,7 +1094,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputc(',', wglb->stream);
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);
}
}
@ -1102,6 +1112,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
yhandle_t sls = Yap_CurrentSlot();
int lvl = push_text_stack();
wglb.sl0 = sls;
if (t == 0)
return;
if (!mywrite) {
@ -1124,6 +1135,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
rwt.parent = NULL;
wglb.Ignore_ops = flags & Ignore_ops_f;
wglb.Write_strings = flags & BackQuote_String_f;
wglb.Write_Loops = !(flags &Ignore_cyclics_f);
if (!(flags & Ignore_cyclics_f) && false) {
Term ts[2];
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_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
args[WRITE_CYCLES].used = true;
args[WRITE_CYCLES].tvalue = TermTrue;
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
@ -603,6 +605,8 @@ static Int writeln(USES_REGS1) {
args[WRITE_NL].tvalue = TermTrue;
args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
args[WRITE_CYCLES].used = true;
args[WRITE_CYCLES].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free(args);