/src/spvw_garcol.d

Large files files are truncated, but you can click here to view the full file

/* Garbage collector. */

/* --------------------------- Specification --------------------------- */

/* Execute a simple garbage collection.
 can trigger GC */
local maygc void gar_col_simple (void);

/* Execute a full garbage collection.
 > level: if 1, also drop all jitc code
 can trigger GC */
global maygc void gar_col (int level);

#ifdef SPVW_PAGES
/* Supplement a simple garbage collection with a compacting.
 can trigger GC */
local maygc void gar_col_compact (void);
#endif

#if defined(SPVW_MIXED_BLOCKS_OPPOSITE) && RESERVE
/* Move the conses, to make a little more room. */
local void move_conses (sintM delta);
#endif

/* --------------------------- Implementation -------------------------- */

/* overall strategy:
 1. pseudo-recursive marking by setting of garcol_bit.
 2. relocate objects of fixed length (conses and similar),
    calculation of displacement of objects of variable length.
 3. update of pointers.
 4. perform the displacements of objects of variable length.
*/

#include "spvw_genera1.c"

/* marking-subroutine
 procedure: marking routine without stack usage (i.e.
  non-"recursive") by descent into the structure to be marked
  with pointer-modification (pointers are reversed,
  so that they can serve as "ariadne thread")
 Convention: an object X counts as marked, if
  - an object of variable length: bit garcol_bit,(X) is set
  - a two-pointer-object: bit garcol_bit,(X) is set
  - a SUBR/FSUBR: bit garcol_bit,(X+const_offset) is set
  - Character, Short-Float, Fixnum etc.: always. */

#if DEBUG_GC_MARK
  #define IF_DEBUG_GC_MARK(statement)  statement
  #if defined(WIDE_SOFT) || defined(WIDE_AUXI)
    /* oint is defined as uint64. */
    #define PRIoint "ll"
  #else
    /* oint is defined as uintP. Assume pointer_bitsize == long_bitsize. */
    #define PRIoint "l"
  #endif
#else
  #define IF_DEBUG_GC_MARK(statement)  /*nop*/
#endif

#define MARK(obj) mark(obj)
#include "spvw_gcmark.c"
#undef MARK

/* pack a pointer into an object, without  typeinfo.
 pointer_as_object(ptr): void* --> object
 pointer_was_object(obj): object --> void* */
  #ifdef TYPECODES
    #define pointer_as_object(ptr)  type_pointer_object(0,ptr)
    #define pointer_was_object(obj)  type_pointable(0,obj)
  #else
    #if defined(WIDE_AUXI)
      #define pointer_as_object(ptr)  as_object_with_auxi((aint)(ptr))
      #define pointer_was_object(obj)  ((void*)((obj).one_o))
    #else
      #define pointer_as_object(ptr)  as_object((oint)(ptr))
      #define pointer_was_object(obj)  ((void*)as_oint(obj))
    #endif
  #endif

/*  marking phase:
 All "active" structures are marked.
 everything is active, that is reachable
 - from the LISP-stack or
 - at Generational-GC: from the old generation or
 - as program-constant (the list of all packages belongs to this). */
local void gc_mark_stack (gcv_object_t* objptr)
{
  while (!eq(*objptr,nullobj)) { /* until STACK is finished: */
    IF_DEBUG_GC_MARK(fprintf(stderr,"gc_mark_stack: 0x%lx/%lu (%lu)\n",
                             objptr,objptr,as_oint(*objptr)));
    if (as_oint(*objptr) & wbit(frame_bit_o)) { /* does a frame start here? */
      if ((as_oint(*objptr) & wbit(skip2_bit_o)) == 0) /* without skip2-Bit? */
        objptr skipSTACKop 2; /* yes -> advance by 2 */
      else
        objptr skipSTACKop 1; /* no -> advance by 1 */
    } else { /* normal object, mark: */
      var object obj = *objptr;
     #ifndef NO_symbolflags
      switch (typecode(obj)) { /* poss. remove Symbol-flags */
        case_symbolflagged:
          obj = symbol_without_flags(obj);
        default: break;
      }
     #endif
      gc_mark(obj);
      objptr skipSTACKop 1; /* advance */
    }
  }
}

#include "spvw_genera2.c"

local void gc_markphase (void)
{
  /* Mark all the STACKs */
  for_all_STACKs(gc_mark_stack(objptr));
 #ifdef GENERATIONAL_GC
  /* mark old generation, whereas it is perused sparingly: */
  if (generation > 0) { gc_mark_old_generation(); }
 #endif
  /* mark all program constants: */
 #if !defined(GENERATIONAL_GC)
  for_all_subrs(gc_mark(subr_tab_ptr_as_object(ptr));); /* subr_tab */
  for_all_constsyms(gc_mark(symbol_tab_ptr_as_object(ptr));); /* symbol_tab */
 #else
  /* Because of the macro in_old_generation(), gc_mark() may regard all
     constant symbols and all subrs as belonging to the old generation and
     may not walk through their pointers recursively. So do it by hand. */
  for_all_subrs({ /* peruse subr_tab */
    gc_mark(ptr->name);
    gc_mark(ptr->keywords);
  });
  for_all_constsyms({ /* peruse symbol_tab */
    gc_mark(ptr->symvalue);
    gc_mark(ptr->symfunction);
    gc_mark(ptr->hashcode);
    gc_mark(ptr->proplist);
    gc_mark(ptr->pname);
    gc_mark(ptr->homepackage);
  });
 #endif
  for_all_constobjs( gc_mark(*objptr); ); /* object_tab */
  for_all_threadobjs( gc_mark(*objptr); ); /* threads */
  /* The callers in back_trace are mostly already marked:
     they refer to subrs and closures that are currently being
     called and therefore cannot possibly be garbage-collected.
     But a few remain unmarked, so make sure all are really marked: */
  for_all_back_traces({
    for (; bt != NULL; bt = bt->bt_next)
      gc_mark(bt->bt_function);
  });
}

/* UP: Determine, if an object is still "live".
 I.e. if the mark bit is set after the marking phase. */
