mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

Fix effects analysis: field writes clobber object reads

Browse source 
* module/language/cps/effects-analysis.scm (compute-clobber-map):
Previously a whole-object read would not be clobbered by a specific
field write.  This crops up for the &read introduced at the site of
`cons` for the synthetic car and cdr definitions.  This error was there
before but didn't cause bugs before 3.0.10 because cons got eagerly
lowered to separate allocation and initialization instructions.
This commit is contained in:
Andy Wingo 2024-03-20 11:32:51 +01:00
parent b012c80875
commit 48548df91e
1 changed files with 69 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

80
module/language/cps/effects-analysis.scm
View file

@ -311,37 +311,75 @@ the LABELS that are clobbered by the effects of LABEL."
clobbered-labels clobbered-labels
(intset-remove clobbered-labels clobbered-label))))) (intset-remove clobbered-labels clobbered-label)))))
clobbered-labels clobbered-labels)))) clobbered-labels clobbered-labels))))
(let ((clobbered-by-write (make-hash-table)))
(define (make-clobber-vector) (make-vector &memory-kind-mask empty-intset))
(define clobbered-by-write-to-unknown empty-intset)
(define clobbered-by-write-to-any-field (make-clobber-vector))
(define clobbered-by-write-to-all-fields (make-clobber-vector))
(define clobbered-by-write-to-specific-field (make-hash-table))
(define (adjoin-to-clobber-vector! v k id)
(vector-set! v k (intset-union (vector-ref v k) (intset id))))
(define (add-clobbered-by-write-to-any-field! kind label)
(adjoin-to-clobber-vector! clobbered-by-write-to-any-field kind label))
(define (add-clobbered-by-write-to-all-fields! kind label)
(adjoin-to-clobber-vector! clobbered-by-write-to-all-fields kind label))
(define (adjoin-to-clobber-hash! h k id)
(hashv-set! h k (intset-union (hashv-ref h k empty-intset) (intset id))))
(define (add-clobbered-by-write-to-specific-field! kind+field label)
(adjoin-to-clobber-hash! clobbered-by-write-to-specific-field
kind+field label))
(intmap-fold (intmap-fold
(lambda (label fx) (lambda (label fx)
;; Unless an expression causes a read, it isn't clobbered by ;; Unless an expression causes a read, it isn't clobbered by
;; anything. ;; anything.
(when (causes-effect? fx &read) (when (causes-effect? fx &read)
(let ((me (intset label))) (define kind+field (ash fx (- &effect-kind-bits)))
(define (add! kind field) (define kind (logand &memory-kind-mask kind+field))
(let* ((k (logior (ash field &memory-kind-bits) kind)) (define field (ash kind+field (- &memory-kind-bits)))
(clobber (hashv-ref clobbered-by-write k empty-intset))) (cond
(hashv-set! clobbered-by-write k (intset-union me clobber)))) ((eqv? field -1)
;; Clobbered by write to specific field of this memory ;; A read of the whole object is clobbered by a write to any
;; kind, write to any field of this memory kind, or ;; field.
;; write to any field of unknown memory kinds. (add-clobbered-by-write-to-all-fields! kind label)
(let* ((loc (ash fx (- &effect-kind-bits))) (add-clobbered-by-write-to-any-field! kind label))
(kind (logand loc &memory-kind-mask)) ((negative? field) (error "unexpected field"))
(field (ash loc (- &memory-kind-bits)))) (else
(add! kind field) ;; A read of a specific field is clobbered by a write to that
(add! kind -1) ;; specific field, or a write to all fields.
(add! &unknown-memory-kinds -1)))) (add-clobbered-by-write-to-all-fields! kind label)
(add-clobbered-by-write-to-specific-field! kind+field label)))
;; Also clobbered by write to any field of unknown memory kinds.
(add-clobbered-by-write-to-any-field! &unknown-memory-kinds label))
(values)) (values))
effects) effects)
(define (lookup-clobbers fx)
(define kind+field (ash fx (- &effect-kind-bits)))
(define kind (logand &memory-kind-mask kind+field))
(define field (ash kind+field (- &memory-kind-bits)))
(cond
((eqv? field -1)
;; A write to the whole object.
(intset-union
(vector-ref clobbered-by-write-to-any-field kind)
(vector-ref clobbered-by-write-to-all-fields kind)))
((negative? field) (error "unexpected field"))
(else
;; A write to a specific field. In addition to clobbering reads
;; of this specific field, we clobber reads of the whole object,
;; for example the ones that correspond to the synthesized "car"
;; and "cdr" definitions that are associated with a "cons" expr.
(intset-union
(vector-ref clobbered-by-write-to-any-field kind)
(hashv-ref clobbered-by-write-to-specific-field kind+field)))))
(intmap-map (lambda (label fx) (intmap-map (lambda (label fx)
(if (causes-effect? fx &write) (if (causes-effect? fx &write)
(filter-may-alias (filter-may-alias label (lookup-clobbers fx))
label
(hashv-ref clobbered-by-write
(ash fx (- &effect-kind-bits))
empty-intset)) empty-intset))
empty-intset)) effects))
effects)))
(define *primitive-effects* (make-hash-table)) (define *primitive-effects* (make-hash-table))