common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

x86-64: Teach INITIALIZE-VECTOR about constant lvars + SIMPLE-VECTOR

Browse source
This commit is contained in:
Douglas Katzman 2022-04-18 13:48:20 -04:00
parent 4f4269f7e7
commit 28685b8c29
3 changed files with 40 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
src/compiler/generic/vm-ir2tran.lisp
View file

@ -216,6 +216,9 @@
`(#-compact-instance-header (:dd . ,c-dd) ,@c-slot-specs) args)
(move-lvar-result node block locs lvar))))
;;; FIXME: this causes emission of GC store barriers, but it should not.
;;; The vector is freshly consed, so anything being stored into it
;;; is at least as old.
(defoptimizer (initialize-vector ir2-convert)
((vector &rest initial-contents) node block)
(let* ((vector-ctype (lvar-type vector))
@ -224,13 +227,14 @@
(bug "Unknown vector type in IR2 conversion for ~S."
'initialize-vector)))
(bit-vector-p (type= elt-ctype (specifier-type 'bit)))
(simple-vector-p (type= elt-ctype (specifier-type 't)))
(saetp (find-saetp-by-ctype elt-ctype))
(lvar (node-lvar node))
(locs (lvar-result-tns lvar (list vector-ctype)))
(result (first locs))
(elt-ptype (primitive-type elt-ctype))
(tmp (make-normal-tn elt-ptype)))
(declare (ignorable bit-vector-p))
(declare (ignorable bit-vector-p simple-vector-p))
(emit-move node block (lvar-tn node block vector) result)
(flet ((compute-setter ()
;; Such cringe. I had no idea why all the "-C" vops were mandatory.
@ -293,9 +297,14 @@
;; Nonetheless it's far better than it was. In all other scenarios, don't pass
;; a constant TN, because we don't know that generated code is better.
(cond #+x86-64 ; still moar cringe
((and bit-vector-p (constant-lvar-p value))
((and (or bit-vector-p simple-vector-p) (constant-lvar-p value))
(funcall setter (tnify i) (emit-constant (lvar-value value))))
(t
;; FIXME: for simple-vector, fixnums should get stored via an ANY-REG
;; so that data-vector-set doesn't emit a store barrier.
;; (TMP is a descriptor-reg because ELT-CTYPE is T)
;; Or just fix this optimizer - as commented above - to somehow elide
;; the barrier for all elements.
(emit-move node block (lvar-tn node block value) tmp)
(funcall setter (tnify i) tmp))))))))
(move-lvar-result node block locs lvar)))

2
src/compiler/x86-64/array.lisp
View file

@ -369,7 +369,7 @@
,type vector-data-offset other-pointer-lowtag ,scs
,element-type)))
(progn
(def-full-data-vector-frobs simple-vector * descriptor-reg any-reg immediate)
(def-full-data-vector-frobs simple-vector * descriptor-reg any-reg immediate constant)
(def-full-data-vector-frobs simple-array-unsigned-byte-64 unsigned-num
unsigned-reg)
(def-full-data-vector-frobs simple-array-fixnum tagged-num any-reg)

28
tests/x86-64-codegen.impure.lisp
View file

@ -1142,3 +1142,31 @@ sb-vm::(define-vop (cl-user::test)
(defun zook ()
(sb-sys:%primitive trythis)
nil)
;;; Previously INITIALIZE-VECTOR would move every element into
;;; a register, causing each to require a store barrier
;;; and then a register-to-memory move like so:
;;; BB02000000 MOV EBX, 2
;;; 488D4601 LEA RAX, [RSI+1]
;;; 48C1E80A SHR RAX, 10
;;; 25FFFF0F00 AND EAX, 1048575
;;; 41C6040400 MOV BYTE PTR [R12+RAX], 0
;;; 48895E01 MOV [RSI+1], RBX
;;; The improved code emits 4 consecutive MOV instructions,
;;; one per item. It is still suboptimal in that it can not discern
;;; between initializing and updating, so it always uses a :QWORD move
;;; despite the prezeroed pages.
(with-test (:name :init-vector-mov-to-mem)
(let* ((lines (disassembly-lines
'(lambda () (vector #\x 1 2 3))))
(magic-value
(write-to-string
(logior (ash (char-code #\x) 8) sb-vm:character-widetag)))
(start
(position-if
(lambda (line) (search magic-value line))
lines)))
(assert start)
(assert (search ", 2" (nth (+ start 1) lines)))
(assert (search ", 4" (nth (+ start 2) lines)))
(assert (search ", 6" (nth (+ start 3) lines)))))