local bool alive (object obj)
{
  #ifdef TYPECODES
  switch (typecode(obj)) {      /* according to type */
    case_pair:                  /* Cons */
      if (in_old_generation(obj,typecode(obj),1)) return true;
      if (marked(ThePointer(obj))) return true; else return false;
    case_symbol:                /* Symbol */
    case_array:                 /* Array */
    case_bignum:                /* Bignum */
    #ifndef IMMEDIATE_FFLOAT
    case_ffloat:                /* Single-Float */
    #endif
    case_dfloat:                /* Double-Float */
    case_lfloat:                /* Long-Float */
    case_record:                /* Record */
      if (in_old_generation(obj,typecode(obj),0)) return true;
      if (marked(ThePointer(obj))) return true; else return false;
    case_subr:                  /* Subr */
      if (marked(TheSubr(obj))) return true; else return false;
    case_machine:              /* Machine Pointer */
    case_char:                 /* Character */
    case_system:           /* Frame-pointer, Small-Read-label, system */
    case_fixnum:           /* Fixnum */
    case_sfloat:           /* Short-Float */
    #ifdef IMMEDIATE_FFLOAT
    case_ffloat:                /* Single-Float */
    #endif
      return true;
    default:
      /* these are no objects. */
      /*NOTREACHED*/ abort();
  }
  #else
  switch (as_oint(obj) & nonimmediate_heapcode_mask) {
    case varobject_bias+varobjects_misaligned:
      if (in_old_generation(obj,,0)) return true;
      if (marked(ThePointer(obj))) return true; else return false;
    case cons_bias+conses_misaligned:
      #ifdef STANDARD_HEAPCODES
      /* NB: (immediate_bias & nonimmediate_heapcode_mask) == cons_bias. */
      if (immediate_object_p(obj)) return true;
      #endif
      if (in_old_generation(obj,,1)) return true;
      if (marked(ThePointer(obj))) return true; else return false;
    #ifdef STANDARD_HEAPCODES
    case subr_bias:
      if (marked(TheSubr(obj))) return true; else return false;
    #endif
    default:
      return true;
  }
  #endif
}

#include "spvw_weak.c"

/* unmark SUBRs and fixed Symbols: */
local void unmark_fixed_varobjects (void)
{
  /* Even if defined(GENERATIONAL_GC), because the macro in_old_generation()
     has undefined behaviour for constsyms and subrs, therefore we don't know
     a priori whether the constsyms and subrs have their mark bit set. */
  for_all_subrs( unmark(&((Subr)ptr)->GCself); ); /* unmark each Subr */
  for_all_constsyms( unmark(&((Symbol)ptr)->GCself); ); /* unmark each Symbol in symbol_tab */
}

#if !defined(MORRIS_GC)

 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE

/* concentrate CONS-cells between page->page_start and page->page_end
   aloft: */
local void gc_compact_cons_page (Page* page)
{
  /* the pointer p1 moves from below and the pointer p2 from
   above through the memory region, while (!)they collide.
   Marked structures are moved above unmarked. */
  var aint p1 = page->page_start;               /* lower bound */
  var aint p2 = page->page_end;                 /* upper bound */
  sweeploop:
    /* search the next-higher unmarked cell <p2 and unmark all: */
    sweeploop1:
      if (p1==p2) goto sweepok2; /* bounds are equal -> finished */
      p2 -= sizeof(cons_);       /* capture next cell from above */
      if (marked(p2)) {          /* marked? */
        unmark(p2);              /* unmark */
        goto sweeploop1;
      }
    /* p1 <= p2, p2 points to an unmarked cell.
     search next lower marked cell >=p1: */
    sweeploop2:
      if (p1==p2) goto sweepok1; /* bounds are equal -> finished */
      if (!marked(p1)) {         /* unmarked? */
        p1 += sizeof(cons_);     /* at the next lower cell */
        goto sweeploop2;         /* continue search */
      }
    /* p1 < p2, p1 points to a marked cell. */
    unmark(p1);             /* unmark */
    /* copy content of cell into the unmark cell: */
    ((gcv_object_t*)p2)[0] = ((gcv_object_t*)p1)[0];
    ((gcv_object_t*)p2)[1] = ((gcv_object_t*)p1)[1];
    *(gcv_object_t*)p1 = pointer_as_object(p2); /* leave new addresse */
    mark(p1);          /* and mark (as identification for the update) */
    p1 += sizeof(cons_);         /* this cell is finished. */
    goto sweeploop;              /* continue */
  sweepok1: p1 += sizeof(cons_); /* skip last unmarked Cons */
  sweepok2:
  /* p1 = new lower bound of the Cons-region */
  page->page_start = p1;
}

 #else

/* concentrate CONS-cells between page->page_start and page->page_end
   below: */
local void gc_compact_cons_page (Page* page)
{
  /* the pointer p1 moves from below and the pointer p2 from
   above through the memory region, while (!)they collide.
   Marked structures are moved above unmarked. */
  var aint p1 = page->page_start;               /* lower bound */
  var aint p2 = page->page_end;                 /* upper bound */
  sweeploop:
    /* search next higher marked cell <p2: */
    sweeploop1:
      if (p1==p2) goto sweepok2; /* bounds are equal -> finished */
      p2 -= sizeof(cons_);       /* capture next cell from above */
      if (!marked(p2)) goto sweeploop1; /* unmarked? */
    /* p1 <= p2, p2 points to a marked cell. */
    unmark(p2);   /* unmark */
    /* search next lower unmarked cell >=p1 and unmark all: */
    sweeploop2:
      if (p1==p2) goto sweepok1; /* bounds are equal -> finished */
      if (marked(p1)) {          /* marked? */
        unmark(p1);              /* unmark */
        p1 += sizeof(cons_);     /* at next upper cell */
        goto sweeploop2;         /* continue search */
      }
    /* p1 < p2, p1 points to an unmarked cell.
     copy cell content from the marked into the unmark cell: */
    ((gcv_object_t*)p1)[0] = ((gcv_object_t*)p2)[0];
    ((gcv_object_t*)p1)[1] = ((gcv_object_t*)p2)[1];
    *(gcv_object_t*)p2 = pointer_as_object(p1); /* leave new address */
    mark(p2);              /* and mark (as identification for update) */
    p1 += sizeof(cons_);   /* this cell is finished. */
    goto sweeploop;        /* continue */
  sweepok1: p1 += sizeof(cons_); /* skip last marked Cons */
  sweepok2:
  /* p1 = new upper bound of the Cons-region */
  page->page_end = p1;
}

 #endif

#else  /* defined(MORRIS_GC) */

/* Algorithm see:
 [F. Lockwood Morris: A time- and space-efficient garbage collection algorithm.
  CACM 21,8 (August 1978), 662-665.]

 Delete all unmarked CONS-cells and unmark the marked CONS-cells,
 so that the mark bit is available for the reverse spointers. */
local void gc_morris1 (Page* page)
{
  var aint p1 = page->page_start; /* lower bound */
  var aint p2 = page->page_end;   /* upper bound */
  var aint d = 0;                 /* also count free memory */
  while (p1 != p2) {
    if (!marked(p1)) {
      ((gcv_object_t*)p1)[0] = nullobj;
      ((gcv_object_t*)p1)[1] = nullobj;
      d += sizeof(cons_);
    } else {
      unmark(p1);
      #ifdef DEBUG_SPVW
      if (eq(((gcv_object_t*)p1)[0],nullobj) || eq(((gcv_object_t*)p1)[1],nullobj))
        abort();
      #endif
    }
    p1 += sizeof(cons_);        /* this cell is finished. */
  }
  page->page_gcpriv.d = d;      /* store free memory */
}

 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE

