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

fix overflow handling in global variables

Browse Source 
fix use of must_be_callable.
This commit is contained in:
Vitor Santos Costa 2019-05-27 15:31:22 +01:00
parent 8f8da92603
commit 07cd79ccb7
5 changed files with 152 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/exec.c
View File

@ -980,7 +980,7 @@ static bool watch_retry(Term d0 USES_REGS) {
while (B->cp_ap->opc == FAIL_OPCODE) while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b; B = B->cp_b;
ASP = (CELL *) PROTECT_FROZEN_B(B);
// just do the frrpest // just do the frrpest
if (B >= B0 && !ex_mode && !active) if (B >= B0 && !ex_mode && !active)
return true; return true;

10
C/fail_absmi_insts.h
View File

@ -215,10 +215,7 @@ failloop:
} }
/* pointer to code space */ /* pointer to code space */
/* or updatable variable */ /* or updatable variable */
#if defined(TERM_EXTENSIONS) || defined(FROZEN_STACKS) || \
defined(MULTI_ASSIGNMENT_VARIABLES)
if (IsPairTerm(d1)) if (IsPairTerm(d1))
#endif /* TERM_EXTENSIONS || FROZEN_STACKS || MULTI_ASSIGNMENT_VARIABLES */
{ {
register CELL flags; register CELL flags;
CELL *pt1 = RepPair(d1); CELL *pt1 = RepPair(d1);
@ -245,11 +242,12 @@ failloop:
goto failloop; goto failloop;
} else } else
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
if (IN_BETWEEN(H0, pt1, HR)) { if (IN_BETWEEN(H0, pt1, LCL0)) {
if (IsAttVar(pt1)) { if (IsAttVar(pt1)) {
goto failloop; goto failloop;
} else { } else {
TR = pt0; TR = pt0;
Yap_CleanOpaqueVariable(d1); Yap_CleanOpaqueVariable(d1);
goto failloop; goto failloop;
@ -257,7 +255,7 @@ failloop:
} }
#ifdef FROZEN_STACKS /* TRAIL */ #ifdef FROZEN_STACKS /* TRAIL */
/* don't reset frozen variables */ /* don't reset frozen variables */
if (pt0 < TR_FZ) else if (pt0 < TR_FZ)
goto failloop; goto failloop;
#endif #endif
flags = *pt1; flags = *pt1;
@ -306,9 +304,7 @@ hence we don't need to have a lock it */
} else { } else {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1); LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
int erase; int erase;
#if PARALLEL_YAP
PredEntry *ap = cl->ClPred; PredEntry *ap = cl->ClPred;
#endif
/* BB support */ /* BB support */
if (ap) { if (ap) {

74
C/globals.c
View File

@ -286,10 +286,9 @@ static Term GrowArena(Term arena, size_t size,
XREGS[arity + 1] = arena; XREGS[arity + 1] = arena;
if (!Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) { if (!Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false; return 0;
} }
arena = XREGS[arity + 1]; arena = XREGS[arity + 1];
adjust_cps(size PASS_REGS);
} }
pt = ArenaLimit(arena); pt = ArenaLimit(arena);
if (pt == HR) { if (pt == HR) {
@ -301,8 +300,8 @@ static Term GrowArena(Term arena, size_t size,
} }
arena = XREGS[arity + 1]; arena = XREGS[arity + 1];
} }
CreateNewArena(RepAppl(arena), size+old_size); arena = CreateNewArena(RepAppl(arena), size+old_size);
return size+old_size; return arena;
} }
CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) { CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
@ -329,11 +328,11 @@ CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
} }
} }
static Term CloseArena(cell_space_t *region, Term arena, static Term CloseArena(cell_space_t *region,
UInt old_size USES_REGS) { UInt old_size USES_REGS) {
UInt new_size; UInt new_size;
new_size = old_size - (HR - RepAppl(arena)); new_size = old_size - (HR - HB);
arena = CreateNewArena(HR, new_size); Term arena = CreateNewArena(HR, new_size);
exit_cell_space( region ); exit_cell_space( region );
return arena; return arena;
} }
@ -649,10 +648,10 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
cell_space_t cspace; cell_space_t cspace;
int res = 0, restarts = 0; int res = 0, restarts = 0;
Term tn; Term tn;
old_size = ArenaSz(arena);
restart: restart:
enter_cell_space(&cspace); enter_cell_space(&cspace);
old_size = ArenaSz(arena);
t = Deref(t); t = Deref(t);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
ASP = ArenaLimit(arena); ASP = ArenaLimit(arena);
@ -668,12 +667,12 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
Hi PASS_REGS)) < 0) { Hi PASS_REGS)) < 0) {
goto error_handler; goto error_handler;
} }
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS); *newarena = CloseArena(&cspace, old_size PASS_REGS);
return Hi[0]; return Hi[0];
} }
#endif #endif
if (share && VarOfTerm(t) > ArenaPt(arena)) { if (share && VarOfTerm(t) > ArenaPt(arena)) {
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS); *newarena = CloseArena(&cspace, old_size PASS_REGS);
return t; return t;
} }
tn = MkVarTerm(); tn = MkVarTerm();
@ -681,7 +680,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
res = -1; res = -1;
goto error_handler; goto error_handler;
} }
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS); *newarena = CloseArena(&cspace, old_size PASS_REGS);
return tn; return tn;
} else if (IsAtomOrIntTerm(t)) { } else if (IsAtomOrIntTerm(t)) {
return t; return t;
@ -703,7 +702,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
Hi PASS_REGS)) < 0) { Hi PASS_REGS)) < 0) {
goto error_handler; goto error_handler;
} }
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS); *newarena = CloseArena(&cspace, old_size PASS_REGS);
return tf; return tf;
} else { } else {
Functor f; Functor f;
@ -724,7 +723,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
switch ((CELL) f) { switch ((CELL) f) {
case (CELL) FunctorDBRef: case (CELL) FunctorDBRef:
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS); *newarena = CloseArena(&cspace, old_size PASS_REGS);
return t; return t;
case (CELL) FunctorLongInt: case (CELL) FunctorLongInt:
if (HR > ASP - (MIN_ARENA_SIZE + 3)) { if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
@ -783,32 +782,32 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
goto error_handler; goto error_handler;
} }
} }
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS); *newarena = CloseArena(&cspace, old_size PASS_REGS);
return tf; return tf;
} }
error_handler: error_handler:
XREGS[arity + 1] = t; XREGS[arity + 1] = t;
XREGS[arity + 2] = arena;
exit_cell_space(&cspace);
switch (res) { switch (res) {
case -1: case -1:
if (arena == LOCAL_GlobalArena) if (arena == LOCAL_GlobalArena)
LOCAL_GlobalArenaOverflows++; LOCAL_GlobalArenaOverflows++;
restarts++; restarts++;
min_grow += (restarts < 16 ? 16*1024*restarts*restarts : 128*1024*1024); min_grow += (restarts < 16 ? 16*1024*restarts*restarts : 128*1024*1024);
CreateNewArena (RepAppl(arena),old_size); HR = HB;
if((arena=GrowArena(arena, min_grow, arity + 2, &cspace PASS_REGS))==0) { arena = CloseArena (&cspace, old_size PASS_REGS);
if((arena=GrowArena(arena, min_grow, arity + 1, &cspace PASS_REGS))==0) {
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return 0L; return 0L;
} }
t = XREGS[arity+1];
enter_cell_space(&cspace);
old_size = ArenaSz(arena);
break; break;
default: /* temporary space overflow */ default: /* temporary space overflow */
exit_cell_space(&cspace);
return 0; return 0;
} }
enter_cell_space(&cspace);
arena = Deref(XREGS[arity + 2]);
t = XREGS[arity + 1];
goto restart; goto restart;
} }
@ -836,7 +835,7 @@ restart:
// CELL *old_top = ArenaLimit(*nsizeof(CELL)ewarena); // CELL *old_top = ArenaLimit(*nsizeof(CELL)ewarena);
if (arena == LOCAL_GlobalArena) if (arena == LOCAL_GlobalArena)
LOCAL_GlobalArenaOverflows++; LOCAL_GlobalArenaOverflows++;
CreateNewArena (RepAppl(arena),old_size); arena = CreateNewArena (RepAppl(arena),old_size);
if ((arena=GrowArena(arena, Nar * sizeof(CELL), if ((arena=GrowArena(arena, Nar * sizeof(CELL),
arity + 1, &cells PASS_REGS))==0) { arity + 1, &cells PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, Yap_Error(RESOURCE_ERROR_STACK, TermNil,
@ -856,7 +855,7 @@ restart:
HB0[i] = init; HB0[i] = init;
} }
} }
*newarena = CloseArena(&cells, arena, ArenaSz(arena) PASS_REGS); *newarena = CloseArena(&cells, ArenaSz(arena) PASS_REGS);
return tf; return tf;
} }
@ -1658,19 +1657,18 @@ static Int p_nb_queue_enqueue(USES_REGS1) {
} else { } else {
min_size = 0L; min_size = 0L;
} }
to = CopyTermToArena(ARG2, arena, FALSE, TRUE, 2, qd + QUEUE_ARENA, Term newarena = arena;
to = CopyTermToArena(Deref(ARG2), arena, FALSE, TRUE, 2, &newarena,
min_size PASS_REGS); min_size PASS_REGS);
if (to == 0L) if (to == 0L)
return FALSE; return FALSE;
cell_space_t cspace; cell_space_t cspace;
qd = GetQueue(ARG1, "enqueue"); arena = newarena;
arena = GetQueueArena(qd, "enqueue");
/* garbage collection ? */ /* garbage collection ? */
enter_cell_space(&cspace);
HR = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
qd = GetQueue(ARG1, "enqueue");
qsize = IntegerOfTerm(qd[QUEUE_SIZE]); qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize + 1); qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize + 1);
if (qsize == 0) { if (qsize == 0) {
qd[QUEUE_HEAD] = AbsPair(HR); qd[QUEUE_HEAD] = AbsPair(HR);
@ -1681,7 +1679,7 @@ static Int p_nb_queue_enqueue(USES_REGS1) {
RESET_VARIABLE(HR); RESET_VARIABLE(HR);
qd[QUEUE_TAIL] = (CELL)HR; qd[QUEUE_TAIL] = (CELL)HR;
HR++; HR++;
qd[QUEUE_ARENA] = CloseArena(&cspace, qd[ QUEUE_ARENA ], old_sz PASS_REGS); qd[QUEUE_ARENA] =CloseArena(&cspace, old_sz PASS_REGS);
return TRUE; return TRUE;
} }
@ -1705,7 +1703,7 @@ static Int p_nb_queue_dequeue(USES_REGS1) {
/* garbage collection ? */ /* garbage collection ? */
enter_cell_space(&cspace); enter_cell_space(&cspace);
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz - 1); qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz - 1);
qd[QUEUE_ARENA] = CloseArena(&cspace, arena, old_sz PASS_REGS); qd[QUEUE_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
return Yap_unify(out, ARG2); return Yap_unify(out, ARG2);
} }
@ -1955,7 +1953,7 @@ restart:
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
HR = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize); qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize);
qd[HEAP_ARENA] = CloseArena(&cspace, arena, old_sz PASS_REGS); qd[HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
goto restart; goto restart;
} }
arena = qd[HEAP_ARENA]; arena = qd[HEAP_ARENA];
@ -1966,14 +1964,14 @@ restart:
mingrow PASS_REGS); mingrow PASS_REGS);
qd = GetHeap(ARG1, "add_to_heap"); qd = GetHeap(ARG1, "add_to_heap");
arena = qd[HEAP_ARENA]; arena = qd[HEAP_ARENA];
to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd + HEAP_ARENA, to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, &arena,
mingrow PASS_REGS); mingrow PASS_REGS);
/* protect key in ARG2 in case there is an overflow while copying to */ /* protect key in ARG2 in case there is an overflow while copying to */
key = ARG2; key = ARG2;
if (key == 0 || to == 0L) if (key == 0 || to == 0L)
return FALSE; return FALSE;
qd = GetHeap(ARG1, "add_to_heap"); qd = GetHeap(ARG1, "add_to_heap");
arena = qd[HEAP_ARENA]; qd[HEAP_ARENA] = arena;
/* garbage collection ? */ /* garbage collection ? */
enter_cell_space(&cspace); enter_cell_space(&cspace);
HR = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
@ -1987,7 +1985,7 @@ restart:
gsiz = 1024; gsiz = 1024;
} }
ARG3 = to; ARG3 = to;
CreateNewArena (RepAppl(arena),old_sz); arena = CreateNewArena (RepAppl(arena),old_sz);
if ((arena=GrowArena(arena, gsiz, 3, &cspace PASS_REGS))==0) { if ((arena=GrowArena(arena, gsiz, 3, &cspace PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage); Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
return 0L; return 0L;
@ -2003,7 +2001,7 @@ restart:
pt[2 * hsize + 1] = to; pt[2 * hsize + 1] = to;
PushHeap(pt, hsize); PushHeap(pt, hsize);
qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1); qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
qd[HEAP_ARENA] = CloseArena(&cspace, qd[ HEAP_ARENA ], old_sz PASS_REGS); qd[HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
return TRUE; return TRUE;
} }
@ -2347,7 +2345,7 @@ cell_space_t cspace;
} }
ARG3 = to; ARG3 = to;
/* fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/ /* fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/
CreateNewArena (RepAppl(arena),old_sz); arena = CreateNewArena (RepAppl(arena),old_sz);
if (!GrowArena(arena, gsiz, 3, &cspace PASS_REGS)) { if (!GrowArena(arena, gsiz, 3, &cspace PASS_REGS)) {
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage); Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
return 0L; return 0L;
@ -2360,7 +2358,7 @@ cell_space_t cspace;
pt = qd + HEAP_START; pt = qd + HEAP_START;
PushBeam(pt, pt + 2 * hmsize, hsize, key, to); PushBeam(pt, pt + 2 * hmsize, hsize, key, to);
qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1); qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
qd[HEAP_ARENA] = CloseArena(&cspace, qd[ HEAP_ARENA ], old_sz PASS_REGS); qd[HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
return TRUE; return TRUE;
} }
@ -2383,7 +2381,7 @@ static Int p_nb_beam_del(USES_REGS1) {
/* garbage collection ? */ /* garbage collection ? */
enter_cell_space(&cspace); enter_cell_space(&cspace);
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz - 1); qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz - 1);
qd[ HEAP_ARENA] = CloseArena(&cspace, arena, old_sz PASS_REGS); qd[ HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
tk = qd[HEAP_START]; tk = qd[HEAP_START];
tv = DelBeamMin(qd + HEAP_START, tv = DelBeamMin(qd + HEAP_START,
qd + (HEAP_START + 2 * IntegerOfTerm(qd[HEAP_MAX])), qsz); qd + (HEAP_START + 2 * IntegerOfTerm(qd[HEAP_MAX])), qsz);

1
C/stdpreds.c
View File

@ -1575,6 +1575,7 @@ void Yap_InitCPreds(void) {
Yap_InitCoroutPreds(); Yap_InitCoroutPreds();
Yap_InitDBPreds(); Yap_InitDBPreds();
Yap_InitExecFs(); Yap_InitExecFs();
Yap_InitErrorPreds();
Yap_InitGlobals(); Yap_InitGlobals();
Yap_InitInlines(); Yap_InitInlines();
Yap_InitIOPreds(); Yap_InitIOPreds();

94
C/write.c
View File

@ -410,28 +410,31 @@ static void wrputref(CODEADDR ref, int Quote_illegal,
lastw = alphanum; lastw = alphanum;
} }
static inline bool was_visited(Term t, wglbs *wg, Term *ta) { static inline bool was_visited(Term t, wglbs *wg, Term *ta) {
Term *tp; Term *tp;
if (IsApplTerm(t)) { if (IsApplTerm(t)) {
if (IsExtensionFunctor(FunctorOfTerm(t)))
return false;
tp = RepAppl(t); tp = RepAppl(t);
*ta = tp[0];
return false;
if (IsExtensionFunctor(FunctorOfTerm(t))) {
return false;
} }
else if (IsPairTerm(t)) tp = RepPair(t); } else if (IsPairTerm(t)) {
else return false; tp = RepPair(t);
*ta = tp[0];
return false;
} else
return false;
if (IsAtomTerm(*tp)) { if (IsAtomTerm(*tp)) {
CELL *pt = (CELL *)AtomOfTerm(*tp); CELL *pt = (CELL *)AtomOfTerm(*tp);
if (pt >= wg->visited0 && if (pt >= wg->visited0 && pt < wg->visited) {
pt < wg->visited) { int depth = (wg->visited) - pt;
int depth = (wg->visited+1)-pt; wrputs(" @[-", wg->stream);
wrputs(" @( ", wg->stream);
wrputn(depth, wg); wrputn(depth, wg);
wrputs( " ) ", wg->stream); wrputs("] ", wg->stream);
return true; return true;
} }
} }
*ta = *tp;
wg->visited[0] = *tp; wg->visited[0] = *tp;
*tp = MkAtomTerm((Atom)wg->visited); *tp = MkAtomTerm((Atom)wg->visited);
wg->visited++; wg->visited++;
@ -441,21 +444,23 @@ static inline bool was_visited(Term t, wglbs *wg, Term *ta ) {
static inline Term visited_indirection(Term t, wglbs *wg) { static inline Term visited_indirection(Term t, wglbs *wg) {
Term *tp = (CELL *)AtomOfTerm(t); Term *tp = (CELL *)AtomOfTerm(t);
if (tp >= wg->visited0 if (tp >= wg->visited0 && (CELL *)tp < wg->visited_top)
&& (CELL *) tp < wg->visited_top)
return *tp; return *tp;
return 0; return 0;
} }
static inline void done_visiting(Term t, wglbs *wg) { static inline void done_visiting(Term t, wglbs *wg) {
Term *tp; Term *tp;
if (IsApplTerm(t)) tp = RepAppl(t); return;
else if (IsPairTerm(t)) tp = RepPair(t); if (IsApplTerm(t))
else return; tp = RepAppl(t);
else if (IsPairTerm(t))
tp = RepPair(t);
else
return;
*tp = *--wg->visited; *tp = *--wg->visited;
} }
/* writes a blob (default) */ /* writes a blob (default) */
static int wrputblob(AtomEntry *ref, int Quote_illegal, static int wrputblob(AtomEntry *ref, int Quote_illegal,
struct write_globs *wglb) { struct write_globs *wglb) {
@ -628,7 +633,8 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
unsigned char *s; unsigned char *s;
wtype atom_or_symbol; wtype atom_or_symbol;
wrf stream = wglb->stream; wrf stream = wglb->stream;
if (atom == NULL) return; if (atom == NULL)
return;
s = RepAtom(atom)->UStrOfAE; s = RepAtom(atom)->UStrOfAE;
if (s[0] == '\0') { if (s[0] == '\0') {
if (Quote_illegal) { if (Quote_illegal) {
@ -772,19 +778,13 @@ static void write_var(CELL *t, struct write_globs *wglb,
} }
} }
static void write_list(Term t, int direction, int depth, static void write_list(Term t, Term hot, 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;
nrwt.parent = rwt; nrwt.parent = rwt;
nrwt.u_sd.s.ptr = 0; nrwt.u_sd.s.ptr = 0;
Term hot; while (true) {
if (was_visited(t, wglb, &hot)) {
return;
}
bool loop = true;
while (loop) {
loop = false;
PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt)); PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t); ti = TailOfTerm(t);
if (IsVarTerm(ti)) if (IsVarTerm(ti))
@ -797,25 +797,33 @@ loop = false;
} }
wrputc('|', wglb->stream); wrputc('|', wglb->stream);
putAtom(Atom3Dots, wglb->Quote_illegal, wglb); putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
done_visiting(t, wglb);
return; return;
} }
lastw = separator; lastw = separator;
depth++; depth++;
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
t = ti; if ((was_visited(ti, wglb, &hot))) {
break;
}
write_list(ti, hot, direction, depth, wglb, &nrwt);
done_visiting(ti, wglb);
return;
} }
if (IsPairTerm(ti)) { if (IsPairTerm(ti)) {
/* 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); write_list(ti, hot, direction, depth, wglb, &nrwt);
} else if (ti != MkAtomTerm(AtomNil)) { done_visiting(ti, wglb);
} else if (ti != TermNil) {
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); writeTerm(ti, 999, depth, FALSE, wglb, &nrwt);
done_visiting(ti, wglb);
} }
} }
@ -846,13 +854,13 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} }
putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb); putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
if (wglb->Ignore_ops) {
wrputs("'.'(", wglb->stream);
lastw = separator;
Term hot; Term hot;
if ((was_visited(t, wglb, &hot))) { if ((was_visited(t, wglb, &hot))) {
return; return;
} }
if (wglb->Ignore_ops) {
wrputs("'.'(", wglb->stream);
lastw = separator;
PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt)); PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
wrputs(",", wglb->stream); wrputs(",", wglb->stream);
@ -861,17 +869,24 @@ if ((was_visited(t, wglb, &hot))) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
return; return;
} }
if (wglb->Use_portray) if (wglb->Use_portray) {
done_visiting(t, wglb);
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) { if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
return; return;
} }
if ((was_visited(t, wglb, &hot))) {
return;
}
}
if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) { if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) {
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 */ /* we assume t was already saved in the stack */
write_list(t, 0, depth, wglb, rwt); write_list(t, hot, 0, depth, wglb, rwt);
done_visiting(t, wglb);
wrputc(']', wglb->stream); wrputc(']', wglb->stream);
lastw = separator; lastw = separator;
} }
@ -938,9 +953,13 @@ if ((was_visited(t, wglb, &hot))) {
} }
#endif #endif
if (wglb->Use_portray) { if (wglb->Use_portray) {
done_visiting(t, wglb);
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) { if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
return; return;
} }
Term tf;
was_visited(t, wglb, &tf);
functor = (Functor)tf;
} }
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) { if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
@ -1003,7 +1022,7 @@ if ((was_visited(t, wglb, &hot))) {
wrputc('{', wglb->stream); wrputc('{', wglb->stream);
} }
lastw = separator; lastw = separator;
write_list(tleft, 0, depth, wglb, rwt); writeTerm(tleft, 0, rinfixarg, depth, wglb, rwt);
if (atom == AtomEmptyBrackets) { if (atom == AtomEmptyBrackets) {
wrputc(')', wglb->stream); wrputc(')', wglb->stream);
} else if (atom == AtomEmptySquareBrackets) { } else if (atom == AtomEmptySquareBrackets) {
@ -1180,13 +1199,11 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
if (true && (flags & Handle_cyclics_f)) { if (true && (flags & Handle_cyclics_f)) {
// tp = Yap_CyclesInTerm(t PASS_REGS); // tp = Yap_CyclesInTerm(t PASS_REGS);
wglb.visited = Malloc(1024*sizeof(CELL)), wglb.visited = Malloc(1024 * sizeof(CELL)), wglb.visited0 = wglb.visited,
wglb.visited0 = wglb.visited,
wglb.visited_top = wglb.visited + 1024; wglb.visited_top = wglb.visited + 1024;
} }
tp = t; tp = t;
/* protect slots for portray */ /* protect slots for portray */
writeTerm(tp, priority, 1, false, &wglb, &rwt); writeTerm(tp, priority, 1, false, &wglb, &rwt);
if (flags & New_Line_f) { if (flags & New_Line_f) {
@ -1204,4 +1221,3 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
} }
pop_text_stack(lvl); pop_text_stack(lvl);
} }