[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/03: Add compute-clobber-map to effect analysis
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/03: Add compute-clobber-map to effect analysis |
Date: |
Thu, 30 Nov 2017 06:57:35 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit eb85b4190f5d8349c8dc0121c27b85347370605e
Author: Andy Wingo <address@hidden>
Date: Thu Nov 30 11:42:04 2017 +0100
Add compute-clobber-map to effect analysis
* module/language/cps/effects-analysis.scm (compute-clobber-map): New
public function.
---
module/language/cps/effects-analysis.scm | 37 +++++++++++++++++++++++++++++++-
1 file changed, 36 insertions(+), 1 deletion(-)
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index fd5e797..298a7be 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -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
@@ -80,7 +81,8 @@
causes-effect?
causes-all-effects?
- effect-clobbers?))
+ effect-clobbers?
+ compute-clobber-map))
(define-syntax define-flags
(lambda (x)
@@ -230,6 +232,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 *primitive-effects* (make-hash-table))
(define-syntax-rule (define-primitive-effects* param