/* There is only one page with Two-Pointer-Objects. */
local void gc_morris2 (Page* page)
{
  /* Each cell within a Cons now contains a list of all
   addresses of pointers to this cell, that point to this cell
   from a root or from a Varobject.

   traverse the undeleted conses from left to right:
   (in between, each cell contains a list of all addresses
   of pointers to this cell, that point to this cell from a root,
   from a varobject or a cons lying further to the left.) */
  var aint p1 = page->page_start;         /* lower bound */
  var aint p2 = p1 + page->page_gcpriv.d; /* later lower bound */
  var aint p1limit = page->page_end;      /* upper bound */
  while (p1 != p1limit) {       /* always: p1 <= p2 <= p1limit */
    /* both cells of a cons are treated exactly the same. */
    var object obj = *(gcv_object_t*)p1;
    if (!eq(obj,nullobj)) {
      /* p1 is moved to p2. */
     #ifdef TYPECODES
      /* the so far registered pointers to this cell are updated: */
      while ((as_oint(obj) & wbit(garcol_bit_o)) != 0) { /* process list */
        obj = without_mark_bit(obj);
        var aint p = upointer(obj);
        var object next_obj = *(gcv_object_t*)p;
        *(gcv_object_t*)p = type_pointer_object(typecode(obj),p2);
        obj = next_obj;
      }
      { /* if the cell contains a pointer "to the right", it is reversed. */
        var tint type = typecode(obj);
        switch (type) {
          case_pair: {
          var aint p = upointer(obj);
          if (!in_old_generation(obj,type,1) && (p > p1)) {
            /* For later update, insert
               p1 in the list of pointers to p: */
            *(gcv_object_t*)p1 = *(gcv_object_t*)p;
            *(gcv_object_t*)p = with_mark_bit(type_pointer_object(type,p1));
            break;
          }
        }
          default:
            *(gcv_object_t*)p1 = obj;
        }
      }
     #else  /* no TYPECODES */
      /* the so far registered pointers to this cell are updated: */
      while ((as_oint(obj) & wbit(garcol_bit_o)) != 0) { /* process list */
        obj = without_mark_bit(obj);
        var aint p = (aint)ThePointer(obj);
        var object next_obj = *(gcv_object_t*)p;
        *(gcv_object_t*)p = as_object((as_oint(obj) & nonimmediate_bias_mask) | (oint)p2);
        obj = next_obj;
      }
      /* if the cell contains a pointer "to the right", it is reversed. */
      if (consp(obj)) {
        var aint p = (aint)ThePointer(obj);
        if (!in_old_generation(obj,,1) && (p > p1)) {
          /* For later update, insert
             p1 in the list of pointers to p: */
          *(gcv_object_t*)p1 = *(gcv_object_t*)p;
          *(gcv_object_t*)p = with_mark_bit(as_object((as_oint(obj) & nonimmediate_bias_mask) | (oint)p1));
        } else {
          *(gcv_object_t*)p1 = obj;
        }
      } else {
        *(gcv_object_t*)p1 = obj;
      }
     #endif
      p2 += sizeof(gcv_object_t);
    }
    p1 += sizeof(gcv_object_t);
  }
  if (p2!=p1limit)
    abort();
}
local void gc_morris3 (Page* page)
{
  /* Each cell within a cons now contains again the original content.
   Traverse the undeleted conses from right to left
   and compact them on the right:
   (in between, each cell contains a list of all addresses
   of pointers to this cell, that point to this cell
   from a cons lying further to the right.) */
  var aint p1limit = page->page_start;       /* lower bound */
  var aint p1 = page->page_end;              /* upper bound */
  var aint p2 = p1;                          /* upper bound */
  #ifdef DEBUG_SPVW
  while (p1!=p1limit) {
    p1 -= 2*sizeof(gcv_object_t);
    if (eq(*(gcv_object_t*)p1,nullobj)+eq(*(gcv_object_t*)(p1^sizeof(gcv_object_t)),nullobj)==1)
      abort();
  }
  p1 = page->page_end;
  #endif
  while (p1!=p1limit) {         /* always: p1limit <= p1 <= p2 */
    /* both cells of a cons are treated exactly the same. */
    p1 -= sizeof(gcv_object_t);
    #ifdef DEBUG_SPVW
    if (eq(*(gcv_object_t*)p1,nullobj)+eq(*(gcv_object_t*)(p1^sizeof(gcv_object_t)),nullobj)==1)
      abort();
    if (((p1 % (2*sizeof(gcv_object_t))) != 0)
        && ((p2 % (2*sizeof(gcv_object_t))) != 0))
      abort();
    #endif
    var object obj = *(gcv_object_t*)p1;
    if (!eq(obj,nullobj)) {
      p2 -= sizeof(gcv_object_t);
      /* p1 is moved to p2. */
     #ifdef TYPECODES
      /* The newly registered pointers to this cell are updated: */
      while ((as_oint(obj) & wbit(garcol_bit_o)) != 0) { /* process list */
        obj = without_mark_bit(obj);
        var aint p = upointer(obj);
        var object next_obj = *(gcv_object_t*)p;
        *(gcv_object_t*)p = type_pointer_object(typecode(obj),p2);
        obj = next_obj;
      }
      #ifdef DEBUG_SPVW
      if (eq(obj,nullobj)) abort();
      #endif
      *(gcv_object_t*)p2 = obj;
      {
        var tint type = typecode(obj);
        if (!gcinvariant_type_p(type)) /* un-movable -> do nothing */
          switch (type) {
            case_pair: {        /* Two-Pointer-Object */
            var aint p = upointer(obj);
            if (p < p1) {       /* pointer to the left? */
              /* For later update, insert
               p2 into the list of pointers to p: */
             #ifdef DEBUG_SPVW
              if (eq(*(gcv_object_t*)p,nullobj)) abort();
             #endif
              *(gcv_object_t*)p2 = *(gcv_object_t*)p;
              *(gcv_object_t*)p = with_mark_bit(type_pointer_object(type,p2));
            } else if (p == p1) { /* pointer to itself? */
              *(gcv_object_t*)p2 = type_pointer_object(type,p2);
            }
          }
            break;
            default:            /* object of variable length */
              if (marked(ThePointer(obj))) /* marked? */
                *(gcv_object_t*)p2 = type_untype_object(type,untype(*(gcv_object_t*)ThePointer(obj)));
              break;
          }
      }
     #else  /* no TYPECODES */
      /* The newly registered pointers to this cell are updated: */
      while ((as_oint(obj) & wbit(garcol_bit_o)) != 0) { /* process list */
        obj = without_mark_bit(obj);
        var aint p = (aint)ThePointer(obj);
        var object next_obj = *(gcv_object_t*)p;
        *(gcv_object_t*)p = as_object((as_oint(obj) & nonimmediate_bias_mask) | (oint)p2);
        obj = next_obj;
      }
      #ifdef DEBUG_SPVW
      if (eq(obj,nullobj)) abort();
      #endif
      *(gcv_object_t*)p2 = obj;
      if (!gcinvariant_object_p(obj)) { /* un-movable -> do nothing */
        if (consp(obj)) {
          /* Two-Pointer-Object */
          var aint p = (aint)ThePointer(obj);
          if (p < p1) {         /* pointer to the left? */
            /* for later update, insert
             p2 into the list of pointers to p: */
           #ifdef DEBUG_SPVW
            if (eq(*(gcv_object_t*)p,nullobj)) abort();
           #endif
            *(gcv_object_t*)p2 = *(gcv_object_t*)p;
            *(gcv_object_t*)p = with_mark_bit(as_object((as_oint(obj) & nonimmediate_bias_mask) | (oint)p2));
          } else if (p == p1) { /* pointer to itself? */
            *(gcv_object_t*)p2 = as_object((as_oint(obj) & nonimmediate_bias_mask) | (oint)p2);
          }
        } else {
          /* object of variable length */
          if (marked(ThePointer(obj))) /* marked? */
            *(gcv_object_t*)p2 = as_object((as_oint(obj) & nonimmediate_bias_mask) | (as_oint(*(gcv_object_t*)ThePointer(obj)) & ~wbit(garcol_bit_o) & ~(oint)nonimmediate_bias_mask));
        }
      }
     #endif
    }
  }
  /* p2 = new lower bound of the Cons-region */
  if (p2 != page->page_start + page->page_gcpriv.d)
    abort();
  page->page_start = p2;
}

 #elif defined(SPVW_MIXED_BLOCKS_STAGGERED)

