/* File:      gc_mark.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_mark.h,v 1.3 2002/02/26 18:22:07 lfcastro Exp $
** 
*/

#ifdef INDIRECTION_SLIDE
#define TO_BUFFER(ptr) \
{ \
  if (slide_buffering) { \
    slide_buf[slide_top] = ptr; \
    slide_top++; \
    slide_buffering = slide_top <= slide_buf_size; \
  } \
}
#else
#define TO_BUFFER(ptr)
#endif

#ifdef GC_PROFILE
#define h_mark(i) \
do { \
  CPtr cell_ptr; int place;\
  place = i;\
  cell_ptr = (CPtr) heap_bot + place;\
  inspect_ptr(cell_ptr);  \
  heap_marks[place] |= MARKED;\
} while (0)
#else
#define h_mark(i)          heap_marks[i] |= MARKED
#endif

#define h_marked(i)        (heap_marks[i])
#define h_clear_mark(i)	   heap_marks[i] &= ~MARKED

#define ls_marked(i)       (ls_marks[i])
#ifdef GC_PROFILE
#define ls_mark(i)         \
do { \
  int tag, place; \
  CPtr ptr; \
  place = i; \
  ptr = (CPtr) ls_top + place; \
  tag = cell_tag(*ptr); \
  inspect_chain(ptr); \
  ls_marks[place] |= MARKED; \
} while (0)
#else
#define ls_mark(i)         ls_marks[i] |= MARKED
#endif
#define ls_clear_mark(i)   ls_marks[i] = 0

#ifndef CHAT
#define tr_marked(i)         (tr_marks[i])
#define tr_mark(i)           tr_marks[i] |= MARKED
#define tr_clear_mark(i)     tr_marks[i] &= ~MARKED
#define tr_mark_pre(i)       tr_marks[i] |= TRAIL_PRE
#define tr_clear_pre_mark(i) tr_marks[i] &= ~TRAIL_PRE
#define tr_pre_marked(i)     (tr_marks[i] & TRAIL_PRE)

#define cp_marked(i)       (cp_marks[i])
#define cp_mark(i)         cp_marks[i] |= MARKED
#define cp_clear_mark(i)   cp_marks[i] &= ~MARKED
#endif 

/*=========================================================================*/

#ifdef GC
inline static CPtr hp_pointer_from_cell(Cell cell, int *tag)
{
  int t;
  CPtr retp;

  t = cell_tag(cell) ;

  /* the use of if-tests rather than a switch is for efficiency ! */
  /* as this function is very heavily used - do not modify */
  if (t == XSB_LIST)
    {
      *tag = XSB_LIST;
      retp = clref_val(cell);
      testreturnit(retp);
    }
  if (t == XSB_STRUCT)
    {
      *tag = XSB_STRUCT;
      retp = (CPtr)(cs_val(cell));
      testreturnit(retp);
    }
  if ((t == XSB_REF) || (t == XSB_REF1))
    {
      *tag = t;
      retp = (CPtr)cell ;
      if (points_into_heap(retp)) return(retp);
    }
  if (t == XSB_ATTV)
    {
      *tag = XSB_ATTV;
      retp = clref_val(cell);
      testreturnit(retp);
    }

  return NULL;
} /* hp_pointer_from_cell */
#endif

static CPtr pointer_from_cell(Cell cell, int *tag, int *whereto)
{ int t ;
 CPtr retp ;

 *tag = t = cell_tag(cell) ;
 switch (t)
   {
   case XSB_REF:
   case XSB_REF1: 
     retp = (CPtr)cell ;
     break ;
   case XSB_LIST: 
   case XSB_ATTV:
     retp = clref_val(cell) ;
     break ;
   case XSB_STRUCT:
     retp = ((CPtr)(cs_val(cell))) ;
     break ;
   default:
     *whereto = TO_NOWHERE ;
     return((CPtr)cell) ;
   }

 if (points_into_heap(retp)) *whereto = TO_HEAP ;
 else
   if (points_into_tr(retp)) *whereto = TO_TR ;
   else
     if (points_into_ls(retp)) *whereto = TO_LS ;
     else
       if (points_into_cp(retp)) *whereto = TO_CP ;
       else
	 if (points_into_compl(retp)) *whereto = TO_COMPL ;
	 else *whereto = TO_NOWHERE ;
 return(retp) ;

} /* pointer_from_cell */

/*-------------------------------------------------------------------------*/

