sb!vm:bignum-digits-offset
index offset))
-#!+x86
-(progn
-(define-source-transform sb!kernel:%vector-raw-bits (thing index)
- `(sb!kernel:%raw-bits-with-offset ,thing ,index 2))
-
-(define-source-transform sb!kernel:%raw-bits (thing index)
- `(sb!kernel:%raw-bits-with-offset ,thing ,index 0))
-
-(define-source-transform sb!kernel:%set-vector-raw-bits (thing index value)
- `(sb!kernel:%set-raw-bits-with-offset ,thing ,index 2 ,value))
-
-(define-source-transform sb!kernel:%set-raw-bits (thing index value)
- `(sb!kernel:%set-raw-bits-with-offset ,thing ,index 0 ,value))
-
-(deftransform sb!kernel:%raw-bits-with-offset ((thing index offset) * * :node node)
- (fold-index-addressing 'sb!kernel:%raw-bits-with-offset
- sb!vm:n-word-bits sb!vm:other-pointer-lowtag
- 0 index offset))
-
-(deftransform sb!kernel:%set-raw-bits-with-offset ((thing index offset value) * *)
- (fold-index-addressing 'sb!kernel:%set-raw-bits-with-offset
- sb!vm:n-word-bits sb!vm:other-pointer-lowtag
- 0 index offset t))
-) ; PROGN
-
;;; The layout is stored in slot 0.
(define-source-transform %instance-layout (x)
`(truly-the layout (%instance-ref ,x 0)))
((simple-array nil (*))
(data-vector-ref string index))))))
-(deftransform hairy-data-vector-ref ((array index) (array t) *)
+;;; This and the corresponding -SET transform work equally well on non-simple
+;;; arrays, but after benchmarking (on x86), Nikodemus didn't find any cases
+;;; where it actually helped with non-simple arrays -- to the contrary, it
+;;; only made for bigger and up 1o 100% slower code.
+(deftransform hairy-data-vector-ref ((array index) (simple-array t) *)
"avoid runtime dispatch on array element type"
(let ((element-ctype (extract-upgraded-element-type array))
(declared-element-ctype (extract-declared-element-type array)))
((simple-array nil (*))
(data-vector-set string index new-value))))))
+;;; This and the corresponding -REF transform work equally well on non-simple
+;;; arrays, but after benchmarking (on x86), Nikodemus didn't find any cases
+;;; where it actually helped with non-simple arrays -- to the contrary, it
+;;; only made for bigger and up 1o 100% slower code.
(deftransform hairy-data-vector-set ((array index new-value)
- (array t t)
+ (simple-array t t)
*)
"avoid runtime dispatch on array element type"
(let ((element-ctype (extract-upgraded-element-type array))
(:little-endian '(byte ,bits (* bit ,bits)))
(:big-endian '(byte ,bits (- sb!vm:n-word-bits
(* (1+ bit) ,bits)))))
- (%raw-bits vector (+ word sb!vm:vector-data-offset)))))
+ (%vector-raw-bits vector word))))
(deftransform data-vector-set ((vector index new-value)
(,type * *))
`(multiple-value-bind (word bit)
(:big-endian
'(byte ,bits (- sb!vm:n-word-bits
(* (1+ bit) ,bits)))))
- (%raw-bits vector (+ word sb!vm:vector-data-offset)))
+ (%vector-raw-bits vector word))
new-value)))))))
(frob simple-bit-vector 1)
(frob (simple-array (unsigned-byte 2) (*)) 2)
;; are handled by the (1- length), below.
;; CSR, 2002-04-24
result-bit-array
- (do ((index sb!vm:vector-data-offset (1+ index))
- (end-1 (+ sb!vm:vector-data-offset
- ;; bit-vectors of length 1-32
- ;; need precisely one (SETF
- ;; %RAW-BITS), done here in the
- ;; epilogue. - CSR, 2002-04-24
- (truncate (truly-the index (1- length))
- sb!vm:n-word-bits))))
+ (do ((index 0 (1+ index))
+ ;; bit-vectors of length 1-32 need
+ ;; precisely one (SETF %VECTOR-RAW-BITS),
+ ;; done here in the epilogue. - CSR,
+ ;; 2002-04-24
+ (end-1 (truncate (truly-the index (1- length))
+ sb!vm:n-word-bits)))
((>= index end-1)
- (setf (%raw-bits result-bit-array index)
- (,',wordfun (%raw-bits bit-array-1 index)
- (%raw-bits bit-array-2 index)))
+ (setf (%vector-raw-bits result-bit-array index)
+ (,',wordfun (%vector-raw-bits bit-array-1 index)
+ (%vector-raw-bits bit-array-2 index)))
result-bit-array)
(declare (optimize (speed 3) (safety 0))
(type index index end-1))
- (setf (%raw-bits result-bit-array index)
- (,',wordfun (%raw-bits bit-array-1 index)
- (%raw-bits bit-array-2 index))))))))))
+ (setf (%vector-raw-bits result-bit-array index)
+ (,',wordfun (%vector-raw-bits bit-array-1 index)
+ (%vector-raw-bits bit-array-2 index))))))))))
(def bit-and word-logical-and)
(def bit-ior word-logical-or)
(def bit-xor word-logical-xor)
;; n-word-bits cases are handled by the (1- length), below.
;; CSR, 2002-04-24
result-bit-array
- (do ((index sb!vm:vector-data-offset (1+ index))
- (end-1 (+ sb!vm:vector-data-offset
- ;; bit-vectors of length 1 to n-word-bits need
- ;; precisely one (SETF %RAW-BITS), done here in
- ;; the epilogue. - CSR, 2002-04-24
- (truncate (truly-the index (1- length))
- sb!vm:n-word-bits))))
+ (do ((index 0 (1+ index))
+ ;; bit-vectors of length 1 to n-word-bits need precisely
+ ;; one (SETF %VECTOR-RAW-BITS), done here in the
+ ;; epilogue. - CSR, 2002-04-24
+ (end-1 (truncate (truly-the index (1- length))
+ sb!vm:n-word-bits)))
((>= index end-1)
- (setf (%raw-bits result-bit-array index)
- (word-logical-not (%raw-bits bit-array index)))
+ (setf (%vector-raw-bits result-bit-array index)
+ (word-logical-not (%vector-raw-bits bit-array index)))
result-bit-array)
(declare (optimize (speed 3) (safety 0))
(type index index end-1))
- (setf (%raw-bits result-bit-array index)
- (word-logical-not (%raw-bits bit-array index))))))))
+ (setf (%vector-raw-bits result-bit-array index)
+ (word-logical-not (%vector-raw-bits bit-array index))))))))
(deftransform bit-vector-= ((x y) (simple-bit-vector simple-bit-vector))
`(and (= (length x) (length y))
(let ((length (length x)))
(or (= length 0)
- (do* ((i sb!vm:vector-data-offset (+ i 1))
- (end-1 (+ sb!vm:vector-data-offset
- (floor (1- length) sb!vm:n-word-bits))))
+ (do* ((i 0 (+ i 1))
+ (end-1 (floor (1- length) sb!vm:n-word-bits)))
((>= i end-1)
(let* ((extra (1+ (mod (1- length) sb!vm:n-word-bits)))
(mask (ash #.(1- (ash 1 sb!vm:n-word-bits))
(:little-endian 0)
(:big-endian
'(- sb!vm:n-word-bits extra))))
- (%raw-bits x i)))
+ (%vector-raw-bits x i)))
(numy
(logand
(ash mask
(:little-endian 0)
(:big-endian
'(- sb!vm:n-word-bits extra))))
- (%raw-bits y i))))
+ (%vector-raw-bits y i))))
(declare (type (integer 1 #.sb!vm:n-word-bits) extra)
(type sb!vm:word mask numx numy))
(= numx numy)))
(declare (type index i end-1))
- (let ((numx (%raw-bits x i))
- (numy (%raw-bits y i)))
+ (let ((numx (%vector-raw-bits x i))
+ (numy (%vector-raw-bits y i)))
(declare (type sb!vm:word numx numy))
(unless (= numx numy)
(return nil))))))))
`(let ((length (length sequence)))
(if (zerop length)
0
- (do ((index sb!vm:vector-data-offset (1+ index))
+ (do ((index 0 (1+ index))
(count 0)
- (end-1 (+ sb!vm:vector-data-offset
- (truncate (truly-the index (1- length))
- sb!vm:n-word-bits))))
+ (end-1 (truncate (truly-the index (1- length))
+ sb!vm:n-word-bits)))
((>= index end-1)
(let* ((extra (1+ (mod (1- length) sb!vm:n-word-bits)))
(mask (ash #.(1- (ash 1 sb!vm:n-word-bits))
(:little-endian 0)
(:big-endian
'(- sb!vm:n-word-bits extra))))
- (%raw-bits sequence index))))
+ (%vector-raw-bits sequence index))))
(declare (type (integer 1 #.sb!vm:n-word-bits) extra))
(declare (type sb!vm:word mask bits))
(incf count (logcount bits))
count))))
(declare (type index index count end-1)
(optimize (speed 3) (safety 0)))
- (incf count (logcount (%raw-bits sequence index)))))))
+ (incf count (logcount (%vector-raw-bits sequence index)))))))
(deftransform fill ((sequence item) (simple-bit-vector bit) *
:policy (>= speed space))
(value ,value))
(if (= length 0)
sequence
- (do ((index sb!vm:vector-data-offset (1+ index))
- (end-1 (+ sb!vm:vector-data-offset
- ;; bit-vectors of length 1 to n-word-bits need
- ;; precisely one (SETF %RAW-BITS), done here
- ;; in the epilogue. - CSR, 2002-04-24
- (truncate (truly-the index (1- length))
- sb!vm:n-word-bits))))
+ (do ((index 0 (1+ index))
+ ;; bit-vectors of length 1 to n-word-bits need precisely
+ ;; one (SETF %VECTOR-RAW-BITS), done here in the
+ ;; epilogue. - CSR, 2002-04-24
+ (end-1 (truncate (truly-the index (1- length))
+ sb!vm:n-word-bits)))
((>= index end-1)
- (setf (%raw-bits sequence index) value)
+ (setf (%vector-raw-bits sequence index) value)
sequence)
(declare (optimize (speed 3) (safety 0))
(type index index end-1))
- (setf (%raw-bits sequence index) value))))))
+ (setf (%vector-raw-bits sequence index) value))))))
(deftransform fill ((sequence item) (simple-base-string base-char) *
:policy (>= speed space))
(value ,value))
(multiple-value-bind (times rem)
(truncate length sb!vm:n-word-bytes)
- (do ((index sb!vm:vector-data-offset (1+ index))
- (end (+ times sb!vm:vector-data-offset)))
+ (do ((index 0 (1+ index))
+ (end times))
((>= index end)
(let ((place (* times sb!vm:n-word-bytes)))
(declare (fixnum place))
(setf (schar sequence (the index (+ place j))) item))))
(declare (optimize (speed 3) (safety 0))
(type index index))
- (setf (%raw-bits sequence index) value))))))
+ (setf (%vector-raw-bits sequence index) value))))))
\f
;;;; %BYTE-BLT
(values)))
\f
;;;; transforms for EQL of floating point values
-
+#!-float-eql-vops
(deftransform eql ((x y) (single-float single-float))
'(= (single-float-bits x) (single-float-bits y)))
+#!-float-eql-vops
(deftransform eql ((x y) (double-float double-float))
'(and (= (double-float-low-bits x) (double-float-low-bits y))
(= (double-float-high-bits x) (double-float-high-bits y))))
projects / sbcl.git / blobdiff