(defknown int-sap ((unsigned-byte #.sb!vm::n-machine-word-bits))
system-area-pointer (movable))
-(defknown sap-ref-8 (system-area-pointer fixnum) (unsigned-byte 8)
- (flushable))
-(defknown %set-sap-ref-8 (system-area-pointer fixnum (unsigned-byte 8))
- (unsigned-byte 8)
- ())
+(macrolet ((defsapref (fun value-type)
+ (let (#!+x86
+ (with-offset-fun (intern (format nil "~A-WITH-OFFSET" fun)))
+ (set-fun (intern (format nil "%SET-~A" fun)))
+ #!+x86
+ (set-with-offset-fun (intern (format nil "%SET-~A-WITH-OFFSET" fun))))
+ `(progn
+ (defknown ,fun (system-area-pointer fixnum) ,value-type
+ (flushable))
+ #!+x86
+ (defknown ,with-offset-fun (system-area-pointer fixnum fixnum) ,value-type
+ (flushable always-translatable))
+ (defknown ,set-fun (system-area-pointer fixnum ,value-type) ,value-type
+ ())
+ #!+x86
+ (defknown ,set-with-offset-fun (system-area-pointer fixnum fixnum ,value-type) ,value-type
+ (always-translatable))))))
+ (defsapref sap-ref-8 (unsigned-byte 8))
+ (defsapref sap-ref-16 (unsigned-byte 16))
+ (defsapref sap-ref-32 (unsigned-byte 32))
+ (defsapref sap-ref-64 (unsigned-byte 64))
+ (defsapref sap-ref-word (unsigned-byte #.sb!vm:n-word-bits))
+ (defsapref signed-sap-ref-8 (signed-byte 8))
+ (defsapref signed-sap-ref-16 (signed-byte 16))
+ (defsapref signed-sap-ref-32 (signed-byte 32))
+ (defsapref signed-sap-ref-64 (signed-byte 64))
+ (defsapref signed-sap-ref-word (signed-byte #.sb!vm:n-word-bits))
+ (defsapref sap-ref-sap system-area-pointer)
+ (defsapref sap-ref-single single-float)
+ (defsapref sap-ref-double double-float)
+ (defsapref sap-ref-long long-float)
+) ; MACROLET
-(defknown sap-ref-16 (system-area-pointer fixnum) (unsigned-byte 16)
- (flushable))
-(defknown %set-sap-ref-16 (system-area-pointer fixnum (unsigned-byte 16))
- (unsigned-byte 16)
- ())
-
-(defknown sap-ref-32 (system-area-pointer fixnum) (unsigned-byte 32)
- (flushable))
-(defknown %set-sap-ref-32 (system-area-pointer fixnum (unsigned-byte 32))
- (unsigned-byte 32)
- ())
-
-;; FIXME These are supported natively on alpha and using deftransforms
-;; in compiler/x86/sap.lisp, which in OAO$n$ style need copying to
-;; other 32 bit systems
-(defknown sap-ref-64 (system-area-pointer fixnum) (unsigned-byte 64)
- (flushable))
-(defknown %set-sap-ref-64 (system-area-pointer fixnum (unsigned-byte 64))
- (unsigned-byte 64)
- ())
-
-(defknown sap-ref-word (system-area-pointer fixnum)
- (unsigned-byte #.sb!vm::n-machine-word-bits)
- (flushable))
-(defknown %set-sap-ref-word
- (system-area-pointer fixnum (unsigned-byte #.sb!vm::n-machine-word-bits))
- (unsigned-byte #.sb!vm::n-machine-word-bits)
- ())
-
-(defknown signed-sap-ref-8 (system-area-pointer fixnum) (signed-byte 8)
- (flushable))
-(defknown %set-signed-sap-ref-8 (system-area-pointer fixnum (signed-byte 8))
- (signed-byte 8)
- ())
-
-(defknown signed-sap-ref-16 (system-area-pointer fixnum) (signed-byte 16)
- (flushable))
-(defknown %set-signed-sap-ref-16 (system-area-pointer fixnum (signed-byte 16))
- (signed-byte 16)
- ())
-
-(defknown signed-sap-ref-32 (system-area-pointer fixnum) (signed-byte 32)
- (flushable))
-(defknown %set-signed-sap-ref-32 (system-area-pointer fixnum (signed-byte 32))
- (signed-byte 32)
- ())
-
-(defknown signed-sap-ref-64 (system-area-pointer fixnum) (signed-byte 64)
- (flushable))
-(defknown %set-signed-sap-ref-64 (system-area-pointer fixnum (signed-byte 64))
- (signed-byte 64)
- ())
-
-(defknown signed-sap-ref-word (system-area-pointer fixnum)
- (signed-byte #.sb!vm::n-machine-word-bits)
- (flushable))
-(defknown %set-signed-sap-ref-word
- (system-area-pointer fixnum (signed-byte #.sb!vm::n-machine-word-bits))
- (signed-byte #.sb!vm::n-machine-word-bits)
- ())
-
-(defknown sap-ref-sap (system-area-pointer fixnum) system-area-pointer
- (flushable))
-(defknown %set-sap-ref-sap (system-area-pointer fixnum system-area-pointer)
- system-area-pointer
- ())
-
-(defknown sap-ref-single (system-area-pointer fixnum) single-float
- (flushable))
-(defknown sap-ref-double (system-area-pointer fixnum) double-float
- (flushable))
-#!+(or x86 long-float)
-(defknown sap-ref-long (system-area-pointer fixnum) long-float
- (flushable))
-
-(defknown %set-sap-ref-single
- (system-area-pointer fixnum single-float) single-float
- ())
-(defknown %set-sap-ref-double
- (system-area-pointer fixnum double-float) double-float
- ())
-#!+long-float
-(defknown %set-sap-ref-long
- (system-area-pointer fixnum long-float) long-float
- ())
\f
;;;; transforms for converting sap relation operators
(eql (lvar-value offset) 0))
'sap)
(t
- (extract-fun-args sap 'sap+ 2)
+ (splice-fun-args sap 'sap+ 2)
'(lambda (sap offset1 offset2)
(sap+ sap (+ offset1 offset2))))))
-(macrolet ((def (fun &optional setp)
- `(deftransform ,fun ((sap offset ,@(when setp `(new-value))) * *)
- (extract-fun-args sap 'sap+ 2)
- `(lambda (sap offset1 offset2 ,@',(when setp `(new-value)))
- (,',fun sap (+ offset1 offset2) ,@',(when setp `(new-value)))))))
- (def sap-ref-8)
- (def %set-sap-ref-8 t)
- (def signed-sap-ref-8)
- (def %set-signed-sap-ref-8 t)
- (def sap-ref-16)
- (def %set-sap-ref-16 t)
- (def signed-sap-ref-16)
- (def %set-signed-sap-ref-16 t)
- (def sap-ref-32)
- (def %set-sap-ref-32 t)
- (def signed-sap-ref-32)
- (def %set-signed-sap-ref-32 t)
- (def sap-ref-64)
- (def %set-sap-ref-64 t)
- (def signed-sap-ref-64)
- (def %set-signed-sap-ref-64 t)
- (def sap-ref-sap)
- (def %set-sap-ref-sap t)
- (def sap-ref-single)
- (def %set-sap-ref-single t)
- (def sap-ref-double)
- (def %set-sap-ref-double t)
- ;; The original CMUCL code had #!+(and x86 long-float) for this first one,
- ;; but only #!+long-float for the second. This was redundant, since the
- ;; LONG-FLOAT target feature only exists on X86. So we removed the
- ;; redundancy. --njf 2002-01-08
- #!+long-float (def sap-ref-long)
- #!+long-float (def %set-sap-ref-long t))
+(macrolet ((def (fun element-size &optional setp value-type)
+ (declare (ignorable value-type))
+ `(progn
+ (deftransform ,fun ((sap offset ,@(when setp `(new-value))) * *)
+ (splice-fun-args sap 'sap+ 2)
+ `(lambda (sap offset1 offset2 ,@',(when setp `(new-value)))
+ (,',fun sap (+ offset1 offset2) ,@',(when setp `(new-value)))))
+ ;; Avoid defining WITH-OFFSET transforms for accessors whose
+ ;; sizes are larger than the word size; they'd probably be
+ ;; pointless to optimize anyway and tricky to boot.
+ ,(unless (and (listp value-type)
+ (or (eq (first value-type) 'unsigned-byte)
+ (eq (first value-type) 'signed-byte))
+ (> (second value-type) sb!vm:n-word-bits))
+ #!+x86
+ (let ((with-offset-fun (intern (format nil "~A-WITH-OFFSET" fun))))
+ `(progn
+ ,(cond
+ (setp
+ `(deftransform ,fun ((sap offset new-value)
+ (system-area-pointer fixnum ,value-type) *)
+ `(,',with-offset-fun sap (truly-the fixnum offset) 0 new-value)))
+ (t
+ `(deftransform ,fun ((sap offset) (system-area-pointer fixnum) *)
+ `(,',with-offset-fun sap (truly-the fixnum offset) 0))))
+ (deftransform ,with-offset-fun ((sap offset disp
+ ,@(when setp `(new-value))) * *)
+ (fold-index-addressing ',with-offset-fun
+ ,element-size
+ 0 ; lowtag
+ 0 ; data offset
+ offset disp ,setp))))))))
+ (def sap-ref-8 8)
+ (def %set-sap-ref-8 8 t (unsigned-byte 8))
+ (def signed-sap-ref-8 8)
+ (def %set-signed-sap-ref-8 8 t (signed-byte 8))
+ (def sap-ref-16 16)
+ (def %set-sap-ref-16 16 t (unsigned-byte 16))
+ (def signed-sap-ref-16 16)
+ (def %set-signed-sap-ref-16 16 t (signed-byte 16))
+ (def sap-ref-32 32)
+ (def %set-sap-ref-32 32 t (unsigned-byte 32))
+ (def signed-sap-ref-32 32)
+ (def %set-signed-sap-ref-32 32 t (signed-byte 32))
+ (def sap-ref-64 64)
+ (def %set-sap-ref-64 64 t (unsigned-byte 64))
+ (def signed-sap-ref-64 64)
+ (def %set-signed-sap-ref-64 64 t (signed-byte 64))
+ (def sap-ref-sap sb!vm:n-word-bits)
+ (def %set-sap-ref-sap sb!vm:n-word-bits t system-area-pointer)
+ (def sap-ref-single 32)
+ (def %set-sap-ref-single 32 t single-float)
+ (def sap-ref-double 64)
+ (def %set-sap-ref-double 64 t double-float)
+ #!+long-float (def sap-ref-long 96)
+ #!+long-float (def %set-sap-ref-long 96 t 8))
(macrolet ((def (fun args 32-bit 64-bit)
`(deftransform ,fun (,args)
;;; out of 8, 16, or 32 bit elements.
(macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
`(progn
- (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
+ (define-full-reffer+offset ,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" type)
,type vector-data-offset other-pointer-lowtag ,scs
- ,element-type data-vector-ref)
- (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
+ ,element-type data-vector-ref-with-offset)
+ (define-full-setter+offset ,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" type)
,type vector-data-offset other-pointer-lowtag ,scs
- ,element-type data-vector-set))))
+ ,element-type data-vector-set-with-offset))))
(def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
(def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
unsigned-reg)
(def-full-data-vector-frobs simple-array-signed-byte-32 signed-num
signed-reg)
(def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num
- unsigned-reg))
+ unsigned-reg)
+ #!+sb-unicode
+ (def-full-data-vector-frobs simple-character-string character character-reg))
+
\f
;;;; integer vectors whose elements are smaller than a byte, i.e.,
;;;; bit, 2-bit, and 4-bit vectors
;;; And the float variants.
-(define-vop (data-vector-ref/simple-array-single-float)
+(defun make-ea-for-float-ref (object index offset element-size
+ &key (scale 1) (complex-offset 0))
+ (sc-case index
+ (immediate
+ (make-ea :dword :base object
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* element-size (+ offset complex-offset
+ (tn-value index)))
+ other-pointer-lowtag))))
+ (t
+ (make-ea :dword :base object :index index :scale scale
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* element-size offset)
+ complex-offset)
+ other-pointer-lowtag)))))
+
+(define-vop (data-vector-ref-with-offset/simple-array-single-float)
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
- (index :scs (any-reg)))
- (:arg-types simple-array-single-float positive-fixnum)
+ (index :scs (any-reg immediate)))
+ (:info offset)
+ (:arg-types simple-array-single-float positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 4 vector-data-offset)))
(:results (value :scs (single-reg)))
(:result-types single-float)
(:generator 5
(with-empty-tn@fp-top(value)
- (inst fld (make-ea :dword :base object :index index :scale 1
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag))))))
-
-(define-vop (data-vector-ref-c/simple-array-single-float)
- (:note "inline array access")
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-single-float (:constant (signed-byte 30)))
- (:results (value :scs (single-reg)))
- (:result-types single-float)
- (:generator 4
- (with-empty-tn@fp-top(value)
- (inst fld (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 4 index))
- other-pointer-lowtag))))))
-
-(define-vop (data-vector-set/simple-array-single-float)
- (:note "inline array store")
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (any-reg))
- (value :scs (single-reg) :target result))
- (:arg-types simple-array-single-float positive-fixnum single-float)
- (:results (result :scs (single-reg)))
- (:result-types single-float)
- (:generator 5
- (cond ((zerop (tn-offset value))
- ;; Value is in ST0.
- (inst fst (make-ea :dword :base object :index index :scale 1
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))
- (unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fst result)))
- (t
- ;; Value is not in ST0.
- (inst fxch value)
- (inst fst (make-ea :dword :base object :index index :scale 1
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))
- (cond ((zerop (tn-offset result))
- ;; The result is in ST0.
- (inst fst value))
- (t
- ;; Neither value or result are in ST0
- (unless (location= value result)
- (inst fst result))
- (inst fxch value)))))))
+ (inst fld (make-ea-for-float-ref object index offset 4)))))
-(define-vop (data-vector-set-c/simple-array-single-float)
+(define-vop (data-vector-set-with-offset/simple-array-single-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
+ (index :scs (any-reg immediate))
(value :scs (single-reg) :target result))
- (:info index)
- (:arg-types simple-array-single-float (:constant (signed-byte 30))
+ (:info offset)
+ (:arg-types simple-array-single-float positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 4 vector-data-offset))
single-float)
(:results (result :scs (single-reg)))
(:result-types single-float)
- (:generator 4
+ (:generator 5
(cond ((zerop (tn-offset value))
;; Value is in ST0.
- (inst fst (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 4 index))
- other-pointer-lowtag)))
+ (inst fst (make-ea-for-float-ref object index offset 4))
(unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fst result)))
+ ;; Value is in ST0 but not result.
+ (inst fst result)))
(t
;; Value is not in ST0.
(inst fxch value)
- (inst fst (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 4 index))
- other-pointer-lowtag)))
+ (inst fst (make-ea-for-float-ref object index offset 4))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fst value))
(t
;; Neither value or result are in ST0
(unless (location= value result)
- (inst fst result))
+ (inst fst result))
(inst fxch value)))))))
-(define-vop (data-vector-ref/simple-array-double-float)
+(define-vop (data-vector-ref-with-offset/simple-array-double-float)
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
- (index :scs (any-reg)))
- (:arg-types simple-array-double-float positive-fixnum)
+ (index :scs (any-reg immediate)))
+ (:info offset)
+ (:arg-types simple-array-double-float
+ positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset)))
(:results (value :scs (double-reg)))
(:result-types double-float)
(:generator 7
(with-empty-tn@fp-top(value)
- (inst fldd (make-ea :dword :base object :index index :scale 2
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag))))))
+ (inst fldd (make-ea-for-float-ref object index offset 8 :scale 2)))))
-(define-vop (data-vector-ref-c/simple-array-double-float)
- (:note "inline array access")
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-double-float (:constant (signed-byte 30)))
- (:results (value :scs (double-reg)))
- (:result-types double-float)
- (:generator 6
- (with-empty-tn@fp-top(value)
- (inst fldd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index))
- other-pointer-lowtag))))))
-
-(define-vop (data-vector-set/simple-array-double-float)
+(define-vop (data-vector-set-with-offset/simple-array-double-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
- (index :scs (any-reg))
+ (index :scs (any-reg immediate))
(value :scs (double-reg) :target result))
- (:arg-types simple-array-double-float positive-fixnum double-float)
- (:results (result :scs (double-reg)))
- (:result-types double-float)
- (:generator 20
- (cond ((zerop (tn-offset value))
- ;; Value is in ST0.
- (inst fstd (make-ea :dword :base object :index index :scale 2
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))
- (unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fstd result)))
- (t
- ;; Value is not in ST0.
- (inst fxch value)
- (inst fstd (make-ea :dword :base object :index index :scale 2
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))
- (cond ((zerop (tn-offset result))
- ;; The result is in ST0.
- (inst fstd value))
- (t
- ;; Neither value or result are in ST0
- (unless (location= value result)
- (inst fstd result))
- (inst fxch value)))))))
-
-(define-vop (data-vector-set-c/simple-array-double-float)
- (:note "inline array store")
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (value :scs (double-reg) :target result))
- (:info index)
- (:arg-types simple-array-double-float (:constant (signed-byte 30))
+ (:info offset)
+ (:arg-types simple-array-double-float positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset))
double-float)
(:results (result :scs (double-reg)))
(:result-types double-float)
- (:generator 19
+ (:generator 20
(cond ((zerop (tn-offset value))
;; Value is in ST0.
- (inst fstd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index))
- other-pointer-lowtag)))
+ (inst fstd (make-ea-for-float-ref object index offset 8 :scale 2))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fstd result)))
(t
;; Value is not in ST0.
(inst fxch value)
- (inst fstd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index))
- other-pointer-lowtag)))
+ (inst fstd (make-ea-for-float-ref object index offset 8 :scale 2))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fstd value))
(inst fstd result))
(inst fxch value)))))))
-
-
;;; complex float variants
-(define-vop (data-vector-ref/simple-array-complex-single-float)
+(define-vop (data-vector-ref-with-offset/simple-array-complex-single-float)
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
- (index :scs (any-reg)))
- (:arg-types simple-array-complex-single-float positive-fixnum)
+ (index :scs (any-reg immediate)))
+ (:info offset)
+ (:arg-types simple-array-complex-single-float positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset)))
(:results (value :scs (complex-single-reg)))
(:result-types complex-single-float)
(:generator 5
(let ((real-tn (complex-single-reg-real-tn value)))
(with-empty-tn@fp-top (real-tn)
- (inst fld (make-ea :dword :base object :index index :scale 2
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))))
- (let ((imag-tn (complex-single-reg-imag-tn value)))
- (with-empty-tn@fp-top (imag-tn)
- (inst fld (make-ea :dword :base object :index index :scale 2
- :disp (- (* (1+ vector-data-offset)
- n-word-bytes)
- other-pointer-lowtag)))))))
-
-(define-vop (data-vector-ref-c/simple-array-complex-single-float)
- (:note "inline array access")
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-complex-single-float (:constant (signed-byte 30)))
- (:results (value :scs (complex-single-reg)))
- (:result-types complex-single-float)
- (:generator 4
- (let ((real-tn (complex-single-reg-real-tn value)))
- (with-empty-tn@fp-top (real-tn)
- (inst fld (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index))
- other-pointer-lowtag)))))
+ (inst fld (make-ea-for-float-ref object index offset 8 :scale 2))))
(let ((imag-tn (complex-single-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
- (inst fld (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index) 4)
- other-pointer-lowtag)))))))
+ ;; FIXME
+ (inst fld (make-ea-for-float-ref object index offset 8
+ :scale 2 :complex-offset 4))))))
-(define-vop (data-vector-set/simple-array-complex-single-float)
+(define-vop (data-vector-set-with-offset/simple-array-complex-single-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
- (index :scs (any-reg))
+ (index :scs (any-reg immediate))
(value :scs (complex-single-reg) :target result))
+ (:info offset)
(:arg-types simple-array-complex-single-float positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset))
complex-single-float)
(:results (result :scs (complex-single-reg)))
(:result-types complex-single-float)
(result-real (complex-single-reg-real-tn result)))
(cond ((zerop (tn-offset value-real))
;; Value is in ST0.
- (inst fst (make-ea :dword :base object :index index :scale 2
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))
+ (inst fst (make-ea-for-float-ref object index offset 8 :scale 2))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fst result-real)))
(t
;; Value is not in ST0.
(inst fxch value-real)
- (inst fst (make-ea :dword :base object :index index :scale 2
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))
+ (inst fst (make-ea-for-float-ref object index offset 8 :scale 2))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fst value-real))
(let ((value-imag (complex-single-reg-imag-tn value))
(result-imag (complex-single-reg-imag-tn result)))
(inst fxch value-imag)
- (inst fst (make-ea :dword :base object :index index :scale 2
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- 4)
- other-pointer-lowtag)))
+ (inst fst (make-ea-for-float-ref object index offset 8
+ :scale 2 :complex-offset 4))
(unless (location= value-imag result-imag)
(inst fst result-imag))
(inst fxch value-imag))))
-(define-vop (data-vector-set-c/simple-array-complex-single-float)
- (:note "inline array store")
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (value :scs (complex-single-reg) :target result))
- (:info index)
- (:arg-types simple-array-complex-single-float (:constant (signed-byte 30))
- complex-single-float)
- (:results (result :scs (complex-single-reg)))
- (:result-types complex-single-float)
- (:generator 4
- (let ((value-real (complex-single-reg-real-tn value))
- (result-real (complex-single-reg-real-tn result)))
- (cond ((zerop (tn-offset value-real))
- ;; Value is in ST0.
- (inst fst (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index))
- other-pointer-lowtag)))
- (unless (zerop (tn-offset result-real))
- ;; Value is in ST0 but not result.
- (inst fst result-real)))
- (t
- ;; Value is not in ST0.
- (inst fxch value-real)
- (inst fst (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index))
- other-pointer-lowtag)))
- (cond ((zerop (tn-offset result-real))
- ;; The result is in ST0.
- (inst fst value-real))
- (t
- ;; Neither value or result are in ST0
- (unless (location= value-real result-real)
- (inst fst result-real))
- (inst fxch value-real))))))
- (let ((value-imag (complex-single-reg-imag-tn value))
- (result-imag (complex-single-reg-imag-tn result)))
- (inst fxch value-imag)
- (inst fst (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index) 4)
- other-pointer-lowtag)))
- (unless (location= value-imag result-imag)
- (inst fst result-imag))
- (inst fxch value-imag))))
-
-
-(define-vop (data-vector-ref/simple-array-complex-double-float)
+(define-vop (data-vector-ref-with-offset/simple-array-complex-double-float)
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
- (index :scs (any-reg)))
- (:arg-types simple-array-complex-double-float positive-fixnum)
+ (index :scs (any-reg immediate)))
+ (:info offset)
+ (:arg-types simple-array-complex-double-float positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 16 vector-data-offset)))
(:results (value :scs (complex-double-reg)))
(:result-types complex-double-float)
(:generator 7
(let ((real-tn (complex-double-reg-real-tn value)))
(with-empty-tn@fp-top (real-tn)
- (inst fldd (make-ea :dword :base object :index index :scale 4
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))))
- (let ((imag-tn (complex-double-reg-imag-tn value)))
- (with-empty-tn@fp-top (imag-tn)
- (inst fldd (make-ea :dword :base object :index index :scale 4
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- 8)
- other-pointer-lowtag)))))))
-
-(define-vop (data-vector-ref-c/simple-array-complex-double-float)
- (:note "inline array access")
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-complex-double-float (:constant (signed-byte 30)))
- (:results (value :scs (complex-double-reg)))
- (:result-types complex-double-float)
- (:generator 6
- (let ((real-tn (complex-double-reg-real-tn value)))
- (with-empty-tn@fp-top (real-tn)
- (inst fldd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index))
- other-pointer-lowtag)))))
+ (inst fldd (make-ea-for-float-ref object index offset 16 :scale 4)))
(let ((imag-tn (complex-double-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
- (inst fldd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index) 8)
- other-pointer-lowtag)))))))
+ (inst fldd (make-ea-for-float-ref object index offset 16
+ :scale 4 :complex-offset 8)))))))
-(define-vop (data-vector-set/simple-array-complex-double-float)
+(define-vop (data-vector-set-with-offset/simple-array-complex-double-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
- (index :scs (any-reg))
+ (index :scs (any-reg immediate))
(value :scs (complex-double-reg) :target result))
+ (:info offset)
(:arg-types simple-array-complex-double-float positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 16 vector-data-offset))
complex-double-float)
(:results (result :scs (complex-double-reg)))
(:result-types complex-double-float)
(result-real (complex-double-reg-real-tn result)))
(cond ((zerop (tn-offset value-real))
;; Value is in ST0.
- (inst fstd (make-ea :dword :base object :index index :scale 4
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))
- (unless (zerop (tn-offset result-real))
- ;; Value is in ST0 but not result.
- (inst fstd result-real)))
- (t
- ;; Value is not in ST0.
- (inst fxch value-real)
- (inst fstd (make-ea :dword :base object :index index :scale 4
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))
- (cond ((zerop (tn-offset result-real))
- ;; The result is in ST0.
- (inst fstd value-real))
- (t
- ;; Neither value or result are in ST0
- (unless (location= value-real result-real)
- (inst fstd result-real))
- (inst fxch value-real))))))
- (let ((value-imag (complex-double-reg-imag-tn value))
- (result-imag (complex-double-reg-imag-tn result)))
- (inst fxch value-imag)
- (inst fstd (make-ea :dword :base object :index index :scale 4
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- 8)
- other-pointer-lowtag)))
- (unless (location= value-imag result-imag)
- (inst fstd result-imag))
- (inst fxch value-imag))))
-
-(define-vop (data-vector-set-c/simple-array-complex-double-float)
- (:note "inline array store")
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (value :scs (complex-double-reg) :target result))
- (:info index)
- (:arg-types simple-array-complex-double-float (:constant (signed-byte 30))
- complex-double-float)
- (:results (result :scs (complex-double-reg)))
- (:result-types complex-double-float)
- (:generator 19
- (let ((value-real (complex-double-reg-real-tn value))
- (result-real (complex-double-reg-real-tn result)))
- (cond ((zerop (tn-offset value-real))
- ;; Value is in ST0.
- (inst fstd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index))
- other-pointer-lowtag)))
+ (inst fstd (make-ea-for-float-ref object index offset 16
+ :scale 4))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fstd result-real)))
(t
;; Value is not in ST0.
(inst fxch value-real)
- (inst fstd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index))
- other-pointer-lowtag)))
+ (inst fstd (make-ea-for-float-ref object index offset 16
+ :scale 4))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fstd value-real))
(let ((value-imag (complex-double-reg-imag-tn value))
(result-imag (complex-double-reg-imag-tn result)))
(inst fxch value-imag)
- (inst fstd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index) 8)
- other-pointer-lowtag)))
+ (inst fstd (make-ea-for-float-ref object index offset 16
+ :scale 4 :complex-offset 8))
(unless (location= value-imag result-imag)
(inst fstd result-imag))
(inst fxch value-imag))))
-
-
\f
-;;; unsigned-byte-8
-(macrolet ((define-data-vector-frobs (ptype)
+;;; {un,}signed-byte-8, simple-base-string
+
+(macrolet ((define-data-vector-frobs (ptype element-type ref-inst &rest scs)
`(progn
- (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
- (:translate data-vector-ref)
+ (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types ,ptype positive-fixnum)
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
+ (index :scs (unsigned-reg immediate)))
+ (:info offset)
+ (:arg-types ,ptype positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 1 vector-data-offset)))
+ (:results (value :scs ,scs))
+ (:result-types ,element-type)
(:generator 5
- (inst movzx value
- (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
- (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types ,ptype (:constant (signed-byte 30)))
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 4
- (inst movzx value
- (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag)))))
- (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
- (:translate data-vector-set)
+ (sc-case index
+ (immediate
+ (inst ,ref-inst value
+ (make-ea :byte :base object
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (tn-value index)
+ offset)
+ other-pointer-lowtag))))
+ (t
+ (inst ,ref-inst value
+ (make-ea :byte :base object :index index :scale 1
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ offset)
+ other-pointer-lowtag)))))))
+ (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (unsigned-reg signed-reg) :target eax))
- (:arg-types ,ptype positive-fixnum positive-fixnum)
+ (index :scs (unsigned-reg immediate) :to (:eval 0))
+ (value :scs ,scs :target eax))
+ (:info offset)
+ (:arg-types ,ptype positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 1 vector-data-offset))
+ ,element-type)
(:temporary (:sc unsigned-reg :offset eax-offset :target result
:from (:argument 2) :to (:result 0))
eax)
- (:results (result :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
+ (:results (result :scs ,scs))
+ (:result-types ,element-type)
(:generator 5
(move eax value)
- (inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- al-tn)
- (move result eax)))
- (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (unsigned-reg signed-reg) :target eax))
- (:info index)
- (:arg-types ,ptype (:constant (signed-byte 30))
- positive-fixnum)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- eax)
- (:results (result :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 4
- (move eax value)
- (inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag))
- al-tn)
+ (sc-case index
+ (immediate
+ (inst mov (make-ea :byte :base object
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (tn-value index)
+ offset)
+ other-pointer-lowtag))
+ al-tn))
+ (t
+ (inst mov (make-ea :byte :base object :index index :scale 1
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ offset)
+ other-pointer-lowtag))
+ al-tn)))
(move result eax))))))
- (define-data-vector-frobs simple-array-unsigned-byte-7)
- (define-data-vector-frobs simple-array-unsigned-byte-8))
-
-;;; unsigned-byte-16
-(macrolet ((define-data-vector-frobs (ptype)
+ (define-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
+ movzx unsigned-reg signed-reg)
+ (define-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
+ movzx unsigned-reg signed-reg)
+ (define-data-vector-frobs simple-array-signed-byte-8 tagged-num
+ movsx signed-reg)
+ (define-data-vector-frobs simple-base-string character movzx character-reg))
+
+;;; {un,}signed-byte-16
+(macrolet ((define-data-vector-frobs (ptype element-type ref-inst &rest scs)
`(progn
- (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
- (:translate data-vector-ref)
+ (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types ,ptype positive-fixnum)
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
+ (index :scs (unsigned-reg immediate)))
+ (:info offset)
+ (:arg-types ,ptype positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 2 vector-data-offset)))
+ (:results (value :scs ,scs))
+ (:result-types ,element-type)
(:generator 5
- (inst movzx value
- (make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
- (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types ,ptype (:constant (signed-byte 30)))
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 4
- (inst movzx value
- (make-ea :word :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 index))
- other-pointer-lowtag)))))
- (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
- (:translate data-vector-set)
+ (sc-case index
+ (immediate
+ (inst ,ref-inst value
+ (make-ea :word :base object
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* 2 (+ offset (tn-value index)))
+ other-pointer-lowtag)))))
+ (t
+ (inst ,ref-inst value
+ (make-ea :word :base object :index index :scale 2
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* 2 offset))
+ other-pointer-lowtag)))))))
+ (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (unsigned-reg signed-reg) :target eax))
- (:arg-types ,ptype positive-fixnum positive-fixnum)
+ (index :scs (unsigned-reg immediate) :to (:eval 0))
+ (value :scs ,scs :target eax))
+ (:info offset)
+ (:arg-types ,ptype positive-fixnum
+ (:constant (constant-displacement other-pointer-lowtag
+ 2 vector-data-offset))
+ ,element-type)
(:temporary (:sc unsigned-reg :offset eax-offset :target result
:from (:argument 2) :to (:result 0))
eax)
- (:results (result :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
+ (:results (result :scs ,scs))
+ (:result-types ,element-type)
(:generator 5
(move eax value)
- (inst mov (make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- ax-tn)
- (move result eax)))
-
- (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (unsigned-reg signed-reg) :target eax))
- (:info index)
- (:arg-types ,ptype (:constant (signed-byte 30))
- positive-fixnum)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- eax)
- (:results (result :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 4
- (move eax value)
- (inst mov (make-ea :word :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 2 index))
- other-pointer-lowtag))
- ax-tn)
+ (sc-case index
+ (immediate
+ (inst mov (make-ea :word :base object
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* 2 (+ offset (tn-value index))))
+ other-pointer-lowtag))
+ ax-tn))
+ (t
+ (inst mov (make-ea :word :base object :index index :scale 2
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* 2 offset))
+ other-pointer-lowtag))
+ ax-tn)))
(move result eax))))))
- (define-data-vector-frobs simple-array-unsigned-byte-15)
- (define-data-vector-frobs simple-array-unsigned-byte-16))
-
-;;; simple-string
-
-#!+sb-unicode
-(progn
-(define-vop (data-vector-ref/simple-base-string)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types simple-base-string positive-fixnum)
- (:results (value :scs (character-reg)))
- (:result-types character)
- (:generator 5
- (inst movzx value
- (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-ref-c/simple-base-string)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-base-string (:constant (signed-byte 30)))
- (:results (value :scs (character-reg)))
- (:result-types character)
- (:generator 4
- (inst movzx value
- (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-set/simple-base-string)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (character-reg) :target eax))
- (:arg-types simple-base-string positive-fixnum character)
- (:temporary (:sc character-reg :offset eax-offset :target result
- :from (:argument 2) :to (:result 0))
- eax)
- (:results (result :scs (character-reg)))
- (:result-types character)
- (:generator 5
- (move eax value)
- (inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- al-tn)
- (move result eax)))
-
-(define-vop (data-vector-set-c/simple-base-string)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (character-reg)))
- (:info index)
- (:arg-types simple-base-string (:constant (signed-byte 30)) character)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- eax)
- (:results (result :scs (character-reg)))
- (:result-types character)
- (:generator 4
- (move eax value)
- (inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag))
- al-tn)
- (move result eax)))
-) ; PROGN
-
-#!-sb-unicode
-(progn
-(define-vop (data-vector-ref/simple-base-string)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types simple-base-string positive-fixnum)
- (:results (value :scs (character-reg)))
- (:result-types character)
- (:generator 5
- (inst mov value
- (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-ref-c/simple-base-string)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-base-string (:constant (signed-byte 30)))
- (:results (value :scs (character-reg)))
- (:result-types character)
- (:generator 4
- (inst mov value
- (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag)))))
+ (define-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum
+ movzx unsigned-reg signed-reg)
+ (define-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum
+ movzx unsigned-reg signed-reg)
+ (define-data-vector-frobs simple-array-signed-byte-16 tagged-num
+ movsx signed-reg))
-(define-vop (data-vector-set/simple-base-string)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (character-reg) :target result))
- (:arg-types simple-base-string positive-fixnum character)
- (:results (result :scs (character-reg)))
- (:result-types character)
- (:generator 5
- (inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- value)
- (move result value)))
-
-(define-vop (data-vector-set-c/simple-base-string)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (character-reg)))
- (:info index)
- (:arg-types simple-base-string (:constant (signed-byte 30)) character)
- (:results (result :scs (character-reg)))
- (:result-types character)
- (:generator 4
- (inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag))
- value)
- (move result value)))
-) ; PROGN
-
-#!+sb-unicode
-(define-full-reffer data-vector-ref/simple-character-string
- simple-character-string vector-data-offset other-pointer-lowtag
- (character-reg) character data-vector-ref)
-#!+sb-unicode
-(define-full-setter data-vector-set/simple-character-string
- simple-character-string vector-data-offset other-pointer-lowtag
- (character-reg) character data-vector-set)
-
-;;; signed-byte-8
-
-(define-vop (data-vector-ref/simple-array-signed-byte-8)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types simple-array-signed-byte-8 positive-fixnum)
- (:results (value :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 5
- (inst movsx value
- (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-ref-c/simple-array-signed-byte-8)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 30)))
- (:results (value :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 4
- (inst movsx value
- (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-set/simple-array-signed-byte-8)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (signed-reg) :target eax))
- (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 2) :to (:result 0))
- eax)
- (:results (result :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 5
- (move eax value)
- (inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- al-tn)
- (move result eax)))
-
-(define-vop (data-vector-set-c/simple-array-signed-byte-8)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (signed-reg) :target eax))
- (:info index)
- (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 30))
- tagged-num)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- eax)
- (:results (result :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 4
- (move eax value)
- (inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag))
- al-tn)
- (move result eax)))
-
-;;; signed-byte-16
-
-(define-vop (data-vector-ref/simple-array-signed-byte-16)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types simple-array-signed-byte-16 positive-fixnum)
- (:results (value :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 5
- (inst movsx value
- (make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-ref-c/simple-array-signed-byte-16)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-signed-byte-16 (:constant (signed-byte 30)))
- (:results (value :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 4
- (inst movsx value
- (make-ea :word :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 2 index))
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-set/simple-array-signed-byte-16)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (signed-reg) :target eax))
- (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
- (:temporary (:sc signed-reg :offset eax-offset :target result
- :from (:argument 2) :to (:result 0))
- eax)
- (:results (result :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 5
- (move eax value)
- (inst mov (make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- ax-tn)
- (move result eax)))
-
-(define-vop (data-vector-set-c/simple-array-signed-byte-16)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (signed-reg) :target eax))
- (:info index)
- (:arg-types simple-array-signed-byte-16 (:constant (signed-byte 30)) tagged-num)
- (:temporary (:sc signed-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- eax)
- (:results (result :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 4
- (move eax value)
- (inst mov
- (make-ea :word :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 2 index))
- other-pointer-lowtag))
- ax-tn)
- (move result eax)))
\f
;;; These vops are useful for accessing the bits of a vector
;;; irrespective of what type of vector it is.
type
size
&optional signed)
- (let ((ref-name-c (symbolicate ref-name "-C"))
- (set-name-c (symbolicate set-name "-C"))
- (temp-sc (symbolicate size "-REG")))
+ (let ((temp-sc (symbolicate size "-REG"))
+ (element-size (ecase size
+ (:byte 1)
+ (:word 2)
+ (:dword 4))))
`(progn
(define-vop (,ref-name)
(:translate ,ref-name)
(:policy :fast-safe)
(:args (sap :scs (sap-reg))
(offset :scs (signed-reg immediate)))
- (:arg-types system-area-pointer signed-num)
+ (:info disp)
+ (:arg-types system-area-pointer signed-num
+ (:constant (constant-displacement 0 ; lowtag
+ ,element-size
+ 0)))
(:results (result :scs (,sc)))
(:result-types ,type)
(:generator 5
(immediate
(inst ,mov-inst result
(make-ea ,size :base sap
- :disp (tn-value offset))))
+ :disp (+ (tn-value offset)
+ (* ,element-size disp)))))
(t (inst ,mov-inst result
(make-ea ,size :base sap
- :index offset)))))))
+ :index offset
+ :disp (* ,element-size disp))))))))
(define-vop (,set-name)
(:translate ,set-name)
(:policy :fast-safe)
:target ,(if (eq size :dword)
'result
'temp)))
- (:arg-types system-area-pointer signed-num ,type)
+ (:info disp)
+ (:arg-types system-area-pointer signed-num
+ (:constant (constant-displacement 0 ; lowtag
+ ,element-size
+ 0))
+ ,type)
,@(unless (eq size :dword)
`((:temporary (:sc ,temp-sc :offset eax-offset
:from (:argument 2) :to (:result 0)
(:results (result :scs (,sc)))
(:result-types ,type)
(:generator 5
- ,@(unless (eq size :dword)
- `((move eax-tn value)))
- (inst mov (sc-case offset
- (immediate
- (make-ea ,size :base sap
- :disp (tn-value offset)))
- (t (make-ea ,size
- :base sap
- :index offset)))
- ,(if (eq size :dword) 'value 'temp))
- (move result
- ,(if (eq size :dword) 'value 'eax-tn))))))))
+ ,@(unless (eq size :dword)
+ `((move eax-tn value)))
+ (inst mov (sc-case offset
+ (immediate
+ (make-ea ,size :base sap
+ :disp (+ (tn-value offset)
+ (* ,element-size disp))))
+ (t (make-ea ,size
+ :base sap
+ :index offset
+ :disp (* ,element-size disp))))
+ ,(if (eq size :dword) 'value 'temp))
+ (move result
+ ,(if (eq size :dword) 'value 'eax-tn))))))))
- (def-system-ref-and-set sap-ref-8 %set-sap-ref-8
+ (def-system-ref-and-set sb!c::sap-ref-8-with-offset sb!c::%set-sap-ref-8-with-offset
unsigned-reg positive-fixnum :byte nil)
- (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8
+ (def-system-ref-and-set sb!c::signed-sap-ref-8-with-offset sb!c::%set-signed-sap-ref-8-with-offset
signed-reg tagged-num :byte t)
- (def-system-ref-and-set sap-ref-16 %set-sap-ref-16
+ (def-system-ref-and-set sb!c::sap-ref-16-with-offset sb!c::%set-sap-ref-16-with-offset
unsigned-reg positive-fixnum :word nil)
- (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16
+ (def-system-ref-and-set sb!c::signed-sap-ref-16-with-offset sb!c::%set-signed-sap-ref-16-with-offset
signed-reg tagged-num :word t)
- (def-system-ref-and-set sap-ref-32 %set-sap-ref-32
+ (def-system-ref-and-set sb!c::sap-ref-32-with-offset sb!c::%set-sap-ref-32-with-offset
unsigned-reg unsigned-num :dword nil)
- (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32
+ (def-system-ref-and-set sb!c::signed-sap-ref-32-with-offset sb!c::%set-signed-sap-ref-32-with-offset
signed-reg signed-num :dword t)
- (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap
+ (def-system-ref-and-set sb!c::sap-ref-sap-with-offset sb!c::%set-sap-ref-sap-with-offset
sap-reg system-area-pointer :dword))
\f
;;;; SAP-REF-DOUBLE
-(define-vop (sap-ref-double)
- (:translate sap-ref-double)
+(define-vop (sap-ref-double-with-offset)
+ (:translate sb!c::sap-ref-double-with-offset)
(:policy :fast-safe)
(:args (sap :scs (sap-reg))
- (offset :scs (signed-reg)))
- (:arg-types system-area-pointer signed-num)
+ (offset :scs (signed-reg immediate)))
+ (:info disp)
+ (:arg-types system-area-pointer signed-num
+ (:constant (constant-displacement 0 ; lowtag
+ 8 ; double-float size
+ 0)))
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 5
- (with-empty-tn@fp-top(result)
- (inst fldd (make-ea :dword :base sap :index offset)))))
-
-(define-vop (sap-ref-double-c)
- (:translate sap-ref-double)
- (:policy :fast-safe)
- (:args (sap :scs (sap-reg)))
- (:arg-types system-area-pointer (:constant (signed-byte 32)))
- (:info offset)
- (:results (result :scs (double-reg)))
- (:result-types double-float)
- (:generator 4
- (with-empty-tn@fp-top(result)
- (inst fldd (make-ea :dword :base sap :disp offset)))))
+ (sc-case offset
+ (immediate
+ (aver (zerop disp))
+ (with-empty-tn@fp-top(result)
+ (inst fldd (make-ea :dword :base sap :disp (tn-value offset)))))
+ (t
+ (with-empty-tn@fp-top(result)
+ (inst fldd (make-ea :dword :base sap :index offset
+ :disp (* 4 disp))))))))
-(define-vop (%set-sap-ref-double)
- (:translate %set-sap-ref-double)
+(define-vop (%set-sap-ref-double-with-offset)
+ (:translate sb!c::%set-sap-ref-double-with-offset)
(:policy :fast-safe)
(:args (sap :scs (sap-reg) :to (:eval 0))
(offset :scs (signed-reg) :to (:eval 0))
(value :scs (double-reg)))
- (:arg-types system-area-pointer signed-num double-float)
+ (:info disp)
+ (:arg-types system-area-pointer signed-num
+ (:constant (constant-displacement 0 ; lowtag
+ 8 ; double-float size
+ 0))
+ double-float)
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 5
(cond ((zerop (tn-offset value))
;; Value is in ST0.
- (inst fstd (make-ea :dword :base sap :index offset))
+ (inst fstd (make-ea :dword :base sap :index offset
+ :disp (* 8 disp)))
(unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fstd result)))
+ ;; Value is in ST0 but not result.
+ (inst fstd result)))
(t
;; Value is not in ST0.
(inst fxch value)
- (inst fstd (make-ea :dword :base sap :index offset))
+ (inst fstd (make-ea :dword :base sap :index offset
+ :disp (* 8 disp)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fstd value))
(t
;; Neither value or result are in ST0.
(unless (location= value result)
- (inst fstd result))
+ (inst fstd result))
(inst fxch value)))))))
-(define-vop (%set-sap-ref-double-c)
- (:translate %set-sap-ref-double)
+(define-vop (%set-sap-ref-double-with-offset-c)
+ (:translate sb!c::%set-sap-ref-double-with-offset)
(:policy :fast-safe)
(:args (sap :scs (sap-reg) :to (:eval 0))
(value :scs (double-reg)))
- (:arg-types system-area-pointer (:constant (signed-byte 32)) double-float)
- (:info offset)
+ (:arg-types system-area-pointer (:constant (signed-byte 32))
+ (:constant (constant-displacement 0 ; lowtag
+ 8 ; double-float size
+ 0))
+ double-float)
+ (:info offset disp)
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 4
+ (aver (zerop disp))
(cond ((zerop (tn-offset value))
;; Value is in ST0.
(inst fstd (make-ea :dword :base sap :disp offset))
(unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fstd result)))
+ ;; Value is in ST0 but not result.
+ (inst fstd result)))
(t
;; Value is not in ST0.
(inst fxch value)
(t
;; Neither value or result are in ST0.
(unless (location= value result)
- (inst fstd result))
+ (inst fstd result))
(inst fxch value)))))))
\f
;;;; SAP-REF-SINGLE
-(define-vop (sap-ref-single)
- (:translate sap-ref-single)
+(define-vop (sap-ref-single-with-offset)
+ (:translate sb!c::sap-ref-single-with-offset)
(:policy :fast-safe)
(:args (sap :scs (sap-reg))
- (offset :scs (signed-reg)))
- (:arg-types system-area-pointer signed-num)
+ (offset :scs (signed-reg immediate)))
+ (:info disp)
+ (:arg-types system-area-pointer signed-num
+ (:constant (constant-displacement 0 ; lowtag
+ 4 ; single-float size
+ 0)))
(:results (result :scs (single-reg)))
(:result-types single-float)
(:generator 5
- (with-empty-tn@fp-top(result)
- (inst fld (make-ea :dword :base sap :index offset)))))
-
-(define-vop (sap-ref-single-c)
- (:translate sap-ref-single)
- (:policy :fast-safe)
- (:args (sap :scs (sap-reg)))
- (:arg-types system-area-pointer (:constant (signed-byte 32)))
- (:info offset)
- (:results (result :scs (single-reg)))
- (:result-types single-float)
- (:generator 4
- (with-empty-tn@fp-top(result)
- (inst fld (make-ea :dword :base sap :disp offset)))))
+ (sc-case offset
+ (immediate
+ (aver (zerop disp))
+ (with-empty-tn@fp-top(result)
+ (inst fld (make-ea :dword :base sap :disp (tn-value offset)))))
+ (t
+ (with-empty-tn@fp-top(result)
+ (inst fld (make-ea :dword :base sap :index offset
+ :disp (* 4 disp))))))))
-(define-vop (%set-sap-ref-single)
- (:translate %set-sap-ref-single)
+(define-vop (%set-sap-ref-single-with-offset)
+ (:translate sb!c::%set-sap-ref-single-with-offset)
(:policy :fast-safe)
(:args (sap :scs (sap-reg) :to (:eval 0))
(offset :scs (signed-reg) :to (:eval 0))
(value :scs (single-reg)))
- (:arg-types system-area-pointer signed-num single-float)
+ (:info disp)
+ (:arg-types system-area-pointer signed-num
+ (:constant (constant-displacement 0 ; lowtag
+ 4 ; single-float size
+ 0))
+ single-float)
(:results (result :scs (single-reg)))
(:result-types single-float)
(:generator 5
(cond ((zerop (tn-offset value))
;; Value is in ST0
- (inst fst (make-ea :dword :base sap :index offset))
+ (inst fst (make-ea :dword :base sap :index offset
+ :disp (* 4 disp)))
(unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fst result)))
+ ;; Value is in ST0 but not result.
+ (inst fst result)))
(t
;; Value is not in ST0.
(inst fxch value)
- (inst fst (make-ea :dword :base sap :index offset))
+ (inst fst (make-ea :dword :base sap :index offset
+ :disp (* 4 disp)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fst value))
(t
;; Neither value or result are in ST0
(unless (location= value result)
- (inst fst result))
+ (inst fst result))
(inst fxch value)))))))
-(define-vop (%set-sap-ref-single-c)
- (:translate %set-sap-ref-single)
+(define-vop (%set-sap-ref-single-with-offset-c)
+ (:translate sb!c::%set-sap-ref-single-with-offset)
(:policy :fast-safe)
(:args (sap :scs (sap-reg) :to (:eval 0))
(value :scs (single-reg)))
- (:arg-types system-area-pointer (:constant (signed-byte 32)) single-float)
- (:info offset)
+ (:arg-types system-area-pointer (:constant (signed-byte 32))
+ (:constant (constant-displacement 0 ; lowtag
+ 4 ; single-float size
+ 0))
+ single-float)
+ (:info offset disp)
(:results (result :scs (single-reg)))
(:result-types single-float)
(:generator 4
+ (aver (zerop disp))
(cond ((zerop (tn-offset value))
;; Value is in ST0
(inst fst (make-ea :dword :base sap :disp offset))
(unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fst result)))
+ ;; Value is in ST0 but not result.
+ (inst fst result)))
(t
;; Value is not in ST0.
(inst fxch value)
(t
;; Neither value or result are in ST0
(unless (location= value result)
- (inst fst result))
+ (inst fst result))
(inst fxch value)))))))
\f
;;;; SAP-REF-LONG
projects / sbcl.git / commitdiff