inline static char * pr_h_marked(CPtr cell_ptr)
{ int i ;
 i = cell_ptr - heap_bot ;
 if (heap_marks == NULL) return("not_m") ;
 if (h_marked(i) == MARKED) return("marked") ;
 if (h_marked(i) == CHAIN_BIT) return("chained") ;
 if (h_marked(i) == (CHAIN_BIT | MARKED)) return("chained+marked") ;
 return("not_m") ;
} /* pr_h_marked */

inline static char * pr_ls_marked(CPtr cell_ptr) 
{ int i ; 
 i = cell_ptr - ls_top ;
 if (ls_marks == NULL) return("not_m") ;
 if (ls_marked(i) == MARKED) return("marked") ;
 if (ls_marked(i) == CHAIN_BIT) return("chained") ;
 if (ls_marked(i) == (CHAIN_BIT | MARKED)) return("chained+marked") ;
 return("not_m") ; 
} /* pr_ls_marked */ 

inline static char * pr_cp_marked(CPtr cell_ptr) 
{ int i ; 
 i = cell_ptr - cp_top ;
 if (cp_marks == NULL) return("not_m") ;
#ifdef CHAT
 if (cp_marks[i]) return ("chained");
#else
 if (cp_marked(i) == MARKED) return("marked") ;
 if (cp_marked(i) == CHAIN_BIT) return("chained") ;
 if (cp_marked(i) == (CHAIN_BIT | MARKED)) return("chained+marked") ;
#endif
 return("not_m") ; 
} /* pr_cp_marked */ 

inline static char * pr_tr_marked(CPtr cell_ptr) 
{ int i ; 
 i = cell_ptr - tr_bot ;
 if (tr_marks == NULL) return("not_m") ;
#ifdef CHAT
 if (tr_marks[i]) return("chained");
#else
 if (tr_marked(i) == MARKED) return("marked") ;
 if (tr_marked(i) == CHAIN_BIT) return("chained") ;
 if (tr_marked(i) == (CHAIN_BIT | MARKED)) return("chained+marked") ;
 if (tr_marked(i) == (CHAIN_BIT | MARKED | TRAIL_PRE)) 
   return("chained+marked+pre");
#endif
 return("not_m") ; 
} /* pr_tr_marked */ 

/*-------------------------------------------------------------------------*/

/* Function mark_cell() keeps an explicit stack to perform marking.
   Marking without using such a stack, as in SICStus, should not be
   considered.  It is nice, but slower and more prone to errors.
   Recursive marking is the only alternative in my opinion, but one can
   construct too easily examples that overflow the C-stack - Bart Demoen.
*/

#define MAXS 3700
#define push_to_mark(p) mark_stack[mark_top++] = p
#define mark_overflow   (mark_top >= MAXS)

static int mark_cell(CPtr cell_ptr)
{
  CPtr p ;
  Cell cell_val ;
  int  i, m, arity, tag ;
  int  mark_top = 0 ;
  CPtr mark_stack[MAXS+MAX_ARITY+1] ;

  m = 0 ;
 mark_more:
  if (!points_into_heap(cell_ptr)) /* defensive marking */
    goto pop_more ;
 safe_mark_more:
  i = cell_ptr - heap_bot ;
  if (h_marked(i)) goto pop_more ;
  TO_BUFFER(cell_ptr);
  h_mark(i) ;
  m++ ;

  cell_val = *cell_ptr;
  tag = cell_tag(cell_val);


  if (tag == XSB_LIST || tag == XSB_ATTV)
    { cell_ptr = clref_val(cell_val) ;
    if (mark_overflow)
      { m += mark_cell(cell_ptr+1) ; }
    else push_to_mark(cell_ptr+1) ;
    goto safe_mark_more ;
    }

  if (tag == XSB_STRUCT)
    { p = (CPtr)cell_val ;
    cell_ptr = ((CPtr)(cs_val(cell_val))) ;
    i = cell_ptr - heap_bot ;
    if (h_marked(i)) goto pop_more ;
    TO_BUFFER(cell_ptr);
    h_mark(i) ; m++ ;
    cell_val = *cell_ptr;
    arity = get_arity((Psc)(cell_val)) ;
    p = ++cell_ptr ;
    if (mark_overflow)
      { while (--arity)
	{ m += mark_cell(++p) ; }
      }
    else while (--arity) push_to_mark(++p) ;
    goto mark_more ;
    }

  if ((tag == XSB_REF) || (tag == XSB_REF1))
    { p = (CPtr)cell_val ;
    if (p == cell_ptr) goto pop_more ;
    cell_ptr = p ;
    goto mark_more ;
    }

 pop_more:
  if (mark_top--)
    { cell_ptr = mark_stack[mark_top] ; goto mark_more ; }
  return(m) ;

} /* mark_cell */

