diff --git a/LOG b/LOG
index 0cac43e02a..87b8d8b21b 100644
--- a/LOG
+++ b/LOG
@@ -1000,3 +1000,7 @@
 - add current-generate-id and expand-omit-library-invocations, which can be
   useful for avoiding library recompilation and redundant invocation checks
     syntax.ss, record.ss, primdata.ss, front.ss, misc.ms, system.stex
+- 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 dff881b5e0..398f77bab7 100644
--- a/c/scheme.c
+++ b/c/scheme.c
@@ -558,10 +558,11 @@ 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;
@@ -572,7 +573,7 @@ static IBOOL find_boot(name, ext, errorp) const char *name, *ext; IBOOL errorp;
 #endif
   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();
@@ -580,16 +581,21 @@ static IBOOL find_boot(name, ext, errorp) const char *name, *ext; IBOOL errorp;
 
     path = name;
 
+    if (fd != -1) {
+      file = gzdopen(fd, "rb");
+    } else {
 #ifdef WIN32
-    expandedpath = S_malloc_wide_pathname(path);
-    file = gzopen_w(expandedpath, "rb");
+      expandedpath = S_malloc_wide_pathname(path);
+      file = gzopen_w(expandedpath, "rb");
 #else
-    expandedpath = S_malloc_pathname(path);
-    file = gzopen(expandedpath, "rb");
+      expandedpath = S_malloc_pathname(path);
+      file = gzopen(expandedpath, "rb");
 #endif
-    /* assumption (seemingly true based on a glance at the source code):
-       gzopen doesn't squirrel away a pointer to expandedpath. */
-    free(expandedpath);
+      /* 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);
@@ -752,7 +758,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 ");
@@ -1026,20 +1032,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) {
@@ -1094,7 +1108,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 42fe062775..5807378658 100644
--- a/csug/foreign.stex
+++ b/csug/foreign.stex
@@ -2804,6 +2804,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}
@@ -2836,9 +2837,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 file 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 3a001937f7..901c4f48c1 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 8d37c313fe..0dcb1061bd 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 7510b21313..c012aed2a6 100644
--- a/s/7.ss
+++ b/s/7.ss
@@ -184,13 +184,15 @@
 
 (let ()
   (define do-load-binary
-    (lambda (who fn ip situation for-import?)
+    (lambda (who fn ip situation for-import? results?)
       (let ([load-binary (make-load-binary who fn situation for-import?)])
-        (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))])
             (cond
              [(eof-object? x) (close-port ip)]
-             [else (load-binary x) (loop)]))))))
+             [(and results? (eof-object? next-x)) (load-binary x)]
+             [else (load-binary x) (loop next-x)]))))))
 
   (define (make-load-binary who fn situation for-import?)
     (module (Lexpand? visit-stuff? visit-stuff-inner revisit-stuff? revisit-stuff-inner
@@ -216,9 +218,17 @@
          [(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))])))
     (lambda (x)
       (cond
-       [(vector? x) (vector-for-each run-outer x)]
+       [(vector? x) (run-vector x 0)]
        [(Lexpand? x) ($interpret-backend x situation for-import? fn)]
        [else (run-outer x)])))
 
@@ -240,7 +250,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))
@@ -256,6 +266,12 @@
     (lambda (fn situation for-import?)
       (make-load-binary '$make-load-binary fn situation for-import?)))
 
+  (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 7a88994a3a..8c71be462e 100644
--- a/s/mkheader.ss
+++ b/s/mkheader.ss
@@ -372,6 +372,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 d12f1b784e..0d297a2282 100644
--- a/s/primdata.ss
+++ b/s/primdata.ss
@@ -1403,6 +1403,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])