local void gc_morris2 (Page* page)
{
  /* Each cell within a Cons now contains a list of all
   addresses of pointers to this cell, that point to this cell
   from a root or from a Varobject.
   Traverse the undeleted conses from right to left:
   (in between, each cell contains a liste of all addresses
   of pointers to this cell, that point to this cell from a root,
   from a varobject or a cons lying further to the right.) */
  var aint p1 = page->page_end;           /* upper bound */
  var aint p2 = p1 - page->page_gcpriv.d; /* later upper bound */
  var aint p1limit = page->page_start;    /* lower bound */
  #ifdef DEBUG_SPVW
  while (p1!=p1limit) {
    p1 -= 2*sizeof(gcv_object_t);
    if (eq(*(gcv_object_t*)p1,nullobj)+eq(*(gcv_object_t*)(p1^sizeof(gcv_object_t)),nullobj)==1)
      abort();
  }
  p1 = page->page_end;
  #endif
  while (p1!=p1limit) {         /* always: p1limit <= p2 <= p1 */
    /* both cells of a cons are treated exactly the same. */
    p1 -= sizeof(gcv_object_t);
    #ifdef DEBUG_SPVW
    if (eq(*(gcv_object_t*)p1,nullobj)+eq(*(gcv_object_t*)(p1^sizeof(gcv_object_t)),nullobj)==1)
      abort();
    #endif
    var object obj = *(gcv_object_t*)p1;
    if (!eq(obj,nullobj)) {
      p2 -= sizeof(gcv_object_t);
      /* p1 is moved to p2. */
     #ifdef TYPECODES
      /* the so far registered pointers to this cell are updated: */
      while ((as_oint(obj) & wbit(garcol_bit_o)) != 0) { /* process list */
        obj = without_mark_bit(obj);
        var aint p = upointer(obj);
        var object next_obj = *(gcv_object_t*)p;
        *(gcv_object_t*)p = type_pointer_object(typecode(obj),p2);
        obj = next_obj;
      }
      /* obj = original content of the cell p1. */
      #ifdef DEBUG_SPVW
      if (eq(obj,nullobj)) abort();
      #endif
      /* if the cell contains a pointer "to the left", it is reversed. */
      {
        var tint type = typecode(obj);
        switch (type) {
          case_pair: {
          var aint p = upointer(obj);
          if (!in_old_generation(obj,type,1) && (p < p1)) {
            /* For later update, insert
             p1 into the list of pointers to p: */
            *(gcv_object_t*)p1 = *(gcv_object_t*)p;
            *(gcv_object_t*)p = with_mark_bit(type_pointer_object(type,p1));
            break;
          }
        }
          default:
            *(gcv_object_t*)p1 = obj;
        }
      }
     #else
      /* the so far registered pointers to this cell are updated: */
      while ((as_oint(obj) & wbit(garcol_bit_o)) != 0) { /* process list */
        obj = without_mark_bit(obj);
        var aint p = (aint)ThePointer(obj);
        var object next_obj = *(gcv_object_t*)p;
        *(gcv_object_t*)p = as_object((as_oint(obj) & nonimmediate_bias_mask) | (oint)p2);
        obj = next_obj;
      }
      /* obj = original content of the cell p1. */
      #ifdef DEBUG_SPVW
      if (eq(obj,nullobj)) abort();
      #endif
      /* if the cell contains a pointer "to the left", it is reversed. */
      if (consp(obj)) {
        var aint p = (aint)ThePointer(obj);
        if (!in_old_generation(obj,,1) && (p < p1)) {
          /* For later update, insert
           p1 into the list of pointers to p: */
          *(gcv_object_t*)p1 = *(gcv_object_t*)p;
          *(gcv_object_t*)p = with_mark_bit(as_object((as_oint(obj) & nonimmediate_bias_mask) | (oint)p1));
        } else {
          *(gcv_object_t*)p1 = obj;
        }
      } else {
        *(gcv_object_t*)p1 = obj;
      }
     #endif
    }
  }
  if (p2!=p1limit)
    abort();
}
local void gc_morris3 (Page* page)
{
  /* Each cell within a cons now contains again the original content.
   Traverse the undeleted conses from left to right
   and compact them on the left:
   (in between, each cell contains a list of all addresses
   of pointers to this cell, that point to this cell
   from a cons lying further to the left.) */
  var aint p1limit = page->page_end;        /* obere Grenze */
  var aint p1 = page->page_start;           /* lower bound */
  var aint p2 = p1;                         /* lower bound */
  while (p1!=p1limit) {         /* always: p1limit <= p1 <= p2 */
    /* both cells of a cons are treated exactly the same. */
    var object obj = *(gcv_object_t*)p1;
    if (!eq(obj,nullobj)) {
      /* p1 is moved to p2. */
     #ifdef TYPECODES
      /* The newly registered pointers to this cell are updated: */
      while ((as_oint(obj) & wbit(garcol_bit_o)) != 0) { /* process list */
        obj = without_mark_bit(obj);
        var aint p = upointer(obj);
        var object next_obj = *(gcv_object_t*)p;
        *(gcv_object_t*)p = type_pointer_object(typecode(obj),p2);
        obj = next_obj;
      }
      /* obj = true content of the cell p1. */
      {
        var tint type = typecode(obj);
        if (!gcinvariant_type_p(type)) /* un-movable -> do nothing */
          switch (type) {
            case_pair: {        /* Two-Pointer-Object */
            var aint p = upointer(obj);
            if (p > p1) {       /* pointer to the right? */
              /* For later update, insert
               p2 into the list of pointers to p: */
             #ifdef DEBUG_SPVW
              if (eq(*(gcv_object_t*)p,nullobj)) abort();
             #endif
              *(gcv_object_t*)p2 = *(gcv_object_t*)p;
              *(gcv_object_t*)p = with_mark_bit(type_pointer_object(type,p2));
            } else if (p == p1) {  /* Pointer to itself? */
              *(gcv_object_t*)p2 = type_pointer_object(type,p2);
            } else {
              *(gcv_object_t*)p2 = obj;
            }
          }
            break;
            default:            /* object of variable length */
              if (marked(ThePointer(obj))) /* marked? */
                *(gcv_object_t*)p2 = type_untype_object(type,untype(*(gcv_object_t*)ThePointer(obj)));
              else
                *(gcv_object_t*)p2 = obj;
              break;
          }
        else { /* un-movable or pointer into the old generation -> do nothing */
          *(gcv_object_t*)p2 = obj;
        }
      }
     #else
      /* The newly registered pointers to this cell are updated: */
      while ((as_oint(obj) & wbit(garcol_bit_o)) != 0) { /* process list */
        obj = without_mark_bit(obj);
        var aint p = (aint)ThePointer(obj);
        var object next_obj = *(gcv_object_t*)p;
        *(gcv_object_t*)p = as_object((as_oint(obj) & nonimmediate_bias_mask) | (oint)p2);
        obj = next_obj;
      }
      /* obj = true content of the cell p1. */
      if (!gcinvariant_object_p(obj)) { /* un-movable -> do nothing */
        if (consp(obj)) {
          /* Two-Pointer-Object */
          var aint p = (aint)ThePointer(obj);
          if (p > p1) {         /* pointer to the right? */
            /* For later update, insert
             p2 into the list of pointers to p: */
           #ifdef DEBUG_SPVW
            if (eq(*(gcv_object_t*)p,nullobj)) abort();
           #endif
            *(gcv_object_t*)p2 = *(gcv_object_t*)p;
            *(gcv_object_t*)p = with_mark_bit(as_object((as_oint(obj) & nonimmediate_bias_mask) | (oint)p2));
          } else if (p == p1) { /* pointer to itself? */
            *(gcv_object_t*)p2 = as_object((as_oint(obj) & nonimmediate_bias_mask) | (oint)p2);
          } else {
            *(gcv_object_t*)p2 = obj;
          }
        } else {
          /* Object of variable length */
          if (marked(ThePointer(obj))) /* marked? */
            *(gcv_object_t*)p2 = as_object((as_oint(obj) & nonimmediate_bias_mask) | (as_oint(*(gcv_object_t*)ThePointer(obj)) & ~wbit(garcol_bit_o) & ~(oint)nonimmediate_bias_mask));
          else
            *(gcv_object_t*)p2 = obj;
        }
      } else { /* un-movable or pointer into the old generation -> do nothing */
        *(gcv_object_t*)p2 = obj;
      }
     #endif
      p2 += sizeof(gcv_object_t);
    }
    p1 += sizeof(gcv_object_t);
  }
  /* p2 = new upper bound of the Cons-region */
  if (p2 != page->page_end - page->page_gcpriv.d)
    abort();
  page->page_end = p2;
}

 #else  /* SPVW_PURE_BLOCKS <==> SINGLEMAP_MEMORY */

