int gc_heap(CTXTdeclc int arity, int ifStringGC)
{
#ifdef GC
CPtr p;
double begin_marktime, end_marktime,
end_slidetime, end_copy_time,
begin_stringtime, end_stringtime;
size_t marked = 0, marked_dregs = 0, i;
int ii;
size_t start_heap_size;
size_t rnum_in_trieinstr_unif_stk = (trieinstr_unif_stkptr-trieinstr_unif_stk)+1;
DECL_GC_PROFILE;
garbage_collecting = 1; // flag for profiling that we are gc-ing
// printf("start gc(%ld): e:%p,h:%p,hf:%p\n",(long)(cpu_time()*1000),ereg,hreg,hfreg);
INIT_GC_PROFILE;
if (pflags[GARBAGE_COLLECT] != NO_GC) {
num_gc++ ;
GC_PROFILE_PRE_REPORT;
slide = (pflags[GARBAGE_COLLECT] == SLIDING_GC) |
(pflags[GARBAGE_COLLECT] == INDIRECTION_SLIDE_GC);
if (fragmentation_only)
slide = FALSE;
heap_early_reset = ls_early_reset = 0;
GC_PROFILE_START_SUMMARY;
begin_marktime = cpu_time();
start_heap_size = hreg+1-(CPtr)glstack.low;
/* make sure the top choice point heap pointer
that might not point into heap, does */
if (hreg == cp_hreg(breg)) {
*hreg = makeint(666) ;
hreg++;
}
#ifdef SLG_GC
/* same for the freeze heap pointer */
if (hfreg == hreg && hreg == cp_hreg(bfreg)) {
*hreg = makeint(66600);
hreg++;
}
#endif
/* copy the aregs to the top of the heap - only if sliding */
/* just hope there is enough space */
/* this happens best before the stack_boundaries are computed */
if (slide) {
if (delayreg != NULL) {
arity++;
reg[arity] = (Cell)delayreg;
}
for (ii = 1; ii <= arity; ii++) {
// printf("reg[%d] to heap: %lx\n",ii,(size_t)reg[i]);
*hreg = reg[ii];
hreg++;
}
arity += (int)rnum_in_trieinstr_unif_stk;
for (i = 0; i < rnum_in_trieinstr_unif_stk; i++) {
// printf("trieinstr_unif_stk[%d] to heap: %lx\n",i,(size_t)trieinstr_unif_stk[i]);
*hreg = trieinstr_unif_stk[i];
hreg++;
}
// printf("extended heap: hreg=%p, arity=%d, rnum_in=%d\n",hreg,arity, rnum_in_trieinstr_unif_stk);
#ifdef SLG_GC
/* in SLGWAM, copy hfreg to the heap */
// printf("hfreg to heap is %p at %p, rnum_in_trieinstr_unif_stk=%d,arity=%d,delay=%p\n",hfreg,hreg,rnum_in_trieinstr_unif_stk,arity,delayreg);
*(hreg++) = (Cell) hfreg;
#endif
}
if (top_of_localstk < hreg) {
fprintf(stderr,"stack clobbered: no space for gc_heap\n");
xsb_exit( "stack clobbered");
}
gc_strings = ifStringGC; /* default */
gc_strings = should_gc_strings(); // collect strings for any reason?
marked = mark_heap(CTXTc arity, &marked_dregs);
end_marktime = cpu_time();
if (fragmentation_only) {
/* fragmentation is expressed as ratio not-marked/total heap in use
this is internal fragmentation only. we print marked and total,
so that postprocessing can do what it wants with this info. */
xsb_dbgmsg((LOG_GC, "marked_used_missed(%d,%d,%d,%d).",
marked,hreg+1-(CPtr)glstack.low,
heap_early_reset,ls_early_reset));
free_marks:
#ifdef PRE_IMAGE_TRAIL
/* re-tag pre image cells in trail */
for (p = tr_bot; p <= tr_top ; p++ ) {
if (tr_pre_marked(p-tr_bot)) {
*p = *p | PRE_IMAGE_MARK;
tr_clear_pre_mark(p-tr_bot);
}
}
#endif
/* get rid of the marking areas - if they exist */
if (heap_marks) { mem_dealloc((heap_marks-1),heap_marks_size,GC_SPACE); heap_marks = NULL; }
if (tr_marks) { mem_dealloc(tr_marks,tr_top-tr_bot+1,GC_SPACE); tr_marks = NULL; }
if (ls_marks) { mem_dealloc(ls_marks,ls_bot - ls_top + 1,GC_SPACE); ls_marks = NULL; }
if (cp_marks) { mem_dealloc(cp_marks,cp_bot - cp_top + 1,GC_SPACE); cp_marks = NULL; }
if (slide_buf) { mem_dealloc(slide_buf,(slide_buf_size+1)*sizeof(CPtr),GC_SPACE); slide_buf = NULL; }
goto end;
}
GC_PROFILE_MARK_SUMMARY;
/* An attempt to add some gc/expansion policy;
ideally this should be user-controlled */
#if (! defined(GC_TEST))
if (marked > ((hreg+1-(CPtr)glstack.low)*mark_threshold))
{
GC_PROFILE_QUIT_MSG;
if (slide)
hreg -= arity;
total_time_gc += (double)
(end_marktime-begin_marktime);
goto free_marks; /* clean-up temp areas and get out of here... */
}
#endif
total_collected += (start_heap_size - marked);
if (slide)
{
GC_PROFILE_SLIDE_START_TIME;
hreg = slide_heap(CTXTc marked) ;
#ifdef DEBUG_VERBOSE
if (hreg != (heap_bot+marked))
xsb_dbgmsg((LOG_GC, "heap sliding gc - inconsistent hreg"));
#endif
#ifdef SLG_GC
/* copy hfreg back from the heap */
hreg--;
hfreg = (CPtr) *hreg;
#endif
/* copy the aregs from the top of the heap back */
hreg -= arity;
hbreg = cp_hreg(breg);
p = hreg;
arity -= (int)rnum_in_trieinstr_unif_stk;
for (ii = 1; ii <= arity; ii++) {
reg[ii] = *p++;
// printf("heap to reg[%d]: %lx\n",ii,(size_t)reg[i]);
}
if (delayreg != NULL)
delayreg = (CPtr)reg[arity--];
for (i = 0; i < rnum_in_trieinstr_unif_stk; i++) {
trieinstr_unif_stk[i] = *p++;
// printf("heap to trieinstr_unif_stk[%d]: %lx\n",i,(size_t)trieinstr_unif_stk[i]);
}
end_slidetime = cpu_time();
total_time_gc += (double)
(end_slidetime - begin_marktime);
GC_PROFILE_SLIDE_FINAL_SUMMARY;
}
else
{ /* else we call the copying collector a la Cheney */
CPtr begin_new_heap, end_new_heap;
GC_PROFILE_COPY_START_TIME;
begin_new_heap = (CPtr)mem_alloc(marked*sizeof(Cell),GC_SPACE);
if (begin_new_heap == NULL)
xsb_exit( "copying garbage collection could not allocate new heap");
end_new_heap = begin_new_heap+marked;
hreg = copy_heap(CTXTc marked,begin_new_heap,end_new_heap,arity);
mem_dealloc(begin_new_heap,marked*sizeof(Cell),GC_SPACE);
adapt_hfreg_from_choicepoints(CTXTc hreg);
hbreg = cp_hreg(breg);
#ifdef SLG_GC
hfreg = hreg;
#endif
end_copy_time = cpu_time();
total_time_gc += (double)
(end_copy_time - begin_marktime);
GC_PROFILE_COPY_FINAL_SUMMARY;
}
if (print_on_gc) print_all_stacks(CTXTc arity);
/* get rid of the marking areas - if they exist */
if (heap_marks) {
check_zero(heap_marks,(heap_top - heap_bot),"heap") ;
mem_dealloc((heap_marks-1),heap_marks_size,GC_SPACE) ; /* see its calloc */
heap_marks = NULL ;
}
if (tr_marks) {
check_zero(tr_marks,(tr_top - tr_bot + 1),"tr") ;
mem_dealloc(tr_marks,tr_top-tr_bot+1,GC_SPACE) ;
tr_marks = NULL ;
}
if (ls_marks) {
check_zero(ls_marks,(ls_bot - ls_top + 1),"ls") ;
mem_dealloc(ls_marks,ls_bot - ls_top + 1,GC_SPACE) ;
ls_marks = NULL ;
}
if (cp_marks) {
check_zero(cp_marks,(cp_bot - cp_top + 1),"cp") ;
mem_dealloc(cp_marks,cp_bot - cp_top + 1,GC_SPACE) ;
cp_marks = NULL ;
}
if (slide_buf) {
mem_dealloc(slide_buf,(slide_buf_size+1)*sizeof(CPtr),GC_SPACE);
slide_buf = NULL;
}
#ifdef SAFE_GC
p = hreg;
while (p < heap_top)
*p++ = 0;
#endif
} /* if (pflags[GARBAGE_COLLECT]) */
#else
/* for no-GC, there is no gc, but stack expansion can be done */
#endif
#ifdef GC
end:
/*************** GC STRING-TABLE (already marked from heap) *******************/
#ifndef NO_STRING_GC
#ifdef MULTI_THREAD
if (flags[NUM_THREADS] == 1) {
#endif
if (gc_strings && (flags[STRING_GARBAGE_COLLECT] == 1)) {
num_sgc++;
begin_stringtime = cpu_time();
mark_nonheap_strings(CTXT);
free_unused_strings();
// printf("String GC reclaimed: %d bytes\n",beg_string_space_size - pspacesize[STRING_SPACE]);
gc_strings = FALSE;
end_stringtime = cpu_time();
total_time_gc += end_stringtime - begin_stringtime;
}
/* update these even if no GC, to avoid too many calls just to gc strings */
last_string_space_size = pspacesize[STRING_SPACE];
last_assert_space_size = pspacesize[ASSERT_SPACE];
force_string_gc = FALSE;
#ifdef MULTI_THREAD
}
#endif
#endif /* ndef NO_STRING_GC */
GC_PROFILE_POST_REPORT;
garbage_collecting = 0;
#endif /* GC */
// printf(" end gc(%ld), hf:%p,h:%p, space=%d\n",(long)(cpu_time()*1000),hfreg,hreg,(pb)top_of_localstk - (pb)top_of_heap);
return(TRUE);
} /* gc_heap */
int gc_heap(int arity)
{
#ifdef GC
CPtr p;
unsigned long begin_marktime, end_marktime,
end_slidetime, end_copy_time;
int marked = 0, marked_dregs = 0, i;
int start_heap_size;
DECL_GC_PROFILE;
INIT_GC_PROFILE;
if (flags[GARBAGE_COLLECT] != NO_GC) {
num_gc++ ;
GC_PROFILE_PRE_REPORT;
slide = (flags[GARBAGE_COLLECT] == SLIDING_GC) |
(flags[GARBAGE_COLLECT] == INDIRECTION_SLIDE_GC);
if (fragmentation_only)
slide = FALSE;
heap_early_reset = ls_early_reset = 0;
GC_PROFILE_START_SUMMARY;
begin_marktime = cpu_time();
start_heap_size = hreg+1-(CPtr)glstack.low;
/* make sure the top choice point heap pointer
that might not point into heap, does */
if (hreg == cp_hreg(breg)) {
*hreg = makeint(666) ;
hreg++ ;
}
#ifdef SLG_GC
/* same for the freeze heap pointer */
if (hfreg == hreg && hreg == cp_hreg(bfreg)) {
*hreg = makeint(66600);
hreg++;
}
#endif
/* copy the aregs to the top of the heap - only if sliding */
/* just hope there is enough space */
/* this happens best before the stack_boundaries are computed */
if (slide) {
if (delayreg != NULL) {
arity++;
reg[arity] = (Cell)delayreg;
}
for (i = 1; i <= arity; i++) {
*hreg = reg[i];
hreg++;
}
}
#ifdef SLG_GC
/* in SLGWAM, copy hfreg to the heap */
if (slide) {
*hreg = (unsigned long) hfreg;
hreg++;
}
#endif
marked = mark_heap(arity, &marked_dregs);
end_marktime = cpu_time();
if (fragmentation_only) {
/* fragmentation is expressed as ratio not-marked/total heap in use
this is internal fragmentation only. we print marked and total,
so that postprocessing can do what it wants with this info. */
xsb_dbgmsg((LOG_GC, "marked_used_missed(%d,%d,%d,%d).",
marked,hreg+1-(CPtr)glstack.low,
heap_early_reset,ls_early_reset));
free_marks:
/* get rid of the marking areas - if they exist */
if (heap_marks) { free((heap_marks-1)); heap_marks = NULL; }
if (tr_marks) { free(tr_marks); tr_marks = NULL; }
if (ls_marks) { free(ls_marks); ls_marks = NULL; }
if (cp_marks) { free(cp_marks); cp_marks = NULL; }
goto end;
}
GC_PROFILE_MARK_SUMMARY;
/* An attempt to add some gc/expansion policy;
ideally this should be user-controlled */
#if (! defined(GC_TEST))
if (marked > ((hreg+1-(CPtr)glstack.low)*mark_threshold))
{
GC_PROFILE_QUIT_MSG;
if (slide)
hreg -= arity;
total_time_gc += (double)
(end_marktime-begin_marktime)*1000/CLOCKS_PER_SEC;
goto free_marks; /* clean-up temp areas and get out of here... */
}
#endif
total_collected += (start_heap_size - marked);
if (slide)
{
GC_PROFILE_SLIDE_START_TIME;
hreg = slide_heap(marked) ;
if (hreg != (heap_bot+marked))
xsb_dbgmsg((LOG_GC, "heap sliding gc - inconsistent hreg"));
#ifdef SLG_GC
/* copy hfreg back from the heap */
hreg--;
hfreg = (unsigned long*) *hreg;
#endif
/* copy the aregs from the top of the heap back */
hreg -= arity;
hbreg = cp_hreg(breg);
p = hreg;
for (i = 1; i <= arity; i++)
reg[i] = *p++ ;
if (delayreg != NULL)
delayreg = (CPtr)reg[arity--];
end_slidetime = cpu_time();
total_time_gc += (double)
(end_slidetime - begin_marktime)*1000/CLOCKS_PER_SEC;
GC_PROFILE_SLIDE_FINAL_SUMMARY;
}
else
{ /* else we call the copying collector a la Cheney */
CPtr begin_new_heap, end_new_heap;
GC_PROFILE_COPY_START_TIME;
begin_new_heap = (CPtr)malloc(marked*sizeof(Cell));
if (begin_new_heap == NULL)
xsb_exit("copying garbage collection could not allocate new heap");
end_new_heap = begin_new_heap+marked;
hreg = copy_heap(marked,begin_new_heap,end_new_heap,arity);
free(begin_new_heap);
adapt_hfreg_from_choicepoints(hreg);
hbreg = cp_hreg(breg);
#ifdef SLG_GC
hfreg = hreg;
#endif
end_copy_time = cpu_time();
total_time_gc += (double)
(end_copy_time - begin_marktime)*1000/CLOCKS_PER_SEC;
GC_PROFILE_COPY_FINAL_SUMMARY;
}
if (print_on_gc) print_all_stacks(arity);
/* get rid of the marking areas - if they exist */
if (heap_marks) {
check_zero(heap_marks,(heap_top - heap_bot),"heap") ;
free((heap_marks-1)) ; /* see its calloc */
heap_marks = NULL ;
}
if (tr_marks) {
check_zero(tr_marks,(tr_top - tr_bot + 1),"tr") ;
free(tr_marks) ;
tr_marks = NULL ;
}
if (ls_marks) {
check_zero(ls_marks,(ls_bot - ls_top + 1),"ls") ;
free(ls_marks) ;
ls_marks = NULL ;
}
if (cp_marks) {
check_zero(cp_marks,(cp_bot - cp_top + 1),"cp") ;
free(cp_marks) ;
cp_marks = NULL ;
}
#ifdef SAFE_GC
p = hreg;
while (p < heap_top)
*p++ = 0;
#endif
} /* if (flags[GARBAGE_COLLECT]) */
#else
/* for no-GC, there is no gc, but stack expansion can be done */
#endif
#ifdef GC
end:
GC_PROFILE_POST_REPORT;
#endif /* GC */
return(TRUE);
} /* gc_heap */
