0.9.0.6:
[sbcl.git] / src / compiler / dump.lisp
index a66ac81..610c1db 100644 (file)
 
 ;;; Open a fasl file, write its header, and return a FASL-OUTPUT
 ;;; object for dumping to it. Some human-readable information about
-;;; the source code is given by the string WHERE. If BYTE-P is true,
-;;; this file will contain no native code, and is thus largely
-;;; implementation independent.
+;;; the source code is given by the string WHERE. 
 (defun open-fasl-output (name where)
   (declare (type pathname name))
   (let* ((stream (open name
 \f
 ;;;; number dumping
 
-;;; Dump a ratio.
 (defun dump-ratio (x file)
   (sub-dump-object (numerator x) file)
   (sub-dump-object (denominator x) file)
   (dump-fop 'fop-ratio file))
 
-;;; Dump an integer.
 (defun dump-integer (n file)
   (typecase n
     ((signed-byte 8)
        (t
         (unless *cold-load-dump*
           (dump-fop 'fop-normal-load file))
+         #+sb-xc-host
         (dump-simple-base-string
           (coerce (package-name pkg) 'simple-base-string)
           file)
+         #-sb-xc-host
+        (#!+sb-unicode dump-simple-character-string
+          #!-sb-unicode dump-simple-base-string
+         (coerce (package-name pkg) '(simple-array character (*)))
+         file)
         (dump-fop 'fop-package file)
         (unless *cold-load-dump*
           (dump-fop 'fop-maybe-cold-load file))
     (6 (dump-fop 'fop-list*-6 file))
     (7 (dump-fop 'fop-list*-7 file))
     (8 (dump-fop 'fop-list*-8 file))
-    (T (do ((nn n (- nn 255)))
+    (t (do ((nn n (- nn 255)))
           ((< nn 256)
            (dump-fop 'fop-list* file)
            (dump-byte nn file))
     (6 (dump-fop 'fop-list-6 file))
     (7 (dump-fop 'fop-list-7 file))
     (8 (dump-fop 'fop-list-8 file))
-    (T (cond ((< n 256)
+    (t (cond ((< n 256)
              (dump-fop 'fop-list file)
              (dump-byte n file))
             (t (dump-fop 'fop-list file)
                                        (*)))
                            x)))
     (typecase simple-version
+      #+sb-xc-host
+      (simple-string
+       (unless (string-check-table x file)
+         (dump-simple-base-string simple-version file)
+         (string-save-object x file)))
+      #-sb-xc-host
       (simple-base-string
-       (unless (equal-check-table x file)
+       (unless (string-check-table x file)
         (dump-simple-base-string simple-version file)
-        (equal-save-object x file)))
+        (string-save-object x file)))
+      #-sb-xc-host
+      ((simple-array character (*))
+       #!+sb-unicode
+       (unless (string-check-table x file)
+        (dump-simple-character-string simple-version file)
+        (string-save-object x file))
+       #!-sb-unicode
+       (bug "how did we get here?"))
       (simple-vector
        (dump-simple-vector simple-version file)
        (eq-save-object x file))
         (dump-unsigned-vector 32 (* 4 len)))
         #-sb-xc-host
         #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-        ((simple-array (unsigned-byte-63) (*))
+        ((simple-array (unsigned-byte 63) (*))
          (dump-unsigned-vector 63 (* 8 len)))
         #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-        ((simple-array (unsigned-byte-64) (*))
+        ((simple-array (unsigned-byte 64) (*))
          (dump-unsigned-vector 64 (* 8 len)))
        ((simple-array (signed-byte 8) (*))
         (dump-signed-vector 8 len))
                      file)
           (dump-word pname-length file)))
 
-    (dump-base-chars-of-string pname file)
+    #+sb-xc-host (dump-base-chars-of-string pname file)
+    #-sb-xc-host (#!+sb-unicode dump-characters-of-string
+                  #!-sb-unicode dump-base-chars-of-string
+                  pname file)
 
     (unless *cold-load-dump*
       (setf (gethash s (fasl-output-eq-table file))