/* gc.c
 * Copyright 1984-2016 Cisco Systems, Inc.
 * 
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 * 
 * http://www.apache.org/licenses/LICENSE-2.0
 * 
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

#include "system.h"
#include "sort.h"
#ifndef WIN32
#include <sys/wait.h>
#endif /* WIN32 */

#define enable_object_counts do_not_use_enable_object_counts_in_this_file_use_ifdef_ENABLE_OBJECT_COUNTS_instead

/* locally defined functions */
static ptr append_bang PROTO((ptr ls1, ptr ls2));
static uptr count_unique PROTO((ptr ls));
static uptr list_length PROTO((ptr ls));
static ptr dosort PROTO((ptr ls, uptr n));
static ptr domerge PROTO((ptr l1, ptr l2));
static IBOOL search_locked PROTO((ptr p));
static ptr copy PROTO((ptr pp, ISPC pps));
static void sweep_ptrs PROTO((ptr *p, iptr n));
static void sweep PROTO((ptr tc, ptr p, IBOOL sweep_pure));
static ptr copy_stack PROTO((ptr old, iptr *length, iptr clength));
static void resweep_weak_pairs PROTO((IGEN g));
static void forward_or_bwp PROTO((ptr *pp, ptr p));
static void sweep_generation PROTO((ptr tc, IGEN g));
static iptr size_object PROTO((ptr p));
static iptr sweep_typed_object PROTO((ptr p));
static void sweep_symbol PROTO((ptr p));
static void sweep_port PROTO((ptr p));
static void sweep_thread PROTO((ptr p));
static void sweep_continuation PROTO((ptr p));
static void sweep_stack PROTO((uptr base, uptr size, uptr ret));
static void sweep_record PROTO((ptr x));
static IGEN sweep_dirty_record PROTO((ptr x));
static void sweep_code_object PROTO((ptr tc, ptr co));
static void record_dirty_segment PROTO((IGEN from_g, IGEN to_g, seginfo *si));
static void sweep_dirty PROTO((void));
static void resweep_dirty_weak_pairs PROTO((void));

/* MAXPTR is used to pad the sorted_locked_object vector.  The pad value must be greater than any heap address */
#define MAXPTR ((ptr)-1)

#define OLDSPACE(x) (SPACE(x) & space_old)

/* #define DEBUG */

/* initialized and used each gc cycle.  any others should be defined in globals.h */
static IBOOL change;
static IGEN target_generation;
static IGEN max_copied_generation;
static ptr sweep_loc[max_real_space+1];
static ptr orig_next_loc[max_real_space+1];
static ptr sorted_locked_objects;
static ptr tlcs_to_rehash;

static ptr append_bang(ptr ls1, ptr ls2) { /* assumes ls2 pairs are older than ls1 pairs, or that we don't car */
  if (ls2 == Snil) {
    return ls1;
  } else if (ls1 == Snil) {
    return ls2;
  } else {
    ptr this = ls1, next;
    while ((next = Scdr(this)) != Snil) this = next;
    INITCDR(this) = ls2;
    return ls1;
  }
}

static uptr count_unique(ls) ptr ls; { /* assumes ls is sorted and nonempty */
  uptr i = 1; ptr x = Scar(ls), y;
  while ((ls = Scdr(ls)) != Snil) {
    if ((y = Scar(ls)) != x) {
      i += 1;
      x = y;
    }
  }
  return i;
}

#define CARLT(x, y) (Scar(x) < Scar(y))
mkmergesort(dosort, domerge, ptr, Snil, CARLT, INITCDR)

uptr list_length(ptr ls) {
  uptr i = 0;
  while (ls != Snil) { ls = Scdr(ls); i += 1; }
  return i;
}

#define relocate(ppp) {\
    ptr PP;\
    PP = *ppp;\
    relocate_help(ppp, PP)\
}

/* optimization of:
 * relocate(ppp)
 * if (GENERATION(*ppp) < youngest)
 *   youngest = GENERATION(*ppp);
 */
#define relocate_dirty(ppp,tg,youngest) {\
  ptr PP = *ppp; seginfo *SI; ISPC S;\
  if (!IMMEDIATE(PP) && (SI = MaybeSegInfo(ptr_get_segment(PP))) != NULL) {\
    if ((S = SI->space) & space_old) {\
      relocate_help_help(ppp, PP, S)\
      youngest = tg;\
    } else {\
      IGEN pg;\
      if (youngest != tg && (pg = SI->generation) < youngest) {\
        youngest = pg;\
      }\
    }\
  }\
}

#define relocate_help(ppp, pp) {\
  seginfo *SI; ISPC S;\
  if (!IMMEDIATE(pp) && (SI = MaybeSegInfo(ptr_get_segment(pp))) != NULL && (S = SI->space) & space_old)\
    relocate_help_help(ppp, pp, S)\
}

#define relocate_help_help(ppp, pp, s) {\
  if (FWDMARKER(pp) == forward_marker && TYPEBITS(pp) != type_flonum)\
    *ppp = FWDADDRESS(pp);\
  else\
    *ppp = copy(pp, s);\
}

#define relocate_return_addr(pcp) {\
    ISPC S;\
    ptr XCP;\
    XCP = *(pcp);\
    if ((S = SPACE(XCP)) & space_old) {\
        iptr CO;\
        CO = ENTRYOFFSET(XCP) + ((uptr)XCP - (uptr)&ENTRYOFFSET(XCP));\
        relocate_code(pcp,XCP,CO,S)\
    }\
}

/* in the call to copy below, assuming SPACE(PP) == SPACE(XCP) since
   PP and XCP point to/into the same object */
#define relocate_code(pcp,XCP,CO,S) {\
    ptr PP;\
    PP = (ptr)((uptr)XCP - CO);\
    if (FWDMARKER(PP) == forward_marker)\
        PP = FWDADDRESS(PP);\
    else\
        PP = copy(PP, S);\
    *pcp = (ptr)((uptr)PP + CO);\
}

/* rkd 2015/06/05: tried to use sse instructions.  abandoned the code
   because the collector ran slower */
#define copy_ptrs(ty, p1, p2, n) {\
  ptr *Q1, *Q2, *Q1END;\
  Q1 = (ptr *)UNTYPE((p1),ty);\
  Q2 = (ptr *)UNTYPE((p2),ty);\
  Q1END = (ptr *)((uptr)Q1 + n);\
  while (Q1 != Q1END) *Q1++ = *Q2++;}

static IBOOL search_locked(ptr p) {
  uptr k; ptr v, *vp, x;
  v = sorted_locked_objects;
  k = Svector_length(v);
  vp = &INITVECTIT(v, 0);
  for (;;) {
    k >>= 1;
    if ((x = vp[k]) == p) return 1;
    if (k == 0) return 0;
    if (x < p) vp += k + 1;
 }
}

#define locked(p) (sorted_locked_objects != FIX(0) && search_locked(p))

