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);
MP_INT *dst;
*ptr++ = (CELL)FunctorBigInt;
dst = (MP_INT *)ptr;
ptr[0] = (CELL)FunctorBigInt;
dst = (MP_INT *)(ptr+1);
dst->_mp_size = 0L;
dst->_mp_alloc = arena2big_sz(size);
ptr[size-2] = EndSpecials;
ptr[size-1] = EndSpecials;
return t;
}
@ -265,15 +265,15 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity)
if (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 (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;
} else {
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;
/* store the terms to visit */
ap2 = RepAppl(d0);
if (ap2 >= HB && ap2 <= H) {
if (ap2 >= HB && ap2 < H) {
/* If this is newer than the current term, just reuse */
*ptf++ = d0;
continue;
@ -427,9 +427,52 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) {
{
*ptf++ = d0; /* you can just copy other extensions. */
switch((CELL)f) {
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;
}
*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);
return tn;
} else if (IsPrimitiveTerm(t)) {
} else if (IsAtomOrIntTerm(t)) {
return t;
} else if (IsPairTerm(t)) {
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);
return tf;
} else {
Functor f = FunctorOfTerm(t);
Functor f;
Term tf;
CELL *HB0;
CELL *ap;
@ -663,9 +706,53 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
ap = RepAppl(t);
tf = AbsAppl(H);
H[0] = (CELL)f;
H += 1+ArityOfFunctor(f);
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, att_arenap)) < 0) {
goto error_handler;
if (IsExtensionFunctor(f)) {
switch((CELL)f) {
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);
return tf;
@ -922,14 +1009,6 @@ p_nb_queue(void)
queue = Yap_MkApplTerm(FunctorNBQueue,5,ar);
if (!Yap_unify(queue,ARG1))
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;
if (arena_sz <2)
arena_sz = 2;
@ -941,6 +1020,14 @@ p_nb_queue(void)
}
nar = RepAppl(Deref(ARG1))+1;
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;
}
@ -1061,14 +1148,14 @@ p_nb_queue_enqueue(void)
old_sz = ArenaSz(arena);
qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
while (old_sz < 128) {
UInt gsiz = qsize*2*sizeof(CELL);
UInt gsiz = qsize*2;
H = oldH;
HB = oldHB;
if (gsiz > 1024*1024) {
gsiz = 1024*1024;
} else if (gsiz < 1024*sizeof(CELL)) {
gsiz = 1024*sizeof(CELL);
} else if (gsiz < 1024) {
gsiz = 1024;
}
ARG3 = to;
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
@ -1175,6 +1262,25 @@ GetHeap(Term t, char* caller)
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
p_nb_heap(void)
{
@ -1193,7 +1299,13 @@ p_nb_heap(void)
}
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))
return FALSE;
ar = RepAppl(heap)+1;
@ -1326,7 +1438,7 @@ p_nb_heap_add_to_heap(void)
hmsize += extra_size;
if (!qd)
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));
while (extra_size) {
RESET_VARIABLE(top);
@ -1347,6 +1459,7 @@ p_nb_heap_add_to_heap(void)
if (arena == 0L)
return FALSE;
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);
if (key == 0 || to == 0L)
return FALSE;
@ -1358,14 +1471,14 @@ p_nb_heap_add_to_heap(void)
H = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
while (old_sz < 128) {
UInt gsiz = hsize*2*sizeof(CELL);
UInt gsiz = hsize*2;
H = oldH;
HB = oldHB;
if (gsiz > 1024*1024) {
gsiz = 1024*1024;
} else if (gsiz < 1024*sizeof(CELL)) {
gsiz = 1024*sizeof(CELL);
} else if (gsiz < 1024) {
gsiz = 1024;
}
ARG3 = to;
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
@ -1475,7 +1588,12 @@ p_nb_beam(void)
}
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))
return FALSE;
ar = RepAppl(beam)+1;
@ -1736,7 +1854,8 @@ p_nb_beam_add_to_beam(void)
arena = qd[HEAP_ARENA];
if (arena == 0L)
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);
if (key == 0 || to == 0L)
return FALSE;
@ -1748,14 +1867,14 @@ p_nb_beam_add_to_beam(void)
H = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
while (old_sz < 128) {
UInt gsiz = hsize*2*sizeof(CELL);
UInt gsiz = hsize*2;
H = oldH;
HB = oldHB;
if (gsiz > 1024*1024) {
gsiz = 1024*1024;
} else if (gsiz < 1024*sizeof(CELL)) {
gsiz = 1024*sizeof(CELL);
} else if (gsiz < 1024) {
gsiz = 1024;
}
ARG3 = to;
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
@ -1847,8 +1966,44 @@ p_nb_beam_check(void)
}
return TRUE;
}
#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
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_peek", 3, p_nb_beam_peek, 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
Yap_InitCPred("nb_beam_check", 1, p_nb_beam_check, SafePredFlag);
#endif

