diff options
author | Andy Wingo <wingo@pobox.com> | 2021-10-03 21:39:46 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2021-10-03 21:39:46 +0200 |
commit | e60469c8b6936575c079faaffa40a340e1d49f3c (patch) | |
tree | 6a0fb837a7e8369e8e8b2b156d55389aca45b19a | |
parent | 71e201d5c4fd10c4bd9abbbc68b8971e8201ac7f (diff) | |
download | guile-e60469c8b6936575c079faaffa40a340e1d49f3c.tar.gz |
Add primitive alias analysis to CSE
* module/language/cps/effects-analysis.scm (compute-known-allocations):
(compute-clobber-map): Add "conts" parameter, and use it to compute
primcalls that access known allocations. A write to a known allocation
only clobbers a read to a known allocation if they are the same.
* module/language/cps/cse.scm (eliminate-common-subexpressions-in-fun):
Pass conts also to compute-clobber-map.
-rw-r--r-- | module/language/cps/cse.scm | 2 | ||||
-rw-r--r-- | module/language/cps/effects-analysis.scm | 75 |
2 files changed, 72 insertions, 5 deletions
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm index 47c0f90e6..3c67a043a 100644 --- a/module/language/cps/cse.scm +++ b/module/language/cps/cse.scm @@ -735,7 +735,7 @@ for a label, it isn't known to be constant at that label." ;; post-order, so the intmap-fold will visit definitions before ;; uses. (let* ((effects (synthesize-definition-effects (compute-effects conts))) - (clobbers (compute-clobber-map effects)) + (clobbers (compute-clobber-map conts effects)) (succs (compute-successors conts kfun)) (preds (invert-graph succs)) (avail (compute-available-expressions succs kfun clobbers)) diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm index 9ee7f0c62..cdbc50159 100644 --- a/module/language/cps/effects-analysis.scm +++ b/module/language/cps/effects-analysis.scm @@ -242,9 +242,74 @@ is or might be a read or a write to the same location as A." (logtest b (logior &read &write)) (locations-same?))) -(define (compute-clobber-map effects) +(define (compute-known-allocations conts effects) + "Return a map of ACCESS-LABEL to ALLOC-LABEL, indicating stores to and +loads from objects created at known allocation sites." + ;; VAR -> ALLOC map of defining allocations, where ALLOC is a label or + ;; #f. Possibly sparse. + (define allocations + (intmap-fold + (lambda (label fx out) + (match (intmap-ref conts label) + (($ $kargs _ _ ($ $continue k)) + (match (intmap-ref conts k) + (($ $kargs (_) (var)) + (intmap-add out var + (and (not (causes-all-effects? fx)) + (logtest fx &allocation) + label) + (lambda (old new) #f))) + (_ out))) + (_ out))) + effects empty-intmap)) + + (persistent-intmap + (intmap-fold + (lambda (label fx out) + (cond + ((causes-all-effects? fx) out) + ((logtest fx (logior &read &write)) + (match (intmap-ref conts label) + ;; Assume that instructions which cause a known set of effects + ;; and which + (($ $kargs names vars + ($ $continue k src + ($ $primcall name param (obj . args)))) + (match (intmap-ref allocations obj (lambda (_) #f)) + (#f out) + (allocation-label + (intmap-add! out label allocation-label)))) + (_ out))) + (else out))) + effects empty-intmap))) + +(define (compute-clobber-map conts effects) "For the map LABEL->EFFECTS, compute a map LABEL->LABELS indicating the LABELS that are clobbered by the effects of LABEL." + (define known-allocations (compute-known-allocations conts effects)) + (define (filter-may-alias write-label clobbered-labels) + ;; We may be able to remove some entries from CLOBBERED-LABELS, if + ;; we can prove they are not aliased by WRITE-LABEL. + (match (intmap-ref known-allocations write-label (lambda (_) #f)) + (#f + ;; We don't know what object WRITE-LABEL refers to; can't refine. + clobbered-labels) + (clobber-alloc + (intset-fold + (lambda (clobbered-label clobbered-labels) + (match (intmap-ref known-allocations clobbered-label (lambda (_) #f)) + (#f + ;; We don't know what object CLOBBERED-LABEL refers to; + ;; can't refine. + clobbered-labels) + (clobbered-alloc + ;; We know that WRITE-LABEL and CLOBBERED-LABEL refer to + ;; known allocations. The write will only clobber the read + ;; if the two allocations are the same. + (if (eqv? clobber-alloc clobbered-alloc) + clobbered-labels + (intset-remove clobbered-labels clobbered-label))))) + clobbered-labels clobbered-labels)))) (let ((clobbered-by-write (make-hash-table))) (intmap-fold (lambda (label fx) @@ -269,9 +334,11 @@ the LABELS that are clobbered by the effects of LABEL." effects) (intmap-map (lambda (label fx) (if (causes-effect? fx &write) - (hashv-ref clobbered-by-write - (ash fx (- &effect-kind-bits)) - empty-intset) + (filter-may-alias + label + (hashv-ref clobbered-by-write + (ash fx (- &effect-kind-bits)) + empty-intset)) empty-intset)) effects))) |