0.8.21.33: make doctrings.lisp understand embedded examples better

[sbcl.git] / src / compiler / dump.lisp

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 453daf4..c51e480 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -600,7 +600,15 @@
        (t
         (unless *cold-load-dump*
           (dump-fop 'fop-normal-load file))
-        (dump-simple-string (package-name pkg) 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))
@@ -731,10 +739,24 @@
                                        (*)))
                            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)
-        (dump-simple-string simple-version file)
-        (equal-save-object x file)))
+       (unless (string-check-table x file)
+        (dump-simple-base-string simple-version 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))
@@ -874,10 +896,10 @@
         (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))
@@ -903,23 +925,31 @@
 \f
 ;;; Dump characters and string-ish things.
 
-(defun dump-character (ch file)
+(defun dump-character (char file)
+  (let ((code (sb!xc:char-code char)))
+    (cond
+      ((< code 256)
   (dump-fop 'fop-short-character file)
-  (dump-byte (char-code ch) file))
+       (dump-byte code file))
+      (t
+       (dump-fop 'fop-character file)
+       (dump-word code file)))))
 
-;;; a helper function shared by DUMP-SIMPLE-STRING and DUMP-SYMBOL
-(defun dump-characters-of-string (s fasl-output)
-  (declare (type string s) (type fasl-output fasl-output))
+(defun dump-base-chars-of-string (s fasl-output)
+  (declare #+sb-xc-host (type simple-string s)
+           #-sb-xc-host (type simple-base-string s)
+           (type fasl-output fasl-output))
   (dovector (c s)
-    (dump-byte (char-code c) fasl-output))
+    (dump-byte (sb!xc:char-code c) fasl-output))
   (values))
 
+
 ;;; Dump a SIMPLE-BASE-STRING.
-;;; FIXME: should be called DUMP-SIMPLE-BASE-STRING then
-(defun dump-simple-string (s file)
-  (declare (type simple-base-string s))
-  (dump-fop* (length s) fop-small-string fop-string file)
-  (dump-characters-of-string s file)
+(defun dump-simple-base-string (s file)
+  #+sb-xc-host (declare (type simple-string s))
+  #-sb-xc-host (declare (type simple-base-string s))
+  (dump-fop* (length s) fop-small-base-string fop-base-string file)
+  (dump-base-chars-of-string s file)
   (values))
 
 ;;; If we get here, it is assumed that the symbol isn't in the table,
@@ -969,7 +999,10 @@
                      file)
           (dump-word pname-length file)))
 
-    (dump-characters-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))