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

100
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)))
(intmap-fold (define (make-clobber-vector) (make-vector &memory-kind-mask empty-intset))
(lambda (label fx)
;; Unless an expression causes a read, it isn't clobbered by (define clobbered-by-write-to-unknown empty-intset)
;; anything. (define clobbered-by-write-to-any-field (make-clobber-vector))
(when (causes-effect? fx &read) (define clobbered-by-write-to-all-fields (make-clobber-vector))
(let ((me (intset label))) (define clobbered-by-write-to-specific-field (make-hash-table))
(define (add! kind field)
(let* ((k (logior (ash field &memory-kind-bits) kind)) (define (adjoin-to-clobber-vector! v k id)
(clobber (hashv-ref clobbered-by-write k empty-intset))) (vector-set! v k (intset-union (vector-ref v k) (intset id))))
(hashv-set! clobbered-by-write k (intset-union me clobber)))) (define (add-clobbered-by-write-to-any-field! kind label)
;; Clobbered by write to specific field of this memory (adjoin-to-clobber-vector! clobbered-by-write-to-any-field kind label))
;; kind, write to any field of this memory kind, or (define (add-clobbered-by-write-to-all-fields! kind label)
;; write to any field of unknown memory kinds. (adjoin-to-clobber-vector! clobbered-by-write-to-all-fields kind label))
(let* ((loc (ash fx (- &effect-kind-bits))) (define (adjoin-to-clobber-hash! h k id)
(kind (logand loc &memory-kind-mask)) (hashv-set! h k (intset-union (hashv-ref h k empty-intset) (intset id))))
(field (ash loc (- &memory-kind-bits)))) (define (add-clobbered-by-write-to-specific-field! kind+field label)
(add! kind field) (adjoin-to-clobber-hash! clobbered-by-write-to-specific-field
(add! kind -1) kind+field label))
(add! &unknown-memory-kinds -1))))
(values)) (intmap-fold
effects) (lambda (label fx)
(intmap-map (lambda (label fx) ;; Unless an expression causes a read, it isn't clobbered by
(if (causes-effect? fx &write) ;; anything.
(filter-may-alias (when (causes-effect? fx &read)
label (define kind+field (ash fx (- &effect-kind-bits)))
(hashv-ref clobbered-by-write (define kind (logand &memory-kind-mask kind+field))
(ash fx (- &effect-kind-bits)) (define field (ash kind+field (- &memory-kind-bits)))
empty-intset)) (cond
empty-intset)) ((eqv? field -1)
effects))) ;; A read of the whole object is clobbered by a write to any
;; field.
(add-clobbered-by-write-to-all-fields! kind label)
(add-clobbered-by-write-to-any-field! kind label))
((negative? field) (error "unexpected field"))
(else
;; A read of a specific field is clobbered by a write to that
;; specific field, or a write to all fields.
(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))
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)
(if (causes-effect? fx &write)
(filter-may-alias label (lookup-clobbers fx))
empty-intset))
effects))
(define *primitive-effects* (make-hash-table)) (define *primitive-effects* (make-hash-table))