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

fix tracing of functor/ arg 

fix leaks in Malloc
handle overfows in globals.
This commit is contained in:
Vitor Santos Costa 2019-05-02 20:51:46 +01:00
parent 7c16af4edf
commit c91faf8bc3
9 changed files with 248 additions and 220 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -215,3 +215,4 @@ cmake/docs/Doxyfile
*.stackdump
*.gz
.Rproj.user

3
C/exec.c
View File

@ -1612,7 +1612,6 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
CalculateStackGap(PASS_REGS1);
LOCAL_CBorder = OldBorder;
LOCAL_RestartEnv = sighold;
pop_text_stack(i + 1);
return out;
}
@ -2267,7 +2266,7 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var);
#endif
size_t defsz = 128*1024;
Yap_AllocateDefaultArena(defsz, myworker_id);
Yap_AllocateDefaultArena(defsz, myworker_id, NULL);
} else {
HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id));
}

222
C/globals.c
View File

@ -139,6 +139,26 @@ threads that are created <em>after</em> the registration.
#define HEAP_ARENA 2
#define HEAP_START 3
/// A cell_space is a short code region, where we want bindings to proceed locally.
/// It is used in copy_term,,,,,,,,,,,,,,,,,,,,,,,
///
typedef struct cell_space {
struct cell_space *parent; //`
CELL *oASP, *oH, *oHB;
} cell_space_t;
INLINE_ONLY void enter_cell_space(cell_space_t *cs) {
cs->oH = HR;
cs->oHB = HB;
cs->oASP = ASP;
}
INLINE_ONLY void exit_cell_space(cell_space_t *cs) {
HR = cs->oH;
HB = cs->oHB;
ASP = cs->oASP;
}
#define MIN_ARENA_SIZE (1048L)
#define MAX_ARENA_SIZE (2048 * 16)
@ -186,34 +206,37 @@ static Term CreateNewArena(CELL *ptr, UInt size) {
return t;
}
static Term NewArena(UInt size, int wid, UInt arity, CELL *where) {
static Term NewArena(UInt size, int wid, UInt arity, CELL *where, struct cell_space *cellSpace) {
Term t;
UInt new_size;
WORKER_REGS(wid)
exit_cell_space(cellSpace);
// make sure we have enough room
while (HR + size > ASP - 1024) {
while (HR + size > ASP - MIN_ARENA_SIZE) {
if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return TermNil;
}
}
if (where == NULL || where == HR) {
t = CreateNewArena(HR, size);
HR += size;
new_size = size;
} else {
if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
"No Stack Space for Non-Backtrackable terms");
return TermNil;
}
size = new_size / sizeof(CELL);
t = CreateNewArena(where, size);
}
enter_cell_space(cellSpace);
return t;
}
static Int p_allocate_arena(USES_REGS1) {
cell_space_t cspace;
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "allocate_arena");
@ -222,15 +245,21 @@ static Int p_allocate_arena(USES_REGS1) {
Yap_Error(TYPE_ERROR_INTEGER, t, "allocate_arena");
return FALSE;
}
return Yap_unify(ARG2, NewArena(IntegerOfTerm(t), worker_id, 1, NULL));
enter_cell_space(&cspace);
return Yap_unify(ARG2, NewArena(IntegerOfTerm(t), worker_id, 1, NULL, &cspace));
}
static Int p_default_arena_size(USES_REGS1) {
return Yap_unify(ARG1, MkIntegerTerm(ArenaSz(LOCAL_GlobalArena)));
}
void Yap_AllocateDefaultArena(size_t gsize, int wid) {
REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL);
void Yap_AllocateDefaultArena(size_t gsize, int wid, void *cs) {
cell_space_t ics;
if (cs == NULL) {
enter_cell_space(&ics);
cs = &ics;
}
REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL, cs);
}
static void adjust_cps(UInt size USES_REGS) {
@ -243,7 +272,7 @@ static void adjust_cps(UInt size USES_REGS) {
}
static Term GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
UInt arity USES_REGS) {
UInt arity, cell_space_t *cspace USES_REGS) {
size_t sz;
LOCAL_ArenaOverflows++;
if (size == 0) {
@ -253,35 +282,35 @@ static Term GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
size = old_size + 128 * 1024;
}
}
if (size < 4096) {
size = 4096;
if (size < 4*MIN_ARENA_SIZE) {
size = 4*MIN_ARENA_SIZE;
}
while (HR + size > ASP - 1024) {
exit_cell_space(cspace);
while (HR + size > ASP - MIN_ARENA_SIZE) {
XREGS[arity + 1] = arena;
if (!Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
}
arena = XREGS[arity + 1];
adjust_cps(size PASS_REGS);
adjust_cps(size PASS_REGS);
}
pt = ArenaLimit(arena)+1;
sz = old_size + size;
if (pt == HR) {
sz = old_size + size;
HR += size;
HR += size+1;
HR[ - 1] = EndSpecials;
} else {
if ((sz = Yap_InsertInGlobal(pt, sz * sizeof(CELL))) == 0) {
if ((sz = Yap_InsertInGlobal(pt, size * sizeof(CELL))) == 0) {
return FALSE;
}
pt[sz-1] = EndSpecials;
pt[size-1] = EndSpecials;
}
arena = XREGS[arity + 1];
MP_INT *dst = (MP_INT *)(RepAppl(arena) + 2);
dst->_mp_alloc+= size/sizeof(CELL);
dst->_mp_alloc+= size;
arena = XREGS[arity + 1];
return sz;
}
}
CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
@ -308,17 +337,15 @@ CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
}
}
static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP,
static void CloseArena(cell_space_t *region, Term *oldArenaP,
UInt old_size USES_REGS) {
UInt new_size;
if (HR == oldH)
if (HR == region->oH)
return;
new_size = old_size - (HR - RepAppl(*oldArenaP));
*oldArenaP = CreateNewArena(HR, new_size);
HR = oldH;
HB = oldHB;
ASP = oldASP;
exit_cell_space( region );
}
static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
@ -641,9 +668,8 @@ 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 *oldHB = HB;
CELL *oldASP = ASP;
cell_space_t cspace;
enter_cell_space( & cspace);
int res = 0;
Term tn;
@ -662,12 +688,12 @@ restart:
if ((res = copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi,
Hi PASS_REGS)) < 0)
goto error_handler;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return Hi[0];
}
#endif
if (share && VarOfTerm(t) > ArenaPt(arena)) {
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return t;
}
tn = MkVarTerm();
@ -675,7 +701,7 @@ restart:
res = -1;
goto error_handler;
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return tn;
} else if (IsAtomOrIntTerm(t)) {
return t;
@ -697,7 +723,7 @@ restart:
Hi PASS_REGS)) < 0) {
goto error_handler;
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return tf;
} else {
Functor f;
@ -718,7 +744,7 @@ restart:
if (IsExtensionFunctor(f)) {
switch ((CELL)f) {
case (CELL) FunctorDBRef:
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return t;
case (CELL) FunctorLongInt:
if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
@ -777,25 +803,23 @@ restart:
goto error_handler;
}
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return tf;
}
error_handler:
HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
XREGS[arity + 1] = t;
XREGS[arity + 2] = arena;
XREGS[arity + 3] = (CELL)newarena;
{
CELL *old_top = ArenaLimit(*newarena);
ASP = oldASP;
HR = oldH;
HB = oldHB;
exit_cell_space(&cspace);
switch (res) {
case -1:
if (arena == LOCAL_GlobalArena)
LOCAL_GlobalArenaOverflows++;
if ((arena=GrowArena(arena, old_top, old_size, min_grow, arity + 3 PASS_REGS))==0) {
if ((arena=GrowArena(arena, old_top, old_size, min_grow, arity + 3, &cspace PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return 0L;
}
@ -805,9 +829,7 @@ error_handler:
}
}
oldH = HR;
oldHB = HB;
oldASP = ASP;
enter_cell_space(&cspace);
newarena = (CELL *)XREGS[arity + 3];
arena = Deref(XREGS[arity + 2]);
t = XREGS[arity + 1];
@ -817,10 +839,9 @@ error_handler:
static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity,
Term *newarena, Term init USES_REGS) {
cell_space_t cells;
UInt old_size = ArenaSz(arena);
CELL *oldH = HR;
CELL *oldHB = HB;
CELL *oldASP = ASP;
enter_cell_space(&cells);
Term tf;
CELL *HB0;
Functor f = Yap_MkFunctor(Na, Nar);
@ -836,26 +857,20 @@ restart:
if (HR > ASP - MIN_ARENA_SIZE) {
/* overflow */
HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cells, newarena, old_size PASS_REGS);
XREGS[arity + 1] = arena;
XREGS[arity + 2] = (CELL)newarena;
{
CELL *old_top = ArenaLimit(*newarena);
ASP = oldASP;
HR = oldH;
HB = oldHB;
if (arena == LOCAL_GlobalArena)
LOCAL_GlobalArenaOverflows++;
if ((arena=GrowArena(arena, old_top, old_size, Nar * sizeof(CELL),
arity + 2 PASS_REGS))==0) {
arity + 2, &cells PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
"while creating large global term");
return 0L;
}
}
oldH = HR;
oldHB = HB;
oldASP = ASP;
newarena = (CELL *)XREGS[arity + 2];
arena = Deref(XREGS[arity + 1]);
old_size = ArenaSz(arena);
@ -870,7 +885,7 @@ restart:
HB0[i] = init;
}
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cells, newarena, old_size PASS_REGS);
return tf;
}
@ -1532,9 +1547,10 @@ static Int p_nb_create2(USES_REGS1) {
static Int nb_queue(UInt arena_sz USES_REGS) {
cell_space_t cspace;
Term queue_arena, queue, ar[QUEUE_FUNCTOR_ARITY], *nar;
Term t = Deref(ARG1);
enter_cell_space(&cspace);
LOCAL_DepthArenas++;
if (!IsVarTerm(t)) {
if (!IsApplTerm(t)) {
@ -1549,7 +1565,7 @@ static Int nb_queue(UInt arena_sz USES_REGS) {
return FALSE;
if (arena_sz < 32 * 1024)
arena_sz = 32 * 1024;
queue_arena = NewArena(arena_sz, worker_id, 1, NULL);
queue_arena = NewArena(arena_sz, worker_id, 1, NULL, &cspace);
if (queue_arena == 0L) {
return FALSE;
}
@ -1654,7 +1670,7 @@ static Int p_nb_queue_close(USES_REGS1) {
}
static Int p_nb_queue_enqueue(USES_REGS1) {
CELL *qd = GetQueue(ARG1, "enqueue"), *oldH, *oldHB;
CELL *qd = GetQueue(ARG1, "enqueue");
UInt old_sz;
Term arena, qsize, to;
UInt min_size;
@ -1673,37 +1689,15 @@ static Int p_nb_queue_enqueue(USES_REGS1) {
min_size PASS_REGS);
if (to == 0L)
return FALSE;
cell_space_t cspace;
qd = GetQueue(ARG1, "enqueue");
arena = GetQueueArena(qd, "enqueue");
/* garbage collection ? */
oldH = HR;
oldHB = HB;
enter_cell_space(&cspace);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = HR - RepPair(qd[QUEUE_HEAD]);
HR = oldH;
HB = oldHB;
if (gsiz > 1024 * 1024) {
gsiz = 1024 * 1024;
} else if (gsiz < 1024) {
gsiz = 1024;
}
ARG3 = to;
/* fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/
if ((arena=GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
return 0L;
}
to = ARG3;
qd = RepAppl(Deref(ARG1)) + 1;
arena = GetQueueArena(qd, "enqueue");
oldH = HR;
oldHB = HB;
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
}
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize + 1);
if (qsize == 0) {
qd[QUEUE_HEAD] = AbsPair(HR);
@ -1714,7 +1708,7 @@ static Int p_nb_queue_enqueue(USES_REGS1) {
RESET_VARIABLE(HR);
qd[QUEUE_TAIL] = (CELL)HR;
HR++;
CloseArena(oldH, oldHB, ASP, qd + QUEUE_ARENA, old_sz PASS_REGS);
CloseArena(&cspace, qd + QUEUE_ARENA, old_sz PASS_REGS);
return TRUE;
}
@ -1722,7 +1716,7 @@ static Int p_nb_queue_dequeue(USES_REGS1) {
CELL *qd = GetQueue(ARG1, "dequeue");
UInt old_sz, qsz;
Term arena, out;
CELL *oldH, *oldHB;
cell_space_t cspace;
if (!qd)
return FALSE;
@ -1736,10 +1730,9 @@ static Int p_nb_queue_dequeue(USES_REGS1) {
out = HeadOfTerm(qd[QUEUE_HEAD]);
qd[QUEUE_HEAD] = TailOfTerm(qd[QUEUE_HEAD]);
/* garbage collection ? */
oldH = HR;
oldHB = HB;
enter_cell_space(&cspace);
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz - 1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
CloseArena(&cspace, &arena, old_sz PASS_REGS);
return Yap_unify(out, ARG2);
}
@ -1836,6 +1829,7 @@ static Term MkZeroApplTerm(Functor f, UInt sz USES_REGS) {
static Int p_nb_heap(USES_REGS1) {
Term heap_arena, heap, *ar, *nar;
UInt hsize;
cell_space_t cspace;
Term tsize = Deref(ARG1);
UInt arena_sz = (ASP-HR) / 16;
@ -1866,7 +1860,7 @@ static Int p_nb_heap(USES_REGS1) {
ar[HEAP_MAX] = tsize;
if (arena_sz < 1024)
arena_sz = 1024;
heap_arena = NewArena(arena_sz, worker_id, 1, NULL);
heap_arena = NewArena(arena_sz, worker_id, 1, NULL, &cspace);
if (heap_arena == 0L) {
return FALSE;
}
@ -1944,10 +1938,11 @@ static void DelHeapRoot(CELL *pt, UInt sz) {
}
static Int p_nb_heap_add_to_heap(USES_REGS1) {
CELL *qd = GetHeap(ARG1, "add_to_heap"), *oldH, *oldHB, *pt;
CELL *qd = GetHeap(ARG1, "add_to_heap"), *pt;
UInt hsize, hmsize, old_sz;
Term arena, to, key;
UInt mingrow;
cell_space_t cspace;
if (!qd)
return FALSE;
@ -1969,7 +1964,8 @@ restart:
"No Stack Space for Non-Backtrackable terms");
return FALSE;
}
extra_size = extra_size / (2 * sizeof(CELL));
enter_cell_space(&cspace);
extra_size = extra_size / (2 * sizeof(CELL));
qd = GetHeap(ARG1, "add_to_heap");
hmsize += extra_size;
if (!qd)
@ -1984,11 +1980,9 @@ restart:
}
arena = qd[HEAP_ARENA];
old_sz = ArenaSz(arena);
oldH = HR;
oldHB = HB;
HR = HB = ArenaPt(arena);
qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize);
CloseArena(oldH, oldHB, ASP, qd + HEAP_ARENA, old_sz PASS_REGS);
CloseArena(&cspace, qd + HEAP_ARENA, old_sz PASS_REGS);
goto restart;
}
arena = qd[HEAP_ARENA];
@ -2008,30 +2002,25 @@ restart:
qd = GetHeap(ARG1, "add_to_heap");
arena = qd[HEAP_ARENA];
/* garbage collection ? */
oldH = HR;
oldHB = HB;
enter_cell_space(&cspace);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = hsize * 2;
HR = oldH;
HB = oldHB;
if (gsiz > 1024 * 1024) {
gsiz = 1024 * 1024;
} else if (gsiz < 1024) {
gsiz = 1024;
}
ARG3 = to;
if ((arena=GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS))==0) {
if ((arena=GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3, &cspace PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
return 0L;
}
to = ARG3;
qd = RepAppl(Deref(ARG1)) + 1;
arena = qd[HEAP_ARENA];
oldH = HR;
oldHB = HB;
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
}
@ -2040,7 +2029,7 @@ restart:
pt[2 * hsize + 1] = to;
PushHeap(pt, hsize);
qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
CloseArena(oldH, oldHB, ASP, qd + HEAP_ARENA, old_sz PASS_REGS);
CloseArena(&cspace, qd + HEAP_ARENA, old_sz PASS_REGS);
return TRUE;
}
@ -2098,6 +2087,7 @@ static Int p_nb_heap_size(USES_REGS1) {
}
static Int p_nb_beam(USES_REGS1) {
cell_space_t cspace;
Term beam_arena, beam, *ar, *nar;
UInt hsize;
Term tsize = Deref(ARG1);
@ -2128,7 +2118,7 @@ static Int p_nb_beam(USES_REGS1) {
ar[HEAP_MAX] = tsize;
if (arena_sz < 1024)
arena_sz = 1024;
beam_arena = NewArena(arena_sz, worker_id, 1, NULL);
beam_arena = NewArena(arena_sz, worker_id, 1, NULL, &cspace);
if (beam_arena == 0L) {
return FALSE;
}
@ -2337,10 +2327,11 @@ static Term DelBeamMin(CELL *pt, CELL *pt2, UInt sz) {
}
static Int p_nb_beam_add_to_beam(USES_REGS1) {
CELL *qd = GetHeap(ARG1, "add_to_beam"), *oldH, *oldHB, *pt;
CELL *qd = GetHeap(ARG1, "add_to_beam"), *pt;
UInt hsize, hmsize, old_sz;
Term arena, to, qsize, key;
UInt mingrow;
cell_space_t cspace;
if (!qd)
return FALSE;
@ -2371,15 +2362,12 @@ static Int p_nb_beam_add_to_beam(USES_REGS1) {
qd = GetHeap(ARG1, "add_to_beam");
arena = qd[HEAP_ARENA];
/* garbage collection ? */
oldH = HR;
oldHB = HB;
enter_cell_space(&cspace);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = HR - RepPair(qd[QUEUE_HEAD]);
HR = oldH;
HB = oldHB;
if (gsiz > 1024 * 1024) {
gsiz = 1024 * 1024;
} else if (gsiz < 1024) {
@ -2387,22 +2375,19 @@ static Int p_nb_beam_add_to_beam(USES_REGS1) {
}
ARG3 = to;
/* fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS)) {
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3, &cspace PASS_REGS)) {
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
return 0L;
}
to = ARG3;
qd = RepAppl(Deref(ARG1)) + 1;
arena = qd[HEAP_ARENA];
oldH = HR;
oldHB = HB;
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
}
pt = qd + HEAP_START;
PushBeam(pt, pt + 2 * hmsize, hsize, key, to);
qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
CloseArena(oldH, oldHB, ASP, qd + HEAP_ARENA, old_sz PASS_REGS);
CloseArena(&cspace, qd + HEAP_ARENA, old_sz PASS_REGS);
return TRUE;
}
@ -2410,8 +2395,8 @@ static Int p_nb_beam_del(USES_REGS1) {
CELL *qd = GetHeap(ARG1, "debeam");
UInt old_sz, qsz;
Term arena;
CELL *oldH, *oldHB;
Term tk, tv;
cell_space_t cspace;
if (!qd)
return FALSE;
@ -2423,10 +2408,9 @@ static Int p_nb_beam_del(USES_REGS1) {
return FALSE;
old_sz = ArenaSz(arena);
/* garbage collection ? */
oldH = HR;
oldHB = HB;
enter_cell_space(&cspace);
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz - 1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
CloseArena(&cspace, &arena, old_sz PASS_REGS);
tk = qd[HEAP_START];
tv = DelBeamMin(qd + HEAP_START,
qd + (HEAP_START + 2 * IntegerOfTerm(qd[HEAP_MAX])), qsz);

4
C/grow.c
View File

@ -990,7 +990,6 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS)
LOCAL_LDiff = LOCAL_TrDiff = 0;
LOCAL_BaseDiff = 0;
}
printf("grow=%d\n", LOCAL_LDiff);
/* now, remember we have delay -- global with a hole in delay or a
hole in global */
if (!hsplit) {
@ -1009,7 +1008,6 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS)
LOCAL_GSplit = hsplit;
LOCAL_XDiff = LOCAL_HDiff = 0;
LOCAL_GlobalBase = old_GlobalBase;
fprintf(stderr,"off %d 5d %d\n", LOCAL_GDiff0, LOCAL_GDiff, LOCAL_LDiff);
SetHeapRegs(FALSE PASS_REGS);
if (do_grow) {
MoveLocalAndTrail( PASS_REGS1 );
@ -1490,7 +1488,7 @@ Yap_growheap(bool fix_code, size_t in_size, void *cip)
int
Yap_growheap_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
{
CACHE_REGS
CACHE_REGS
int res;
res=do_growheap(FALSE, 0L, NULL, old_trp, tksp, vep PASS_REGS);

130
C/prim_absmi_insts.h
View File

@ -1949,11 +1949,12 @@
Op(p_arg_vv, xxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxx.x1);
HR[1] = XREG(PREG->y_u.xxx.x2);
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.xxx.x1);
ts[1] = XREG(PREG->y_u.xxx.x2);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -2045,12 +2046,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
CELL *Ho = HR;
Term ts[3];
Term t = MkIntegerTerm(PREG->y_u.xxn.c);
HR[0] = t;
HR[1] = XREG(PREG->y_u.xxn.xi);
RESET_VARIABLE(HR + 2);
ts[0] = t;
ts[1] = XREG(PREG->y_u.xxn.xi);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), ts);
HR = Ho;
}
#endif /* LOW_LEVEL_TRACE */
@ -2118,12 +2120,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_arg_y_vv, yxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yxx.x1);
HR[1] = XREG(PREG->y_u.yxx.x2);
HR[2] = YREG[PREG->y_u.yxx.y];
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.yxx.x1);
ts[1] = XREG(PREG->y_u.yxx.x2);
ts[2] = YREG[PREG->y_u.yxx.y];
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -2216,13 +2219,14 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
CELL *Ho = HR;
Term ts[3];
Term t = MkIntegerTerm(PREG->y_u.yxn.c);
HR[0] = t;
HR[1] = XREG(PREG->y_u.yxn.xi);
HR[2] = YREG[PREG->y_u.yxn.y];
RESET_VARIABLE(HR + 2);
ts[0] = t;
ts[1] = XREG(PREG->y_u.yxn.xi);
ts[2] = YREG[PREG->y_u.yxn.y];
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), ts);
HR = Ho;
}
#endif /* LOW_LEVEL_TRACE */
@ -2295,12 +2299,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.xxx.x1);
HR[2] = XREG(PREG->y_u.xxx.x2);
Term ts[3];
RESET_VARIABLE(ts);
ts[1] = XREG(PREG->y_u.xxx.x1);
ts[2] = XREG(PREG->y_u.xxx.x2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2412,12 +2417,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_cv:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = PREG->y_u.xxc.c;
HR[2] = XREG(PREG->y_u.xxc.xi);
Term ts[3];
RESET_VARIABLE(ts);
ts[1] = PREG->y_u.xxc.c;
ts[2] = XREG(PREG->y_u.xxc.xi);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -2517,15 +2523,16 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
Term ti;
Term ts[3];
CELL *hi = HR;
ti = MkIntegerTerm(PREG->y_u.xxn.c);
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.xxn.xi);
HR[2] = ti;
RESET_VARIABLE(ts);
ts[1] = XREG(PREG->y_u.xxn.xi);
ts[2] = ti;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
HR = hi;
}
#endif /* LOW_LEVEL_TRACE */
@ -2611,12 +2618,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_y:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.yxx.x1);
HR[2] = XREG(PREG->y_u.yxx.x2);
Term ts[3];
RESET_VARIABLE(ts);
ts[1] = XREG(PREG->y_u.yxx.x1);
ts[2] = XREG(PREG->y_u.yxx.x2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2735,12 +2743,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_y_cv:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = PREG->y_u.yxc.c;
HR[2] = XREG(PREG->y_u.yxc.xi);
Term ts[3];
RESET_VARIABLE(ts);
ts[1] = PREG->y_u.yxc.c;
ts[2] = XREG(PREG->y_u.yxc.xi);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2847,14 +2856,15 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
if (Yap_do_low_level_trace) {
Term ti;
CELL *hi = HR;
Term ts[3];
ti = MkIntegerTerm((Int)(PREG->y_u.yxn.c));
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.yxn.xi);
HR[2] = ti;
RESET_VARIABLE(ts);
ts[1] = XREG(PREG->y_u.yxn.xi);
ts[2] = ti;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
HR = hi;
}
#endif /* LOW_LEVEL_TRACE */
@ -2952,12 +2962,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_xx, xxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxx.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.xxx.x);
RESET_VARIABLE(ts + 1);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -3000,12 +3011,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_xy, xxy);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxy.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.xxy.x);
RESET_VARIABLE(ts + 1);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -3051,12 +3063,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_yx, yxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yxx.x2);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.yxx.x2);
RESET_VARIABLE(ts + 1);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -3102,12 +3115,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_yy, yyx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yyx.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.yyx.x);
RESET_VARIABLE(ts + 1);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);

