0.7.13.17:
[sbcl.git] / src / compiler / dump.lisp
index 094f646..4e1255a 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
   (declare (type pathname name))
   (let* ((stream (open name
                       :direction :output
-                      :if-exists :new-version
+                      :if-exists :supersede
                       :element-type 'sb!assem:assembly-unit))
         (res (make-fasl-output :stream stream)))
 
 ;;; this function is not parallel to other functions DUMP-FOO, e.g.
 ;;; DUMP-SYMBOL and DUMP-LIST. The mapping between names and behavior
 ;;; should be made more consistent.
+(declaim (ftype (function (package fasl-output) index) dump-package))
 (defun dump-package (pkg file)
-  (declare (type package pkg) (type fasl-output file))
-  #+nil (declare (values index))
   (declare (inline assoc))
   (cond ((cdr (assoc pkg (fasl-output-packages file) :test #'eq)))
        (t
 ;;; 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
        ;; KLUDGE: What exactly does the (ASH .. -3) stuff do? -- WHN 19990902
        (simple-bit-vector
         (dump-unsigned-vector 1 (ash (+ (the index len) 7) -3)))
+       ;; KLUDGE: This isn't the best way of expressing that the host
+       ;; may not have specializations for (unsigned-byte 2) and
+       ;; (unsigned-byte 4), which means that these types are
+       ;; type-equivalent to (simple-array (unsigned-byte 8) (*));
+       ;; the workaround is to remove them from the etypecase, since
+       ;; they can't be dumped from the cross-compiler anyway. --
+       ;; CSR, 2002-05-07
+       #-sb-xc-host
        ((simple-array (unsigned-byte 2) (*))
         (dump-unsigned-vector 2 (ash (+ (the index (ash len 1)) 7) -3)))
+       #-sb-xc-host
        ((simple-array (unsigned-byte 4) (*))
         (dump-unsigned-vector 4 (ash (+ (the index (ash len 2)) 7) -3)))
        ((simple-array (unsigned-byte 8) (*))