0.9.1.63:

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

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 5694a74..a7a33b7 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -349,7 +349,7 @@
            (if (null splice)
                (setq list (cdr x))
                (rplacd splice (cdr x))))
-          (T (setq splice x)))))
+          (t (setq splice x)))))
 
 (deftransform fill ((seq item &key (start 0) (end (length seq)))
                    (vector t &key (:start t) (:end index))
@@ -683,6 +683,10 @@
 (defun valid-bit-bash-saetp-p (saetp)
   ;; BIT-BASHing isn't allowed on simple vectors that contain pointers
   (and (not (eq t (sb!vm:saetp-specifier saetp)))
+       ;; Disallowing (VECTOR NIL) also means that we won't transform
+       ;; sequence functions into bit-bashing code and we let the
+       ;; generic sequence functions signal errors if necessary.
+       (not (zerop (sb!vm:saetp-n-bits saetp)))
        ;; Due to limitations with the current BIT-BASHing code, we can't
        ;; BIT-BASH reliably on arrays whose element types are larger
        ;; than the word size.
@@ -699,7 +703,7 @@
              collect
              (let* ((sequence-type `(simple-array ,(sb!vm:saetp-specifier saetp) (*)))
                     (n-element-bits (sb!vm:saetp-n-bits saetp))
-                    (bash-function (intern (format nil "UB~A-BASH-COPY" n-element-bits)
+                    (bash-function (intern (format nil "UB~D-BASH-COPY" n-element-bits)
                                             (find-package "SB!KERNEL"))))
                `(deftransform replace ((seq1 seq2 &key (start1 0) (start2 0) end1 end2)
                                        (,sequence-type ,sequence-type &rest t)
@@ -733,7 +737,7 @@
              collect
              (let* ((sequence-type `(simple-array ,(sb!vm:saetp-specifier saetp) (*)))
                     (n-element-bits (sb!vm:saetp-n-bits saetp))
-                    (bash-function (intern (format nil "UB~A-BASH-COPY" n-element-bits)
+                    (bash-function (intern (format nil "UB~D-BASH-COPY" n-element-bits)
                                            (find-package "SB!KERNEL"))))
                `(deftransform subseq ((seq start &optional end)
                                       (,sequence-type t &optional t)
@@ -760,7 +764,7 @@
              collect
              (let* ((sequence-type `(simple-array ,(sb!vm:saetp-specifier saetp) (*)))
                     (n-element-bits (sb!vm:saetp-n-bits saetp))
-                    (bash-function (intern (format nil "UB~A-BASH-COPY" n-element-bits)
+                    (bash-function (intern (format nil "UB~D-BASH-COPY" n-element-bits)
                                            (find-package "SB!KERNEL"))))
                `(deftransform copy-seq ((seq) (,sequence-type)
                                         ,sequence-type)
@@ -812,17 +816,21 @@
   (loop for rest-seqs on sequences
         for n-seq = (gensym "N-SEQ")
         for n-length = (gensym "N-LENGTH")
-        for start = vector-data-bit-offset then next-start
+        for start = 0 then next-start
         for next-start = (gensym "NEXT-START")
         collect n-seq into args
-        collect `(,n-length (* (length ,n-seq) sb!vm:n-byte-bits)) into lets
+        collect `(,n-length (length ,n-seq)) into lets
         collect n-length into all-lengths
         collect next-start into starts
         collect `(if (and (typep ,n-seq '(simple-array nil (*)))
                          (> ,n-length 0))
                     (error 'nil-array-accessed-error)
-                    (bit-bash-copy ,n-seq ,vector-data-bit-offset
-                                   res ,start ,n-length))
+                     (#.(let* ((i (position 'character sb!kernel::*specialized-array-element-types*))
+                               (saetp (aref sb!vm:*specialized-array-element-type-properties* i))
+                               (n-bits (sb!vm:saetp-n-bits saetp)))
+                          (intern (format nil "UB~D-BASH-COPY" n-bits)
+                                  "SB!KERNEL"))
+                        ,n-seq 0 res ,start ,n-length))
                 into forms
         collect `(setq ,next-start (+ ,start ,n-length)) into forms
         finally
@@ -830,9 +838,8 @@
           `(lambda (rtype ,@args)
              (declare (ignore rtype))
              (let* (,@lets
-                      (res (make-string (truncate (the index (+ ,@all-lengths))
-                                                  sb!vm:n-byte-bits)
-                                        :element-type 'base-char)))
+                    (res (make-string (the index (+ ,@all-lengths))
+                                      :element-type 'base-char)))
                (declare (type index ,@all-lengths))
                (let (,@(mapcar (lambda (name) `(,name 0)) starts))
                  (declare (type index ,@starts))