X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsharpm.lisp;h=39c8e66ce1be9b66a5500bca95a19bbe0f60214a;hb=HEAD;hp=af7994f17d3c540309ad3b4b35ff83539261c742;hpb=5d04a95274c9ddaebbcd6ddffc5d646e2c25598c;p=sbcl.git

diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp
index af7994f..39c8e66 100644
--- a/src/code/sharpm.lisp
+++ b/src/code/sharpm.lisp
@@ -21,32 +21,32 @@
 (defun sharp-left-paren (stream ignore length)
   (declare (ignore ignore) (special *backquote-count*))
   (let* ((list (read-list stream nil))
-         (listlength (handler-case (length list)
-                       (type-error
-                        (error)
-                        (declare (ignore error))
-                        (simple-reader-error stream
-                                             "improper list in #(): ~S"
-                                             list)))))
+         (list-length (handler-case (length list)
+                        (type-error ()
+                          (simple-reader-error stream
+                                               "Improper list in #(): ~S."
+                                               list)))))
     (declare (list list)
-             (fixnum listlength))
+             (fixnum list-length))
     (cond (*read-suppress* nil)
+          ((and length (> list-length length))
+           (simple-reader-error
+            stream
+            "Vector longer than the specified length: #~S~S."
+            length list))
           ((zerop *backquote-count*)
            (if length
-               (cond ((> listlength (the fixnum length))
-                      (simple-reader-error
-                       stream
-                       "vector longer than specified length: #~S~S"
-                       length list))
-                     (t
-                      (fill (the simple-vector
-                                 (replace (the simple-vector
-                                               (make-array length))
-                                          list))
-                            (car (last list))
-                            :start listlength)))
+               (fill (replace (make-array length) list)
+                     (car (last list))
+                     :start list-length)
                (coerce list 'vector)))
-          (t (cons *bq-vector-flag* list)))))
+          (t
+           (cons *bq-vector-flag*
+                 (if length
+                     (append list
+                             (make-list (- length list-length)
+                                        :initial-element (car (last list))))
+                     list))))))
 
 (defun sharp-star (stream ignore numarg)
   (declare (ignore ignore))
@@ -93,10 +93,15 @@
   (when *read-suppress*
     (read stream t nil t)
     (return-from sharp-A nil))
-  (unless dimensions (simple-reader-error stream
-                                          "no dimensions argument to #A"))
+  (unless dimensions
+    (simple-reader-error stream "No dimensions argument to #A."))
   (collect ((dims))
-    (let* ((contents (read stream t nil t))
+    (let* ((*bq-error*
+            (if (zerop *backquote-count*)
+                *bq-error*
+                "Comma inside a backquoted array (not a list or general vector.)"))
+           (*backquote-count* 0)
+           (contents (read stream t nil t))
            (seq contents))
       (dotimes (axis dimensions
                      (make-array (dims) :initial-contents contents))
@@ -122,8 +127,14 @@
   (when *read-suppress*
     (read stream t nil t)
     (return-from sharp-S nil))
-  (let ((body (if (char= (read-char stream t) #\( )
-                  (read-list stream nil)
+  (let* ((*bq-error*
+          (if (zerop *backquote-count*)
+              *bq-error*
+              "Comma inside backquoted structure (not a list or general vector.)"))
+         (*backquote-count* 0)
+         (body (if (char= (read-char stream t) #\( )
+                  (let ((*backquote-count* 0))
+                    (read-list stream nil))
                   (simple-reader-error stream "non-list following #S"))))
     (unless (listp body)
       (simple-reader-error stream "non-list following #S: ~S" body))
@@ -256,13 +267,22 @@
                       (unless (eq old new)
                         (setf (aref data i) new))))))
                ((typep tree 'instance)
-                (do ((i 1 (1+ i))
-                     (end (%instance-length tree)))
-                    ((= i end))
-                  (let* ((old (%instance-ref tree i))
-                         (new (circle-subst old-new-alist old)))
-                    (unless (eq old new)
-                      (setf (%instance-ref tree i) new)))))
+                (let* ((n-untagged (layout-n-untagged-slots (%instance-layout tree)))
+                       (n-tagged (- (%instance-length tree) n-untagged)))
+                  ;; N-TAGGED includes the layout as well (at index 0), which
+                  ;; we don't grovel.
+                  (do ((i 1 (1+ i)))
+                      ((= i n-tagged))
+                    (let* ((old (%instance-ref tree i))
+                           (new (circle-subst old-new-alist old)))
+                      (unless (eq old new)
+                        (setf (%instance-ref tree i) new))))
+                  (do ((i 0 (1+ i)))
+                      ((= i n-untagged))
+                    (let* ((old (%raw-instance-ref/word tree i))
+                           (new (circle-subst old-new-alist old)))
+                      (unless (= old new)
+                        (setf (%raw-instance-ref/word tree i) new))))))
                ((typep tree 'funcallable-instance)
                 (do ((i 1 (1+ i))
                      (end (- (1+ (get-closure-length tree)) sb!vm:funcallable-instance-info-offset)))