wingo pushed a commit to branch main
in repository guile.
commit 98178ac3080639913948a3daecf177de5dd1608d
Author: Andy Wingo <[email protected]>
AuthorDate: Thu Jun 22 09:15:56 2023 +0200
Add effects analysis for new high-level object accessors
* module/language/cps/effects-analysis.scm: Add car, box-ref, etc to
effects analysis.
---
module/language/cps/effects-analysis.scm | 48 +++++++++++++++++++++++++++++++-
1 file changed, 47 insertions(+), 1 deletion(-)
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index cdbc50159..c6439cfd1 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -1,6 +1,6 @@
;;; Effects analysis on CPS
-;; Copyright (C) 2011-2015,2017-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015,2017-2021,2023 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -413,6 +413,14 @@ the LABELS that are clobbered by the effects of LABEL."
;; Generic objects.
(define (annotation->memory-kind* annotation idx)
+ ;; Lowering from Tree-IL to CPS reifies type-specific constructors and
+ ;; accessors. For these we can treat e.g. vector-length as completely
+ ;; constant as it can commute with any other instruction: the header
+ ;; initialization write of a vector is not visible.
+ ;;
+ ;; However when these instructions are later lowered to allocate-words
+ ;; with explicit initializers, we need to model the header reads and
+ ;; writes as non-commutative.
(match (cons annotation idx)
(('vector . 0) &header)
(('string . (or 0 1 2 3)) &header)
@@ -439,6 +447,44 @@ the LABELS that are clobbered by the effects of LABEL."
('struct &struct)
('atomic-box &unknown-memory-kinds)))
+(define-primitive-effects* param
+ ((allocate-vector size) (&allocate &vector))
+ ((allocate-vector/immediate) (&allocate &vector))
+ ((vector-length v))
+ ((vector-ref/immediate v) (&read-field &vector param))
+ ((vector-ref v idx) (&read-object &vector))
+ ((vector-set!/immediate v val) (&write-field &vector param))
+ ((vector-set! v idx val) (&write-object &vector))
+
+ ((cons x y) (&allocate &pair))
+ ((car pair) (&read-field &pair 0))
+ ((cdr pair) (&read-field &pair 1))
+ ((set-car! pair val) (&write-field &pair 0))
+ ((set-cdr! pair val) (&write-field &pair 1))
+
+ ((box val) (&allocate &box))
+ ((box-ref b) (&read-object &box))
+ ((box-set! b val) (&write-object &box))
+
+ ((allocate-struct vtable) (&allocate &struct))
+ ((vtable-size x))
+ ((vtable-has-unboxed-fields? x))
+ ((vtable-field-boxed? x))
+ ((struct-vtable x))
+ ((struct-ref x) (&read-field &struct param))
+ ((struct-set! x y) (&write-field &struct param))
+
+ ((bv-contents bv))
+ ((bv-length bv))
+
+ ((string-length str))
+ ((string-ref str idx) (&read-object &string))
+ ((string-set! str idx cp) (&write-object &string))
+
+ ((make-closure code) (&allocate &closure))
+ ((closure-ref code) (&read-field &closure param))
+ ((closure-set! code) (&write-field &closure param)))
+
(define-primitive-effects* param
((allocate-words size) (&allocate (annotation->memory-kind param)))
((allocate-words/immediate) (match param