91
C/scanner.c
View File

@ -1319,6 +1319,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
TokEntry *t, *l, *p;
enum TokenKinds kind;
int solo_flag = TRUE;
int lvl = push_text_stack();
int32_t ch, och = ' ';
struct qq_struct_t *cur_qq = NULL;
int sign = 1;
@ -1348,6 +1349,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
t->TokNext = NULL;
if (t == NULL) {
pop_text_stack(lvl);
return TrailSpaceError(p, l);
}
if (!l)
@ -1418,7 +1420,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
imgsz = Yap_Min(imgsz * 2, imgsz + MBYTE);
TokImage = Realloc(p0, imgsz);
if (TokImage == NULL) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
charp =(unsigned char *) TokImage + (charp - p0);
}
@ -1427,7 +1430,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
while (ch == '\'' && isvar &&
trueGlobalPrologFlag(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG)) {
if (charp == (unsigned char *)AuxSp - 1024) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
add_ch_to_buff(ch);
ch = getchr(st);
@ -1438,7 +1442,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
/* don't do this in iso */
ae = Yap_LookupAtom(TokImage);
if (ae == NIL) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->TokInfo = MkAtomTerm(ae);
if (ch == '(')
@ -1470,7 +1475,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokInfo = TermError;
}
/* serious error now */
return l;
pop_text_stack(lvl);
return l;
}
ch = cha;
if (cherr) {
@ -1480,7 +1486,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokLine = GetCurInpLine(st);
e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e == NULL) {
return TrailSpaceError(p, l);
pop_text_stack(lvl);
return TrailSpaceError(p, l);
} else {
e->TokNext = NULL;
@ -1506,7 +1513,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokLine = GetCurInpLine(st);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
return TrailSpaceError(p, l);
pop_text_stack(lvl);
return TrailSpaceError(p, l);
} else {
e2->TokNext = NULL;
}
@ -1540,7 +1548,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokPos = GetCurInpPos(st);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
return TrailSpaceError(p, l);
pop_text_stack(lvl);
return TrailSpaceError(p, l);
} else {
e2->TokNext = NULL;
}
@ -1570,7 +1579,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
size_t sz = charp-(unsigned char *)TokImage;
TokImage = Realloc(TokImage, (imgsz = Yap_Min(imgsz * 2, imgsz + MBYTE)));
if (TokImage == NULL) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
charp = (unsigned char *)TokImage+sz;
break;
@ -1609,20 +1619,23 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokInfo = Yap_CharsToTDQ((char *)TokImage, CurrentModule,
LOCAL_encoding PASS_REGS);
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->Tok = Ord(kind = String_tok);
} else if (quote == '`') {
t->TokInfo = Yap_CharsToTBQ((char *)TokImage, CurrentModule,
LOCAL_encoding PASS_REGS);
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->Tok = Ord(kind = String_tok);
} else {
t->TokInfo = MkAtomTerm(Yap_LookupAtom(TokImage));
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
@ -1642,7 +1655,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokInfo = TermNewLine;
}
t->TokInfo = TermEof;
return l;
pop_text_stack(lvl);
return l;
} else
ch = getchr(st);
break;
@ -1656,9 +1670,11 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
// consume...
if (pch == '%') {
t->TokInfo = TermNewLine;
return l;
pop_text_stack(lvl);
return l;
}
return l;
pop_text_stack(lvl);
return l;
}
if (ch == '`')
goto quoted_string;
@ -1669,7 +1685,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(kind = eot_tok);
if (ch == '%') {
t->TokInfo = TermNewLine;
return l;
pop_text_stack(lvl);
return l;
}
if (chtype(ch) == EF) {
mark_eof(st);
@ -1677,7 +1694,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
} else {
t->TokInfo = TermNewLine;
}
return l;
pop_text_stack(lvl);
return l;
}
}
if (och == '/' && ch == '*') {
@ -1726,7 +1744,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(kind = eot_tok);
if (ch == '%') {
t->TokInfo = TermNewLine;
return l;
pop_text_stack(lvl);
return l;
}
if (chtype(ch) == EF) {
mark_eof(st);
@ -1734,7 +1753,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
} else {
t->TokInfo = TermNl;
}
return l;
pop_text_stack(lvl);
return l;
} else {
Atom ae;
charp = (unsigned char *)TokImage;
@ -1744,8 +1764,10 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
size_t sz = charp - (unsigned char *)TokImage;
imgsz = Yap_Min(imgsz * 2, imgsz + MBYTE);
TokImage = Realloc(TokImage, imgsz);
if (!TokImage)
return CodeSpaceError(t, p, l);
if (!TokImage) {
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
charp = (unsigned char *)TokImage+sz;
}
add_ch_to_buff(ch);
@ -1753,11 +1775,13 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
add_ch_to_buff('\0');
ae = Yap_LookupAtom(TokImage);
if (ae == NIL) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->TokInfo = MkAtomTerm(ae);
if (t->TokInfo == (CELL)NIL) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
@ -1820,15 +1844,16 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
return l;
pop_text_stack(lvl);
return l;
}
if (cur_qq) {
LOCAL_ErrorMessage = "quasi quote in quasi quote";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
Free(qq);
return l;
pop_text_stack(lvl);
return l;
} else {
cur_qq = qq;
}
@ -1865,7 +1890,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
cur_qq = NULL;
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermError;
return l;
pop_text_stack(lvl);
return l;
}
cur_qq = NULL;
t->TokInfo = (CELL)qq;
@ -1910,7 +1936,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
return l;
pop_text_stack(lvl);
return l;
}
strncpy((char *)mp, (const char *)TokImage, len + 1);
qq->text = (unsigned char *)mp;
@ -1923,7 +1950,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
qq->end.linepos = st->linepos - 1;
qq->end.charno = st->charcount - 1;
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
solo_flag = FALSE;
@ -1936,7 +1964,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
mark_eof(st);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermEof;
return l;
pop_text_stack(lvl);
return l;
default: {
kind = Error_tok;
@ -1951,7 +1980,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
/* insert an error token to inform the system of what happened */
TokEntry *e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e == NULL) {
return TrailSpaceError(p, l);
pop_text_stack(lvl);
return TrailSpaceError(p, l);
}
p->TokNext = e;
e->Tok = Error_tok;
@ -1963,6 +1993,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
p = e;
}
} while (kind != eot_tok);
pop_text_stack(lvl);
return (l);
}