/* gc_morris2 and gc_morris3 must be called for each page exactly once,
 first gc_morris2 from right to left, then gc_morris3 from left to right
 (in terms of the positioning of the addresses)! */
local void gc_morris2 (Page* page)
{
  /* Each cell within a Cons now contains a list of all
   addresses of pointers to this cell, that point to this cell
   from a root or from a Varobject.
   Traverse the undeleted conses from right to left:
   (in between, each cell contains a liste of all addresses
   of pointers to this cell, that point to this cell from a root,
   from a varobject or a cons lying further to the right.) */
  var aint p1 = page->page_end;           /* upper bound */
  var aint p2 = p1 - page->page_gcpriv.d; /* later upper bound */
  var aint p1limit = page->page_start;    /* lower bound */
  while (p1!=p1limit) {         /* always: p1limit <= p2 <= p1 */
    /* both cells of a cons are treated exactly the same. */
    p1 -= sizeof(gcv_object_t);
    var object obj = *(gcv_object_t*)p1;
    if (!eq(obj,nullobj)) {
      p2 -= sizeof(gcv_object_t);
      /* p1 is moved to p2.
       the so far registered pointers to this cell are updated: */
      while ((as_oint(obj) & wbit(garcol_bit_o)) != 0) { /* process list */
        obj = without_mark_bit(obj);
        var object next_obj = *(gcv_object_t*)pointable(obj);
        *(gcv_object_t*)pointable(obj) = as_object(p2);
        obj = next_obj;
      }
      /* obj = original content of the cell p1.
       if the cell contains a pointer "to the left", it is reversed. */
      if (is_cons_heap(typecode(obj))
          && !in_old_generation(obj,typecode(obj),1)
          && ((aint)pointable(obj) < p1)
         ) {
        /* For later update, insert
         p1 into the list of pointers to obj: */
        *(gcv_object_t*)p1 = *(gcv_object_t*)pointable(obj);
        *(gcv_object_t*)pointable(obj) = with_mark_bit(as_object(p1));
      } else {
        *(gcv_object_t*)p1 = obj;
      }
    }
  }
  if (p2!=p1limit)
    abort();
}
local void gc_morris3 (Page* page)
{
  /* Each cell within a cons now contains again the original content.
   Traverse the undeleted conses from left to right
   and compact them on the left:
   (in between, each cell contains a list of all addresses
   of pointers to this cell, that point to this cell
   from a cons lying further to the left.) */
  var aint p1limit = page->page_end;        /* upper bound */
  var aint p1 = page->page_start;           /* lower bound */
  var aint p2 = p1;                         /* lower bound */
  while (p1!=p1limit) {         /* always: p1limit <= p1 <= p2 */
    /* both cells of a cons are treated exactly the same. */
    var object obj = *(gcv_object_t*)p1;
    if (!eq(obj,nullobj)) {
      /* p1 is moved to p2.
       The newly registered pointers to this cell are updated: */
      while ((as_oint(obj) & wbit(garcol_bit_o)) != 0) { /* process list */
        obj = without_mark_bit(obj);
        var object next_obj = *(gcv_object_t*)pointable(obj);
        *(gcv_object_t*)pointable(obj) = as_object(p2);
        obj = next_obj;
      }
      /* obj = true content of cell p1. */
      {
        var tint type = typecode(obj);
        if (!is_unused_heap(type) && !in_old_generation(obj,type,?))
          if (is_cons_heap(type)) {
            /* Two-Pointer-Object */
            if ((aint)pointable(obj) > p1) { /* pointer to the right? */
              /* For later update, insert
               p2 into the list of pointers to obj: */
              *(gcv_object_t*)p2 = *(gcv_object_t*)pointable(obj);
              *(gcv_object_t*)pointable(obj) = with_mark_bit(as_object(p2));
            } else if ((aint)pointable(obj) == p1) { /* pointer to itself? */
              *(gcv_object_t*)p2 = as_object(p2);
            } else {
              *(gcv_object_t*)p2 = obj;
            }
          } else {
            /* object of variable length */
            if (marked(ThePointer(obj))) /* marked? */
              *(gcv_object_t*)p2 = type_untype_object(type,untype(*(gcv_object_t*)ThePointer(obj)));
            else
              *(gcv_object_t*)p2 = obj;
          } else { /* un-movable or pointer into the old generation -> do nothing */
            *(gcv_object_t*)p2 = obj;
          }
      }
      p2 += sizeof(gcv_object_t);
    }
    p1 += sizeof(gcv_object_t);
  }
  /* p2 = new upper bound of the Cons-region */
  if (p2 != page->page_end - page->page_gcpriv.d)
    abort();
  page->page_end = p2;
}

 #endif

