From 1a740907454271e242f9eb119412fa26a8d6049f Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Mon, 20 Nov 2023 22:52:34 -0500 Subject: [PATCH] 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. --- benchmarks/arm64-softcard.txt | 10 ++++ crossbuild-runner/backends/arm64/features | 2 +- src/assembly/arm64/tramps.lisp | 12 +++- src/compiler/arm64/c-call.lisp | 2 +- src/compiler/arm64/cell.lisp | 13 +++++ src/compiler/arm64/insts.lisp | 8 +++ src/compiler/arm64/macros.lisp | 67 ++++++++++++++++------- src/compiler/arm64/memory.lisp | 20 +++++++ src/compiler/arm64/parms.lisp | 9 ++- src/compiler/arm64/vm.lisp | 12 ++-- src/runtime/arm64-arch.c | 8 +++ src/runtime/arm64-assem.S | 3 + src/runtime/arm64-lispregs.h | 4 +- src/runtime/coreparse.c | 20 ++++++- src/runtime/os-common.c | 2 +- 15 files changed, 157 insertions(+), 35 deletions(-) create mode 100644 benchmarks/arm64-softcard.txt diff --git a/benchmarks/arm64-softcard.txt b/benchmarks/arm64-softcard.txt new file mode 100644 index 000000000..ee90f43fe --- /dev/null +++ b/benchmarks/arm64-softcard.txt @@ -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 diff --git a/crossbuild-runner/backends/arm64/features b/crossbuild-runner/backends/arm64/features index b88d81ae9..c8ae3ab39 100644 --- a/crossbuild-runner/backends/arm64/features +++ b/crossbuild-runner/backends/arm64/features @@ -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 diff --git a/src/assembly/arm64/tramps.lisp b/src/assembly/arm64/tramps.lisp index d5322d298..d77f408dc 100644 --- a/src/assembly/arm64/tramps.lisp +++ b/src/assembly/arm64/tramps.lisp @@ -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") diff --git a/src/compiler/arm64/c-call.lisp b/src/compiler/arm64/c-call.lisp index 740f0f8a9..b94979bdd 100644 --- a/src/compiler/arm64/c-call.lisp +++ b/src/compiler/arm64/c-call.lisp @@ -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 diff --git a/src/compiler/arm64/cell.lisp b/src/compiler/arm64/cell.lisp index 253606ef6..889c0dd62 100644 --- a/src/compiler/arm64/cell.lisp +++ b/src/compiler/arm64/cell.lisp @@ -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)) diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp index 495d4c96b..65f785fc2 100644 --- a/src/compiler/arm64/insts.lisp +++ b/src/compiler/arm64/insts.lisp @@ -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))))) diff --git a/src/compiler/arm64/macros.lisp b/src/compiler/arm64/macros.lisp index 8db3983aa..4a931902f 100644 --- a/src/compiler/arm64/macros.lisp +++ b/src/compiler/arm64/macros.lisp @@ -364,26 +364,53 @@ (loadw value tmp-tn ,offset ,lowtag)))))) (defmacro define-full-setter (name type offset lowtag scs el-type - &optional translate) - `(define-vop (,name) - ,@(when 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) - (:generator 2 - (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)))))) + &optional translate + &aux (barrierp (member 'descriptor-reg scs))) + (case name + ((data-vector-set/simple-vector %weakvec-set) + `(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) + (: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 + (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) diff --git a/src/compiler/arm64/memory.lisp b/src/compiler/arm64/memory.lisp index 9e6114644..9b6565f5a 100644 --- a/src/compiler/arm64/memory.lisp +++ b/src/compiler/arm64/memory.lisp @@ -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))) diff --git a/src/compiler/arm64/parms.lisp b/src/compiler/arm64/parms.lisp index 4f5048b6a..76f39b5b9 100644 --- a/src/compiler/arm64/parms.lisp +++ b/src/compiler/arm64/parms.lisp @@ -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 diff --git a/src/compiler/arm64/vm.lisp b/src/compiler/arm64/vm.lisp index fbe6d92da..08a4c596c 100644 --- a/src/compiler/arm64/vm.lisp +++ b/src/compiler/arm64/vm.lisp @@ -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) diff --git a/src/runtime/arm64-arch.c b/src/runtime/arm64-arch.c index effa08706..71d00b126 100644 --- a/src/runtime/arm64-arch.c +++ b/src/runtime/arm64-arch.c @@ -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); +} diff --git a/src/runtime/arm64-assem.S b/src/runtime/arm64-assem.S index 2bcaa1def..f6fd05e8e 100644 --- a/src/runtime/arm64-assem.S +++ b/src/runtime/arm64-assem.S @@ -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] diff --git a/src/runtime/arm64-lispregs.h b/src/runtime/arm64-lispregs.h index 6f84bbb7e..c79a1f52a 100644 --- a/src/runtime/arm64-lispregs.h +++ b/src/runtime/arm64-lispregs.h @@ -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) diff --git a/src/runtime/coreparse.c b/src/runtime/coreparse.c index f4c363ff6..381c9a65b 100644 --- a/src/runtime/coreparse.c +++ b/src/runtime/coreparse.c @@ -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 diff --git a/src/runtime/os-common.c b/src/runtime/os-common.c index 1cab74bdd..4b9f53071 100644 --- a/src/runtime/os-common.c +++ b/src/runtime/os-common.c @@ -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");