mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
238 lines
13 KiB
Common Lisp
238 lines
13 KiB
Common Lisp
(in-package #:sb-vm)
|
|
|
|
;;; Both load- and store VOPs are augmented with an auxiliary last argument
|
|
;;; that is a constant addend for the address calculation. This addend is
|
|
;;; zero by default, but we can sometimes transform the code for the index
|
|
;;; calculation such that we have a nonzero addend. We also generate two
|
|
;;; variants of the VOP - one for the general case, and one for the case
|
|
;;; where the index is a compile-time constant.
|
|
|
|
#+(or x86 x86-64)
|
|
(macrolet
|
|
((define-vref-vop (vref-record-name)
|
|
(with-accessors ((name sb-simd-internals:vref-record-name)
|
|
(vop sb-simd-internals:vref-record-vop)
|
|
(vop-c sb-simd-internals:vref-record-vop-c)
|
|
(mnemonic sb-simd-internals:vref-record-mnemonic)
|
|
(value-record sb-simd-internals:vref-record-value-record)
|
|
(vector-record sb-simd-internals:vref-record-vector-record)
|
|
(store sb-simd-internals:store-record-p)
|
|
(sap-ref sb-simd-internals:vref-record-sap-ref))
|
|
(sb-simd-internals:find-function-record vref-record-name)
|
|
(let* ((sap-vop (when sap-ref (sb-simd-internals:mksym (symbol-package name) (if store "%SET-" "%") sap-ref)))
|
|
(sap-vop-c (when sap-ref (sb-simd-internals:mksym (symbol-package name) (if store "%SET-" "%") sap-ref "-C")))
|
|
(vector-type (sb-simd-internals:value-record-type vector-record))
|
|
(vector-primitive-type (sb-simd-internals:value-record-primitive-type vector-record))
|
|
(value-scs (sb-simd-internals:value-record-scs value-record))
|
|
(value-type (sb-simd-internals:value-record-type value-record))
|
|
(value-primitive-type (sb-simd-internals:value-record-primitive-type value-record))
|
|
(scalar-record
|
|
(etypecase value-record
|
|
(sb-simd-internals:simd-record (sb-simd-internals:simd-record-scalar-record value-record))
|
|
(sb-simd-internals:value-record value-record)))
|
|
(bits-per-element (sb-simd-internals:value-record-bits scalar-record))
|
|
(bytes-per-element (ceiling bits-per-element 8))
|
|
(displacement
|
|
(multiple-value-bind (lo hi)
|
|
(displacement-bounds other-pointer-lowtag bits-per-element vector-data-offset)
|
|
`(integer ,lo ,hi))))
|
|
(multiple-value-bind (index-scs scale)
|
|
(if (>= bytes-per-element (ash 1 n-fixnum-tag-bits))
|
|
(values '(any-reg signed-reg unsigned-reg) `(index-scale ,bytes-per-element index))
|
|
(values '(signed-reg unsigned-reg) bytes-per-element))
|
|
`(progn
|
|
(defknown ,vop (,@(when store `(,value-type)) ,vector-type index ,displacement)
|
|
(values ,value-type &optional)
|
|
(always-translatable)
|
|
:overwrite-fndb-silently t)
|
|
(define-vop (,vop)
|
|
(:translate ,vop)
|
|
(:policy :fast-safe)
|
|
(:args
|
|
,@(when store `((value :scs ,value-scs :target result)))
|
|
(vector :scs (descriptor-reg))
|
|
(index :scs ,index-scs))
|
|
(:info addend)
|
|
(:arg-types
|
|
,@(when store `(,value-primitive-type))
|
|
,vector-primitive-type
|
|
positive-fixnum
|
|
(:constant ,displacement))
|
|
(:results (result :scs ,value-scs))
|
|
(:result-types ,value-primitive-type)
|
|
(:generator
|
|
2
|
|
,@(let ((ea `(ea (+ (* vector-data-offset n-word-bytes)
|
|
(* addend ,bytes-per-element)
|
|
(- other-pointer-lowtag))
|
|
vector index ,scale)))
|
|
(if store
|
|
`((inst ,mnemonic ,ea value)
|
|
(move result value))
|
|
`((inst ,mnemonic result ,ea))))))
|
|
(define-vop (,vop-c)
|
|
(:translate ,vop)
|
|
(:policy :fast-safe)
|
|
(:args ,@(when store `((value :scs ,value-scs :target result)))
|
|
(vector :scs (descriptor-reg)))
|
|
(:info index addend)
|
|
(:arg-types ,@(when store `(,value-primitive-type))
|
|
,vector-primitive-type
|
|
(:constant low-index)
|
|
(:constant ,displacement))
|
|
(:results (result :scs ,value-scs))
|
|
(:result-types ,value-primitive-type)
|
|
(:generator
|
|
1
|
|
,@(let ((ea `(ea (+ (* vector-data-offset n-word-bytes)
|
|
(* ,bytes-per-element (+ index addend))
|
|
(- other-pointer-lowtag))
|
|
vector)))
|
|
(if store
|
|
`((inst ,mnemonic ,ea value)
|
|
(move result value))
|
|
`((inst ,mnemonic result ,ea))))))
|
|
,@(when sap-ref
|
|
`((sb-c:defknown ,sap-vop (,@(when store `(,value-type))
|
|
sb-alien:system-area-pointer index ,displacement)
|
|
(values ,value-type &optional) (always-translatable) :overwrite-fndb-silently t)
|
|
(define-vop (,sap-vop)
|
|
(:translate ,sap-vop)
|
|
(:policy :fast-safe)
|
|
(:args ,@(when store `((value :scs ,value-scs :target result)))
|
|
(sap :scs (sap-reg))
|
|
(index :scs ,index-scs))
|
|
(:info addend)
|
|
(:arg-types ,@(when store `(,value-primitive-type))
|
|
sb-alien:system-area-pointer positive-fixnum
|
|
(:constant ,displacement))
|
|
(:results (result :scs ,value-scs))
|
|
(:result-types ,value-primitive-type)
|
|
(:generator 2
|
|
,@(let ((ea `(ea (* addend ,bytes-per-element) sap index ,scale)))
|
|
(if store
|
|
`((inst ,mnemonic ,ea value) (move result value))
|
|
`((inst ,mnemonic result ,ea))))))
|
|
(define-vop (,sap-vop-c)
|
|
(:translate ,sap-vop)
|
|
(:policy :fast-safe)
|
|
(:args ,@(when store `((value :scs ,value-scs :target result)))
|
|
(sap :scs (sap-reg)))
|
|
(:info index addend)
|
|
(:arg-types ,@(when store `(,value-primitive-type))
|
|
sb-alien:system-area-pointer
|
|
(:constant low-index)
|
|
(:constant ,displacement))
|
|
(:results (result :scs ,value-scs))
|
|
(:result-types ,value-primitive-type)
|
|
(:generator 1
|
|
,@(let ((ea `(ea (* ,bytes-per-element (+ index addend)) sap)))
|
|
(if store
|
|
`((inst ,mnemonic ,ea value) (move result value))
|
|
`((inst ,mnemonic result ,ea)))))))))))))
|
|
(define-vref-vops ()
|
|
`(progn
|
|
,@(loop for vref-record
|
|
in (sb-simd-internals:filter-available-function-records
|
|
#'sb-simd-internals:vref-record-p)
|
|
collect `(define-vref-vop ,(sb-simd-internals:vref-record-name vref-record))))))
|
|
(define-vref-vops))
|
|
|
|
#+arm64
|
|
(macrolet
|
|
((define-vref-vop (vref-record-name)
|
|
(with-accessors ((name sb-simd-internals:vref-record-name)
|
|
(vop sb-simd-internals:vref-record-vop)
|
|
(value-record sb-simd-internals:vref-record-value-record)
|
|
(vector-record sb-simd-internals:vref-record-vector-record)
|
|
(store sb-simd-internals:store-record-p)
|
|
(sap-ref sb-simd-internals:vref-record-sap-ref))
|
|
(sb-simd-internals:find-function-record vref-record-name)
|
|
(let* ((vector-type (sb-simd-internals:value-record-type vector-record))
|
|
(vector-primitive-type (sb-simd-internals:value-record-primitive-type vector-record))
|
|
(value-scs (sb-simd-internals:value-record-scs value-record))
|
|
(value-type (sb-simd-internals:value-record-type value-record))
|
|
(value-primitive-type (sb-simd-internals:value-record-primitive-type value-record))
|
|
(scalar-record
|
|
(etypecase value-record
|
|
(sb-simd-internals:simd-record (sb-simd-internals:simd-record-scalar-record value-record))
|
|
(sb-simd-internals:value-record value-record)))
|
|
(bits-per-element (sb-simd-internals:value-record-bits scalar-record))
|
|
(bytes-per-element (ceiling bits-per-element 8))
|
|
(shift (1- (integer-length bytes-per-element)))
|
|
(sap-vop (when sap-ref
|
|
(sb-simd-internals:mksym (symbol-package name) (if store "%SET-" "%") sap-ref))))
|
|
`(progn
|
|
(defknown ,vop (,@(when store `(,value-type)) ,vector-type index (integer 0 0))
|
|
(values ,value-type &optional)
|
|
(always-translatable)
|
|
:overwrite-fndb-silently t)
|
|
(define-vop (,vop)
|
|
(:translate ,vop)
|
|
(:policy :fast-safe)
|
|
(:args ,@(when store `((value :scs (,@value-scs zero))))
|
|
(object :scs (descriptor-reg))
|
|
(index :scs (any-reg unsigned-reg signed-reg immediate)))
|
|
(:arg-types ,@(when store `(,value-primitive-type))
|
|
,vector-primitive-type
|
|
tagged-num
|
|
(:constant (integer 0 0)))
|
|
(:info addend) ; always zero
|
|
,@(unless store
|
|
`((:results (value :scs ,value-scs))
|
|
(:result-types ,value-primitive-type)))
|
|
(:generator 2
|
|
(let ((addend addend))
|
|
(declare (ignore addend))
|
|
(sc-case index
|
|
(immediate
|
|
(inst ,(if store 'str 'ldr)
|
|
value
|
|
(@ object (load-store-offset
|
|
(+ (ash (tn-value index) ,shift)
|
|
(- (ash vector-data-offset word-shift)
|
|
other-pointer-lowtag))))))
|
|
(t
|
|
(let ((shift ,shift))
|
|
(when (sc-is index any-reg)
|
|
(decf shift n-fixnum-tag-bits))
|
|
(inst add tmp-tn object (if (minusp shift)
|
|
(asr index (- shift))
|
|
(lsl index shift))))
|
|
(inst ,(if store 'str 'ldr)
|
|
value
|
|
(@ tmp-tn (load-store-offset (- (ash vector-data-offset word-shift)
|
|
other-pointer-lowtag)))))))))
|
|
,@(when sap-vop
|
|
`((sb-c:defknown ,sap-vop (,@(when store `(,value-type))
|
|
sb-sys:system-area-pointer index (integer 0 0))
|
|
(values ,value-type &optional)
|
|
(always-translatable)
|
|
:overwrite-fndb-silently t)
|
|
(define-vop (,sap-vop)
|
|
(:translate ,sap-vop)
|
|
(:policy :fast-safe)
|
|
(:args ,@(when store `((value :scs (,@value-scs zero))))
|
|
(sap :scs (sap-reg))
|
|
(offset :scs (signed-reg)))
|
|
(:info addend)
|
|
(:arg-types ,@(when store `(,value-primitive-type))
|
|
system-area-pointer
|
|
signed-num
|
|
(:constant (integer 0 0)))
|
|
,@(unless store
|
|
`((:results (value :scs ,value-scs))
|
|
(:result-types ,value-primitive-type)))
|
|
(:generator 1
|
|
(let ((addend addend))
|
|
(declare (ignore addend))
|
|
(inst ,(if store 'str 'ldr) value
|
|
(@ sap offset)))))))))))
|
|
(define-vref-vops ()
|
|
`(progn
|
|
,@(loop for vref-record
|
|
in (sb-simd-internals:filter-available-function-records
|
|
#'sb-simd-internals:vref-record-p)
|
|
collect `(define-vref-vop ,(sb-simd-internals:vref-record-name vref-record))))))
|
|
(define-vref-vops))
|