#endif

/* modify the self-pointer of an object of variable length:
 set_GCself(p,type,addr);
 sets p->GCself to type_pointer_object(type,addr). */
#ifdef TYPECODES
  #if !(exact_uint_size_p(oint_type_len) && ((oint_type_shift%hfintsize)==0) && (tint_type_mask == bit(oint_type_len)-1))
    #ifdef MAP_MEMORY
      /* addr contains typeinfo */
      #define make_GCself(type,addr)  \
        type_pointer_object((type)&(tint_type_mask),(addr)&(oint_addr_mask))
    #else
      /* addr contains no typeinfo */
      #define make_GCself(type,addr)  \
        type_pointer_object((type)&(tint_type_mask),addr)
    #endif
    #define set_GCself(p,type,addr)  \
      ((Varobject)(p))->GCself = make_GCself(type,addr)
  #else  /* better: though two memory accesses, but less arithmetics */
    #define make_GCself(type,addr)  \
      type_pointer_object((type)&(tint_type_mask),(addr)&~(oint_type_mask))
    #define set_GCself(p,type,addr)  \
      (((Varobject)(p))->GCself = type_pointer_object(0,addr), \
       ((Varobject)(p))->header_flags = (type))
  #endif
#else
  #define make_GCself(type,addr)  /* ignore type */ \
    as_object((oint)(addr))
  #define set_GCself(p,type,addr)  /* ignore type */ \
    ((Varobject)(p))->GCself = make_GCself(type,addr)
#endif

#ifdef HAVE_SMALL_SSTRING
/* Special handling of forward pointers among simple-strings. */
local void gc_sweep1_sstring_forward (aint p2) {
  var gcv_object_t forward = ((Sistring)p2)->data;
  if (sstring_flags(TheSstring(forward)) & sstringflags_relocated_B) {
    var gcv_object_t target = TheSstring(forward)->GCself;
    var aint backchain = p2;
    for (;;) {
      var gcv_object_t backpointer = ((Varobject)backchain)->GCself;
      ((Varobject)backchain)->GCself = target;
      sstring_flags_set((Sstring)backchain,sstringflags_relocated_B);
      if (sstring_flags((Sstring)backchain) & sstringflags_backpointer_B)
        backchain = (aint)ThePointer(without_mark_bit(backpointer));
      else
        break;
    }
  } else {
    /* Leave a backpointer for later fixup.
     Each string can have only one forward pointer directly pointing
     to it. This ensures that the backchain is a singly linked list. */
    if (sstring_flags(TheSstring(forward)) & sstringflags_backpointer_B)
      /*NOTREACHED*/ abort();
    TheSstring(forward)->GCself = with_mark_bit(make_GCself(sstring_type,p2));
    sstring_flags_set(TheSstring(forward),sstringflags_backpointer_B);
  }
  /* Don't reclaim the space at p2 during this GC, because
   1. we need the mark bit at p2 so that update() does the
      relocation, and the mark bit tells gc_sweep2_varobject_page
      that the object is not yet reclaimed.
   2. otherwise last_open_ptr may be set to &((Varobject)p2)->GCself
      later. */
}
local void gc_sweep1_sstring_target (aint p2, aint p1) {
  if (sstring_flags((Sstring)p2) & sstringflags_relocated_B)
    /*NOTREACHED*/ abort();
  var gcv_object_t target; target = with_mark_bit(make_GCself(sstring_type,p1));
  var aint backchain = p2;
  for (;;) {
    var gcv_object_t backpointer = ((Varobject)backchain)->GCself;
    ((Varobject)backchain)->GCself = target;
    sstring_flags_set((Sstring)backchain,sstringflags_relocated_B);
    if (sstring_flags((Sstring)backchain) & sstringflags_backpointer_B)
      backchain = (aint)ThePointer(without_mark_bit(backpointer));
    else
      break;
  }
}
#endif

