From: Stas Boukarev <stassats@gmail.com>
Date: Sat, 12 Oct 2013 17:45:49 +0000 (+0400)
Subject: Fix another regression in dumping specialized vectors.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3a2377d9ab3389ddfacdeb425f81c4df820d8e7c;p=sbcl.git

Fix another regression in dumping specialized vectors.

It should read "CEILING", not "*".

Reported by Jan Moringen.
---

diff --git a/NEWS b/NEWS
index bc09d77..34cb3f8 100644
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,8 @@ changes relative to sbcl-1.1.12:
     (lp#746132)
   * bug fix: don't warn on a interpreted->compiled function redefinition
     from the same location.  (patch by Douglas Katzman, lp#1042405)
+  * bug fix: Create vectors of proper internal length when reading literal
+    vectors from FASLs. (Reported by Jan Moringen)
 
 changes in sbcl-1.1.12 relative to sbcl-1.1.11:
   * enhancement: Add sb-bsd-sockets:socket-shutdown, for calling
diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index 44e512d..f7bb13b 100644
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -412,26 +412,29 @@
     res))
 
 (defglobal **saetp-bits-per-length**
-    (let ((array (make-array 255 :element-type '(unsigned-byte 8)
-                                 :initial-element 255)))
+    (let ((array (make-array (1+ sb!vm:widetag-mask)
+                             :element-type '(unsigned-byte 8)
+                             :initial-element 255)))
       (loop for saetp across sb!vm:*specialized-array-element-type-properties*
             do
             (setf (aref array (sb!vm:saetp-typecode saetp))
                   (sb!vm:saetp-n-bits saetp)))
       array)
     "255 means bad entry.")
-(declaim (type (simple-array (unsigned-byte 8) (255))
+(declaim (type (simple-array (unsigned-byte 8) (#.(1+ sb!vm:widetag-mask)))
                **saetp-bits-per-length**))
 
 (define-fop (fop-spec-vector 43)
   (let* ((length (read-word-arg))
          (widetag (read-byte-arg))
          (bits-per-length (aref **saetp-bits-per-length** widetag))
-         (bytes  (progn
-                   (aver (< bits-per-length 255))
-                   (ceiling (* length bits-per-length) sb!vm:n-byte-bits)))
-         (vector (allocate-vector widetag length (* bytes sb!vm:n-word-bytes))))
-    (declare (type index length))
+         (bits (progn (aver (< bits-per-length 255))
+                      (* length bits-per-length)))
+         (bytes (ceiling bits sb!vm:n-byte-bits))
+         (words (ceiling bytes sb!vm:n-word-bytes))
+         (vector (allocate-vector widetag length words)))
+    (declare (type index length bytes words)
+             (type word bits))
     (read-n-bytes *fasl-input-stream* vector 0 bytes)
     vector))
 
diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 341bdbf..5ca2b23 100644
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -838,7 +838,9 @@
       (dump-fop 'fop-spec-vector file)
       (dump-word length file)
       (dump-byte widetag file))
-    (dump-raw-bytes vector (ceiling (* length bits-per-length) sb!vm:n-byte-bits) file)))
+    (dump-raw-bytes vector
+                    (ceiling (* length bits-per-length) sb!vm:n-byte-bits)
+                    file)))
 
 ;;; Dump characters and string-ish things.