/* File: gc_slide.h
** Author(s): Luis Castro, Bart Demoen, Kostis Sagonas
** Contact: xsb-contact@cs.sunysb.edu
**
** Copyright (C) The Research Foundation of SUNY, 1986, 1993-1998
** Copyright (C) ECRC, Germany, 1990
**
** XSB is free software; you can redistribute it and/or modify it under the
** terms of the GNU Library General Public License as published by the Free
** Software Foundation; either version 2 of the License, or (at your option)
** any later version.
**
** XSB is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
** FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for
** more details.
**
** You should have received a copy of the GNU Library General Public License
** along with XSB; if not, write to the Free Software Foundation,
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
**
** $Id: gc_slide.h,v 1.8 2003/03/19 16:45:58 lfcastro Exp $
**
*/
/*=======================================================================*/
/* from here to end of slide_heap is code taken to some extent from
BinProlog and adapted to XSB - especially what concerns the
environments
the BinProlog garbage collector was also written originally by Bart Demoen
*/
#ifdef GC
#define h_set_chained(p) heap_marks[(p-heap_bot)] |= CHAIN_BIT
#define h_set_unchained(p) heap_marks[(p-heap_bot)] &= ~CHAIN_BIT
#define h_is_chained(p) (heap_marks[(p-heap_bot)] & CHAIN_BIT)
#define ls_set_chained(p) ls_marks[(p-ls_top)] |= CHAIN_BIT
#define ls_set_unchained(p) ls_marks[(p-ls_top)] &= ~CHAIN_BIT
#define ls_is_chained(p) (ls_marks[(p-ls_top)] & CHAIN_BIT)
#define cp_set_chained(p) cp_marks[(p-cp_top)] |= CHAIN_BIT
#define cp_set_unchained(p) cp_marks[(p-cp_top)] &= ~CHAIN_BIT
#define cp_is_chained(p) (cp_marks[(p-cp_top)] & CHAIN_BIT)
#define tr_set_chained(p) tr_marks[(p-tr_bot)] |= CHAIN_BIT
#define tr_set_unchained(p) tr_marks[(p-tr_bot)] &= ~CHAIN_BIT
#define tr_is_chained(p) (tr_marks[(p-tr_bot)] & CHAIN_BIT)
static void unchain(CPtr hptr, CPtr destination)
{
CPtr start, pointsto ;
int whereto, tag ;
int continue_after_this = 0 ;
/* hptr is a pointer to the heap and is chained */
/* the whole chain is unchained, i.e.
the end of the chain is put in the beginning and
all other chained elements (up to end included) are made
to point to the destination
we have to make sure that the tags are ok and that the chain tags
are switched off
I have implemented a version which can be optimised, but it shows
all intermediate steps as the previous chaining steps - except for
the chain bit of hptr
*/
h_set_unchained(hptr) ;
do
{
start = (CPtr)(*hptr) ;
/* start is for sure a pointer - possibly with a tag */
pointsto = pointer_from_cell((Cell)start,&tag,&whereto) ;
if (pointsto == NULL) xsb_exit("pointsto error during unchaining") ;
switch (whereto)
{
case TO_HEAP :
continue_after_this = h_is_chained(pointsto) ;
h_set_unchained(pointsto) ;
break ;
case TO_LS :
continue_after_this = ls_is_chained(pointsto) ;
ls_set_unchained(pointsto) ;
break ;
case TO_TR :
continue_after_this = tr_is_chained(pointsto) ;
tr_set_unchained(pointsto) ;
break ;
case TO_CP :
continue_after_this = cp_is_chained(pointsto) ;
cp_set_unchained(pointsto) ;
break ;
default :
xsb_exit("pointsto wrong space error during unchaining");
break;
}
*hptr = *pointsto ;
switch (tag) {
case XSB_REF:
case XSB_REF1:
*pointsto = (Cell)destination ;
break ;
case XSB_STRUCT :
*pointsto = makecs((Cell)destination) ;
break ;
case XSB_LIST :
*pointsto = makelist((Cell)destination) ;
break ;
case XSB_ATTV :
*pointsto = makeattv((Cell)destination);
break;
default :
xsb_exit("tag error during unchaining") ;
}
}
while (continue_after_this) ;
} /* unchain */
/*----------------------------------------------------------------------*/
inline static void swap_with_tag(CPtr p, CPtr q, int tag)
{ /* p points to a cell with contents a tagged pointer
make *q = p + tag, but maybe shift p
*/
*p = *q ;
switch (tag) {
case XSB_REF:
case XSB_REF1:
*q = (Cell)p ;
break ;
case XSB_STRUCT :
*q = makecs((Cell)p) ;
break ;
case XSB_LIST :
*q = makelist((Cell)p) ;
break ;
case XSB_ATTV :
*q = makeattv((Cell)p);
break;
default : xsb_exit("error during swap_with_tag") ;
}
} /* swap_with_tag */
#endif /* GC */
/*----------------------------------------------------------------------*/
/*
slide_heap: implements a sliding collector for the heap
see: Algorithm of Morris / ACM paper by Appleby et al.
num_marked = number of marked heap cells
the relevant argument registers have been moved to the top
of the heap prior to marking
*/
#ifdef INDIRECTION_SLIDE
#define mem_swap(a,b) \
{ unsigned long temp; \
temp = *a; \
*a = *b; \
*b = temp; \
}
#define push_sort_stack(X,Y) \
addr_stack[stack_index] = X;\
size_stack[stack_index] = Y;\
stack_index++
#define pop_sort_stack(X,Y)\
stack_index--; \
X = addr_stack[stack_index]; \
Y = size_stack[stack_index]
#define sort_stack_empty \
(stack_index == 0)
static void randomize_data(unsigned long *data, unsigned long size)
{
unsigned long i,j;
for (i=0; i<size; i++) {
j = (unsigned long) rand()*(size-1)/RAND_MAX;
mem_swap((data+i), (data+j));
}
}
static void sort_buffer(unsigned long *indata, unsigned long insize)
{
unsigned long *left, *right, *pivot;
unsigned long *data, size;
unsigned long *addr_stack[4000];
unsigned long size_stack[4000];
int stack_index=0;
int leftsize;
#ifdef GC_PROFILE
unsigned long begin_sorting, end_sorting;
#endif
randomize_data(indata,insize);
#ifdef GC_PROFILE
if (verbose_gc)
begin_sorting = cpu_time();
#endif
push_sort_stack(indata,insize);
while (!sort_stack_empty) {
pop_sort_stack(data,size);
if (size < 1)
continue;
if (size == 1) {
if (data[0] > data[1])
mem_swap(data, (data+1));
continue;
}
left = data;
right = &data[size];
pivot = &data[size/2];
mem_swap(pivot, right);
pivot = right;
while (left < right) {
while ((*left < *pivot) && (left < right))
left++;
while ((*right >= *pivot) && (left < right))
right--;
if (left < right) {
mem_swap(left,right);
left++;
}
}
if (right == data) {
mem_swap(right, pivot);
right++;
}
leftsize = right - data;
if (leftsize >= 1)
push_sort_stack(data,leftsize);
if ((size-leftsize) >= 1)
push_sort_stack(right,(size-leftsize));
}
#ifdef GC_PROFILE
if (verbose_gc) {
end_sorting = cpu_time();
fprintf(stddbg,"{GC} Sorting took %f ms.\n", (double)
(end_sorting - begin_sorting)*1000/CLOCKS_PER_SEC);
}
#endif
}
#endif
#ifdef GC
static CPtr slide_heap(int num_marked)
{
int tag ;
Cell contents;
CPtr p, q ;
/* chain external (to heap) pointers */
/* chain argument registers */
/* will be automatic as aregisters were copied to the heap */
/* chain trail */
/* more precise traversal of trail possible */
{ CPtr endtr ;
endtr = tr_top ;
for (p = tr_bot; p <= endtr ; p++ )
{ contents = cell(p) ;
#ifdef SLG_GC
if (!tr_marked(p-tr_bot))
continue;
tr_clear_mark(p-tr_bot);
#endif
q = hp_pointer_from_cell(contents,&tag) ;
if (!q) continue ;
if (! h_marked(q-heap_bot)) {
continue ;
}
if (h_is_chained(q)) tr_set_chained(p) ;
h_set_chained(q) ;
swap_with_tag(p,q,tag) ;
}
}
/* chain choicepoints */
/* more precise traversal of choice points possible */
{ CPtr endcp ;
endcp = cp_top ;
for (p = cp_bot; p >= endcp ; p--)
{ contents = cell(p) ;
q = hp_pointer_from_cell(contents,&tag) ;
if (!q) continue ;
if (! h_marked(q-heap_bot))
{ xsb_dbgmsg((LOG_DEBUG, "not marked from cp(%p)",p)); continue ; }
if (h_is_chained(q)) cp_set_chained(p) ;
h_set_chained(q) ;
swap_with_tag(p,q,tag) ;
}
}
/* chain local stack */
/* more precise traversal of local stack possible */
{ CPtr endls ;
endls = ls_top ;
for (p = ls_bot; p >= endls ; p-- )
{
if (! ls_marked(p-ls_top)) continue ;
ls_clear_mark((p-ls_top)) ; /* chain bit cannot be on yet */
contents = cell(p) ;
q = hp_pointer_from_cell(contents,&tag) ;
if (!q) continue ;
if (! h_marked(q-heap_bot)) continue ;
if (h_is_chained(q)) ls_set_chained(p) ;
h_set_chained(q) ;
swap_with_tag(p,q,tag) ;
}
}
/* if (print_on_gc) print_all_stacks() ; */
{ CPtr destination, hptr ;
long garbage = 0 ;
int index ;
/* one phase upwards - from top of heap to bottom of heap */
index = heap_top - heap_bot ;
destination = heap_bot + num_marked - 1 ;
#ifdef INDIRECTION_SLIDE
if (slide_buffering) {
unsigned long i;
#ifdef GC_PROFILE
if (verbose_gc) {
fprintf(stddbg,"{GC} Using Fast-Slide scheme.\n");
}
#endif
/* sort the buffer */
sort_buffer((unsigned long *)slide_buf, slide_top-1);
/* upwards phase */
for (i=slide_top; i > 0; i--) {
hptr = slide_buf[i-1];
if (h_is_chained(hptr)) {
unchain(hptr,destination);
}
p = hp_pointer_from_cell(*hptr,&tag);
if (p &&(p<hptr)) {
swap_with_tag(hptr,p,tag);
if (h_is_chained(p))
h_set_chained(hptr);
else
h_set_chained(p);
}
destination--;
}
} else {
#ifdef GC_PROFILE
if (verbose_gc && flags[GARBAGE_COLLECT]==INDIRECTION_SLIDE_GC)
fprintf(stddbg,"{GC} Giving up Fast-Slide scheme.\n");
#endif
#endif /* INDIRECTION_SLIDE */
for (hptr = heap_top - 1 ; hptr >= heap_bot ; hptr--) {
if (h_marked(hptr - heap_bot)) {
/* boxing */
if (garbage) {
*(hptr+1) = makeint(garbage) ;
garbage = 0 ;
}
if (h_is_chained(hptr)) {
unchain(hptr,destination) ;
}
p = hp_pointer_from_cell(*hptr,&tag) ;
if (p && (p < hptr)) {
swap_with_tag(hptr,p,tag) ;
if (h_is_chained(p))
h_set_chained(hptr) ;
else
h_set_chained(p) ;
}
destination-- ;
}
else
garbage++ ;
index-- ;
}
#ifdef INDIRECTION_SLIDE
}
if (!slide_buffering)
#endif
if (garbage)
/* the first heap cell is not marked */
*heap_bot = makeint(garbage) ;
/* one phase downwards - from bottom of heap to top of heap */
index = 0 ;
destination = heap_bot ;
#ifdef INDIRECTION_SLIDE
if (slide_buffering) {
unsigned long i;
for (i=0; i<slide_top; i++) {
hptr = slide_buf[i];
if (h_is_chained(hptr)) {
unchain(hptr,destination);
}
if ((Cell)(hptr) == *hptr) /* undef */
bld_free(destination);
else {
p = hp_pointer_from_cell(*hptr,&tag);
*destination = *hptr;
if (p && (p > hptr)) {
swap_with_tag(destination,p,tag);
if (h_is_chained(p))
h_set_chained(destination);
else
h_set_chained(p);
}
h_clear_mark((hptr-heap_bot));
}
destination++;
}
} else {
#endif /* INDIRECTION_SLIDE */
hptr = heap_bot;
while (hptr < heap_top) {
if (h_marked(hptr - heap_bot)) {
if (h_is_chained(hptr))
{ unchain(hptr,destination) ; }
if ((Cell)(hptr) == *hptr) /* UNDEF */
bld_free(destination) ;
else {
p = hp_pointer_from_cell(*hptr,&tag) ;
*destination = *hptr ;
if (p && (p > hptr)) {
swap_with_tag(destination,p,tag) ;
if (h_is_chained(p))
h_set_chained(destination) ;
else
h_set_chained(p) ;
}
}
h_clear_mark((hptr-heap_bot)) ;
hptr++ ; destination++ ;
index++ ;
} else {
garbage = int_val(cell(hptr)) ;
index += garbage ;
hptr += garbage ;
}
}
if (destination != (heap_bot+num_marked))
xsb_dbgmsg((LOG_DEBUG, "bad size %p %p",
destination,heap_bot+num_marked));
#ifdef INDIRECTION_SLIDE
}
#endif
}
#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
return(heap_bot + num_marked) ;
} /* slide_heap */
static void check_zero(char *b, int l, char *s)
{
#ifdef SAFE_GC
int i = 0 ;
while (l--)
{
if (*b++)
xsb_dbgmsg((LOG_DEBUG, "%s - left marker - %d - %d - %d", s,*(b-1),i,l));
i++ ;
}
#endif
} /* check_zero */
#endif
/*=======================================================================*/
syntax highlighted by Code2HTML, v. 0.9.1