/* Special handling of forward pointers among CLOS instances. */
local void gc_sweep1_instance_forward (aint p2) {
  var gcv_object_t forward = ((Instance)p2)->inst_class_version;
  if (record_flags(TheInstance(forward)) & instflags_relocated_B) {
    var gcv_object_t target = TheInstance(forward)->GCself;
    var aint backchain = p2;
    for (;;) {
      var gcv_object_t backpointer = ((Varobject)backchain)->GCself;
      ((Varobject)backchain)->GCself = target;
      record_flags_set((Record)backchain,instflags_relocated_B);
      if (record_flags((Record)backchain) & instflags_backpointer_B)
        backchain = (aint)ThePointer(without_mark_bit(backpointer));
      else
        break;
    }
  } else {
    /* Leave a backpointer for later fixup.
     Each instance can have only one forward pointer directly pointing
     to it. This ensures that the backchain is a singly linked list. */
    if (record_flags(TheInstance(forward)) & instflags_backpointer_B)
      /*NOTREACHED*/ abort();
    #ifdef TYPECODES
    /* The type is either instance_type or closure_type. */
    var tint type = mtypecode(((Varobject)p2)->GCself) & ~bit(garcol_bit_t);
    #endif
    TheInstance(forward)->GCself = with_mark_bit(make_GCself(type,p2));
    record_flags_set(TheInstance(forward),instflags_backpointer_B);
  }
  /* Don't reclaim the space at p2 during this GC, because
   1. we need the mark bit at p2 so that update() does the
      relocation, and the mark bit tells gc_sweep2_varobject_page
      that the object is not yet reclaimed.
   2. otherwise last_open_ptr may be set to &((Varobject)p2)->GCself
      later. */
}
local void gc_sweep1_instance_target (aint p2, aint p1) {
  if (record_flags((Instance)p2) & instflags_relocated_B)
    /*NOTREACHED*/ abort();
  #ifdef TYPECODES
  /* The type is either instance_type or closure_type. */
  var tint type = mtypecode(((Varobject)p2)->GCself) & ~bit(garcol_bit_t);
  #endif
  var gcv_object_t target; target = with_mark_bit(make_GCself(type,p1));
  var aint backchain = p2;
  for (;;) {
    var gcv_object_t backpointer = ((Varobject)backchain)->GCself;
    ((Varobject)backchain)->GCself = target;
    record_flags_set((Record)backchain,instflags_relocated_B);
    if (record_flags((Record)backchain) & instflags_backpointer_B)
      backchain = (aint)ThePointer(without_mark_bit(backpointer));
    else
      break;
  }
}

/* Prepare objects of variable length between page->page_start and
 page->page_end for compacting below. Therefore, in each marked
 object the pointer in front is pointed to the location, where the
 object will be located later (including typeinfo). If the sequencing
 object is unmarked, then its first pointer is oriented to the address
 of the next marked object. */
#ifdef SPVW_PURE
local aint gc_sweep1_varobject_page (uintL heapnr, aint start, aint end, gcv_object_t* firstmarked, aint dest)
#elif defined(GENERATIONAL_GC)
local aint gc_sweep1_varobject_page (aint start, aint end, gcv_object_t* firstmarked, aint dest)
#else
local void gc_sweep1_varobject_page (Page* page)
#endif
{
 #if defined(SPVW_PURE) || defined(GENERATIONAL_GC)
  var gcv_object_t* last_open_ptr = firstmarked;
  var aint p2 = start;          /* source-pointer */
  var aint p2end = end;         /* upper bound of the source-region */
  var aint p1 = dest;           /* destination-pointer */
 #else
  var gcv_object_t* last_open_ptr = &page->page_gcpriv.firstmarked;
  /* In *last_open_ptr, always store the address of the next marked
   object (als oint) .
   Via chained-list-mechanism: At the end, page->page_gcpriv.firstmarked
   contains the address of the 1. marked object */
  var aint p2 = page->page_start;                /* source-pointer */
  var aint p2end = page->page_end; /* upper bound of the source-region */
  var aint p1 = p2;                /* destination-pointer */
 #endif
  /* start <= p1 <= p2 <= end, p1 and p2 grow, p2 faster than p1. */
  var_prepare_objsize;
 sweeploop1:
  /* search next marked object.
   enter address of the next marked object in *last_open_ptr . */
  if (p2==p2end)                /* upper bound reached -> finished */
    goto sweepok1;
  {
   #ifdef TYPECODES
    var tint flags = mtypecode(((Varobject)p2)->GCself);
    /* save typeinfo (and flags for symbols) */
   #endif
    var uintM laenge = objsize((Varobject)p2); /* determine byte-length */
    if (!marked(p2)) {                         /* object unmarked? */
      p2 += laenge; goto sweeploop1; /* yes -> goto next object */
    }
    /* object marked
     Elimination of forward pointers: */
   #ifdef HAVE_SMALL_SSTRING
    #ifdef SPVW_PURE
    if (heapnr == sstring_type)
    #else
     #ifdef TYPECODES
    if ((flags & ~bit(garcol_bit_t)) == sstring_type)
     #else
      /* NB: No need to handle Rectype_[Imm_]S8string here. */
    if ((uintB)(record_type((Record)p2) - Rectype_S16string)
        <= Rectype_reallocstring - Rectype_S16string)
     #endif
    #endif
      {
        if (sstring_reallocatedp((Sstring)p2)) {
          /* A forward pointer. */
          gc_sweep1_sstring_forward(p2);
        } else {
          /* Possibly the target of a forward pointer. */
          gc_sweep1_sstring_target(p2,p1);
        }
      }
    else
    #endif
     #ifdef SPVW_PURE
      if (heapnr == instance_type
          || (heapnr == closure_type
              && (closure_flags((Closure)p2) & closflags_instance_B)))
     #else
      #ifdef TYPECODES
      if ((flags & ~bit(garcol_bit_t)) == instance_type
          || ((flags & ~bit(garcol_bit_t)) == closure_type
              && (closure_flags((Closure)p2) & closflags_instance_B)))
      #else
      if (record_type((Record)p2) == Rectype_Instance
          || (record_type((Record)p2) == Rectype_Closure
              && (closure_flags((Closure)p2) & closflags_instance_B)))
      #endif
     #endif
        {
          if (record_flags((Instance)p2) & instflags_forwarded_B) {
            /* A forward pointer. */
            gc_sweep1_instance_forward(p2);
          } else {
            /* Possibly the target of a forward pointer. */
            gc_sweep1_instance_target(p2,p1);
          }
        }
      else {
        set_GCself(p2, flags,p1); /* enter new address, with old */
        /* typeinfo (the mark bit is contained within) */
        #ifndef TYPECODES
        mark(p2);
        #endif
      }
    *last_open_ptr = pointer_as_object(p2); /* store address */
    p2 += laenge;               /* source address for next object */
    p1 += laenge;              /* destination address for next object */
  }
 sweeploop2:
  /* search next unmarked object. */
  if (p2==p2end)                /* upper bound reached -> finished */
    goto sweepok2;
  {
   #ifdef TYPECODES
    var tint flags = mtypecode(((Varobject)p2)->GCself);
    /* save typeinfo (and flags for symbols) */
   #endif
    var uintM laenge = objsize((Varobject)p2); /* determine byte-length */
    if (!marked(p2)) {                         /* object unmarked? */
      last_open_ptr = (gcv_object_t*)p2; /* yes -> store the next pointer here */
      p2 += laenge; goto sweeploop1;     /* goto next object */
    }
    /* object marked
     Elimination of forward pointers: */
   #ifdef HAVE_SMALL_SSTRING
    #ifdef SPVW_PURE
    if (heapnr == sstring_type)
    #else
     #ifdef TYPECODES
    if ((flags & ~bit(garcol_bit_t)) == sstring_type)
     #else
    /* NB: No need to handle Rectype_[Imm_]S8string here. */
    if ((uintB)(record_type((Record)p2) - Rectype_S16string)
        <= Rectype_reallocstring - Rectype_S16string)
     #endif
    #endif
      {
        if (sstring_reallocatedp((Sstring)p2)) {
          /* A forward pointer. */
          gc_sweep1_sstring_forward(p2);
        } else {
          /* Possibly the target of a forward pointer. */
          gc_sweep1_sstring_target(p2,p1);
        }
      }
    else
   #endif
   #ifdef SPVW_PURE
      if (heapnr == instance_type
          || (heapnr == closure_type
              && (closure_flags((Closure)p2) & closflags_instance_B)))
   #else
    #ifdef TYPECODES
      if ((flags & ~bit(garcol_bit_t)) == instance_type
          || ((flags & ~bit(garcol_bit_t)) == closure_type
              && (closure_flags((Closure)p2) & closflags_instance_B)))
    #else
      if (record_type((Record)p2) == Rectype_Instance
          || (record_type((Record)p2) == Rectype_Closure
              && (closure_flags((Closure)p2) & closflags_instance_B)))
    #endif
   #endif
        {
          if (record_flags((Instance)p2) & instflags_forwarded_B) {
            /* A forward pointer. */
            gc_sweep1_instance_forward(p2);
          } else {
            /* Possibly the target of a forward pointer. */
            gc_sweep1_instance_target(p2,p1);
          }
        }
      else {
        set_GCself(p2, flags,p1); /* enter new address, with old */
        /* typeinfo (the mark bit is contained within) */
       #ifndef TYPECODES
        mark(p2);
       #endif
      }
    p2 += laenge;               /* source address for next object */
    p1 += laenge;              /* destination address for next object */
    goto sweeploop2;
  }
 sweepok1: { *last_open_ptr = pointer_as_object(p2); }
 sweepok2: ;
 #if defined(SPVW_PURE) || defined(GENERATIONAL_GC)
  return p1;
 #endif
}

