|
569 | 569 | #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) |
570 | 570 | (:complex-single-float |
571 | 571 | (logior (ash (single-float-bits (imagpart tmp)) 32) |
572 | | - (single-float-bits (realpart tmp))))))) |
| 572 | + (ldb (byte 32 0) |
| 573 | + (single-float-bits (realpart tmp)))))))) |
573 | 574 | (res bits)) |
574 | 575 | (loop for i of-type sb!vm:word from n-bits by n-bits |
575 | 576 | until (= i sb!vm:n-word-bits) |
576 | 577 | do (setf res (ldb (byte sb!vm:n-word-bits 0) |
577 | 578 | (logior res (ash bits i))))) |
578 | 579 | res)) |
579 | | - `(let* ((bits (ldb (byte ,n-bits 0) |
580 | | - ,(ecase kind |
581 | | - (:tagged |
582 | | - `(ash item ,sb!vm:n-fixnum-tag-bits)) |
583 | | - (:char |
584 | | - `(char-code item)) |
585 | | - (:bits |
586 | | - `item) |
587 | | - (:single-float |
588 | | - `(single-float-bits item)) |
589 | | - #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) |
590 | | - (:double-float |
591 | | - `(logior (ash (double-float-high-bits item) 32) |
592 | | - (double-float-low-bits item))) |
593 | | - #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) |
594 | | - (:complex-single-float |
595 | | - `(logior (ash (single-float-bits (imagpart item)) 32) |
596 | | - (single-float-bits (realpart item))))))) |
597 | | - (res bits)) |
598 | | - (declare (type sb!vm:word res)) |
599 | | - ,@(unless (= sb!vm:n-word-bits n-bits) |
600 | | - `((loop for i of-type sb!vm:word from ,n-bits by ,n-bits |
601 | | - until (= i sb!vm:n-word-bits) |
602 | | - do (setf res |
603 | | - (ldb (byte ,sb!vm:n-word-bits 0) |
604 | | - (logior res (ash bits (truly-the (integer 0 ,(- sb!vm:n-word-bits n-bits)) i)))))))) |
605 | | - res)))) |
| 580 | + (progn |
| 581 | + (delay-ir1-transform node :constraint) |
| 582 | + `(let* ((bits (ldb (byte ,n-bits 0) |
| 583 | + ,(ecase kind |
| 584 | + (:tagged |
| 585 | + `(ash item ,sb!vm:n-fixnum-tag-bits)) |
| 586 | + (:char |
| 587 | + `(char-code item)) |
| 588 | + (:bits |
| 589 | + `item) |
| 590 | + (:single-float |
| 591 | + `(single-float-bits item)) |
| 592 | + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) |
| 593 | + (:double-float |
| 594 | + `(logior (ash (double-float-high-bits item) 32) |
| 595 | + (double-float-low-bits item))) |
| 596 | + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) |
| 597 | + (:complex-single-float |
| 598 | + `(logior (ash (single-float-bits (imagpart item)) 32) |
| 599 | + (ldb (byte 32 0) |
| 600 | + (single-float-bits (realpart item)))))))) |
| 601 | + (res bits)) |
| 602 | + (declare (type sb!vm:word res)) |
| 603 | + ,@(unless (= sb!vm:n-word-bits n-bits) |
| 604 | + `((loop for i of-type sb!vm:word from ,n-bits by ,n-bits |
| 605 | + until (= i sb!vm:n-word-bits) |
| 606 | + do (setf res |
| 607 | + (ldb (byte ,sb!vm:n-word-bits 0) |
| 608 | + (logior res (ash bits (truly-the (integer 0 ,(- sb!vm:n-word-bits n-bits)) i)))))))) |
| 609 | + res))))) |
606 | 610 | (values |
607 | 611 | `(with-array-data ((data seq) |
608 | 612 | (start start) |
|
0 commit comments