0.8.0.59:
[sbcl.git] / src / compiler / dump.lisp
index 398bfca..991dc18 100644 (file)
         (dump-byte ',val ,file))
       (error "compiler bug: ~S is not a legal fasload operator." fs))))
 
-;;; Dump a FOP-Code along with an integer argument, choosing the FOP
+;;; Dump a FOP-CODE along with an integer argument, choosing the FOP
 ;;; based on whether the argument will fit in a single byte.
 ;;;
 ;;; FIXME: This, like DUMP-FOP, should be a function with a
      stream)
     (dump-byte +fasl-header-string-stop-char-code+ res)
 
-    ;; Finish the header by outputting fasl file implementation and
-    ;; version in machine-readable form.
-    (let ((implementation +backend-fasl-file-implementation+))
-      (dump-unsigned-32 (length (symbol-name implementation)) res)
-      (dotimes (i (length (symbol-name implementation)))
-       (dump-byte (char-code (aref (symbol-name implementation) i)) res)))
-    (dump-unsigned-32 +fasl-file-version+ res)
+    ;; Finish the header by outputting fasl file implementation,
+    ;; version, and key *FEATURES*.
+    (flet ((dump-counted-string (string)
+            (dump-unsigned-32 (length string) res)
+            (dotimes (i (length string))
+              (dump-byte (char-code (aref string i)) res))))
+      (dump-counted-string (symbol-name +backend-fasl-file-implementation+))
+      (dump-unsigned-32 +fasl-file-version+ res)      
+      (dump-counted-string *features-affecting-fasl-format*))
 
     res))
 
 ;;; tables.
 (defun dump-vector (x file)
   (let ((simple-version (if (array-header-p x)
-                           (coerce x 'simple-array)
+                           (coerce x `(simple-array
+                                       ,(array-element-type x)
+                                       (*)))
                            x)))
     (typecase simple-version
       (simple-base-string
 (defun dump-layout (obj file)
   (when (layout-invalid obj)
     (compiler-error "attempt to dump reference to obsolete class: ~S"
-                   (layout-class obj)))
-  (let ((name (sb!xc:class-name (layout-class obj))))
+                   (layout-classoid obj)))
+  (let ((name (classoid-name (layout-classoid obj))))
     (unless name
       (compiler-error "dumping anonymous layout: ~S" obj))
     (dump-fop 'fop-normal-load file)