diff --git a/.makefile b/.makefile
index dec5d574f5d..47f4f7b13b2 100644
--- a/.makefile
+++ b/.makefile
@@ -338,7 +338,7 @@ RACKET_FOR_BOOTFILES = $(RACKET)
 RACKET_FOR_BUILD = $(RACKET)
 
 # This branch name changes each time the pb boot files are updated:
-PB_BRANCH == circa-7.9.0.13-1
+PB_BRANCH == circa-7.9.0.14-2
 PB_REPO = https://github.com/racket/pb
 
 # Alternative source for Chez Scheme boot files, normally set by
diff --git a/Makefile b/Makefile
index 8be6a3124a0..00e6066821c 100644
--- a/Makefile
+++ b/Makefile
@@ -47,7 +47,7 @@ RACKETCS_SUFFIX =
 RACKET =
 RACKET_FOR_BOOTFILES = $(RACKET)
 RACKET_FOR_BUILD = $(RACKET)
-PB_BRANCH = circa-7.9.0.13-1
+PB_BRANCH = circa-7.9.0.14-2
 PB_REPO = https://github.com/racket/pb
 EXTRA_REPOS_BASE =
 CS_CROSS_SUFFIX =
@@ -307,18 +307,18 @@ maybe-fetch-pb-as-is:
 	echo done
 fetch-pb-from:
 	mkdir -p racket/src/ChezScheme/boot
-	if [ ! -d racket/src/ChezScheme/boot/pb ] ; 	  then git clone -q -b circa-7.9.0.13-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; 	  else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.13-1:remotes/origin/circa-7.9.0.13-1 ; fi
-	cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.13-1
+	if [ ! -d racket/src/ChezScheme/boot/pb ] ; 	  then git clone -q -b circa-7.9.0.14-2 $(PB_REPO) racket/src/ChezScheme/boot/pb ; 	  else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.14-2:remotes/origin/circa-7.9.0.14-2 ; fi
+	cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.14-2
 pb-fetch:
 	$(MAKE) fetch-pb EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" PB_REPO="$(PB_REPO)"
 pb-build:
 	cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb
 pb-stage:
-	cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.13-1
-	cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.13-1
+	cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.14-2
+	cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.14-2
 	cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build"
 pb-push:
-	cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.13-1
+	cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.14-2
 win-cs-base:
 	IF "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-bc-then-cs-base SETUP_BOOT_MODE=--boot WIN32_BUILD_LEVEL=bc PLAIN_RACKET=racket\racketbc DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETBC_SUFFIX="$(RACKETBC_SUFFIX)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)"
 	IF not "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-just-cs-base SETUP_BOOT_MODE=--chain DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" RACKET_FOR_BUILD="$(RACKET_FOR_BUILD)"
diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt
index 0b149fb08bd..db6dae94a3a 100644
--- a/pkgs/base/info.rkt
+++ b/pkgs/base/info.rkt
@@ -14,7 +14,7 @@
 
 ;; In the Racket source repo, this version should change only when
 ;; "racket_version.h" changes:
-(define version "7.9.0.13")
+(define version "7.9.0.14")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))
diff --git a/pkgs/racket-doc/scribblings/reference/places.scrbl b/pkgs/racket-doc/scribblings/reference/places.scrbl
index 8a064a755c1..c153dfa400d 100644
--- a/pkgs/racket-doc/scribblings/reference/places.scrbl
+++ b/pkgs/racket-doc/scribblings/reference/places.scrbl
@@ -25,15 +25,16 @@ take advantage of machines with multiple processors, cores, or
 hardware threads.
 
 @margin-note{Currently, parallel support for places is enabled
-  only for the 3m (main) and CS variants of Racket, and only
+  only for the CS and 3m variants of Racket, and for 3m, only
   by default for Windows, Linux x86/x86_64, and Mac OS x86/x86_64. To
-  enable support for other platforms, use @DFlag{enable-places} with
+  enable support for other platforms with 3m, use @DFlag{enable-places} with
   @exec{configure} when building Racket. The @racket[place-enabled?]
   function reports whether places run in parallel.
 
   Implementation and operating-system constraints may limit the
   scalability of places. For example, although places can perform
-  garbage collections independently in the 3m variant, a garbage collection
+  garbage collections in parallel in the CS variant or independently
+  in the 3m variant, a garbage collection
   may need to manipulate a page table that is shared across all
   places, and that shared page table can be a bottleneck with enough
   places---perhaps around 8 or 16.}
diff --git a/racket/src/ChezScheme/IMPLEMENTATION.md b/racket/src/ChezScheme/IMPLEMENTATION.md
index a6659043a10..623dd7ec2f1 100644
--- a/racket/src/ChezScheme/IMPLEMENTATION.md
+++ b/racket/src/ChezScheme/IMPLEMENTATION.md
@@ -9,7 +9,8 @@ found in the "c" directory.
 
 Some key files in "s":
 
- * "cmacro.ss": object layouts and other global constants
+ * "cmacro.ss": object layouts and other global constants, including
+   constants that are needed by both the compiler and the kernel
 
  * "syntax.ss": the macro expander
 
@@ -141,6 +142,28 @@ Tests go in "mats/*...*.ms". In "*machine-type*/mats", you can use
 changing `7.ms`. Makefile variables like `o` control the way tests
 are run; for example, use `make o=3 7.mo` to test in unsafe mode.
 
+# Compiled Files and Boot Files
+
+A Scheme file conventionally uses the suffix ".ss" and it's compiled
+form uses the suffix ".so". The format of a compiled file is closely
+related to the fasl format that is exposed by `fasl-write` and
+`fasl-read`, but you can't compile Scheme code to some value that is
+written with `fasl-write`. Instead, `compile-file` and related
+functions directly generate compiled code in a fasled form that
+includes needed linking information.
+
+A boot file, usually with the suffix ".boot", has the same format as a
+compiled file, but with an extra header that identifies it as a boot
+file and takes care of some singleton objects, such as `#!base-rtd`
+and the stub to invoke compiled code.
+
+The vfasl format is used for the same purposes as the fasl format, but
+mostly for boot files. It is always platform-specific and its content
+is very close to the form that the content will take when loaded into
+memory. It can load especially quickly with streamlined linking and
+interning of symbols and record types, especially in uncompressed
+form. The build scripts do not convert boot files to vfasl format.
+
 # Scheme Objects
 
 A Scheme object is represented at run time by a pointer. The low bits
@@ -212,6 +235,13 @@ contain the value `type-inexactnum`. The `iptr` type for `type` means
 "a pointer-sized signed integer". The `ptr` type for `real` and `imag`
 means "pointer" or "Scheme object".
 
+If you create a new type of object, then several pieces need to be
+updated: the garbage collector (in "mkgc.ss" and "gc.c"), the compiler
+to implement primitives that generate the kind of objects, the fasl
+writer (in "fasl.ss"), the fasl reader (in "fasl.c"), the fasl reader
+used by `strip-fasl-file` and `vfasl-convert-file` (in "strip.ss"),
+the vfasl writer (in "vfasl.ss"), and the inspector (in "inspect.ss").
+
 # Functions and Calls
 
 Scheme code does not use the C stack, except to the degree that it
@@ -1079,6 +1109,31 @@ The `asm-foreign-callable` function returns 4 values:
    Generate the code for a C return, including any teardown needed to
    balance `c-init`.
 
