mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
arm64: switch to soft card marks
This was performance-neutral in my limited testing- the regression suite consumes the same amount of time before and after. Given that the compiler probably takes a little longer due to deciding to emit barriers, the runtime of the code under test seems as good if not better. Thanks to Stas for some help with Darwin changes.
This commit is contained in:
Douglas Katzman
parent
26f86b514d
commit
1a74090745
10
benchmarks/arm64-softcard.txt
Normal file
10
benchmarks/arm64-softcard.txt
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
Tested on a fairly recent iMac
|
||||
|
||||
time ./parallel-exec.sh 8
|
||||
|
||||
baseline soft card marks
|
||||
-------- ---------------
|
||||
Total realtime: 73677 msec Total realtime: 72886 msec
|
||||
real 1m13.943s real 1m13.152s
|
||||
user 5m35.184s user 5m35.356s
|
||||
sys 1m27.364s sys 1m23.214s
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
:64-bit :gencgc :fp-and-pc-standard-save
|
||||
:use-cons-region
|
||||
:use-cons-region :soft-card-marks
|
||||
:alien-callbacks
|
||||
:unbind-in-unwind
|
||||
:compare-and-swap-vops :undefined-fun-restarts
|
||||
|
|
|
|||
|
|
@ -104,7 +104,17 @@
|
|||
|
||||
(inst mov tmp-tn nl0) ;; result
|
||||
|
||||
(map-pairs ldp nsp-tn 64 nl-registers :post-index 80 :delta -16)
|
||||
(aver (location= tmp-tn (reg 9 'any-reg))) ; Change detector assertion
|
||||
;; Do not reload r9 (= NL9 = TMP-TN) as it just got moved from NL0 which holds
|
||||
;; the result from C and which will be returned from this asm routine.
|
||||
(inst ldr (reg 8 'any-reg) (@ nsp-tn 64))
|
||||
;; I'm unsure how to utilize map-pairs on the others now :-(
|
||||
;; (It took more lines of code to alter MAP-PAIRS to accept another keyword
|
||||
;; asking it not to clobber TMP-TN than it did to just hand-write 4 instructions)
|
||||
(inst ldp (reg 6 'any-reg) (reg 7 'any-reg) (@ nsp-tn 48))
|
||||
(inst ldp (reg 4 'any-reg) (reg 5 'any-reg) (@ nsp-tn 32))
|
||||
(inst ldp (reg 2 'any-reg) (reg 3 'any-reg) (@ nsp-tn 16))
|
||||
(inst ldp (reg 0 'any-reg) (reg 1 'any-reg) (@ nsp-tn 80 :post-index))
|
||||
(inst ret)))))))
|
||||
(define-alloc-tramp alloc-tramp "alloc")
|
||||
(define-alloc-tramp list-alloc-tramp "alloc_list")
|
||||
|
|
|
|||
|
|
@ -279,7 +279,7 @@
|
|||
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
|
||||
(defun destroyed-c-registers ()
|
||||
(let ((gprs (list nl0-offset nl1-offset nl2-offset nl3-offset
|
||||
nl4-offset nl5-offset nl6-offset nl7-offset nl8-offset nl9-offset
|
||||
nl4-offset nl5-offset nl6-offset nl7-offset nl8-offset tmp-offset
|
||||
r0-offset r1-offset r2-offset r3-offset
|
||||
r4-offset r5-offset r6-offset r7-offset
|
||||
#-darwin r8-offset
|
||||
|
|
|
|||
|
|
@ -28,7 +28,9 @@
|
|||
(:info name offset lowtag)
|
||||
(:ignore name)
|
||||
(:results)
|
||||
(:vop-var vop)
|
||||
(:generator 1
|
||||
(emit-gengc-barrier object nil tmp-tn (vop-nth-arg 1 vop) value)
|
||||
(storew value object offset lowtag)))
|
||||
|
||||
(define-vop (compare-and-swap-slot)
|
||||
|
|
@ -39,7 +41,9 @@
|
|||
(:ignore name)
|
||||
(:temporary (:sc non-descriptor-reg) lip)
|
||||
(:results (result :scs (descriptor-reg any-reg) :from :load))
|
||||
(:vop-var vop)
|
||||
(:generator 5
|
||||
(emit-gengc-barrier object nil lip (vop-nth-arg 2 vop) new)
|
||||
(inst add-sub lip object (- (* offset n-word-bytes) lowtag))
|
||||
(cond ((member :arm-v8.1 *backend-subfeatures*)
|
||||
(move result old)
|
||||
|
|
@ -81,6 +85,7 @@
|
|||
(symbol-always-has-tls-value-p (tn-value object)))))
|
||||
(value :scs (descriptor-reg any-reg zero)))
|
||||
(:temporary (:sc any-reg) tls-index)
|
||||
(:vop-var vop)
|
||||
(:generator 4
|
||||
(sc-case object
|
||||
(constant
|
||||
|
|
@ -91,6 +96,7 @@
|
|||
(inst ldr tmp-tn (@ thread-tn tls-index))
|
||||
(compare-to-no-tls-value-marker tmp-tn)
|
||||
(inst b :ne LOCAL)
|
||||
(emit-gengc-barrier object nil tls-index (vop-nth-arg 1 vop) value)
|
||||
(storew value object symbol-value-slot other-pointer-lowtag)
|
||||
(inst b DONE)
|
||||
LOCAL
|
||||
|
|
@ -244,6 +250,9 @@
|
|||
(loadw tmp-tn symbol symbol-name-slot other-pointer-lowtag)
|
||||
(inst and result tmp-tn (1- (ash 1 sb-impl::symbol-name-bits))))))
|
||||
|
||||
;; Is it worth eliding the GC store barrier for a thread-local CAS?
|
||||
;; Not really, because why does such an operation even exists?
|
||||
;; No other thread can see our TLS except via SAP-REF.
|
||||
(define-vop (%compare-and-swap-symbol-value)
|
||||
(:translate %compare-and-swap-symbol-value)
|
||||
(:args (symbol :scs (descriptor-reg))
|
||||
|
|
@ -256,6 +265,7 @@
|
|||
(:policy :fast-safe)
|
||||
(:vop-var vop)
|
||||
(:generator 15
|
||||
(emit-gengc-barrier symbol nil lip (vop-nth-arg 2 vop) new)
|
||||
(inst dsb)
|
||||
#+sb-thread
|
||||
(assemble ()
|
||||
|
|
@ -299,6 +309,7 @@
|
|||
(:vop-var vop)
|
||||
(:guard (member :arm-v8.1 *backend-subfeatures*))
|
||||
(:generator 14
|
||||
(emit-gengc-barrier symbol nil lip (vop-nth-arg 2 vop) new)
|
||||
#+sb-thread
|
||||
(assemble ()
|
||||
(inst ldr (32-bit-reg tls-index) (tls-index-of symbol))
|
||||
|
|
@ -346,6 +357,7 @@
|
|||
(:temporary (:scs (non-descriptor-reg)) type)
|
||||
(:results (result :scs (descriptor-reg)))
|
||||
(:generator 38
|
||||
(emit-gengc-barrier fdefn nil lip)
|
||||
(inst add-sub lip function (- (* simple-fun-insts-offset n-word-bytes)
|
||||
fun-pointer-lowtag))
|
||||
(load-type type function (- fun-pointer-lowtag))
|
||||
|
|
@ -589,6 +601,7 @@
|
|||
(:temporary (:sc descriptor-reg) val-temp)
|
||||
(:info indices)
|
||||
(:generator 1
|
||||
(emit-gengc-barrier instance nil tmp-tn values)
|
||||
(do ((tn-ref values (tn-ref-across tn-ref))
|
||||
(indices indices (cdr indices)))
|
||||
((null tn-ref))
|
||||
|
|
|
|||
|
|
@ -883,6 +883,9 @@
|
|||
:tab rd ", " rn ", "
|
||||
(:using #'print-ubfm-alias ubfm-alias)))
|
||||
(:emitter
|
||||
(when (and (fixup-p imms) (eq (fixup-flavor imms) :card-table-index-mask))
|
||||
(note-fixup segment :ubfm-imms imms)
|
||||
(setq imms 0))
|
||||
(emit-bitfield segment +64-bit-size+ #b10 +64-bit-size+
|
||||
immr imms (gpr-offset rn) (gpr-offset rd))))
|
||||
|
||||
|
|
@ -3440,6 +3443,11 @@
|
|||
(setf (ldb (byte 12 10) (sap-ref-32 sap offset))
|
||||
(ash (the (unsigned-byte #.(+ 12 word-shift)) value)
|
||||
(- word-shift))))
|
||||
(:ubfm-imms
|
||||
;; The 'imms' value is is the inclusive index of the final
|
||||
;; bit in the unsigned bitfield to copy (or "move").
|
||||
(setf (ldb (byte 6 10) (sb-vm::sap-ref-32 sap offset))
|
||||
(+ sb-vm::gencgc-card-shift value -1)))
|
||||
(:move-wide
|
||||
(setf (ldb (byte 16 5) (sap-ref-32 sap offset))
|
||||
(the (unsigned-byte 16) value)))))
|
||||
|
|
|
|||
|
|
@ -364,26 +364,53 @@
|
|||
(loadw value tmp-tn ,offset ,lowtag))))))
|
||||
|
||||
(defmacro define-full-setter (name type offset lowtag scs el-type
|
||||
&optional translate)
|
||||
&optional translate
|
||||
&aux (barrierp (member 'descriptor-reg scs)))
|
||||
(case name
|
||||
((data-vector-set/simple-vector %weakvec-set)
|
||||
`(define-vop (,name)
|
||||
,@(when translate
|
||||
`((:translate ,translate)))
|
||||
(:translate ,translate)
|
||||
(:policy :fast-safe)
|
||||
(:args (object :scs (descriptor-reg))
|
||||
(index :scs (any-reg unsigned-reg signed-reg immediate))
|
||||
(value :scs (,@scs zero)))
|
||||
(:arg-types ,type tagged-num ,el-type)
|
||||
(:temporary (:sc non-descriptor-reg) ea)
|
||||
(:vop-var vop)
|
||||
(:generator 2
|
||||
(sc-case index
|
||||
(immediate
|
||||
(inst add ea object (load-store-offset
|
||||
(- (ash (+ ,offset (tn-value index)) word-shift)
|
||||
,lowtag))))
|
||||
(t
|
||||
;; Scale the index
|
||||
(let ((unshift (if (sc-is index any-reg) n-fixnum-tag-bits 0)))
|
||||
(inst add ea object (lsl index (- word-shift unshift))))
|
||||
;; Calculate the exact cell address to ensure the right card is marked
|
||||
(inst add ea ea (- (ash vector-data-offset word-shift) other-pointer-lowtag))))
|
||||
(emit-gengc-barrier object ea tmp-tn (vop-nth-arg 2 vop) value)
|
||||
(storew value ea 0 0))))
|
||||
(t
|
||||
`(define-vop (,name)
|
||||
(:translate ,translate)
|
||||
(:policy :fast-safe)
|
||||
(:args (object :scs (descriptor-reg))
|
||||
(index :scs (any-reg unsigned-reg signed-reg immediate))
|
||||
(value :scs (,@scs zero)))
|
||||
(:arg-types ,type tagged-num ,el-type)
|
||||
(:vop-var vop)
|
||||
(:generator 2
|
||||
,@(if barrierp '((emit-gengc-barrier object nil tmp-tn (vop-nth-arg 2 vop) value)))
|
||||
(sc-case index
|
||||
(immediate
|
||||
(inst str value (@ object (load-store-offset
|
||||
(- (ash (+ ,offset (tn-value index)) word-shift)
|
||||
,lowtag)))))
|
||||
(t
|
||||
(inst add tmp-tn object (lsl index (- word-shift (if (sc-is index any-reg)
|
||||
n-fixnum-tag-bits
|
||||
0))))
|
||||
(storew value tmp-tn ,offset ,lowtag))))))
|
||||
(let ((unshift (if (sc-is index any-reg) n-fixnum-tag-bits 0)))
|
||||
(inst add tmp-tn object (lsl index (- word-shift unshift))))
|
||||
(storew value tmp-tn ,offset ,lowtag))))))))
|
||||
|
||||
(defmacro define-partial-reffer (name type size signed offset lowtag scs
|
||||
el-type &optional translate)
|
||||
|
|
|
|||
|
|
@ -11,6 +11,11 @@
|
|||
;;;; files for more information.
|
||||
|
||||
(in-package "SB-VM")
|
||||
|
||||
(defun emit-gengc-barrier (object cell-address temp &optional value-tn-ref value-tn)
|
||||
(when (require-gengc-barrier-p object value-tn-ref value-tn)
|
||||
(inst ubfm temp (or cell-address object) gencgc-card-shift (make-fixup nil :card-table-index-mask))
|
||||
(inst strb zr-tn (@ cardtable-tn temp))))
|
||||
|
||||
;;; Cell-Ref and Cell-Set are used to define VOPs like CAR, where the
|
||||
;;; offset to be read or written is a property of the VOP used.
|
||||
|
|
@ -28,7 +33,9 @@
|
|||
(value :scs (descriptor-reg any-reg)))
|
||||
(:variant-vars offset lowtag)
|
||||
(:policy :fast-safe)
|
||||
(:vop-var vop)
|
||||
(:generator 4
|
||||
(emit-gengc-barrier object nil tmp-tn (vop-nth-arg 1 vop) value)
|
||||
(storew value object offset lowtag)))
|
||||
|
||||
;;;
|
||||
|
|
@ -43,6 +50,7 @@
|
|||
(:result-types *)
|
||||
(:variant-vars offset lowtag)
|
||||
(:policy :fast-safe)
|
||||
(:vop-var vop)
|
||||
(:generator 5
|
||||
(cond
|
||||
((sc-is index immediate)
|
||||
|
|
@ -51,6 +59,13 @@
|
|||
(t
|
||||
(inst add lip object (lsl index (- word-shift n-fixnum-tag-bits)))
|
||||
(inst add-sub lip lip (- (* offset n-word-bytes) lowtag))))
|
||||
;; Avoid emitting a barrier for %RAW-INSTANCE-CAS/{SIGNED-}WORD
|
||||
;; which inherits the generator of this vop.
|
||||
(when (sc-is new-value descriptor-reg)
|
||||
;; LOWTAG determines whether to mark the card containing the object header
|
||||
;; (if instance-pointer-lowtag) versus element (if other-pointer-lowtag)
|
||||
(emit-gengc-barrier object (if (eq lowtag other-pointer-lowtag) lip nil)
|
||||
tmp-tn (vop-nth-arg 3 vop) new-value))
|
||||
(inst dsb)
|
||||
LOOP
|
||||
;; If this were 'ldaxr' instead of 'ldxr' maybe we wouldn't need the 'dsb' ?
|
||||
|
|
@ -75,6 +90,7 @@
|
|||
(:variant-vars offset lowtag)
|
||||
(:policy :fast-safe)
|
||||
(:guard (member :arm-v8.1 *backend-subfeatures*))
|
||||
(:vop-var vop)
|
||||
(:generator 3
|
||||
(cond
|
||||
((sc-is index immediate)
|
||||
|
|
@ -83,6 +99,10 @@
|
|||
(t
|
||||
(inst add lip object (lsl index (- word-shift n-fixnum-tag-bits)))
|
||||
(inst add-sub lip lip (- (* offset n-word-bytes) lowtag))))
|
||||
;; just like above
|
||||
(when (sc-is new-value descriptor-reg)
|
||||
(emit-gengc-barrier object (if (eq lowtag other-pointer-lowtag) lip nil)
|
||||
tmp-tn (vop-nth-arg 3 vop) new-value))
|
||||
(move result old-value)
|
||||
(inst casal result new-value lip)))
|
||||
|
||||
|
|
|
|||
|
|
@ -21,10 +21,13 @@
|
|||
;; Can be in the range 4K-64K
|
||||
(defconstant +backend-page-bytes+ 65536)
|
||||
|
||||
;;; The size in bytes of GENCGC cards, i.e. the granularity at which
|
||||
;;; writes to old generations are logged. With mprotect-based write
|
||||
;;; barriers, this must be a multiple of the OS page size.
|
||||
;;; The size in bytes of GENCGC pages. A page is essentially
|
||||
;;; the granularity at which we claim memory for TLABs.
|
||||
(defconstant gencgc-page-bytes +backend-page-bytes+)
|
||||
;;; The divisor relative to page-bytes which computes the granularity
|
||||
;;; at which writes to old generations are logged.
|
||||
(defconstant cards-per-page 32)
|
||||
|
||||
;;; The minimum size of new allocation regions. While it doesn't
|
||||
;;; currently make a lot of sense to have a card size lower than
|
||||
;;; the alloc granularity, it will, once we are smarter about finding
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
|
||||
(in-package "SB-VM")
|
||||
|
||||
(defconstant-eqx +fixup-kinds+ #(:absolute :cond-branch :uncond-branch :layout-id
|
||||
(defconstant-eqx +fixup-kinds+ #(:absolute :cond-branch :uncond-branch :layout-id :ubfm-imms
|
||||
:pc-relative :pc-relative-ldr-str :ldr-str :move-wide)
|
||||
#'equalp)
|
||||
|
||||
|
|
@ -41,7 +41,7 @@
|
|||
(defreg nl6 6)
|
||||
(defreg nl7 7)
|
||||
(defreg nl8 8)
|
||||
(defreg nl9 9)
|
||||
(defreg tmp 9)
|
||||
|
||||
(defreg r0 10)
|
||||
(defreg r1 11)
|
||||
|
|
@ -67,7 +67,7 @@
|
|||
(defreg ocfp 25)
|
||||
(defreg cfp 26)
|
||||
(defreg csp 27)
|
||||
(defreg tmp 28)
|
||||
(defreg cardtable 28) ; preserved across C calls
|
||||
(defreg null 29)
|
||||
(defreg lr 30)
|
||||
(defreg nsp 31)
|
||||
|
|
@ -79,8 +79,9 @@
|
|||
(defregset descriptor-regs
|
||||
r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 #-darwin r10 #-sb-thread r11 lexenv)
|
||||
|
||||
;; nl9 can't be selected by PACK as it is a freely usable temp reg
|
||||
(defregset non-descriptor-regs
|
||||
nl0 nl1 nl2 nl3 nl4 nl5 nl6 nl7 nl8 nl9 nargs nfp ocfp lr)
|
||||
nl0 nl1 nl2 nl3 nl4 nl5 nl6 nl7 nl8 nargs nfp ocfp lr)
|
||||
|
||||
(defregset boxed-regs
|
||||
r0 r1 r2 r3 r4 r5 r6
|
||||
|
|
@ -94,7 +95,7 @@
|
|||
(defregset *register-arg-offsets* r0 r1 r2 r3)
|
||||
(defparameter *register-arg-names* '(r0 r1 r2 r3))
|
||||
(defregset *descriptor-args* r0 r1 r2 r3 r4 r5 r6 r7 r8 r9)
|
||||
(defregset *non-descriptor-args* nl0 nl1 nl2 nl3 nl4 nl5 nl6 nl7 nl8 nl9)
|
||||
(defregset *non-descriptor-args* nl0 nl1 nl2 nl3 nl4 nl5 nl6 nl7 nl8)
|
||||
(defglobal *float-regs* (loop for i below 32 collect i)))
|
||||
|
||||
|
||||
|
|
@ -232,6 +233,7 @@
|
|||
(defregtn null descriptor-reg)
|
||||
(defregtn lexenv descriptor-reg)
|
||||
(defregtn tmp any-reg)
|
||||
(defregtn cardtable any-reg)
|
||||
|
||||
(defregtn nargs any-reg)
|
||||
(defregtn ocfp any-reg)
|
||||
|
|
|
|||
|
|
@ -168,3 +168,11 @@ void arch_write_linkage_table_entry(int index, void *target_addr, int datap)
|
|||
DONE:
|
||||
THREAD_JIT(1);
|
||||
}
|
||||
|
||||
void gcbarrier_patch_code(void* where, int nbits)
|
||||
{
|
||||
// Patch in the 'imms' value for UBFM
|
||||
unsigned* pc = where;
|
||||
unsigned int mask = ~0x0000FC00; // 6 bits at position 10
|
||||
*pc = (*pc & mask) | ((GENCGC_CARD_SHIFT + nbits - 1) << 10);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -225,6 +225,9 @@ one_arg:
|
|||
ldr reg_R0, [reg_R9]
|
||||
no_args:
|
||||
|
||||
// load CARDTABLE-TN. reg_NAME macros aren't autogenerated for native asm code
|
||||
// and it hardly seems worth #defining it to use in one assembly statement.
|
||||
ldr x28, [reg_THREAD, THREAD_CARD_TABLE_OFFSET]
|
||||
// Load the closure-fun (or simple-fun-self), in case we're
|
||||
// trying to call a closure.
|
||||
ldr reg_LR, [reg_LEXENV, #CLOSURE_FUN_OFFSET]
|
||||
|
|
|
|||
|
|
@ -59,8 +59,8 @@
|
|||
#define reg_OCFP REG(25)
|
||||
#define reg_CFP REG(26)
|
||||
#define reg_CSP REG(27)
|
||||
#define reg_TMP REG(28)
|
||||
#define reg_wTMP w28
|
||||
#define reg_TMP REG(9)
|
||||
#define reg_wTMP w9
|
||||
#define reg_NULL REG(29)
|
||||
#define reg_wNULL w29
|
||||
#define reg_LR REG(30)
|
||||
|
|
|
|||
|
|
@ -1072,7 +1072,8 @@ bool gc_allocate_ptes()
|
|||
}
|
||||
|
||||
extern void gcbarrier_patch_code(void*, int);
|
||||
#if !(defined LISP_FEATURE_MIPS || defined LISP_FEATURE_PPC64 \
|
||||
// Architectures that lack a method for gcbarrier_patch_code get this dummy stub.
|
||||
#if !(defined LISP_FEATURE_ARM64 || defined LISP_FEATURE_MIPS || defined LISP_FEATURE_PPC64 \
|
||||
|| defined LISP_FEATURE_X86 || defined LISP_FEATURE_X86_64)
|
||||
void gcbarrier_patch_code(void* __attribute__((unused)) where, int __attribute__((unused)) nbits)
|
||||
{
|
||||
|
|
@ -1224,6 +1225,23 @@ void gc_load_corefile_ptes(int card_table_nbits,
|
|||
page_index_t p;
|
||||
for (p = 0; p < next_free_page; ++p)
|
||||
if (page_words_used(p)) assign_page_card_marks(p, CARD_UNMARKED);
|
||||
|
||||
#ifdef LISP_FEATURE_DARWIN_JIT
|
||||
page_index_t start = 0, end;
|
||||
while (start < next_free_page) {
|
||||
if (is_code(page_table[start].type)) {
|
||||
for (end = start + 1; end < next_free_page; end++) {
|
||||
if (!page_words_used(end) || !is_code(page_table[end].type))
|
||||
break;
|
||||
}
|
||||
os_protect(page_address(start), npage_bytes(end - start), OS_VM_PROT_ALL);
|
||||
start = end+1;
|
||||
continue;
|
||||
}
|
||||
++start;
|
||||
}
|
||||
#endif
|
||||
|
||||
#else
|
||||
// coreparse can avoid hundreds to thousands of mprotect() calls by
|
||||
// treating the whole range from the corefile as protectable, except
|
||||
|
|
|
|||
|
|
@ -408,7 +408,7 @@ char *copied_string(char *string)
|
|||
void
|
||||
os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
|
||||
{
|
||||
#ifdef LISP_FEATURE_SOFT_CARD_MARKS
|
||||
#if defined LISP_FEATURE_SOFT_CARD_MARKS && !defined LISP_FEATURE_DARWIN_JIT
|
||||
// dynamic space should not have protections manipulated
|
||||
if (find_page_index(address) >= 0)
|
||||
lose("unexpected call to os_protect with software card marks");
|
||||
|
|
|
|||
Loading…
Reference in a new issue