static ptr copy(pp, pps) ptr pp; ISPC pps; {
    ptr p, tf; ITYPE t; IGEN tg;

    if (locked(pp)) return pp;

    tg = target_generation;

    change = 1;

    if ((t = TYPEBITS(pp)) == type_typed_object) {
      tf = TYPEFIELD(pp);
      if (TYPEP(tf, mask_record, type_record)) {
          ptr rtd; iptr n; ISPC s;

        /* relocate to make sure we aren't using an oldspace descriptor
           that has been overwritten by a forwarding marker, but don't loop
           on tag-reflexive base descriptor */
          if ((rtd = tf) != pp) relocate(&rtd)

          n = size_record_inst(UNFIX(RECORDDESCSIZE(rtd)));

#ifdef ENABLE_OBJECT_COUNTS
          { ptr counts; IGEN g;
            counts = RECORDDESCCOUNTS(rtd);
            if (counts == Sfalse) {
              IGEN grtd = rtd == pp ? tg : GENERATION(rtd);
              S_G.countof[grtd][countof_rtd_counts] += 1;
             /* allocte counts struct in same generation as rtd.  initialize timestamp & counts */
              find_room(space_data, grtd, type_typed_object, size_rtd_counts, counts);
              RTDCOUNTSTYPE(counts) = type_rtd_counts;
              RTDCOUNTSTIMESTAMP(counts) = S_G.gctimestamp[0];
              for (g = 0; g <= static_generation; g += 1) RTDCOUNTSIT(counts, g) = 0;
              RECORDDESCCOUNTS(rtd) = counts;
              S_G.rtds_with_counts[grtd] = S_cons_in((grtd == 0 ? space_new : space_impure), grtd, rtd, S_G.rtds_with_counts[grtd]);
              S_G.countof[grtd][countof_pair] += 1;
            } else {
              relocate(&counts)
              RECORDDESCCOUNTS(rtd) = counts;
              if (RTDCOUNTSTIMESTAMP(counts) != S_G.gctimestamp[0]) S_fixup_counts(counts);
            }
            RTDCOUNTSIT(counts, tg) += 1;
          }
#endif /* ENABLE_OBJECT_COUNTS */

        /* if the rtd is the only pointer and is immutable, put the record
           into space data.  if the record contains only pointers, put it
           into space_pure or space_impure.  otherwise put it into
           space_pure_typed_object or space_impure_record.  we could put all
           records into space_{pure,impure}_record or even into
           space_impure_record, but by picking the target space more
           carefully we may reduce fragmentation and sweeping cost */
          s = RECORDDESCPM(rtd) == FIX(1) && RECORDDESCMPM(rtd) == FIX(0) ?
                  space_data :
                  RECORDDESCPM(rtd) == FIX(-1) ?
                      RECORDDESCMPM(rtd) == FIX(0) ?
                          space_pure :
                          space_impure :
                      RECORDDESCMPM(rtd) == FIX(0) ?
                          space_pure_typed_object :
                          space_impure_record;

          find_room(s, tg, type_typed_object, n, p);
          copy_ptrs(type_typed_object, p, pp, n);

        /* overwrite type field with forwarded descriptor */
          RECORDINSTTYPE(p) = rtd == pp ? p : rtd;

        /* pad if necessary */
          if (s == space_pure || s == space_impure) {
              iptr m = unaligned_size_record_inst(UNFIX(RECORDDESCSIZE(rtd)));
              if (m != n)
                  *((ptr *)((uptr)UNTYPE(p,type_typed_object) + m)) = FIX(0);
          }
      } else if (TYPEP(tf, mask_fixnum, type_fixnum)) {
        /* vector type/length field is a fixnum */
          iptr len, n;
          len = Svector_length(pp);
          n = size_vector(len);
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_vector] += 1;
          S_G.bytesof[tg][countof_vector] += n;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_impure, tg, type_typed_object, n, p);
          copy_ptrs(type_typed_object, p, pp, n);
        /* pad if necessary */
          if ((len & 1) == 0) INITVECTIT(p, len) = FIX(0);
      } else if (TYPEP(tf, mask_string, type_string)) {
          iptr n;
          n = size_string(Sstring_length(pp));
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_string] += 1;
          S_G.bytesof[tg][countof_string] += n;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_data, tg, type_typed_object, n, p);
          copy_ptrs(type_typed_object, p, pp, n);
      } else if (TYPEP(tf, mask_fxvector, type_fxvector)) {
          iptr n;
          n = size_fxvector(Sfxvector_length(pp));
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_fxvector] += 1;
          S_G.bytesof[tg][countof_fxvector] += n;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_data, tg, type_typed_object, n, p);
          copy_ptrs(type_typed_object, p, pp, n);
      } else if (TYPEP(tf, mask_bytevector, type_bytevector)) {
          iptr n;
          n = size_bytevector(Sbytevector_length(pp));
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_bytevector] += 1;
          S_G.bytesof[tg][countof_bytevector] += n;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_data, tg, type_typed_object, n, p);
          copy_ptrs(type_typed_object, p, pp, n);
      } else if ((iptr)tf == type_tlc) {
          ptr keyval, next;

#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_tlc] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_impure, tg, type_typed_object, size_tlc, p);
          TLCTYPE(p) = type_tlc;
          INITTLCKEYVAL(p) = keyval = TLCKEYVAL(pp);
          INITTLCHT(p) = TLCHT(pp);
          INITTLCNEXT(p) = next = TLCNEXT(pp);

        /* if next isn't false and keyval is old, add tlc to a list of tlcs
         * to process later.  determining if keyval is old is a (conservative)
         * approximation to determining if key is old.  we can't easily
         * determine if key is old, since keyval might or might not have been
         * swept already.  NB: assuming keyvals are always pairs. */
          if (next != Sfalse && SPACE(keyval) & space_old)
            tlcs_to_rehash = S_cons_in(space_new, 0, p, tlcs_to_rehash);
      } else if ((iptr)tf == type_box) {
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_box] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_impure, tg, type_typed_object, size_box, p);
          BOXTYPE(p) = type_box;
          INITBOXREF(p) = Sunbox(pp);
      } else if ((iptr)tf == type_ratnum) {
        /* not recursive: place in space_data and relocate fields immediately */
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_ratnum] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_data, tg,
                      type_typed_object, size_ratnum, p);
          RATTYPE(p) = type_ratnum;
          RATNUM(p) = RATNUM(pp);
          RATDEN(p) = RATDEN(pp);
          relocate(&RATNUM(p))
          relocate(&RATDEN(p))
      } else if ((iptr)tf == type_exactnum) {
        /* not recursive: place in space_data and relocate fields immediately */
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_exactnum] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_data, tg,
                      type_typed_object, size_exactnum, p);
          EXACTNUM_TYPE(p) = type_exactnum;
          EXACTNUM_REAL_PART(p) = EXACTNUM_REAL_PART(pp);
          EXACTNUM_IMAG_PART(p) = EXACTNUM_IMAG_PART(pp);
          relocate(&EXACTNUM_REAL_PART(p))
          relocate(&EXACTNUM_IMAG_PART(p))
      } else if ((iptr)tf == type_inexactnum) {
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_inexactnum] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_data, tg,
                      type_typed_object, size_inexactnum, p);
          INEXACTNUM_TYPE(p) = type_inexactnum;
          INEXACTNUM_REAL_PART(p) = INEXACTNUM_REAL_PART(pp);
          INEXACTNUM_IMAG_PART(p) = INEXACTNUM_IMAG_PART(pp);
      } else if (TYPEP(tf, mask_bignum, type_bignum)) {
          iptr n;
          n = size_bignum(BIGLEN(pp));
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_bignum] += 1;
          S_G.bytesof[tg][countof_bignum] += n;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_data, tg, type_typed_object, n, p);
          copy_ptrs(type_typed_object, p, pp, n);
      } else if (TYPEP(tf, mask_port, type_port)) {
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_port] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_port, tg,
                      type_typed_object, size_port, p);
          PORTTYPE(p) = PORTTYPE(pp);
          PORTHANDLER(p) = PORTHANDLER(pp);
          PORTNAME(p) = PORTNAME(pp);
          PORTINFO(p) = PORTINFO(pp);
          PORTOCNT(p) = PORTOCNT(pp);
          PORTICNT(p) = PORTICNT(pp);
          PORTOBUF(p) = PORTOBUF(pp);
          PORTOLAST(p) = PORTOLAST(pp);
          PORTIBUF(p) = PORTIBUF(pp);
          PORTILAST(p) = PORTILAST(pp);
      } else if (TYPEP(tf, mask_code, type_code)) {
          iptr n;
          n = size_code(CODELEN(pp));
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_code] += 1;
          S_G.bytesof[tg][countof_code] += n;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_code, tg, type_typed_object, n, p);
          copy_ptrs(type_typed_object, p, pp, n);
      } else if ((iptr)tf == type_thread) {
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_thread] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_pure_typed_object, tg,
                      type_typed_object, size_thread, p);
          TYPEFIELD(p) = (ptr)type_thread;
          THREADTC(p) = THREADTC(pp); /* static */
      } else if ((iptr)tf == type_rtd_counts) {
#ifdef ENABLE_OBJECT_COUNTS
          S_G.countof[tg][countof_rtd_counts] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
          find_room(space_data, tg, type_typed_object, size_rtd_counts, p);
          copy_ptrs(type_typed_object, p, pp, size_rtd_counts);
      } else {
          S_error_abort("copy(gc): illegal type");
          return (ptr)0 /* not reached */;
      }
    } else if (t == type_pair) {
        ptr qq = Scdr(pp); ptr q; seginfo *si;
        if (qq != pp && TYPEBITS(qq) == type_pair && (si = MaybeSegInfo(ptr_get_segment(qq))) != NULL && si->space == pps && FWDMARKER(qq) != forward_marker && !locked(qq)) {
          if (pps == (space_weakpair | space_old)) {
#ifdef ENABLE_OBJECT_COUNTS
            S_G.countof[tg][countof_weakpair] += 2;
#endif /* ENABLE_OBJECT_COUNTS */
            find_room(space_weakpair, tg, type_pair, 2 * size_pair, p);
          } else {
#ifdef ENABLE_OBJECT_COUNTS
            S_G.countof[tg][countof_pair] += 2;
#endif /* ENABLE_OBJECT_COUNTS */
            find_room(space_impure, tg, type_pair, 2 * size_pair, p);
          }
          q = (ptr)((uptr)p + size_pair);
          INITCAR(p) = Scar(pp);
          INITCDR(p) = q;
          INITCAR(q) = Scar(qq);
          INITCDR(q) = Scdr(qq);
          FWDMARKER(qq) = forward_marker;
          FWDADDRESS(qq) = q;
        } else {
          if (pps == (space_weakpair | space_old)) {
#ifdef ENABLE_OBJECT_COUNTS
            S_G.countof[tg][countof_weakpair] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
            find_room(space_weakpair, tg, type_pair, size_pair, p);
          } else {
#ifdef ENABLE_OBJECT_COUNTS
            S_G.countof[tg][countof_pair] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
            find_room(space_impure, tg, type_pair, size_pair, p);
          }
          INITCAR(p) = Scar(pp);
          INITCDR(p) = qq;
        }
    } else if (t == type_closure) {
        ptr code;

      /* relocate before accessing code type field, which otherwise might
         be a forwarding marker */
        code = CLOSCODE(pp);
        relocate(&code)
        if (CODETYPE(code) & (code_flag_continuation << code_flags_offset)) {
#ifdef ENABLE_OBJECT_COUNTS
            S_G.countof[tg][countof_continuation] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
            find_room(space_continuation, tg,
                        type_closure, size_continuation, p);
            SETCLOSCODE(p,code);
          /* don't promote one-shots */
            CONTLENGTH(p) = CONTLENGTH(pp);
            CONTCLENGTH(p) = CONTCLENGTH(pp);
            CONTWINDERS(p) = CONTWINDERS(pp);
            if (CONTLENGTH(p) != scaled_shot_1_shot_flag) {
                CONTLINK(p) = CONTLINK(pp);
                CONTRET(p) = CONTRET(pp);
                CONTSTACK(p) = CONTSTACK(pp);
            }
        } else {
            iptr len, n;
            len = CLOSLEN(pp);
            n = size_closure(len);
#ifdef ENABLE_OBJECT_COUNTS
            S_G.countof[tg][countof_closure] += 1;
            S_G.bytesof[tg][countof_closure] += n;
#endif /* ENABLE_OBJECT_COUNTS */
            find_room(space_pure, tg, type_closure, n, p);
            copy_ptrs(type_closure, p, pp, n);
            SETCLOSCODE(p,code);
         /* pad if necessary */
            if ((len & 1) == 0) CLOSIT(p, len) = FIX(0);
        }
    } else if (t == type_symbol) {
#ifdef ENABLE_OBJECT_COUNTS
        S_G.countof[tg][countof_symbol] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
        find_room(space_symbol, tg, type_symbol, size_symbol, p);
        INITSYMVAL(p) = SYMVAL(pp);
        INITSYMPVAL(p) = SYMPVAL(pp);
        INITSYMPLIST(p) = SYMPLIST(pp);
        INITSYMSPLIST(p) = SYMSPLIST(pp);
        INITSYMNAME(p) = SYMNAME(pp);
        INITSYMHASH(p) = SYMHASH(pp);
    } else if (t == type_flonum) {
#ifdef ENABLE_OBJECT_COUNTS
        S_G.countof[tg][countof_flonum] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
        find_room(space_data, tg, type_flonum, size_flonum, p);
        FLODAT(p) = FLODAT(pp);
      /* no room for forwarding address, so let 'em be duplicated */
        return p;
    } else {
      S_error_abort("copy(gc): illegal type");
      return (ptr)0 /* not reached */;
    }

    FWDMARKER(pp) = forward_marker;
    FWDADDRESS(pp) = p;

    return p;
}