+# Cross Compilation and Compile-Time Constants
+
+When cross compiling, there are two notions of quantities/properties
+like the size of pointers or endianness: the host notion and the
+target platform's notion. A function like `(native-endianness)` always
+reports the host's notion. A constant like `(constant
+native-endianness)` refers to the target machine notion.
+
+Cross compilation works by starting with a Chez Scheme that runs on
+the host machine and then re-compiling a subset of the Chez Scheme
+implementation to run on the host machine but with `constant` values
+suitable for the target machine. The recompiled parts are assembled
+into an `xpatch` file that can be loaded to replace functions like
+`compile-file` and `vfasl-convert-file` with ones that use the
+target-machine constants. Loading an `xpatch` file tends to make
+compilation or fasl operations for the host machine inaccessible, so a
+given Chez Scheme process is only good for targeting one particular
+platform.
+
+When working on the compiler or fasl-related tools, take care to use
+the right notion of a quantity or property. If you need the host
+value, then there must be some function that provides the value. If
+you need the target machine's value, then it must be accessed using
+`constant`.
+
 # Changing the Version Number
 
 To change the version number:
diff --git a/racket/src/ChezScheme/c/Mf-base b/racket/src/ChezScheme/c/Mf-base
index f37a81a33be..2dddc636a7a 100644
--- a/racket/src/ChezScheme/c/Mf-base
+++ b/racket/src/ChezScheme/c/Mf-base
@@ -72,7 +72,6 @@ gc-011.o gc-par.o gc-ocd.o gc-oce.o: gc.c
 gc-011.o gc-ocd.o: ${Include}/gc-ocd.inc
 gc-oce.o: ${Include}/gc-oce.inc
 gc-par.o: ${Include}/gc-par.inc
-vfasl.o: ${Include}/vfasl.inc
 gcwrapper.o: ${Include}/heapcheck.inc
 
 ../zlib/zlib.h ../zlib/zconf.h: ../zlib/configure.log
diff --git a/racket/src/ChezScheme/c/externs.h b/racket/src/ChezScheme/c/externs.h
index a6b83236d09..059ed85c4c9 100644
--- a/racket/src/ChezScheme/c/externs.h
+++ b/racket/src/ChezScheme/c/externs.h
@@ -113,11 +113,11 @@ extern void S_phantom_bytevector_adjust PROTO((ptr ph, uptr new_sz));
 
 /* fasl.c */
 extern void S_fasl_init PROTO((void));
-ptr S_fasl_read PROTO((INT fd, IFASLCODE situation, ptr path, ptr externals));
-ptr S_bv_fasl_read PROTO((ptr bv, int ty, uptr offset, uptr len, ptr path, ptr externals));
-ptr S_boot_read PROTO((INT fd, const char *path));
-char *S_format_scheme_version PROTO((uptr n));
-char *S_lookup_machine_type PROTO((uptr n));
+extern ptr S_fasl_read PROTO((INT fd, IFASLCODE situation, ptr path, ptr externals));
+extern ptr S_bv_fasl_read PROTO((ptr bv, int ty, uptr offset, uptr len, ptr path, ptr externals));
+extern ptr S_boot_read PROTO((INT fd, const char *path));
+extern char *S_format_scheme_version PROTO((uptr n));
+extern char *S_lookup_machine_type PROTO((uptr n));
 extern void S_set_code_obj PROTO((char *who, IFASLCODE typ, ptr p, iptr n,
              ptr x, iptr o));
 extern ptr S_get_code_obj PROTO((IFASLCODE typ, ptr p, iptr n, iptr o));
@@ -131,10 +131,8 @@ extern void S_swap_dounderflow_header_endian PROTO((ptr code));
 #endif
 
 /* vfasl.c */
-extern ptr S_to_vfasl PROTO((ptr v));
 extern ptr S_vfasl PROTO((ptr bv, void *stream, iptr offset, iptr len));
 extern ptr S_vfasl_to PROTO((ptr v));
-extern IBOOL S_vfasl_can_combinep(ptr v);
 
 /* flushcache.c */
 extern void S_record_code_mod PROTO((ptr tc, uptr addr, uptr bytes));
@@ -201,6 +199,8 @@ extern ptr S_intern4 PROTO((ptr sym));
 extern void S_intern_gensym PROTO((ptr g));
 extern void S_retrofit_nonprocedure_code PROTO((void));
 extern ptr S_mkstring PROTO((const string_char *s, iptr n));
+extern I32 S_symbol_hash32(ptr str);
+extern I64 S_symbol_hash64(ptr str);
 
 /* io.c */
 extern IBOOL S_file_existsp PROTO((const char *inpath, IBOOL followp));
diff --git a/racket/src/ChezScheme/c/fasl.c b/racket/src/ChezScheme/c/fasl.c
index 2486b08a7fd..44499166025 100644
--- a/racket/src/ChezScheme/c/fasl.c
+++ b/racket/src/ChezScheme/c/fasl.c
@@ -14,6 +14,10 @@
  * limitations under the License.
  */
 
+/* The fasl writer is in "fasl.ss".
+   There's a second fasl reader and writer in "strip.ss", so it has
+   to be kept in sync with this one. */
+
 /* fasl representation:
  *
  * <fasl-file> -> <fasl-group>*
@@ -52,6 +56,8 @@
  *
  *        -> {bytevector}<uptr n><octet elt1>...<octet eltn>
  *
+ *        -> {stencil-vector}<uptr mask><octet elt1>...<octet eltn>
+ *
  *        -> {immediate}<uptr>
  *
  *        -> {small-integer}<iptr>
@@ -115,6 +121,8 @@
  *                 ...
  *                 <faslreloc>       # last relocation entry
  *
+ *        -> {begin}<va>...<val>     # all but last is intended to be a {graph-def}
+ *
  * <faslreloc> -> <byte type-etc>    # bit 0: extended entry, bit 1: expect item offset, bit 2+: type
  *                <uptr code-offset>
  *                <uptr item-offset> # omitted if bit 1 of type-etc is 0
@@ -1545,19 +1553,27 @@ ptr S_get_code_obj(typ, p, n, o) IFASLCODE typ; iptr n, o; ptr p; {
     return (ptr)(item - o);
 }
 
-
 #ifdef PORTABLE_BYTECODE
 
 /* Address pieces in a movz,movk,movk,movk sequence are upper 16 bits */
 #define ADDRESS_BITS_SHIFT 16
-#define ADDRESS_BITS_MASK  ((U32)0xffff0000)
+#define ADDRESS_BITS_MASK  ((U32)0xFFFF0000)
+#define DEST_REG_MASK      0xF00
 
 static void pb_set_abs(void *address, uptr item) {
-  ((U32 *)address)[0] = ((((U32 *)address)[0] & ~ADDRESS_BITS_MASK) | ((item & 0xFFFF) << ADDRESS_BITS_SHIFT));
-  ((U32 *)address)[1] = ((((U32 *)address)[1] & ~ADDRESS_BITS_MASK) | (((item >> 16) & 0xFFFF) << ADDRESS_BITS_SHIFT));
+  /* First word can have an arbitrary value due to vfasl offset
+     storage, so get the target register from the end: */
 #if ptr_bytes == 8  
-  ((U32 *)address)[2] = ((((U32 *)address)[2] & ~ADDRESS_BITS_MASK) | (((item >> 32) & 0xFFFF) << ADDRESS_BITS_SHIFT));
-  ((U32 *)address)[3] = ((((U32 *)address)[3] & ~ADDRESS_BITS_MASK) | (((item >> 48) & 0xFFFF) << ADDRESS_BITS_SHIFT));
+  int dest_reg = ((U32 *)address)[3] & DEST_REG_MASK;
+#else
+  int dest_reg = ((U32 *)address)[1] & DEST_REG_MASK;
+#endif
+
+  ((U32 *)address)[0] = (pb_mov16_pb_zero_bits_pb_shift0 | dest_reg | ((item & 0xFFFF) << ADDRESS_BITS_SHIFT));
+  ((U32 *)address)[1] = (pb_mov16_pb_keep_bits_pb_shift1 | dest_reg | (((item >> 16) & 0xFFFF) << ADDRESS_BITS_SHIFT));
+#if ptr_bytes == 8  
+  ((U32 *)address)[2] = (pb_mov16_pb_keep_bits_pb_shift2 | dest_reg | (((item >> 32) & 0xFFFF) << ADDRESS_BITS_SHIFT));
+  ((U32 *)address)[3] = (pb_mov16_pb_keep_bits_pb_shift3 | dest_reg | (((item >> 48) & 0xFFFF) << ADDRESS_BITS_SHIFT));
 #endif
 }
 
@@ -1571,17 +1587,17 @@ static uptr pb_get_abs(void *address) {
           );
 }
 
-#endif /* AARCH64 */
+#endif /* PORTABLE_BYTECODE */
 
 #ifdef ARMV6
 static void arm32_set_abs(void *address, uptr item) {
   /* code generator produces ldrlit destreg, 0; brai 0; long 0 */
-  /* we change long 0 => long item */
-  *((U32 *)address + 2) = item;
+  /* given address is at long 0, which we change to `item` */
+  *((U32 *)address) = item;
 }
 
 static uptr arm32_get_abs(void *address) {
-  return *((U32 *)address + 2);
+  return *((U32 *)address);
 }
 
 #define MAKE_B(n) (0xEA000000 | (n))
@@ -1634,11 +1650,24 @@ static uptr arm32_get_jump(void *address) {
 #define ADDRESS_BITS_SHIFT 5
 #define ADDRESS_BITS_MASK  ((U32)0x1fffe0)
 
+/* Dest register in either movz or movk: */
+#define DEST_REG_MASK 0x1F
+
+#define MOVZ_OPCODE    0xD2800000
+#define MOVK_OPCODE    0xF2800000
+#define SHIFT16_OPCODE 0x00200000
+#define SHIFT32_OPCODE 0x00400000
+#define SHIFT48_OPCODE 0x00600000
+
 static void arm64_set_abs(void *address, uptr item) {
-  ((U32 *)address)[0] = ((((U32 *)address)[0] & ~ADDRESS_BITS_MASK) | ((item & 0xFFFF) << ADDRESS_BITS_SHIFT));
-  ((U32 *)address)[1] = ((((U32 *)address)[1] & ~ADDRESS_BITS_MASK) | (((item >> 16) & 0xFFFF) << ADDRESS_BITS_SHIFT));
-  ((U32 *)address)[2] = ((((U32 *)address)[2] & ~ADDRESS_BITS_MASK) | (((item >> 32) & 0xFFFF) << ADDRESS_BITS_SHIFT));
-  ((U32 *)address)[3] = ((((U32 *)address)[3] & ~ADDRESS_BITS_MASK) | (((item >> 48) & 0xFFFF) << ADDRESS_BITS_SHIFT));
+  /* First word can have an arbitrary value due to vfasl offset
+     storage, so get the target register from the end: */
+  int dest_reg = ((U32 *)address)[3] & DEST_REG_MASK;
+  
+  ((U32 *)address)[0] = (MOVZ_OPCODE | dest_reg | ((item & 0xFFFF) << ADDRESS_BITS_SHIFT));
+  ((U32 *)address)[1] = (MOVK_OPCODE | SHIFT16_OPCODE | dest_reg | (((item >> 16) & 0xFFFF) << ADDRESS_BITS_SHIFT));
+  ((U32 *)address)[2] = (MOVK_OPCODE | SHIFT32_OPCODE | dest_reg | (((item >> 32) & 0xFFFF) << ADDRESS_BITS_SHIFT));
+  ((U32 *)address)[3] = (MOVK_OPCODE | SHIFT48_OPCODE | dest_reg | (((item >> 48) & 0xFFFF) << ADDRESS_BITS_SHIFT));
 }
 
 static uptr arm64_get_abs(void *address) {
@@ -1655,21 +1684,26 @@ static uptr arm64_get_abs(void *address) {
 #define UPDATE_ADDIS(item, instr) (((instr) & ~0xFFFF) | (((item) >> 16) & 0xFFFF))
 #define UPDATE_ADDI(item, instr)  (((instr) & ~0xFFFF) | ((item) & 0xFFFF))
 
-#define MAKE_B(disp, callp) ((18 << 26) | (((disp) & 0xFFFFFF) << 2) | (callp))
-#define MAKE_ADDIS(item)    ((15 << 26) | (((item) >> 16) & 0xFFFF))
-#define MAKE_ORI(item)      ((24 << 26) | ((item) & 0xFFFF))
-#define MAKE_NOP            ((24 << 26))
-#define MAKE_MTCTR          ((31 << 26) | (9 << 16) | (467 << 1))
-#define MAKE_BCTR(callp)    ((19 << 26) | (20 << 21) | (528 << 1) | (callp))
+#define MAKE_B(disp, callp)   ((18 << 26) | (((disp) & 0xFFFFFF) << 2) | (callp))
+#define MAKE_ADDIS(item)      ((15 << 26) | (((item) >> 16) & 0xFFFF))
+#define MAKE_ADDI(item)       ((14 << 26) | ((item) & 0xFFFF))
+#define MAKE_ORI(item)        ((24 << 26) | ((item) & 0xFFFF))
+#define MAKE_NOP              ((24 << 26))
+#define MAKE_MTCTR            ((31 << 26) | (9 << 16) | (467 << 1))
+#define MAKE_BCTR(callp)      ((19 << 26) | (20 << 21) | (528 << 1) | (callp))
+
+#define DEST_REG_MASK         (0x1F << 21)
 
 static void ppc32_set_abs(void *address, uptr item) {
   /* code generator produces addis destreg, %r0, 0 (hi) ; addi destreg, destreg, 0 (lo) */
   /* we change 0 (hi) => upper 16 bits of address */
   /* we change 0 (lo) => lower 16 bits of address */
   /* low part is signed: if negative, increment high part */
+  /* but the first word may have been overritten for vfasl */
+  int dest_reg = (*((U32 *)address + 1)) & DEST_REG_MASK;
   item = item + (item << 1 & 0x10000);
-  *((U32 *)address + 0) = UPDATE_ADDIS(item, *((U32 *)address + 0));
-  *((U32 *)address + 1) = UPDATE_ADDI(item, *((U32 *)address + 1));
+  *((U32 *)address + 0) = dest_reg | MAKE_ADDIS(item);
+  *((U32 *)address + 1) = dest_reg | dest_reg >> 5 | MAKE_ADDI(item);
 }
 
 static uptr ppc32_get_abs(void *address) {
diff --git a/racket/src/ChezScheme/c/intern.c b/racket/src/ChezScheme/c/intern.c
index b7749e9bfb6..cb12aa28723 100644
--- a/racket/src/ChezScheme/c/intern.c
+++ b/racket/src/ChezScheme/c/intern.c
@@ -106,34 +106,37 @@ void S_resize_oblist(void) {
 
 #define MIX_HASH(hc) (hc += (hc << 10), hc ^= (hc >> 6))
 
+#define SYM_HASH_LOOP(uptr, iptr, extract, mask)  {     \
+    uptr h = (uptr)n + 401887359;                       \
+    while (n--) { h += extract(*s++); MIX_HASH(h); }    \
+    return (iptr)h & mask;                              \
+  }
+
+#define identity_extract(x) x
+
 static iptr hash(const unsigned char *s, iptr n) {
-  uptr h = (uptr)n + 401887359;
-  while (n--) { h += *s++; MIX_HASH(h); }
-  return (iptr)h & most_positive_fixnum;
+  SYM_HASH_LOOP(uptr, iptr, identity_extract, most_positive_fixnum);
 }
 
 static iptr hash_sc(const string_char *s, iptr n) {
-  uptr h = (uptr)n + 401887359;
-  while (n--) { h += Schar_value(*s++); MIX_HASH(h); }
-  return (iptr)h & most_positive_fixnum;
+  SYM_HASH_LOOP(uptr, iptr, Schar_value, most_positive_fixnum);
 }
 
 static iptr hash_uname(const string_char *s, iptr n) {
-  /* attempting to get dissimilar hash codes for gensyms created in the same session */
-  iptr i = n, h = 0; iptr pos = 1; int d, c;
+  return hash_sc(s, n);
+}
 
-  while (i-- > 0) {
-    if ((c = Schar_value(s[i])) == '-') {
-      if (pos <= 10) break;
-      return (h + 523658599) & most_positive_fixnum;
-    }
-    d = c - '0';
-    if (d < 0 || d > 9) break;
-    h += d * pos;
-    pos *= 10;
-  }
+/* on any platform, computes the value that is computed on a 32-bit platform,
+   but needs to be `bitwise-and`ed with most_positive_fixnum */
+I32 S_symbol_hash32(ptr str) {
+  const string_char *s = &STRIT(str, 0); iptr n = Sstring_length(str);
+  SYM_HASH_LOOP(U32, I32, Schar_value, (I32)-1);
+}
 
-  return hash_sc(s, n);
+/* like S_symbol_hash32 for the value that is computed on a 64-bit platform */
+I64 S_symbol_hash64(ptr str) {
+  const string_char *s = &STRIT(str, 0); iptr n = Sstring_length(str);
+  SYM_HASH_LOOP(U64, I64, Schar_value, (U64)-1);
 }
 
 static ptr mkstring(const string_char *s, iptr n) {
diff --git a/racket/src/ChezScheme/c/prim5.c b/racket/src/ChezScheme/c/prim5.c
index e0e564fdb26..5d1566aef08 100644
--- a/racket/src/ChezScheme/c/prim5.c
+++ b/racket/src/ChezScheme/c/prim5.c
@@ -1678,6 +1678,8 @@ void S_prim5_init() {
     Sforeign_symbol("(cs)s_strings_to_gensym", (void *)s_strings_to_gensym);
     Sforeign_symbol("(cs)s_intern_gensym", (void *)S_intern_gensym);
     Sforeign_symbol("(cs)s_uninterned", (void *)S_uninterned);
+    Sforeign_symbol("(cs)symbol_hash32", (void *)S_symbol_hash32);
+    Sforeign_symbol("(cs)symbol_hash64", (void *)S_symbol_hash64);
     Sforeign_symbol("(cs)cputime", (void *)S_cputime);
     Sforeign_symbol("(cs)realtime", (void *)S_realtime);
     Sforeign_symbol("(cs)clock_gettime", (void *)S_clock_gettime);
@@ -1706,9 +1708,7 @@ void S_prim5_init() {
     Sforeign_symbol("(cs)getpid", (void *)s_getpid);
     Sforeign_symbol("(cs)fasl_read", (void *)S_fasl_read);
     Sforeign_symbol("(cs)bv_fasl_read", (void *)S_bv_fasl_read);
-    Sforeign_symbol("(cs)to_vfasl", (void *)S_to_vfasl);
     Sforeign_symbol("(cs)vfasl_to", (void *)S_vfasl_to);
-    Sforeign_symbol("(cs)vfasl_can_combinep", (void *)S_vfasl_can_combinep);
     Sforeign_symbol("(cs)s_decode_float", (void *)s_decode_float);
 
     Sforeign_symbol("(cs)new_open_input_fd", (void *)S_new_open_input_fd);
diff --git a/racket/src/ChezScheme/c/print.c b/racket/src/ChezScheme/c/print.c
index 50545823893..a711ee684cd 100644
--- a/racket/src/ChezScheme/c/print.c
+++ b/racket/src/ChezScheme/c/print.c
@@ -32,6 +32,7 @@ static void pstr PROTO((ptr x));
 static void psym PROTO((ptr x));
 static void pvec PROTO((ptr x));
 static void pfxvector PROTO((ptr x));
+static void pflvector PROTO((ptr x));
 static void pbytevector PROTO((ptr x));
 static void pflonum PROTO((ptr x));
 static void pflodat PROTO((double x));
@@ -54,6 +55,7 @@ void S_prin1(x) ptr x; {
     else if (Sexactnump(x)) pexactnum(x);
     else if (Svectorp(x)) pvec(x);
     else if (Sfxvectorp(x)) pfxvector(x);
+    else if (Sflvectorp(x)) pflvector(x);
     else if (Sbytevectorp(x)) pbytevector(x);
     else if (Sboxp(x)) pbox(x);
     else if (Sprocedurep(x)) pclo(x);
@@ -159,12 +161,16 @@ static void pstr(x) ptr x; {
 }
 
 static void display_string(x) ptr x; {
-  iptr i, n = Sstring_length(x);
-
-  for (i = 0; i < n; i += 1) {
-    int k = Sstring_ref(x, i);
-    if (k >= 256) k = '?';
-    putchar(k);
+  if (!Sstringp(x)) {
+    printf("#<garbage-string>");
+  } else {
+    iptr i, n = Sstring_length(x);
+    
+    for (i = 0; i < n; i += 1) {
+      int k = Sstring_ref(x, i);
+      if (k >= 256) k = '?';
+      putchar(k);
+    }
   }
 }
 
@@ -227,6 +233,25 @@ static void pfxvector(x) ptr x; {
     putchar(')');
 }
 
+static void pflvector(x) ptr x; {
+    iptr n;
+
+    putchar('#');
+    n = Sflvector_length(x);
+    wrint(FIX(n));
+    printf("vfl(");
+    if (n != 0) {
+        iptr i = 0;
+
+        while (1) {
+            pflodat(Sflvector_ref(x, i));
+            if (++i == n) break;
+            putchar(' ');
+        }
+    }
+    putchar(')');
+}
+
 static void pbytevector(x) ptr x; {
     iptr n;
 
diff --git a/racket/src/ChezScheme/c/scheme.c b/racket/src/ChezScheme/c/scheme.c
index 196916cdfcb..78e3063dc26 100644
--- a/racket/src/ChezScheme/c/scheme.c
+++ b/racket/src/ChezScheme/c/scheme.c
@@ -344,8 +344,11 @@ static void idiot_checks() {
 static ptr boot_call PROTO((ptr tc, ptr p, INT n));
 static void check_ap PROTO((ptr tc));
 
+int boot_calls = 0;
+
 /* arguments and ac0 set up */
 static ptr boot_call(tc, p, n) ptr tc; ptr p; INT n; {
+  boot_calls++;
     AC1(tc) = p;
     CP(tc) = Svoid; /* don't have calling code object */
 
diff --git a/racket/src/ChezScheme/c/vfasl.c b/racket/src/ChezScheme/c/vfasl.c
index 7de7d627c50..3ab4e383a1e 100644
--- a/racket/src/ChezScheme/c/vfasl.c
+++ b/racket/src/ChezScheme/c/vfasl.c
@@ -15,7 +15,6 @@
  */
 
 #include "system.h"
-#include "popcount.h"
 
 /*
 
@@ -55,25 +54,7 @@ e   \_  [bitmap of pointers to relocate]
 
 typedef uptr vfoff;
 
-/* Similar to allocation spaces, but not all allocation spaces are
-   represented, and these spaces are more fine-grained in some
-   cases: */
-enum {
-  vspace_symbol,
-  vspace_rtd,
-  vspace_closure,
-  vspace_impure,
-  vspace_pure_typed,
-  vspace_impure_record,
-  /* rest rest are at then end to make the pointer bitmap
-     end with zeros (that can be dropped): */
-  vspace_code,
-  vspace_data,
-  vspace_reloc, /* can be dropped after direct to static generation */
-  vspaces_count
-};
-
-/* Needs to match order above, maps vfasl spaces to allocation
+/* Needs to match vspace enum order, maps vfasl spaces to allocation
    spaces: */
 static ISPC vspace_spaces[] = {
   space_symbol,
@@ -87,71 +68,10 @@ static ISPC vspace_spaces[] = {
   space_data /* reloc --- but not really, since relocs are never in static */
 };
 
-typedef struct vfasl_header {
-  vfoff data_size;
-  vfoff table_size;
-
-  vfoff result_offset;
-
-  /* first starting offset is 0, so skip it in this array: */
-  vfoff vspace_rel_offsets[vspaces_count-1];
-
-  vfoff symref_count;
-  vfoff rtdref_count;
-  vfoff singletonref_count;
-} vfasl_header;
-
-/************************************************************/
-/* Encode-time data structures                              */
-
-/* During encoding, we use many chunks per vspace on first pass, one
-   per vspace on second pass: */
-typedef struct vfasl_chunk {
-  ptr bytes;
-  uptr length;
-  uptr used;
-  uptr swept;
-  struct vfasl_chunk *next, *prev;
-} vfasl_chunk;
-
-/* One per vspace: */
-struct vfasl_count_and_chunk {
-  uptr total_bytes;
-  vfasl_chunk *first;
-};
-
-typedef struct vfasl_info {
-  ptr base_addr; /* address to make relocations relative to */
-
-  uptr sym_count;
-
-  vfoff symref_count;
-  vfoff *symrefs;
-
-  ptr base_rtd; /* track replacement base_rtd to recognize other rtds */
-
-  vfoff rtdref_count;
-  vfoff *rtdrefs;
-
-  vfoff singletonref_count;
-  vfoff *singletonrefs;
-
-  struct vfasl_count_and_chunk spaces[vspaces_count];
-
-  octet *ptr_bitmap;
-
-  struct vfasl_hash_table *graph;
-
-  IBOOL installs_library_entry; /* to determine whether vfasls can be combined */
-} vfasl_info;
-
 #define ptr_add(p, n) ((ptr)((uptr)(p) + (n)))
 #define ptr_subtract(p, n) ((ptr)((uptr)(p) - (n)))
 #define ptr_diff(p, q) ((uptr)(p) - (uptr)(q))
 
-#define byte_bits      8
-#define log2_byte_bits 3
-
 #define segment_align(size) (((size)+bytes_per_segment-1) & ~(bytes_per_segment-1))
 
 static uptr symbol_pos_to_offset(uptr sym_pos) {
@@ -161,47 +81,11 @@ static uptr symbol_pos_to_offset(uptr sym_pos) {
   return (segs * bytes_per_segment) + (syms * size_symbol);
 }
 
-static ptr vfasl_copy_all(vfasl_info *vfi, ptr v);
-
-static ptr copy(vfasl_info *vfi, ptr pp, seginfo *si);
-static uptr sweep(vfasl_info *vfi, ptr p);
-static int is_rtd(ptr tf, vfasl_info *vfi);
-
-static IFASLCODE abs_reloc_variant(IFASLCODE type);
-static ptr vfasl_encode_relocation(vfasl_info *vfi, ptr obj);
 static void relink_code(ptr co, ptr sym_base, ptr *vspaces, uptr *vspace_offsets, IBOOL to_static);
 static ptr find_pointer_from_offset(uptr p_off, ptr *vspaces, uptr *vspace_offsets);
 
-static void vfasl_relocate(vfasl_info *vfi, ptr *ppp);
-static ptr vfasl_relocate_help(vfasl_info *vfi, ptr pp);
-static ptr vfasl_relocate_code(vfasl_info *vfi, ptr code);
-static ptr vfasl_find_room(vfasl_info *vfi, int s, ITYPE t, iptr n);
-static void vfasl_register_rtd_reference(vfasl_info *vfi, ptr pp);
-static void vfasl_register_symbol_reference(vfasl_info *vfi, ptr *pp, ptr p);
-static void vfasl_register_singleton_reference(vfasl_info *vfi, ptr *pp, int which);
-static void vfasl_register_forward(vfasl_info *vfi, ptr pp, ptr p);
-static ptr vfasl_lookup_forward(vfasl_info *vfi, ptr p);
-
-static iptr vfasl_symbol_to_index(vfasl_info *vfi, ptr pp);
-
-static void fasl_init_entry_tables();
-static void vfasl_check_install_library_entry(vfasl_info *vfi, ptr name);
-
-static int detect_singleton(ptr p);
 static ptr lookup_singleton(iptr which);
 
-typedef struct vfasl_hash_table vfasl_hash_table;
-static vfasl_hash_table *make_vfasl_hash_table(IBOOL permanent);
-static void vfasl_hash_table_set(vfasl_hash_table *ht, ptr key, ptr value);
-static ptr vfasl_hash_table_ref(vfasl_hash_table *ht, ptr key);
-
-static void *vfasl_malloc(uptr sz);
-static void *vfasl_calloc(uptr sz, uptr n);
-
-static void sort_offsets(vfoff *p, vfoff len);
-
-#define vfasl_fail(vfi, what) S_error("vfasl", "cannot encode " what)
-
 /************************************************************/
 /* Loading                                                  */
 
@@ -212,7 +96,8 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
 # define VSPACE_LENGTH(s) (vspace_offsets[(s)+1] - vspace_offsets[(s)])
 # define VSPACE_END(s) ptr_add(vspaces[(s)], VSPACE_LENGTH(s))
   ptr tc = get_thread_context();
-  vfasl_header header;
+  octet header_space[size_vfasl_header];
+  ptr header = TO_PTR(header_space);
   ptr table;
   vfoff *symrefs, *rtdrefs, *singletonrefs;
   octet *bm, *bm_end;
@@ -226,23 +111,23 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
     S_error("fasl-read", "input length mismatch");
 
   if (bv)
-    memcpy(&header, &BVIT(bv, offset), sizeof(vfasl_header));
+    memcpy(&header_space, &BVIT(bv, offset), size_vfasl_header);
   else {
-    if (S_fasl_stream_read(stream, (octet*)&header, sizeof(header)) < 0)
+    if (S_fasl_stream_read(stream, header_space, size_vfasl_header) < 0)
       S_error("fasl-read", "input truncated");
   }
 
-  used_len += header.data_size + header.table_size;
+  used_len += VFASLHEADER_DATA_SIZE(header) + VFASLHEADER_TABLE_SIZE(header);
   if (used_len > input_len)
     S_error("fasl-read", "input length mismatch");
 
   vspace_offsets[0] = 0;
   for (s = 1; s < vspaces_count; s++) {
-    vspace_offsets[s] = header.vspace_rel_offsets[s-1];
+    vspace_offsets[s] = VFASLHEADER_VSPACE_REL_OFFSETS(header, s-1);
   }
-  vspace_offsets[vspaces_count] = header.data_size;
+  vspace_offsets[vspaces_count] = VFASLHEADER_DATA_SIZE(header);
 
-  bv_addr = (bv ? &BVIT(bv, sizeof(vfasl_header) + offset) : NULL);
+  bv_addr = (bv ? &BVIT(bv, size_vfasl_header + offset) : NULL);
 
   to_static = (S_vfasl_boot_mode > 0);
   
@@ -285,16 +170,16 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
   if (bv)
     table = TO_PTR(bv_addr);
   else {
-    newspace_find_room(tc, typemod, ptr_align(header.table_size), table);
-    if (S_fasl_stream_read(stream, TO_VOIDP(table), header.table_size) < 0)
+    newspace_find_room(tc, typemod, ptr_align(VFASLHEADER_TABLE_SIZE(header)), table);
+    if (S_fasl_stream_read(stream, TO_VOIDP(table), VFASLHEADER_TABLE_SIZE(header)) < 0)
       S_error("fasl-read", "input truncated");
   }
 
   symrefs = TO_VOIDP(table);
-  rtdrefs = TO_VOIDP(ptr_add(TO_PTR(symrefs), header.symref_count * sizeof(vfoff)));
-  singletonrefs = TO_VOIDP(ptr_add(TO_PTR(rtdrefs), header.rtdref_count * sizeof(vfoff)));
-  bm = TO_VOIDP(ptr_add(TO_PTR(singletonrefs), header.singletonref_count * sizeof(vfoff)));
-  bm_end = TO_VOIDP(ptr_add(TO_PTR(table), header.table_size));
+  rtdrefs = TO_VOIDP(ptr_add(TO_PTR(symrefs), VFASLHEADER_SYMREF_COUNT(header) * sizeof(vfoff)));
+  singletonrefs = TO_VOIDP(ptr_add(TO_PTR(rtdrefs), VFASLHEADER_RTDREF_COUNT(header) * sizeof(vfoff)));
+  bm = TO_VOIDP(ptr_add(TO_PTR(singletonrefs), VFASLHEADER_SINGLETONREF_COUNT(header) * sizeof(vfoff)));
+  bm_end = TO_VOIDP(ptr_add(TO_PTR(table), VFASLHEADER_TABLE_SIZE(header)));
 
 #if 0
   printf("\n"
@@ -307,7 +192,7 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
          "data %ld\n"
          "othr %ld\n"
          "tabl %ld  symref %ld  rtdref %ld  sglref %ld\n",
-         sizeof(vfasl_header),
+         (uptr)size_vfasl_header,
          VSPACE_LENGTH(vspace_symbol),
          VSPACE_LENGTH(vspace_rtd),
          VSPACE_LENGTH(vspace_closure),
@@ -317,12 +202,23 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
          (VSPACE_LENGTH(vspace_impure)
           + VSPACE_LENGTH(vspace_pure_typed)
           + VSPACE_LENGTH(vspace_impure_record)),
-         header.table_size,
-         header.symref_count * sizeof(vfoff),
-         header.rtdref_count * sizeof(vfoff),
-         header.singletonref_count * sizeof(vfoff));
+         VFASLHEADER_TABLE_SIZE(header),
+         VFASLHEADER_SYMREF_COUNT(header) * sizeof(vfoff),
+         VFASLHEADER_RTDREF_COUNT(header) * sizeof(vfoff),
+         VFASLHEADER_SINGLETONREF_COUNT(header) * sizeof(vfoff));
 #endif
 
+  if (VSPACE_LENGTH(vspace_rtd) > 0) {
+    ptr rtd = TYPE(vspaces[vspace_rtd], type_typed_object);
+    ptr rtd_end = TYPE(VSPACE_END(vspace_rtd), type_typed_object);
+
+    while (1) {
+      rtd = ptr_add(rtd, size_record_type);
+      if (rtd == rtd_end)
+        break;
+    }
+  }
+    
   /* We have to convert an offset relative to the start of data in the
      vfasl format to an offset relative to an individual space, at
      least for target generations other than 0. Rely on the fact that
@@ -379,7 +275,7 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
   {
     SPACE_OFFSET_DECLS;
     vfoff i;
-    for (i = 0; i < header.singletonref_count; i++) {
+    for (i = 0; i < VFASLHEADER_SINGLETONREF_COUNT(header); i++) {
       uptr r_off;
       ptr *ref;
       r_off = singletonrefs[i];
@@ -417,6 +313,10 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
         INITSYMVAL(sym) = sunbound;
         INITSYMCODE(sym,S_G.nonprocedure_code);
 
+#if 0
+        S_prin1(sym); printf("\n");
+#endif
+
         isym = S_intern4(sym);
         if (isym != sym) {
           /* The symbol was already interned, so point to the existing one */
@@ -429,9 +329,6 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
               printf("\n");
             }
           }
-        } else {
-          if (INITSYMPLIST(sym) != Snil) printf("oops\n");
-          if (INITSYMSPLIST(sym) != Snil) printf("oops\n");
         }
 
         sym = ptr_add(sym, size_symbol);
@@ -447,7 +344,7 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
     SPACE_OFFSET_DECLS;
     ptr syms = vspaces[vspace_symbol];
     vfoff i;
-    for (i = 0; i < header.symref_count; i++) {
+    for (i = 0; i < VFASLHEADER_SYMREF_COUNT(header); i++) {
       uptr p2_off, sym_pos;
       ptr *p2, sym, val;
       p2_off = symrefs[i];
@@ -510,7 +407,7 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
   {
     SPACE_OFFSET_DECLS;
     vfoff i;
-    for (i = 0; i < header.rtdref_count; i++) {
+    for (i = 0; i < VFASLHEADER_RTDREF_COUNT(header); i++) {
       uptr r_off;
       ptr *ref, rtd, uid;
       r_off = rtdrefs[i];
@@ -563,7 +460,7 @@ ptr S_vfasl(ptr bv, void *stream, iptr offset, iptr input_len)
   {
     ptr v;
     ITYPE t;
-    v = find_pointer_from_offset(header.result_offset, vspaces, vspace_offsets);
+    v = find_pointer_from_offset(VFASLHEADER_RESULT_OFFSET(header), vspaces, vspace_offsets);
     if (((t = TYPEBITS(v)) == type_typed_object)
         && TYPEP(TYPEFIELD(v), mask_box, type_box))
       v = Sunbox(v);
@@ -577,579 +474,17 @@ ptr S_vfasl_to(ptr bv)
   return S_vfasl(bv, NULL, 0, Sbytevector_length(bv));
 }
 
-/************************************************************/
-/* Saving                                                   */
-
-static void vfasl_init(vfasl_info *vfi) {
-  int s;
-  
-  vfi->base_addr = (ptr)0;
-  vfi->sym_count = 0;
-  vfi->symref_count = 0;
-  vfi->symrefs = NULL;
-  vfi->base_rtd = S_G.base_rtd;
-  vfi->rtdref_count = 0;
-  vfi->rtdrefs = NULL;
-  vfi->singletonref_count = 0;
-  vfi->singletonrefs = NULL;
-  vfi->graph = make_vfasl_hash_table(0);
-  vfi->ptr_bitmap = NULL;
-  vfi->installs_library_entry = 0;
-
-  for (s = 0; s < vspaces_count; s++) {
-    vfasl_chunk *c;
-
-    c = vfasl_malloc(sizeof(vfasl_chunk));
-    c->bytes = (ptr)0;
-    c->length = 0;
-    c->used = 0;
-    c->swept = 0;
-    c->next = NULL;
-    c->prev = NULL;
-
-    vfi->spaces[s].first = c;
-    vfi->spaces[s].total_bytes = 0;
-  }
-}
-
-ptr S_to_vfasl(ptr v)
-{
-  vfasl_info *vfi;
-  vfasl_header header;
-  ITYPE t;
-  int s;
-  uptr size, data_size, bitmap_size;
-  ptr bv, p;
-
-  fasl_init_entry_tables();
-
-  /* Box certain kinds of values where the vfasl process needs a
-     pointer into data */
-  if (IMMEDIATE(v)
-      || detect_singleton(v)
-      || ((t = TYPEBITS(v)) == type_symbol)
-      || ((t == type_typed_object)
-          && TYPEP(TYPEFIELD(v), mask_record, type_record)
-          && (TYPEFIELD(v) == v))
-      || ((t == type_typed_object)
-          && TYPEP(TYPEFIELD(v), mask_box, type_box))) {
-    v = Sbox(v);
-  }
-
-  vfi = vfasl_malloc(sizeof(vfasl_info));
-
-  vfasl_init(vfi);
-
-  /* First pass: determine sizes */
-
-  (void)vfasl_copy_all(vfi, v);
-
-  /* Setup for second pass: allocate to contiguous bytes */
-
-  size = sizeof(vfasl_header);
-
-  data_size = vfi->spaces[0].total_bytes;
-  for (s = 1; s < vspaces_count; s++) {
-    header.vspace_rel_offsets[s-1] = data_size;
-    data_size += vfi->spaces[s].total_bytes;
-  }
-  header.data_size = data_size;
-  size += data_size;
-
-  size += vfi->symref_count * sizeof(vfoff);
-  size += vfi->rtdref_count * sizeof(vfoff);
-  size += vfi->singletonref_count * sizeof(vfoff);
-
-  header.symref_count = vfi->symref_count;
-  header.rtdref_count = vfi->rtdref_count;
-  header.singletonref_count = vfi->singletonref_count;
-
-  header.table_size = size - data_size - sizeof(header); /* doesn't yet include the bitmap */
-
-  bitmap_size = (data_size + (byte_bits-1)) >> log2_byte_bits;
-
-  size += bitmap_size;
-
-  bv = S_bytevector(size);
-  memset(&BVIT(bv, 0), 0, size);
-
-  p = TO_PTR(&BVIT(bv, 0));
-
-  /* Skip header for now */  
-  p = ptr_add(p, sizeof(vfasl_header));
-
-  vfi->base_addr = p;
-
-  /* Set pointers to vspaces based on sizes from first pass */
-  for (s = 0; s < vspaces_count; s++) {
-    vfasl_chunk *c;
-
-    c = vfasl_malloc(sizeof(vfasl_chunk));
-    c->bytes = p;
-    c->length = vfi->spaces[s].total_bytes;
-    c->used = 0;
-    c->swept = 0;
-    c->next = NULL;
-    c->prev = NULL;
-    vfi->spaces[s].first = c;
-
-    p = ptr_add(p, vfi->spaces[s].total_bytes);
-    vfi->spaces[s].total_bytes = 0;
-  }
-
-  vfi->symrefs = TO_VOIDP(p);
-  p = ptr_add(p, sizeof(vfoff) * vfi->symref_count);
-
-  vfi->base_rtd = S_G.base_rtd;
-  vfi->rtdrefs = TO_VOIDP(p);
-  p = ptr_add(p, sizeof(vfoff) * vfi->rtdref_count);
-
-  vfi->singletonrefs = TO_VOIDP(p);
-  p = ptr_add(p, sizeof(vfoff) * vfi->singletonref_count);
-
-  vfi->sym_count = 0;
-  vfi->symref_count = 0;
-  vfi->rtdref_count = 0;
-  vfi->singletonref_count = 0;
-
-  vfi->graph = make_vfasl_hash_table(0);
-
-  vfi->ptr_bitmap = TO_VOIDP(p);
-
-  /* Write data */
-
-  v = vfasl_copy_all(vfi, v);
-
-  header.result_offset = ptr_diff(v, vfi->base_addr);
-
-  /* Make all pointers relative to the start of the data area */
-  {
-    ptr *p2 = TO_VOIDP(vfi->base_addr);
-    uptr base_addr = (uptr)vfi->base_addr;
-    octet *bm = vfi->ptr_bitmap;
-    octet *bm_end = bm + bitmap_size;
-    uptr zeros = 0;
-    for (; bm != bm_end; bm++, p2 += byte_bits) {
-      octet m = *bm;
-      if (m == 0) {
-        zeros++;
-      } else {
-#       define MAYBE_FIXUP(i) if (m & (1 << i)) ((uptr *)p2)[i] -= base_addr;
-        MAYBE_FIXUP(0);
-        MAYBE_FIXUP(1);
-        MAYBE_FIXUP(2);
-        MAYBE_FIXUP(3);
-        MAYBE_FIXUP(4);
-        MAYBE_FIXUP(5);
-        MAYBE_FIXUP(6);
-        MAYBE_FIXUP(7);
-#       undef MAYBE_FIXUP
-        zeros = 0;
-      }
-    }
-
-    /* We can ignore trailing zeros */
-    header.table_size += (bitmap_size - zeros);
-  }
-
-  /* Truncate bytevector to match end of bitmaps */
-  {
-    uptr sz = sizeof(vfasl_header) + header.data_size + header.table_size;
-    BYTEVECTOR_TYPE(bv) = (sz << bytevector_length_offset) | type_bytevector;
-  }
-
-  memcpy(&BVIT(bv, 0), &header, sizeof(vfasl_header));
-
-  sort_offsets(vfi->symrefs, vfi->symref_count);
-  sort_offsets(vfi->rtdrefs, vfi->rtdref_count);
-  sort_offsets(vfi->singletonrefs, vfi->singletonref_count);
-  
-  return bv;
-}
-
-/* If compiled code uses `$install-library-entry`, then it can't be
-   combined into a single vfasled object, because the installation
-   needs to be evaluated for laster vfasls. Recognize a non-combinable
-   value as anything that references the C entry or even mentions the
-   symbol `$install-library-entry` (as defined in "library.ss"). If
-   non-boot code mentions the symbol `$install-library-entry`, it just
-   isn't as optimal.
-
-   This is an expensive test, since we perform half of a vfasl
-   encoding to look for `$install-library-entry`. */
-IBOOL S_vfasl_can_combinep(ptr v)
-{
-  IBOOL installs;
-  vfasl_info *vfi;
-
-  if (IMMEDIATE(v))
-    return 1;
-
-  fasl_init_entry_tables();
-
-  /* Run a "first pass" */
-  
-  vfi = vfasl_malloc(sizeof(vfasl_info));
-  vfasl_init(vfi);
-  (void)vfasl_copy_all(vfi, v);
-
-  installs = vfi->installs_library_entry;
-
-  return !installs;
-}
-
-/************************************************************/
-/* Traversals for saving                                    */
-
-static ptr vfasl_copy_all(vfasl_info *vfi, ptr v) {
-  seginfo *si;
-  int s;
-  int changed = 1;
-
-  si = MaybeSegInfo(ptr_get_segment(v));
-  
-  v = copy(vfi, v, si);
-
-  while (changed) {
-    changed = 0;
-    for (s = 0; s < vspaces_count; s++) {
-      vfasl_chunk *c = vfi->spaces[s].first;
-
-      /* consistent order of sweeping by older chunks first: */
-      if (c) {
-        while ((c->swept < c->used) && c->next)
-          c = c->next;
-        if (c->swept >= c->used)
-          c = c->prev;
-      }
-
-      while (c) {
-        ptr pp, pp_end;
-
-        pp = ptr_add(c->bytes, c->swept);
-        pp_end = ptr_add(c->bytes, c->used);
-        c->swept = c->used;
-
-        switch(s) {
-        case vspace_symbol:
-          while (pp < pp_end) {
-            pp = ptr_add(pp, sweep(vfi, TYPE((ptr)pp, type_symbol)));
-          }
-          break;
-        case vspace_closure:
-          while (pp < pp_end) {
-            pp = ptr_add(pp, sweep(vfi, TYPE((ptr)pp, type_closure)));
-          }
-          break;
-        case vspace_impure:
-          while (pp < pp_end) {
-            vfasl_relocate(vfi, TO_VOIDP(pp));
-            pp = ptr_add(pp, sizeof(ptr));
-          }
-          break;
-        case vspace_rtd:
-        case vspace_code:
-        case vspace_pure_typed:
-        case vspace_impure_record:
-          while (pp < pp_end) {
-            pp = ptr_add(pp, sweep(vfi, TYPE((ptr)pp, type_typed_object)));
-          }
-          break;
-        case vspace_data:
-        case vspace_reloc:
-          break;
-        default:
-          S_error_abort("vfasl: unrecognized space");
-          break;
-        }
-
-        if (c->swept >= c->used)
-          c = c->prev;
-        changed = 1;
-      }
-    }
-  }
-
-  return v;
-}
-
-static void vfasl_register_pointer(vfasl_info *vfi, ptr *pp) {
-  if (vfi->ptr_bitmap) {
-    uptr delta = ptr_diff(TO_PTR(pp), vfi->base_addr) >> log2_ptr_bytes;
-    uptr i = delta >> log2_byte_bits;
-    uptr bit = (((uptr)1) << (delta & (byte_bits - 1)));
-    vfi->ptr_bitmap[i] |= bit;
-  }
-}
-
-static uptr ptr_base_diff(vfasl_info *vfi, ptr p) {
-  if ((uptr)vfi->base_addr > (uptr)UNTYPE(p, TYPEBITS(p)))
-    S_error_abort("vfasl: pointer not in region");
-    
-  return ptr_diff(p, vfi->base_addr);
-}
-
-static void vfasl_register_symbol_reference(vfasl_info *vfi, ptr *pp, ptr p) {
-  if (vfi->symrefs)
-    vfi->symrefs[vfi->symref_count] = ptr_base_diff(vfi, TO_PTR(pp));
-  vfi->symref_count++;
-  *pp = SYMVAL(p); /* replace symbol reference with index of symbol */
-}
-
-static void vfasl_register_rtd_reference(vfasl_info *vfi, ptr pp) {
-  if (vfi->rtdrefs)
-    vfi->rtdrefs[vfi->rtdref_count] = ptr_base_diff(vfi, pp);
-  vfi->rtdref_count++;
-}
-
-static void vfasl_register_singleton_reference(vfasl_info *vfi, ptr *pp, int which) {
-  if (vfi->singletonrefs)
-    vfi->singletonrefs[vfi->singletonref_count] = ptr_base_diff(vfi, TO_PTR(pp));
-  vfi->singletonref_count++;
-  *pp = FIX(which);
-}
-
-static void vfasl_register_forward(vfasl_info *vfi, ptr pp, ptr p) {
-  vfasl_hash_table_set(vfi->graph, pp, p);
-}
-
-static ptr vfasl_lookup_forward(vfasl_info *vfi, ptr p) {
-  return vfasl_hash_table_ref(vfi->graph, p);
-}
-
-static void vfasl_relocate_parents(vfasl_info *vfi, ptr p) {
-  ptr ancestors = Snil;
-
-  while ((p != Sfalse) && !vfasl_lookup_forward(vfi, p)) {
-    ancestors = Scons(p, ancestors);
-    p = RECORDDESCPARENT(p);
-  }
-
-  while (ancestors != Snil) {
-    (void)vfasl_relocate_help(vfi, Scar(ancestors));
-    ancestors = Scdr(ancestors);
-  }
-}
-
-static ptr vfasl_find_room(vfasl_info *vfi, int s, ITYPE t, iptr n) {
-  ptr p;
-  uptr sz = vfi->spaces[s].total_bytes;
-
-  switch (s) {
-  case vspace_symbol:
-  case vspace_impure_record:
-    /* For these spaces, in case they will be loaded into the static
-       generation, objects must satisfy an extra constraint: an object
-       must not span segments unless it's at the start of a
-       segment. */
-    if (sz & (bytes_per_segment-1)) {
-      /* Since we're not at the start of a segment, don't let an
-         object span a segment */
-      if ((segment_align(sz) != segment_align(sz+n))
-          && ((sz+n) != segment_align(sz+n))) {
-        /* Fill in to next segment, instead. */
-        uptr delta = segment_align(sz) - sz;
-        vfasl_chunk *c, *new_c;
-
-        vfi->spaces[s].total_bytes += delta;
-
-        /* Mark the end of the old segment */
-        c = vfi->spaces[s].first;
-        p = ptr_add(c->bytes, c->used);
-        FWDMARKER(p) = forward_marker;
-
-        /* Create a new chunk so the old one tracks the current
-           swept-to-used region, and the new chunk starts a new
-           segment. If the old chunk doesn't have leftover bytes
-           (because we're in the first pass), then we'll need to
-           clean out this useless chunk below. */
-        new_c = vfasl_malloc(sizeof(vfasl_chunk));
-        new_c->bytes = ptr_add(c->bytes, c->used + delta);
-        new_c->length = c->length - (c->used + delta);
-        new_c->used = 0;
-        new_c->swept = 0;
-
-        new_c->prev = NULL;
-        new_c->next = c;        
-        c->prev = new_c;
-
-        vfi->spaces[s].first = new_c;
-      }
-    }
-    break;
-  default:
-    break;
-  }
-
-  vfi->spaces[s].total_bytes += n;
-
-  if (vfi->spaces[s].first->used + n > vfi->spaces[s].first->length) {
-    vfasl_chunk *c, *old_c;
-    iptr newlen = segment_align(n);
-
-    c = vfasl_malloc(sizeof(vfasl_chunk));
-    c->bytes = TO_PTR(vfasl_malloc(newlen));
-    c->length = newlen;
-    c->used = 0;
-    c->swept = 0;
-
-    old_c = vfi->spaces[s].first;
-    if (old_c->next && !old_c->length)
-      old_c = old_c->next; /* drop useless chunk created above */
-
-    c->prev = NULL;
-    c->next = old_c;
-    old_c->prev = c;
-
-    vfi->spaces[s].first = c;
-  }
-
-  p = ptr_add(vfi->spaces[s].first->bytes, vfi->spaces[s].first->used);
-  vfi->spaces[s].first->used += n;
-
-  return TYPE(p, t);
-}
-
-#define FIND_ROOM(vfi, s, t, n, p) p = vfasl_find_room(vfi, s, t, n)
-
-#include "vfasl.inc"
-
-static ptr vfasl_relocate_help(vfasl_info *vfi, ptr pp) {
-  ptr fpp;
-  seginfo *si;
-  
-  si = MaybeSegInfo(ptr_get_segment(pp));
-  if (!si)
-    vfasl_fail(vfi, "unknown");
-  
-  fpp = vfasl_lookup_forward(vfi, pp);
-  if (fpp)
-    return fpp;
-  else
-    return copy(vfi, pp, si);
-}
-
-/* Use vfasl_relocate only on addresses that are in the vfasl target area */
-static void vfasl_relocate(vfasl_info *vfi, ptr *ppp) {
-  ptr pp = *ppp, tf;
-  if (!IMMEDIATE(pp)) {
-    int which_singleton;
-    if ((which_singleton = detect_singleton(pp)))
-      vfasl_register_singleton_reference(vfi, ppp, which_singleton);
-    else {
-      pp = vfasl_relocate_help(vfi, pp);
-      *ppp = pp;
-      if (!IMMEDIATE(pp)) {
-        if (TYPEBITS(pp) == type_symbol)
-          vfasl_register_symbol_reference(vfi, ppp, pp);
-        else {
-          if ((TYPEBITS(pp) == type_typed_object)
-              && TYPEP((tf = TYPEFIELD(pp)), mask_record, type_record)
-              && is_rtd(tf, vfi))
-            vfasl_register_rtd_reference(vfi, TO_PTR(ppp));
-          vfasl_register_pointer(vfi, ppp);
-        }
-      }
-    }
-  }
-}
-
-static ptr vfasl_relocate_code(vfasl_info *vfi, ptr code) {
-  /* We don't want to register `code` as a pointer, since it is
-     treated more directly */
-  return vfasl_relocate_help(vfi, code);
-}
-
-static int is_rtd(ptr tf, vfasl_info *vfi)
-{
-  while (1) {
-    if (tf == vfi->base_rtd)
-      return 1;
-    if (tf == S_G.base_rtd)
-      return 1;
-
-    tf = RECORDDESCPARENT(tf);
-    if (tf == Sfalse)
-      return 0;
-  }
-}
-
 /*************************************************************/
 /* Code and relocation handling for save and load            */
 
-#define VFASL_RELOC_TAG_BITS         3
-
-#define VFASL_RELOC_C_ENTRY_TAG            1
-#define VFASL_RELOC_LIBRARY_ENTRY_TAG      2
-#define VFASL_RELOC_LIBRARY_ENTRY_CODE_TAG 3
-#define VFASL_RELOC_SYMBOL_TAG             4
-#define VFASL_RELOC_SINGLETON_TAG          5
-/* FXIME: rtds? */
-
-#define VFASL_RELOC_C_ENTRY(p) (((uptr)(p) << VFASL_RELOC_TAG_BITS) | VFASL_RELOC_C_ENTRY_TAG)
-#define VFASL_RELOC_LIBRARY_ENTRY(p) (((uptr)(p) << VFASL_RELOC_TAG_BITS) | VFASL_RELOC_LIBRARY_ENTRY_TAG)
-#define VFASL_RELOC_LIBRARY_ENTRY_CODE(p) (((uptr)(p) << VFASL_RELOC_TAG_BITS) | VFASL_RELOC_LIBRARY_ENTRY_CODE_TAG)
-#define VFASL_RELOC_SYMBOL(p) (((uptr)(p) << VFASL_RELOC_TAG_BITS) | VFASL_RELOC_SYMBOL_TAG)
-#define VFASL_RELOC_SINGLETON(p) (((uptr)(p) << VFASL_RELOC_TAG_BITS) | VFASL_RELOC_SINGLETON_TAG)
-
-#define VFASL_RELOC_TAG(p) (UNFIX(p) & ((1 << VFASL_RELOC_TAG_BITS) - 1))
-#define VFASL_RELOC_POS(p) (UNFIX(p) >> VFASL_RELOC_TAG_BITS)
-
-/* Picks a relocation variant that fits into the actual relocation's
-   shape, but holds an absolue value */
-static IFASLCODE abs_reloc_variant(IFASLCODE type) {
-  if (type == reloc_abs)
-    return reloc_abs;
-#if defined(I386) || defined(X86_64)
-  return reloc_abs;
-#elif defined(ARMV6)
-  return reloc_arm32_abs;
-#elif defined(AARCH64)
-  return reloc_arm64_abs;
-#elif defined(PPC32)
-  if (type == reloc_ppc32_abs)
-    return reloc_ppc32_abs;
-  else
-    return reloc_abs;
-#elif defined(PORTABLE_BYTECODE)
-  return reloc_pb_abs;
-#else
-  >> need to fill in for this platform <<
-#endif
-}
-
-static ptr vfasl_encode_relocation(vfasl_info *vfi, ptr obj) {
-  ptr pos;
-  int which_singleton;
-  
-  if ((which_singleton = detect_singleton(obj))) {
-    obj = FIX(VFASL_RELOC_SINGLETON(which_singleton));
-  } else if ((pos = vfasl_hash_table_ref(S_G.c_entries, obj))) {
-    pos = (ptr)((uptr)pos - 1);
-    if ((uptr)pos == CENTRY_install_library_entry)
-      vfi->installs_library_entry = 1;
-    obj = FIX(VFASL_RELOC_C_ENTRY(pos));
-  } else if ((pos = vfasl_hash_table_ref(S_G.library_entries, obj))) {
-    pos = (ptr)((uptr)pos - 1);
-    obj = FIX(VFASL_RELOC_LIBRARY_ENTRY(pos));
-  } else if ((pos = vfasl_hash_table_ref(S_G.library_entry_codes, obj))) {
-    pos = (ptr)((uptr)pos - 1);
-    obj = FIX(VFASL_RELOC_LIBRARY_ENTRY_CODE(pos));
-  } else if (Ssymbolp(obj)) {
-    obj = vfasl_relocate_help(vfi, obj);
-    obj = FIX(VFASL_RELOC_SYMBOL(UNFIX(SYMVAL(obj))));
-  } else if (IMMEDIATE(obj)) {
-    /* as-is */
-    if (Sfixnump(obj))
-      if (obj != FIX(0)) /* allow 0 for fcallable cookie */
-        S_error("vfasl", "unexpected fixnum in relocation");
-  } else {
-    obj = vfasl_relocate_help(vfi, obj);
-    obj = (ptr)ptr_diff(obj, vfi->base_addr);
-  }
+#define VFASL_RELOC_C_ENTRY(p) (((uptr)(p) << vfasl_reloc_tag_bits) | vfasl_reloc_c_entry_tag)
+#define VFASL_RELOC_LIBRARY_ENTRY(p) (((uptr)(p) << vfasl_reloc_tag_bits) | vfasl_reloc_library_entry_tag)
+#define VFASL_RELOC_LIBRARY_ENTRY_CODE(p) (((uptr)(p) << vfasl_reloc_tag_bits) | vfasl_reloc_library_entry_code_tag)
+#define VFASL_RELOC_SYMBOL(p) (((uptr)(p) << vfasl_reloc_tag_bits) | vfasl_reloc_symbol_tag)
+#define VFASL_RELOC_SINGLETON(p) (((uptr)(p) << vfasl_reloc_tag_bits) | vfasl_reloc_singleton_tag)
 
-  return obj;
-}
+#define VFASL_RELOC_TAG(p) (UNFIX(p) & ((1 << vfasl_reloc_tag_bits) - 1))
+#define VFASL_RELOC_POS(p) (UNFIX(p) >> vfasl_reloc_tag_bits)
 
 static void relink_code(ptr co, ptr sym_base, ptr *vspaces, uptr *vspace_offsets, IBOOL to_static) {
     ptr t; iptr a, m, n;
@@ -1190,22 +525,24 @@ static void relink_code(ptr co, ptr sym_base, ptr *vspaces, uptr *vspace_offsets
             code_off = RELOC_CODE_OFFSET(entry);
         }
         a += code_off;
-        obj = S_get_code_obj(abs_reloc_variant(RELOC_TYPE(entry)), co, a, item_off);
+
+        /* offset is stored in place of constant-loading code: */
+        memcpy(&obj, TO_VOIDP((ptr)((uptr)co + a)), sizeof(ptr));
 
         if (IMMEDIATE(obj)) {
           if (Sfixnump(obj)) {
             int tag = VFASL_RELOC_TAG(obj);
             iptr pos = VFASL_RELOC_POS(obj);
-            if (tag == VFASL_RELOC_SINGLETON_TAG)
+            if (tag == vfasl_reloc_singleton_tag)
               obj = lookup_singleton(pos);
-            else if (tag == VFASL_RELOC_C_ENTRY_TAG)
+            else if (tag == vfasl_reloc_c_entry_tag)
               obj = S_lookup_c_entry(pos);
-            else if ((tag == VFASL_RELOC_LIBRARY_ENTRY_TAG)
-                     || (tag == VFASL_RELOC_LIBRARY_ENTRY_CODE_TAG)) {
+            else if ((tag == vfasl_reloc_library_entry_tag)
+                     || (tag == vfasl_reloc_library_entry_code_tag)) {
               obj = S_lookup_library_entry(pos, 1);
-              if (tag == VFASL_RELOC_LIBRARY_ENTRY_CODE_TAG)
+              if (tag == vfasl_reloc_library_entry_code_tag)
                 obj = CLOSCODE(obj);
-            } else if (tag == VFASL_RELOC_SYMBOL_TAG) {
+            } else if (tag == vfasl_reloc_symbol_tag) {
               ptr val;
               obj = TYPE(ptr_add(sym_base, symbol_pos_to_offset(pos)), type_symbol);
               if ((val = SYMVAL(obj)) != sunbound)
@@ -1259,69 +596,10 @@ static ptr find_pointer_from_offset(uptr p_off, ptr *vspaces, uptr *vspace_offse
   return TYPE(ptr_add(vspaces[s], p_off - vspace_offsets[s]), t);
 }
 
-/*************************************************************/
-/* Symbol names                                              */
-
-static iptr vfasl_symbol_to_index(vfasl_info *vfi, ptr pp)
-{
-  uptr pos = vfi->sym_count++;
-  ptr name = SYMNAME(pp);
-  if (Sstringp(name))
-    vfasl_check_install_library_entry(vfi, name);
-  else if (!Spairp(name) || (Scar(name) == Sfalse))
-    vfasl_fail(vfi, "gensym without unique name");
-  return pos;
-}
-
-/*************************************************************/
-/* C and library entries                                     */
-
-static void fasl_init_entry_tables()
-{
-  tc_mutex_acquire();
-
-  if (!S_G.c_entries) {
-    iptr i;
-    
-    S_G.c_entries = make_vfasl_hash_table(1);
-    S_G.library_entries = make_vfasl_hash_table(1);
-    S_G.library_entry_codes = make_vfasl_hash_table(1);
-
-    for (i = Svector_length(S_G.c_entry_vector); i--; ) {
-      ptr entry = Svector_ref(S_G.c_entry_vector, i);
-      vfasl_hash_table_set(S_G.c_entries, entry, (ptr)(i+1));
-    }
-
-    for (i = Svector_length(S_G.library_entry_vector); i--; ) {
-      ptr entry = Svector_ref(S_G.library_entry_vector, i);
-      if (entry != Sfalse) {
-        vfasl_hash_table_set(S_G.library_entries, entry, (ptr)(i+1));
-        if (Sprocedurep(entry))
-          vfasl_hash_table_set(S_G.library_entry_codes, CLOSCODE(entry), (ptr)(i+1));
-      }
-    }
-  }
-
-  tc_mutex_release();
-}
-
-static void vfasl_check_install_library_entry(vfasl_info *vfi, ptr name)
-{
-  const char *ile = "$install-library-entry";
-  iptr len = Sstring_length(name), i;
-
-  for (i = 0; i < len; i++) {
-    if (Sstring_ref(name, i) != (unsigned)ile[i])
-      return;
-  }
-
-  if (!ile[i])
-    vfi->installs_library_entry = 1;
-}
-
 /*************************************************************/
 /* Singletons, such as ""                                    */
 
+/* This array needs to be in the same order as the enumeration in "cmacro.ss" */
 static ptr *singleton_refs[] = { &S_G.null_string,
                                  &S_G.null_vector,
                                  &S_G.null_fxvector,
@@ -1333,162 +611,26 @@ static ptr *singleton_refs[] = { &S_G.null_string,
                                  &S_G.eqp,
                                  &S_G.eqvp,
                                  &S_G.equalp,
-                                 &S_G.symboleqp };
-
-static int detect_singleton(ptr p) {
-  unsigned i;
-  for (i = 0; i < sizeof(singleton_refs) / sizeof(ptr*); i++) {
-    if (p == *(singleton_refs[i]))
-      return i+1;
-  }
-  return 0;
-}
+                                 &S_G.symboleqp,
+                                 &S_G.symbol_symbol,
+                                 &S_G.symbol_ht_rtd };
 
 static ptr lookup_singleton(iptr which) {
-  return *(singleton_refs[which-1]);
-}  
-  
-/*************************************************************/
-/* `eq?`-based hash table during saving as critical section  */
-
-typedef struct hash_entry {
-  ptr key, value;
-} hash_entry;
-
-struct vfasl_hash_table {
-  IBOOL permanent;
-  uptr count;
-  uptr size;
-  hash_entry *entries;
-};
+  ptr v;
 
-#define HASH_CODE(p) ((uptr)(p) >> log2_ptr_bytes)
-#define HASH_CODE2(p) (((uptr)(p) >> (log2_ptr_bytes + log2_ptr_bytes)) | 1)
+  v = *(singleton_refs[which-1]);
 
-static vfasl_hash_table *make_vfasl_hash_table(IBOOL permanent) {
-  vfasl_hash_table *ht;
-
-  if (permanent)
-    ht = malloc(sizeof(vfasl_hash_table));
-  else
-    ht = vfasl_malloc(sizeof(vfasl_hash_table));
-
-  ht->permanent = permanent;
-  ht->count = 0;
-  ht->size = 16;
-  if (permanent)
-    ht->entries = calloc(sizeof(hash_entry), ht->size);
-  else
-    ht->entries = vfasl_calloc(sizeof(hash_entry), ht->size);
-
-  return ht;
-}
-
-static void vfasl_hash_table_set(vfasl_hash_table *ht, ptr key, ptr value) {
-  uptr hc = HASH_CODE(key);
-  uptr hc2 = HASH_CODE2(key);
-  uptr size = ht->size;
-
-  if (ht->count > ht->size >> 1) {
-    /* rehash */
-    uptr i;
-    hash_entry *old_entries = ht->entries;
-    
-    ht->count = 0;
-    ht->size *= 2;
-    if (ht->permanent)
-      ht->entries = calloc(sizeof(hash_entry), ht->size);
-    else
-      ht->entries = vfasl_calloc(sizeof(hash_entry), ht->size);
-    
-    for (i = 0; i < size; i++) {
-      if (old_entries[i].key)
-        vfasl_hash_table_set(ht, old_entries[i].key, old_entries[i].value);
-    }
-
-    if (ht->permanent)
-      free(old_entries);
-    
-    size = ht->size;
-  }
-
-  hc = hc & (size - 1);
-  while (ht->entries[hc].key) {
-    hc = (hc + hc2) & (size - 1);
-  }
-
-  ht->entries[hc].key = key;
-  ht->entries[hc].value = value;
-  ht->count++;
-}
-
-static ptr vfasl_hash_table_ref(vfasl_hash_table *ht, ptr key) {
-  uptr hc = HASH_CODE(key);
-  uptr hc2 = HASH_CODE2(key);
-  uptr size = ht->size;
-  ptr old_key;
-
-  hc = hc & (size - 1);
-  while ((old_key = ht->entries[hc].key) != key) {
-    if (!old_key)
-      return (ptr)0;
-    hc = (hc + hc2) & (size - 1);
-  }
-
-  return ht->entries[hc].value;
-}
-
-/*************************************************************/
-
-static void *vfasl_malloc(uptr sz) {
-  ptr tc = get_thread_context();
-  void *p;
-  newspace_find_room_voidp(tc, ptr_align(sz), p);
-  return p;
-}
-
-static void *vfasl_calloc(uptr sz, uptr n) {
-  void *p;
-  sz *= n;
-  p = vfasl_malloc(sz);
-  memset(p, 0, sz);
-  return p;
-}
-
-/*************************************************************/
-
-static void sort_offsets(vfoff *p, vfoff len)
-{
-  while (1) {
-    if (len > 1) {
-      vfoff i, pivot = 0;
-
-      {
-        vfoff mid = len >> 2;
-        vfoff tmp = p[mid];
-        p[mid] = p[0];
-        p[0] = tmp;
-      }
-      
-      for (i = 1; i < len; i++) {
-        if (p[i] < p[pivot]) {
-          vfoff tmp = p[pivot];
-          p[pivot] = p[i];
-          pivot++;
-          p[i] = p[pivot];
-          p[pivot] = tmp;
-        }
-      }
-
-      if (pivot > (len >> 1)) {
-        sort_offsets(p+pivot+1, len-pivot-1);
-        len = pivot;
-      } else {
-        sort_offsets(p, pivot);
-        p = p+pivot+1;
-        len = len-pivot-1;
-      }
+  if (v == Sfalse) {
+    if (which == singleton_symbol_ht_rtd) {
+      S_G.symbol_ht_rtd = SYMVAL(S_intern((const unsigned char *)"$symbol-ht-rtd"));
+      if (!Srecordp(S_G.symbol_ht_rtd)) S_error_abort("$symbol-ht-rtd has not been set");
+    } else if (which == singleton_eq) {
+      S_G.eqp = SYMVAL(S_intern((const unsigned char *)"eq?"));
+      if (!Sprocedurep(S_G.eqp)) S_error_abort("eq? has not been set");
     } else
-      return;
+      S_error_abort("vfasl: singleton not ready");
+    v = *(singleton_refs[which-1]);
   }
-}
+
+  return v;
+}  
diff --git a/racket/src/ChezScheme/makefiles/Mf-install.in b/racket/src/ChezScheme/makefiles/Mf-install.in
index be5c8334717..c6c3d080752 100644
--- a/racket/src/ChezScheme/makefiles/Mf-install.in
+++ b/racket/src/ChezScheme/makefiles/Mf-install.in
@@ -62,7 +62,7 @@ InstallLZ4Target=
 #                 no changes should be needed below this point                #
 ###############################################################################
 
-Version=csv9.5.3.55
+Version=csv9.5.3.56
 Include=boot/$m
 PetiteBoot=boot/$m/petite.boot
 SchemeBoot=boot/$m/scheme.boot
diff --git a/racket/src/ChezScheme/mats/misc.ms b/racket/src/ChezScheme/mats/misc.ms
index 280da7dfbb4..3c88348f381 100644
--- a/racket/src/ChezScheme/mats/misc.ms
+++ b/racket/src/ChezScheme/mats/misc.ms
@@ -4927,7 +4927,11 @@
     (define immutable-objs (list (vector->immutable-vector '#(1 2 3))
                                  (string->immutable-string "abc")
                                  (bytevector->immutable-bytevector #vu8(1 2 3))
-                                 (box-immutable 1)))
+                                 (box-immutable 1)
+                                 ;; Not immutable, but we want to test strip:
+                                 (fxvector 1 2 3)
+                                 (flvector 1.5 2.5 3.5)
+                                 (stencil-vector 6 'a 'b)))
     (define immutable-zero-objs (list (vector->immutable-vector '#())
                                       (string->immutable-string "")
                                       (bytevector->immutable-bytevector #vu8())
diff --git a/racket/src/ChezScheme/mats/primvars.ms b/racket/src/ChezScheme/mats/primvars.ms
index 83427dedaed..f51d6ef35d7 100644
--- a/racket/src/ChezScheme/mats/primvars.ms
+++ b/racket/src/ChezScheme/mats/primvars.ms
@@ -395,6 +395,7 @@
               [(environment) *env '((a . b)) #f]
               [(eq-hashtable) *eq-hashtable *symbol-hashtable #f]
               [(exact-integer) (- (most-negative-fixnum) 1) 2.0 1/2 #f]
+              [(exact-uinteger) (+ (most-positive-fixnum) 1) -10 2.0 1/2 #f]
               [(exception-state) (current-exception-state) 0 #f]
               [(eof/char) #\a 0 #f]
               [(eof/u8) 0 -1 (expt 2 8) "a" #f]
diff --git a/racket/src/ChezScheme/rktboot/make-boot.rkt b/racket/src/ChezScheme/rktboot/make-boot.rkt
index dc5240f2963..3c559179c8e 100644
--- a/racket/src/ChezScheme/rktboot/make-boot.rkt
+++ b/racket/src/ChezScheme/rktboot/make-boot.rkt
@@ -402,7 +402,6 @@
       (eval `(mkgc-ocd.inc ,(path->string (build-path out-subdir "gc-ocd.inc"))))
       (eval `(mkgc-oce.inc ,(path->string (build-path out-subdir "gc-oce.inc"))))
       (eval `(mkgc-par.inc ,(path->string (build-path out-subdir "gc-par.inc"))))
