X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdump.lisp;h=991dc1897c5ef2e0e33785b6f65f55a4a4daee48;hb=e511ed14d4a20cb9de2523f052b0f23a1dde1115;hp=398bfca40e2b46a5c89d3aa237f098df4d0b8516;hpb=69cd16d7335a7f66985752b84f78d18e45f9783e;p=sbcl.git diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index 398bfca..991dc18 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -155,7 +155,7 @@ (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 @@ -293,13 +293,15 @@ 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)) @@ -709,7 +711,9 @@ ;;; 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 @@ -1255,8 +1259,8 @@ (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)