/*----------------------------------------------------------------------*/

static int mark_root(Cell cell_val)
{
  int m, i, arity ;
  CPtr cell_ptr;
  int tag, whereto ;
  Cell v ;

  /* this is one of the places to be defensive while marking: an uninitialised
     cell in the ls can point to a Psc; the danger is not in following the Psc
     and mark something outside of the heap: mark_cell takes care of that; the
     dangerous thing is to mark the cell with the Psc on the heap without
     marking all its arguments */

  if (cell_val == 0) return(0) ;
  switch (cell_tag(cell_val))
    {
    case XSB_REF:
    case XSB_REF1:
      v = *(CPtr)cell_val ;
      pointer_from_cell(v,&tag,&whereto) ;
      switch (tag)
    	{ case XSB_REF: case XSB_REF1:
	  if (whereto != TO_HEAP) return(0) ;
	  break ;
    	}
      return(mark_cell((CPtr)cell_val)) ;

    case XSB_STRUCT : 
      cell_ptr = ((CPtr)(cs_val(cell_val))) ;
      if (!points_into_heap(cell_ptr)) return(0) ;
      i = cell_ptr - heap_bot ; 
      if (h_marked(i)) return(0) ; 
      /* now check that at i, there is a Psc */
      v = *cell_ptr ;
      pointer_from_cell(v,&tag,&whereto) ;
      /* v must be a PSC - the following tries to test this */
      switch (tag) {
      case XSB_REF: 
      case XSB_REF1 :
	if (whereto != TO_NOWHERE) return(0) ;
	break ;
	/* default: return(0); */
      }
      TO_BUFFER(cell_ptr);
      h_mark(i) ; m = 1 ; 
      cell_val = *cell_ptr;
      arity = get_arity((Psc)(cell_val)) ;
      while (arity--) m += mark_cell(++cell_ptr) ;
      return(m) ;
      
    case XSB_LIST: 
    case XSB_ATTV:
      /* the 2 cells will be marked iff neither of them is a Psc */
      cell_ptr = clref_val(cell_val) ;
      if (!points_into_heap(cell_ptr)) return(0) ;
      v = *cell_ptr ;
      pointer_from_cell(v,&tag,&whereto) ;
      switch (tag) {
      case XSB_REF:
      case XSB_REF1:
	if (whereto != TO_HEAP) return(0) ;
	break ;
      }
      v = *(++cell_ptr) ;
      pointer_from_cell(v,&tag,&whereto) ;
      switch (tag) {
      case XSB_REF:
      case XSB_REF1:
	if (whereto != TO_HEAP) return(0) ;
	break ;
      }
      m = mark_cell(cell_ptr) ;
      cell_ptr-- ; 
      m += mark_cell(cell_ptr) ;
      return(m) ;

    default : return(0) ;
    }

} /* mark_root */

/*----------------------------------------------------------------------*/

inline static int mark_region(CPtr beginp, CPtr endp)
{
  int marked = 0 ;

  while (beginp <= endp) {
    marked += mark_root(*(beginp++)) ;
  }

  return(marked) ;
} /* mark_region */