static void sweep_ptrs(pp, n) ptr *pp; iptr n; {
  ptr *end = pp + n;

  while (pp != end) {
    relocate(pp)
    pp += 1;
  }
}

static void sweep(ptr tc, ptr p, IBOOL sweep_pure) {
  ptr tf; ITYPE t;

  if ((t = TYPEBITS(p)) == type_pair) {
    if ((SPACE(p) & ~(space_locked | space_old)) != space_weakpair) {
      relocate(&INITCAR(p))
    }
    relocate(&INITCDR(p))
  } else if (t == type_closure) {
    if (sweep_pure) {
      ptr code;

      code = CLOSCODE(p);
      relocate(&code)
        SETCLOSCODE(p,code);
      if (CODETYPE(code) & (code_flag_continuation << code_flags_offset))
        sweep_continuation(p);
      else
        sweep_ptrs(&CLOSIT(p, 0), CLOSLEN(p));
    }
  } else if (t == type_symbol) {
    sweep_symbol(p);
  } else if (t == type_flonum) {
    /* nothing to sweep */;
 /* typed objects */
  } else if (tf = TYPEFIELD(p), TYPEP(tf, mask_fixnum, type_fixnum)) {
    sweep_ptrs(&INITVECTIT(p, 0), UNFIX(tf));
  } else if (TYPEP(tf, mask_string, type_string) || TYPEP(tf, mask_bytevector, type_bytevector) || TYPEP(tf, mask_fxvector, type_fxvector)) {
    /* nothing to sweep */;
  } else if (TYPEP(tf, mask_record, type_record)) {
    relocate(&RECORDINSTTYPE(p));
    if (sweep_pure || RECORDDESCMPM(RECORDINSTTYPE(p)) != FIX(0)) {
      sweep_record(p);
    }
  } else if ((iptr)tf == type_box) {
    relocate(&INITBOXREF(p))
  } else if ((iptr)tf == type_ratnum) {
    if (sweep_pure) {
      relocate(&RATNUM(p))
      relocate(&RATDEN(p))
    }
  } else if ((iptr)tf == type_exactnum) {
    if (sweep_pure) {
      relocate(&EXACTNUM_REAL_PART(p))
      relocate(&EXACTNUM_IMAG_PART(p))
    }
  } else if ((iptr)tf == type_inexactnum) {
    /* nothing to sweep */;
  } else if (TYPEP(tf, mask_bignum, type_bignum)) {
    /* nothing to sweep */;
  } else if (TYPEP(tf, mask_port, type_port)) {
    sweep_port(p);
  } else if (TYPEP(tf, mask_code, type_code)) {
    if (sweep_pure) {
      sweep_code_object(tc, p);
    }
  } else if ((iptr)tf == type_thread) {
    sweep_thread(p);
  } else if ((iptr)tf == type_rtd_counts) {
    /* nothing to sweep */;
  } else {
    S_error_abort("sweep(gc): illegal type");
  }
}

static ptr copy_stack(old, length, clength) ptr old; iptr *length, clength; {
  iptr n, m; ptr new;

  /* Don't copy non-oldspace stacks, since we may be sweeping a locked
     continuation that is older than target_generation.  Doing so would
     be a waste of work anyway. */
  if (!OLDSPACE(old)) return old;

  /* reduce headroom created for excessively large frames (typically resulting from apply with long lists) */
  if ((n = *length) != clength && n > default_stack_size && n > (m = clength + one_shot_headroom)) {
    *length = n = m;
  }

  n = ptr_align(n);
#ifdef ENABLE_OBJECT_COUNTS
  S_G.countof[target_generation][countof_stack] += 1;
  S_G.bytesof[target_generation][countof_stack] += n;
#endif /* ENABLE_OBJECT_COUNTS */
  find_room(space_data, target_generation, typemod, n, new);
  n = ptr_align(clength);
 /* warning: stack may have been left non-double-aligned by split_and_resize */
  copy_ptrs(typemod, new, old, n);

 /* also returning possibly updated value in *length */
  return new;
}

#define NONSTATICINHEAP(si, x) (!IMMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && si->generation != static_generation)
#define ALWAYSTRUE(si, x) (si = SegInfo(ptr_get_segment(x)), 1)
#define partition_guardians(LS, FILTER) { \
  ptr ls; seginfo *si;\
  for (ls = LS; ls != Snil; ls = next) { \
    obj = GUARDIANOBJ(ls); \
    next = GUARDIANNEXT(ls); \
 \
    if (FILTER(si, obj)) { \
      if (!(si->space & space_old) || locked(obj)) { \
        INITGUARDIANNEXT(ls) = pend_hold_ls; \
        pend_hold_ls = ls; \
      } else if (FWDMARKER(obj) == forward_marker && TYPEBITS(obj) != type_flonum) { \
        INITGUARDIANOBJ(ls) = FWDADDRESS(obj); \
        INITGUARDIANNEXT(ls) = pend_hold_ls; \
        pend_hold_ls = ls; \
      } else { \
        tconc = GUARDIANTCONC(ls); \
        if (!OLDSPACE(tconc) || locked(tconc)) { \
          INITGUARDIANNEXT(ls) = final_ls; \
          final_ls = ls; \
        } else if (FWDMARKER(tconc) == forward_marker) { \
          INITGUARDIANTCONC(ls) = FWDADDRESS(tconc); \
          INITGUARDIANNEXT(ls) = final_ls; \
          final_ls = ls; \
        } else { \
          INITGUARDIANNEXT(ls) = pend_final_ls; \
          pend_final_ls = ls; \
        } \
      } \
    } \
  } \
}

void GCENTRY(ptr tc, IGEN mcg, IGEN tg) {
    IGEN g; ISPC s;
    seginfo *oldspacesegments, *si, *nextsi;
    ptr ls;
    bucket_pointer_list *buckets_to_rebuild;
    ptr locked_oldspace_objects;

   /* flush instruction cache: effectively clear_code_mod but safer */
    for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
      ptr tc = (ptr)THREADTC(Scar(ls));
      S_flush_instruction_cache(tc);
    }

    tlcs_to_rehash = Snil;

    for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
      ptr tc = (ptr)THREADTC(Scar(ls));
      S_scan_dirty((ptr **)EAP(tc), (ptr **)REAL_EAP(tc));
      EAP(tc) = REAL_EAP(tc) = AP(tc) = (ptr)0;
    }

   /* perform after ScanDirty */
    if (S_checkheap) S_check_heap(0);

#ifdef DEBUG
(void)printf("mcg = %x;  go? ", mcg); (void)fflush(stdout); (void)getc(stdin);
#endif

    target_generation = tg;
    max_copied_generation = mcg;

  /* set up generations to be copied */
    for (s = 0; s <= max_real_space; s++)
        for (g = 0; g <= mcg; g++) {
            S_G.base_loc[s][g] = FIX(0);
            S_G.first_loc[s][g] = FIX(0);
            S_G.next_loc[s][g] = FIX(0);
            S_G.bytes_left[s][g] = 0;
            S_G.bytes_of_space[s][g] = 0;
        }

  /* set up target generation sweep_loc and orig_next_loc pointers */
    for (s = 0; s <= max_real_space; s++)
      orig_next_loc[s] = sweep_loc[s] = S_G.next_loc[s][tg];

  /* mark segments from which objects are to be copied */
    oldspacesegments = (seginfo *)NULL;
    for (s = 0; s <= max_real_space; s += 1) {
      for (g = 0; g <= mcg; g += 1) {
        for (si = S_G.occupied_segments[s][g]; si != NULL; si = nextsi) {
          nextsi = si->next;
          si->next = oldspacesegments;
          oldspacesegments = si;
          si->space = s | space_old; /* NB: implicitly clearing space_locked */
        }
        S_G.occupied_segments[s][g] = NULL;
      }
    }

#ifdef ENABLE_OBJECT_COUNTS
   /* clear object counts & bytes for copied generations; bump timestamp */
   {INT i;
    for (g = 0; g <= mcg; g += 1) {
      for (i = 0; i < countof_types; i += 1) {
        S_G.countof[g][i] = 0;
        S_G.bytesof[g][i] = 0;
      }
      if (g == 0) {
        S_G.gctimestamp[g] += 1;
      } else {
        S_G.gctimestamp[g] = S_G.gctimestamp[0];
      }
    }
   }
