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

more fixes for global data-structures.

Browse Source 
statistics on atom space.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1690 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2006-09-01 20:14:42 +00:00
parent cd5bc14cfc
commit f0b132b083
6 changed files with 272 additions and 253 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

236
C/globals.c
View File

@ -86,11 +86,11 @@ CreateNewArena(CELL *ptr, UInt size)
Term t = AbsAppl(ptr); Term t = AbsAppl(ptr);
MP_INT *dst; MP_INT *dst;
*ptr++ = (CELL)FunctorBigInt; ptr[0] = (CELL)FunctorBigInt;
dst = (MP_INT *)ptr; dst = (MP_INT *)(ptr+1);
dst->_mp_size = 0L; dst->_mp_size = 0L;
dst->_mp_alloc = arena2big_sz(size); dst->_mp_alloc = arena2big_sz(size);
ptr[size-2] = EndSpecials; ptr[size-1] = EndSpecials;
return t; return t;
} }
@ -265,15 +265,15 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity)
if (size < 4096) { if (size < 4096) {
size = 4096; size = 4096;
} }
if (H+size > ASP-1024) {
XREGS[arity+1] = arena;
if (!Yap_gcl(size*sizeof(CELL), arity+1, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
arena = XREGS[arity+1];
}
if (pt == H && ArenaPt(arena) >= B->cp_h) { if (pt == H && ArenaPt(arena) >= B->cp_h) {
if (H+size > ASP-1024) {
XREGS[arity+1] = arena;
if (!Yap_gcl(size*sizeof(CELL), arity+1, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
arena = XREGS[arity+1];
}
H += size; H += size;
} else { } else {
XREGS[arity+1] = arena; XREGS[arity+1] = arena;
@ -419,7 +419,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
register CELL *ap2; register CELL *ap2;
/* store the terms to visit */ /* store the terms to visit */
ap2 = RepAppl(d0); ap2 = RepAppl(d0);
if (ap2 >= HB && ap2 <= H) { if (ap2 >= HB && ap2 < H) {
/* If this is newer than the current term, just reuse */ /* If this is newer than the current term, just reuse */
*ptf++ = d0; *ptf++ = d0;
continue; continue;
@ -427,9 +427,52 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
f = (Functor)(*ap2); f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
{ switch((CELL)f) {
*ptf++ = d0; /* you can just copy other extensions. */ case (CELL)FunctorDBRef:
*ptf++ = d0;
break;
case (CELL)FunctorLongInt:
if (H > ASP - (128+3)) {
goto overflow;
} }
*ptf++ = AbsAppl(H);
H[0] = (CELL)f;
H[1] = ap2[1];
H[2] = EndSpecials;
H += 3;
break;
case (CELL)FunctorDouble:
if (H > ASP - (128+(2+SIZEOF_DOUBLE/sizeof(CELL)))) {
goto overflow;
}
*ptf++ = AbsAppl(H);
H[0] = (CELL)f;
H[1] = ap2[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
H[2] = ap2[2];
H[3] = EndSpecials;
H += 4;
#else
H[2] = EndSpecials;
H += 3;
#endif
break;
default:
{
/* big int */
UInt sz = ArenaSz(d0), i;
if (H > ASP - (128+sz)) {
goto overflow;
}
*ptf++ = AbsAppl(H);
H[0] = (CELL)f;
for (i = 1; i < sz; i++) {
H[i] = ap2[i];
}
H += sz;
}
}
continue; continue;
} }
*ptf = AbsAppl(H); *ptf = AbsAppl(H);
@ -632,7 +675,7 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
} }
CloseArena(oldH, oldHB, oldASP, newarena, old_size); CloseArena(oldH, oldHB, oldASP, newarena, old_size);
return tn; return tn;
} else if (IsPrimitiveTerm(t)) { } else if (IsAtomOrIntTerm(t)) {
return t; return t;
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
Term tf; Term tf;
@ -651,7 +694,7 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
CloseArena(oldH, oldHB, oldASP, newarena, old_size); CloseArena(oldH, oldHB, oldASP, newarena, old_size);
return tf; return tf;
} else { } else {
Functor f = FunctorOfTerm(t); Functor f;
Term tf; Term tf;
CELL *HB0; CELL *HB0;
CELL *ap; CELL *ap;
@ -663,9 +706,53 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
ap = RepAppl(t); ap = RepAppl(t);
tf = AbsAppl(H); tf = AbsAppl(H);
H[0] = (CELL)f; H[0] = (CELL)f;
H += 1+ArityOfFunctor(f); if (IsExtensionFunctor(f)) {
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, att_arenap)) < 0) { switch((CELL)f) {
goto error_handler; case (CELL)FunctorDBRef:
return t;
case (CELL)FunctorLongInt:
if (H > ASP - (128+3)) {
res = -1;
goto error_handler;
}
H[1] = ap[1];
H[2] = EndSpecials;
H += 3;
break;
case (CELL)FunctorDouble:
if (H > ASP - (128+(2+SIZEOF_DOUBLE/sizeof(CELL)))) {
res = -1;
goto error_handler;
}
H[1] = ap[1];
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
H[2] = ap[2];
H[3] = EndSpecials;
H += 4;
#else
H[2] = EndSpecials;
H += 3;
#endif
break;
default:
{
UInt sz = ArenaSz(t), i;
if (H > ASP - (128+sz)) {
res = -1;
goto error_handler;
}
for (i = 1; i < sz; i++) {
H[i] = ap[i];
}
H += sz;
}
}
} else {
H += 1+ArityOfFunctor(f);
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, att_arenap)) < 0) {
goto error_handler;
}
} }
CloseArena(oldH, oldHB, oldASP, newarena, old_size); CloseArena(oldH, oldHB, oldASP, newarena, old_size);
return tf; return tf;
@ -922,14 +1009,6 @@ p_nb_queue(void)
queue = Yap_MkApplTerm(FunctorNBQueue,5,ar); queue = Yap_MkApplTerm(FunctorNBQueue,5,ar);
if (!Yap_unify(queue,ARG1)) if (!Yap_unify(queue,ARG1))
return FALSE; return FALSE;
if (arena_sz < 1024)
arena_sz = 1024;
queue_arena = NewArena(arena_sz,1,NULL);
if (queue_arena == 0L) {
return FALSE;
}
nar = RepAppl(Deref(ARG1))+1;
nar[QUEUE_ARENA] = queue_arena;
arena_sz = ((attvar_record *)H0- DelayTop())/16; arena_sz = ((attvar_record *)H0- DelayTop())/16;
if (arena_sz <2) if (arena_sz <2)
arena_sz = 2; arena_sz = 2;
@ -941,6 +1020,14 @@ p_nb_queue(void)
} }
nar = RepAppl(Deref(ARG1))+1; nar = RepAppl(Deref(ARG1))+1;
nar[QUEUE_DELAY_ARENA] = delay_queue_arena; nar[QUEUE_DELAY_ARENA] = delay_queue_arena;
if (arena_sz < 4*1024)
arena_sz = 4*1024;
queue_arena = NewArena(arena_sz,1,NULL);
if (queue_arena == 0L) {
return FALSE;
}
nar = RepAppl(Deref(ARG1))+1;
nar[QUEUE_ARENA] = queue_arena;
return TRUE; return TRUE;
} }
@ -1061,14 +1148,14 @@ p_nb_queue_enqueue(void)
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
qsize = IntegerOfTerm(qd[QUEUE_SIZE]); qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
while (old_sz < 128) { while (old_sz < 128) {
UInt gsiz = qsize*2*sizeof(CELL); UInt gsiz = qsize*2;
H = oldH; H = oldH;
HB = oldHB; HB = oldHB;
if (gsiz > 1024*1024) { if (gsiz > 1024*1024) {
gsiz = 1024*1024; gsiz = 1024*1024;
} else if (gsiz < 1024*sizeof(CELL)) { } else if (gsiz < 1024) {
gsiz = 1024*sizeof(CELL); gsiz = 1024;
} }
ARG3 = to; ARG3 = to;
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) { if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
@ -1175,6 +1262,25 @@ GetHeap(Term t, char* caller)
return RepAppl(t)+1; return RepAppl(t)+1;
} }
static Term
MkZeroApplTerm(Functor f, UInt sz)
{
Term t0, tf;
CELL *pt;
if (H+(sz+1) > ASP-1024)
return TermNil;
tf = AbsAppl(H);
*H = (CELL)f;
t0 = MkIntTerm(0);
pt = H+1;
while (sz--) {
*pt++ = t0;
}
H = pt;
return tf;
}
static Int static Int
p_nb_heap(void) p_nb_heap(void)
{ {
@ -1193,7 +1299,13 @@ p_nb_heap(void)
} }
hsize = IntegerOfTerm(tsize); hsize = IntegerOfTerm(tsize);
} }
heap = Yap_MkNewApplTerm(Yap_MkFunctor(Yap_LookupAtom("heap"),2*hsize+HEAP_START),2*hsize+HEAP_START);
while ((heap = MkZeroApplTerm(Yap_MkFunctor(Yap_LookupAtom("heap"),2*hsize+HEAP_START+1),2*hsize+HEAP_START+1)) == TermNil) {
if (!Yap_gcl((2*hsize+HEAP_START+1)*sizeof(CELL), 2, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
if (!Yap_unify(heap,ARG2)) if (!Yap_unify(heap,ARG2))
return FALSE; return FALSE;
ar = RepAppl(heap)+1; ar = RepAppl(heap)+1;
@ -1326,7 +1438,7 @@ p_nb_heap_add_to_heap(void)
hmsize += extra_size; hmsize += extra_size;
if (!qd) if (!qd)
return FALSE; return FALSE;
qd[-1] = (CELL)Yap_MkFunctor(Yap_LookupAtom("heap"),2*hmsize+HEAP_START); qd[-1] = (CELL)Yap_MkFunctor(Yap_LookupAtom("heap"),2*hmsize+HEAP_START)+1;
top = qd+(HEAP_START+2*(hmsize-extra_size)); top = qd+(HEAP_START+2*(hmsize-extra_size));
while (extra_size) { while (extra_size) {
RESET_VARIABLE(top); RESET_VARIABLE(top);
@ -1347,6 +1459,7 @@ p_nb_heap_add_to_heap(void)
if (arena == 0L) if (arena == 0L)
return FALSE; return FALSE;
key = CopyTermToArena(ARG2, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA); key = CopyTermToArena(ARG2, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA);
arena = qd[HEAP_ARENA];
to = CopyTermToArena(ARG3, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA); to = CopyTermToArena(ARG3, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA);
if (key == 0 || to == 0L) if (key == 0 || to == 0L)
return FALSE; return FALSE;
@ -1358,14 +1471,14 @@ p_nb_heap_add_to_heap(void)
H = HB = ArenaPt(arena); H = HB = ArenaPt(arena);
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
while (old_sz < 128) { while (old_sz < 128) {
UInt gsiz = hsize*2*sizeof(CELL); UInt gsiz = hsize*2;
H = oldH; H = oldH;
HB = oldHB; HB = oldHB;
if (gsiz > 1024*1024) { if (gsiz > 1024*1024) {
gsiz = 1024*1024; gsiz = 1024*1024;
} else if (gsiz < 1024*sizeof(CELL)) { } else if (gsiz < 1024) {
gsiz = 1024*sizeof(CELL); gsiz = 1024;
} }
ARG3 = to; ARG3 = to;
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) { if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
@ -1475,7 +1588,12 @@ p_nb_beam(void)
} }
hsize = IntegerOfTerm(tsize); hsize = IntegerOfTerm(tsize);
} }
beam = Yap_MkNewApplTerm(Yap_MkFunctor(Yap_LookupAtom("beam"),5*hsize+HEAP_START),5*hsize+HEAP_START); while ((beam = MkZeroApplTerm(Yap_MkFunctor(Yap_LookupAtom("heap"),5*hsize+HEAP_START+1),5*hsize+HEAP_START+1)) == TermNil) {
if (!Yap_gcl((5*hsize+HEAP_START+1)*sizeof(CELL), 2, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
if (!Yap_unify(beam,ARG2)) if (!Yap_unify(beam,ARG2))
return FALSE; return FALSE;
ar = RepAppl(beam)+1; ar = RepAppl(beam)+1;
@ -1736,7 +1854,8 @@ p_nb_beam_add_to_beam(void)
arena = qd[HEAP_ARENA]; arena = qd[HEAP_ARENA];
if (arena == 0L) if (arena == 0L)
return FALSE; return FALSE;
key = CopyTermToArena(ARG2, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA); key = CopyTermToArena(ARG2, qd[HEAP_ARENA], 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA);
arena = qd[HEAP_ARENA];
to = CopyTermToArena(ARG3, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA); to = CopyTermToArena(ARG3, arena, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA);
if (key == 0 || to == 0L) if (key == 0 || to == 0L)
return FALSE; return FALSE;
@ -1748,14 +1867,14 @@ p_nb_beam_add_to_beam(void)
H = HB = ArenaPt(arena); H = HB = ArenaPt(arena);
old_sz = ArenaSz(arena); old_sz = ArenaSz(arena);
while (old_sz < 128) { while (old_sz < 128) {
UInt gsiz = hsize*2*sizeof(CELL); UInt gsiz = hsize*2;
H = oldH; H = oldH;
HB = oldHB; HB = oldHB;
if (gsiz > 1024*1024) { if (gsiz > 1024*1024) {
gsiz = 1024*1024; gsiz = 1024*1024;
} else if (gsiz < 1024*sizeof(CELL)) { } else if (gsiz < 1024) {
gsiz = 1024*sizeof(CELL); gsiz = 1024;
} }
ARG3 = to; ARG3 = to;
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) { if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
@ -1847,8 +1966,44 @@ p_nb_beam_check(void)
} }
return TRUE; return TRUE;
} }
#endif #endif
static Int
p_nb_beam_keys(void)
{
CELL *qd;
UInt qsz;
CELL *pt, *ho;
UInt i;
restart:
qd = GetHeap(ARG1,"beam_keys");
if (!qd)
return FALSE;
qsz = IntegerOfTerm(qd[HEAP_SIZE]);
ho = H;
pt = qd+HEAP_START;
if (qsz == 0)
return Yap_unify(ARG2, TermNil);
for (i=0; i < qsz; i++) {
if (H > ASP-1024) {
H = ho;
if (!Yap_gcl(((ASP-H)-1024)*sizeof(CELL), 2, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return TermNil;
}
goto restart;
}
*H++ = pt[0];
*H = AbsPair(H+1);
H++;
pt += 2;
}
H[-1] = TermNil;
return Yap_unify(ARG2, AbsPair(ho));
}
static Int static Int
p_nb_beam_peek(void) p_nb_beam_peek(void)
{ {
@ -1922,6 +2077,7 @@ void Yap_InitGlobals(void)
Yap_InitCPred("nb_beam_del", 3, p_nb_beam_del, SafePredFlag); Yap_InitCPred("nb_beam_del", 3, p_nb_beam_del, SafePredFlag);
Yap_InitCPred("nb_beam_peek", 3, p_nb_beam_peek, SafePredFlag); Yap_InitCPred("nb_beam_peek", 3, p_nb_beam_peek, SafePredFlag);
Yap_InitCPred("nb_beam_empty", 1, p_nb_beam_empty, SafePredFlag); Yap_InitCPred("nb_beam_empty", 1, p_nb_beam_empty, SafePredFlag);
Yap_InitCPred("nb_beam_keys", 2, p_nb_beam_keys, 0L);
#ifdef DEBUG #ifdef DEBUG
Yap_InitCPred("nb_beam_check", 1, p_nb_beam_check, SafePredFlag); Yap_InitCPred("nb_beam_check", 1, p_nb_beam_check, SafePredFlag);
#endif #endif

150
C/heapgc.c
View File

@ -111,9 +111,7 @@ static tr_fr_ptr new_TR;
static CELL *HGEN; static CELL *HGEN;
#if GC_NO_TAGS
char *Yap_bp; char *Yap_bp;
#endif
static int discard_trail_entries = 0; static int discard_trail_entries = 0;
@ -154,7 +152,6 @@ gc_growtrail(int committed)
inline static void inline static void
PUSH_CONTINUATION(CELL *v, int nof) { PUSH_CONTINUATION(CELL *v, int nof) {
cont *x; cont *x;
if (nof == 0) return;
x = cont_top; x = cont_top;
x++; x++;
if ((ADDR)x > Yap_TrailTop-1024) { if ((ADDR)x > Yap_TrailTop-1024) {
@ -1137,13 +1134,9 @@ mark_variable(CELL_PTR current)
inc_var(current, current); inc_var(current, current);
#endif #endif
*next = (CELL)current; *next = (CELL)current;
#if GC_NO_TAGS
UNMARK(next); UNMARK(next);
MARK(current); MARK(current);
*current = (CELL)current; *current = (CELL)current;
#else
*current = MARK_CELL((CELL)current);
#endif
POP_CONTINUATION(); POP_CONTINUATION();
} else { } else {
/* can't help here */ /* can't help here */
@ -1155,9 +1148,7 @@ mark_variable(CELL_PTR current)
} else { } else {
/* binding to a determinate reference */ /* binding to a determinate reference */
if (next >= HB && current < LCL0 && cnext != TermFoundVar) { if (next >= HB && current < LCL0 && cnext != TermFoundVar) {
#if GC_NO_TAGS
UNMARK(current); UNMARK(current);
#endif
*current = cnext; *current = cnext;
if (current >= H0 && current < H) { if (current >= H0 && current < H) {
total_marked--; total_marked--;
@ -1178,9 +1169,7 @@ mark_variable(CELL_PTR current)
current < LCL0) { current < LCL0) {
/* This step is possible because we clean up the trail */ /* This step is possible because we clean up the trail */
*current = UNMARK_CELL(cnext); *current = UNMARK_CELL(cnext);
#if GC_NO_TAGS
UNMARK(current); UNMARK(current);
#endif
if (current >= H0 && current < H) { if (current >= H0 && current < H) {
total_marked--; total_marked--;
if (current < HGEN) { if (current < HGEN) {
@ -1277,9 +1266,7 @@ mark_variable(CELL_PTR current)
switch (cnext) { switch (cnext) {
case (CELL)FunctorLongInt: case (CELL)FunctorLongInt:
MARK(next); MARK(next);
#if GC_NO_TAGS
MARK(next+2); MARK(next+2);
#endif
if (next < HGEN) { if (next < HGEN) {
total_oldies+=3; total_oldies+=3;
} }
@ -1300,7 +1287,6 @@ mark_variable(CELL_PTR current)
MARK(next+sz); MARK(next+sz);
} }
POP_CONTINUATION(); POP_CONTINUATION();
#ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
{ {
UInt sz = (sizeof(MP_INT)+ UInt sz = (sizeof(MP_INT)+
@ -1315,8 +1301,6 @@ mark_variable(CELL_PTR current)
MARK(next+sz); MARK(next+sz);
PUSH_POINTER(next+sz); PUSH_POINTER(next+sz);
} }
POP_CONTINUATION();
#endif
default: default:
POP_CONTINUATION(); POP_CONTINUATION();
} }
@ -1332,7 +1316,22 @@ mark_variable(CELL_PTR current)
++total_oldies; ++total_oldies;
} }
PUSH_POINTER(next); PUSH_POINTER(next);
current = next+1; next++;
/* speedup for leaves */
while (arity && IsAtomOrIntTerm(*next)) {
if (!UNMARKED_MARK(next,local_bp)) {
total_marked++;
if (next < HGEN) {
total_oldies++;
}
PUSH_POINTER(next);
}
next++;
arity--;
}
if (!arity) POP_CONTINUATION();
current = next;
if (arity == 1) goto begin;
PUSH_CONTINUATION(current+1,arity-1); PUSH_CONTINUATION(current+1,arity-1);
goto begin; goto begin;
} }
@ -2066,7 +2065,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
static inline void static inline void
into_relocation_chain(CELL_PTR current, CELL_PTR next) into_relocation_chain(CELL_PTR current, CELL_PTR next)
{ {
#if GC_NO_TAGS
CELL current_tag; CELL current_tag;
current_tag = TAG(*current); current_tag = TAG(*current);
@ -2078,39 +2076,6 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next)
} }
*current = *next; *current = *next;
*next = (CELL) current | current_tag; *next = (CELL) current | current_tag;
#else
#ifdef TAGS_FAST_OPS
register CELL ccur = *current, cnext = *next;
if (IsVarTerm(ccur)) {
*current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) :
UNMARKED(cnext) );
*next = (MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current;
} else if (IsPairTerm(ccur)) {
*current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) :
UNMARKED(cnext) );
*next = AbsPair((CELL *)
((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current));
} else if (IsApplTerm(ccur)) {
*current = ( MARKED(ccur) ? MARK_CELL(UNMARKED(cnext)) :
UNMARKED(cnext) );
*next = AbsAppl((CELL *)
((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current));
} else {
fprintf(Yap_stderr," OH MY GOD !!!!!!!!!!!!\n");
}
#else
CELL current_tag;
current_tag = TAG(*current);
*current = (*current & MBIT) | (*next & ~MBIT);
#if INVERT_RBIT
*next = ((*next & MBIT) | (CELL) current | current_tag) & ~RBIT;
#else
*next = (*next & MBIT) | RBIT | (CELL) current | current_tag;
#endif
#endif
#endif /* GC_NO_TAGS */
} }
@ -2883,7 +2848,6 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
CELL_PTR next; CELL_PTR next;
CELL ccur = *current; CELL ccur = *current;
#if GC_NO_TAGS
int rmarked = RMARKED(current); int rmarked = RMARKED(current);
UNRMARK(current); UNRMARK(current);
@ -2897,52 +2861,6 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
*next = (CELL) dest | current_tag; *next = (CELL) dest | current_tag;
} }
*current = ccur; *current = ccur;
#elif TAGS_FAST_OPS
while (RMARKED(current)) {
register CELL cnext;
next = GET_NEXT(ccur);
cnext = *next;
if (IsVarTerm(ccur)) {
ccur = *current = (MARKED_VAR(ccur) ?
ENSURE_MARKED(cnext) :
UNMARKED(cnext) );
*next = (MARKED(cnext) ? MBIT : 0) | (Int) dest;
} else if (IsPairTerm(ccur)) {
ccur = *current = (MARKED_COMP(ccur) ?
ENSURE_MARKED(cnext) :
UNMARKED(cnext) );
*next = AbsPair((CELL *)
((MARKED(cnext) ? MBIT : 0) |
(Int) dest));
} else if (IsApplTerm(ccur)) {
ccur = *current = (MARKED_COMP(ccur) ?
ENSURE_MARKED(cnext) :
UNMARKED(cnext) );
*next = AbsAppl((CELL *)
((MARKED(cnext) ? MBIT : 0) |
(Int) dest));
}
#ifdef DEBUG
else {
Yap_Error(SYSTEM_ERROR, TermNil, "ATOMIC in a GC relocation chain");
}
#endif
}
#else /* !TAGS_FAST_OPS */
while (RMARKED(current)) {
CELL current_tag;
next = GET_NEXT(ccur);
current_tag = TAG(ccur);
ccur = *current = (ccur & MBIT) | (*next & ~MBIT);
#if INVERT_RBIT
*next = (*next & MBIT) | (CELL) dest | current_tag | RBIT;
#else
*next = (*next & MBIT) | (CELL) dest | current_tag;
#endif
}
#endif
} }
static inline choiceptr static inline choiceptr
@ -3047,11 +2965,7 @@ compact_heap(void)
while (!MARKED_PTR(ptr)) ptr--; while (!MARKED_PTR(ptr)) ptr--;
nofcells = current-ptr; nofcells = current-ptr;
ptr++; ptr++;
#if GC_NO_TAGS
MARK(ptr); MARK(ptr);
#else
XXX BROKEN CODE
#endif
#ifdef DEBUG #ifdef DEBUG
found_marked+=nofcells; found_marked+=nofcells;
#endif #endif
@ -3074,12 +2988,8 @@ compact_heap(void)
into_relocation_chain(current, next); into_relocation_chain(current, next);
else if (current == next) { /* cell pointing to else if (current == next) { /* cell pointing to
* itself */ * itself */
#if GC_NO_TAGS
UNRMARK(current); UNRMARK(current);
*current = (CELL) dest; /* no tag */ *current = (CELL) dest; /* no tag */
#else
*current = (*current & MBIT) | (CELL) dest; /* no tag */
#endif
} }
} }
dest--; dest--;
@ -3251,12 +3161,8 @@ icompact_heap(void)
into_relocation_chain(current, next); into_relocation_chain(current, next);
else if (current == next) { /* cell pointing to else if (current == next) { /* cell pointing to
* itself */ * itself */
#if GC_NO_TAGS
UNRMARK(current); UNRMARK(current);
*current = (CELL) dest; /* no tag */ *current = (CELL) dest; /* no tag */
#else
*current = (*current & MBIT) | (CELL) dest; /* no tag */
#endif
} }
} }
dest--; dest--;
@ -3407,7 +3313,7 @@ sweep_oldgen(CELL *max, CELL *base)
char *bpb = Yap_bp+(base-(CELL*)Yap_GlobalBase); char *bpb = Yap_bp+(base-(CELL*)Yap_GlobalBase);
while (ptr < max) { while (ptr < max) {
if (*bpb & MARK_BIT) { if (*bpb) {
if (HEAP_PTR(*ptr)) { if (HEAP_PTR(*ptr)) {
into_relocation_chain(ptr, GET_NEXT(*ptr)); into_relocation_chain(ptr, GET_NEXT(*ptr));
} }
@ -3561,17 +3467,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
#endif #endif
if (Yap_GetValue(AtomGcTrace) != TermNil) if (Yap_GetValue(AtomGcTrace) != TermNil)
gc_trace = 1; gc_trace = 1;
#if !GC_NO_TAGS
/* sanity check: can we still do garbage_collection ? */
if ((CELL)Yap_TrailTop & (MBIT|RBIT)) {
/* oops, we can't */
if (gc_verbose) {
fprintf(Yap_stderr, "%% TrailTop at %p clashes with gc bits: %lx\n", Yap_TrailTop, (unsigned long int)(MBIT|RBIT));
fprintf(Yap_stderr, "%% garbage collection disallowed\n");
}
return -1;
}
#endif
if (gc_trace) { if (gc_trace) {
fprintf(Yap_stderr, "%% gc\n"); fprintf(Yap_stderr, "%% gc\n");
} else if (gc_verbose) { } else if (gc_verbose) {
@ -3602,7 +3497,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
total_smarked = 0; total_smarked = 0;
#endif #endif
discard_trail_entries = 0; discard_trail_entries = 0;
#if GC_NO_TAGS
{ {
UInt alloc_sz = (CELL *)Yap_TrailTop-(CELL*)Yap_GlobalBase; UInt alloc_sz = (CELL *)Yap_TrailTop-(CELL*)Yap_GlobalBase;
Yap_bp = Yap_PreAllocCodeSpace(); Yap_bp = Yap_PreAllocCodeSpace();
@ -3620,26 +3514,16 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
} }
memset((void *)Yap_bp, 0, alloc_sz); memset((void *)Yap_bp, 0, alloc_sz);
} }
#endif /* GC_NO_TAGS */
if (setjmp(Yap_gc_restore) == 2) { if (setjmp(Yap_gc_restore) == 2) {
/* we cannot recover, fail system */ /* we cannot recover, fail system */
restore_machine_regs(); restore_machine_regs();
*--ASP = (CELL)current_env; *--ASP = (CELL)current_env;
TR = OldTR; TR = OldTR;
if ( if (
#if GC_NO_TAGS
!Yap_growtrail(64 * 1024L, FALSE) !Yap_growtrail(64 * 1024L, FALSE)
#else
TRUE
#endif
) { ) {
#if GC_NO_TAGS
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"out of %lB during gc", 64*1024L); Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"out of %lB during gc", 64*1024L);
return -1; return -1;
#else
/* try stack expansion, who knows */
return 0;
#endif
} else { } else {
total_marked = 0; total_marked = 0;
total_oldies = 0; total_oldies = 0;

37
C/stdpreds.c
View File

@ -11,8 +11,11 @@
* File: stdpreds.c * * File: stdpreds.c *
* comments: General-purpose C implemented system predicates * * comments: General-purpose C implemented system predicates *
* * * *
* Last rev: $Date: 2006-08-22 16:12:46 $,$Author: vsc $ * * Last rev: $Date: 2006-09-01 20:14:42 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.107 2006/08/22 16:12:46 vsc
* global variables
*
* Revision 1.106 2006/08/07 18:51:44 vsc * Revision 1.106 2006/08/07 18:51:44 vsc
* fix garbage collector not to try to garbage collect when we ask for large * fix garbage collector not to try to garbage collect when we ask for large
* chunks of stack in a single go. * chunks of stack in a single go.
@ -2510,6 +2513,37 @@ p_statistics_trail_info(void)
} }
static Int
p_statistics_atom_info(void)
{
UInt count = 0, spaceused = 0, i;
for (i =0; i < AtomHashTableSize; i++) {
Atom catom;
READ_LOCK(HashChain[i].aeAERWLock);
catom = HashChain[i].Entry;
if (catom != NIL) {
READ_LOCK(RepAtom(catom)->ARWLock);
}
READ_UNLOCK(HashChain[i].AERWLock);
while (catom != NIL) {
Atom ncatom;
count++;
spaceused += sizeof(AtomEntry)+strlen(RepAtom(catom)->StrOfAE);
ncatom = RepAtom(catom)->NextOfAE;
if (ncatom != NIL) {
READ_LOCK(RepAtom(ncatom)->ARWLock);
}
READ_UNLOCK(RepAtom(ncatom)->ARWLock);
catom = ncatom;
}
}
return Yap_unify(ARG1, MkIntegerTerm(count)) &&
Yap_unify(ARG2, MkIntegerTerm(spaceused));
}
static Term static Term
mk_argc_list(void) mk_argc_list(void)
{ {
@ -2950,6 +2984,7 @@ Yap_InitCPreds(void)
Yap_InitCPred("$statistics_heap_info", 2, p_statistics_heap_info, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$statistics_heap_info", 2, p_statistics_heap_info, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$statistics_stacks_info", 3, p_statistics_stacks_info, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$statistics_stacks_info", 3, p_statistics_stacks_info, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$statistics_trail_info", 2, p_statistics_trail_info, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$statistics_trail_info", 2, p_statistics_trail_info, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$statistics_atom_info", 2, p_statistics_atom_info, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$argv", 1, p_argv, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$argv", 1, p_argv, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$runtime", 2, p_runtime, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$runtime", 2, p_runtime, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$cputime", 2, p_cputime, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$cputime", 2, p_cputime, SafePredFlag|SyncPredFlag|HiddenPredFlag);

36
C/utilpreds.c
View File

@ -1347,22 +1347,23 @@ static Int TermHash(Term t1, Int depth_lim, Int k)
Int i; Int i;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
return(-1); return(-1);
} else if (IsAtomTerm(t1)) { } else if (IsAtomOrIntTerm(t1)) {
register char *s = AtomName(AtomOfTerm(t1)); if (IsAtomTerm(t1)) {
for (i=0; s[i]; i++) register char *s = AtomName(AtomOfTerm(t1));
for (i=0; s[i]; i++)
HASHADD(s[i]); HASHADD(s[i]);
return(k); return k;
} else {
HASHADD(IntOfTerm(t1));
return k;
}
} else if (IsPairTerm(t1)) { } else if (IsPairTerm(t1)) {
HASHADD('.'); HASHADD('.');
depth_lim--; depth_lim--;
if (depth_lim == 0) return(TRUE); if (depth_lim == 0) return(TRUE);
k = TermHash(HeadOfTerm(t1),depth_lim,k); k = TermHash(HeadOfTerm(t1),depth_lim,k);
if (k < 0) return(-1); if (k < 0) return k;
k = TermHash(TailOfTerm(t1),depth_lim,k); return TermHash(TailOfTerm(t1),depth_lim,k);
return(k);
} else if (IsIntTerm(t1)) {
HASHADD(IntOfTerm(t1));
return(k);
} else { } else {
Functor f = FunctorOfTerm(t1); Functor f = FunctorOfTerm(t1);
@ -1386,17 +1387,18 @@ static Int TermHash(Term t1, Int depth_lim, Int k)
return(-1); return(-1);
} }
} else { } else {
int ar = ArityOfFunctor(FunctorOfTerm(t1)); int ar;
int res = TRUE; char *s;
register char *s = AtomName(NameOfFunctor(f));
depth_lim--; s = AtomName(NameOfFunctor(f));
if (depth_lim == 0) return(TRUE);
for (i=0; s[i]; i++) for (i=0; s[i]; i++)
HASHADD(s[i]); HASHADD(s[i]);
for (i=1; i<=ar && res; i++) { depth_lim--;
if (depth_lim == 0) return k;
ar = ArityOfFunctor(f);
for (i=1; i<=ar; i++) {
k = TermHash(ArgOfTerm(i,t1),depth_lim,k); k = TermHash(ArgOfTerm(i,t1),depth_lim,k);
if (k == -1 ) return(-1); if (k < 0) return k;
} }
return(k); return(k);
} }

62
H/heapgc.h
View File

@ -20,11 +20,7 @@
/* macros used by garbage collection */ /* macros used by garbage collection */
#if TAG_64BITS #if TAG_64BITS
#if GC_NO_TAGS
#define MaskAdr (~0x7L) #define MaskAdr (~0x7L)
#else
#define MaskAdr (~(MBIT|RBIT|0x7L))
#endif
#endif #endif
/* return pointer from object pointed to by ptr (remove tag & mark) */ /* return pointer from object pointed to by ptr (remove tag & mark) */
@ -42,13 +38,7 @@
) )
#else #else
#ifdef TAG_LOW_BITS_32 #ifdef TAG_LOW_BITS_32
#if GC_NO_TAGS
#define GET_NEXT(val) ((CELL *) ((val) & ~LowTagBits)) #define GET_NEXT(val) ((CELL *) ((val) & ~LowTagBits))
#elif INVERT_RBIT
#define GET_NEXT(val) ((CELL *) (((val) & ~(LowTagBits|MBIT))|RBIT))
#else
#define GET_NEXT(val) ((CELL *) ((val) & ~(LowTagBits|MBIT|RBIT)))
#endif
#else #else
#define GET_NEXT(val) ((CELL *) ((val) & MaskAdr)) #define GET_NEXT(val) ((CELL *) ((val) & MaskAdr))
#endif #endif
@ -87,8 +77,6 @@
(CellPtr(B) < CellPtr(val) && CellPtr(val) <= \ (CellPtr(B) < CellPtr(val) && CellPtr(val) <= \
LCL0 && HEAP_PTR(val)))) LCL0 && HEAP_PTR(val))))
#if GC_NO_TAGS
#if !defined(YAPOR) && !defined(THREADS) #if !defined(YAPOR) && !defined(THREADS)
extern char *Yap_bp; extern char *Yap_bp;
#endif #endif
@ -151,56 +139,6 @@ RMARKED(CELL* ptr)
return mcell(ptr) & RMARK_BIT; return mcell(ptr) & RMARK_BIT;
} }
#else
/* is the object pointed to by ptr marked? */
#ifdef TAGS_FAST_OPS
#define MARKED_VAR(val) ((val) & MBIT)
#define MARKED_COMP(val) (!((val) & MBIT))
#define MARKED(val) ((Int)(val) < 0 && (((val) & LowTagBits) != 2)\
? \
!((val) & MBIT) : ((val) & MBIT))
#else
#define MARKED(val) ((val) & MBIT)
#endif
#define MARK(ptr) (*(ptr) ^= MBIT) /* mark the object pointed to by ptr */
#define MARK_CELL(val) ((val) ^ MBIT) /* mark the object pointed to by ptr */
#define UNMARK(ptr) (*(ptr) ^= MBIT) /* unmark the object pointed to by ptr */
#define UNMARK_CELL(val) ((val) ^ MBIT) /* unmark the object pointed to by ptr */
#define MARKED_PTR(ptr) MARKED(*(ptr))
#ifdef TAGS_FAST_OPS
#define RMARKED(ptr) (!GCIsPrimitiveTerm(*(ptr)) && (IsVarTerm(*(ptr)) ?\
((*(ptr)) & RBIT) : !((*(ptr)) & RBIT)))
#define UNMARKED(val) ((Int)(val) < 0 && (((val) & LowTagBits) != 2)\
? \
((val) | MBIT) : ((val) & ~MBIT))
#define ENSURE_MARKED(val) ((Int)(val) < 0 && (((val) & LowTagBits) != 2)\
? \
((val) & ~MBIT) : ((val) | MBIT))
#else
#if INVERT_RBIT
#define RMARKED(ptr) (!GCIsPrimitiveTerm(*(ptr)) && !((*(ptr)) & RBIT))
#else
#define RMARKED(ptr) (!GCIsPrimitiveTerm(*(ptr)) && ((*(ptr)) & RBIT))
#endif
#endif /* GC_NO_TAGS */
#endif
/* is the object pointed to by ptr marked as in a relocation chain? */ /* is the object pointed to by ptr marked as in a relocation chain? */

4
pl/statistics.yap
View File

@ -110,6 +110,10 @@ statistics(stack_shifts,[NOfHO,NOfSO,NOfTO]) :-
'$inform_heap_overflows'(NOfHO,_), '$inform_heap_overflows'(NOfHO,_),
'$inform_stack_overflows'(NOfSO,_), '$inform_stack_overflows'(NOfSO,_),
'$inform_trail_overflows'(NOfTO,_). '$inform_trail_overflows'(NOfTO,_).
statistics(atoms,[NOf,SizeOf]) :-
'$statistics_atom_info'(NOf,SizeOf),
'$inform_stack_overflows'(NOfSO,_),
'$inform_trail_overflows'(NOfTO,_).
key_statistics(Key, NOfEntries, TotalSize) :- key_statistics(Key, NOfEntries, TotalSize) :-
key_statistics(Key, NOfEntries, ClSize, IndxSize), key_statistics(Key, NOfEntries, ClSize, IndxSize),