Gracefully handle microcodes with the older DUMP-BAND primitive.

Should fix build from 10.1.11.

(cherry picked from commit 3da997d2e4ae49fb2f4ee19ad7032d49a2c9be5e)

diff --git a/src/microcode/fasdump.c b/src/microcode/fasdump.c
index 08b9442f91d557a81ed2a8788019e2ac18b696ed..46f8fedb838c50e16fbb027a90aab709bae762a9 100644 (file)
--- a/src/microcode/fasdump.c
+++ b/src/microcode/fasdump.c
@@ -506,7 +506,7 @@ run_fixups (void * p)
   OS_free (fixups_start);
 }
 \f
-DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2,
+DEFINE_PRIMITIVE ("DUMP-BAND*", Prim_band_dump, 2, 2,
                  "(PROCEDURE NAMESTRING)\n\
 Saves an image of the current world to the file NAMESTRING.\n\
 When the file is reloaded, PROCEDURE is called with an argument of #F.")

diff --git a/src/microcode/prename.h b/src/microcode/prename.h
index 451521154f502e96acfcb18030677ca4af2472a3..637c43dad1118d164ae018a527624034fac78485 100644 (file)
--- a/src/microcode/prename.h
+++ b/src/microcode/prename.h
@@ -53,7 +53,8 @@ static struct primitive_alias_s primitive_aliases [] =
   { "SCREEN-Y-SIZE", "TTY-Y-SIZE" },
   { "FILE-SYMLINK?", "FILE-SOFT-LINK?" },
   { "X-GRAPHICS-SET-CLASS-HINT", "X-WINDOW-SET-CLASS-HINT" },
-  { "CURRENT-FILE-TIME", "ENCODED-TIME" }
+  { "CURRENT-FILE-TIME", "ENCODED-TIME" },
+  { "DUMP-BAND", "DUMP-BAND*" },
 };
 
 #define N_PRIMITIVE_ALIASES                                            \

diff --git a/src/runtime/savres.scm b/src/runtime/savres.scm
index 7a355289b247ecabd6be3aace66bd9a36242d891..8ad0b82b621d2c37924c97541b71c5b75ee411e8 100644 (file)
--- a/src/runtime/savres.scm
+++ b/src/runtime/savres.scm
@@ -69,9 +69,7 @@ USA.
                        interrupt-mask
                        (gc-flip)
                        (do ()
-                           (((ucode-primitive dump-band)
-                             restart
-                             (disk-save-filename-string filename*)))
+                           ((dump-band restart filename*))
                          (with-simple-restart 'retry "Try again."
                            (lambda ()
                              (error "Disk save failed!"))))
@@ -100,26 +98,34 @@ USA.
                    #t))))))))))
 \f
 ;;; Kludge to store disk-save filenames outside the Scheme heap so they
-;;; don't get dumped in bands.
+;;; don't get dumped in bands.  However, only works if the microcode
+;;; supports passing the filename through an external string; if not,
+;;; tough -- we'll just have to keep the filename in the Scheme heap
+;;; and in the band.
+
+(define (dump-band restart filename)
+  (if (implemented-primitive-procedure? (ucode-primitive dump-band* 2))
+      ((ucode-primitive dump-band* 2) restart (cell-contents filename))
+      ((ucode-primitive dump-band 2) restart filename)))
 
 (define (disk-save-filename filename)
-  (let* ((pathname (merge-pathnames filename))
-        (namestring (->namestring pathname))
-        (primitive (string-for-primitive namestring))
-        (n (string-length primitive))
-        (cell
-         (make-gc-finalized-object disk-save-filenames
-           (lambda (p)
-             (weak-set-cdr! p
-                            ((ucode-primitive allocate-external-string 1) n)))
-           (lambda (s)
-             (make-cell s))))
-        (string (cell-contents cell)))
-    ((ucode-primitive substring-move-left! 5) primitive 0 n string 0)
-    cell))
-
-(define (disk-save-filename-string f)
-  (cell-contents f))
+  (if (implemented-primitive-procedure? (ucode-primitive dump-band* 2))
+      (let* ((pathname (merge-pathnames filename))
+            (namestring (->namestring pathname))
+            (primitive (string-for-primitive namestring))
+            (n (string-length primitive))
+            (cell
+             (make-gc-finalized-object disk-save-filenames
+               (lambda (p)
+                 (weak-set-cdr!
+                  p
+                  ((ucode-primitive allocate-external-string 1) n)))
+               (lambda (s)
+                 (make-cell s))))
+            (string (cell-contents cell)))
+       ((ucode-primitive substring-move-left! 5) primitive 0 n string 0)
+       cell)
+      filename))
 
 (define-deferred disk-save-filenames
   (make-gc-finalizer (ucode-primitive deallocate-external-string 1)