#endif /* ENABLE_OBJECT_COUNTS */

    /* pre-collection handling of locked objects. */

    /* create a single sorted_locked_object vector for all copied generations
     * to accelerate the search for locked objects in copy().  copy wants
     * a vector of some size n=2^k-1 so it doesn't have to check bounds */
    ls = Snil;
    /* note: append_bang and dosort reuse pairs, which can result in older
     * objects pointing to newer ones...but we don't care since they are all
     * oldspace and going away after this collection. */
    for (g = 0; g <= mcg; g += 1) {
      ls = append_bang(S_G.locked_objects[g], ls);
      S_G.locked_objects[g] = Snil;
      S_G.unlocked_objects[g] = Snil;
    }
    if (ls == Snil) {
      sorted_locked_objects = FIX(0);
      locked_oldspace_objects = Snil;
    } else {
      ptr v, x, y; uptr i, n;

      /* dosort is destructive, so have to store the result back */
      locked_oldspace_objects = ls = dosort(ls, list_length(ls));

      /* create vector of smallest size n=2^k-1 that will fit all of
         the list's unique elements */
      i = count_unique(ls);
      for (n = 1; n < i; n = (n << 1) | 1);
      sorted_locked_objects = v = S_vector_in(space_new, 0, n);

      /* copy list elements in, skipping duplicates */
      INITVECTIT(v,0) = x = Scar(ls);
      i = 1;
      while ((ls = Scdr(ls)) != Snil) {
        if ((y = Scar(ls)) != x) {
          INITVECTIT(v, i) = x = y;
          i += 1;
        }
      }

      /* fill remaining slots with largest ptr value */
      while (i < n) { INITVECTIT(v, i) = MAXPTR; i += 1; }
    }

    /* sweep older locked and unlocked objects */
    for (g = mcg + 1; g <= static_generation; INCRGEN(g)) {
      for (ls = S_G.locked_objects[g]; ls != Snil; ls = Scdr(ls))
        sweep(tc, Scar(ls), 0);
      for (ls = S_G.unlocked_objects[g]; ls != Snil; ls = Scdr(ls))
        sweep(tc, Scar(ls), 0);
    }

    /* sweep younger locked objects, working from sorted vector to avoid redundant sweeping of duplicates */
    if (sorted_locked_objects != FIX(0)) {
      uptr i; ptr x, v, *vp;
      v = sorted_locked_objects;
      i = Svector_length(v);
      x = *(vp = &INITVECTIT(v, 0));
      do sweep(tc, x, 1); while (--i != 0 && (x = *++vp) != MAXPTR);
    }
  /* sweep non-oldspace threads, since any thread may have an active stack */
    for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
      ptr thread;

    /* someone may have their paws on the list */
      if (FWDMARKER(ls) == forward_marker) ls = FWDADDRESS(ls);

      thread = Scar(ls);
      if (!OLDSPACE(thread)) sweep_thread(thread);
    }
    relocate(&S_threads)

  /* relocate nonempty oldspace symbols and set up list of buckets to rebuild later */
    buckets_to_rebuild = NULL;
    for (g = 0; g <= mcg; g += 1) {
      bucket_list *bl, *blnext; bucket *b; bucket_pointer_list *bpl; bucket **oblist_cell; ptr sym; iptr idx;
      for (bl = S_G.buckets_of_generation[g]; bl != NULL; bl = blnext) {
        blnext = bl->cdr;
        b = bl->car;
        /* mark this bucket old for the rebuilding loop */
        b->next = (bucket *)((uptr)b->next | 1);
        sym = b->sym;
        idx = UNFIX(SYMHASH(sym)) % S_G.oblist_length;
        oblist_cell = &S_G.oblist[idx];
        if (!((uptr)*oblist_cell & 1)) {
          /* mark this bucket in the set */
          *oblist_cell = (bucket *)((uptr)*oblist_cell | 1);
          /* repurpose the bucket list element for the list of buckets to rebuild later */
          /* idiot_checks verifies these have the same size */
          bpl = (bucket_pointer_list *)bl;
          bpl->car = oblist_cell;
          bpl->cdr = buckets_to_rebuild;
          buckets_to_rebuild = bpl;
        }
        if (FWDMARKER(sym) != forward_marker &&
            /* coordinate with alloc.c */
            (SYMVAL(sym) != sunbound || SYMPLIST(sym) != Snil || SYMSPLIST(sym) != Snil))
          (void)copy(sym, SPACE(sym));
      }
      S_G.buckets_of_generation[g] = NULL;
    }

  /* relocate the protected C pointers */
    {uptr i;
     for (i = 0; i < S_G.protect_next; i++)
         relocate(S_G.protected[i])
    }

  /* sweep areas marked dirty by assignments into older generations */
    sweep_dirty();

    sweep_generation(tc, tg);

  /* handle guardians */
    {   ptr hold_ls, pend_hold_ls, final_ls, pend_final_ls;
        ptr obj, rep, tconc, next;

      /* move each entry in guardian lists into one of:
       *   pend_hold_ls     if obj accessible
       *   final_ls         if obj not accessible and tconc accessible
       *   pend_final_ls    if obj not accessible and tconc not accessible */
        pend_hold_ls = final_ls = pend_final_ls = Snil;

        for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
          ptr tc = (ptr)THREADTC(Scar(ls));
          partition_guardians(GUARDIANENTRIES(tc), NONSTATICINHEAP);
          GUARDIANENTRIES(tc) = Snil;
        }

        for (g = 0; g <= mcg; g += 1) {
          partition_guardians(S_G.guardians[g], ALWAYSTRUE);
          S_G.guardians[g] = Snil;
        }

       /* invariants after partition_guardians:
        * for entry in pend_hold_ls, obj is !OLDSPACE or locked
        * for entry in final_ls, obj is OLDSPACE and !locked
        * for entry in final_ls, tconc is !OLDSPACE or locked
        * for entry in pend_final_ls, obj and tconc are OLDSPACE and !locked
        */

        hold_ls = S_G.guardians[tg];
        while (1) {
            IBOOL relocate_rep = final_ls != Snil;

          /* relocate & add the final objects to their tconcs */
            for (ls = final_ls; ls != Snil; ls = GUARDIANNEXT(ls)) {
                ptr old_end, new_end;

                rep = GUARDIANREP(ls);
                relocate(&rep);

              /* if tconc was old it's been forwarded */
                tconc = GUARDIANTCONC(ls);

                old_end = Scdr(tconc);
                /* allocating pair in tg means it will be swept, which is wasted effort, but should cause no harm */
                new_end = S_cons_in(space_impure, tg, FIX(0), FIX(0));
#ifdef ENABLE_OBJECT_COUNTS
                S_G.countof[tg][countof_pair] += 1;
#endif /* ENABLE_OBJECT_COUNTS */

                SETCAR(old_end,rep);
                SETCDR(old_end,new_end);
                SETCDR(tconc,new_end);
            }

            /* discard static pend_hold_ls entries */
            if (tg != static_generation) {
                /* copy each entry in pend_hold_ls into hold_ls if tconc accessible */
                ls = pend_hold_ls; pend_hold_ls = Snil;
                for ( ; ls != Snil; ls = next) {
                    tconc = GUARDIANTCONC(ls); next = GUARDIANNEXT(ls); ptr p;
        
                    if (OLDSPACE(tconc) && !locked(tconc)) {
                        if (FWDMARKER(tconc) == forward_marker)
                            tconc = FWDADDRESS(tconc);
                        else {
                            INITGUARDIANNEXT(ls) = pend_hold_ls;
                            pend_hold_ls = ls;
                            continue;
                        }
                    }
        
                    rep = GUARDIANREP(ls);
                    relocate(&rep);
                    relocate_rep = 1;

#ifdef ENABLE_OBJECT_COUNTS
                    S_G.countof[tg][countof_guardian] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
                    find_room(space_pure, tg, typemod, size_guardian_entry, p);
                    INITGUARDIANOBJ(p) = GUARDIANOBJ(ls);
                    INITGUARDIANREP(p) = rep;
                    INITGUARDIANTCONC(p) = tconc;
                    INITGUARDIANNEXT(p) = hold_ls;
                    hold_ls = p;
                }
            }

            if (!relocate_rep) break;

            sweep_generation(tc, tg);

          /* move each entry in pend_final_ls into one of:
           *   final_ls         if tconc forwarded
           *   pend_final_ls    if tconc not forwarded */
            ls = pend_final_ls; final_ls = pend_final_ls = Snil;
            for ( ; ls != Snil; ls = next) {
                tconc = GUARDIANTCONC(ls); next = GUARDIANNEXT(ls);

                if (FWDMARKER(tconc) == forward_marker) {
                    INITGUARDIANTCONC(ls) = FWDADDRESS(tconc);
                    INITGUARDIANNEXT(ls) = final_ls;
                    final_ls = ls;
                } else {
                    INITGUARDIANNEXT(ls) = pend_final_ls;
                    pend_final_ls = ls;
                }
            }
        }

        S_G.guardians[tg] = hold_ls;
    }

  /* handle weak pairs */
    resweep_dirty_weak_pairs();
    resweep_weak_pairs(tg);

   /* forward car fields of locked and unlocked older weak pairs */
    for (g = mcg + 1; g <= static_generation; INCRGEN(g)) {
      for (ls = S_G.locked_objects[g]; ls != Snil; ls = Scdr(ls)) {
        ptr x = Scar(ls);
        if (Spairp(x) && (SPACE(x) & ~(space_old|space_locked)) == space_weakpair)
          forward_or_bwp(&INITCAR(x), Scar(x));
      }
      for (ls = S_G.unlocked_objects[g]; ls != Snil; ls = Scdr(ls)) {
        ptr x = Scar(ls);
        if (Spairp(x) && (SPACE(x) & ~(space_old|space_locked)) == space_weakpair)
          forward_or_bwp(&INITCAR(x), Scar(x));
      }
    }

   /* forward car fields of locked oldspace weak pairs */
    if (sorted_locked_objects != FIX(0)) {
      uptr i; ptr x, v, *vp;
      v = sorted_locked_objects;
      i = Svector_length(v);
      x = *(vp = &INITVECTIT(v, 0));
      do {
        if (Spairp(x) && (SPACE(x) & ~(space_old|space_locked)) == space_weakpair) {
          forward_or_bwp(&INITCAR(x), Scar(x));
        }
      } while (--i != 0 && (x = *++vp) != MAXPTR);
    }

   /* post-gc oblist handling.  rebuild old buckets in the target generation, pruning unforwarded symbols */
    { bucket_list *bl, *blnext; bucket *b, *bnext; bucket_pointer_list *bpl; bucket **pb; ptr sym;
      bl = tg == static_generation ? NULL : S_G.buckets_of_generation[tg];
      for (bpl = buckets_to_rebuild; bpl != NULL; bpl = bpl->cdr) {
        pb = bpl->car;
        for (b = (bucket *)((uptr)*pb - 1); b != NULL && ((uptr)(b->next) & 1); b = bnext) {
          bnext = (bucket *)((uptr)(b->next) - 1);
          sym = b->sym;
          if (locked(sym) || (FWDMARKER(sym) == forward_marker && ((sym = FWDADDRESS(sym)) || 1))) {
            find_room(space_data, tg, typemod, sizeof(bucket), b);
#ifdef ENABLE_OBJECT_COUNTS
            S_G.countof[tg][countof_oblist] += 1;
            S_G.bytesof[tg][countof_oblist] += sizeof(bucket);
#endif /* ENABLE_OBJECT_COUNTS */
            b->sym = sym;
            *pb = b;
            pb = &b->next;
            if (tg != static_generation) {
              blnext = bl;
              find_room(space_data, tg, typemod, sizeof(bucket_list), bl);
#ifdef ENABLE_OBJECT_COUNTS
              S_G.countof[tg][countof_oblist] += 1;
              S_G.bytesof[tg][countof_oblist] += sizeof(bucket_list);
#endif /* ENABLE_OBJECT_COUNTS */
              bl->cdr = blnext;
              bl->car = b;
            }
          } else {
            S_G.oblist_count -= 1;
          }
        }
        *pb = b;
      }
      if (tg != static_generation) S_G.buckets_of_generation[tg] = bl;
    }

  /* rebuild rtds_with_counts lists, dropping otherwise inaccessible rtds */
    { IGEN g; ptr ls, p, newls = tg == mcg ? Snil : S_G.rtds_with_counts[tg];
      for (g = 0; g <= mcg; g += 1) {
        for (ls = S_G.rtds_with_counts[g], S_G.rtds_with_counts[g] = Snil; ls != Snil; ls = Scdr(ls)) {
          p = Scar(ls);
          if (!OLDSPACE(p) || locked(p)) {
            newls = S_cons_in(space_impure, tg, p, newls);
            S_G.countof[tg][countof_pair] += 1;
          } else if (FWDMARKER(p) == forward_marker) {
            newls = S_cons_in(space_impure, tg, FWDADDRESS(p), newls);
            S_G.countof[tg][countof_pair] += 1;
          }
        }
      }
      S_G.rtds_with_counts[tg] = newls;
    }