-      (eval `(mkvfasl.inc ,(path->string (build-path out-subdir "vfasl.inc"))))
       (eval `(mkheapcheck.inc ,(path->string (build-path out-subdir "heapcheck.inc"))))
       (plumber-flush-all (current-plumber))))
 
diff --git a/racket/src/ChezScheme/s/Mf-base b/racket/src/ChezScheme/s/Mf-base
index c1a59c6ba3a..c42e9fe2f6e 100644
--- a/racket/src/ChezScheme/s/Mf-base
+++ b/racket/src/ChezScheme/s/Mf-base
@@ -115,7 +115,6 @@ Cequates = ../boot/$m/equates.h
 Cgcocd = ../boot/$m/gc-ocd.inc
 Cgcoce = ../boot/$m/gc-oce.inc
 Cgcpar = ../boot/$m/gc-par.inc
-Cvfasl = ../boot/$m/vfasl.inc
 Cheapcheck = ../boot/$m/heapcheck.inc
 Revision = ../boot/$m/revision
 
@@ -128,7 +127,7 @@ patch = patch
 patchobj = patch.patch cpnanopass.patch cprep.patch cpcheck.patch\
  cp0.patch cpvalid.patch cptypes.patch cpcommonize.patch cpletrec.patch\
  reloc.patch\