/* update phase:
 The entire LISP-memory is perused and old addresses are replaced
 with new ones.
 update of an object *objptr : */
#if !defined(MORRIS_GC)
 #ifdef TYPECODES
  #define update(objptr)                                                \
   { var tint type = mtypecode(*(gcv_object_t*)objptr);                 \
     if (!gcinvariant_type_p(type)) {   /* un-movable -> do nothing */  \
       var object obj = *(gcv_object_t*)objptr;           /* object */  \
       if (!in_old_generation(obj,type,mem.heapnr_from_type[type]))     \
         /* older generation -> do nothing (object stayed there) */     \
         if (marked(ThePointer(obj))) {                 /* marked? */   \
           /* no -> do nothing (object stayed there)                    \
              yes -> enter new address and typeinfobyte (incl.          \
                     poss. symbol-binding-flag) */                      \
           var object newptr =                                          \
             type_untype_object(type,untype(*(gcv_object_t*)ThePointer(obj))); \
           DEBUG_SPVW_ASSERT(is_valid_heap_object_address(as_oint(newptr)) \
                             || is_valid_stack_address(as_oint(newptr))); \
           *(gcv_object_t*)objptr = newptr;                             \
         }                                                              \
     }                                                                  \
   }
 #else
  #ifdef GENERATIONAL_GC
   #define update(objptr)                                               \
    { var object obj = *(gcv_object_t*)objptr;            /* object */  \
      if (!gcinvariant_object_p(obj))   /* un-movable -> do nothing */  \
        if (!(consp(obj) ? in_old_generation(obj,,1) : in_old_generation(obj,,0))) \
          /* older generation -> do nothing (object stayed there) */    \
          if (marked(ThePointer(obj))) {                 /* marked? */  \
            /* no ->  do nothing (object stayed there)                  \
               yes -> enter new address */                              \
            var object newptr =                                         \
              as_object((as_oint(obj) & nonimmediate_bias_mask) | (as_oint(*(gcv_object_t*)ThePointer(obj)) & ~wbit(garcol_bit_o))); \
            DEBUG_SPVW_ASSERT((consp(obj) ? is_valid_cons_address(as_oint(newptr)) : is_valid_varobject_address(as_oint(newptr))) \
                              || is_valid_stack_address(as_oint(newptr))); \
            *(gcv_object_t*)objptr = newptr;                            \
          }                                                             \
    }
  #else
   #define update(objptr)                                               \
    { var object obj = *(gcv_object_t*)objptr;            /* object */  \
      if (!gcinvariant_object_p(obj))   /* un-movable -> do nothing */  \
        if (!in_old_generation(obj,,))                                  \
          /* older generation -> do nothing (object stayed there) */    \
          if (marked(ThePointer(obj))) {                 /* marked? */  \
            /* no ->  do nothing (object stayed there)                  \
               yes -> enter new address */                              \
            var object newptr =                                         \
              as_object((as_oint(obj) & nonimmediate_bias_mask) | (as_oint(*(gcv_object_t*)ThePointer(obj)) & ~wbit(garcol_bit_o))); \
            DEBUG_SPVW_ASSERT((consp(obj) ? is_valid_cons_address(as_oint(newptr)) : is_valid_varobject_address(as_oint(newptr))) \
                              || is_valid_stack_address(as_oint(newptr))); \
            *(gcv_object_t*)objptr = newptr;                            \
          }                                                             \
    }
  #endif
 #endif
#else  /* defined(MORRIS_GC) */
 #if defined(SPVW_MIXED_BLOCKS)
  #ifdef TYPECODES
   #define update(objptr)                                               \
    { var tint type = mtypecode(*(gcv_object_t*)objptr);                \
      if (!gcinvariant_type_p(type))    /* un-movable -> do nothing */  \
        switch (type) {                                                 \
          default: {                   /* object of variable length */  \
            var object obj = *(gcv_object_t*)objptr;      /* object */  \
            if (!in_old_generation(obj,type,0))                         \
              if (marked(ThePointer(obj))) {             /* marked? */  \
                var object newptr =           …