#ifndef WIN32
  /* rebuild child_process list, reaping any that have died and refusing
     to promote into the static generation. */
    {
      ptr old_ls, new_ls; IGEN gtmp, cpgen;
      cpgen = tg == static_generation ? S_G.max_nonstatic_generation : tg;
      new_ls = cpgen <= mcg ? Snil : S_child_processes[cpgen];
      for (gtmp = 0; gtmp <= mcg; gtmp += 1) {
        for (old_ls = S_child_processes[gtmp]; old_ls != Snil; old_ls = Scdr(old_ls)) {
          INT pid = UNFIX(Scar(old_ls)), status, retpid;
          retpid = waitpid(pid, &status, WNOHANG);
          if (retpid == 0 || (retpid == pid && !(WIFEXITED(status) || WIFSIGNALED(status)))) {
            new_ls = S_cons_in(space_impure, cpgen, FIX(pid), new_ls);
#ifdef ENABLE_OBJECT_COUNTS
            S_G.countof[cpgen][countof_pair] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
          }
        }
        S_child_processes[gtmp] = Snil;
      }
      S_child_processes[cpgen] = new_ls;
    }
#endif /* WIN32 */

   /* post-collection handling of locked objects.  This must come after
      any use of relocate or any other use of sorted_locked_objects */
    if (sorted_locked_objects != FIX(0)) {
      ptr ls, lsnew, x, v, *vp; iptr i;

      v = sorted_locked_objects;
      lsnew = tg == mcg ? Snil : S_G.locked_objects[tg];

      /* work from sorted vector to avoid redundant processing of duplicates */
      i = Svector_length(v);
      x = *(vp = &INITVECTIT(v, 0));
      do {
        ptr a1, a2; uptr seg; uptr n;

        /* promote the segment(s) containing x to the target generation.
           reset the space_old bit to prevent the segments from being
           reclaimed; set the locked bit to prevent sweeping by
           sweep_dirty (since the segments may contain a mix of objects,
           many of which have been discarded). */
        n = size_object(x);
#ifdef ENABLE_OBJECT_COUNTS
        S_G.countof[target_generation][countof_locked] += 1;
        S_G.bytesof[target_generation][countof_locked] += n;
#endif /* ENABLE_OBJECT_COUNTS */

        a1 = UNTYPE_ANY(x);
        a2 = (ptr)((uptr)a1 + n - 1);
        for (seg = addr_get_segment(a1); seg <= addr_get_segment(a2); seg += 1) {
          seginfo *si = SegInfo(seg);
          si->generation = tg;
          si->space = (si->space & ~space_old) | space_locked;
        }
      } while (--i != 0 && (x = *++vp) != MAXPTR);

      /* append entire list, including duplicates, to target-generation list.  we do so
         even when tg == static_generation so we can keep track of static objects that need to
         be swept at the start of collection.  (we could weed out pure static objects.) */
      for (ls = locked_oldspace_objects; ls != Snil; ls = Scdr(ls)) {
        lsnew = S_cons_in(space_impure, tg, Scar(ls), lsnew);
#ifdef ENABLE_OBJECT_COUNTS
        S_G.countof[tg][countof_pair] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
      }

      S_G.locked_objects[tg] = lsnew;
    }

  /* move old space segments to empty space */
    for (si = oldspacesegments; si != NULL; si = nextsi) {
      nextsi = si->next;
      s = si->space;
      if (s & space_locked) {
        /* note: the oldspace bit is cleared above for locked objects */
        s &= ~space_locked;
        g = si->generation;
        if (g == static_generation) S_G.number_of_nonstatic_segments -= 1;
        si->next = S_G.occupied_segments[s][g];
        S_G.occupied_segments[s][g] = si;
      } else {
        chunkinfo *chunk = si->chunk;
        if (si->generation != static_generation) S_G.number_of_nonstatic_segments -= 1;
        S_G.number_of_empty_segments += 1;
        si->space = space_empty;
        si->next = chunk->unused_segs;
        chunk->unused_segs = si;
#ifdef WIPECLEAN
        memset((void *)build_ptr(seg,0), 0xc7, bytes_per_segment);
#endif
        if ((chunk->nused_segs -= 1) == 0) {
          if (chunk->bytes != (minimum_segment_request + 1) * bytes_per_segment) {
            /* release oversize chunks back to the O/S immediately to avoid allocating
             * small stuff into them and thereby invite fragmentation */
            S_free_chunk(chunk);
          } else {
            S_move_to_chunk_list(chunk, &S_chunks[PARTIAL_CHUNK_POOLS]);
          }
        } else {
          S_move_to_chunk_list(chunk, &S_chunks[PARTIAL_CHUNK_POOLS-1]);
        }
      }
    }

    if (mcg >= S_G.min_free_gen) S_free_chunks();

    S_flush_instruction_cache(tc);

    if (S_checkheap) S_check_heap(1);

   /* post-collection rehashing of tlcs.
      must come after any use of relocate.
      logically comes after gc is entirely complete */
    while (tlcs_to_rehash != Snil) {
      ptr b, next; uptr old_idx, new_idx;
      ptr tlc = Scar(tlcs_to_rehash);
      ptr ht = TLCHT(tlc);
      ptr vec = PTRFIELD(ht,eq_hashtable_vec_disp);
      uptr veclen = Svector_length(vec);
      ptr key = Scar(TLCKEYVAL(tlc));
  
     /* scan to end of bucket to find the index */
      for (b = TLCNEXT(tlc); !Sfixnump(b); b = TLCNEXT(b));
      old_idx = UNFIX(b);

      if (key == Sbwp_object && PTRFIELD(ht,eq_hashtable_weakp_disp) != Sfalse) {
       /* remove tlc */
        b = Svector_ref(vec, old_idx);
        if (b == tlc) {
          SETVECTIT(vec, old_idx, TLCNEXT(b));
        } else {
          for (;;) { next = TLCNEXT(b); if (next == tlc) break; b = next; }
          SETTLCNEXT(b,TLCNEXT(next));
        }
        INITTLCNEXT(tlc) = Sfalse;
        INITPTRFIELD(ht,eq_hashtable_size_disp) = FIX(UNFIX(PTRFIELD(ht,eq_hashtable_size_disp)) - 1);
      } else if ((new_idx = ((uptr)key >> primary_type_bits) & (veclen - 1)) != old_idx) {
       /* remove tlc from old bucket */
        b = Svector_ref(vec, old_idx);
        if (b == tlc) {
          SETVECTIT(vec, old_idx, TLCNEXT(b));
        } else {
          for (;;) { next = TLCNEXT(b); if (next == tlc) break; b = next; }
          SETTLCNEXT(b,TLCNEXT(next));
        }
       /* and add to new bucket */
        SETTLCNEXT(tlc, Svector_ref(vec, new_idx));
        SETVECTIT(vec, new_idx, tlc);
      }
      tlcs_to_rehash = Scdr(tlcs_to_rehash);
    }

    S_resize_oblist();
}