- compile.patch fasl.patch syntax.patch env.patch\
+ compile.patch fasl.patch vfasl.patch syntax.patch env.patch\
  read.patch interpret.patch ftype.patch strip.patch\
  ubify.patch
 
@@ -151,7 +150,7 @@ basesrc =\
  interpret.ss cprep.ss cpcheck.ss cp0.ss cpvalid.ss  cptypes.ss cpcommonize.ss cpletrec.ss inspect.ss\
  enum.ss io.ss read.ss primvars.ss syntax.ss costctr.ss expeditor.ss\
  exceptions.ss pretty.ss env.ss\
- fasl.ss reloc.ss pdhtml.ss strip.ss ftype.ss back.ss
+ fasl.ss vfasl.ss reloc.ss pdhtml.ss strip.ss ftype.ss back.ss
 
 baseobj = ${basesrc:%.ss=%.$m}
 
@@ -170,14 +169,14 @@ macroobj =\
 allsrc =\
  ${basesrc} ${compilersrc} cmacros.ss ${archincludes} setup.ss debug.ss priminfo.ss primdata.ss layout.ss\
  base-lang.ss expand-lang.ss primref.ss types.ss io-types.ss fasl-helpers.ss hashtable-types.ss\
- np-languages.ss fxmap.ss
+ np-languages.ss fxmap.ss strip-types.ss
 
 # doit uses a different Scheme process to compile each target
-doit: ${PetiteBoot} ${SchemeBoot} ${Cheader} ${Cequates} ${Cgcocd} ${Cgcoce} ${Cgcpar} ${Cvfasl} ${Cheapcheck} ${Revision}
+doit: ${PetiteBoot} ${SchemeBoot} ${Cheader} ${Cequates} ${Cgcocd} ${Cgcoce} ${Cgcpar} ${Cheapcheck} ${Revision}
 
 # all uses a single Scheme process to compile all targets.  this is typically
 # faster when most of the targets need to be recompiled.
-all: bootall ${Cheader} ${Cequates} ${Cgcocd} ${Cgcoce} ${Cgcpar} ${Cvfasl} ${Cheapcheck} ${Revision}
+all: bootall ${Cheader} ${Cequates} ${Cgcocd} ${Cgcoce} ${Cgcpar} ${Cheapcheck} ${Revision}
 
 # allx runs all up to three times and checks to see if the new boot file is the
 # same as the last, i.e., the system is properly bootstrapped.
@@ -364,7 +363,7 @@ resetbootlinks:
              | ${Scheme} -q
 
 keepbootfiles:
-	for x in `echo scheme.boot petite.boot scheme.h equates.h gc-oce.inc gc-ocd.inc gc-par.inc vfasl.inc heapcheck.inc` ; do\
+	for x in `echo scheme.boot petite.boot scheme.h equates.h gc-oce.inc gc-ocd.inc gc-par.inc heapcheck.inc` ; do\
           if [ ! -h ../boot/$(m)/$$x ] ; then \
             mv -f ../boot/$(m)/$$x ../../boot/$(m)/$$x ;\
           elif [ "${upupupbootdir}" != "../../.." ] ; then \
@@ -593,11 +592,15 @@ ${patch}: ${patchobj}
 ${asm} ${obj} mkheader.so: ${macroobj} nanopass.so base-lang.ss expand-lang.ss primref.ss types.ss io-types.ss fasl-helpers.ss hashtable-types.ss ${patchfile}
 primvars.so setup.so mkheader.so env.so: cmacros.so priminfo.so primref.ss
 setup.so: debug.ss
+strip.so: strip-types.ss
+vfasl.so: strip-types.ss
 
-${patchobj}: ${macroobj} nanopass.so base-lang.ss expand-lang.ss primref.ss types.ss io-types.ss fasl-helpers.ss hashtable-types.ss env.ss
+${patchobj}: ${macroobj} nanopass.so base-lang.ss expand-lang.ss primref.ss types.ss io-types.ss fasl-helpers.ss hashtable-types.ss strip-types.ss env.ss
 cpnanopass.$m cpnanopass.patch: nanopass.so np-languages.ss fxmap.ss ${archincludes}
 cptypes.$m: fxmap.ss
 5_4.$m: ../unicode/unicode-char-cases.ss ../unicode/unicode-charinfo.ss
+strip.$m: strip-types.ss
+vfasl.$m: strip-types.ss
 
 ${Cheader}: mkheader.so ${macroobj} nanopass.so base-lang.ss expand-lang.ss primref.ss types.ss io-types.ss fasl-helpers.ss hashtable-types.ss
 	(if [ -r ${Cheader} ]; then mv -f ${Cheader} ${Cheader}.bak; fi)
@@ -644,15 +647,6 @@ ${Cgcpar}: mkgc.so ${macroobj} nanopass.so base-lang.ss expand-lang.ss primref.s
           then mv -f ${Cgcpar}.bak ${Cgcpar};\
           else rm -f ${Cgcpar}.bak; fi)
 
-${Cvfasl}: mkgc.so ${macroobj} nanopass.so base-lang.ss expand-lang.ss primref.ss types.ss io-types.ss fasl-helpers.ss hashtable-types.ss
-	(if [ -r ${Cvfasl} ]; then mv -f ${Cvfasl} ${Cvfasl}.bak; fi)
-	echo '(reset-handler abort)'\
-             '(mkvfasl.inc "${Cvfasl}")' |\
-         ${Scheme} -q ${macroobj} mkheader.so mkgc.so
-	(if `cmp -s ${Cvfasl} ${Cvfasl}.bak`;\
-          then mv -f ${Cvfasl}.bak ${Cvfasl};\
-          else rm -f ${Cvfasl}.bak; fi)
-
 ${Cheapcheck}: mkgc.so ${macroobj} nanopass.so base-lang.ss expand-lang.ss primref.ss types.ss io-types.ss fasl-helpers.ss hashtable-types.ss
 	(if [ -r ${Cheapcheck} ]; then mv -f ${Cheapcheck} ${Cheapcheck}.bak; fi)
 	echo '(reset-handler abort)'\
@@ -685,7 +679,6 @@ reset:
 	$(MAKE) reset-one FILE=gc-oce.inc
 	$(MAKE) reset-one FILE=gc-ocd.inc
 	$(MAKE) reset-one FILE=gc-par.inc
-	$(MAKE) reset-one FILE=vfasl.inc
 	$(MAKE) reset-one FILE=heapcheck.inc
 
 .PHONY: reset-one
diff --git a/racket/src/ChezScheme/s/cmacros.ss b/racket/src/ChezScheme/s/cmacros.ss
index 1b783f29a4a..82a3d1e8669 100644
--- a/racket/src/ChezScheme/s/cmacros.ss
+++ b/racket/src/ChezScheme/s/cmacros.ss
@@ -357,7 +357,7 @@
 ;; ---------------------------------------------------------------------
 ;; Version and machine types:
 
