diff --git a/LOG b/LOG
index 477a911001..d0f137be09 100644
--- a/LOG
+++ b/LOG
@@ -788,3 +788,7 @@
 - fix bounds checking with an immediate index on immutable vectors,
   fxvectors, strings, and bytevectors
     cpnanopass.ss, 5_5.ms, 5_6.ms, bytevector.ms
+- add load-compiled-from-port and Sregister_boot_file_fd for loading modes
+  based on open files instead of paths
+    7.ss, primdata.ss, mkheader.ss, scheme.c
+    7.ms, foreign.stex, system.stex
diff --git a/c/scheme.c b/c/scheme.c
index 7717f581a9..3d02f778f1 100644
--- a/c/scheme.c
+++ b/c/scheme.c
@@ -545,17 +545,18 @@ static boot_desc bd[MAX_BOOT_FILES];
 /* locally defined functions */
 static uptr zget_uptr PROTO((gzFile file, uptr *pn));
 static INT zgetstr PROTO((gzFile file, char *s, iptr max));
-static IBOOL find_boot PROTO((const char *name, const char *ext, IBOOL errorp));
+static IBOOL find_boot PROTO((const char *name, const char *ext, int fd, IBOOL errorp));
 static void load PROTO((ptr tc, iptr n, IBOOL base));
+static void check_boot_file_state PROTO((const char *who));
 