#define sweep_space(s, body)\
    slp = &sweep_loc[s];\
    nlp = &S_G.next_loc[s][g];\
    if (*slp == 0) *slp = S_G.first_loc[s][g];\
    pp = (ptr *)*slp;\
    while (pp != (nl = (ptr *)*nlp))\
        do\
            if ((p = *pp) == forward_marker)\
                pp = (ptr *)*(pp + 1);\
            else\
                body\
        while (pp != nl);\
    *slp = (ptr)pp;

static void resweep_weak_pairs(g) IGEN g; {
    ptr *slp, *nlp; ptr *pp, p, *nl;

    sweep_loc[space_weakpair] = S_G.first_loc[space_weakpair][g];
    sweep_space(space_weakpair, {
        forward_or_bwp(pp, p);
        pp += 2;
    })
}

static void forward_or_bwp(pp, p) ptr *pp; ptr p; {
  seginfo *si;
 /* adapted from relocate */
  if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->space & space_old && !locked(p)) {
    if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) {
      *pp = FWDADDRESS(p);
    } else {
      *pp = Sbwp_object;
    }
  }
}

static void sweep_generation(tc, g) ptr tc; IGEN g; {
  ptr *slp, *nlp; ptr *pp, p, *nl;

  do {
    change = 0;
    sweep_space(space_impure, {
        relocate_help(pp, p)
        p = *(pp += 1);
        relocate_help(pp, p)
        pp += 1;
    })

    sweep_space(space_symbol, {
        p = TYPE((ptr)pp, type_symbol);
        sweep_symbol(p);
        pp += size_symbol / sizeof(ptr);
    })

    sweep_space(space_port, {
        p = TYPE((ptr)pp, type_typed_object);
        sweep_port(p);
        pp += size_port / sizeof(ptr);
    })

    sweep_space(space_weakpair, {
        p = *(pp += 1);
        relocate_help(pp, p)
        pp += 1;
    })

    sweep_space(space_pure, {
        relocate_help(pp, p)
        p = *(pp += 1);
        relocate_help(pp, p)
        pp += 1;
    })

    sweep_space(space_continuation, {
        p = TYPE((ptr)pp, type_closure);
        sweep_continuation(p);
        pp += size_continuation / sizeof(ptr);
    })

    sweep_space(space_pure_typed_object, {
        p = TYPE((ptr)pp, type_typed_object);
        pp = (ptr *)((uptr)pp + sweep_typed_object(p));
    })

    sweep_space(space_code, {
        p = TYPE((ptr)pp, type_typed_object);
        sweep_code_object(tc, p);
        pp += size_code(CODELEN(p)) / sizeof(ptr);
    })

    sweep_space(space_impure_record, {
        p = TYPE((ptr)pp, type_typed_object);
        sweep_record(p);
        pp = (ptr *)((iptr)pp +
               size_record_inst(UNFIX(RECORDDESCSIZE(RECORDINSTTYPE(p)))));
    })
  } while (change);
}

static iptr size_object(p) ptr p; {
    ITYPE t; ptr tf;

    if ((t = TYPEBITS(p)) == type_pair) {
        return size_pair;
    } else if (t == type_closure) {
        ptr code = CLOSCODE(p);
        if (CODETYPE(code) & (code_flag_continuation << code_flags_offset))
            return size_continuation;
        else
            return size_closure(CLOSLEN(p));
    } else if (t == type_symbol) {
        return size_symbol;
    } else if (t == type_flonum) {
        return size_flonum;
  /* typed objects */
    } else if (tf = TYPEFIELD(p), TYPEP(tf, mask_fixnum, type_fixnum)) {
        return size_vector(Svector_length(p));
    } else if (TYPEP(tf, mask_string, type_string)) {
        return size_string(Sstring_length(p));
    } else if (TYPEP(tf, mask_bytevector, type_bytevector)) {
        return size_bytevector(Sbytevector_length(p));
    } else if (TYPEP(tf, mask_record, type_record)) {
        return size_record_inst(UNFIX(RECORDDESCSIZE(tf)));
    } else if (TYPEP(tf, mask_fxvector, type_fxvector)) {
        return size_fxvector(Sfxvector_length(p));
    } else if ((iptr)tf == type_box) {
        return size_box;
    } else if ((iptr)tf == type_ratnum) {
        return size_ratnum;
    } else if ((iptr)tf == type_exactnum) {
        return size_exactnum;
    } else if ((iptr)tf == type_inexactnum) {
        return size_inexactnum;
    } else if (TYPEP(tf, mask_bignum, type_bignum)) {
        return size_bignum(BIGLEN(p));
    } else if (TYPEP(tf, mask_port, type_port)) {
        return size_port;
    } else if (TYPEP(tf, mask_code, type_code)) {
        return size_code(CODELEN(p));
    } else if ((iptr)tf == type_thread) {
        return size_thread;
    } else if ((iptr)tf == type_rtd_counts) {
        return size_rtd_counts;
    } else {
        S_error_abort("size_object(gc): illegal type");
        return 0 /* not reached */;
    }
}

static iptr sweep_typed_object(p) ptr p; {
  ptr tf = TYPEFIELD(p);

  if (TYPEP(tf, mask_record, type_record)) {
    sweep_record(p);
    return size_record_inst(UNFIX(RECORDDESCSIZE(RECORDINSTTYPE(p))));
  } else if (TYPEP(tf, mask_thread, type_thread)) {
    sweep_thread(p);
    return size_thread;
  } else {
      S_error_abort("sweep_typed_object(gc): unexpected type");
      return 0 /* not reached */;
  }
}

static void sweep_symbol(p) ptr p; {
  ptr val, code;

  val = SYMVAL(p);
  relocate(&val);
  INITSYMVAL(p) = val;
  code = Sprocedurep(val) ? CLOSCODE(val) : SYMCODE(p);
  relocate(&code);
  INITSYMCODE(p,code);
  relocate(&INITSYMPLIST(p))
  relocate(&INITSYMSPLIST(p))
  relocate(&INITSYMNAME(p))
  relocate(&INITSYMHASH(p))
}

static void sweep_port(p) ptr p; {
  relocate(&PORTHANDLER(p))
  relocate(&PORTINFO(p))
  relocate(&PORTNAME(p))

  if (PORTTYPE(p) & PORT_FLAG_OUTPUT) {
    iptr n = (iptr)PORTOLAST(p) - (iptr)PORTOBUF(p);
    relocate(&PORTOBUF(p))
    PORTOLAST(p) = (ptr)((iptr)PORTOBUF(p) + n);
  }

  if (PORTTYPE(p) & PORT_FLAG_INPUT) {
    iptr n = (iptr)PORTILAST(p) - (iptr)PORTIBUF(p);
    relocate(&PORTIBUF(p))
    PORTILAST(p) = (ptr)((iptr)PORTIBUF(p) + n);
  }
}

static void sweep_thread(p) ptr p; {
  ptr tc = (ptr)THREADTC(p);
  INT i;

  if (tc != (ptr)0) {
    ptr old_stack = SCHEMESTACK(tc);
    if (OLDSPACE(old_stack)) {
      iptr clength = (uptr)SFP(tc) - (uptr)old_stack;
     /* include SFP[0], which contains the return address */
      SCHEMESTACK(tc) = copy_stack(old_stack, &SCHEMESTACKSIZE(tc), clength + sizeof(ptr));
      SFP(tc) = (ptr)((uptr)SCHEMESTACK(tc) + clength);
      ESP(tc) = (ptr)((uptr)SCHEMESTACK(tc) + SCHEMESTACKSIZE(tc) - stack_slop);
    }
    STACKCACHE(tc) = Snil;
    relocate(&CCHAIN(tc))
    /* U32 RANDOMSEED(tc) */
    /* I32 ACTIVE(tc) */
    relocate(&STACKLINK(tc))
    /* iptr SCHEMESTACKSIZE */
    relocate(&WINDERS(tc))
    relocate_return_addr(&FRAME(tc,0))
    sweep_stack((uptr)SCHEMESTACK(tc), (uptr)SFP(tc), (uptr)FRAME(tc,0));
    relocate(&U(tc))
    relocate(&V(tc))
    relocate(&W(tc))
    relocate(&X(tc))
    relocate(&Y(tc))
    /* immediate SOMETHINGPENDING(tc) */
    /* immediate TIMERTICKS */
    /* immediate DISABLE_COUNT */
    /* immediate SIGNALINTERRUPTPENDING */
    /* immediate KEYBOARDINTERRUPTPENDING */
    relocate(&THREADNO(tc))
    relocate(&CURRENTINPUT(tc))
    relocate(&CURRENTOUTPUT(tc))
    relocate(&CURRENTERROR(tc))
    /* immediate BLOCKCOUNTER */
    relocate(&SFD(tc))
    relocate(&TARGETMACHINE(tc))
    relocate(&FXLENGTHBV(tc))
    relocate(&FXFIRSTBITSETBV(tc))
    /* immediate METALEVEL */
    relocate(&COMPILEPROFILE(tc))
    /* immediate GENERATEINSPECTORINFORMATION */
    /* immediate GENERATEPROFILEFORMS */
    /* immediate OPTIMIZELEVEL */
    relocate(&PARAMETERS(tc))
    /* U64 INSTRCOUNTER(tc) */
    /* U64 ALLOCCOUNTER(tc) */
    for (i = 0 ; i < virtual_register_count ; i += 1) {
      relocate(&VIRTREG(tc, i));
    }
  }
}

