diff --git a/c/externs.h b/c/externs.h
index e10038dfd2..f52c4c4148 100644
--- a/c/externs.h
+++ b/c/externs.h
@@ -107,8 +107,8 @@ 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 S_bv_fasl_read PROTO((ptr bv, int ty, uptr offset, uptr len, ptr path));
+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));
diff --git a/c/fasl.c b/c/fasl.c
index 1536c91e40..74e07aa57b 100644
--- a/c/fasl.c
+++ b/c/fasl.c
@@ -218,8 +218,8 @@ typedef struct faslFileObj {
 static INT uf_read PROTO((unbufFaslFile uf, octet *s, iptr n));
 static octet uf_bytein PROTO((unbufFaslFile uf));
 static uptr uf_uptrin PROTO((unbufFaslFile uf, INT *bytes_consumed));
-static ptr fasl_entry PROTO((ptr tc, IFASLCODE situation, unbufFaslFile uf));
-static ptr bv_fasl_entry PROTO((ptr tc, ptr bv, IFASLCODE ty, uptr offset, uptr len, unbufFaslFile uf));
+static ptr fasl_entry PROTO((ptr tc, IFASLCODE situation, unbufFaslFile uf, ptr externals));
+static ptr bv_fasl_entry PROTO((ptr tc, ptr bv, IFASLCODE ty, uptr offset, uptr len, unbufFaslFile uf, ptr externals));
 static void fillFaslFile PROTO((faslFile f));
 static void bytesin PROTO((octet *s, iptr n, faslFile f));
 static void toolarge PROTO((ptr path));
@@ -298,7 +298,7 @@ void S_fasl_init() {
 #endif
 }
 
-ptr S_fasl_read(INT fd, IFASLCODE situation, ptr path) {
+ptr S_fasl_read(INT fd, IFASLCODE situation, ptr path, ptr externals) {
   ptr tc = get_thread_context();
   ptr x; struct unbufFaslFileObj uffo;
 
@@ -307,12 +307,12 @@ ptr S_fasl_read(INT fd, IFASLCODE situation, ptr path) {
   uffo.path = path;
   uffo.type = UFFO_TYPE_FD;
   uffo.fd = fd;
-  x = fasl_entry(tc, situation, &uffo);
+  x = fasl_entry(tc, situation, &uffo, externals);
   tc_mutex_release()
   return x;
 }
 
-ptr S_bv_fasl_read(ptr bv, int ty, uptr offset, uptr len, ptr path) {
+ptr S_bv_fasl_read(ptr bv, int ty, uptr offset, uptr len, ptr path, ptr externals) {
   ptr tc = get_thread_context();
   ptr x; struct unbufFaslFileObj uffo;
 
@@ -320,7 +320,7 @@ ptr S_bv_fasl_read(ptr bv, int ty, uptr offset, uptr len, ptr path) {
   tc_mutex_acquire()
   uffo.path = path;
   uffo.type = UFFO_TYPE_BV;
-  x = bv_fasl_entry(tc, bv, ty, offset, len, &uffo);
+  x = bv_fasl_entry(tc, bv, ty, offset, len, &uffo, externals);
   tc_mutex_release()
   return x;
 }
@@ -332,7 +332,7 @@ ptr S_boot_read(INT fd, const char *path) {
   uffo.path = Sstring_utf8(path, -1);
   uffo.type = UFFO_TYPE_FD;
   uffo.fd = fd;
-  return fasl_entry(tc, fasl_type_visit_revisit, &uffo);
+  return fasl_entry(tc, fasl_type_visit_revisit, &uffo, S_G.null_vector);
 }
 
 #ifdef WIN32
@@ -432,7 +432,7 @@ char *S_lookup_machine_type(uptr n) {
     return "unknown";
 }
 
-static ptr fasl_entry(ptr tc, IFASLCODE situation, unbufFaslFile uf) {
+static ptr fasl_entry(ptr tc, IFASLCODE situation, unbufFaslFile uf, ptr externals) {
   ptr x; ptr strbuf = S_G.null_string;
   octet tybuf[1]; IFASLCODE ty; iptr size;
   /* gcc (GCC) 4.8.5 20150623 (Red Hat 4.8.5-28) co-locates buf and x if we put the declaration of buf down where we use it */
@@ -534,7 +534,7 @@ static ptr fasl_entry(ptr tc, IFASLCODE situation, unbufFaslFile uf) {
       }
       switch (kind) {
         case fasl_type_fasl:
-          faslin(tc, &x, S_G.null_vector, &strbuf, &ffo);          
+          faslin(tc, &x, externals, &strbuf, &ffo);
           break;
         case fasl_type_vfasl:
           x = S_vfasl(bv, uf, 0, ffo.size);
@@ -551,7 +551,7 @@ static ptr fasl_entry(ptr tc, IFASLCODE situation, unbufFaslFile uf) {
   }
 }
 
-static ptr bv_fasl_entry(ptr tc, ptr bv, int ty, uptr offset, uptr len, unbufFaslFile uf) {
+static ptr bv_fasl_entry(ptr tc, ptr bv, int ty, uptr offset, uptr len, unbufFaslFile uf, ptr externals) {
   ptr x; ptr strbuf = S_G.null_string;
   struct faslFileObj ffo;
 
@@ -563,7 +563,7 @@ static ptr bv_fasl_entry(ptr tc, ptr bv, int ty, uptr offset, uptr len, unbufFas
     ffo.end = &BVIT(bv, offset + len);
     ffo.uf = uf;
     
-    faslin(tc, &x, S_G.null_vector, &strbuf, &ffo);
+    faslin(tc, &x, externals, &strbuf, &ffo);
   } else {
     S_error1("", "bad entry type (got ~s)", FIX(ty));
   }
@@ -1053,9 +1053,16 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) {
         case fasl_type_phantom:
             *x = S_phantom_bytevector(uptrin(f));
             return;
-        case fasl_type_graph:
-            faslin(tc, x, S_vector(uptrin(f)), pstrbuf, f);
+        case fasl_type_graph: {
+            uptr len = uptrin(f), len2, i;
+            ptr new_t = S_vector(len);
+            len2 = Svector_length(t);
+            if (len2 > len) len2 = len;
+            for (i = 0; i < len2; i++)
+              INITVECTIT(new_t, i+(len-len2)) = Svector_ref(t, i);
+            faslin(tc, x, new_t, pstrbuf, f);
             return;
+        }
         case fasl_type_graph_def: {
             ptr *p;
             p = &INITVECTIT(t, uptrin(f));
diff --git a/csug/io.stex b/csug/io.stex
index 4678fab109..6551eb86af 100644
--- a/csug/io.stex
+++ b/csug/io.stex
@@ -3379,17 +3379,32 @@ input port, must be used instead.
 %----------------------------------------------------------------------------
 \entryheader
 \formdef{fasl-write}{\categoryprocedure}{(fasl-write \var{obj} \var{binary-output-port})}
+\formdef{fasl-write}{\categoryprocedure}{(fasl-write \var{obj} \var{binary-output-port} \var{external-pred})}
 \returns unspecified
 \listlibraries
 \endentryheader
 
 \noindent
+If \var{externals-pred} is provided, it must be a procedure or \scheme{#f}.
+
 \scheme{fasl-write} writes the fasl representation of \var{obj} to
 \var{binary-output-port}.
 An exception is raised with condition-type \scheme{&assertion} if
 \var{obj} or any portion of \var{obj} has no external fasl representation,
 e.g., if \var{obj} is or contains a procedure.
 
+If \var{externals-pred} is provided and not \scheme{#f}, then it is
+applied to each distinct object encountered in \var{obj}. If
+\var{externals-pred} returns true for an object, that object is not
+written to the fasl representation. Instead, a placeholder is written
+containing as position as the number of preceding calls to
+\var{externals-pred} that had returned true. Typically, for each
+object where it returns true, \var{externals-pred} saves the object
+through its closure. When the fasl representation is read with
+\scheme{fasl-read}, a vector with as many items as generated positions
+must be provided, and each placeholder is replaced with the
+corresponding vector element.
+
 The fasl representation of \var{obj} is compressed if the parameter
 \scheme{fasl-compressed}, described below, is set to \scheme{#t},
 its default value.
@@ -3415,14 +3430,16 @@ fasl objects from a compressed file.
 \entryheader
 \formdef{fasl-read}{\categoryprocedure}{(fasl-read \var{binary-input-port})}
 \formdef{fasl-read}{\categoryprocedure}{(fasl-read \var{binary-input-port \var{situation}})}
+\formdef{fasl-read}{\categoryprocedure}{(fasl-read \var{binary-input-port \var{situation} \var{externals}})}
 \returns unspecified
 \listlibraries
 \endentryheader
 
 \noindent
 If present, \var{situation} must be one of the symbols \scheme{load},
-\scheme{visit}, or \scheme{revisit}.
-It defaults to \scheme{load}.
+\scheme{visit}, or \scheme{revisit}, and it defaults to \scheme{load}.
+If present, \var{exterrnals} must be a vector, and it defaults to
+\scheme{'#()}.
 
 \scheme{fasl-read} reads one object from
 \var{binary-input-port}, which must be positioned at the
@@ -3439,6 +3456,11 @@ corresponding to source code within an \scheme{eval-when} form with
 situation \scheme{load} or situations \scheme{visit} and \scheme{revisit})
 are never skipped.
 
+The \var{externals} vector should have the same length as the number
+of true-returning calls to \var{external-pred} during the
+\scheme{fasl-write} call that produced the fasl rrepresentation. See
+\scheme{fasl-write} for more information.
+
 \scheme{fasl-read} automatically decompresses the representation
 of each fasl object written in compressed format by \scheme{fasl-write}.
 Thus, \var{binary-input-port} generally should not be opened with
diff --git a/csug/syntax.stex b/csug/syntax.stex
index d3f67ebd15..11bdff4bf2 100644
--- a/csug/syntax.stex
+++ b/csug/syntax.stex
@@ -1613,7 +1613,7 @@ source file to make sure that the proper file has been found and
 has not been modified.
 Source-file descriptors can be created with
 \index{\scheme{make-source-file-descriptor}}\scheme{make-source-file-descriptor},
-which accepts two arguments: a string naming the path and a binary
+which accepts two arguments: an object (usually a string) naming the path and a binary
 input port, along with an optional third boolean argument, \var{reset?},
 which defaults to false.
 \scheme{make-source-file-descriptor} computes a checksum based on
@@ -1642,8 +1642,8 @@ and described in more detail later in this section.
 (source-object-line \var{source-object}) ;-> \var{uint} or #f
 (source-object-column \var{source-object}) ;-> \var{uint} or #f
 
-(make-source-file-descriptor \var{string} \var{binary-input-port}) ;-> \var{sfd}
-(make-source-file-descriptor \var{string} \var{binary-input-port} \var{reset?}) ;-> \var{sfd}
+(make-source-file-descriptor \var{obj} \var{binary-input-port}) ;-> \var{sfd}
+(make-source-file-descriptor \var{obj} \var{binary-input-port} \var{reset?}) ;-> \var{sfd}
 (source-file-descriptor? \var{obj}) ;-> \var{boolean}
 (source-file-descriptor-checksum \var{sfd}) ;-> \var{obj}
 (source-file-descriptor-path \var{sfd}) ;-> \var{obj}
@@ -1836,8 +1836,8 @@ to a file-position object, instead of delaying the conversion to
 
 %----------------------------------------------------------------------------
 \entryheader
-\formdef{make-source-file-descriptor}{\categoryprocedure}{(make-source-file-descriptor \var{string} \var{binary-input-port})}
-\formdef{make-source-file-descriptor}{\categoryprocedure}{(make-source-file-descriptor \var{string} \var{binary-input-port} \var{reset?})}
+\formdef{make-source-file-descriptor}{\categoryprocedure}{(make-source-file-descriptor \var{obj} \var{binary-input-port})}
+\formdef{make-source-file-descriptor}{\categoryprocedure}{(make-source-file-descriptor \var{obj} \var{binary-input-port} \var{reset?})}
 \returns a source-file descriptor
 \listlibraries
 \endentryheader
@@ -1870,16 +1870,17 @@ Otherwise, it is left pointing at end-of-file.
 \listlibraries
 \endentryheader
 
-\var{sfd} must be a source-file descriptor.
+\var{sfd} must be a source-file descriptor. The result is typically a string, but a
+source file descriptor can have any value representing a path.
 
 %----------------------------------------------------------------------------
 \entryheader
-\formdef{source-file-descriptor}{\categoryprocedure}{(source-file-descriptor \var{path} \var{checksum})}
+\formdef{source-file-descriptor}{\categoryprocedure}{(source-file-descriptor \var{obj} \var{checksum})}
 \returns a new source-file-descriptor
 \listlibraries
 \endentryheader
 
-\var{path} must be a string, and \var{checksum} must be an exact nonnegative integer.
+\var{checksum} must be an exact nonnegative integer.
 This procedure can be used to construct custom source-file descriptors or to reconstitute
 source-file descriptors from the \var{path} and \var{checksum} components.
 
@@ -1958,7 +1959,7 @@ exact nonnegative integer.
 This procedure either uses cached information from a previous
 request for \var{sfd} (only when \var{use-cache?} is provided as true)
 or attempts to locate and open the source file identified
-by \var{sfd}.
+by \var{sfd} (which can only work when its path is a string).
 If successful, it returns three values: a string \var{path}, an exact
 nonnegative integer \var{line}, and an exact nonnegative integer \var{char}
 representing the absolute pathname, line, and character position within
diff --git a/csug/system.stex b/csug/system.stex
index ba426df45c..78d3b1a2bf 100644
--- a/csug/system.stex
+++ b/csug/system.stex
@@ -1031,6 +1031,7 @@ will occur when the files are actually loaded.
 %----------------------------------------------------------------------------
 \entryheader
 \formdef{load-compiled-from-port}{\categoryprocedure}{(load-compiled-from-port \var{input-port})}
+\formdef{load-compiled-from-port}{\categoryprocedure}{(load-compiled-from-port \var{input-port} \var{externals})}
 \returns result of the last compiled expression
 \listlibraries
 \endentryheader
@@ -1041,6 +1042,11 @@ of \var{input-port} as previously created by functions like \scheme{compile-file
 \scheme{compile-script}, \scheme{compile-library}, and
 \scheme{compile-to-port}.
 
+The \var{externals} argument, if supplied, must be a vector. It should
+cooperate with an \var{external-pred} procedure passed to
+\scheme{compile-to-port}, analogous to the way a procedure and vector
+cooperate with \scheme{fasl-write} and \scheme{fasl-read}.
+
 The return value is the value of the last expression whose compiled
 form is in \var{input-port}. If \var{input-port} is empty, then the
 result value is unspecified.
@@ -1520,6 +1526,7 @@ will take care of closing the ports.
 \formdef{compile-to-port}{\categoryprocedure}{(compile-to-port \var{obj-list} \var{output-port} \var{sfd})}
 \formdef{compile-to-port}{\categoryprocedure}{(compile-to-port \var{obj-list} \var{output-port} \var{sfd} \var{wpo-port})}
 \formdef{compile-to-port}{\categoryprocedure}{(compile-to-port \var{obj-list} \var{output-port} \var{sfd} \var{wpo-port} \var{covop})}
+\formdef{compile-to-port}{\categoryprocedure}{(compile-to-port \var{obj-list} \var{output-port} \var{sfd} \var{wpo-port} \var{covop} \var{external-pred})}
 \returns see below
 \listlibraries
 \endentryheader
@@ -1533,6 +1540,8 @@ expression, \scheme{compile-to-port} raises an exception with
 condition type \scheme{&syntax}.
 \var{output-port} and, if present, \var{wpo-port} must be binary output ports.
 If present, \var{sfd} must be a source-file descriptor.
+If present, \var{external-pred} must be \scheme{#f} or a procedure,
+and it must be \scheme{#f} if \var{obj-list} does not have exactlty one element.
 
 \scheme{compile-to-port} is like \scheme{compile-file} except that it takes
 input from a list of objects and sends output to an arbitrary binary
@@ -1549,6 +1558,12 @@ The ports are not closed automatically after compilation under the assumption
 the program that opens the port and invokes \scheme{compile-to-port}
 will take care of closing the port.
 
+If \var{external-pred} is present and not \scheme{#f}, it is used like
+the predicate supplied to \scheme{fasl-write}. In that case, a
+corresponding vector must be provided to
+\scheme{load-compiled-from-port} to load the compiled code, analogous
+to the vector supplied to \scheme{fasl-read}.
+
 When \var{obj-list} contains a single list-structured element whose
 first-element is the symbol \scheme{top-level-program},
 \scheme{compile-to-port} returns a list of the libraries the top-level
diff --git a/makefiles/Mf-install.in b/makefiles/Mf-install.in
index 9f4ffc6b98..c588187ad5 100644
--- a/makefiles/Mf-install.in
+++ b/makefiles/Mf-install.in
@@ -62,7 +62,7 @@ InstallLZ4Target=
 #                 no changes should be needed below this point                #
 ###############################################################################
 
-Version=csv9.5.3.33
+Version=csv9.5.3.34
 Include=boot/$m
 PetiteBoot=boot/$m/petite.boot
 SchemeBoot=boot/$m/scheme.boot
diff --git a/mats/6.ms b/mats/6.ms
index 0db61d95ac..882be24f96 100644
--- a/mats/6.ms
+++ b/mats/6.ms
@@ -993,6 +993,18 @@
           (weak-pair? (cddr ls))
           (weak-pair? (cdddr ls)))))
     '(#t #f #t #t #f #t))
+
+  (error? (fasl-write 'any (let-values ([(o get) (open-bytevector-output-port)]) o) '#()))
+  (error? (fasl-write 'any (let-values ([(o get) (open-bytevector-output-port)]) o) 10))
+  (error? (fasl-read (open-bytevector-input-port #vu8()) 'load #f))
+  (error? (fasl-read (open-bytevector-input-port #vu8()) 'load 10))
+  
+  (let-values ([(o get) (open-bytevector-output-port)])
+    (fasl-write '(apple (banana cream pie) (vector coconut banana cream)) o (lambda (v)
+                                                                              (or (eq? v 'banana)
+                                                                                  (eq? v 'coconut))))
+    (equal? '(apple (B cream pie) (vector C B cream))
+            (fasl-read (open-bytevector-input-port (get)) 'load '#(B C))))
 )
 
 (mat fasl-depth
diff --git a/mats/7.ms b/mats/7.ms
index 4ff2686c9f..01667fdefa 100644
--- a/mats/7.ms
+++ b/mats/7.ms
@@ -113,7 +113,7 @@
  )
 
 (mat load-compiled-from-port
-  (begin
+  (let ()
     (define-values (o get) (open-bytevector-output-port))
     (compile-to-port '((define lcfp1 'worked) 'loaded) o)
     (eq? 'loaded (load-compiled-from-port (open-bytevector-input-port (get)))))
@@ -138,6 +138,12 @@
   (equal?
     (with-output-to-string (lambda () (printf "result = ~s\n" (revisit-compiled-from-port (open-bytevector-input-port lcfp-bv)))))
     "revisit\nvisit-revisit\nresult = revisit-return\n")
+
+  
+  (let ()
+    (define-values (o get) (open-bytevector-output-port))
+    (compile-to-port '((lambda () 'banana)) o #f #f #f (machine-type) #f (lambda (v) (eq? v 'banana)))
+    (eq? 'apple ((load-compiled-from-port (open-bytevector-input-port (get)) '#(apple)))))
 )
 
 (mat compile-to-file
diff --git a/mats/8.ms b/mats/8.ms
index 25f3fdea10..2992b4f073 100644
--- a/mats/8.ms
+++ b/mats/8.ms
@@ -11356,8 +11356,8 @@
  )
 
 (mat annotations
-  (error? ; #f is not a string
-    (make-source-file-descriptor #f
+  (source-file-descriptor?
+    (make-source-file-descriptor #f ; anything is allowed as a path
       (open-bytevector-input-port (string->utf8 "hello"))))
   (error? ; 17 is not a binary-input port
     (make-source-file-descriptor "foo" 17))
@@ -11584,7 +11584,7 @@
   (eq? (source-object-sfd source) sfd)
   (eqv? (source-object-bfp source) 0)
   (eqv? (source-object-efp source) (string-length str))
-  (error? ; not a string
+  (source-file-descriptor?
     (source-file-descriptor 'spam 0))
   (error? ; not an exact nonnegative integer
     (source-file-descriptor "spam" -1))
@@ -11605,6 +11605,7 @@
   (error? ; not an exact nonnegative integer
     (locate-source sfd 'a))
   (let-values ([() (locate-source sfd 7)]) #t)
+  (let-values ([() (locate-source (source-file-descriptor 'something-else 0) 7)]) #t)
   (begin
     (with-output-to-file "testfile.ss"
       (lambda ()
diff --git a/mats/root-experr-compile-0-f-f-f b/mats/root-experr-compile-0-f-f-f
index dd57ce0dec..c57fdd61a8 100644
--- a/mats/root-experr-compile-0-f-f-f
+++ b/mats/root-experr-compile-0-f-f-f
@@ -33,6 +33,8 @@ primvars.mo:Expected error testing (fxpopcount (quote #!eof)): Exception in fxpo
 primvars.mo:Expected error testing (fxpopcount (quote #f)): Exception in fxpopcount32: #f is not a non-negative fixnum
 primvars.mo:Expected error testing (hashtable-cells (quote ((a . b)))): Exception in hashtable-size: ((a . b)) is not a hashtable
 primvars.mo:Expected error testing (hashtable-cells (quote #f)): Exception in hashtable-size: #f is not a hashtable
+primvars.mo:Expected error testing (load-compiled-from-port 1.0+2.0i (quote "a")): Exception in load-compiled-from-port: 1.0+2.0i is not a binary input port
+primvars.mo:Expected error testing (load-compiled-from-port 1.0+2.0i (quote #f)): Exception in load-compiled-from-port: 1.0+2.0i is not a binary input port
 primvars.mo:Expected error testing (make-input-port (quote 0) "a"): Exception in make-input-port: fixnum handler no longer supported; use open-fd-input-port
 primvars.mo:Expected error testing (make-input/output-port (quote 0) "a" "a"): Exception in make-input/output-port: fixnum handler no longer supported; use open-fd-input-port
 primvars.mo:Expected error testing (make-output-port (quote 0) "a"): Exception in make-output-port: fixnum handler no longer supported; use open-fd-input-port
@@ -4452,6 +4454,10 @@ cp0.mo:Expected error in mat expand/optimize-output: "expand/optimize-output: #<
 6.mo:Expected error in mat pretty-print: "pretty-format: invalid format (bad 0 ... ... 0 format)".
 6.mo:Expected error in mat fasl: "separate-eval: Warning in fasl-write: fasl file content is compressed internally; compressing the file (#<binary output port testfile.ss>) is redundant and can slow fasl writing and reading significantly
 6.mo:Expected error in mat fasl: "separate-eval: Warning in fasl-read: fasl file content is compressed internally; compressing the file (#<binary input port testfile.ss>) is redundant and can slow fasl writing and reading significantly
+6.mo:Expected error in mat fasl: "fasl-write: #() is not #f or a procedure".
+6.mo:Expected error in mat fasl: "fasl-write: 10 is not #f or a procedure".
+6.mo:Expected error in mat fasl: "fasl-read: not a vector #f".
+6.mo:Expected error in mat fasl: "fasl-read: not a vector 10".
 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format".
 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~a~a~a~s" in call to format".
 6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "~a~~~s" in call to format at line 1, char 28 of testfile.ss".
@@ -8951,7 +8957,6 @@ enum.mo:Expected error in mat enumeration: "make-record-type: cannot extend seal
 8.mo:Expected error in mat top-level-syntax-functions: "define-top-level-syntax: cannot modify immutable environment #<environment>".
 8.mo:Expected error in mat top-level-syntax-functions: "top-level-syntax: p is not defined".
 8.mo:Expected error in mat top-level-syntax-functions: "top-level-syntax: cond is not defined".
-8.mo:Expected error in mat annotations: "make-source-file-descriptor: #f is not a string".
 8.mo:Expected error in mat annotations: "make-source-file-descriptor: 17 is not a binary input port".
 8.mo:Expected error in mat annotations: "make-source-file-descriptor: #<input port string> is not a binary input port".
 8.mo:Expected error in mat annotations: "make-source-file-descriptor: #<binary input port foo> does not support port-position and set-port-position!".
@@ -9005,7 +9010,6 @@ enum.mo:Expected error in mat enumeration: "make-record-type: cannot extend seal
 8.mo:Expected error in mat annotations: "get-datum/annotations: #<sfd foo> is not a valid file position".
 8.mo:Expected error in mat annotations: "get-datum/annotations: -5 is not a valid file position".
 8.mo:Expected error in mat annotations: "get-datum/annotations: 5.0 is not a valid file position".
-8.mo:Expected error in mat annotations: "source-file-descriptor: spam is not a string".
 8.mo:Expected error in mat annotations: "source-file-descriptor: -1 is not an exact nonnegative integer".
 8.mo:Expected error in mat annotations: "source-file-descriptor: 1.0 is not an exact nonnegative integer".
 8.mo:Expected error in mat annotations: "locate-source: "spam" is not a source-file descriptor".
diff --git a/s/7.ss b/s/7.ss
index c2f618ca88..447c1ad63d 100644
--- a/s/7.ss
+++ b/s/7.ss
@@ -134,8 +134,8 @@
 
 (set-who! fasl-read
   (let ()
-    (define $fasl-read (foreign-procedure "(cs)fasl_read" (int fixnum ptr) ptr))
-    (define $bv-fasl-read (foreign-procedure "(cs)bv_fasl_read" (ptr int uptr uptr ptr) ptr))
+    (define $fasl-read (foreign-procedure "(cs)fasl_read" (int fixnum ptr ptr) ptr))
+    (define $bv-fasl-read (foreign-procedure "(cs)bv_fasl_read" (ptr int uptr uptr ptr ptr) ptr))
     (define (get-uptr p)
       (let ([k (get-u8 p)])
         (let f ([k k] [n (fxand k #x7F)])
@@ -190,13 +190,13 @@
              ;; Call `get-bytevector-n`, etc. with interrupts reenabled
              (lambda ()
                (proc (get-bytevector-n p len) 0))])))))
-    (define (go p situation)
+    (define (go p situation externals)
       (define (go1)
         (if (and ($port-flags-set? p (constant port-flag-file))
                  (or (not ($port-flags-set? p (constant port-flag-compressed)))
                      (begin ($compressed-warning who p) #f))
                  (eqv? (binary-port-input-count p) 0))
-            ($fasl-read ($port-info p) situation (port-name p))
+            ($fasl-read ($port-info p) situation (port-name p) externals)
             (let fasl-entry ()
               (let ([ty (get-u8 p)])
                 (cond
@@ -232,26 +232,31 @@
                                       (if (eqv? compressed-flag (constant fasl-type-gzip))
                                           (constant COMPRESS-GZIP)
                                           (constant COMPRESS-LZ4)))))])
-                       ($bv-fasl-read bv kind 0 dest-size (port-name p))))]
+                       ($bv-fasl-read bv kind 0 dest-size (port-name p) externals)))]
                   [(eqv? compressed-flag (constant fasl-type-uncompressed))
                    (let ([len (- n 2)])
                      (call-with-bytevector-and-offset
                       p len
                       (lambda (bv offset)
-                        ($bv-fasl-read bv kind offset len (port-name p)))))]
+                        ($bv-fasl-read bv kind offset len (port-name p) externals))))]
                   [else (malformed p "invalid compression")])))))
       (unless (and (input-port? p) (binary-port? p))
         ($oops who "~s is not a binary input port" p))
       (go1))
+    (define (parse-situation situation)
+      (case situation
+        [(visit) (constant fasl-type-visit)]
+        [(revisit) (constant fasl-type-revisit)]
+        [(load) (constant fasl-type-visit-revisit)]
+        [else ($oops who "invalid situation ~s" situation)]))
     (case-lambda
-      [(p) (go p (constant fasl-type-visit-revisit))]
-      [(p situation)
-       (go p
-         (case situation
-           [(visit) (constant fasl-type-visit)]
-           [(revisit) (constant fasl-type-revisit)]
-           [(load) (constant fasl-type-visit-revisit)]
-           [else ($oops who "invalid situation ~s" situation)]))])))
+      [(p) (go p (constant fasl-type-visit-revisit) '#())]
+      [(p situation) (go p (parse-situation situation) '#())]
+      [(p situation externals)
+       (let ([situation (parse-situation situation)])
+         (unless (vector? externals)
+           ($oops who "not a vector ~s" externals))
+         (go p situation externals))])))
 
 (define ($compiled-file-header? ip)
   (let ([pos (port-position ip)])
@@ -265,12 +270,12 @@
 
 (let ()
   (define do-load-binary
-    (lambda (who fn ip situation for-import? importer)
+    (lambda (who fn ip situation for-import? importer externals)
       (let ([load-binary (make-load-binary who fn situation for-import? importer)])
-        (let ([x (fasl-read ip situation)])
+        (let ([x (fasl-read ip situation externals)])
           (unless (eof-object? x)
             (let loop ([x x])
-              (let ([next-x (fasl-read ip situation)])
+              (let ([next-x (fasl-read ip situation externals)])
                 (if (eof-object? next-x)
                     (load-binary x)
                     (begin (load-binary x) (loop next-x))))))))))
@@ -323,7 +328,7 @@
                         (begin (set-port-position! ip start-pos) 0)))])
           (if ($compiled-file-header? ip)
               (begin
-                (do-load-binary who fn ip situation for-import? importer)
+                (do-load-binary who fn ip situation for-import? importer '#())
                 (close-port ip))
               (begin
                 (unless ksrc
@@ -341,22 +346,27 @@
       (make-load-binary '$make-load-binary fn 'load #f #f)))
 
   (set-who! load-compiled-from-port
-    (lambda (ip)
-      (unless (and (input-port? ip) (binary-port? ip))
-        ($oops who "~s is not a binary input port" ip))
-      (do-load-binary who (port-name ip) ip 'load #f #f)))
+    (rec load-compiled-from-port
+      (case-lambda
+       [(ip) (load-compiled-from-port ip '#())]
+       [(ip externals)
+        (unless (and (input-port? ip) (binary-port? ip))
+          ($oops who "~s is not a binary input port" ip))
+        (unless (vector? externals)
+          ($oops who "~s is not a vector" ip))
+        (do-load-binary who (port-name ip) ip 'load #f #f externals)])))
 
   (set-who! visit-compiled-from-port
     (lambda (ip)
       (unless (and (input-port? ip) (binary-port? ip))
         ($oops who "~s is not a binary input port" ip))
-      (do-load-binary who (port-name ip) ip 'visit #f #f)))
+      (do-load-binary who (port-name ip) ip 'visit #f #f '#())))
 
   (set-who! revisit-compiled-from-port
     (lambda (ip)
       (unless (and (input-port? ip) (binary-port? ip))
         ($oops who "~s is not a binary input port" ip))
-      (do-load-binary who (port-name ip) ip 'revisit #f #f)))
+      (do-load-binary who (port-name ip) ip 'revisit #f #f '#())))
 
   (set-who! load-program
     (rec load-program
diff --git a/s/cmacros.ss b/s/cmacros.ss
index ab43c68dd8..4445a8c250 100644
--- a/s/cmacros.ss
+++ b/s/cmacros.ss
@@ -348,7 +348,7 @@
 ;; ---------------------------------------------------------------------
 ;; Version and machine types:
 
-(define-constant scheme-version #x09050321)
+(define-constant scheme-version #x09050322)
 
 (define-syntax define-machine-types
   (lambda (x)
diff --git a/s/compile.ss b/s/compile.ss
index 751068a838..94376da826 100644
--- a/s/compile.ss
+++ b/s/compile.ss
@@ -457,8 +457,8 @@
                          [else (c-assembler-output-error c)])]))))))]
       [else (c-assembler-output-error x)])))
 
-(define (c-print-fasl x p situation)
-  (let ([t ($fasl-table)]
+(define (c-print-fasl x p situation external?-pred)
+  (let ([t ($fasl-table external?-pred)]
         [a? (let ([flags (fxlogor
                            (if (generate-inspector-information) (constant annotation-debug) 0)
                            (if (eq? ($compile-profile) 'source) (constant annotation-profile) 0))])
@@ -520,7 +520,7 @@
         x)))
 
 (define compile-file-help
-  (lambda (op hostop wpoop source-table machine sfd do-read outfn)
+  (lambda (op hostop wpoop source-table machine sfd do-read outfn external?-pred)
     (parameterize ([$target-machine machine]
                    [$sfd sfd]
                    [$current-mso ($current-mso)]
@@ -548,7 +548,7 @@
       (let cfh0 ([n 1] [rrcinfo** '()] [rlpinfo** '()] [rfinal** '()])
         (let ([x0 ($pass-time 'read do-read)])
           (if (eof-object? x0)
-              (compile-file-help2 op (reverse rrcinfo**) (reverse rlpinfo**) (reverse rfinal**))
+              (compile-file-help2 op (reverse rrcinfo**) (reverse rlpinfo**) (reverse rfinal**) external?-pred)
               (let ()
                 (define source-info-string
                   (and (or ($assembly-output) (expand-output) (expand/optimize-output))
@@ -748,7 +748,7 @@
               [else (finish-compile x1 values)]))))))
 
 (define compile-file-help2
-  (lambda (op rcinfo** lpinfo** final**)
+  (lambda (op rcinfo** lpinfo** final** external?-pred)
     (define (libreq-hash x) (symbol-hash (libreq-uid x)))
     (define (libreq=? x y) (eq? (libreq-uid x) (libreq-uid y)))
     (let ([import-ht (make-hashtable libreq-hash libreq=?)]
@@ -767,18 +767,19 @@
         rcinfo**)
       (let ([import-req* (vector->list (hashtable-keys import-ht))]
             [include-req* (vector->list (hashtable-keys include-ht))])
-        ; the first entry is always a recompile-info record with recompile information for the entire object file
+        ; the first entry is always, if needed, a recompile-info record with recompile information for the entire object file
         ($pass-time 'pfasl
           (lambda ()
-            (c-print-fasl `(object ,(make-recompile-info import-req* include-req*)) op (constant fasl-type-visit-revisit))
+            (unless (and (compile-omit-concatenate-support) (null? import-req*) (null? include-req*))
+              (c-print-fasl `(object ,(make-recompile-info import-req* include-req*)) op (constant fasl-type-visit-revisit) #f))
             (for-each
               (lambda (final*)
                 (for-each
                   (lambda (x)
                     (record-case x
-                      [(visit-stuff) x (c-print-fasl x op (constant fasl-type-visit))]
-                      [(revisit-stuff) x (c-print-fasl x op (constant fasl-type-revisit))]
-                      [else (c-print-fasl x op (constant fasl-type-visit-revisit))]))
+                      [(visit-stuff) x (c-print-fasl x op (constant fasl-type-visit) external?-pred)]
+                      [(revisit-stuff) x (c-print-fasl x op (constant fasl-type-revisit) external?-pred)]
+                      [else (c-print-fasl x op (constant fasl-type-visit-revisit) external?-pred)]))
                   final*))
               (append lpinfo**
                       (if (compile-omit-concatenate-support)
@@ -857,7 +858,7 @@
                      (emit-header op (constant scheme-version) (constant machine-type))
                        (let loop ([x1* (reverse rx1*)] [rrcinfo** (list rcinfo*)] [rlpinfo** '()] [rfinal** '()])
                          (if (null? x1*)
-                             (compile-file-help2 op (reverse rrcinfo**) (reverse rlpinfo**) (reverse rfinal**))
+                             (compile-file-help2 op (reverse rrcinfo**) (reverse rlpinfo**) (reverse rfinal**) #f)
                              (let-values ([(rcinfo* lpinfo* final*)
                                            (let ([x1 (car x1*)])
                                              (if (recompile-info? x1)
@@ -1565,7 +1566,7 @@
                 (when source-table ($insert-profile-src! source-table x1))
                 (emit-header op (constant scheme-version) (constant machine-type))
                 (let-values ([(rcinfo* lpinfo* final*) (compile-file-help1 x1 msg)])
-                  (compile-file-help2 op (list rcinfo*) (list lpinfo*) (list final*))))))))))
+                  (compile-file-help2 op (list rcinfo*) (list lpinfo*) (list final*) #f)))))))))
 
   (define write-wpo-file
     (lambda (who ofn ir*)
@@ -1717,8 +1718,8 @@
       (emit-header op (constant scheme-version) (constant machine-type) (map path-root (map path-last bootfiles)))
       (when (null? bootfiles)
         (parameterize ([$target-machine machine] [$sfd #f])
-          (c-print-fasl ($np-boot-code 'error-invoke) op (constant fasl-type-visit-revisit))
-          (c-print-fasl ($np-boot-code 'invoke) op (constant fasl-type-visit-revisit))
+          (c-print-fasl ($np-boot-code 'error-invoke) op (constant fasl-type-visit-revisit) #f)
+          (c-print-fasl ($np-boot-code 'invoke) op (constant fasl-type-visit-revisit) #f)
           ($fasl-base-rtd #!base-rtd op)))))
 
   (define do-make-boot-file
@@ -1762,7 +1763,7 @@
                           (let ([sfd ($source-file-descriptor infn ip)])
                             ; whack ip so close-port calls close the text port
                             (set! ip (transcoded-port ip (current-transcoder)))
-                            (compile-file-help op #f #f source-table machine sfd ($make-read ip sfd 0) outfn))))
+                            (compile-file-help op #f #f source-table machine sfd ($make-read ip sfd 0) outfn #f))))
                     (close-port ip)))
                 infn*)))))))
 
@@ -1893,7 +1894,7 @@
                     (c-print-fasl `(object ,(make-recompile-info
                                               (vector->list (hashtable-keys import-ht))
                                               (vector->list (hashtable-keys include-ht))))
-                      op (constant fasl-type-visit-revisit))
+                      op (constant fasl-type-visit-revisit) #f)
                     (for-each (lambda (ip)
                                 (let loop () ;; NB: This loop consumes one entry past the last library/program info record,
                                              ;; which we presume is the #t end-of-header marker.
@@ -1902,11 +1903,11 @@
                                       ;; perhaps should verify ty here.
                                       (let ([x (fasl-read ip)])
                                         (when (or (library-info? x) (program-info? x))
-                                          (c-print-fasl `(object ,x) op ty)
+                                          (c-print-fasl `(object ,x) op ty #f)
                                           (loop)))))))
                       ip*)
                     ;; inserting #t after lpinfo as an end-of-header marker
-                    (c-print-fasl `(object #t) op (constant fasl-type-visit-revisit))
+                    (c-print-fasl `(object #t) op (constant fasl-type-visit-revisit) #f)
                     (let* ([bufsiz (file-buffer-size)] [buf (make-bytevector bufsiz)])
                       (for-each (lambda (ip)
                                   (let loop ()
@@ -1976,7 +1977,7 @@
                           (if ($port-flags-set? ip (constant port-flag-char-positions))
                               fp
                               (and (eqv? fp 0) fp))))])
-           (compile-file-help op hostop wpoop source-table machine sfd ($make-read ip sfd fp) #f)
+           (compile-file-help op hostop wpoop source-table machine sfd ($make-read ip sfd fp) #f #f)
            (when covop (put-source-table covop source-table))))])))
 
 (set-who! compile-to-port
@@ -1987,7 +1988,8 @@
       [(sexpr* op sfd wpoop) (compile-to-port sexpr* op sfd wpoop #f)]
       [(sexpr* op sfd wpoop covop) (compile-to-port sexpr* op sfd wpoop covop (constant machine-type-name))]
       [(sexpr* op sfd wpoop covop machine) (compile-to-port sexpr* op sfd wpoop covop machine #f)]
-      [(sexpr* op sfd wpoop covop machine hostop)
+      [(sexpr* op sfd wpoop covop machine hostop) (compile-to-port sexpr* op sfd wpoop covop machine hostop #f)]
+      [(sexpr* op sfd wpoop covop machine hostop external?-pred)
        (define do-compile-to-port
          (lambda ()
            (let ([source-table (and covop (make-source-table))])
@@ -1998,7 +2000,8 @@
                      (let ([x (car sexpr*)])
                        (set! sexpr* (cdr sexpr*))
                        x)))
-               (port-name op))
+               (port-name op)
+               external?-pred)
              (when covop (put-source-table covop source-table)))))
        (unless (list? sexpr*)
          ($oops who "~s is not a proper list" sexpr*))
@@ -2022,6 +2025,11 @@
          (unless (and (output-port? hostop) (binary-port? hostop))
            ($oops who "~s is not a binary output port or #f" hostop))
          (when ($port-flags-set? hostop (constant port-flag-compressed)) ($compressed-warning who hostop)))
+       (when external?-pred
+         (unless (procedure? external?-pred)
+           ($oops who "~s is not a procedure or #f" external?-pred))
+         (unless (= (length sexpr*) 1)
+           ($oops who "external predicate allowed only with a single expression")))
        (if (and (= (length sexpr*) 1) (pair? (car sexpr*)) (eq? (caar sexpr*) 'top-level-program))
            (let ([library-collector (make-parameter '())])
              (parameterize ([$require-libraries library-collector])
@@ -2046,7 +2054,7 @@
               (lambda (wpoop)
                 (with-coverage-file who out
                   (lambda (source-table)
-                    (compile-file-help op hostop wpoop source-table machine sfd do-read out))))))))))
+                    (compile-file-help op hostop wpoop source-table machine sfd do-read out #f))))))))))
 
   (define (do-compile-file who in out hostout machine r6rs?)
     (unless (string? in) ($oops who "~s is not a string" in))
@@ -2126,7 +2134,7 @@
                                             (when wpoop (put-u8 wpoop n)))
                                           (let ([fp (+ fp 1)])
                                             (if (char=? c #\newline) fp (loop fp)))))])
-                              (compile-file-help op #f wpoop source-table machine sfd ((if r6rs? $make-read-program $make-read) ip sfd fp) out))))))))
+                              (compile-file-help op #f wpoop source-table machine sfd ((if r6rs? $make-read-program $make-read) ip sfd fp) out #f))))))))
                 ; no #! line
                 (with-object-file who out
                   (lambda (op)
@@ -2135,7 +2143,7 @@
                       (lambda (wpoop)
                         (with-coverage-file who out
                           (lambda (source-table)
-                            (compile-file-help op #f wpoop source-table machine sfd ((if r6rs? $make-read-program $make-read) ip sfd 0) out)))))))))))
+                            (compile-file-help op #f wpoop source-table machine sfd ((if r6rs? $make-read-program $make-read) ip sfd 0) out #f)))))))))))
       (close-port ip))
     (unless-feature windows (chmod out #o755)))
 
diff --git a/s/fasl.ss b/s/fasl.ss
index 18ce2e4040..935c87f055 100644
--- a/s/fasl.ss
+++ b/s/fasl.ss
@@ -41,13 +41,15 @@
 (define rtd-flags (csv7:record-field-accessor #!base-rtd 'flags))
 
 (define-record-type table
-  (fields (mutable count) (immutable hash))
+  (fields (mutable count) (immutable hash)
+          (immutable external?-pred) (mutable external-count) (mutable externals))
   (nongenerative)
   (sealed #t)
   (protocol
-    (lambda (new)
-      (lambda ()
-        (new 0 (make-eq-hashtable))))))
+   (lambda (new)
+     (case-lambda
+      [() (new 0 (make-eq-hashtable) #f 0 '())]
+      [(external?-pred) (new 0 (make-eq-hashtable) external?-pred 0 '())]))))
 
 (include "fasl-helpers.ss")
 
@@ -112,7 +114,7 @@
    (lambda (x t a? d)
       (void)))
 
-(module (bld-graph dump-graph reset-dump-graph)
+(module (bld-graph dump-graph reset-dump-graph shift-externals!)
   (define enable-dump-graph? #f)
   (define vcat (if enable-dump-graph?
                    `#((code . ,(lambda (x) (and (pair? x) (eq? (car x) 'code))))
@@ -153,22 +155,40 @@
              #;(let ([n (hashtable-size (table-hash t))])
                  (when (fx= (modulo n 10000) 0)
                    (printf "entries = ~s, ba = ~s, count = ~s\n" n (bytes-allocated) (table-count t))))
-             (record! ventry x)
              (cond
-              [(fx>= d 500)
-               ;; Limit depth of recursion by lifting to a `fasl-begin` graph:
-               (let ([n (table-count t)])
-                 (set-cdr! a (cons n (if inner? 'inner-begin 'begin)))
-                 (table-count-set! t (fx+ n 1)))
-               (handler x t a? 0)]
-              [else
-               (set-cdr! a #f)
-               (handler x t a? (fx+ d 1))])]
+               [(let ([pred (table-external?-pred t)])
+                  (and pred (pred x)))
+                ;; Don't traverse; just record as external. We'll
+                ;; assign positions to externals after the graph
+                ;; has been fully traversed.
+                (let ([p (cons (table-external-count t) #f)])
+                  (set-cdr! a p)
+                  (table-external-count-set! t (fx+ (table-external-count t) 1))
+                  (table-externals-set! t (cons p (table-externals t))))]
+               [else
+                (record! ventry x)
+                (cond
+                  [(fx>= d 500)
+                   ;; Limit depth of recursion by lifting to a `fasl-begin` graph:
+                   (let ([n (table-count t)])
+                     (set-cdr! a (cons n (if inner? 'inner-begin 'begin)))
+                     (table-count-set! t (fx+ n 1)))
+                   (handler x t a? 0)]
+                  [else
+                   (set-cdr! a #f)
+                   (handler x t a? (fx+ d 1))])])]
             [(not p)
              (record! vdup x)
              (let ([n (table-count t)])
                (set-cdr! a (cons n #t))
                (table-count-set! t (fx+ n 1)))])))))
+  (define (shift-externals! t)
+    (unless (null? (table-externals t))
+      (let ([c (table-count t)])
+        (table-count-set! t (fx+ c (table-external-count t)))
+        (for-each (lambda (p)
+                    (set-car! p (fx+ (car p) c)))
+                  (table-externals t)))))
   (reset-dump-graph))
 
 (define bld
@@ -640,6 +660,7 @@
 (module (start)
   (define start
     (lambda (p t situation proc)
+      (shift-externals! t)
       (dump-graph)
       (let-values ([(bv* size)
                     (let-values ([(p extractor) ($open-bytevector-list-output-port)])
@@ -687,18 +708,22 @@
   ; when called from fasl-write or fasl-file, always preserve annotations;
   ; otherwise use value passed in by the compiler
   (define fasl-one
-    (lambda (x p)
-      (let ([t (make-table)])
+    (lambda (x p external?-pred)
+      (let ([t (make-table external?-pred)])
          (bld x t (constant annotation-all) 0)
          (start p t (constant fasl-type-visit-revisit) (lambda (p) (wrf x p t (constant annotation-all)))))))
 
   (define-who fasl-write
-    (lambda (x p)
+    (case-lambda
+     [(x p) (fasl-write x p #f)]
+     [(x p external?-pred)
       (unless (and (output-port? p) (binary-port? p))
         ($oops who "~s is not a binary output port" p))
+      (unless (or (not external?-pred) (procedure? external?-pred))
+        ($oops who "~s is not #f or a procedure" external?-pred))
       (when ($port-flags-set? p (constant port-flag-compressed)) ($compressed-warning who p))
       (emit-header p (constant scheme-version) (constant machine-type-any))
-      (fasl-one x p)))
+      (fasl-one x p external?-pred)]))
 
   (define-who fasl-file
     (lambda (in out)
@@ -717,7 +742,7 @@
             (let fasl-loop ()
               (let ([x (read ip)])
                 (unless (eof-object? x)
-                  (fasl-one x op)
+                  (fasl-one x op #f)
                   (fasl-loop)))))
           (close-port op))
         (close-port ip)))))
@@ -742,10 +767,14 @@
   (set! $fasl-enter (lambda (x t a? d) ((target-fasl-enter (fasl-target)) x t a? d)))
   (set! $fasl-out (lambda (x p t a?) ((target-fasl-out (fasl-target)) x p t a?)))
   (set! $fasl-start (lambda (p t situation proc) ((target-fasl-start (fasl-target)) p t situation proc)))
-  (set! $fasl-table (lambda () ((target-fasl-table (fasl-target)))))
+  (set! $fasl-table (case-lambda
+                     [() ((target-fasl-table (fasl-target)))]
+                     [(external?-pred) ((target-fasl-table (fasl-target)) external?-pred)]))
   (set! $fasl-wrf-graph (lambda (x p t a? handler) ((target-fasl-wrf-graph (fasl-target)) x p t a? handler)))
   (set! $fasl-base-rtd (lambda (x p) ((target-fasl-base-rtd (fasl-target)) x p)))
-  (set! fasl-write (lambda (x p) ((target-fasl-write (fasl-target)) x p)))
+  (set! fasl-write (case-lambda
+                    [(x p) ((target-fasl-write (fasl-target)) x p)]
+                    [(x p externals) ((target-fasl-write (fasl-target)) x p externals)]))
   (set! fasl-file (lambda (in out) ((target-fasl-file (fasl-target)) in out))))
 
 (when ($unbound-object? (#%$top-level-value '$capture-fasl-target))
diff --git a/s/pdhtml.ss b/s/pdhtml.ss
index 5d45e24f6e..b70537cc12 100644
--- a/s/pdhtml.ss
+++ b/s/pdhtml.ss
@@ -74,13 +74,13 @@
       (lambda (new)
         (lambda ()
           (define sfd-hash
-            (lambda (sfd)
+            (lambda (sfd)<
               (source-file-descriptor-crc sfd)))
           (define sfd=?
             (lambda (sfd1 sfd2)
               (and (fx= (source-file-descriptor-crc sfd1) (source-file-descriptor-crc sfd2))
                    (= (source-file-descriptor-length sfd1) (source-file-descriptor-length sfd2))
-                   (string=? (source-file-descriptor-name sfd1) (source-file-descriptor-name sfd2)))))
+                   (equal? (source-file-descriptor-name sfd1) (source-file-descriptor-name sfd2)))))
           (new (make-hashtable sfd-hash sfd=?))))))
   (define *local-profile-trackers* '())
   (define op+ car)
@@ -496,9 +496,11 @@
                                     (source-file-descriptor-crc y))
                                  (= (source-file-descriptor-length x)
                                     (source-file-descriptor-length y))
-                                 (string=?
-                                   (path-last (source-file-descriptor-name x))
-                                   (path-last (source-file-descriptor-name y)))))))])
+                                 (let ([maybe-path-last (lambda (p)
+                                                          (if (string? p) (path-last p) p))])
+                                   (equal?
+                                    (maybe-path-last (source-file-descriptor-name x))
+                                    (maybe-path-last (source-file-descriptor-name y))))))))])
       (define (open-source sfd)
         (cond
           [(hashtable-ref fdata-ht sfd #f)]
@@ -622,9 +624,11 @@
                         (source-file-descriptor-crc y))
                      (= (source-file-descriptor-length x)
                         (source-file-descriptor-length y))
-                     (string=?
-                       (path-last (source-file-descriptor-name x))
-                       (path-last (source-file-descriptor-name y)))))))))
+                     (let ([maybe-path-last (lambda (p)
+                                              (if (string? p) (path-last p) p))])
+                       (string=?
+                        (maybe-path-last (source-file-descriptor-name x))
+                        (maybe-path-last (source-file-descriptor-name y))))))))))
 
     (define profile-database #f)
     (define profile-source-data? #f)
diff --git a/s/primdata.ss b/s/primdata.ss
index e7ca9c7dcf..76d90cac03 100644
--- a/s/primdata.ss
+++ b/s/primdata.ss
@@ -1237,7 +1237,7 @@
   (compile-time-value? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
   (compile-time-value-value [sig [(compile-time-value) -> (ptr)]] [flags pure mifoldable discard])
   (compile-to-file [sig [(list pathname) (list pathname maybe-sfd) -> (void/list)]] [flags true])
-  (compile-to-port [sig [(list binary-output-port) (list binary-output-port maybe-sfd) (list binary-output-port maybe-sfd maybe-binary-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port sub-symbol) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port sub-symbol maybe-binary-output-port) -> (void/list)]] [flags true])
+  (compile-to-port [sig [(list binary-output-port) (list binary-output-port maybe-sfd) (list binary-output-port maybe-sfd maybe-binary-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port sub-symbol) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port sub-symbol maybe-binary-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port sub-symbol maybe-binary-output-port ptr) -> (void/list)]] [flags true])
   (compile-whole-program [sig [(string string) (string string ptr) -> (void)]] [flags])
   (compile-whole-library [sig [(string string) -> (void)]] [flags])
   (compute-composition [sig [(ptr) -> (list)] [(ptr sub-ufixnum) -> (list)]] [flags alloc])
@@ -1309,8 +1309,8 @@
   (expand/optimize [sig [(ptr) (ptr environment) -> (ptr)]] [flags])
   (expt-mod [sig [(integer integer integer) -> (integer)]] [flags arith-op mifoldable discard])
   (fasl-file [sig [(pathname pathname) -> (void)]] [flags true])
-  (fasl-read [sig [(binary-input-port) (binary-input-port sub-symbol) -> (ptr)]] [flags])
-  (fasl-write [sig [(sub-ptr binary-output-port) -> (void)]] [flags true])
+  (fasl-read [sig [(binary-input-port) (binary-input-port sub-symbol) (binary-input-port sub-symbol vector) -> (ptr)]] [flags])
+  (fasl-write [sig [(sub-ptr binary-output-port) (sub-ptr binary-output-port ptr) -> (void)]] [flags true])
   (vfasl-convert-file [sig [(ptr ptr ptr) -> (void)]] [flags])
   (file-access-time [sig [(pathname) (pathname ptr) -> (time)]] [flags discard])
   (file-change-time [sig [(pathname) (pathname ptr) -> (time)]] [flags discard])
@@ -1445,7 +1445,7 @@
   (list-head [sig [(sub-ptr sub-index) -> (list)]] [flags alloc])
   (literal-identifier=? [sig [(identifier identifier) -> (boolean)]] [flags pure mifoldable discard cp03])
   (load [sig [(pathname) (pathname procedure) -> (void)]] [flags true ieee r5rs])
-  (load-compiled-from-port [sig [(ptr) -> (ptr ...)]] [flags])
+  (load-compiled-from-port [sig [(ptr) (ptr vector) -> (ptr ...)]] [flags])
   (load-library [sig [(pathname) (pathname procedure) -> (void)]] [flags true])
   (load-program [sig [(pathname) (pathname procedure) -> (void)]] [flags true])
   (load-shared-object [sig [(maybe-pathname) -> (void)]] [flags true])
@@ -1493,7 +1493,7 @@
   (make-record-type [sig [(sub-ptr sub-list) (maybe-rtd sub-ptr sub-list) -> (rtd)]] [flags pure alloc cp02])
   (make-record-type-descriptor* [sig [(symbol maybe-rtd maybe-symbol ptr ptr ufixnum exact-integer) -> (rtd)]] [flags pure alloc cp02])
   (make-source-condition [sig [(ptr) -> (condition)]] [flags pure unrestricted mifoldable discard])
-  (make-source-file-descriptor [sig [(string binary-input-port) (string binary-input-port ptr) -> (sfd)]] [flags true])
+  (make-source-file-descriptor [sig [(ptr binary-input-port) (ptr binary-input-port ptr) -> (sfd)]] [flags true])
   (make-source-object [sig [(sfd uint uint) (sfd uint uint nzuint nzuint) -> (source-object)]] [flags pure true mifoldable discard])
   (make-sstats [sig [(time time exact-integer exact-integer time time exact-integer) -> (sstats)]] [flags alloc])
   (make-thread-parameter [feature pthreads] [sig [(ptr) (ptr procedure) -> (thread-parameter)]] [flags true cp02 cp03])
@@ -1672,10 +1672,10 @@
   (sort! [sig [(procedure list) -> (list)]] [flags true])
   (source-condition? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
   (source-condition-form [sig [(source-condition) -> (ptr)]] [flags pure mifoldable discard])
-  (source-file-descriptor [sig [(string uint) -> (sfd)]] [flags alloc])
+  (source-file-descriptor [sig [(ptr uint) -> (sfd)]] [flags alloc])
   (source-file-descriptor? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
   (source-file-descriptor-checksum [sig [(sfd) -> (sint)]] [flags pure mifoldable discard true])
-  (source-file-descriptor-path [sig [(sfd) -> (string)]] [flags pure mifoldable discard true])
+  (source-file-descriptor-path [sig [(sfd) -> (ptr)]] [flags pure mifoldable discard])
   (source-object? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
   (source-object-bfp [sig [(source-object) -> (uint)]] [flags pure mifoldable discard])
   (source-object-column [sig [(source-object) -> (maybe-uint)]] [flags pure mifoldable discard])
diff --git a/s/read.ss b/s/read.ss
index c0efc00da0..7e4b4b4e34 100644
--- a/s/read.ss
+++ b/s/read.ss
@@ -1633,13 +1633,14 @@
                          dir name))))
                (search name (cdr dir*)))))
     (let ([name (source-file-descriptor-name sfd)])
-      (or (and ($fixed-path? name) (source-port name))
-          (let ([dir* (append (source-directories) (map car (library-directories)))])
-            (let pathloop ([name name])
-              (or (search name dir*)
-                  (let ([rest (path-rest name)])
-                    (and (not (string=? rest name))
-                         (pathloop rest))))))))))
+      (and (string? name)
+           (or (and ($fixed-path? name) (source-port name))
+               (let ([dir* (append (source-directories) (map car (library-directories)))])
+                 (let pathloop ([name name])
+                   (or (search name dir*)
+                       (let ([rest (path-rest name)])
+                         (and (not (string=? rest name))
+                              (pathloop rest)))))))))))
 
 (let ([source-lines-cache (make-weak-eq-hashtable)])
 
diff --git a/s/strip.ss b/s/strip.ss
index a933eac0b2..d9e3dd9e1d 100644
--- a/s/strip.ss
+++ b/s/strip.ss
@@ -469,25 +469,21 @@
 
     (define write-entry
       (lambda (p x)
-        (define (append-bvs bv*)
-          (let f ([bv* bv*] [n 0])
-            (if (null? bv*)
-                (if (fixnum? n)
-                    (make-bytevector n)
-                    ($oops 'fasl-write "fasl output is too large to compress"))
-                (let ([bv1 (car bv*)])
-                  (let ([m (bytevector-length bv1)])
-                    (let ([bv2 (f (cdr bv*) (+ n m))])
-                      (bytevector-copy! bv1 0 bv2 n m)
-                      bv2))))))
         (fasl-case x
           [header (version machine dependencies)
            (emit-header p version machine dependencies)]
           [entry (situation fasl)
            (let ([t (make-table)])
              (build! fasl t)
-             ($fasl-start p t situation
-               (lambda (p) (write-fasl p t fasl))))]
+             (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)])))
 
     (define write-graph
diff --git a/s/syntax.ss b/s/syntax.ss
index 792a452263..e6d385ee6c 100644
--- a/s/syntax.ss
+++ b/s/syntax.ss
@@ -10270,7 +10270,6 @@
       (case-lambda
         [(ifn bip) (make-source-file-descriptor ifn bip #f)]
         [(ifn bip reset?)
-         (unless (string? ifn) ($oops who "~s is not a string" ifn))
          (unless (and (input-port? bip) (binary-port? bip))
            ($oops who "~s is not a binary input port" bip))
          (when reset?
@@ -10279,7 +10278,6 @@
          ($source-file-descriptor ifn bip reset?)])))
   (set-who! source-file-descriptor
     (lambda (path checksum)
-      (unless (string? path) ($oops who "~s is not a string" path))
       (unless (if (fixnum? checksum) (fx>= checksum 0) (and (bignum? checksum) ($bigpositive? checksum)))
         ($oops who "~s is not an exact nonnegative integer" checksum))
       (%make-source-file-descriptor path (ash checksum -16) (logand checksum #xffff))))