Primitive dump-band

[Matt Birkholz]

My builds from scratch fail because dump-band complains about it second
argument.  Am I not using the right host (again)?  I'm thinking 10.1.11
should do it, but I needed the following patch.

Name dump-band with new signature “dump-band2”, for host compat.

2 files changed, 16 insertions(+), 4 deletions(-)
src/microcode/fasdump.c |  2 +-
src/runtime/savres.scm  | 18 +++++++++++++++---

modified   src/microcode/fasdump.c
@@ -506,7 +506,7 @@ run_fixups (void * p)
   OS_free (fixups_start);
 }
 
-DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2,
+DEFINE_PRIMITIVE ("DUMP-BAND2", 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.")
modified   src/runtime/savres.scm
@@ -69,9 +69,8 @@ USA.
                        interrupt-mask
                        (gc-flip)
                        (do ()
-                           (((ucode-primitive dump-band)
-                             restart
-                             (disk-save-filename-string filename*)))
+                           ((dump-band restart
+                                       (disk-save-filename-string
filename*)))
                          (with-simple-restart 'retry "Try again."
                            (lambda ()
                              (error "Disk save failed!"))))
@@ -102,7 +101,20 @@ USA.
 ;;; Kludge to store disk-save filenames outside the Scheme heap so
they
 ;;; don't get dumped in bands.
 
+;; XXX Remove when the host has the dump-band2 primitive.
+(define get-primitive-address (ucode-primitive get-primitive-address
2))
+
+(define dump-band
+  (if (get-primitive-address 'dump-band2 #f)
+      (make-primitive-procedure 'dump-band2 2)
+      (make-primitive-procedure 'dump-band 2)))
+
 (define (disk-save-filename filename)
+  (if (get-primitive-address 'dump-band2 #f)
+      (disk-save-filename* filename)
+      (make-cell filename)))
+
+(define (disk-save-filename* filename)
   (let* ((pathname (merge-pathnames filename))
         (namestring (->namestring pathname))
         (primitive (string-for-primitive namestring))