12
H/YapText.h
View File

@ -47,20 +47,20 @@ extern const void *MallocExportAsRO(const void *blk);
extern int AllocLevel(void);
#define push_text_stack() \
(/* fprintf(stderr, " + *** %d %s:%s:%d\n", AllocLevel(),*/ \
/* __FILE__, __FUNCTION__, __LINE__), */ \
( fprintf(stderr, " + *** %d %s:%s:%d\n", AllocLevel(), \
__FILE__, __FUNCTION__, __LINE__), \
push_text_stack__(PASS_REGS1))
extern int push_text_stack__(USES_REGS1);
#define pop_text_stack(lvl) \
(/* fprintf(stderr, " - *** %d %s:%s:%d\n", AllocLevel(), __FILE__,*/ \
/* __FUNCTION__, __LINE__), */ \
( fprintf(stderr, " - *** %d %s:%s:%d\n", AllocLevel(), __FILE__, \
__FUNCTION__, __LINE__), \
pop_text_stack__(lvl))
extern int pop_text_stack__(int lvl USES_REGS);
#define pop_output_text_stack(lvl,p) \
(/*fprintf(stderr, "-- *** %d %s:%s:%d\n", AllocLevel(), __FILE__,*/ \
/* __FUNCTION__, __LINE__),*/ \
(fprintf(stderr, "-- *** %d %s:%s:%d\n", AllocLevel(), __FILE__, \
__FUNCTION__, __LINE__), \
pop_output_text_stack__(lvl,p))
extern void *pop_output_text_stack__(int lvl, const void *ox USES_REGS);

2
H/Yapproto.h
View File

@ -247,7 +247,7 @@ extern Term Yap_SaveTerm(Term);
extern Term Yap_SetGlobalVal(Atom, Term);
extern Term Yap_GetGlobal(Atom);
extern Int Yap_DeleteGlobal(Atom);
extern void Yap_AllocateDefaultArena(size_t gsize, int wid);
extern void Yap_AllocateDefaultArena(size_t gsize, int wid, void *cs);
extern CELL *Yap_ArenaLimit(Term arena);
/* grow.c */

3
pl/absf.yap
View File

@ -334,7 +334,7 @@ prolog_file_name(File, PrologFileName) :-
system:true_file_name(File, PrologFileName).
prolog_file_name(File, PrologFileName) :-
'$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)).
:- start_low_level_trace.
/**
@pred path(-Directories:list) is det,deprecated
@ -344,6 +344,7 @@ prolog_file_name(File, PrologFileName) :-
*/
path(Path) :-
findall(X,'$in_path'(X),Path).
:- stop_low_level_trace.
'$in_path'(X) :-
recorded('$path',Path,_),