/*----------------------------------------------------------------------*/
#ifdef CHAT
inline static unsigned long mark_trail_section(CPtr begintr, CPtr endtr)
{
  CPtr a = begintr;
  CPtr trailed_cell;
  unsigned long i=0, marked=0;

  while (a-- > (CPtr)endtr)
    { /* a[0] == & trailed cell */
      trailed_cell = (CPtr)a[0] ;
      if (points_into_heap(trailed_cell))
	{ i = trailed_cell - heap_bot ;
	if (! h_marked(i))
	  {
#if (EARLY_RESET == 1)
	    {
	      /* instead of marking the word in the heap, 
		 we make the trail cell point to itself */
	      TO_BUFFER(trailed_cell);
	      h_mark(i) ;
	      marked++ ;
	      bld_free(trailed_cell); /* early reset */
	      /* could do trail compaction now or later */
	      heap_early_reset++;
	    }
#else
	    {
	      marked += mark_root((Cell)trailed_cell);
	    }
#endif
	  }
	}
      else
	/* it must be a ls pointer, but for safety
	   we take into account between_h_ls */
	if (points_into_ls(trailed_cell))
	  { i = trailed_cell - ls_top ;
	  if (! ls_marked(i))
	    {
#if (EARLY_RESET == 1)
	      {
		/* don't ls_mark(i) because we early reset
		   so, it is not a heap pointer
		   but marking would be correct */
		bld_free(trailed_cell) ; /* early reset */
		/* could do trail compaction now or later */
		ls_early_reset++;
	      }
#else
	      { ls_mark(i) ;
	      marked += mark_region(trailed_cell,trailed_cell);
	      }
#endif
	    }
	  }
    }
  return marked;
}
#else
inline static unsigned long mark_trail_section(CPtr begintr, CPtr endtr)
{
  CPtr a = begintr;
  CPtr trailed_cell;
  unsigned long i=0, marked=0;
#ifdef PRE_IMAGE_TRAIL
  CPtr pre_value = NULL;
#endif
  
  while (a > (CPtr)endtr)
    { 
      tr_mark(a - tr_bot); /* mark trail cell as visited */
      /* lfcastro -- needed for copying */
      tr_mark((a-tr_bot)-1);
      tr_mark((a-tr_bot)-2);

      trailed_cell = (CPtr) *(a-2);
#ifdef PRE_IMAGE_TRAIL
      if ((long) trailed_cell & PRE_IMAGE_MARK) {
	trailed_cell = (CPtr) ((Cell) trailed_cell & ~PRE_IMAGE_MARK);
	pre_value = (CPtr) *(a-3);
	tr_mark_pre((a-tr_bot)-2); /* mark somewhere else */
	*(a-2) = ((Cell)trailed_cell & ~PRE_IMAGE_MARK); /* and delete mark */
      /* lfcastro -- needed for copying */
	tr_mark((a-tr_bot)-3);
      }
#endif
      
      if (points_into_heap(trailed_cell))
	{ i = trailed_cell - heap_bot ;
	if (! h_marked(i))
	  {
#if (EARLY_RESET == 1)
	    {
	      /* instead of marking the word in the heap, 
		 we make the trail cell point to itself */
	      TO_BUFFER(trailed_cell);
	      h_mark(i) ;
	      marked++ ;
	      
#ifdef PRE_IMAGE_TRAIL
	      if (pre_value) 
		*trailed_cell = (Cell) pre_value;
	      else
#endif
		bld_free(trailed_cell); /* early reset */
	      
	      /* could do trail compaction now or later */
	      heap_early_reset++;
	    }
#else
	    {
	      marked += mark_root((Cell)trailed_cell);
	    }
#endif
	    
	  }
	}
      else
	/* it must be a ls pointer, but for safety
	   we take into account between_h_ls */
	if (points_into_ls(trailed_cell))
	  { i = trailed_cell - ls_top ;
	  if (! ls_marked(i))
	    {
#if (EARLY_RESET == 1)
	      {
		/* don't ls_mark(i) because we early reset
		   so, it is not a heap pointer
		   but marking would be correct */
#ifdef PRE_IMAGE_TRAIL
		if (pre_value)
		  *trailed_cell = (Cell) pre_value;
		else
#endif
		  bld_free(trailed_cell) ; /* early reset */
		
		/* could do trail compaction now or later */
		ls_early_reset++;
	      }
#else
	      { ls_mark(i) ;
	      marked += mark_region(trailed_cell, trailed_cell);
	      }
#endif
	    }
	  }
      
      /* mark the forward value */
      marked += mark_root((Cell) *(a-1));
      
#ifdef PRE_IMAGE_TRAIL
      if (pre_value) { 
	marked += mark_root((Cell) pre_value);
	pre_value = NULL;
      }
#endif

      /* stop if we're not going anywhere */
      if ((unsigned long) a == (unsigned long) *a)
	break;

      /* jump to previous cell */
      a = (CPtr) *a;
    }
  return marked;
}
#endif
/*----------------------------------------------------------------------*/

