mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00
Code Activity

Add compute-clobber-map to effect analysis

Browse source 
* module/language/cps/effects-analysis.scm (compute-clobber-map): New
  public function.
This commit is contained in:
Andy Wingo 2017-11-30 11:42:04 +01:00 • committed by Andy Wingo
parent d4883307ca
commit 8e7f857b02
1 changed files with 36 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -42,6 +42,7 @@
(define-module (language cps effects-analysis)
#:use-module (language cps)
#:use-module (language cps utils)
#:use-module (language cps intset)
#:use-module (language cps intmap)
#:use-module (ice-9 match)
#:export (expression-effects
@ -83,7 +84,8 @@
constant?
causes-effect?
causes-all-effects?
effect-clobbers?))
effect-clobbers?
compute-clobber-map))
(define-syntax define-flags
(lambda (x)
@ -236,6 +238,39 @@ is or might be a read or a write to the same location as A."
(not (zero? (logand b (logior &read &write))))
(locations-same?)))
(define (compute-clobber-map effects)
"For the map LABEL->EFFECTS, compute a map LABEL->LABELS indicating
the LABELS that are clobbered by the effects of LABEL."
(let ((clobbered-by-write (make-hash-table)))
(intmap-fold
(lambda (label fx)
;; Unless an expression causes a read, it isn't clobbered by
;; anything.
(when (causes-effect? fx &read)
(let ((me (intset label)))
(define (add! kind field)
(let* ((k (logior (ash field &memory-kind-bits) kind))
(clobber (hashv-ref clobbered-by-write k empty-intset)))
(hashv-set! clobbered-by-write k (intset-union me clobber))))
;; Clobbered by write to specific field of this memory
;; kind, write to any field of this memory kind, or
;; write to any field of unknown memory kinds.
(let* ((loc (ash fx (- &effect-kind-bits)))
(kind (logand loc &memory-kind-mask))
(field (ash loc (- &memory-kind-bits))))
(add! kind field)
(add! kind -1)
(add! &unknown-memory-kinds -1))))
(values))
effects)
(intmap-map (lambda (label fx)
(if (causes-effect? fx &write)
(hashv-ref clobbered-by-write
(ash fx (- &effect-kind-bits))
empty-intset)
empty-intset))
effects)))
(define-inlinable (indexed-field kind var constants)
(let ((val (intmap-ref constants var (lambda (_) #f))))
(if (and (exact-integer? val) (<= 0 val))