static void sweep_continuation(p) ptr p; {
  relocate(&CONTWINDERS(p))

 /* bug out for shot 1-shot continuations */
  if (CONTLENGTH(p) == scaled_shot_1_shot_flag) return;

  if (OLDSPACE(CONTSTACK(p)))
    CONTSTACK(p) = copy_stack(CONTSTACK(p), &CONTLENGTH(p), CONTCLENGTH(p));

  relocate(&CONTLINK(p))
  relocate_return_addr(&CONTRET(p))

 /* use CLENGTH to avoid sweeping unoccupied portion of one-shots */
  sweep_stack((uptr)CONTSTACK(p), (uptr)CONTSTACK(p) + CONTCLENGTH(p), (uptr)CONTRET(p));
}

/* assumes stack has already been copied to newspace */
static void sweep_stack(base, fp, ret) uptr base, fp, ret; {
  ptr *pp; iptr oldret;
  ptr num;

  while (fp != base) {
    if (fp < base)
      S_error_abort("sweep_stack(gc): malformed stack");
    fp = fp - ENTRYFRAMESIZE(ret);
    pp = (ptr *)fp;

    oldret = ret;
    ret = (iptr)(*pp);
    relocate_return_addr(pp)

    num = ENTRYLIVEMASK(oldret);
    if (Sfixnump(num)) {
      uptr mask = UNFIX(num);
      while (mask != 0) {
        pp += 1;
        if (mask & 0x0001) relocate(pp)
        mask >>= 1;
      }
    } else {
      iptr index;

      relocate(&ENTRYLIVEMASK(oldret))
      num = ENTRYLIVEMASK(oldret);
      index = BIGLEN(num);
      while (index-- != 0) {
        INT bits = bigit_bits;
        bigit mask = BIGIT(num,index);
        while (bits-- > 0) {
          pp += 1;
          if (mask & 1) relocate(pp)
          mask >>= 1;
        }
      }
    }
  }
}

static void sweep_record(x) ptr x; {
    ptr *pp; ptr num; ptr rtd;

  /* record-type descriptor was forwarded in copy */
    rtd = RECORDINSTTYPE(x);
    num = RECORDDESCPM(rtd);
    pp = &RECORDINSTIT(x,0);

  /* sweep cells for which bit in pm is set; quit when pm == 0. */
    if (Sfixnump(num)) {
       /* ignore bit for already forwarded rtd */
        uptr mask = (uptr)UNFIX(num) >> 1;
        if (mask == (uptr)-1 >> 1) {
            ptr *ppend = (ptr *)((uptr)pp + UNFIX(RECORDDESCSIZE(rtd))) - 1;
            while (pp < ppend) {
                relocate(pp)
                pp += 1;
            }
        } else {
            while (mask != 0) {
                if (mask & 1) relocate(pp)
                mask >>= 1;
                pp += 1;
            }
        }
    } else {
        iptr index; bigit mask; INT bits;

       /* bignum pointer mask may have been forwarded */
        relocate(&RECORDDESCPM(rtd))
        num = RECORDDESCPM(rtd);
        index = BIGLEN(num) - 1;
       /* ignore bit for already forwarded rtd */
        mask = BIGIT(num,index) >> 1;
        bits = bigit_bits - 1;
        for (;;) {
            do {
                if (mask & 1) relocate(pp)
                mask >>= 1;
                pp += 1;
            } while (--bits > 0);
            if (index-- == 0) break;
            mask = BIGIT(num,index);
            bits = bigit_bits;
        }
    }
}

static IGEN sweep_dirty_record(x) ptr x; {
    ptr *pp; ptr num; ptr rtd; IGEN tg, youngest;

    tg = target_generation;
    youngest = 0xff;

   /* warning: assuming rtd is immutable */
    rtd = RECORDINSTTYPE(x);

   /* warning: assuming MPM field is immutable */
    num = RECORDDESCMPM(rtd);
    pp = &RECORDINSTIT(x,0);

  /* sweep cells for which bit in mpm is set
     include rtd in case it's mutable */
    if (Sfixnump(num)) {
       /* ignore bit for assumed immutable rtd */
        uptr mask = (uptr)UNFIX(num) >> 1;
        while (mask != 0) {
            if (mask & 1) relocate_dirty(pp,tg,youngest)
            mask >>= 1;
            pp += 1;
        }
    } else {
        iptr index; bigit mask; INT bits;

        index = BIGLEN(num) - 1;
       /* ignore bit for assumed immutable rtd */
        mask = BIGIT(num,index) >> 1;
        bits = bigit_bits - 1;
        for (;;) {
            do {
                if (mask & 1) relocate_dirty(pp,tg,youngest)
                mask >>= 1;
                pp += 1;
            } while (--bits > 0);
            if (index-- == 0) break;
            mask = BIGIT(num,index);
            bits = bigit_bits;
        }
    }

    return youngest;
}

static void sweep_code_object(tc, co) ptr tc, co; {
    ptr t, oldco; iptr a, m, n;

#ifdef DEBUG
    if ((CODETYPE(co) & mask_code) != type_code) {
      (void)printf("unexpected type %x sweeping code object %p\n", CODETYPE(co), co);
      (void)fflush(stdout);
    }
#endif

    relocate(&CODENAME(co))
    relocate(&CODEINFO(co))
    relocate(&CODEPINFOS(co))

    t = CODERELOC(co);
    m = RELOCSIZE(t);
    oldco = RELOCCODE(t);
    a = 0;
    n = 0;
    while (n < m) {
        uptr entry, item_off, code_off; ptr obj;
        entry = RELOCIT(t, n); n += 1;
        if (RELOC_EXTENDED_FORMAT(entry)) {
            item_off = RELOCIT(t, n); n += 1;
            code_off = RELOCIT(t, n); n += 1;
        } else {
            item_off = RELOC_ITEM_OFFSET(entry);
            code_off = RELOC_CODE_OFFSET(entry);
        }
        a += code_off;
        obj = S_get_code_obj(RELOC_TYPE(entry), oldco, a, item_off);
        relocate(&obj)
        S_set_code_obj("gc", RELOC_TYPE(entry), co, a, obj, item_off);
    }

    if (target_generation == static_generation && !S_G.retain_static_relocation) {
      CODERELOC(co) = (ptr)0;
    } else {
      /* Don't copy non-oldspace relocation tables, since we may be
         sweeping a locked code object that is older than target_generation
         Doing so would be a waste of work anyway. */
      if (OLDSPACE(t)) {
        ptr oldt = t;
        n = size_reloc_table(RELOCSIZE(oldt));
#ifdef ENABLE_OBJECT_COUNTS
        S_G.countof[target_generation][countof_relocation_table] += 1;
        S_G.bytesof[target_generation][countof_relocation_table] += n;
#endif /* ENABLE_OBJECT_COUNTS */
        find_room(space_data, target_generation, typemod, n, t);
        copy_ptrs(typemod, t, oldt, n);
      }
      RELOCCODE(t) = co;
      CODERELOC(co) = t;
    }

    S_record_code_mod(tc, (uptr)&CODEIT(co,0), (uptr)CODELEN(co));
}

typedef struct _weakseginfo {
  seginfo *si;
  IGEN youngest[cards_per_segment];
  struct _weakseginfo *next;
} weakseginfo;

static weakseginfo *weaksegments_to_resweep;

static void record_dirty_segment(IGEN from_g, IGEN to_g, seginfo *si) {
  if (si->min_dirty_byte != 0xff) {
    S_error_abort("record_dirty(gc): unexpected mutation while sweeping");
  }

  if (to_g < from_g) {
    seginfo *oldfirst = DirtySegments(from_g, to_g);
    DirtySegments(from_g, to_g) = si;
    si->dirty_prev = &DirtySegments(from_g, to_g);
    si->dirty_next = oldfirst;
    if (oldfirst != NULL) oldfirst->dirty_prev = &si->dirty_next;
    si->min_dirty_byte = to_g;
  }
}