static int mark_query(void)
{
  int yvar, i, total_marked = 0 ;
  CPtr b,e,*tr,a,d;
  byte *cp;
  int first_time;

  b = breg ;
  e = ereg ;
  tr = trreg ;
  cp = cpreg ;
  first_time = 1;

restart:
  while (1)
    {
      while ((e < ls_bot) && (cp != NULL))
	{
	  if (ls_marked(e - ls_top)) break ;
	  ls_mark(e - ls_top) ;
	  yvar = *(cp-2*sizeof(Cell)+3) - 1 ;
	  total_marked += mark_region(e-yvar,e-2) ;
	  i = (e-2) - ls_top ;
	  while (yvar-- > 1) { ls_mark(i--); }
	  cp = (byte *)e[-1] ;
	  e = (CPtr)e[0] ;
	}
      if (b >= (cp_bot-CP_SIZE)) {
	return(total_marked) ;
      }
      a = (CPtr)tr ;
      tr = cp_trreg(b) ;

      /* the answer template is part of the forward computation for 
	 consumers, so it should be marked before the trail in order
	 to allow for early reset                      --lfcastro */
      
      if (is_generator_choicepoint(b)) {
	CPtr region;
	int at_size;
	region = (CPtr) tcp_template(b);
	at_size = (int_val(cell(region)) & 0xffff) + 1;
	while (at_size--)
	  total_marked += mark_cell(region--);
      } else if (is_consumer_choicepoint(b)) {
	CPtr region;
	int at_size;
	region = (CPtr) nlcp_template(b);
	at_size = (int_val(cell(region))&0xffff)+1;
	while (at_size--)
	  total_marked += mark_cell(region--);
      }

      /* mark the delay list field of all choice points in CP stack too */
      if ((d = cp_pdreg(b)) != NULL) {
	total_marked += mark_root((Cell)d);
      }

      total_marked += mark_trail_section(a,(CPtr) tr);

      /* mark the arguments in the choicepoint */
      /* the choicepoint can be a consumer, a generator or ... */

      /* the code for non-tabled choice points is ok */
      /* for all other cps - check that
	 (1) the saved arguments are marked
	 (2) the substitution factor is marked
      */

      if (is_generator_choicepoint(b))
	{ /* mark the arguments */
#ifdef CHAT
	  total_marked += mark_region(b+TCP_SIZE,tcp_prevbreg(b)-1);
	  /* mark the substitution factor later */
#else
	  total_marked += mark_region(b+TCP_SIZE, tcp_prevtop(b)-1);
#endif
	}
      else if (is_consumer_choicepoint(b))
	{ /* mark substitution factor -- skip the number of SF vars */
	  /* substitution factor is in the choicepoint for consumers */
#ifdef SLG_GC
	  if (nlcp_prevtop(b) != b+NLCP_SIZE) {
	    /* this was a producer that was backtracked over --lfcastro */
	    /* mark the arguments, since chaining & copying consider them */
	    CPtr ptr;
	    for (ptr = b+NLCP_SIZE; ptr < nlcp_prevtop(b); ptr++)
	      *ptr = makeint(6660666);
/* 	    total_marked += mark_region(b+NLCP_SIZE, nlcp_prevtop(b)-1); */
	  } 

#endif
	}
      else if (is_compl_susp_frame(b)) 
	/* there is nothing to do in this case */ ;
      else { 
	CPtr endregion, beginregion;
#ifdef CHAT
	endregion = cp_prevbreg(b)-1;
#else
	endregion = cp_prevtop(b)-1;
#endif
	beginregion = b+CP_SIZE;
	total_marked += mark_region(beginregion,endregion) ;

      }

      e = cp_ereg(b) ;
      cp = cp_cpreg(b) ;
#if defined(GC_PROFILE) && defined(CP_DEBUG)
      if (examine_data) {
	print_cpf_pred(b);
	active_cps++;
      }
#endif
#ifdef CHAT
      b = cp_prevbreg(b) ;
#else
      if (first_time) {
	first_time = 0;
	if (bfreg < breg) {
	  b = bfreg;
	  e = cp_ereg(b);
	  cp = cp_cpreg(b);
	  tr = cp_trreg(b);
	  goto restart;
	}
      }

      b = cp_prevtop(b);
#endif
    }

} /* mark_query */

/*----------------------------------------------------------------------*/

#ifdef CHAT

