X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=065674e1efc01ab88357239e2b002c7c1f7c768a;hb=d25e3478acccec70402ff32554669a982be8e281;hp=3c25cc46ea8ef0a4eca77d954adf01c5c991c206;hpb=cfc3b695e6452907fef6492710777511ac4af979;p=sbcl.git diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 3c25cc4..065674e 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -535,8 +535,14 @@ (kind (cond ((sb!vm:saetp-fixnum-p saetp) :tagged) ((member element-type '(character base-char)) :char) ((eq element-type 'single-float) :single-float) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) ((eq element-type 'double-float) :double-float) - (t :bits))) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((equal element-type '(complex single-float)) + :complex-single-float) + (t + (aver (integer-type-p element-ctype)) + :bits))) ;; BASH-VALUE is a word that we can repeatedly smash ;; on the array: for less-than-word sized elements it ;; contains multiple copies of the fill item. @@ -556,9 +562,14 @@ tmp) (:single-float (single-float-bits tmp)) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) (:double-float (logior (ash (double-float-high-bits tmp) 32) - (double-float-low-bits tmp)))))) + (double-float-low-bits tmp))) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (:complex-single-float + (logior (ash (single-float-bits (imagpart tmp)) 32) + (single-float-bits (realpart tmp))))))) (res bits)) (loop for i of-type sb!vm:word from n-bits by n-bits until (= i sb!vm:n-word-bits) @@ -575,9 +586,14 @@ `item) (:single-float `(single-float-bits item)) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) (:double-float `(logior (ash (double-float-high-bits item) 32) - (double-float-low-bits item)))))) + (double-float-low-bits item))) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (:complex-single-float + `(logior (ash (single-float-bits (imagpart item)) 32) + (single-float-bits (realpart item))))))) (res bits)) (declare (type sb!vm:word res)) ,@(unless (= sb!vm:n-word-bits n-bits)