-static IBOOL find_boot(name, ext, errorp) const char *name, *ext; IBOOL errorp; {
+static IBOOL find_boot(name, ext, fd, errorp) const char *name, *ext; int fd; IBOOL errorp; {
   char pathbuf[PATH_MAX], buf[PATH_MAX];
   uptr n; INT c;
   const char *path;
   char *expandedpath;
   gzFile file;
 
-  if (S_fixedpathp(name)) {
+  if ((fd != -1) || S_fixedpathp(name)) {
     if (strlen(name) >= PATH_MAX) {
       fprintf(stderr, "boot-file path is too long %s\n", name);
       S_abnormal_exit();
@@ -563,11 +564,16 @@ static IBOOL find_boot(name, ext, errorp) const char *name, *ext; IBOOL errorp;
 
     path = name;
 
-    expandedpath = S_malloc_pathname(path);
-    file = gzopen(expandedpath, "rb");
-    /* assumption (seemingly true based on a glance at the source code):
-       gzopen doesn't squirrel away a pointer to expandedpath. */
-    free(expandedpath);
+    if (fd != -1) {
+      file = gzdopen(fd, "rb");
+    } else {
+      expandedpath = S_malloc_pathname(path);
+      file = gzopen(expandedpath, "rb");
+      /* assumption (seemingly true based on a glance at the source code):
+         gzopen doesn't squirrel away a pointer to expandedpath. */
+      free(expandedpath);
+    }
+
     if (!file) {
       if (errorp) {
         fprintf(stderr, "cannot open boot file %s\n", path);
@@ -725,7 +731,7 @@ static IBOOL find_boot(name, ext, errorp) const char *name, *ext; IBOOL errorp;
           gzclose(file);
           S_abnormal_exit();
         }
-        if (find_boot(buf, ".boot", 0)) break;
+        if (find_boot(buf, ".boot", -1, 0)) break;
         if ((c = gzgetc(file)) == ')') {
           char *sep; char *wastebuf[8];
           fprintf(stderr, "cannot find subordinate boot file ");
@@ -979,20 +985,28 @@ extern void Sscheme_init(abnormal_exit) void (*abnormal_exit) PROTO((void)); {
 #endif
 }
 
-extern void Sregister_boot_file(name) const char *name; {
+static void check_boot_file_state(const char *who) {
   switch (current_state) {
     case UNINITIALIZED:
     case DEINITIALIZED:
-      fprintf(stderr, "error (Sregister_boot_file): uninitialized; call Sscheme_init first\n");
+      fprintf(stderr, "error (%s): uninitialized; call Sscheme_init first\n", who);
       if (current_state == UNINITIALIZED) exit(1); else S_abnormal_exit();
     case RUNNING:
-      fprintf(stderr, "error (Sregister_boot_file): already running\n");
+      fprintf(stderr, "error (%s): already running\n", who);
       S_abnormal_exit();
     case BOOTING:
       break;
   }
+}
 
-  find_boot(name, "", 1);
+extern void Sregister_boot_file(name) const char *name; {
+  check_boot_file_state("Sregister_boot_file");
+  find_boot(name, "", -1, 1);
+}
+
+extern void Sregister_boot_file_fd(name, fd) const char *name; int fd; {
+  check_boot_file_state("Sregister_boot_file_fd");
+  find_boot(name, "", fd, 1);
 }
 
 extern void Sregister_heap_file(UNUSED const char *path) {
@@ -1047,7 +1061,7 @@ extern void Sbuild_heap(kernel, custom_init) const char *kernel; void (*custom_i
     }
 #endif
 
-    if (!find_boot(name, ".boot", 0)) {
+    if (!find_boot(name, ".boot", -1, 0)) {
       fprintf(stderr, "cannot find compatible %s.boot in search path\n  \"%s%s\"\n",
               name,
               Sschemeheapdirs, Sdefaultheapdirs);
diff --git a/csug/foreign.stex b/csug/foreign.stex
index ecac576d7a..200b85694d 100644
--- a/csug/foreign.stex
+++ b/csug/foreign.stex
@@ -2720,6 +2720,7 @@ program.
 \cfunction{void}{Sscheme_init}{void (*\var{abnormal}_\var{exit})(void)}
 \cfunction{void}{Sset_verbose}{int \var{v}}
 \cfunction{void}{Sregister_boot_file}{const char *\var{name}}
+\cfunction{void}{Sregister_boot_file_fd}{const char *\var{name}, int \var{fd}}
 \cfunction{void}{Sbuild_heap}{const char *\var{exec}, void (*\var{custom}_\var{init})(void)}
 \cfunction{void}{Senable_expeditor}{const char *\var{history}_\var{file}}
 \cfunction{void}{Sretain_static_relocation}{void}
@@ -2752,9 +2753,11 @@ for subsequently registered boot files.
 
 \scheme{Sregister_boot_file} searches for
 the named boot file and
-register it for loading.
-The file is opened but not loaded until the heap is built via
-\scheme{Sbuild_heap}.
+register it for loading, while \scheme{Sregister_boot_file_fd}
+provides a specific boot file as a file descriptor.
+When only a boot file name is provided, the is opened but not loaded until the heap is built via
+\scheme{Sbuild_heap}. When a file descriptor is provided, the given file name
+is used only for error reporting.
 For the first boot file registered only, the system also
 searches for the boot files upon which the named file
 depends, either directly or indirectly.
diff --git a/csug/system.stex b/csug/system.stex
index a21473c8b3..9efd00424b 100644
--- a/csug/system.stex
+++ b/csug/system.stex
@@ -980,6 +980,24 @@ determines the set of directories searched for source files not identified
 by absolute path names.
 
 
+%----------------------------------------------------------------------------
+\entryheader
+\formdef{load-compiled-from-port}{\categoryprocedure}{(load-compiled-from-port \var{input-port})}
+\returns result of the last compiled expression
+\listlibraries
+\endentryheader
+
+\noindent
+\scheme{load-compiled-from-port} reads and evaluates the object-code contents
+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 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.
+
+
 %----------------------------------------------------------------------------
 \entryheader
 \formdef{visit}{\categoryprocedure}{(visit \var{path})}
diff --git a/mats/7.ms b/mats/7.ms
index 29bba8229c..42dff0e567 100644
--- a/mats/7.ms
+++ b/mats/7.ms
@@ -112,6 +112,14 @@
     "6\n")
  )
 
+(mat load-compiled-from-port
+  (begin
+   (define-values (o get) (open-bytevector-output-port))
+   (compile-to-port '((define lcfp1 'worked) 'loaded) o)
+   (equal? 'loaded (load-compiled-from-port (open-bytevector-input-port (get)))))
+  (equal? 'worked lcfp1)
+)
+
 (mat compile-to-file
   (begin
     (delete-file (format "testfile.~s" (machine-type)))
diff --git a/s/7.ss b/s/7.ss
index eeb308dbcc..18473ca4e5 100644
--- a/s/7.ss
+++ b/s/7.ss
@@ -184,7 +184,7 @@
 
 (let ()
   (define do-load-binary
-    (lambda (who fn ip situation for-import?)
+    (lambda (who fn ip situation for-import? results?)
       (module (Lexpand? visit-stuff? visit-stuff-inner revisit-stuff? revisit-stuff-inner
                recompile-info? library/ct-info? library/rt-info? program-info?)
         (import (nanopass))
@@ -193,8 +193,9 @@
       (define unexpected-value!
         (lambda (x)
           ($oops who "unexpected value ~s read from ~a" x fn)))
-      (let loop ()
-        (let ([x (fasl-read ip)])
+      (let loop ([lookahead-x #f])
+        (let* ([x (or lookahead-x (fasl-read ip))]
+               [next-x (and results? (not (eof-object? x)) (fasl-read ip))])
           (define run-inner
             (lambda (x)
               (cond
@@ -210,11 +211,23 @@
                 [(revisit-stuff? x) (when (memq situation '(load revisit)) (run-inner (revisit-stuff-inner x)))]
                 [(visit-stuff? x) (when (memq situation '(load visit)) (run-inner (visit-stuff-inner x)))]
                 [else (run-inner x)])))
+          (define run-vector
+            (lambda (x i)
+              (cond
+               [(fx= (fx+ i 1) (vector-length x))
+                (run-outer (vector-ref x i))]
+               [else
+                (run-outer (vector-ref x i))
+                (run-vector x (fx+ i 1))])))
           (cond
             [(eof-object? x) (close-port ip)]
-            [(vector? x) (vector-for-each run-outer x) (loop)]
-            [(Lexpand? x) ($interpret-backend x situation for-import? fn) (loop)]
-            [else (run-outer x) (loop)])))))
+            [(vector? x)
+             (cond
+              [(and results? (eof-object? next-x) (fx> (vector-length x) 0)) (run-vector x 0)]
+              [else (vector-for-each run-outer x) (loop next-x)])]
+            [(Lexpand? x) ($interpret-backend x situation for-import? fn) (loop next-x)]
+            [(and results? (eof-object? next-x)) (run-outer x)]
+            [else (run-outer x) (loop next-x)])))))
 
   (define (do-load who fn situation for-import? ksrc)
     (let ([ip ($open-file-input-port who fn)])
@@ -234,7 +247,7 @@
                         (begin (set-port-position! ip start-pos) 0)))])
           (port-file-compressed! ip)
           (if ($compiled-file-header? ip)
-              (do-load-binary who fn ip situation for-import?)
+              (do-load-binary who fn ip situation for-import? #f)
               (begin
                 (when ($port-flags-set? ip (constant port-flag-compressed))
                   ($oops who "missing header for compiled file ~s" fn))
@@ -246,6 +259,12 @@
                   (set! ip (transcoded-port ip (current-transcoder)))
                   (ksrc ip sfd ($make-read ip sfd fp)))))))))
 
+  (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 #t)))
+
   (set-who! load-program
     (rec load-program
       (case-lambda
diff --git a/s/mkheader.ss b/s/mkheader.ss
index 30f96ed9e0..9c6ee4bf92 100644
--- a/s/mkheader.ss
+++ b/s/mkheader.ss
@@ -371,6 +371,7 @@
         (export "void" "Sset_verbose" "(int)")
         (export "void" "Sscheme_init" "(void (*)(void))")
         (export "void" "Sregister_boot_file" "(const char *)")
+        (export "void" "Sregister_boot_file_fd" "(const char *, int fd)")
         (export "void" "Sregister_heap_file" "(const char *)")
         (export "void" "Scompact_heap" "(void)")
         (export "void" "Ssave_heap" "(const char *, int)")
diff --git a/s/primdata.ss b/s/primdata.ss
index 7dd04e73b5..be92635121 100644
--- a/s/primdata.ss
+++ b/s/primdata.ss
@@ -1392,6 +1392,7 @@
   (list-head [sig [(sub-ptr sub-index) -> (ptr)]] [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-library [sig [(pathname) (pathname procedure) -> (void)]] [flags true])
   (profile-load-data [sig [(pathname) -> (void)]] [flags true])
   (load-program [sig [(pathname) (pathname procedure) -> (void)]] [flags true])