static int chat_mark_trail(CPtr *tr, int trlen)
{
  int  i, j, m = 0;
  CPtr trailed_cell;

  /* mark trail: both address and value - do cautious early reset */

  while (trlen)
    { 
      if (trlen > sizeof(CPtr))
	{ trlen -= sizeof(CPtr); j = sizeof(CPtr)>>1 ; }
      else { j = trlen>>1; trlen = 0; }
      while (j--)
	{ 
	  /* mark address */
	  trailed_cell = *tr;
	  tr++;
	  if (points_into_heap(trailed_cell))
	    { i = trailed_cell - heap_bot ;
	    if (! h_marked(i))
	      { TO_BUFFER(trailed_cell);
		h_mark(i) ; /* it is correct to mark this cell, because the
			       value is also marked
			       avoiding to mark the cell would make chat
			       trail compaction necessary
			    */
#if (EARLY_RESET == 1)
	      *tr = (CPtr)makeint(88888);
	      heap_early_reset++;
#endif
	      m++ ;
	      }
	    }
	  else
	    /* it must be a ls pointer, but we check between_h_ls */
	    if (points_into_ls(trailed_cell))
	      { i = trailed_cell - ls_top ;
	      if (! ls_marked(i))
		{
		  /* it is possible to come here:
		     in SLG-WAM (and CHAT) there might exist envs
		     that are not reachable from anywhere and some
		     CHAT trail pointer might point into it
		     as example (maybe not simplest):
		     :- table g/1.

		     g(X) :- a, g(Y).
		     g(_) :- gc_heap.

		     a :- b(X), p(X), use(X).
		       
		     p(17).
		       
		     use(_).
		       
		     b(_).
		     b(_) :- fail.
		  */
#if (EARLY_RESET == 1)
		  *tr = (CPtr)makeint(99999);
		  ls_early_reset++;
#endif
		}
	      }

	  /* mark value */
	  m += mark_root((Cell)(*tr));
	  tr++;
	}
      tr++; /* skip chain bits */
    }

  return m;
} /* chat_mark_trail */

static int chat_mark_region(CPtr b, int len)
{
  int j, m = 0;

  while (len)
    {
      if (len > sizeof(CPtr))
        { len -= sizeof(CPtr); j = sizeof(CPtr) ; }
      else { j = len; len = 0; }
      while (j--)
        {
          m += mark_root(*b);
          b++;
        }
      b++; /* skip chain bits */
    }

  return m; 
} /* chat_mark_region */

static int chat_mark_answer_template_area(CPtr b, int len)
{
  int j, m = 0;
  while (len) {
    if (len > sizeof(CPtr)) {
      len -= sizeof(CPtr);
      j = sizeof(CPtr);
    } else {
      j = len;
      len = 0; 
    }
    while (j--) {
      CPtr region; /* special marking for answer templates on heap */
      int at_size;
      region = *b;
      at_size = (int_val(cell(region)) & 0xffff) + 1;
      while (at_size--) 
	m += mark_cell(region--);
      b++;
    }
    b++; /* skip chain bits */
  }
  return m;
}

/*-------------------------------------------------------------------------
chat_mark_frozen_parts: see ISMM'98 paper for more understanding
for CHAT it means:
         mark the environment chain starting from the consumer
	 then mark the trail in the chat areas of this consumer
	          but be careful with early reset
	 since the failure continuations of a consumer are always also
	 failure continuations of the active computation, there is no
	 need to mark the failure continuations of the consumer
  -------------------------------------------------------------------------*/

static int chat_mark_frozen_parts(int *avail_dreg_marks)
{
  int  m, i, trlen, yvar;
  chat_init_pheader initial_pheader;
  chat_incr_pheader pheader;
  CPtr b, e, d, *tr;
  byte *cp;

  m = 0;
  initial_pheader = chat_link_headers;

  /* mark answer template special area  --lfcastro */
  m += chat_mark_answer_template_area(at_start, at_area_size);


  if (initial_pheader != NULL)
    do
      {
#ifdef GC_PROFILE
	if (examine_data)
	  frozen_cps++;
#endif
	/* marking of heap pointer from consumer is unnecessary */
	/* as consumer gets hreg from its scheduling generator  */

	/* mark from the consumer the environment chain */
	/* it is enough to do that until the e of the leader of the consumer */
	/* we do it all the way up for now */

	b = (CPtr)(&chat_get_cons_start(initial_pheader));
	e = cp_ereg(b);
	cp = cp_cpreg(b);

	/* mark the delay list field of choice points too */
	if ((d = cp_pdreg(b)) != NULL) {
	  if (slide) {
	    if (*avail_dreg_marks > 0) {
	      *avail_dreg_marks -= 1;
	      *hreg = (Cell)d;
	      heap_top++;
	      m += mark_root((Cell)d)+1; /* +1 because of the following line */
	      TO_BUFFER(hreg);
	      h_mark(hreg-heap_bot) ;
	      hreg++;
	    } else xsb_exit("Fatal: no heap space to mark Dreg of CHAT areas");
	  }
	  else {
	    m += mark_root((Cell)d);
	  }
	}

	while ((e < ls_bot) && (cp != NULL))
	  {
	    if (ls_marked(e - ls_top)) break ;
	    ls_mark(e - ls_top) ;
	    yvar = *(cp-2*sizeof(Cell)+3) - 1 ;
	    m += mark_region(e-yvar,e-2) ;
	    i = (e-2) - ls_top ;
	    while (yvar-- > 1) ls_mark(i--) ;
	    cp = (byte *)e[-1] ;
	    e = (CPtr)e[0] ;
	  }

	initial_pheader = initial_pheader->next_header;
      }
    while (initial_pheader != chat_link_headers);

  initial_pheader = chat_link_headers;
  if (initial_pheader != NULL)
    do
      { /* now mark the CHAT trails */
	pheader = chat_get_father(initial_pheader);
	while ((pheader != NULL) && (! chat_area_imarked(pheader)))
	  {
	    chat_imark_area(pheader);
	    tr = chat_get_tr_start(pheader);
	    trlen = chat_get_tr_length(pheader);
	    m += chat_mark_trail(tr,trlen);

	    pheader = chat_get_ifather(pheader);
	  }
	initial_pheader = initial_pheader->next_header;
      }
    while (initial_pheader != chat_link_headers);


  return m;

} /* chat_mark_frozen_parts */

