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

Revert "Revert "ppc64: implement soft card marks""

Browse source 
This reverts commit 52dbcfc618.

I'm fairly confident that the change for soft card marks on ppc64
was not the cause of failure reported by Eric Marsden
in https://groups.google.com/g/sbcl-devel/c/a5M2mDk8ZmA/m/1jrtO6K1AwAJ.
Software marks had been in use for slightly over a month, but there was
a "better" culprit change a few days prior to the problem report.
This commit is contained in:
Douglas Katzman 2022-01-07 00:45:10 -05:00
parent 58a495d0ab
commit ff74a2f356
7 changed files with 120 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
crossbuild-runner/backends/ppc64/features
View file

@ -1,5 +1,5 @@
; threads are required because differing versions of the vops for BOUNDP
; and [fast-]symbol-[global-]value and CAS create extra maintenance burden.
:64-bit :untagged-fdefns :sb-thread
:64-bit :untagged-fdefns :sb-thread :soft-card-marks
:gencgc
:compare-and-swap-vops :alien-callbacks

37
src/compiler/ppc64/array.lisp
View file

@ -108,7 +108,40 @@
(:arg-types ,type positive-fixnum)
(:results (value :scs ,scs))
(:result-types ,element-type))
(define-vop (,(symbolicate "DATA-VECTOR-SET/" (string type))
,(if (eq type 'simple-vector)
`(define-vop (,(symbolicate "DATA-VECTOR-SET/" (string type)))
(:note "inline array store")
(:translate data-vector-set)
(:arg-types ,type positive-fixnum ,element-type)
(:args (object :scs (descriptor-reg))
(index :scs (any-reg immediate))
(value :scs ,scs))
(:arg-types simple-vector positive-fixnum *)
(:policy :fast-safe)
(:temporary (:scs (non-descriptor-reg)) ea t1)
(:vop-var vop)
(:generator 5
;; To ensure the right card gets marked, the exact element address must
;; be computed. Alternatively, we could allow some leeway in which card(s)
;; we look at in GC to decide whether a vector page was touched.
;; i.e there are games that could be played to make the boundaries fuzzy
;; which might obviate the need to perform two ADDs here,
;; at the expense of some precision in which cards to re-protect.
;; Probably better to just compute effective address precisely.
(cond ((sc-is index immediate)
(let ((disp (- (ash (+ vector-data-offset (tn-value index)) word-shift)
other-pointer-lowtag)))
(cond ((typep disp '(signed-byte 16))
(inst addi ea object disp))
(t ; doesn't fit in ADDI
(inst lr ea disp)
(inst add ea object ea)))))
(t
(inst addi ea index (- (ash vector-data-offset word-shift) other-pointer-lowtag))
(inst add ea object ea)))
(emit-gc-store-barrier object ea (list t1) (vop-nth-arg 2 vop) value)
(inst std value ea 0)))
`(define-vop (,(symbolicate "DATA-VECTOR-SET/" (string type))
,(symbolicate (string variant) "-SET"))
(:note "inline array store")
(:variant vector-data-offset other-pointer-lowtag)
@ -116,7 +149,7 @@
(:arg-types ,type positive-fixnum ,element-type)
(:args (object :scs (descriptor-reg))
(index :scs (any-reg immediate))
(value :scs ,scs))))))
(value :scs ,scs)))))))
(def-data-vector-frobs simple-base-string byte-index
character character-reg)
#+sb-unicode

21
src/compiler/ppc64/cell.lisp
View file