-(define-constant scheme-version #x09050337)
+(define-constant scheme-version #x09050338)
 
 (define-syntax define-machine-types
   (lambda (x)
@@ -420,6 +420,12 @@
 (define-constant ptr-bytes (/ (constant ptr-bits) 8)) ; size in bytes
 (define-constant log2-ptr-bytes (log2 (constant ptr-bytes)))
 
+(define-constant double-bytes 8)
+
+(define-constant byte-bytes 1)
+(define-constant byte-bits 8)
+(define-constant log2-byte-bits 3)
+
 ;;; ordinary types must be no more than 8 bits long
 (define-constant ordinary-type-bits 8)    ; smallest addressable unit
 
@@ -2185,6 +2191,68 @@
 (define-constant time-collector-cpu 5)
 (define-constant time-collector-real 6)
 
+;; ---------------------------------------------------------------------
+;; vfasl
+
+;; For vfasl images: Similar to allocation spaces, but not all
+;; allocation spaces are represented, and these spaces are more
+;; fine-grained in some cases:
+(define-enumerated-constants
+  vspace-symbol
+  vspace-rtd
+  vspace-closure
+  vspace-impure
+  vspace-pure-typed
+  vspace-impure-record
+  ;; rest rest are at then end to make the pointer bitmap
+  ;; end with zeros (that can be dropped):
+  vspace-code
+  vspace-data
+  vspace-reloc ;; can be dropped after direct to static generation
+  vspaces-count)
+
+(define-constant vspaces-offsets-count (- (constant vspaces-count) 1))
+
+(define-primitive-structure-disps vfasl-header typemod
+  ([uptr data-size]
+   [uptr table-size]
+   
+   [uptr result-offset]
+   
+   ;; first starting offset is 0, so skip it in this array:
+   [uptr vspace-rel-offsets (constant vspaces-offsets-count)]
+   
+   [uptr symref-count]
+   [uptr rtdref-count]
+   [uptr singletonref-count]))
+
+(define-enumerated-constants
+  singleton-not-a-singleton
+  singleton-null-string
+  singleton-null-vector
+  singleton-null-fxvector
+  singleton-null-flvector
+  singleton-null-bytevector
+  singleton-null-immutable-string
+  singleton-null-immutable-vector
+  singleton-null-immutable-bytevector
+  singleton-eq
+  singleton-eqv
+  singleton-equal
+  singleton-symbol=?
+  singleton-symbol-symbol
+  singleton-symbol-ht-rtd)
+
+(define-constant vfasl-reloc-tag-bits 3)
+
+(define-enumerated-constants
+  vfasl-reloc-not-a-tag
+  vfasl-reloc-c-entry-tag
+  vfasl-reloc-library-entry-tag
+  vfasl-reloc-library-entry-code-tag
+  vfasl-reloc-symbol-tag
+  vfasl-reloc-singleton-tag)
+
 ;; ---------------------------------------------------------------------
 ;; General helpers for the compiler and runtime implementation:
 
diff --git a/racket/src/ChezScheme/s/compile.ss b/racket/src/ChezScheme/s/compile.ss
index eed7cfc4e95..5349d22429d 100644
--- a/racket/src/ChezScheme/s/compile.ss
+++ b/racket/src/ChezScheme/s/compile.ss
@@ -150,19 +150,16 @@
                           [(arm32)
                            (record-case c
                              [(arm32-abs) (n x)
-                              ; on ARMV7 would be 8: 4-byte movi, 4-byte movt
-                              (let ([a1 (fx- a 12)]) ; 4-byte ldr, 4-byte bra, 4-byte value
+                              (let ([a1 (fx- a 4)]) ; [4-byte ldr, 4-byte bra,] 4-byte value
                                 (let ([x* (cons (mkcode x) x*)])
                                   (let ([r ($reloc (constant reloc-arm32-abs) n (fx- a1 ra))])
                                     (mkc0 (cdr c*) a (cons r r*) a1 x*))))]
                              [(arm32-call) (n x)
-                              ; on ARMV7 would be 12: 4-byte movi, 4-byte movt, 4-byte blx
                               (let ([a1 (fx- a 16)]) ; 4-byte ldr, 4-byte bra, 4-byte value, 4-byte blx
                                 (let ([x* (cons (mkcode x) x*)])
                                   (let ([r ($reloc (constant reloc-arm32-call) n (fx- a1 ra))])
                                     (mkc0 (cdr c*) a (cons r r*) a1 x*))))]
                              [(arm32-jump) (n x)
-                              ; on ARMV7 would be 12: 4-byte movi, 4-byte movt, 4-byte bx
                               (let ([a1 (fx- a 16)]) ; 4-byte ldr, 4-byte bra, 4-byte value, 4-byte bx
                                 (let ([x* (cons (mkcode x) x*)])
                                   (let ([r ($reloc (constant reloc-arm32-jump) n (fx- a1 ra))])
@@ -411,17 +408,14 @@
                          [(arm32)
                           (record-case c
                             [(arm32-abs) (n x)
-                             ; on ARMV7 would be 8: 4-byte movi, 4-byte movt
-                             (let ([a1 (fx- a 12)]) ; 4-byte ldr, 4-byte bra, 4-byte value
+                             (let ([a1 (fx- a 4)]) ; [4-byte ldr, 4-byte bra,] 4-byte value
                                (let ([r ($reloc (constant reloc-arm32-abs) n (fx- a1 ra))])
                                  (prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
                             [(arm32-call) (n x)
-                             ; on ARMV7 would be 12: 4-byte movi, 4-byte movt, 4-byte blx
                              (let ([a1 (fx- a 16)]) ; 4-byte ldr, 4-byte bra, 4-byte value, 4-byte blx
                                (let ([r ($reloc (constant reloc-arm32-call) n (fx- a1 ra))])
                                  (prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
                             [(arm32-jump) (n x)
-                             ; on ARMV7 would be 12: 4-byte movi, 4-byte movt, 4-byte bx
                              (let ([a1 (fx- a 16)]) ; 4-byte ldr, 4-byte bra, 4-byte value, 4-byte bx
                                (let ([r ($reloc (constant reloc-arm32-jump) n (fx- a1 ra))])
                                  (prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
@@ -1829,43 +1823,8 @@
     ; create boot loader (invoke) for entry into Scheme from C
     (lambda (out machine . bootfiles)
       (do-make-boot-header who out machine bootfiles)))
-  
-  (set-who! vfasl-convert-file
-    (let ([->vfasl (foreign-procedure "(cs)to_vfasl" (scheme-object) scheme-object)]
-          [vfasl-can-combine? (foreign-procedure "(cs)vfasl_can_combinep" (scheme-object) boolean)])
-      (lambda (in-file out-file bootfile*)
-        (let ([op ($open-file-output-port who out-file (file-options replace))])
-          (on-reset (delete-file out-file #f)
-            (on-reset (close-port op)
-              (when bootfile*
-                (emit-boot-header op (constant machine-type-name) bootfile*))
-              (emit-header op (constant scheme-version) (constant machine-type))
-              (let ([ip ($open-file-input-port who in-file (file-options compressed))])
-                (on-reset (close-port ip)
-                  (let* ([write-out (lambda (x)
-                                      (let ([bv (->vfasl x)])
-                                        ($write-fasl-bytevectors op (list bv) (bytevector-length bv)
-                                                                 (constant fasl-type-visit-revisit) (constant fasl-type-vfasl))))]
-                         [write-out-accum (lambda (accum)
-                                            (unless (null? accum)
-                                              (if (null? (cdr accum))
-                                                  (write-out (car accum))
-                                                  (write-out (list->vector (reverse accum))))))])
-                    (let loop ([accum '()])
-                      (let ([x (fasl-read ip)])
-                        (cond
-                         [(eof-object? x)
-                          (write-out-accum accum)]
-                         [(not (vfasl-can-combine? x))
-                          (write-out-accum accum)
-                          (write-out x)
-                          (loop '())]
-                         [(vector? x)
-                          (loop (append (reverse (vector->list x)) accum))]
-                         [else
-                          (loop (cons x accum))]))))
-                  (close-port ip)))
-              (close-port op)))))))
+
+  (set! $emit-boot-header emit-boot-header)
   )
 
 (set-who! $write-fasl-bytevectors
diff --git a/racket/src/ChezScheme/s/cpnanopass.ss b/racket/src/ChezScheme/s/cpnanopass.ss
index 50833cb63c5..476f2dfec26 100644
--- a/racket/src/ChezScheme/s/cpnanopass.ss
+++ b/racket/src/ChezScheme/s/cpnanopass.ss
@@ -548,7 +548,7 @@
                                             arg-offset fp-offset rextra* rfpextra*)
                                          (if (eq? (syntax->datum (car other-type*)) 'fp)
                                              (f (cdr other*) (cdr other-type*) (cons fp-offset rtc-disp*)
-                                                arg-offset (fx+ fp-offset 8) rextra* (cons other rfpextra*))
+                                                arg-offset (fx+ fp-offset (constant double-bytes)) rextra* (cons other rfpextra*))
                                              (f (cdr other*) (cdr other-type*) (cons arg-offset rtc-disp*)
                                                 (fx+ arg-offset (constant ptr-bytes)) fp-offset (cons other rextra*) rfpextra*))))))]
                             [_ (syntax-error x "missing or out-of-order required registers")])]
diff --git a/racket/src/ChezScheme/s/fasl-helpers.ss b/racket/src/ChezScheme/s/fasl-helpers.ss
index e45fdce123b..7ca6c872ff0 100644
--- a/racket/src/ChezScheme/s/fasl-helpers.ss
+++ b/racket/src/ChezScheme/s/fasl-helpers.ss
@@ -148,10 +148,16 @@
      (put-bytevector p (constant fasl-header))
      (put-uptr p version)
      (put-uptr p mtype)
-     (put-u8 p (char->integer #\())           ; )
+     (put-u8 p (char->integer #\())
      (let f ([bootfiles bootfiles] [sep? #f])
        (unless (null? bootfiles)
-         (when sep? (put-u8 p (char->integer #\space)))
-         (put-str p (car bootfiles))
-         (f (cdr bootfiles) #t)))        ; (
+         (cond
+           [(string? (car bootfiles))
+            (when sep? (put-u8 p (char->integer #\space)))
+            (put-str p (car bootfiles))
+            (f (cdr bootfiles) #t)]
+           [else
+            ;; strip produces dependenices as a sequence of bytes
+            (put-u8 p (car bootfiles))
+            (f (cdr bootfiles) #f)])))
      (put-u8 p (char->integer #\)))]))
diff --git a/racket/src/ChezScheme/s/fasl.ss b/racket/src/ChezScheme/s/fasl.ss
index be831c7c0c5..b5c45b831cb 100644
--- a/racket/src/ChezScheme/s/fasl.ss
+++ b/racket/src/ChezScheme/s/fasl.ss
@@ -13,6 +13,9 @@
 ;;; See the License for the specific language governing permissions and
 ;;; limitations under the License.
 
+;; The fasl reader is "fasl.c", which includes an overview of the fasl
+;; format.
+
 (let ()
 (define-record-type target
   (nongenerative #{target dchg2hp5v3cck8ge283luo-1})
diff --git a/racket/src/ChezScheme/s/mkgc.ss b/racket/src/ChezScheme/s/mkgc.ss
index d73b1c90386..e65a9bbd84d 100644
--- a/racket/src/ChezScheme/s/mkgc.ss
+++ b/racket/src/ChezScheme/s/mkgc.ss
@@ -25,8 +25,6 @@
 ;;   - self-test   : check immediate pointers only for self references
 ;;   - size        : immediate size, so does not recur
 ;;   - measure     : recurs for reachable size
-;;   - vfasl-copy
-;;   - vfasl-sweep
 ;;   - check
 
 ;; For the specification, there are a few declaration forms described
@@ -71,7 +69,6 @@
 ;; Primitive actions/declarations, must be used as statements in roughly
 ;; this order (but there are exceptions to the order):
 ;;  - (space <space>) : target for copy; works as a constraint for other modes
-;;  - (vspace <vspace>) : target for vfasl
 ;;  - (size <size> [<scale>]) : size for copy; skips rest in size mode
 ;;  - (mark <flag>) : in mark mode, skips rest except counting;
 ;;      possible <flags>:
@@ -106,7 +103,6 @@
 ;; an identifier or a Parenthe-C expression. The meaning of a plain
 ;; identifier depends on the nonterminal:
 ;;  - <space>  : should be a `space-...` from cmacro
-;;  - <vspace> : should be a `vspace_...`
 ;;  - <size>   : should be a constant from cmacro
 ;;  - <field>  : accessor from cmacro, implicitly applied to `_` and `_copy_`
 
@@ -151,7 +147,7 @@
 ;;
 ;; Built-in variables:
 ;;  - _                 : object being copied, swept, etc.
-;;  - _copy_            : target in copy or vfasl mode, same as _ otherwise
+;;  - _copy_            : target in copy mode, same as _ otherwise
 ;;  - _size_            : size of the current object, but only in parallel mode
 ;;  - _tf_              : type word
 ;;  - _tg_              : target generation
@@ -168,7 +164,6 @@
     (case-space
      [space-ephemeron
       (space space-ephemeron)
-      (vfasl-fail "ephemeron")
       (size size-ephemeron)
       (copy pair-car)
       (copy pair-cdr)
@@ -186,7 +181,6 @@
       (count countof-ephemeron)]
      [space-weakpair
       (space space-weakpair)
-      (vfasl-fail "weakpair")
       (case-mode
        [(check) (trace pair-car)]
        [else])
@@ -195,7 +189,6 @@
                        countof-weakpair)]
      [else
       (space space-impure)
-      (vspace vspace_impure) 
       (try-double-pair trace pair-car
                        trace pair-cdr
                        countof-pair)])]
@@ -214,7 +207,6 @@
        (space (cond
                 [(and-counts (is_counting_root si _)) space-count-pure]
                 [else space-continuation]))
-       (vfasl-fail "closure")
        (size size-continuation)
        (case-mode
         [self-test]
@@ -282,10 +274,6 @@
                  space-closure]
                 [off
                  space-pure])])]))
-       (vspace vspace_closure)
-       (when-vfasl
-        (when (& (code-type code) (<< code-flag-mutable-closure code-flags-offset))
-          (vfasl-fail "mutable closure")))
        (define len : uptr (code-closure-length code))
        (size (size_closure len))
        (when-mark
@@ -311,20 +299,18 @@
    
    [symbol
     (space space-symbol)
-    (vspace vspace_symbol)
     (size size-symbol)
     (mark one-bit)
-    (trace/define symbol-value val :vfasl-as (FIX (vfasl_symbol_to_index vfi _)))
+    (trace/define symbol-value val)
     (trace-local-symcode symbol-pvalue val)
-    (trace-nonself/vfasl-as-nil symbol-plist)
+    (trace-nonself symbol-plist)
     (trace-nonself symbol-name)
-    (trace-nonself/vfasl-as-nil symbol-splist)
+    (trace-nonself symbol-splist)
     (trace-nonself symbol-hash)
     (count countof-symbol)]
    
    [flonum
     (space space-data)
-    (vspace vspace_data)
     (size size-flonum)
     (mark)
     (copy-flonum flonum-data)
@@ -372,19 +358,12 @@
              space-pure-typed-object]
             [else
              space-impure-record])]))
-      (vspace (cond
-                [(is_rtd rtd vfi) vspace_rtd]
-                [(== (record-type-mpm rtd) (FIX 0)) vspace_pure_typed]
-                [else vspace_impure_record]))
-      (vfasl-check-parent-rtd rtd)
       (define len : uptr (UNFIX (record-type-size rtd)))
       (size (size_record_inst len))
       (mark counting-root)
       (trace-record rtd len)
-      (vfasl-set-base-rtd)
-      (pad (when (or-vfasl
-                  (\|\| (== p_spc space-pure) (\|\| (== p_spc space-impure)
-                                               (and-counts (== p_spc space-count-impure)))))
+      (pad (when (\|\| (== p_spc space-pure) (\|\| (== p_spc space-impure)
+                                              (and-counts (== p_spc space-count-impure))))
              (let* ([ua_size : uptr (unaligned_size_record_inst len)])
                (when (!= p_sz ua_size)
                  (set! (* (cast ptr* (TO_VOIDP (+ (cast uptr (UNTYPE _copy_ type_typed_object)) ua_size))))
@@ -404,7 +383,6 @@
           (cond
            [_backreferences?_ space-impure-typed-object]
            [else space-impure])]))
-      (vspace vspace_impure)
       (define len : uptr (Svector_length _))
       (size (size_vector len))
       (mark)
@@ -421,7 +399,6 @@
        (cond
         [_backreferences?_ space-impure-typed-object]
         [else space-impure]))
-      (vspace vspace_impure)
       (define len : uptr (Sstencil_vector_length _))
       (size (size_stencil_vector len))
       (mark within-segment) ; see assertion
@@ -434,7 +411,6 @@
 
      [string
       (space space-data)
-      (vspace vspace_data)
       (define sz : uptr (size_string (Sstring_length _)))
       (size (just sz))
       (mark)
@@ -443,7 +419,6 @@
 
      [fxvector
       (space space-data)
-      (vspace vspace_data)
       (define sz : uptr (size_fxvector (Sfxvector_length _)))
       (size (just sz))
       (mark)
@@ -452,7 +427,6 @@
 
      [flvector
       (space space-data)
-      (vspace vspace_data)
       (define sz : uptr (size_flvector (Sflvector_length _)))
       (size (just sz))
       (mark)
@@ -461,7 +435,6 @@
 
      [bytevector
       (space space-data)
-      (vspace vspace_data)
       (define sz : uptr (size_bytevector (Sbytevector_length _)))
       (size (just sz))
       (mark)
@@ -473,7 +446,6 @@
        (cond
         [_backreferences?_ space-impure-typed-object]
         [else space-impure]))
-      (vfasl-fail "tlc")
       (size size-tlc)
       (mark)
       (copy-type tlc-type)
@@ -493,7 +465,6 @@
           (cond
             [_backreferences?_ space-impure-typed-object]
             [else space-impure])]))
-      (vspace vspace_impure)
       (size size-box)
       (mark)
       (copy-type box-type)
@@ -504,7 +475,6 @@
       (space (case-flag parallel?
                [on space-pure]
                [off space-data]))
-      (vspace vspace_impure) ; would be better if we had pure, but these are rare
       (size size-ratnum)
       (copy-type ratnum-type)
       (trace-nonparallel-now ratnum-numerator)
@@ -513,14 +483,12 @@
         [on (pad (set! (ratnum-pad _copy_) 0))]
         [off])
       (mark)
-      (vfasl-pad-word)
       (count countof-ratnum)]
 
      [exactnum
       (space (case-flag parallel?
                [on space-pure]
                [off space-data]))
-      (vspace vspace_impure) ; same rationale as ratnum
       (size size-exactnum)
       (copy-type exactnum-type)
       (trace-nonparallel-now exactnum-real)
@@ -529,12 +497,10 @@
         [on (pad (set! (exactnum-pad _copy_) 0))]
         [off])
       (mark)
-      (vfasl-pad-word)
       (count countof-exactnum)]
 
      [inexactnum
       (space space-data)
-      (vspace vspace_data)
       (size size-inexactnum)
       (mark)
       (copy-type inexactnum-type)
@@ -544,7 +510,6 @@
 
      [bignum
       (space space-data)
-      (vspace vspace_data)
       (define sz : uptr (size_bignum (BIGLEN _)))
       (size (just sz))
       (mark)
@@ -553,7 +518,6 @@
 
      [port
       (space space-port)
-      (vfasl-fail "port")
       (size size-port)
       (mark one-bit)
       (copy-type port-type)
@@ -568,7 +532,6 @@
 
      [code
       (space space-code)
-      (vspace vspace_code)
       (define len : uptr (code-length _)) ; in bytes
       (size (size_code len))
       (mark one-bit)
@@ -588,7 +551,6 @@
       (space (cond
                [(and-counts (is_counting_root si _)) space-count-pure]
                [else space-pure-typed-object]))
-      (vfasl-fail "thread")
       (size size-thread)
       (mark one-bit)
       (case-mode
@@ -601,7 +563,6 @@
 
      [rtd-counts
       (space space-data)
-      (vfasl-as-false "rtd-counts") ; prune counts, since GC will recreate as needed
       (size size-rtd-counts)
       (mark)
       (copy-bytes rtd-counts-type size_rtd_counts)
@@ -609,7 +570,6 @@
 
      [phantom
       (space space-data)
-      (vfasl-fail "phantom")
       (size size-phantom)
       (mark)
       (copy-type phantom-type)
@@ -640,13 +600,6 @@
    [else
     (trace-pure field)]))
 
-(define-trace-macro (trace-nonself/vfasl-as-nil field)
-  (case-mode
-   [vfasl-copy
-    (set! (field _copy_) Snil)]
-   [else
-    (trace-nonself field)]))
-
 (define-trace-macro (trace-nonparallel-now field)
   (case-flag parallel?
     [on (trace-pure field)]
@@ -714,34 +667,24 @@
 
 (define-trace-macro (trace-code-early code)
   (unless-code-relocated
-   (case-mode
-    [(vfasl-sweep)
-     ;; Special relocation handling for code in a closure:
-     (set! code (vfasl_relocate_code vfi code))]
-    [else
-     ;; In parallel mode, the `code` pointer may or may not have been
-     ;; forwarded. In that case, we may misinterpret the forward mmarker
-     ;; as a code type with flags, but it's ok, because the flags will
-     ;; only be set for static-generation objects
-     (case-flag parallel?
-       [on (case-mode
-            [(sweep sweep-in-old)
-             (trace-pure-code (just code))]
-            [else])]
-       [off (trace-early (just code))])])))
+   ;; In parallel mode, the `code` pointer may or may not have been
+   ;; forwarded. In that case, we may misinterpret the forward mmarker
+   ;; as a code type with flags, but it's ok, because the flags will
+   ;; only be set for static-generation objects
+   (case-flag parallel?
+     [on (case-mode
+          [(sweep sweep-in-old)
+           (trace-pure-code (just code))]
+          [else])]
+     [off (trace-early (just code))])))
 
 (define-trace-macro (copy-clos-code code)
   (case-mode
-   [(copy vfasl-copy)
+   [(copy)
     (SETCLOSCODE _copy_ code)]
    [(sweep sweep-in-old)
     (unless-code-relocated
      (SETCLOSCODE _copy_ code))]
-   [(vfasl-sweep)
-    ;; Make the code pointer relative to the base address.
-    ;; It's turned back absolute when loading from vfasl
-    (define rel_code : ptr (cast ptr (ptr_diff code (-> vfi base_addr))))
-    (SETCLOSCODE p rel_code)]
    [else]))
 
 (define-trace-macro (copy-stack-length continuation-stack-length continuation-stack-clength)
@@ -760,15 +703,13 @@
    [else
     (copy continuation-stack-length)]))
 
-(define-trace-macro (trace/define ref val :vfasl-as vfasl-val)
+(define-trace-macro (trace/define ref val)
   (case-mode
    [(copy measure)
     (trace ref)]
    [(sweep sweep-in-old)
     (trace ref) ; can't trace `val` directly, because we need an impure relocate
     (define val : ptr (ref _))]
-   [vfasl-copy
-    (set! (ref _copy_) vfasl-val)]
    [else]))
 
 (define-trace-macro (trace-symcode symbol-pvalue val)
@@ -782,8 +723,6 @@
        [off (trace-pure (just code))])
     (INITSYMCODE _ code)]
    [measure]
-   [vfasl-copy
-    (set! (symbol-pvalue _copy_) Snil)]
    [else
     (copy symbol-pvalue)]))
 
@@ -833,7 +772,7 @@
 
 (define-trace-macro (trace-record trd len)
   (case-mode
-   [(copy vfasl-copy)
+   [(copy)
     (copy-bytes record-data (- len ptr_bytes))]
    [else
     ;; record-type descriptor was forwarded already
@@ -910,37 +849,6 @@
   (trace-pure (record-type-pm rtd))
   (set! num (record-type-pm rtd)))
 
-(define-trace-macro (vfasl-check-parent-rtd rtd)
-  (case-mode
-   [(vfasl-copy)
-    (when (is_rtd rtd vfi)
-      (when (!= _ S_G.base_rtd)
-        ;; Make sure rtd's type is registered firs, but
-        ;; discard the relocated pointer (leaving to sweep)
-        (cast void (vfasl_relocate_help vfi rtd)))
-      ;; Need parent before child
-      (vfasl_relocate_parents vfi (record-type-parent _)))]
-   [(vfasl-sweep)
-    ;; Don't need to save fields of base-rtd
-    (when (== _ (-> vfi base_rtd))
-      (let* ([pp : ptr* (& (record-data _ 0))]
-             [ppend : ptr* (- (cast ptr* (TO_VOIDP (+ (cast uptr (TO_PTR pp)) (UNFIX (record-type-size rtd))))) 1)])
-        (while
-         :? (< pp ppend)
-         (set! (* pp) Snil)
-         (set! pp += 1))
-        (return (size_record_inst (UNFIX (record-type-size rtd))))))
-    ;; Relocation of rtd fields was deferred
-    (vfasl_relocate vfi (& (record-type _)))]
-   [else]))
-
-(define-trace-macro (vfasl-set-base-rtd)
-  (case-mode
-   [(vfasl-copy)
-    (when (== _ S_G.base_rtd)
-      (set! (-> vfi base_rtd) _copy_))]
-   [else]))
-
 (define-trace-macro (count-record rtd)
   (case-mode
    [(copy mark)
@@ -1157,7 +1065,7 @@
 
 (define-trace-macro (trace-code len)
   (case-mode
-   [(copy vfasl-copy)
+   [(copy)
     (copy-bytes code-data len)]
    [else
     (define t : ptr (code-reloc _))
@@ -1167,13 +1075,6 @@
     (define oldco : ptr (cond
                           [t (reloc-table-code t)]
                           [else 0]))
-    (case-mode
-     [vfasl-sweep
-      (let* ([r_sz : uptr (size_reloc_table m)]
-             [new_t : ptr (vfasl_find_room vfi vspace_reloc typemod r_sz)])
-        (memcpy_aligned (TO_VOIDP new_t) (TO_VOIDP t) r_sz)
-        (set! t new_t))]
-     [else])
     (define a : iptr 0)
     (define n : iptr 0)
     (while
@@ -1193,16 +1094,10 @@
           (set! code_off (RELOC_CODE_OFFSET entry))])
        (set! a (+ a code_off))
        (let* ([obj : ptr (S_get_code_obj (RELOC_TYPE entry) oldco a item_off)])
-         (case-mode
-          [vfasl-sweep
-           (set! obj (vfasl_encode_relocation vfi obj))]
-          [else
-           (trace-pure (just obj))])
+         (trace-pure (just obj))
          (case-mode
           [sweep
            (S_set_code_obj "gc" (RELOC_TYPE entry) _ a obj item_off)]
-          [vfasl-sweep
-           (S_set_code_obj "vfasl" (abs_reloc_variant (RELOC_TYPE entry)) _ a obj item_off)]
           [else]))))
 
     (case-mode
@@ -1233,10 +1128,6 @@
          (set! (reloc-table-code t) _)
          (set! (code-reloc _) t)])
       (S_record_code_mod (-> _tgc_ tc) (cast uptr (TO_PTR (& (code-data _ 0)))) (cast uptr (code-length _)))]
-     [vfasl-sweep
-      ;; no vfasl_register_pointer, since relink_code can handle it
-      (set! (reloc-table-code t) (cast ptr (ptr_diff _ (-> vfi base_addr))))
-      (set! (code-reloc _) (cast ptr (ptr_diff t (-> vfi base_addr))))]
      [else])]))
 
 (define-trace-macro (check-bignum var)
@@ -1271,21 +1162,11 @@
    [on e]
    [off 1]))
 
-(define-trace-macro (or-vfasl e)
-  (case-mode
-   [vfasl-copy 1]
-   [else e]))
-
 (define-trace-macro (and-purity-sensitive-mode e)
   (case-mode
    [(sweep sweep-in-old) e]
    [else 0]))
 
-(define-trace-macro (when-vfasl e)
-  (case-mode
-   [(vfasl-copy vfasl-sweep) e]
-   [else]))
-
 (define-trace-macro (when-mark e)
   (case-mode
    [(mark) e]
@@ -1293,34 +1174,7 @@
 
 (define-trace-macro (pad e)
   (case-mode
-   [(copy vfasl-copy) e]
-   [else]))
-
-(define-trace-macro (vfasl-pad-word)
-  (case-mode
-   [(vfasl-copy)
-    (set! (array-ref (cast ptr* (TO_VOIDP (UNTYPE _copy_ type_typed_object))) 3)
-          0)]
-   [else]))
-
-(define-trace-macro (vfasl-fail what)
-  (case-mode
-   [(vfasl-copy vfasl-sweep)
-    (vfasl_fail vfi what)
-    (case-mode
-     [vfasl-copy (return (cast ptr 0))]
-     [vfasl-sweep (return 0)])
-    (vspace #f)]
-   [else]))
-
-(define-trace-macro (vfasl-as-false what)
-  (case-mode
-   [(vfasl-copy)
-    (return Sfalse)
-    (vspace #f)]
-   [(vfasl-sweep)
-    (vfasl-fail what)
-    (vspace #f)]
+   [(copy) e]
    [else]))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1460,8 +1314,7 @@
      (format "static ~a ~a(~aptr p~a)"
              (case (lookup 'mode config)
                [(copy mark) "IGEN"]
-               [(vfasl-copy) "ptr"]
-               [(size vfasl-sweep) "uptr"]
+               [(size) "uptr"]
                [(self-test) "IBOOL"]
                [(sweep) (if (lookup 'as-dirty? config #f)
                             "IGEN"
@@ -1471,12 +1324,10 @@
              name
              (case (lookup 'mode config)
                [(copy mark sweep sweep-in-old measure) "thread_gc *tgc, "]
-               [(vfasl-copy vfasl-sweep)
-                "vfasl_info *vfi, "]
                [else ""])
              (case (lookup 'mode config)
                [(copy) ", seginfo *si, ptr *dest"]
-               [(mark vfasl-copy) ", seginfo *si"]
+               [(mark) ", seginfo *si"]
                [(sweep)
                 (cond
                   [(lookup 'as-dirty? config #f) ", IGEN youngest"]
@@ -1553,17 +1404,6 @@
           (code-block
            (body)
            "return 0;")]
-         [(vfasl-copy)
-          (code-block
-           "ptr new_p;"
-           (body)
-           "vfasl_register_forward(vfi, p, new_p);"
-           "return new_p;")]
-         [(vfasl-sweep)
-          (code-block
-           "uptr result_sz;"
-           (body)
-           "return result_sz;")]
          [else
           (body)]))))
 
@@ -1629,7 +1469,7 @@
              (code-block
               (format "ISPC p_at_spc = ~a;"
                       (case (lookup 'mode config)
-                        [(copy mark vfasl-copy) "si->space"]
+                        [(copy mark) "si->space"]
                         [else "SPACE(p)"]))
               (let loop ([all-clauses all-clauses] [else? #f])
                 (match all-clauses
@@ -1699,7 +1539,7 @@
                  (relocate-statement 'pure "tmp_p" config)
                  (format "~a = tmp_p;" (field-expression field config "new_p" #f)))]
                [(self-test) #f]
-               [(measure vfasl-copy vfasl-sweep)
+               [(measure)
                 (statements (list `(trace ,field)) config)]
                [(mark)
                 (relocate-statement 'pure (field-expression field config "p" #t) config)]
@@ -1735,14 +1575,12 @@
                                  (field-expression field config "new_p" #f)
                                  (field-expression field config "p" #f)))
                         (statements (cdr l) config))]
-                 [(vfasl-copy)
-                  (statements (cons `(copy ,field) (cdr l)) config)]
                  [else (statements (cdr l) config)])]
               [else
                (statements (cons `(copy ,field) (cdr l)) config)])]
            [`(copy-bytes ,offset ,len)
             (code (case (lookup 'mode config)
-                    [(copy vfasl-copy)
+                    [(copy)
                      (format "memcpy_aligned(&~a, &~a, ~a);"
                              (field-expression offset config "new_p" #t)
                              (field-expression offset config "p" #t)
@@ -1751,7 +1589,7 @@
                   (statements (cdr l) config))]
            [`(copy-type ,field)
             (case (lookup 'mode config)
-              [(copy vfasl-copy)
+              [(copy)
                (code
                 (format "~a = ~a;"
                         (field-expression field config "new_p" #f)
@@ -1770,11 +1608,11 @@
                         config)]
            [`(trace-ptrs ,offset ,len ,purity)
             (case (lookup 'mode config)
-              [(copy vfasl-copy)
+              [(copy)
                (statements (cons `(copy-bytes ,offset (* ptr_bytes ,len))
                                  (cdr l))
                            config)]
-              [(sweep measure sweep-in-old vfasl-sweep check)
+              [(sweep measure sweep-in-old check)
                (code
                 (loop-over-pointers
                  (field-expression offset config "p" #t)
@@ -1817,21 +1655,6 @@
                                        (cons `(known-space ,s) config)
                                        config))]
               [else (statements (cdr l) config)])]
-           [`(vspace ,s)
-            (case (lookup 'mode config)
-              [(vfasl-copy)
-               (cond
-                 [(not s) (code)]
-                 [else
-                  (code (code-indent "int p_vspc = "
-                                     (expression s config #f #t)
-                                     ";")
-                        (statements (cdr l) (cons '(vspace-ready? #t) config)))])]
-              [(vfasl-sweep)
-               (cond
-                 [(not s) (code)]
-                 [else (statements (cdr l) config)])]
-              [else (statements (cdr l) config)])]
            [`(size ,sz)
             (statements (cons `(size ,sz ,1) (cdr l)) config)]
            [`(size ,sz ,scale)
@@ -1854,25 +1677,18 @@
                                config)]
                    [rest
                     (case mode
-                      [(copy vfasl-copy)
-                       (case mode
-                         [(copy) (unless (lookup 'space-ready? config #f)
-                                   (error 'generate "size before space"))]
-                         [(vfasl-copy) (unless (lookup 'vspace-ready? config #f)
-                                         (error 'generate "size before vspace for ~a/~a"
-                                                (lookup 'basetype config)
-                                                (lookup 'type config #f)))])
+                      [(copy)
+                       (unless (lookup 'space-ready? config #f)
+                         (error 'generate "size before space"))
                        (hashtable-set! (lookup 'used config) 'p_sz #t)
                        (code (format "~a, ~a, p_sz, new_p);"
-                                     (case mode
-                                       [(copy) "find_gc_room(tgc, p_spc, tg"]
-                                       [(vfasl-copy) "FIND_ROOM(vfi, p_vspc"])
+                                     "find_gc_room(tgc, p_spc, tg"
                                      (as-c 'type (lookup 'basetype config)))
                              (statements (let ([extra (lookup 'copy-extra config #f)])
                                            (if extra
                                                (cons `(copy ,extra) (cdr l))
                                                (let* ([mode (lookup 'mode config)]
-                                                      [extra (and (memq mode '(copy vfasl-copy))
+                                                      [extra (and (memq mode '(copy))
                                                                   (lookup 'copy-extra-rtd config #f))])
                                                  (if extra
                                                      (cons `(set! (,extra _copy_)
@@ -1890,10 +1706,6 @@
                       [(size)
                        (hashtable-set! (lookup 'used config) 'p_sz #t)
                        (code "return p_sz;")]
-                      [(vfasl-sweep)
-                       (hashtable-set! (lookup 'used config) 'p_sz #t)
-                       (code "result_sz = p_sz;"
-                             (statements (cdr l) config))]
                       [(measure)
                        (hashtable-set! (lookup 'used config) 'p_sz #t)
                        (code "measure_total += p_sz;"
@@ -2069,7 +1881,7 @@
       (match a
         [`_ "p"]
         [`_copy_ (case (lookup 'mode config)
-                   [(copy vfasl-copy) "new_p"]
+                   [(copy) "new_p"]
                    [else "p"])]
         [`_size_
          (cond
@@ -2205,12 +2017,10 @@
     (cond
       [(or (eq? mode 'sweep)
            (eq? mode 'sweep-in-old)
-           (eq? mode 'vfasl-sweep)
            (and early? (or (eq? mode 'copy)
                            (eq? mode 'mark))))
        (relocate-statement purity (field-expression field config "p" #t) config)]
-      [(or (eq? mode 'copy)
-           (eq? mode 'vfasl-copy))
+      [(eq? mode 'copy)
        (copy-statement field config)]
       [(eq? mode 'measure)
        (measure-statement (field-expression field config "p" #f))]
@@ -2228,8 +2038,6 @@
   (define (relocate-statement purity e config)
     (define mode (lookup 'mode config))
     (case mode
-      [(vfasl-sweep)
-       (format "vfasl_relocate(vfi, &~a);" e)]
       [(sweep-in-old)
        (if (eq? purity 'pure)
            (format "relocate_pure(&~a);" e)
@@ -2257,7 +2065,7 @@
   (define (copy-statement field config)
     (define mode (lookup 'mode config))
     (case mode
-      [(copy vfasl-copy)
+      [(copy)
        (cond
          [(symbol? field)
           (unless (lookup 'copy-ready? config #f)
@@ -2686,16 +2494,6 @@
        (when measure?
          (print-code (generate "measure" `((mode measure))))))))
 
-  (define (gen-vfasl ofn)
-    (guard
-     (x [#t (raise x)])
-     (parameterize ([current-output-port (open-output-file ofn 'replace)])
-       (print-code (generate "copy"
-                             `((mode vfasl-copy))))
-       (print-code (generate "sweep"
-                             `((mode vfasl-sweep)
-                               (return-size? #t)))))))
-
   (define (gen-heapcheck ofn)
     (guard
      (x [#t (raise x)])
@@ -2713,5 +2511,4 @@
   (set! mkgc-ocd.inc (lambda (ofn) (gen-gc ofn #f #f #f)))
   (set! mkgc-oce.inc (lambda (ofn) (gen-gc ofn #t #t #f))) ; not currently parallel (but could be "parallel" for ownership preservation)
   (set! mkgc-par.inc (lambda (ofn) (gen-gc ofn #f #f #t)))
-  (set! mkvfasl.inc (lambda (ofn) (gen-vfasl ofn)))
   (set! mkheapcheck.inc (lambda (ofn) (gen-heapcheck ofn))))
diff --git a/racket/src/ChezScheme/s/mkheader.ss b/racket/src/ChezScheme/s/mkheader.ss
index 8f78513d224..8563bbf061d 100644
--- a/racket/src/ChezScheme/s/mkheader.ss
+++ b/racket/src/ChezScheme/s/mkheader.ss
@@ -45,6 +45,8 @@
                         [(#\?) (cons #\p rest)]
                         [(#\>) rest]
                         [(#\*) (cons #\s rest)]
+                        [(#\=) (cons* #\e #\q #\l rest)]
+                        [(#\?) (cons #\p rest)]
                         [else (cons x rest)]))
           '()
           (string->list (symbol->string x))))))
@@ -1153,6 +1155,14 @@
         (defref RPCOMPACTHEADERMASKANDSIZE rp-compact-header mask+size+mode)
         (defref RPCOMPACTHEADERTOPLINK rp-compact-header toplink)
 
+        (defref VFASLHEADER_DATA_SIZE vfasl-header data-size)
+        (defref VFASLHEADER_TABLE_SIZE vfasl-header table-size)
+        (defref VFASLHEADER_RESULT_OFFSET vfasl-header result-offset)
+        (defref VFASLHEADER_VSPACE_REL_OFFSETS vfasl-header vspace-rel-offsets)
+        (defref VFASLHEADER_SYMREF_COUNT vfasl-header symref-count)
+        (defref VFASLHEADER_RTDREF_COUNT vfasl-header rtdref-count)
+        (defref VFASLHEADER_SINGLETONREF_COUNT vfasl-header singletonref-count)
+
         (nl)
         (comment "machine types")
         (pr "#define machine_type_names ")
diff --git a/racket/src/ChezScheme/s/primdata.ss b/racket/src/ChezScheme/s/primdata.ss
index 99e48523aa4..11e299c02bb 100644
--- a/racket/src/ChezScheme/s/primdata.ss
+++ b/racket/src/ChezScheme/s/primdata.ss
@@ -1926,6 +1926,7 @@
   ($dofmt [flags single-valued])
   ($do-wind [flags single-valued])
   ($dynamic-closure-counts [flags single-valued alloc])  ; added for closure instrumentation
+  ($emit-boot-header [flags single-valued])
   ($enum-set-members [flags single-valued])
   ($eol-style? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable])
   ($eq-hashtable-cells [flags single-valued discard])
@@ -1949,11 +1950,13 @@
   ($expeditor [feature expeditor] [flags])
   ($fasl-base-rtd [flags single-valued])
   ($fasl-bld-graph [flags single-valued])
+  ($fasl-can-combine? [flags single-valued])
   ($fasl-enter [flags single-valued])
   ($fasl-file-equal? [sig [(pathname pathname) (pathname pathname ptr) -> (boolean)]] [flags discard])
   ($fasl-out [flags single-valued])
   ($fasl-start [flags single-valued])
   ($fasl-table [flags single-valued])
+  ($fasl-to-vfasl [flags single-valued])
   ($fasl-wrf-graph [flags single-valued])
   ($filter-conv [flags single-valued])
   ($filter-foreign-type [flags single-valued])
diff --git a/racket/src/ChezScheme/s/prims.ss b/racket/src/ChezScheme/s/prims.ss
index bd4105620d4..bfde6f4ed77 100644
--- a/racket/src/ChezScheme/s/prims.ss
+++ b/racket/src/ChezScheme/s/prims.ss
@@ -1805,6 +1805,8 @@
       ($oops '$thread-tc "~s is not a thread" thread))
     ($thread-tc thread)))
 
+)
+
 (when-feature pthreads
 
 (define $raw-collect-cond (lambda () ($raw-collect-cond)))
@@ -2036,7 +2038,7 @@
   (let ([thread (car (ts))])
     (lambda () thread)))
 ))
-
+(begin
 (let ()
   (define-syntax define-tc-parameter
     (lambda (x)
diff --git a/racket/src/ChezScheme/s/strip-types.ss b/racket/src/ChezScheme/s/strip-types.ss
new file mode 100644
index 00000000000..094a70d79af
--- /dev/null
+++ b/racket/src/ChezScheme/s/strip-types.ss
@@ -0,0 +1,30 @@
+(define-datatype #{fasl striprur0zx3-fasl}
+  (#{entry striprur0zx3-0} situation fasl)
+  (#{header striprur0zx3-1} version machine dependencies)
+  (#{pair striprur0zx3-2} vfasl)
+  (#{tuple striprur0zx3-3} ty vfasl)
+  (#{string striprur0zx3-4} ty string)
+  (#{gensym striprur0zx30-5} pname uname)
+  (#{vector striprur0zx3-6} ty vfasl)
+  (#{fxvector striprur0zx3-7} viptr)
+  (#{bytevector striprur0zx3-9} ty bv)
+  (#{stencil-vector striprur0zx3-sv} mask vfasl)
+  (#{record  striprur0zx3-10} maybe-uid size nflds rtd pad-ty* fld*) ; maybe-uid => rtd
+  (#{rtd-ref striprur0zx3-11} uid) ; field info not recorded
+  (#{closure striprur0zx3-12} offset c)
+  (#{flonum striprur0zx3-13} high low)
+  (#{small-integer striprur0zx3-14} iptr)
+  (#{large-integer striprur0zx3-15} sign vuptr)
+  (#{eq-hashtable striprur0zx3-16} mutable? subtype minlen veclen vpfasl)
+  (#{symbol-hashtable striprur0zx3-17} mutable? minlen equiv veclen vpfasl)
+  (#{code striprur0zx3-18} flags free name arity-mask info pinfo* bytes m vreloc)
+  (#{atom striprur0zx3-19} ty uptr)
+  (#{reloc striprur0zx3-20} type-etc code-offset item-offset fasl)
+  (#{indirect striprur0zx3-21} g i))
+
+(define-datatype #{field stripfur0zx3-field}
+  (#{ptr stripfur0zx3-0} fasl)
+  (#{byte stripfur0zx3-1} n)
+  (#{iptr stripfur0zx3-2} n)
+  (#{single stripfur0zx3-3} n)
+  (#{double stripfur0zx3-4} high low))
diff --git a/racket/src/ChezScheme/s/strip.ss b/racket/src/ChezScheme/s/strip.ss
index 2d5c392601a..cb4ceb48ba9 100644
--- a/racket/src/ChezScheme/s/strip.ss
+++ b/racket/src/ChezScheme/s/strip.ss
@@ -13,41 +13,17 @@
 ;;; See the License for the specific language governing permissions and
 ;;; limitations under the License.
 
+;; The `strip-fasl-file` and related functions use a fasl reader and
+;; writer that are completely separate from the ones in "fasl.ss" and
+;; "fasl.c", so changes made in those places must be duplicated here.
+;; The vfasl writer uses this fasl reader.
+
 (let ()
   ; per file
   (define-threaded fasl-who)
   (define-threaded fasl-count)
 
-  (define-datatype fasl
-    (entry situation fasl)
-    (header version machine dependencies)
-    (pair vfasl)
-    (tuple ty vfasl)
-    (string ty string)
-    (gensym pname uname)
-    (vector ty vfasl)
-    (fxvector viptr)
-    (flvector vfl)
-    (bytevector ty bv)
-    (record maybe-uid size nflds rtd pad-ty* fld*) ; maybe-uid => rtd
-    (rtd-ref uid) ; field info not recorded
-    (closure offset c)
-    (flonum high low)
-    (small-integer iptr)
-    (large-integer sign vuptr)
-    (eq-hashtable mutable? subtype minlen veclen vpfasl)
-    (symbol-hashtable mutable? minlen equiv veclen vpfasl)
-    (code flags free name arity-mask info pinfo* bytes m vreloc)
-    (atom ty uptr)
-    (reloc type-etc code-offset item-offset fasl)
-    (indirect g i))
-
-  (define-datatype field
-    (ptr fasl)
-    (byte n)
-    (iptr n)
-    (single n)
-    (double high low))
+  (include "strip-types.ss")
 
   (define follow-indirect
     (lambda (x)
@@ -217,10 +193,12 @@
           [(fasl-type-gensym)
            (let* ([pname (read-string p)] [uname (read-string p)])
              (fasl-gensym pname uname))]
-          [(fasl-type-ratnum fasl-type-exactnum fasl-type-inexactnum fasl-type-weak-pair)
+          [(fasl-type-ratnum fasl-type-exactnum fasl-type-inexactnum
+                             fasl-type-weak-pair fasl-type-ephemeron)
            (let ([first (read-fasl p g)])
              (fasl-tuple ty (vector first (read-fasl p g))))]
-          [(fasl-type-vector fasl-type-immutable-vector) (fasl-vector ty (read-vfasl p g (read-uptr p)))]
+          [(fasl-type-vector fasl-type-immutable-vector fasl-type-flvector)
+           (fasl-vector ty (read-vfasl p g (read-uptr p)))]
           [(fasl-type-fxvector)
            (fasl-fxvector
              (let ([n (read-uptr p)])
@@ -228,14 +206,11 @@
                  (do ([i 0 (fx+ i 1)])
                      ((fx= i n) v)
                    (vector-set! v i (read-iptr p))))))]
-          [(fasl-type-flvector)
-           (let ([n (read-uptr p)])
-             (let ([vfl (make-vector n)])
-               (do ([i 0 (fx+ i 1)])
-                   ((fx= i n) vfl)
-                 (vector-set! vfl i (read-fasl p g)))))]
           [(fasl-type-bytevector fasl-type-immutable-bytevector)
            (fasl-bytevector ty (read-bytevector p (read-uptr p)))]
+          [(fasl-type-stencil-vector)
+           (let ([mask (read-uptr p)])
+             (fasl-stencil-vector mask (read-vfasl p g (bitwise-bit-count mask))))]
           [(fasl-type-base-rtd) (fasl-tuple ty '#())]
           [(fasl-type-rtd) (let* ([uid (read-fasl p g)]
                                   [size (read-uptr p)])
@@ -319,6 +294,14 @@
            (let ([n (read-uptr p)])
              (or (vector-ref g n)
                  (fasl-indirect g n)))]
+          [(fasl-type-begin)
+           (let loop ([n (read-uptr p)])
+             (if (fx= n 1)
+                 (read-fasl p g)
+                 (begin
+                   ;; will set graph definitions:
+                   (read-fasl p g)
+                   (loop (fx- n 1)))))]
           [else (bogus "unexpected fasl code ~s in ~a" ty (port-name p))]))))
 
   (define read-script-header
@@ -439,8 +422,8 @@
           [gensym (pname uname) (build-graph! x t void)]
           [vector (ty vfasl) (build-graph! x t (build-vfasl! vfasl))]
           [fxvector (viptr) (build-graph! x t void)]
-          [flvector (vfl) (build-graph! x t void)]
           [bytevector (ty viptr) (build-graph! x t void)]
+          [stencil-vector (mask vfasl) (build-graph! x t (build-vfasl! vfasl))]
           [record (maybe-uid size nflds rtd pad-ty* fld*)
            (if (and strip-source-annotations? (fasl-annotation? x))
                (build! (fasl-annotation-stripped x) t)
@@ -488,24 +471,35 @@
 
     (include "fasl-helpers.ss")
 
-    (define write-entry
-      (lambda (p x)
+    (define handle-entry
+      (lambda (x header-k entry-k)
         (fasl-case x
           [header (version machine dependencies)
-           (emit-header p version machine dependencies)]
+           (header-k (lambda (p) (emit-header p version machine dependencies)))]
           [entry (situation fasl)
-           (let ([t (make-table)])
-             (build! fasl t)
-             (let-values ([(bv* size)
-                           (let-values ([(p extractor) ($open-bytevector-list-output-port)])
-                             (let ([n (table-count t)])
-                               (unless (fx= n 0)
-                                 (put-u8 p (constant fasl-type-graph))
-                                 (put-uptr p n)))
-                             (write-fasl p t fasl)
-                             (extractor))])
-               ($write-fasl-bytevectors p bv* size situation (constant fasl-type-fasl))))]
-          [else (sorry! "unrecognized top-level fasl-record-type ~s" x)])))
+           (entry-k situation fasl)]
+          [else
+           (sorry! "unrecognized top-level fasl-record-type ~s" x)])))
+
+    (define (write-one-entry p situation fasl)
+      (let ([t (make-table)])
+        (build! fasl t)
+        (let-values ([(bv* size)
+                      (let-values ([(p extractor) ($open-bytevector-list-output-port)])
+                        (let ([n (table-count t)])
+                          (unless (fx= n 0)
+                            (put-u8 p (constant fasl-type-graph))
+                            (put-uptr p n)))
+                        (write-fasl p t fasl)
+                        (extractor))])
+          ($write-fasl-bytevectors p bv* size situation (constant fasl-type-fasl)))))
+
+    (define write-entry
+      (lambda (p x)
+        (handle-entry
+         x
+         (lambda (write-k) (write-k p))
+         (lambda (situation fasl) (write-one-entry p situation fasl)))))
 
     (define write-graph
       (lambda (p t x th)
@@ -560,18 +554,18 @@
                (put-u8 p (constant fasl-type-fxvector))
                (put-uptr p (vector-length viptr))
                (vector-for-each (lambda (iptr) (put-iptr p iptr)) viptr)))]
-          [flvector (vfl)
-           (write-graph p t x
-             (lambda ()
-               (put-u8 p (constant fasl-type-flvector))
-               (put-uptr p (vector-length vfl))
-               (vector-for-each (lambda (x) (write-fasl p t x)) vfl)))]
           [bytevector (ty bv)
            (write-graph p t x
              (lambda ()
                (put-u8 p ty)
                (put-uptr p (bytevector-length bv))
                (put-bytevector p bv)))]
+          [stencil-vector (mask vfasl)
+           (write-graph p t x
+             (lambda ()
+               (put-u8 p (constant fasl-type-stencil-vector))
+               (put-uptr p mask)
+               (vector-for-each (lambda (fasl) (write-fasl p t fasl)) vfasl)))]
           [record (maybe-uid size nflds rtd pad-ty* fld*)
            (if (and strip-source-annotations? (fasl-annotation? x))
                (write-fasl p t (fasl-annotation-stripped x))
@@ -771,6 +765,9 @@
                  [(fasl-type-weak-pair)
                   (weak-cons (describe (vector-ref vfasl 0))
                              (describe (vector-ref vfasl 1)))]
+                 [(fasl-type-ephemeron)
+                  (ephemeron-cons (describe (vector-ref vfasl 0))
+                                  (describe (vector-ref vfasl 1)))]
                  [(fasl-type-base-rtd)
                   #!base-rtd]
                  [else
@@ -782,8 +779,8 @@
               [gensym (pname uname) (gensym pname uname)]
               [vector (ty vfasl) (vector-map describe vfasl)]
               [fxvector (viptr) viptr]
-              [flvector (vfl) vfl]
               [bytevector (ty bv) bv]
+              [stencil-vector (ty vfasl) (vector-map describe vfasl)]
               [record (maybe-uid size nflds rtd pad-ty* fld*)
                (vector 'RECORD
                        (and maybe-uid (describe maybe-uid))
@@ -885,6 +882,25 @@
           (let ([ip ($open-file-input-port fasl-who ifn)])
             (on-reset (close-port ip)
                       (read-and-strip-from-port ip ifn #f)))))
+      (define convert-fasl-file
+        (lambda (who ifn ofn options write)
+          (unless (string? ifn) ($oops who "~s is not a string" ifn))
+          (unless (string? ofn) ($oops who "~s is not a string" ofn))
+          (unless (and (enum-set? options) (enum-set-subset? options $fasl-strip-options))
+            ($oops who "~s is not a fasl-strip-options object" options))
+          (fluid-let ([strip-inspector-information? (enum-set-subset? (fasl-strip-options inspector-source) options)]
+                      [strip-profile-information? (enum-set-subset? (fasl-strip-options profile-source) options)]
+                      [strip-source-annotations? (enum-set-subset? (fasl-strip-options source-annotations) options)]
+                      [strip-compile-time-information? (enum-set-subset? (fasl-strip-options compile-time-information) options)]
+                      [fasl-who who]
+                      [fasl-count 0])
+            (let-values ([(script-header mode entry*) (read-and-strip-file ifn)])
+              (let ([op ($open-file-output-port who ofn (file-options replace))])
+                (on-reset (delete-file ofn #f)
+                  (on-reset (close-port op)
+                    (write script-header mode entry* op)
+                    (close-port op)
+                    (unless-feature windows (when mode (chmod ofn mode))))))))))
       (set-who! $describe-fasl-from-port
         (rec $describe-fasl-from-port
           (case-lambda
@@ -901,26 +917,60 @@
                 (list (and script-header (describe script-header))
                       (map describe entry*))))])))
       (set-who! strip-fasl-file
-        (rec strip-fasl-file
-          (lambda (ifn ofn options)
-            (unless (string? ifn) ($oops who "~s is not a string" ifn))
-            (unless (string? ofn) ($oops who "~s is not a string" ofn))
-            (unless (and (enum-set? options) (enum-set-subset? options $fasl-strip-options))
-              ($oops who "~s is not a fasl-strip-options object" options))
-            (fluid-let ([strip-inspector-information? (enum-set-subset? (fasl-strip-options inspector-source) options)]
-                        [strip-profile-information? (enum-set-subset? (fasl-strip-options profile-source) options)]
-                        [strip-source-annotations? (enum-set-subset? (fasl-strip-options source-annotations) options)]
-                        [strip-compile-time-information? (enum-set-subset? (fasl-strip-options compile-time-information) options)]
-                        [fasl-who who]
-                        [fasl-count 0])
-              (let-values ([(script-header mode entry*) (read-and-strip-file ifn)])
-                (let ([op ($open-file-output-port who ofn (file-options replace))])
-                  (on-reset (delete-file ofn #f)
-                    (on-reset (close-port op)
-                      (when script-header (put-bytevector op script-header))
-                      (for-each (lambda (entry) (write-entry op entry)) entry*)
-                      (close-port op)
-                      (unless-feature windows (when mode (chmod ofn mode)))))))))))))
+        (lambda (ifn ofn options)
+          (convert-fasl-file who ifn ofn options
+                             (lambda (script-header mode entry* op)
+                               (when script-header (put-bytevector op script-header))
+                               (for-each (lambda (entry) (write-entry op entry)) entry*)))))
+      (set-who! vfasl-convert-file
+        (lambda (ifn ofn bootfile*)
+          (convert-fasl-file who ifn ofn (fasl-strip-options)
+                             (lambda (script-header mode entry* op)
+                               (when bootfile*
+                                 ($emit-boot-header op (constant machine-type-name) bootfile*))
+                               (let* ([write-out
+                                       (lambda (x situation)
+                                         (let ([bv ($fasl-to-vfasl x)])
+                                           ($write-fasl-bytevectors op (list bv) (bytevector-length bv)
+                                                                    ;; see "promoting" below:
+                                                                    (constant fasl-type-visit-revisit)
+                                                                    (constant fasl-type-vfasl))))]
+                                      [write-out-accum (lambda (accum situation)
+                                                         (unless (null? accum)
+                                                           (if (null? (cdr accum))
+                                                               (write-out (car accum) situation)
+                                                               (write-out (fasl-vector (constant fasl-type-vector)
+                                                                                       (list->vector (reverse accum)))
+                                                                          situation))))])
+                                 (let loop ([ignore-header? #f] [accum '()] [accum-situation #f] [entry* entry*])
+                                   (cond
+                                     [(null? entry*)
+                                      (write-out-accum accum accum-situation)]
+                                     [else
+                                      (handle-entry
+                                       (car entry*)
+                                       (lambda (write-k)
+                                         (unless ignore-header?
+                                           (write-k op))
+                                         (loop #t accum accum-situation (cdr entry*)))
+                                       (lambda (situation x)
+                                         (cond
+                                           [(vector? x)
+                                            (loop #t
+                                                  (append (reverse (vector->list x)) accum)
+                                                  situation
+                                                  (cdr entry*))]
+                                           [(or (not ($fasl-can-combine? x))
+                                                ;; improve sharing by promiting everyting to visit-revisit,
+                                                ;; instead of comparing situations
+                                                #;
+                                                (and accum-situation
+                                                     (not (eqv? accum-situation situation))))
+                                            (write-out-accum accum accum-situation)
+                                            (write-out x situation)
+                                            (loop #t '() #f (cdr entry*))]
+                                           [else
+                                            (loop #t (cons x accum) situation (cdr entry*))])))])))))))))
 
   (let ()
     ; per file
@@ -995,8 +1045,8 @@
                                    (string=? x uname2))))]
                        [vector (ty vfasl) (and (eqv? ty1 ty2) (vandmap fasl=? vfasl1 vfasl2))]
                        [fxvector (viptr) (vandmap = viptr1 viptr2)]
-                       [flvector (vfl) (vandmap fasl=? vfl1 vfl2)]
                        [bytevector (ty bv) (and (eqv? ty1 ty2) (bytevector=? bv1 bv2))]
+                       [stencil-vector (mask vfasl) (and (eqv? mask1 mask2) (vandmap fasl=? vfasl1 vfasl2))]
                        [record (maybe-uid size nflds rtd pad-ty* fld*)
                         (and (if maybe-uid1
                                  (and maybe-uid2 (fasl=? maybe-uid1 maybe-uid2))
diff --git a/racket/src/ChezScheme/s/vfasl.ss b/racket/src/ChezScheme/s/vfasl.ss
new file mode 100644
index 00000000000..befc436ee19
--- /dev/null
+++ b/racket/src/ChezScheme/s/vfasl.ss
@@ -0,0 +1,1092 @@
+;; vfasl conversion uses the 
+
+
+(let ()
+
+(include "strip-types.ss")
+
+;; cooperates better with auto-indent than `fasl-case`:
+(define-syntax (fasl-case* stx)
+  (syntax-case stx (else)
+    [(_ target [(op fld ...) body ...] ... [else e-body ...])
+     #'(fasl-case target [op (fld ...) body ...] ... [else e-body ...])]
+    [(_ target [(op fld ...) body ...] ...)
+     #'(fasl-case target [op (fld ...) body ...] ...)]))
+
+;; reverse quoting convention compared to `constant-case`:
+(define-syntax (constant-case* stx)
+  (syntax-case stx (else)
+    [(_ target [(const ...) body ...] ... [else e-body ...])
+     (with-syntax ([((val ...) ...)
+                    (map (lambda (consts)
+                           (map (lambda (const)
+                                  (lookup-constant const))
+                                consts))
+                         (datum ((const ...) ...)))])
+       #'(case target [(val ...) body ...] ... [else e-body ...]))]
+    [(_ target [(const ...) body ...] ...)
+     #'(constant-case* target [(const ...) body ...] ... [else ($oops 'constant-case* "no matching case ~s" 'target)])]))
+
+;; ************************************************************
+;; Encode-time data structures                              */
+
+;; During encoding, we use a bytevector per vspace on first pass,
+;; single shared bytevector on the second pass
+(define-record-type vfasl-chunk
+  (fields (mutable bv)
+          (mutable offset) ; offset into bv
+          (mutable alloc) ; allocation pointer; implies size
+          limit) ; #f or a sanity-check limit
+  (nongenerative))
+
+(define-record-type vfasl-info
+  (fields (mutable bv)
+
+          (mutable base-addr) ; index within bv to make pointers and relocations relative to
+
+          (mutable sym-count)
+
+          (mutable symref-count)
+          (mutable symrefs)  ; offset into bv
+
+          (mutable rtdref-count)
+          (mutable rtdrefs)  ; offset into bv
+
+          (mutable singletonref-count)
+          (mutable singletonrefs) ; offset into bv
+
+          spaces ; vector of vfasl-chunk
+
+          (mutable ptr-bitmap) ; #f or offset into bv
+
+          (mutable graph)
+          (mutable base-rtd)   ; write base-rtd only once
+
+          (mutable symbols)    ; intern symbols (because multiple fasl blocks may be combined)
+          (mutable rtds)       ; intern rtds (same reason)
+          (mutable strings)    ; intern certain strings (for code names)
+
+          (mutable installs-library-entry?)) ; to determine whether vfasls can be combined
+  (nongenerative))
+
+(define (new-vfasl-info)
+  (make-vfasl-info #f
+
+                   0
+                   0 ; sym-count
+
+                   0 ;symref-count
+                   #f
+
+                   0 ; rtdref-count
+                   #f
+
+                   0 ; singletonref-count
+                   #f
+
+                   (list->vector
+                    (let loop ([i 0])
+                      (if (fx= i (constant vspaces-count))
+                          '()
+                          (cons (make-vfasl-chunk '#vu8() 0 0 #f)
+                                (loop (fx+ i 1))))))
+                   #f ; ptr-bitmap
+
+                   (make-eq-hashtable)
+                   #f
+                   (make-eq-hashtable)
+                   (make-eq-hashtable)
+                   (make-hashtable string-hash string=?)
+
+                   #f)) ; installs-library-entry?
+
+;; Creates a vfasl image for the fasl content `v` (as read by "strip.ss")
+(define (to-vfasl v)
+  (let ([v (ensure-reference v)]
+        [vfi (new-vfasl-info)])
+    ;; First pass: determine sizes
+    (copy v vfi)
+
+    ;; Setup for second pass: allocate to contiguous bytes
+    (let* ([data-size (let loop ([i 0])
+                        (if (fx= i (constant vspaces-count))
+                            0
+                            (fx+ (vfasl-chunk-alloc
+                                  (vector-ref (vfasl-info-spaces vfi) i))
+                                 (loop (fx+ i 1)))))]
+           [table-size (fx+ (fx* (vfasl-info-symref-count vfi) (constant ptr-bytes))
+                            (fx* (vfasl-info-rtdref-count vfi) (constant ptr-bytes))
+                            (fx* (vfasl-info-singletonref-count vfi) (constant ptr-bytes)))]
+           [bitmap-size (fxsra (fx+ data-size (fx- (constant byte-bits) 1)) (constant log2-byte-bits))]
+           [size (fx+ (constant size-vfasl-header)
+                      data-size
+                      table-size
+                      bitmap-size)]
+           [bv (make-bytevector size 0)])
+      (vfasl-info-bv-set! vfi bv)
+
+      ;; write header, except for result offset and table size:
+      (set-uptr! bv (constant vfasl-header-data-size-disp) data-size)
+      (let loop ([i 1] [offset (vfasl-chunk-alloc
+                                (vector-ref (vfasl-info-spaces vfi) 0))])
+        (unless (fx= i (constant vspaces-count))
+          (set-uptr! bv
+                     (fx+ (constant vfasl-header-vspace-rel-offsets-disp)
+                          (fx* (fx- i 1) (constant ptr-bytes)))
+                     offset)
+          (loop (fx+ i 1) (fx+ offset (vfasl-chunk-alloc
+                                       (vector-ref (vfasl-info-spaces vfi) i))))))
+      (set-uptr! bv (constant vfasl-header-symref-count-disp) (vfasl-info-symref-count vfi))
+      (set-uptr! bv (constant vfasl-header-rtdref-count-disp) (vfasl-info-rtdref-count vfi))
+      (set-uptr! bv (constant vfasl-header-singletonref-count-disp) (vfasl-info-singletonref-count vfi))
+
+      (let ([base-addr (constant size-vfasl-header)])
+        (vfasl-info-base-addr-set! vfi base-addr)
+
+        (let* ([p
+                ;; Set pointers to vspaces based on sizes from first pass
+                (let loop ([i 0] [p base-addr])
+                  (if (fx= i (constant vspaces-count))
+                      p
+                      (let ([len (vfasl-chunk-alloc
+                                  (vector-ref (vfasl-info-spaces vfi) i))])
+                        (vector-set! (vfasl-info-spaces vfi) i (make-vfasl-chunk bv p 0 len))
+                        (loop (fx+ i 1) (fx+ p len)))))]
+               [p (begin
+                    (vfasl-info-symrefs-set! vfi p)
+                    (fx+ p (fx* (vfasl-info-symref-count vfi) (constant ptr-bytes))))]
+               [p (begin
+                    (vfasl-info-rtdrefs-set! vfi p)
+                    (fx+ p (fx* (vfasl-info-rtdref-count vfi) (constant ptr-bytes))))]
+               [p (begin
+                    (vfasl-info-singletonrefs-set! vfi p)
+                    (fx+ p (fx* (vfasl-info-singletonref-count vfi) (constant ptr-bytes))))]
+               [bm p])
+          (vfasl-info-ptr-bitmap-set! vfi bm)
+
+          (vfasl-info-sym-count-set! vfi 0)
+          (vfasl-info-symref-count-set! vfi 0)
+          (vfasl-info-rtdref-count-set! vfi 0)
+          (vfasl-info-singletonref-count-set! vfi 0)
+          (vfasl-info-graph-set! vfi (make-eq-hashtable))
+          (vfasl-info-base-rtd-set! vfi #f)
+
+          ;; Write data
+          (let ([v (copy v vfi)])
+            (let-values ([(bv offset) (vptr->bytevector+offset v vfi)])
+              (set-iptr! bv (constant vfasl-header-result-offset-disp) (- offset base-addr)))
+
+            ;; We can ignore trailing zeros in the bitmap:
+            (let* ([zeros (let loop ([bmp (fx+ bm bitmap-size)] [zeros 0])
+                            (cond
+                              [(fx= bmp bm) zeros]
+                              [(fx= 0 (bytevector-u8-ref bv (fx- bmp 1)))
+                               (loop (fx- bmp 1) (fx+ zeros 1))]
+                              [else zeros]))]
+                   [table-size (fx+ table-size (fx- bitmap-size zeros))])
+              (set-uptr! bv (constant vfasl-header-table-size-disp) table-size)
+              ;; Truncate bytevector to match end of bitmaps
+              (bytevector-truncate! bv (fx- size zeros)))
+
+            (sort-offsets! bv (vfasl-info-symrefs vfi) (vfasl-info-symref-count vfi))
+            (sort-offsets! bv (vfasl-info-rtdrefs vfi) (vfasl-info-rtdref-count vfi))
+            (sort-offsets! bv (vfasl-info-singletonrefs vfi) (vfasl-info-singletonref-count vfi))
+
+            bv))))))
+
+;; If compiled code uses `$install-library-entry`, then it can't be
+;; combined into a single vfasled object, because the installation
+;; needs to be evaluated for laster vfasls. Recognize a non-combinable
+;; value as anything that references the C entry or even mentions the
+;; symbol `$install-library-entry` (as defined in "library.ss"). If
+;; non-boot code mentions the symbol `$install-library-entry`, it just
+;; isn't as optimal.
+;;
+;; This is an expensive test, since we perform half of a vfasl
+;; encoding to look for `$install-library-entry`. */
+(define (fasl-can-combine? v)
+  (let ([vfi (new-vfasl-info)])
+    ;; Run a "first pass"
+    (copy v vfi)
+    (not (vfasl-info-installs-library-entry? vfi))))
+
+;; Box certain kinds of values (including singletons) where the vfasl
+;; process needs a pointer into data
+(define (ensure-reference v)
+  (define (enbox v)
+    (fasl-tuple (constant fasl-type-box) (vector v)))
+  (define (enbox-fixnum n)
+    (if (<= (constant most-negative-fixnum) n (constant most-positive-fixnum))
+        (enbox v)
+        v))
+  (fasl-case* v
+    [(atom ty uptr)
+     (constant-case* ty
+       [(fasl-type-immediate fasl-type-base-rtd) (enbox v)]
+       [else v])]
+    [(small-integer iptr) (enbox-fixnum iptr)]
+    [(large-integer sign vuptr) (enbox-fixnum (build-exact-integer sign vuptr))]
+    [(tuple ty vec)
+     (constant-case* ty
+       [(fasl-type-box) (enbox v)]
+       [else v])]
+    [(string ty string)
+     (constant-case* ty
+       [(fasl-type-symbol) (enbox v)]
+       [else
+        (if (fx= 0 (string-length string))
+            (enbox v)
+            v)])]
+    [(vector ty vec)
+     (if (fx= 0 (vector-length vec))
+         (enbox v)
+         v)]
+    [(fxvector vec)
+     (if (fx= 0 (vector-length vec))
+         (enbox v)
+         v)]
+    [(bytevector ty bv)
+     (if (fx= 0 (bytevector-length bv))
+         (enbox v)
+         v)]
+    [(record maybe-uid size nflds rtd pad-ty* fld*)
+     (enbox v)]
+    [else v]))
+
+;; quicksort on uptrs within a bytevector
+(define (sort-offsets! bv offset len)
+  (define (uref i)
+    (ref-uptr bv (fx+ offset (fx* i (constant ptr-bytes)))))
+  (define (uset! i v)
+    (set-uptr! bv (fx+ offset (fx* i (constant ptr-bytes))) v))
+  (when (fx> len 1)
+    (let* ([mid (fxsra len 1)]
+           [tmp (uref mid)])
+      (uset! mid (uref 0))
+      (uset! 0 tmp))
+    (let ([p-val (uref 0)])
+      (let loop ([i 1] [pivot 0])
+        (cond
+          [(fx= i len)
+           (uset! pivot p-val)
+           (sort-offsets! bv offset pivot)
+           (sort-offsets! bv (fx+ offset (fx* (fx+ pivot 1) (constant ptr-bytes))) (fx- len pivot 1))]
+          [(< (uref i) p-val)
+           (uset! pivot (uref i))
+           (let ([pivot (fx+ pivot 1)])
+             (uset! i (uref pivot))
+             (loop (fx+ i 1) pivot))]
+          [else
+           (loop (fx+ i 1) pivot)])))))
+
+;; ----------------------------------------
+
+;; A vptr represents a pointer to an object allocated in a vfasl image.
+;; A vsingleton represents a pointer to a single (not in the image).
+;; A number a pointer represents a literal pointer, such as a fixnum or immediate.
+
+(define (make-vptr v vspace) (cons v vspace))
+(define (make-vsingleton n) (cons n 'singleton))
+
+(define (vptr? v) (and (pair? v) (not (eq? (cdr v) 'singleton))))
+(define (vptr-v v) (car v))
+(define (vptr-vspace v) (cdr v))
+(define (vptr+ v offset) (make-vptr (fx+ (vptr-v v) offset) (vptr-vspace v)))
+
+(define (vsingleton? v) (and (pair? v) (eq? (cdr v) 'singleton)))
+(define (vsingleton-index v) (car v))
+
+(define (segment-start? sz)
+  (fxzero? (fxand sz (fx- (constant bytes-per-segment) 1))))
+(define (segment-truncate sz)
+  (fxand sz (fxnot (fx- (constant bytes-per-segment) 1))))
+
+;; Allocate into the given vspace in a vfasl image. The result
+;; is just the `v` part of a vptr (because it's easier to do arithmetic
+;; with that to initialize the item).
+(define (find-room who vfi vspc n type)
+  (let ([n (c-alloc-align n)]
+        [vc (vector-ref (vfasl-info-spaces vfi) vspc)])
+    (constant-case* vspc
+      [(vspace-symbol vspace-impure-record)
+       ;; For these spaces, in case they will be loaded into the static
+       ;; generation, objects must satisfy an extra constraint: an object
+       ;; must not span segments unless it's at the start of a
+       ;; segment
+       (let ([sz (vfasl-chunk-alloc vc)])
+         (unless (segment-start? sz)
+           ;; Since we're not at the start of a segment, don't let an
+           ;; object span a segment
+           (when (and (not (fx= (segment-truncate sz) (segment-truncate (fx+ sz n))))
+                      (not (segment-start? (fx+ sz n))))
+             ;; Skip to next segment
+             (vfasl-chunk-alloc-set! vc (segment-truncate (fx+ sz n))))))]
+      [else (void)])
+    (let* ([sz (vfasl-chunk-alloc vc)]
+           [new-sz (fx+ sz n)]
+           [limit (vfasl-chunk-limit vc)])
+      (when (and limit
+                 (fx> new-sz limit))
+        ($oops 'vfasl "allocation overrun"))
+      (when (fx< (bytevector-length (vfasl-chunk-bv vc)) new-sz)
+        (let ([bv (make-bytevector (fx+ (if (fxzero? sz)
+                                            (constant bytes-per-segment)
+                                            (fx* 2 (bytevector-length (vfasl-chunk-bv vc))))
+                                        (segment-truncate n)))])
+          (bytevector-copy! (vfasl-chunk-bv vc) 0 bv 0 sz)
+          (vfasl-chunk-bv-set! vc bv)))
+      (vfasl-chunk-alloc-set! vc new-sz)
+      (make-vptr (fx- sz (fx- (constant typemod) type))
+                 vspc))))
+
+(define vptr->bytevector+offset
+  (case-lambda
+   [(p vfi) (vptr->bytevector+offset p 0 vfi)]
+   [(p delta vfi)
+    (let ([vc (vector-ref (vfasl-info-spaces vfi) (vptr-vspace p))])
+      (values (vfasl-chunk-bv vc) (fx+ (vfasl-chunk-offset vc) (vptr-v p) delta)))]))
+
+;; Overloaded to either set in a bytevector or set in a vfasl image:
+(define set-uptr!
+  (case-lambda
+   [(bv i uptr)
+    (constant-case ptr-bytes
+      [(4) (bytevector-u32-set! bv i uptr (constant native-endianness))]
+      [(8) (bytevector-u64-set! bv i uptr (constant native-endianness))])]
+   [(p delta uptr vfi)
+    (let-values ([(bv offset) (vptr->bytevector+offset p delta vfi)])
+      (set-uptr! bv offset uptr))]))
+
+;; Overloaded in the same way as `set-uptr!`
+(define ref-uptr
+  (case-lambda
+   [(bv i)
+    (constant-case ptr-bytes
+      [(4) (bytevector-u32-ref bv i (constant native-endianness))]
+      [(8) (bytevector-u64-ref bv i (constant native-endianness))])]
+   [(p delta vfi)
+    (let-values ([(bv offset) (vptr->bytevector+offset p delta vfi)])
+      (ref-uptr bv offset))]))
+
+;; Overloaded in the same way as `set-uptr!`
+(define set-iptr!
+  (case-lambda
+   [(bv i uptr)
+    (constant-case ptr-bytes
+      [(4) (bytevector-s32-set! bv i uptr (constant native-endianness))]
+      [(8) (bytevector-s64-set! bv i uptr (constant native-endianness))])]
+   [(p delta uptr vfi)
+    (let-values ([(bv offset) (vptr->bytevector+offset p delta vfi)])
+      (set-iptr! bv offset uptr))]))
+
+;; Overloaded in the same way as `set-uptr!`
+(define set-double!
+  (case-lambda
+   [(bv i dbl)
+    (bytevector-ieee-double-set! bv i dbl (constant native-endianness))]
+   [(p delta dbl vfi)
+    (let-values ([(bv offset) (vptr->bytevector+offset p delta vfi)])
+      (set-double! bv offset dbl))]))
+
+;; Overloaded in the same way as `set-uptr!`
+(define set-char!
+  (case-lambda
+   [(bv i char)
+    (let ([n (bitwise-ior (bitwise-arithmetic-shift-left (char->integer char) (constant char-data-offset))
+                          (constant type-char))])
+      (constant-case string-char-bytes
+        [(4) (bytevector-u32-set! bv i n (constant native-endianness))]))]
+   [(p delta char vfi)
+    (let-values ([(bv offset) (vptr->bytevector+offset p delta vfi)])
+      (set-char! bv offset char))]))
+
+(define set-u8!
+  (case-lambda
+   [(p delta u8 vfi)
+    (let-values ([(bv offset) (vptr->bytevector+offset p delta vfi)])
+      (bytevector-u8-set! bv offset u8))]))
+
+(define (copy-u8s! p delta bv bv-off len vfi)
+  (let-values ([(dest-bv offset) (vptr->bytevector+offset p delta vfi)])
+    (bytevector-copy! bv bv-off dest-bv offset len)))
+
+;; Overloaded in the same way as `set-uptr!`
+(define set-bigit!
+  (case-lambda
+   [(bv i bigit)
+    (constant-case bigit-bytes
+      [(4) (bytevector-u32-set! bv i bigit (constant native-endianness))])]
+   [(p delta bigit vfi)
+    (let-values ([(bv offset) (vptr->bytevector+offset p delta vfi)])
+      (set-bigit! bv offset bigit))]))
+
+;; Sets a pointer in a vfasl image, and optionally records the reference.
+;; The pointer is written as a relative offset, and then it will get
+;; adjusted when the vfasl image is loaded.
+(define (do-set-ptr! at-p delta p vfi record?)
+  (let* ([vc (vector-ref (vfasl-info-spaces vfi) (vptr-vspace at-p))]
+         [rel-v (fx- (fx+ (vptr-v at-p) delta (vfasl-chunk-offset vc))
+                     (vfasl-info-base-addr vfi))])
+    (define (register! vfasl-info-ref-count
+                       vfasl-info-ref-count-set!
+                       vfasl-info-refs)
+      (unless record? ($oops 'vfasl "expected to record ptr"))
+      (let ([c (vfasl-info-ref-count vfi)]
+            [refs (vfasl-info-refs vfi)])
+        (vfasl-info-ref-count-set! vfi (fx+ c 1))
+        (when refs
+          (set-uptr! (vfasl-info-bv vfi) (fx+ refs (fx* c (constant ptr-bytes))) rel-v))))
+    (let ([val (cond
+                 [(vptr? p)
+                  (let* ([p-vspc (vptr-vspace p)]
+                         [p-vc (vector-ref (vfasl-info-spaces vfi) p-vspc)])
+                    (constant-case* p-vspc
+                      [(vspace-symbol)
+                       (when record?
+                         (register! vfasl-info-symref-count
+                                    vfasl-info-symref-count-set!
+                                    vfasl-info-symrefs))
+                       ;; symbol reference are not registered in the bitmap,
+                       ;; and the reference is as an index instead of address offset
+                       (fix (symbol-vptr->index p vfi))]
+                      [else
+                       (when record?
+                         (when (eqv? p-vspc (constant vspace-rtd))
+                           (register! vfasl-info-rtdref-count
+                                      vfasl-info-rtdref-count-set!
+                                      vfasl-info-rtdrefs))
+                         (let ([bm (vfasl-info-ptr-bitmap vfi)])
+                           (when bm
+                             (safe-assert (fxzero? (fxand rel-v (fx- (constant ptr-bytes) 1))))
+                             (let* ([w-rel-b (fxsra rel-v (constant log2-ptr-bytes))]
+                                    [i (fx+ bm (fxsra w-rel-b (constant log2-byte-bits)))]
+                                    [bit (fxsll 1 (fxand w-rel-b (fx- (constant byte-bits) 1)))]
+                                    [bv (vfasl-info-bv vfi)])
+                               (bytevector-u8-set! bv i (fxior (bytevector-u8-ref bv i) bit))))))
+                       (fx- (fx+ (vptr-v p) (vfasl-chunk-offset p-vc))
+                            (vfasl-info-base-addr vfi))]))]
+                 [(vsingleton? p)
+                  (register! vfasl-info-singletonref-count
+                             vfasl-info-singletonref-count-set!
+                             vfasl-info-singletonrefs)
+                  (fix (vsingleton-index p))]
+                 [else p])])
+      (set-iptr! at-p delta val vfi))))
+
+(define (set-ptr! at-p delta p vfi) (do-set-ptr! at-p delta p vfi #t))
+(define (set-ptr!/no-record at-p delta p vfi) (do-set-ptr! at-p delta p vfi #f))
+
+(define (symbol-vptr->index p vfi)
+  ;; There may be leftover space at the end of each segment containing symbols,
+  ;; we we have to compensate for that
+  (let* ([vc (vector-ref (vfasl-info-spaces vfi) (constant vspace-symbol))]
+         [offset (fx+ (vptr-v p) (fx- (constant typemod) (constant type-symbol)))]
+         [seg (quotient offset (constant bytes-per-segment))])
+    (fx+ (fx* seg (quotient (constant bytes-per-segment) (constant size-symbol)))
+         (fxquotient (fx- offset (fx* seg (constant bytes-per-segment))) (constant size-symbol)))))
+
+(define (build-exact-integer sign vuptr)
+  (let loop ([v 0] [i 0])
+    (cond
+      [(fx= i (vector-length vuptr))
+       (if (eqv? sign 1) (- v) v)]
+      [else (loop (bitwise-ior (bitwise-arithmetic-shift v (constant bigit-bits))
+                                   (vector-ref vuptr i))
+                  (fx+ i 1))])))
+
+(define (build-flonum high low)
+  (let ([bv (make-bytevector 8)])
+    (bytevector-u64-native-set! bv 0 (bitwise-ior low (bitwise-arithmetic-shift high 32)))
+    (bytevector-ieee-double-native-ref bv 0)))
+
+(define (unpack-flonum v)
+  (fasl-case* v
+    [(flonum high low) (build-flonum high low)]
+    [else ($oops 'vfasl "expected a flonum")]))
+
+(define (unpack-symbol v)
+  (or (fasl-case* v
+        [(string ty string)
+         (if (eq? ty (constant fasl-type-symbol))
+             (string->symbol string)
+             #f)]
+        [(gensym pname uname) (gensym pname uname)]
+        [else #f])
+      (error 'vfasl "expected a symbol: ~s" v)))
+
+;; ----------------------------------------
+
+(define rtd-flds (csv7:record-field-accessor #!base-rtd 'flds))
+
+(define (fix v)
+  (bitwise-arithmetic-shift-left v (constant fixnum-offset)))
+(define (fixed? v)
+  (fxzero? (bitwise-and v (sub1 (fxsll 1 (constant fixnum-offset))))))
+
+(define (graph! v new-p vfi)
+  (eq-hashtable-set! (vfasl-info-graph vfi) v new-p))
+
+(define (copy v vfi)
+  (or (eq-hashtable-ref (vfasl-info-graph vfi) v #f)
+      (do-copy v vfi)))
+
+(define (do-copy v vfi)
+  (fasl-case* v
+    [(atom ty uptr)
+     (constant-case* ty
+       [(fasl-type-immediate) uptr]
+       [(fasl-type-entry fasl-type-library fasl-type-library-code)
+        ($oops 'vfasl "expected only in a relocation: ~s" v)]
+       [else ($oops 'vfasl "unknown atom: ~s" v)])]
+    [(small-integer iptr) (exact-integer-copy v iptr vfi)]
+    [(large-integer sign vuptr)
+     (exact-integer-copy v (build-exact-integer sign vuptr) vfi)]
+    [(flonum high low)
+     (let ([new-p (find-room 'flonum vfi
+                             (constant vspace-data)
+                             (constant size-flonum)
+                             (constant type-flonum))])
+       (graph! v new-p vfi)
+       (set-double! new-p (constant flonum-data-disp) (build-flonum high low) vfi)
+       new-p)]
+    [(pair vec)
+     (let ([len (vector-length vec)]
+           [vspc (constant vspace-impure)])
+       (cond
+         [(fx= len 1) (copy (vector-ref vec 0) vfi)]
+         [else
+          ;; can't just use `pair-copy` for initial pair, because we need
+          ;; to set up the graph:
+          (let ([new-p (find-room 'pair vfi
+                                  (constant vspace-impure)
+                                  (constant size-pair)
+                                  (constant type-pair))])
+            (graph! v new-p vfi)
+            (set-ptr! new-p (constant pair-car-disp) (copy (vector-ref vec 0) vfi) vfi)
+            (let ([d (let loop ([i 1])
+                       (let ([e (copy (vector-ref vec i) vfi)]
+                             [i (fx+ i 1)])
+                         (if (fx= i len)
+                             e
+                             (pair-copy e (loop i) vfi))))])
+              (set-ptr! new-p (constant pair-cdr-disp) d vfi)
+              new-p))]))]
+    [(tuple ty vec)
+     (constant-case* ty
+       [(fasl-type-base-rtd) (base-rtd-copy v vfi)]
+       [(fasl-type-box fasl-type-immutable-box)
+        (let ([new-p (find-room 'box vfi
+                                (constant vspace-impure)
+                                (constant size-box)
+                                (constant type-typed-object))])
+          (graph! v new-p vfi)
+          (set-uptr! new-p (constant box-type-disp)
+                     (if (eqv? ty (constant fasl-type-immutable-box))
+                         (constant type-immutable-box)
+                         (constant type-box))
+                     vfi)
+          (set-ptr! new-p (constant box-ref-disp) (copy (vector-ref vec 0) vfi) vfi)
+          new-p)]
+       [(fasl-type-ratnum)
+        (let ([new-p (find-room 'ratnum vfi
+                                (constant vspace-impure)
+                                (constant size-ratnum)
+                                (constant type-typed-object))])
+          (graph! v new-p vfi)
+          (set-uptr! new-p (constant ratnum-type-disp) (constant type-ratnum) vfi)
+          (set-ptr! new-p (constant ratnum-numerator-disp) (copy (vector-ref vec 0) vfi) vfi)
+          (set-ptr! new-p (constant ratnum-denominator-disp) (copy (vector-ref vec 1) vfi) vfi)
+          new-p)]
+       [(fasl-type-exactnum)
+        (let ([new-p (find-room 'exactnum vfi
+                                (constant vspace-impure)
+                                (constant size-exactnum)
+                                (constant type-typed-object))])
+          (graph! v new-p vfi)
+          (set-uptr! new-p (constant exactnum-type-disp) (constant type-exactnum) vfi)
+          (set-ptr! new-p (constant exactnum-real-disp) (copy (vector-ref vec 0) vfi) vfi)
+          (set-ptr! new-p (constant exactnum-imag-disp) (copy (vector-ref vec 1) vfi) vfi)
+          new-p)]
+       [(fasl-type-inexactnum)
+        (let ([new-p (find-room 'inexactnum vfi
+                                (constant vspace-data)
+                                (constant size-inexactnum)
+                                (constant type-typed-object))])
+          (graph! v new-p vfi)
+          (set-uptr! new-p (constant inexactnum-type-disp) (constant type-inexactnum) vfi)
+          (set-double! new-p (constant inexactnum-real-disp) (unpack-flonum (vector-ref vec 0)) vfi)
+          (set-double! new-p (constant inexactnum-imag-disp) (unpack-flonum (vector-ref vec 1)) vfi)
+          new-p)]
+       [(fasl-type-weak-pair)
+        ($oops 'vfasl "weak pair not supported")]
+       [(fasl-type-ephemeron)
+        ($oops 'vfasl "ephemeron pair not supported")]
+       [else
+        ($oops 'vfasl "unrecognized tuple type")])]
+    [(string ty string)
+     (constant-case* ty
+       [(fasl-type-symbol)
+        (when (string=? string "$install-library-entry")
+          (vfasl-info-installs-library-entry?-set! vfi #t))
+        (symbol-copy v
+                     (string-copy string vfi)
+                     (string->symbol string)
+                     vfi)]
+       [else
+        (let ([immutable? (eqv? ty (constant fasl-type-immutable-string))])
+          (cond
+            [(fx= 0 (string-length string))
+             (make-vsingleton (if immutable?
+                                  (constant singleton-null-immutable-string)
+                                  (constant singleton-null-string)))]
+            [else
+             (vector-copy v string vfi
+                          string-length
+                          vspace-data
+                          header-size-string string-data-disp
+                          string-char-bytes
+                          (bitwise-ior (bitwise-arithmetic-shift-left (string-length string) (constant string-length-offset))
+                                       (if immutable?
+                                           (constant string-immutable-flag)
+                                           0)
+                                       (constant type-string))
+                          string-type-disp
+                          set-char!
+                          string-ref)]))])]
+    [(gensym pname uname)
+     (symbol-copy v (pair-copy (string-copy uname vfi) (string-copy pname vfi) vfi) (gensym pname uname) vfi)]
+    [(vector ty vec)
+     (cond
+       [(fx= 0 (vector-length vec))
+        (make-vsingleton (constant-case* ty
+                           [(fasl-type-vector)
+                            (constant singleton-null-vector)]
+                           [(fasl-type-immutable-vector)
+                            (constant singleton-null-immutable-vector)]
+                           [(fasl-type-flvector)
+                            (constant singleton-null-flvector)]))]
+       [else
+        (constant-case* ty
+          [(fasl-type-vector fasl-type-immutable-vector)
+           (vector-copy v vec vfi
+                        vector-length
+                        vspace-impure
+                        header-size-vector vector-data-disp
+                        ptr-bytes
+                        (bitwise-ior (bitwise-arithmetic-shift-left (vector-length vec) (constant vector-length-offset))
+                                     (if (eqv? ty (constant fasl-type-immutable-vector))
+                                         (constant vector-immutable-flag)
+                                         0)
+                                     (constant type-vector))
+                        vector-type-disp
+                        set-ptr!
+                        (lambda (vec i) (copy (vector-ref vec i) vfi)))]
+          [(fasl-type-flvector)
+           (vector-copy v vec vfi
+                        vector-length
+                        vspace-data
+                        header-size-flvector flvector-data-disp
+                        double-bytes
+                        (bitwise-ior (bitwise-arithmetic-shift-left (vector-length vec) (constant flvector-length-offset))
+                                     (constant type-flvector))
+                        flvector-type-disp
+                        set-double!
+                        (lambda (v i) (unpack-flonum (vector-ref v i))))])])]
+    [(fxvector vec)
+     (cond
+       [(fx= 0 (vector-length vec))
+        (make-vsingleton (constant singleton-null-fxvector))]
+       [else
+        (vector-copy v vec vfi
+                     vector-length
+                     vspace-data
+                     header-size-fxvector fxvector-data-disp
+                     ptr-bytes
+                     (bitwise-ior (bitwise-arithmetic-shift-left (vector-length v) (constant fxvector-length-offset))
+                                  (constant type-fxvector))
+                     fxvector-type-disp
+                     set-iptr!
+                     (lambda (v i) (fix (vector-ref v i))))])]
+    [(bytevector ty bv)
+     (cond
+       [(fx= 0 (bytevector-length bv))
+        (make-vsingleton (if (eqv? ty (constant fasl-type-immutable-bytevector))
+                             (constant singleton-null-immutable-bytevector)
+                             (constant singleton-null-bytevector)))]
+       [else
+        (vector-copy v bv vfi
+                     bytevector-length
+                     vspace-data
+                     header-size-bytevector bytevector-data-disp
+                     byte-bytes
+                     (bitwise-ior (bitwise-arithmetic-shift-left (bytevector-length bv) (constant bytevector-length-offset))
+                                  (if (eqv? ty (constant fasl-type-immutable-bytevector))
+                                      (constant bytevector-immutable-flag)
+                                      0)
+                                  (constant type-bytevector))
+                     bytevector-type-disp
+                     set-u8!
+                     bytevector-u8-ref)])]
+    [(stencil-vector mask vec)
+     (vector-copy v vec vfi
+                  vector-length
+                  vspace-impure
+                  header-size-stencil-vector stencil-vector-data-disp
+                  ptr-bytes
+                  (bitwise-ior (bitwise-arithmetic-shift-left mask (constant stencil-vector-mask-offset))
+                               (constant type-stencil-vector))
+                  stencil-vector-type-disp
+                  set-ptr!
+                  (lambda (v i) (copy (vector-ref v i) vfi)))]
+    [(record maybe-uid size nflds rtd pad-ty* fld*)
+     (cond
+       [(refers-back-to-self? v rtd)
+        (base-rtd-copy v vfi)]
+       [(and maybe-uid
+             (let ([v2 (eq-hashtable-ref (vfasl-info-rtds vfi) (unpack-symbol maybe-uid) v)])
+               (and (not (eq? v2 v))
+                    v2)))
+        => (lambda (v2)
+             (copy v2 vfi))]
+       [else
+        (let ([rtd-p (copy rtd vfi)])
+          (when maybe-uid
+            (eq-hashtable-set! (vfasl-info-rtds vfi) (unpack-symbol maybe-uid) v)
+            ;; make sure parent type is earlier
+            (for-each (lambda (fld)
+                        (field-case (car fld*)
+                                    [ptr (elem) (copy elem vfi)]
+                                    [else (void)]))
+                      fld*))
+          (let* ([vspc (cond
+                         [maybe-uid
+                          (constant vspace-rtd)]
+                         [(eqv? 0 (let-values ([(bv offset) (vptr->bytevector+offset rtd-p vfi)])
+                                    (ref-uptr bv (fx+ offset (constant record-type-mpm-disp)))))
+                          (constant vspace-pure-typed)]
+                         [else
+                          (constant vspace-impure-record)])]
+                 [new-p (find-room 'record vfi vspc size (constant type-typed-object))])
+            (graph! v new-p vfi)
+            (set-ptr! new-p (constant record-type-disp) rtd-p vfi)
+            (let loop ([addr (constant record-data-disp)]
+                       [pad-ty* pad-ty*]
+                       [fld* fld*])
+              (unless (null? pad-ty*)
+                (let* ([pad-ty (car pad-ty*)]
+                       [addr (fx+ addr (fxsrl pad-ty 4))]
+                       [addr (field-case (car fld*)
+                               [ptr (elem)
+                                (safe-assert (eqv? (fxand pad-ty #xF) (constant fasl-fld-ptr)))
+                                (set-ptr! new-p addr (copy elem vfi) vfi)
+                                (fx+ addr (constant ptr-bytes))]
+                               [iptr (elem)
+                                (set-iptr! new-p addr elem vfi)
+                                (fx+ addr (constant ptr-bytes))]
+                               [double (high low)
+                                (safe-assert (eqv? (fxand pad-ty #xF) (constant fasl-fld-double)))
+                                (set-double! new-p addr
+                                             (build-flonum high low)
+                                             vfi)
+                                (fx+ addr (constant double-bytes))]
+                               [else
+                                (error 'vfasl "unsupported field: ~s" (car fld*))])])
+                  (loop addr (cdr pad-ty*) (cdr fld*)))))
+            new-p))])]
+    [(closure offset c)
+     (let* ([c-v (copy c vfi)]
+            [new-p (find-room 'closure vfi
+                              (constant vspace-closure)
+                              (constant header-size-closure)
+                              (constant type-closure))])
+       (graph! v new-p vfi)
+       (set-ptr!/no-record new-p (constant closure-code-disp) (vptr+ c-v offset) vfi)
+       new-p)]
+    [(code flags free name arity-mask info pinfo* bytes m vreloc)
+     (let* ([len (bytevector-length bytes)]
+            [new-p (find-room 'code vfi
+                              (constant vspace-code)
+                              (fx+ (constant header-size-code) len)
+                              (constant type-typed-object))])
+       (graph! v new-p vfi)
+       (set-uptr! new-p (constant code-type-disp)
+                  (bitwise-ior (bitwise-arithmetic-shift-left flags (constant code-flags-offset))
+                               (constant type-code))
+                  vfi)
+       (set-uptr! new-p (constant code-length-disp) len vfi)
+       (set-ptr! new-p (constant code-name-disp)
+                 (fasl-case* name
+                   [(string ty string)
+                    ;; imitate string interning that fasl read performs:
+                    (if (or (eqv? ty (constant fasl-type-string))
+                            (eqv? ty (constant fasl-type-immutable-string)))
+                        (string-copy string vfi)
+                        (copy name vfi))]
+                   [else (copy name vfi)])
+                 vfi)
+       (set-ptr! new-p (constant code-arity-mask-disp) (copy arity-mask vfi) vfi)
+       (set-uptr! new-p (constant code-closure-length-disp) free vfi)
+       (set-ptr! new-p (constant code-info-disp) (copy info vfi) vfi)
+       (set-ptr! new-p (constant code-pinfo*-disp) (copy pinfo* vfi) vfi)
+       (copy-u8s! new-p (constant code-data-disp) bytes 0 len vfi)
+       ;; must be after code is copied into place:
+       (set-ptr!/no-record new-p (constant code-reloc-disp) (copy-reloc m vreloc new-p vfi) vfi)
+       new-p)]
+    [(symbol-hashtable mutable? minlen subtype veclen vpfasl)
+     (let* ([flds (rtd-flds $symbol-ht-rtd)]
+            [len (fx* (length flds) (constant ptr-bytes))]
+            [new-p (find-room 'symbol-ht vfi
+                              (constant vspace-impure)
+                              (fx+ (constant header-size-record) len)
+                              (constant type-typed-object))]
+            [vec-p (find-room 'symbol-ht-vector vfi
+                              (constant vspace-impure)
+                              (fx+ (constant header-size-vector) (fx* veclen (constant ptr-bytes)))
+                              (constant type-typed-object))]
+            [equiv (case subtype
+                     [(0) (make-vsingleton (constant singleton-eq))]
+                     [(1) (make-vsingleton (constant singleton-eqv))]
+                     [(2) (make-vsingleton (constant singleton-equal))]
+                     [(3) (make-vsingleton (constant singleton-symbol=?))]
+                     [else ($oops 'vfasl "unrecognized symbol table subtype ~s" subtype)])])
+       (define (field-offset name)
+         (let loop ([flds flds] [addr (constant record-data-disp)])
+           (cond
+             [(null? flds) ($oops 'vfasl "could not find symbol hash table field ~s" name)]
+             [(eq? (fld-name (car flds)) name) addr]
+             [else (loop (cdr flds) (fx+ addr (constant ptr-bytes)))])))
+       (graph! v new-p vfi)
+       (set-ptr! new-p (constant record-type-disp) (make-vsingleton (constant singleton-symbol-ht-rtd)) vfi)
+       (set-ptr! new-p (field-offset 'type) (make-vsingleton (constant singleton-symbol-symbol)) vfi)
+       (set-ptr! new-p (field-offset 'mutable?) (if mutable? (constant strue) (constant sfalse)) vfi)
+       (set-ptr! new-p (field-offset 'vec) vec-p vfi)
+       (set-ptr! new-p (field-offset 'minlen) (fix minlen) vfi)
+       (set-ptr! new-p (field-offset 'size) (fix (vector-length vpfasl)) vfi)
+       (set-ptr! new-p (field-offset 'equiv?) equiv vfi)
+       (set-uptr! vec-p (constant vector-type-disp)
+                  (bitwise-ior (bitwise-arithmetic-shift-left veclen (constant vector-length-offset))
+                               (constant type-vector))
+                  vfi)
+       (let ([to-vec (make-vector veclen (constant snil))])
+         ;; first, determine what goes in each vector slot, building up
+         ;; pair copies for the vector slots:
+         (vector-for-each (lambda (p)
+                            (let* ([a (copy (car p) vfi)]
+                                   [b (copy (cdr p) vfi)]
+                                   [hc (or (fasl-case* (car p)
+                                             [(string ty string)
+                                              (and (eqv? ty (constant fasl-type-symbol))
+                                                   (target-symbol-hash (string->symbol string)))]
+                                             [(gensym pname uname)
+                                              (target-symbol-hash (gensym pname uname))]
+                                             [else #f])
+                                           ($oops 'vfasl "symbol table key not a symbol ~s" (car p)))]
+                                   [i (fxand hc (fx- veclen 1))])
+                              (vector-set! to-vec i (pair-copy (pair-copy a b vfi) (vector-ref to-vec i) vfi))))
+                          vpfasl)
+         ;; install the vector slots:
+         (let loop ([i 0])
+           (unless (fx= i veclen)
+             (set-ptr! vec-p (fx+ (constant vector-data-disp) (fx* i (constant ptr-bytes)))
+                       (vector-ref to-vec i)
+                       vfi)
+             (loop (fx+ i 1)))))
+       new-p)]
+    [(indirect g i) (copy (vector-ref g i) vfi)]
+    [else
+     ($oops 'vfasl "unsupported ~s" v)]))
+
+(define-syntax (vector-copy stx)
+  (syntax-case stx ()
+    [(_ v vec vfi
+        vec-length
+        vspace
+        header-size-vec data-disp
+        elem-bytes
+        tag
+        vec-type-disp
+        set-elem!
+        vec-ref)
+     #'(let* ([len (vec-length vec)]
+              [new-p (find-room 'vec-type-disp vfi
+                                (constant vspace)
+                                (fx+ (constant header-size-vec) (fx* len (constant elem-bytes)))
+                                (constant type-typed-object))])
+         (graph! v new-p vfi)
+         (set-uptr! new-p (constant vec-type-disp) tag vfi)
+         (let loop ([i 0])
+           (unless (fx= i len)
+             (set-elem! new-p (fx+ (constant data-disp) (fx* i (constant elem-bytes)))
+                        (vec-ref vec i)
+                        vfi)
+             (loop (fx+ i 1))))
+         new-p)]))
+
+(define (symbol-copy v name sym vfi)
+  (let ([v2 (eq-hashtable-ref (vfasl-info-symbols vfi) sym v)])
+    (cond
+      [(not (eq? v v2))
+       (copy v2 vfi)]
+      [else
+       (eq-hashtable-set! (vfasl-info-symbols vfi) sym v)
+       (let ([new-p (find-room 'symbol vfi
+                               (constant vspace-symbol)
+                               (constant size-symbol)
+                               (constant type-symbol))])
+         (graph! v new-p vfi)
+         (set-uptr! new-p (constant symbol-value-disp)
+                    ;; use value slot to store symbol index
+                    (fix (symbol-vptr->index new-p vfi))
+                    vfi)
+         (set-uptr! new-p (constant symbol-pvalue-disp) (constant snil) vfi)
+         (set-uptr! new-p (constant symbol-plist-disp) (constant snil) vfi)
+         (set-ptr! new-p (constant symbol-name-disp) name vfi)
+         (set-uptr! new-p (constant symbol-splist-disp) (constant snil) vfi)
+         (set-iptr! new-p (constant symbol-hash-disp) (fix (target-symbol-hash sym)) vfi)
+         new-p)])))
+
+(define target-symbol-hash
+  (let ([symbol-hashX (constant-case ptr-bits
+                        [(32) (foreign-procedure "(cs)symbol_hash32" (ptr) integer-32)]
+                        [(64) (foreign-procedure "(cs)symbol_hash64" (ptr) integer-64)])])
+    (lambda (s)
+      (bitwise-and (symbol-hashX (if (gensym? s)
+                                     (gensym->unique-string s)
+                                     (symbol->string s)))
+                   (constant most-positive-fixnum)))))
+
+(define (string-copy name vfi)
+  ;; interns `name` so that symbols and code share
+  (let ([s (or (hashtable-ref (vfasl-info-strings vfi) name #f)
+               (let ([s (fasl-string (constant fasl-type-immutable-string) name)])
+                 (hashtable-set! (vfasl-info-strings vfi) name s)
+                 s))])
+    (copy s vfi)))
+
+(define (pair-copy a d vfi)
+  (let* ([new-p (find-room 'pair vfi
+                           (constant vspace-impure)
+                           (constant size-pair)
+                           (constant type-pair))])
+    (set-ptr! new-p (constant pair-car-disp) a vfi)
+    (set-ptr! new-p (constant pair-cdr-disp) d vfi)
+    new-p))
+
+(define (exact-integer-copy v n vfi)
+  (if (<= (constant most-negative-fixnum) n (constant most-positive-fixnum))
+      (fix n)
+      (let ([len (fxquotient (fx+ (integer-length n) (fx- (constant bigit-bits) 1)) (constant bigit-bits))])
+        (vector-copy v n vfi
+                     (lambda (n) len)
+                     vspace-data
+                     header-size-bignum bignum-data-disp
+                     bigit-bytes
+                     (bitwise-ior (bitwise-arithmetic-shift-left len (constant bignum-length-offset))
+                                  (if (negative? n)
+                                      (constant type-negative-bignum)
+                                      (constant type-positive-bignum)))
+                     bignum-type-disp
+                     set-bigit!
+                     (lambda (n i)
+                       (let ([i (- len i 1)])
+                         (let ([i (fx* i (constant bigit-bits))])
+                           (bitwise-bit-field n i (fx+ i (constant bigit-bits))))))))))
+
+(define (base-rtd-copy v vfi)
+  (let ([new-p (or (vfasl-info-base-rtd vfi)
+                   (find-room 'base-rtd vfi
+                              (constant vspace-rtd)
+                              (constant size-record-type)
+                              (constant type-typed-object)))])
+    ;; this is a placeholder, and there's no need to write any content
+    (graph! v new-p vfi)
+    (vfasl-info-base-rtd-set! vfi new-p)
+    new-p))
+
+(define (refers-back-to-self? v rtd)
+  (or (eq? v rtd)
+      (fasl-case* rtd
+        [(indirect g i) (refers-back-to-self? v (vector-ref g i))]
+        [else #f])))
+
+(define (reloc-addr n)
+  (fx+ (constant reloc-table-data-disp) (fx* n (constant ptr-bytes))))
+
+(define (make-short-reloc type code-offset item-offset)
+  (bitwise-ior (bitwise-arithmetic-shift-left type (constant reloc-type-offset))
+               (bitwise-arithmetic-shift-left code-offset (constant reloc-code-offset-offset))
+               (bitwise-arithmetic-shift-left item-offset (constant reloc-item-offset-offset))))
+
+(define (build-vfasl-reloc tag pos)
+  (fix (bitwise-ior tag (bitwise-arithmetic-shift-left pos (constant vfasl-reloc-tag-bits)))))
+
+(define (copy-reloc m vreloc code-p vfi)
+  (let* ([new-p (find-room 'reloc vfi
+                           (constant vspace-reloc)
+                           (fx+ (constant header-size-reloc-table) (fx* m (constant ptr-bytes)))
+                           (constant typemod))])
+    (set-uptr! new-p (constant reloc-table-size-disp) m vfi)
+    (set-ptr!/no-record new-p (constant reloc-table-code-disp) code-p vfi)
+    (let loop ([n 0] [a 0] [i 0])
+      (unless (fx= n m)
+        (fasl-case* (vector-ref vreloc i)
+          [(reloc type-etc code-offset item-offset elem)
+           (let* ([type (fxsra type-etc 2)]
+                  [n (cond
+                       [(fxlogtest type-etc 1)
+                        (set-uptr! new-p (reloc-addr n)
+                                   (bitwise-ior (fxsll type (constant reloc-type-offset))
+                                                (constant reloc-extended-format))
+                                   vfi)
+                        (set-uptr! new-p (reloc-addr (fx+ n 1)) item-offset vfi)
+                        (set-uptr! new-p (reloc-addr (fx+ n 2)) code-offset vfi)
+                        (fx+ n 3)]
+                       [else
+                        (set-uptr! new-p (reloc-addr n)
+                                   (make-short-reloc type code-offset item-offset)
+                                   vfi)
+                        (fx+ n 1)])]
+                  [a (fx+ a code-offset)]
+                  [new-elem (or (fasl-case* elem
+                                  [(atom ty uptr)
+                                   (constant-case* ty
+                                     [(fasl-type-entry)
+                                      (when (eqv? uptr (lookup-c-entry install-library-entry))
+                                        (vfasl-info-installs-library-entry?-set! vfi #t))
+                                      (build-vfasl-reloc (constant vfasl-reloc-c-entry-tag) uptr)]
+                                     [(fasl-type-library)
+                                      (build-vfasl-reloc (constant vfasl-reloc-library-entry-tag) uptr)]
+                                     [(fasl-type-library-code)
+                                      (build-vfasl-reloc (constant vfasl-reloc-library-entry-code-tag) uptr)]
+                                     [else #f])]
+                                  [else #f])
+                                (let ([elem-addr (copy elem vfi)])
+                                  (cond
+                                    [(vsingleton? elem-addr)
+                                     (build-vfasl-reloc (constant vfasl-reloc-singleton-tag)
+                                                        (vsingleton-index elem-addr))]
+                                    [(vptr? elem-addr)
+                                     (cond
+                                       [(eqv? (vptr-vspace elem-addr) (constant vspace-symbol))
+                                        (build-vfasl-reloc (constant vfasl-reloc-symbol-tag)
+                                                           (symbol-vptr->index elem-addr vfi))]
+                                       [else
+                                        (let-values ([(bv offset) (vptr->bytevector+offset elem-addr vfi)])
+                                          (safe-assert (not (fixed? offset)))
+                                          (fx- offset (vfasl-info-base-addr vfi)))])]
+                                    [else
+                                     ;; an immediate value; for fixnums, we can only allow 0
+                                     (unless (or (eqv? elem-addr 0)
+                                                 (not (fixed? elem-addr)))
+                                       ($oops 'vfasl "unexpected fixnum in relocation ~s" elem-addr))
+                                     elem-addr])))])
+             ;; overwrites constant-loading instructions in the code, so the
+             ;; linking protocol needs to be able to deal with that, possibly using
+             ;; later instructions to infer the right repair:
+             (set-iptr! code-p a new-elem vfi)
+             (loop n a (fx+ i 1)))]
+          [else ($oops 'vfasl "expected a relocation")])))
+    new-p))
+
+(set! $fasl-to-vfasl to-vfasl)
+(set! $fasl-can-combine? fasl-can-combine?))
diff --git a/racket/src/cs/c/Makefile.in b/racket/src/cs/c/Makefile.in
index 5c2e73873cf..954a44b467c 100644
--- a/racket/src/cs/c/Makefile.in
+++ b/racket/src/cs/c/Makefile.in
@@ -220,13 +220,13 @@ raw_gracketcs: grmain.o boot.o $(BOOT_OBJ_DEPS)
 	@POST_LINKER@ raw_gracketcs
 
 petite-v.boot: $(SCHEME_TARGET_INC)/petite.boot
-	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ @TT_CROSS_MODE@ $(SCHEME_TARGET_INC)/petite.boot petite-v.boot
+	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ $(XPATCH@CROSS_MODE@) $(SCHEME_TARGET_INC)/petite.boot petite-v.boot
 
 scheme-v.boot: $(SCHEME_TARGET_INC)/scheme.boot
-	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ @TT_CROSS_MODE@ $(SCHEME_TARGET_INC)/scheme.boot scheme-v.boot petite
+	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ $(XPATCH@CROSS_MODE@) $(SCHEME_TARGET_INC)/scheme.boot scheme-v.boot petite
 
 racket-v.boot: racket.boot
-	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ @TT_CROSS_MODE@ racket.boot racket-v.boot petite scheme
+	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ $(XPATCH@CROSS_MODE@) racket.boot racket-v.boot petite scheme
 
 # ----------------------------------------
 # Mac OS
@@ -273,9 +273,9 @@ $(RKTFW): $(BOOT_OBJ_DEPS) $(BOOT_FILES)
 	rm -f Racket.framework/Racket
 	ln -s Versions/$(FWVERSION)_CS/Racket Racket.framework/Racket
 	mkdir -p Racket.framework/Versions/$(FWVERSION)_CS/boot
-	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ @TT_CROSS_MODE@ $(SCHEME_TARGET_INC)/petite.boot $(FW_BOOT_DEST)/petite.boot
-	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ @TT_CROSS_MODE@ $(SCHEME_TARGET_INC)/scheme.boot $(FW_BOOT_DEST)/scheme.boot petite
-	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ @TT_CROSS_MODE@ racket.boot $(FW_BOOT_DEST)/racket.boot petite scheme
+	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ $(XPATCH@CROSS_MODE@) $(SCHEME_TARGET_INC)/petite.boot $(FW_BOOT_DEST)/petite.boot
+	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ $(XPATCH@CROSS_MODE@) $(SCHEME_TARGET_INC)/scheme.boot $(FW_BOOT_DEST)/scheme.boot petite
+	$(SCHEME) --script $(srcdir)/to-vfasl.ss @BOOT_COMPRESS_COMP@ $(XPATCH@CROSS_MODE@) racket.boot $(FW_BOOT_DEST)/racket.boot petite scheme
 
 adjust-framework-boot-compress:
 	$(BOOTSTRAP_RACKET) $(srcdir)/adjust-compress.rkt @BOOT_COMPRESS_COMP@ $(FW_BOOT_DEST)/petite.boot $(FW_BOOT_DEST)/scheme.boot $(FW_BOOT_DEST)/racket.boot
diff --git a/racket/src/cs/c/check_boot.sh b/racket/src/cs/c/check_boot.sh
index 4d913f9d4cb..459ac2bb404 100644
--- a/racket/src/cs/c/check_boot.sh
+++ b/racket/src/cs/c/check_boot.sh
@@ -25,7 +25,6 @@ check_pb equates.h
 check_pb gc-ocd.inc
 check_pb gc-oce.inc
 check_pb gc-par.inc
-check_pb vfasl.inc
 check_pb heapcheck.inc
 
 check_mach()
@@ -46,5 +45,4 @@ check_mach equates.h
 check_mach gc-ocd.inc
 check_mach gc-oce.inc
 check_mach gc-par.inc
-check_mach vfasl.inc
 check_mach heapcheck.inc
diff --git a/racket/src/cs/c/ready_boot.sh b/racket/src/cs/c/ready_boot.sh
index 046f2dfd463..dba7a180b41 100644
--- a/racket/src/cs/c/ready_boot.sh
+++ b/racket/src/cs/c/ready_boot.sh
@@ -23,7 +23,6 @@ ready_mach equates.h
 ready_mach gc-ocd.inc
 ready_mach gc-oce.inc
 ready_mach gc-par.inc
-ready_mach vfasl.inc
 ready_mach heapcheck.inc
 
 rm -f boot_pending
diff --git a/racket/src/cs/c/reset_boot.sh b/racket/src/cs/c/reset_boot.sh
index 702f9d3c28a..29323ace9ad 100644
--- a/racket/src/cs/c/reset_boot.sh
+++ b/racket/src/cs/c/reset_boot.sh
@@ -26,4 +26,3 @@ ready_mach equates.h
 ready_mach gc-ocd.inc
 ready_mach gc-oce.inc
 ready_mach gc-par.inc
-ready_mach vfasl.inc
diff --git a/racket/src/cs/c/to-vfasl.ss b/racket/src/cs/c/to-vfasl.ss
index d24965e3815..72e7263413e 100644
--- a/racket/src/cs/c/to-vfasl.ss
+++ b/racket/src/cs/c/to-vfasl.ss
@@ -1,5 +1,4 @@
 (fasl-compressed #f)
-(define compile-cross? #f)
 
 (define-values (src dest deps)
   (let loop ([args (command-line-arguments)])
@@ -9,9 +8,10 @@
        (fasl-compressed #t)
        (loop (cdr args))]
       [(and (pair? args)
-            (equal? (car args) "--cross"))
-       (set! compile-cross? #t)
-       (loop (cdr args))]
+            (equal? (car args) "--xpatch")
+            (pair? (cdr args)))
+       (load (cadr args))
+       (loop (cddr args))]
       [(null? args)
        (error 'to-vfasl "missing src argument")]
       [(null? (cdr args))
@@ -19,17 +19,4 @@
       [else
        (values (car args) (cadr args) (cddr args))])))
 
-(cond
- [compile-cross?
-  (printf "Cross-compile cannot convert to vfasl; leaving as-is\n")
-  (let ([i (open-file-input-port src)]
-        [o (open-file-output-port dest (file-options no-fail))])
-    (let loop ()
-      (define c (get-u8 i))
-      (unless (eof-object? c)
-        (put-u8 o c)
-        (loop)))
-    (close-port i)
-    (close-port o))]
- [else
-  (vfasl-convert-file src dest deps)])
+(vfasl-convert-file src dest deps)
diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h
index 8995d86402b..f27fb327a09 100644
--- a/racket/src/version/racket_version.h
+++ b/racket/src/version/racket_version.h
@@ -16,7 +16,7 @@
 #define MZSCHEME_VERSION_X 7
 #define MZSCHEME_VERSION_Y 9
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 13
+#define MZSCHEME_VERSION_W 14
 
 /* A level of indirection makes `#` work as needed: */
 #define AS_a_STR_HELPER(x) #x