0.8.6.14:

[sbcl.git] / src / compiler / generic / genesis.lisp

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index f32e88d..485d71b 100644 (file)
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -598,7 +598,7 @@
         (des (allocate-vector-object gspace
                                      sb!vm:n-byte-bits
                                      (1+ length)
-                                     sb!vm:simple-string-widetag))
+                                     sb!vm:simple-base-string-widetag))
         (bytes (gspace-bytes gspace))
         (offset (+ (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
                    (descriptor-byte-offset des))))
@@ -1253,11 +1253,12 @@
   (macrolet ((frob (symbol)
               `(cold-set ',symbol
                          (cold-fdefinition-object (cold-intern ',symbol)))))
-    (frob maybe-gc)
+    (frob sub-gc)
     (frob internal-error)
     (frob sb!kernel::control-stack-exhausted-error)
     (frob sb!di::handle-breakpoint)
-    (frob sb!di::handle-fun-end-breakpoint))
+    (frob sb!di::handle-fun-end-breakpoint)
+    (frob sb!thread::handle-thread-exit))
 
   (cold-set '*current-catch-block*          (make-fixnum-descriptor 0))
   (cold-set '*current-unwind-protect-block* (make-fixnum-descriptor 0))
@@ -2021,7 +2022,7 @@
 (defun cold-load-symbol (size package)
   (let ((string (make-string size)))
     (read-string-as-bytes *fasl-input-stream* string)
-    (cold-intern (intern string package) package)))
+    (cold-intern (intern string package))))
 
 (macrolet ((frob (name pname-len package-len)
             `(define-cold-fop (,name)
@@ -2125,11 +2126,18 @@
   (let* ((len (read-arg 4))
         (sizebits (read-arg 1))
         (type (case sizebits
+                (0 sb!vm:simple-array-nil-widetag)
                 (1 sb!vm:simple-bit-vector-widetag)
                 (2 sb!vm:simple-array-unsigned-byte-2-widetag)
                 (4 sb!vm:simple-array-unsigned-byte-4-widetag)
+                (7 (prog1 sb!vm:simple-array-unsigned-byte-7-widetag
+                     (setf sizebits 8)))
                 (8 sb!vm:simple-array-unsigned-byte-8-widetag)
+                (15 (prog1 sb!vm:simple-array-unsigned-byte-15-widetag
+                      (setf sizebits 16)))
                 (16 sb!vm:simple-array-unsigned-byte-16-widetag)
+                (31 (prog1 sb!vm:simple-array-unsigned-byte-31-widetag
+                      (setf sizebits 32)))
                 (32 sb!vm:simple-array-unsigned-byte-32-widetag)
                 (t (error "losing element size: ~W" sizebits))))
         (result (allocate-vector-object *dynamic* sizebits len type))
@@ -3290,7 +3298,12 @@ initially undefined function references:~2%")
          (dolist (obj structs)
            (out-to
             (string-downcase (string (sb!vm:primitive-object-name obj)))
-            (write-primitive-object obj))))
+            (write-primitive-object obj)))
+         (out-to "primitive-objects"
+                 (dolist (obj structs)
+                   (format t "~&#include \"~A.h\"~%"
+                           (string-downcase 
+                            (string (sb!vm:primitive-object-name obj)))))))
        (out-to "static-symbols" (write-static-symbols))
        
       (when core-file-name