/*-------------------------------------------------------------------------*/

static int chat_mark_substitution_factor(void)
{
  CPtr compl_fr;
  VariantSF subg_ptr;
  CPtr region_to_mark, d;
  int  CallNumVar, m = 0;

  /* mark the substitution factor starting from the completion stack */
  compl_fr = openreg;
  while (compl_fr != COMPLSTACKBOTTOM)
    {
      /* substitution factor is now in the heap for generators */
      region_to_mark = compl_hreg(compl_fr);
      /* `+ 1': mark the Num too */
      CallNumVar = (int_val(cell(region_to_mark)) & 0xffff) + 1;
      while (CallNumVar--)
	m += mark_cell(region_to_mark--);

      /* we also need to mark the Dreg fields of those generator
         choice points that have been reclaimed from the CP stack */
      subg_ptr = compl_subgoal_ptr(compl_fr);
      if ((subg_cp_ptr(subg_ptr) == NULL) /* not in the CP stack anymore */ &&
	  (! is_completed(subg_ptr))) {
	if ((d = compl_pdreg(compl_fr)) != NULL) {
	  m += mark_root((Cell)d);
	}
      }
      compl_fr = prev_compl_frame(compl_fr);
    }
  return m;

} /* chat_mark_substitution_factor */

#endif

/*-------------------------------------------------------------------------*/

static int mark_hreg_from_choicepoints(void)
{
  CPtr b, bprev, h;
  int  i, m;

  /* this has to happen after all other marking ! */
  /* actually there is no need to do this for a copying collector */

#ifdef CHAT
  b = breg;
#else
  b = (bfreg < breg ? bfreg : breg);
#endif
  bprev = 0;
  m = 0;
#ifdef CHAT
  while (b != bprev) 
#else
    while(1)
#endif
     {
      h = cp_hreg(b) ;
      i = h - heap_bot ;
      if (! h_marked(i)) /* h from choicepoint should point to something that
			    is marked; if not, mark it now and set it
			    to something reasonable - int(666) is ok
			    although a bit scary :-)
			 */
	{
	  cell(h) = makeint(666) ;
	  TO_BUFFER(h);
	  h_mark(i) ;
	  m++ ;
	}
#ifdef SLG_GC
      /* should mark hfreg for generators, too --lfcastro */
      if (is_generator_choicepoint(b)) {
	h = tcp_hfreg(b);
	i = h - heap_bot;
	if (! h_marked(i)) {
	  cell(h) = makeint(6660);
	  TO_BUFFER(h);
	  h_mark(i);
	  m++;
	}
      }
#endif
      bprev = b; 
#ifdef CHAT
    b = cp_prevbreg(b);
#else
    b = cp_prevtop(b);
    if (b >= (cp_bot-CP_SIZE))
      break;
#endif
  }
  return m;
} /* mark_hreg_from_choicepoints */

/*-------------------------------------------------------------------------*/

/**
 * mark_from_attv_array: marks reachable cells from the attributed variables 
 *                       interrupt chain.
 * 
 * 
 * Return value: number of marked cells.
 **/
static int mark_from_attv_array()
{
  int i,max;
  int m=0;

  max = int_val(cell(interrupt_reg));

  for (i=0; i<max; i++) {
    m += mark_cell((CPtr) attv_interrupts[i][0]);
    m += mark_cell((CPtr) attv_interrupts[i][1]);
  }
  return m;
}

