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;

12
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,19 +242,20 @@ 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;
} }
} }
#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) {

78
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;
} }
break; t = XREGS[arity+1];
enter_cell_space(&cspace);
old_size = ArenaSz(arena);
break;
default: /* temporary space overflow */ default: /* temporary space overflow */
return 0; exit_cell_space(&cspace);
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();

200
C/write.c
View File

@ -74,7 +74,7 @@ typedef struct write_globs {
bool Keep_terms; bool Keep_terms;
bool Write_Loops; bool Write_Loops;
bool Write_strings; bool Write_strings;
UInt last_atom_minus; UInt last_atom_minus;
UInt MaxDepth, MaxArgs; UInt MaxDepth, MaxArgs;
wtype lw; wtype lw;
CELL *visited, *visited0, *visited_top; CELL *visited, *visited0, *visited_top;
@ -410,52 +410,57 @@ 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)) { tp = RepAppl(t);
if (IsExtensionFunctor(FunctorOfTerm(t))) *ta = tp[0];
return false;
tp = RepAppl(t);
}
else if (IsPairTerm(t)) tp = RepPair(t);
else return false;
if (IsAtomTerm(*tp)) {
CELL *pt= (CELL*)AtomOfTerm(*tp);
if (pt >= wg->visited0 &&
pt < wg->visited) {
int depth = (wg->visited+1)-pt;
wrputs(" @( ", wg->stream);
wrputn(depth, wg);
wrputs( " ) ", wg->stream);
return true;
}
}
*ta = *tp;
wg->visited[0] = *tp;
*tp = MkAtomTerm( (Atom)wg->visited );
wg->visited++;
return false; return false;
if (IsExtensionFunctor(FunctorOfTerm(t))) {
return false;
}
} else if (IsPairTerm(t)) {
tp = RepPair(t);
*ta = tp[0];
return false;
} else
return false;
if (IsAtomTerm(*tp)) {
CELL *pt = (CELL *)AtomOfTerm(*tp);
if (pt >= wg->visited0 && pt < wg->visited) {
int depth = (wg->visited) - pt;
wrputs(" @[-", wg->stream);
wrputn(depth, wg);
wrputs("] ", wg->stream);
return true;
}
}
wg->visited[0] = *tp;
*tp = MkAtomTerm((Atom)wg->visited);
wg->visited++;
return false;
} }
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);
*tp = *--wg->visited; else if (IsPairTerm(t))
tp = RepPair(t);
else
return;
*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) {
@ -523,10 +528,10 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) { static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) {
CACHE_REGS CACHE_REGS
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) { if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
wrputc(ch, stream); wrputc(ch, stream);
if (ch == '\'') if (ch == '\'')
wrputc('\'', stream); /* be careful about quotes */ wrputc('\'', stream); /* be careful about quotes */
return; return;
} }
if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' && if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' &&
ch != '`') { ch != '`') {
@ -628,12 +633,13 @@ 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) {
wrputc('\'', stream); wrputc('\'', stream);
wrputc('\'', stream); wrputc('\'', stream);
} }
return; return;
} }
@ -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);
} }
} }
@ -840,19 +848,19 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputn((Int)IntOfTerm(t), wglb); wrputn((Int)IntOfTerm(t), wglb);
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
Term tn; Term tn;
if ((tn = visited_indirection(t, wglb))!=0) { if ((tn = visited_indirection(t, wglb)) != 0) {
writeTerm(tn,p,depth,rinfixarg,wglb,rwt); writeTerm(tn, p, depth, rinfixarg, wglb, rwt);
return; return;
} }
putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb); putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
Term hot;
if ((was_visited(t, wglb, &hot))) {
return;
}
if (wglb->Ignore_ops) { if (wglb->Ignore_ops) {
wrputs("'.'(", wglb->stream); wrputs("'.'(", wglb->stream);
lastw = separator; lastw = separator;
Term hot;
if ((was_visited(t, wglb, &hot))) {
return;
}
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) {
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) { done_visiting(t, wglb);
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;
} }
@ -882,10 +897,10 @@ if ((was_visited(t, wglb, &hot))) {
int op, lp, rp; int op, lp, rp;
Term argf; Term argf;
if (was_visited(t, wglb, &argf)) { if (was_visited(t, wglb, &argf)) {
return; return;
} }
functor = (Functor)argf; functor = (Functor)argf;
if (IsExtensionFunctor(functor)) { if (IsExtensionFunctor(functor)) {
switch ((CELL)functor) { switch ((CELL)functor) {
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
@ -938,12 +953,16 @@ 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)) {
Term tright = ArgOfTerm(1, t); Term tright = ArgOfTerm(1, t);
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) && int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright)); Yap_IsOp(AtomOfTerm(tright));
@ -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) {
@ -1125,10 +1144,10 @@ if ((was_visited(t, wglb, &hot))) {
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
wrputc('}', wglb->stream); wrputc('}', wglb->stream);
lastw = separator; lastw = separator;
} else { } else {
if (!wglb->Ignore_ops && atom == AtomHeap) { if (!wglb->Ignore_ops && atom == AtomHeap) {
Arity = 3+2*IntegerOfTerm(ArgOfTerm(1,t)); Arity = 3 + 2 * IntegerOfTerm(ArgOfTerm(1, t));
} }
putAtom(atom, wglb->Quote_illegal, wglb); putAtom(atom, wglb->Quote_illegal, wglb);
lastw = separator; lastw = separator;
wropen_bracket(wglb, FALSE); wropen_bracket(wglb, FALSE);
@ -1147,7 +1166,7 @@ if ((was_visited(t, wglb, &hot))) {
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
done_visiting(t, wglb); done_visiting(t, wglb);
} }
} }
@ -1173,25 +1192,23 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wglb.Keep_terms = flags & To_heap_f; wglb.Keep_terms = flags & To_heap_f;
wglb.Write_Loops = flags & Handle_cyclics_f; wglb.Write_Loops = flags & Handle_cyclics_f;
wglb.Quote_illegal = flags & Quote_illegal_f; wglb.Quote_illegal = flags & Quote_illegal_f;
wglb.MaxArgs = 0 ; wglb.MaxArgs = 0;
wglb.MaxDepth = 0 ; wglb.MaxDepth = 0;
wglb.lw = separator; wglb.lw = separator;
Term tp; Term tp;
if (true && (flags & Handle_cyclics_f) ){
// tp = Yap_CyclesInTerm(t PASS_REGS);
wglb.visited = Malloc(1024*sizeof(CELL)),
wglb.visited0 = wglb.visited,
wglb.visited_top = wglb.visited+1024;
}
tp = t;
/* protect slots for portray */ if (true && (flags & Handle_cyclics_f)) {
// tp = Yap_CyclesInTerm(t PASS_REGS);
wglb.visited = Malloc(1024 * sizeof(CELL)), wglb.visited0 = wglb.visited,
wglb.visited_top = wglb.visited + 1024;
}
tp = t;
/* 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) {
if (flags & Fullstop_f) { if (flags & Fullstop_f) {
wrputc('.', wglb.stream); wrputc('.', wglb.stream);
wrputc('\n', wglb.stream); wrputc('\n', wglb.stream);
} else { } else {
wrputc('\n', wglb.stream); wrputc('\n', wglb.stream);
@ -1203,5 +1220,4 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
} }
} }
pop_text_stack(lvl); pop_text_stack(lvl);
} }