@ -76,9 +76,13 @@
(:args (object :scs (descriptor-reg))
(value :scs (descriptor-reg any-reg)))
(:info name offset lowtag)
(:ignore name)
(:results)
(:temporary (:scs (non-descriptor-reg)) t1)
(:vop-var vop)
(:generator 1
;; gencgc does not need to emit the barrier for constructors
(unless (member name '(%make-structure-instance make-weak-pointer
%make-ratio %make-complex))
(emit-gc-store-barrier object nil (list t1) (vop-nth-arg 1 vop) value))
(storew value object offset lowtag)))
(define-vop (compare-and-swap-slot)
@ -89,7 +93,9 @@
(:info name offset lowtag)
(:ignore name)
(:results (result :scs (descriptor-reg) :from :load))
(:vop-var vop)
(:generator 5
(emit-gc-store-barrier object nil (list temp) (vop-nth-arg 2 vop) new)
(inst sync)
(inst li temp (- (* offset n-word-bytes) lowtag))
LOOP
@ -114,6 +120,7 @@
(:policy :fast-safe)
(:vop-var vop)
(:generator 15
(emit-gc-store-barrier symbol nil (list temp) (vop-nth-arg 2 vop) new)
(inst sync)
(load-tls-index temp symbol)
;; Thread-local area, no synchronization needed.
@ -187,7 +194,9 @@
(define-vop (set)
(:args (symbol :scs (descriptor-reg))
(value :scs (descriptor-reg any-reg)))
(:temporary (:sc any-reg) tls-slot temp)
(:temporary (:sc non-descriptor-reg) tls-slot)
(:temporary (:sc any-reg) temp)
(:vop-var vop)
(:generator 4
(load-tls-index tls-slot symbol)
(inst ldx temp thread-base-tn tls-slot)
@ -196,6 +205,7 @@
(inst stdx value thread-base-tn tls-slot)
(inst b DONE)
GLOBAL-VALUE
(emit-gc-store-barrier symbol nil (list tls-slot) (vop-nth-arg 1 vop) value)
(storew value symbol symbol-value-slot other-pointer-lowtag)
DONE))
@ -342,6 +352,7 @@
(:temporary (:scs (non-descriptor-reg)) type)
(:results (result :scs (descriptor-reg)))
(:generator 38
(emit-gc-store-barrier fdefn nil (list type))
(let ((normal-fn (gen-label)))
(load-type type function (- fun-pointer-lowtag))
(inst cmpdi type simple-fun-widetag)
@ -431,7 +442,7 @@
(:variant closure-info-offset fun-pointer-lowtag)
(:translate %closure-index-ref))
(define-vop (%closure-index-set word-index-set)
(define-vop (%closure-index-set descriptor-word-index-set)
(:variant closure-info-offset fun-pointer-lowtag)
(:translate %closure-index-set))
@ -487,7 +498,7 @@
(:variant instance-slots-offset instance-pointer-lowtag)
(:arg-types instance positive-fixnum))
(define-vop (instance-index-set word-index-set)
(define-vop (instance-index-set descriptor-word-index-set)
(:policy :fast-safe)
(:translate %instance-set)
(:variant instance-slots-offset instance-pointer-lowtag)

57
src/compiler/ppc64/memory.lisp
View file

@ -11,6 +11,20 @@
;;;; files for more information.
(in-package "SB-VM")
(defun emit-gc-store-barrier (object cell-address temps &optional value-tn-ref value-tn)
(aver (neq (car temps) cell-address)) ; LD would clobber the cell-address
(when (require-gc-store-barrier-p object value-tn-ref value-tn)
;; (inst ld (car temps) thread-base-tn (ash thread-card-table-slot word-shift))
;; RLIDCL dest, source, (64-rightshift), (64-indexbits)
(inst rldicl (car temps) (or cell-address object) (- 64 gencgc-card-shift)
(make-fixup nil :gc-barrier))
;; THREAD-TN's low byte is 0. NL5 is the card table address.
(inst stbx thread-base-tn
(make-random-tn :kind :normal
:sc (sc-or-lose 'non-descriptor-reg) :offset nl5-offset)
(car temps))))
;;; 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,13 +42,39 @@
(value :scs (descriptor-reg any-reg)))
(:variant-vars offset lowtag)
(:policy :fast-safe)
(:vop-var vop)
(:temporary (:sc non-descriptor-reg) t1)
(:generator 4
(emit-gc-store-barrier object nil (list t1) (vop-nth-arg 1 vop) value)
(storew value object offset lowtag)))
;;;; Indexed references:
;;; Define some VOPs for indexed memory reference.
(define-vop (descriptor-word-index-set)
(:args (object :scs (descriptor-reg))
(index :scs (any-reg immediate))
(value :scs (any-reg descriptor-reg)))
(:arg-types * tagged-num *)
(:temporary (:scs (non-descriptor-reg)) temp)
(:variant-vars offset lowtag)
(:policy :fast-safe)
(:vop-var vop)
(:generator 5
(emit-gc-store-barrier object nil (list temp) (vop-nth-arg 2 vop) value)
(sc-case index
((immediate)
(let ((offset (- (ash (+ (tn-value index) offset) word-shift) lowtag)))
(cond ((and (typep offset '(signed-byte 16)) (not (logtest offset #b11)))
(inst std value object offset))
(t
(inst lr temp offset)
(inst stdx value object temp)))))
(t
(inst addi temp index (- (ash offset word-shift) lowtag))
(inst stdx value object temp)))))
;;; Due to the encoding restrictione that doubleword accesses can not displace
;;; from the base register by an arbitrarily aligned value, but only an even
;;; multiple of 4. By using a certain arrangement of lowtags we can get two of
@ -117,12 +157,23 @@
(:result-types *)
(:variant-vars offset lowtag)
(:policy :fast-safe)
(:vop-var vop)
(:generator 5
(let ((ea
(ecase lowtag
(#.instance-pointer-lowtag nil)
(#.other-pointer-lowtag ; has to be (SETF SVREF)
(cond ((sc-is index immediate)
(let ((offset (- (ash (+ (tn-value index) offset) word-shift) lowtag)))
(inst lr temp offset)))
(t
(inst addi temp index (- (ash offset word-shift) lowtag))))
(inst add temp object temp)
temp))))
(emit-gc-store-barrier object ea (list result temp) (vop-nth-arg 3 vop) new-value))
(sc-case index
((immediate)
(let ((offset (- (+ (ash (tn-value index) word-shift)
(ash offset word-shift))
lowtag)))
(let ((offset (- (ash (+ (tn-value index) offset) word-shift) lowtag)))
(inst lr temp offset)))
(t
(inst sldi temp index (- word-shift n-fixnum-tag-bits))

4
src/compiler/ppc64/vm.lisp
View file

@ -77,8 +77,10 @@
(defreg thread 30)
(defreg lip 31)
;; nl5 is reserved for the GC card table base. It's restored after every
;; foreign call, since it coincides with the sixth C arg-passing register.
(defregset non-descriptor-regs
nl0 nl1 nl2 nl3 nl4 nl5 nl6 cfunc nargs nfp)
nl0 nl1 nl2 nl3 nl4 #|nl5|# nl6 cfunc nargs nfp)
(defregset descriptor-regs
fdefn a0 a1 a2 a3 ocfp lra lexenv l0 l1)

8
src/runtime/gencgc.c
View file

@ -3676,7 +3676,8 @@ static void __attribute__((unused)) maybe_pin_code(lispobj addr) {
}
#ifdef LISP_FEATURE_PPC64
static void semiconservative_pin_stack(struct thread* th) {
static void semiconservative_pin_stack(struct thread* th,
generation_index_t gen) {
/* Stack can only pin code, since it contains return addresses.
* Non-code pointers on stack do *not* pin anything, and may be updated
* when scavenging.
@ -3696,7 +3697,8 @@ static void semiconservative_pin_stack(struct thread* th) {
static int boxed_registers[] = BOXED_REGISTERS;
for (j = (int)(sizeof boxed_registers / sizeof boxed_registers[0])-1; j >= 0; --j) {
lispobj word = *os_context_register_addr(context, boxed_registers[j]);
preserve_pointer((void*)word); // maybe pin something, tagged pointer or not
if (gen == 0) sticky_preserve_pointer(word);
else preserve_pointer((void*)word);
}
preserve_pointer((void*)*os_context_lr_addr(context));
preserve_pointer((void*)*os_context_ctr_addr(context));
@ -3973,7 +3975,7 @@ garbage_collect_generation(generation_index_t generation, int raise,
conservative_stack_scan(th, generation, approximate_stackptr);
#elif defined LISP_FEATURE_PPC64
// Pin code if needed
semiconservative_pin_stack(th);
semiconservative_pin_stack(th, generation);
#elif !defined(reg_CODE)
pin_stack(th);
#endif

6
src/runtime/ppc64-assem.S
View file

@ -211,6 +211,9 @@ indirect_ptr(all_threads)
ld reg_A2,16(reg_CFP)
ld reg_A3,24(reg_CFP)
/* load card table base */
ld reg_NL5, THREAD_CARD_TABLE_OFFSET(reg_THREAD)
/* Calculate LRA */
lis reg_LRA,lra@h
ori reg_LRA,reg_LRA,lra@l
@ -445,6 +448,9 @@ lra:
mr reg_CSP,reg_CFP
mr reg_CFP,reg_OCFP
/* load card table base */
ld reg_NL5, THREAD_CARD_TABLE_OFFSET(reg_THREAD)
/* And back into Lisp. */
blr