150
C/heapgc.c
View File

@ -111,9 +111,7 @@ static tr_fr_ptr new_TR;
static CELL *HGEN;
#if GC_NO_TAGS
char *Yap_bp;
#endif
static int discard_trail_entries = 0;
@ -154,7 +152,6 @@ gc_growtrail(int committed)
inline static void
PUSH_CONTINUATION(CELL *v, int nof) {
cont *x;
if (nof == 0) return;
x = cont_top;
x++;
if ((ADDR)x > Yap_TrailTop-1024) {
@ -1137,13 +1134,9 @@ mark_variable(CELL_PTR current)
inc_var(current, current);
#endif
*next = (CELL)current;
#if GC_NO_TAGS
UNMARK(next);
MARK(current);
*current = (CELL)current;
#else
*current = MARK_CELL((CELL)current);
#endif
POP_CONTINUATION();
} else {
/* can't help here */
@ -1155,9 +1148,7 @@ mark_variable(CELL_PTR current)
} else {
/* binding to a determinate reference */
if (next >= HB && current < LCL0 && cnext != TermFoundVar) {
#if GC_NO_TAGS
UNMARK(current);
#endif
*current = cnext;
if (current >= H0 && current < H) {
total_marked--;
@ -1178,9 +1169,7 @@ mark_variable(CELL_PTR current)
current < LCL0) {
/* This step is possible because we clean up the trail */
*current = UNMARK_CELL(cnext);
#if GC_NO_TAGS
UNMARK(current);
#endif
if (current >= H0 && current < H) {
total_marked--;
if (current < HGEN) {
@ -1277,9 +1266,7 @@ mark_variable(CELL_PTR current)
switch (cnext) {
case (CELL)FunctorLongInt:
MARK(next);
#if GC_NO_TAGS
MARK(next+2);
#endif
if (next < HGEN) {
total_oldies+=3;
}
@ -1300,7 +1287,6 @@ mark_variable(CELL_PTR current)
MARK(next+sz);
}
POP_CONTINUATION();
#ifdef USE_GMP
case (CELL)FunctorBigInt:
{
UInt sz = (sizeof(MP_INT)+
@ -1315,8 +1301,6 @@ mark_variable(CELL_PTR current)
MARK(next+sz);
PUSH_POINTER(next+sz);
}
POP_CONTINUATION();
#endif
default:
POP_CONTINUATION();
}
@ -1332,7 +1316,22 @@ mark_variable(CELL_PTR current)
++total_oldies;
}
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);
goto begin;
}
@ -2066,7 +2065,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
static inline void
into_relocation_chain(CELL_PTR current, CELL_PTR next)
{
#if GC_NO_TAGS
CELL current_tag;
current_tag = TAG(*current);
@ -2078,39 +2076,6 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next)
}
*current = *next;
*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 ccur = *current;
#if GC_NO_TAGS
int rmarked = RMARKED(current);
UNRMARK(current);
@ -2897,52 +2861,6 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
*next = (CELL) dest | current_tag;
}
*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
@ -3047,11 +2965,7 @@ compact_heap(void)
while (!MARKED_PTR(ptr)) ptr--;
nofcells = current-ptr;
ptr++;
#if GC_NO_TAGS
MARK(ptr);
#else
XXX BROKEN CODE
#endif
#ifdef DEBUG
found_marked+=nofcells;
#endif
@ -3074,12 +2988,8 @@ compact_heap(void)
into_relocation_chain(current, next);
else if (current == next) { /* cell pointing to
* itself */
#if GC_NO_TAGS
UNRMARK(current);
*current = (CELL) dest; /* no tag */
#else
*current = (*current & MBIT) | (CELL) dest; /* no tag */
#endif
}
}
dest--;
@ -3251,12 +3161,8 @@ icompact_heap(void)
into_relocation_chain(current, next);
else if (current == next) { /* cell pointing to
* itself */
#if GC_NO_TAGS
UNRMARK(current);
*current = (CELL) dest; /* no tag */
#else
*current = (*current & MBIT) | (CELL) dest; /* no tag */
#endif
}
}
dest--;
@ -3407,7 +3313,7 @@ sweep_oldgen(CELL *max, CELL *base)
char *bpb = Yap_bp+(base-(CELL*)Yap_GlobalBase);
while (ptr < max) {
if (*bpb & MARK_BIT) {
if (*bpb) {
if (HEAP_PTR(*ptr)) {
into_relocation_chain(ptr, GET_NEXT(*ptr));
}
@ -3561,17 +3467,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
#endif
if (Yap_GetValue(AtomGcTrace) != TermNil)
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) {
fprintf(Yap_stderr, "%% gc\n");
} else if (gc_verbose) {
@ -3602,7 +3497,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
total_smarked = 0;
#endif
discard_trail_entries = 0;
#if GC_NO_TAGS
{
UInt alloc_sz = (CELL *)Yap_TrailTop-(CELL*)Yap_GlobalBase;
Yap_bp = Yap_PreAllocCodeSpace();
@ -3620,26 +3514,16 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
}
memset((void *)Yap_bp, 0, alloc_sz);
}
#endif /* GC_NO_TAGS */
if (setjmp(Yap_gc_restore) == 2) {
/* we cannot recover, fail system */
restore_machine_regs();
*--ASP = (CELL)current_env;
TR = OldTR;
if (
#if GC_NO_TAGS
!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);
return -1;
#else
/* try stack expansion, who knows */
return 0;
#endif
} else {
total_marked = 0;
total_oldies = 0;

37
C/stdpreds.c
View File

@ -11,8 +11,11 @@
* File: stdpreds.c *
* 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 $
* Revision 1.107 2006/08/22 16:12:46 vsc
* global variables
*
* Revision 1.106 2006/08/07 18:51:44 vsc
* fix garbage collector not to try to garbage collect when we ask for large
* 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
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_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_atom_info", 2, p_statistics_atom_info, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$argv", 1, p_argv, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$runtime", 2, p_runtime, 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;
if (IsVarTerm(t1)) {
return(-1);
} else if (IsAtomTerm(t1)) {
register char *s = AtomName(AtomOfTerm(t1));
for (i=0; s[i]; i++)
} else if (IsAtomOrIntTerm(t1)) {
if (IsAtomTerm(t1)) {
register char *s = AtomName(AtomOfTerm(t1));
for (i=0; s[i]; i++)
HASHADD(s[i]);
return(k);
return k;
} else {
HASHADD(IntOfTerm(t1));
return k;
}
} else if (IsPairTerm(t1)) {
HASHADD('.');
depth_lim--;
if (depth_lim == 0) return(TRUE);
k = TermHash(HeadOfTerm(t1),depth_lim,k);
if (k < 0) return(-1);
k = TermHash(TailOfTerm(t1),depth_lim,k);
return(k);
} else if (IsIntTerm(t1)) {
HASHADD(IntOfTerm(t1));
return(k);
if (k < 0) return k;
return TermHash(TailOfTerm(t1),depth_lim,k);
} else {
Functor f = FunctorOfTerm(t1);
@ -1386,17 +1387,18 @@ static Int TermHash(Term t1, Int depth_lim, Int k)
return(-1);
}
} else {
int ar = ArityOfFunctor(FunctorOfTerm(t1));
int res = TRUE;
register char *s = AtomName(NameOfFunctor(f));
int ar;
char *s;
depth_lim--;
if (depth_lim == 0) return(TRUE);
s = AtomName(NameOfFunctor(f));
for (i=0; s[i]; 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);
if (k == -1 ) return(-1);
if (k < 0) return k;
}
return(k);
}

62
H/heapgc.h
View File

@ -20,11 +20,7 @@
/* macros used by garbage collection */
#if TAG_64BITS
#if GC_NO_TAGS
#define MaskAdr (~0x7L)
#else
#define MaskAdr (~(MBIT|RBIT|0x7L))
#endif
#endif
/* return pointer from object pointed to by ptr (remove tag & mark) */
@ -42,13 +38,7 @@
)
#else
#ifdef TAG_LOW_BITS_32
#if GC_NO_TAGS
#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
#define GET_NEXT(val) ((CELL *) ((val) & MaskAdr))
#endif
@ -87,8 +77,6 @@
(CellPtr(B) < CellPtr(val) && CellPtr(val) <= \
LCL0 && HEAP_PTR(val))))
#if GC_NO_TAGS
#if !defined(YAPOR) && !defined(THREADS)
extern char *Yap_bp;
#endif
@ -151,56 +139,6 @@ RMARKED(CELL* ptr)
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? */

4
pl/statistics.yap
View File

@ -110,6 +110,10 @@ statistics(stack_shifts,[NOfHO,NOfSO,NOfTO]) :-
'$inform_heap_overflows'(NOfHO,_),
'$inform_stack_overflows'(NOfSO,_),
'$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, ClSize, IndxSize),