/*-------------------------------------------------------------------------*/


int mark_heap(int arity, int *marked_dregs)
{
  int avail_dreg_marks = 0, marked = 0;

  /* the following seems unnecessary, but it is not !
     mark_heap() may be called directly and not only through gc_heap() */
  slide = (flags[GARBAGE_COLLECT] == SLIDING_GC) |
    (flags[GARBAGE_COLLECT] == INDIRECTION_SLIDE_GC);
  
  stack_boundaries ;
  
  if (print_on_gc) print_all_stacks(arity);
  
  if (slide) {
#ifdef CHAT
    avail_dreg_marks = MAX_DREG_MARKS;
    /* here allocate EXACT amount for completion stack: not upper bound */
    compl_marks = (char *)calloc(compl_bot - top_of_complstk,1);
    if (! compl_marks)
      xsb_exit("Not enough core to allocate chain bits for completion stack");
#endif
#ifdef INDIRECTION_SLIDE
    /* space for keeping pointers to live data */
    slide_buf_size = (hreg+1-(CPtr)glstack.low)*0.2;
    slide_buf = (CPtr *) calloc(slide_buf_size+1, sizeof(CPtr));
    if (!slide_buf)
      xsb_exit("Not enough space to allocate slide_buf");
    slide_top=0;
    if (flags[GARBAGE_COLLECT] == INDIRECTION_SLIDE_GC)
      slide_buffering=1;
    else
      slide_buffering=0;
#endif
#ifdef CHAT
    /* these areas are not used in a copying collector */
    cp_marks = (char *)calloc(cp_bot - cp_top + 1,1);
    tr_marks = (char *)calloc(tr_top - tr_bot + 1,1);
    if ((! cp_marks) || (! tr_marks))
      xsb_exit("Not enough core to perform garbage collection chaining phase");
#endif
  }
  
#ifdef INDIRECTION_SLIDE
  else
    slide_buffering=0;
#endif
  
#ifdef SLG_GC
  cp_marks = (char *)calloc(cp_bot - cp_top + 1,1);
  tr_marks = (char *)calloc(tr_top - tr_bot + 1,1);
  if ((! cp_marks) || (! tr_marks))
    xsb_exit("Not enough core to perform garbage collection chaining phase");
#endif  
  heap_marks = (char * )calloc(heap_top - heap_bot + 2 + avail_dreg_marks,1);
  ls_marks   = (char * )calloc(ls_bot - ls_top + 1,1);
  if ((! heap_marks) || (! ls_marks))
    xsb_exit("Not enough core to perform garbage collection marking phase");
  
  heap_marks += 1; /* see its free; also note that heap_marks[-1] = 0 is
		      needed for copying garbage collection see copy_block() */
  
  /* start marking phase */
  marked = mark_region(reg+1,reg+arity);
  if (delayreg != NULL) {
    marked += mark_root((Cell)delayreg);
  }
  
  if (slide)
    { 
      int put_on_heap;
      put_on_heap = arity;
      marked += put_on_heap;
      while (put_on_heap > 0) {
#ifdef SLG_GC
	TO_BUFFER((heap_top-put_on_heap-1));
	h_mark((heap_top - 1 - put_on_heap--)-heap_bot);
#else
	TO_BUFFER((heap_top-put_on_heap));
	h_mark((heap_top - put_on_heap--)-heap_bot);
#endif
      }
    }

#ifdef SLG_GC
  /* hfreg's also kept in the heap so that it's automatically adjusted */
  /* only for sliding GC */
  if (slide) { 
    CPtr hfreg_in_heap;
    /* mark from hfreg */
    marked += mark_root((Cell)hfreg);
  
    hfreg_in_heap = heap_top - 1;
    TO_BUFFER(hfreg_in_heap);
    if (!h_marked(hfreg_in_heap - heap_bot)) {
      h_mark(hfreg_in_heap - heap_bot);
      marked++;
    }
  }
#endif


#ifdef CHAT
  marked += chat_mark_substitution_factor();
#endif

  marked += mark_query();

#ifdef CHAT
  marked += chat_mark_frozen_parts(&avail_dreg_marks);
  if (slide) *marked_dregs = MAX_DREG_MARKS - avail_dreg_marks;
  marked += mark_from_attv_array();
#else /* SLG_GC */
  marked += mark_from_attv_array();
#endif

  if (slide)
    marked += mark_hreg_from_choicepoints();

  if (print_on_gc) print_all_stacks(arity);

  return marked ;
} /* mark_heap */

