[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Add primitive alias analysis to CSE
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/02: Add primitive alias analysis to CSE |
Date: |
Sun, 3 Oct 2021 15:46:00 -0400 (EDT) |
wingo pushed a commit to branch main
in repository guile.
commit e60469c8b6936575c079faaffa40a340e1d49f3c
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Sun Oct 3 21:39:46 2021 +0200
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.
---
module/language/cps/cse.scm | 2 +-
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 47c0f90..3c67a04 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 9ee7f0c..cdbc501 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)))