static void sweep_dirty(void) {
  IGEN tg, mcg, youngest, min_youngest, pg;
  ptr *pp, *ppend, *nl;
  uptr seg, d;
  ISPC s;
  IGEN from_g, to_g;
  seginfo *dirty_si, *nextsi;

  tg = target_generation;
  mcg = max_copied_generation;
  weaksegments_to_resweep = NULL;

  /* clear dirty segment lists for copied generations */
  for (from_g = 1; from_g <= mcg; from_g += 1) {
    for (to_g = 0; to_g < from_g; to_g += 1) {
      DirtySegments(from_g, to_g) = NULL;
    }
  }

  /* NB: could have problems if a card is moved from some current or to-be-swept (from_g, to_g) to some previously
     swept list due to a dirty_set while we sweep.  believe this can't happen as of 6/14/2013.  if it can, it
     might be sufficient to process the lists in reverse order. */
  for (from_g = mcg + 1; from_g <= static_generation; INCRGEN(from_g)) {
    for (to_g = 0; to_g <= mcg; to_g += 1) {
      for (dirty_si = DirtySegments(from_g, to_g), DirtySegments(from_g, to_g) = NULL; dirty_si != NULL; dirty_si = nextsi) {
        nextsi = dirty_si->dirty_next;
        seg = dirty_si->number;
        s = dirty_si->space;

        if (s & space_locked) continue;

        /* reset min dirty byte so we can detect if byte is set while card is swept */
        dirty_si->min_dirty_byte = 0xff;

        min_youngest = 0xff;
        nl = from_g == tg ? (ptr *)orig_next_loc[s] : (ptr *)S_G.next_loc[s][from_g];
        ppend = build_ptr(seg, 0);

        if (s == space_weakpair) {
          weakseginfo *next = weaksegments_to_resweep;
          find_room(space_data, 0, typemod, sizeof(weakseginfo), weaksegments_to_resweep);
          weaksegments_to_resweep->si = dirty_si;
          weaksegments_to_resweep->next = next;
        }

        d = 0;
        while (d < cards_per_segment) {
          uptr dend = d + sizeof(iptr);
          iptr *dp = (iptr *)(dirty_si->dirty_bytes + d);
          /* check sizeof(iptr) bytes at a time for 0xff */
          if (*dp == -1) {
            pp = ppend;
            ppend += bytes_per_card;
            if (pp <= nl && nl < ppend) ppend = nl;
            d = dend;
          } else {
            while (d < dend) {
              pp = ppend;
              ppend += bytes_per_card / sizeof(ptr);
              if (pp <= nl && nl < ppend) ppend = nl;

              if (dirty_si->dirty_bytes[d] <= mcg) {
                /* assume we won't find any wrong-way pointers */
                youngest = 0xff;

                if (s == space_impure) {
                  while (pp < ppend && *pp != forward_marker) {
                    /* handle two pointers at a time */
                    relocate_dirty(pp,tg,youngest)
                    pp += 1;
                    relocate_dirty(pp,tg,youngest)
                    pp += 1;
                  }
                } else if (s == space_symbol) {
                  /* old symbols cannot overlap segment boundaries
                     since any object that spans multiple
                     generations begins at the start of a segment,
                     and symbols are much smaller (we assume)
                     than the segment size. */
                  pp = (ptr *)build_ptr(seg,0) +
                    ((pp - (ptr *)build_ptr(seg,0)) /
                     (size_symbol / sizeof(ptr))) *
                    (size_symbol / sizeof(ptr));

                  while (pp < ppend && *pp != forward_marker) { /* might overshoot card by part of a symbol.  no harm. */
                    ptr p, val, code;

                    p = TYPE((ptr)pp, type_symbol);

                    val = SYMVAL(p);
                    relocate_dirty(&val,tg,youngest)
                    INITSYMVAL(p) = val;
                    code = Sprocedurep(val) ? CLOSCODE(val) : SYMCODE(p);
                    relocate_dirty(&code,tg,youngest)
                    INITSYMCODE(p,code);
                    relocate_dirty(&INITSYMPLIST(p),tg,youngest)
                    relocate_dirty(&INITSYMSPLIST(p),tg,youngest)
                    relocate_dirty(&INITSYMNAME(p),tg,youngest)
                    relocate_dirty(&INITSYMHASH(p),tg,youngest)

                    pp += size_symbol / sizeof(ptr);
                  }
                } else if (s == space_port) {
                  /* old ports cannot overlap segment boundaries
                     since any object that spans multiple
                     generations begins at the start of a segment,
                     and ports are much smaller (we assume)
                     than the segment size. */
                  pp = (ptr *)build_ptr(seg,0) +
                    ((pp - (ptr *)build_ptr(seg,0)) /
                     (size_port / sizeof(ptr))) *
                    (size_port / sizeof(ptr));

                  while (pp < ppend && *pp != forward_marker) { /* might overshoot card by part of a port.  no harm. */
                    ptr p = TYPE((ptr)pp, type_typed_object);

                    relocate_dirty(&PORTHANDLER(p),tg,youngest)
                    relocate_dirty(&PORTINFO(p),tg,youngest)
                    relocate_dirty(&PORTNAME(p),tg,youngest)

                    if (PORTTYPE(p) & PORT_FLAG_OUTPUT) {
                      iptr n = (iptr)PORTOLAST(p) - (iptr)PORTOBUF(p);
                      relocate_dirty(&PORTOBUF(p),tg,youngest)
                      PORTOLAST(p) = (ptr)((iptr)PORTOBUF(p) + n);
                    }

                    if (PORTTYPE(p) & PORT_FLAG_INPUT) {
                      iptr n = (iptr)PORTILAST(p) - (iptr)PORTIBUF(p);
                      relocate_dirty(&PORTIBUF(p),tg,youngest)
                      PORTILAST(p) = (ptr)((iptr)PORTIBUF(p) + n);
                    }

                    pp += size_port / sizeof(ptr);
                  }
                } else if (s == space_impure_record) { /* abandon hope all ye who enter here */
                  uptr j; ptr p, pnext; seginfo *si;

                  /* synchronize on first record that overlaps the dirty
                     area, then relocate any mutable pointers in that
                     record and those that follow within the dirty area. */

                  /* find first segment of group of like segments */
                  j = seg - 1;
                  while ((si = MaybeSegInfo(j)) != NULL &&
                      si->space == s &&
                      si->generation == from_g)
                    j -= 1;
                  j += 1;

                  /* now find first record in segment seg */
                  /* we count on following fact: if an object spans two
                     or more segments, then he starts at the beginning
                     of a segment */
                  for (;;) {
                    p = TYPE(build_ptr(j,0),type_typed_object);
                    pnext = (ptr)((iptr)p +
                        size_record_inst(UNFIX(RECORDDESCSIZE(
                              RECORDINSTTYPE(p)))));
                    if (ptr_get_segment(pnext) >= seg) break;
                    j = ptr_get_segment(pnext) + 1;
                  }

                  /* now find first within dirty area */
                  while ((ptr *)UNTYPE(pnext, type_typed_object) <= pp) {
                    p = pnext;
                    pnext = (ptr)((iptr)p +
                        size_record_inst(UNFIX(RECORDDESCSIZE(
                              RECORDINSTTYPE(p)))));
                  }

                  /* now sweep */
                  while ((ptr *)UNTYPE(p, type_typed_object) < ppend) {
                    /* quit on end of segment */
                    if (FWDMARKER(p) == forward_marker) break;

                    pg = sweep_dirty_record(p);
                    if (pg < youngest) youngest = pg;
                    p = (ptr)((iptr)p +
                        size_record_inst(UNFIX(RECORDDESCSIZE(
                              RECORDINSTTYPE(p)))));
                  }
                } else if (s == space_weakpair) {
                  while (pp < ppend && *pp != forward_marker) {
                    /* skip car field and handle cdr field */
                    pp += 1;
                    relocate_dirty(pp, tg, youngest)
                    pp += 1;
                  }
                } else {
                  S_error_abort("sweep_dirty(gc): unexpected space");
                }

                if (s == space_weakpair) {
                  weaksegments_to_resweep->youngest[d] = youngest;
                } else {
                  dirty_si->dirty_bytes[d] = youngest < from_g ? youngest : 0xff;
                }
                if (youngest < min_youngest) min_youngest = youngest;
              } else {
                if (dirty_si->dirty_bytes[d] < min_youngest) min_youngest = dirty_si->dirty_bytes[d];
              }
              d += 1;
            }
          }
        }
        if (s != space_weakpair) {
          record_dirty_segment(from_g, min_youngest, dirty_si);
        }
      }
    }
  }
}

static void resweep_dirty_weak_pairs() {
  weakseginfo *ls;
  ptr *pp, *ppend, *nl, p;
  IGEN from_g, min_youngest, youngest, tg, mcg, pg;
  uptr d;

  tg = target_generation;
  mcg = max_copied_generation;

  for (ls = weaksegments_to_resweep; ls != NULL; ls = ls->next) {
    seginfo *dirty_si = ls->si;
    from_g = dirty_si->generation;
    nl = from_g == tg ? (ptr *)orig_next_loc[space_weakpair] : (ptr *)S_G.next_loc[space_weakpair][from_g];
    ppend = build_ptr(dirty_si->number, 0);
    min_youngest = 0xff;
    d = 0;
    while (d < cards_per_segment) {
      uptr dend = d + sizeof(iptr);
      iptr *dp = (iptr *)(dirty_si->dirty_bytes + d);
      /* check sizeof(iptr) bytes at a time for 0xff */
      if (*dp == -1) {
        d = dend;
        ppend += bytes_per_card;
      } else {
        while (d < dend) {
          pp = ppend;
          ppend += bytes_per_card / sizeof(ptr);
          if (pp <= nl && nl < ppend) ppend = nl;
          if (dirty_si->dirty_bytes[d] <= mcg) {
            youngest = ls->youngest[d];
            while (pp < ppend) {
              p = *pp;
              seginfo *si;

              /* handle car field */
              if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) {
                if (si->space & space_old) {
                  if (locked(p)) {
                    youngest = tg;
                  } else if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) {
                    *pp = FWDADDRESS(p);
                    youngest = tg;
                  } else {
                    *pp = Sbwp_object;
                  }
                } else {
                  if (youngest != tg && (pg = si->generation) < youngest)
                    youngest = pg;
                }
              }

              /* skip cdr field */
              pp += 2;
            }

            dirty_si->dirty_bytes[d] = youngest < from_g ? youngest : 0xff;
            if (youngest < min_youngest) min_youngest = youngest;
          } else {
            if (dirty_si->dirty_bytes[d] < min_youngest) min_youngest = dirty_si->dirty_bytes[d];
          }
          d += 1;
        }
      }
    }
    record_dirty_segment(from_g, min_youngest, dirty_si);
  }
}
