guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 05/16: Immediate variants of vector-ref, etc use immedia


From: Andy Wingo
Subject: [Guile-commits] 05/16: Immediate variants of vector-ref, etc use immediate param
Date: Sun, 5 Nov 2017 09:00:40 -0500 (EST)

wingo pushed a commit to branch master
in repository guile.

commit f9b8763921f315421c4e0f4ecd94cb0f3f9587af
Author: Andy Wingo <address@hidden>
Date:   Wed Nov 1 14:52:57 2017 +0100

    Immediate variants of vector-ref, etc use immediate param
    
    * module/language/cps/compile-bytecode.scm (compile-function):
    * module/language/cps/cse.scm (compute-equivalent-subexpressions):
    * module/language/cps/effects-analysis.scm:
    * module/language/cps/slot-allocation.scm (compute-needs-slot):
    * module/language/cps/specialize-primcalls.scm (specialize-primcalls):
    * module/language/cps/types.scm (make-vector/immediate):
      (vector-ref/immediate, vector-set!/immediate): Use immediate primcall
      param.
---
 module/language/cps/compile-bytecode.scm     | 16 ++++++++--------
 module/language/cps/cse.scm                  |  7 ++++---
 module/language/cps/effects-analysis.scm     | 18 ++++++------------
 module/language/cps/slot-allocation.scm      |  6 ------
 module/language/cps/specialize-primcalls.scm | 12 +++++++++---
 module/language/cps/types.scm                | 22 ++++++++++++++++++----
 6 files changed, 45 insertions(+), 36 deletions(-)

diff --git a/module/language/cps/compile-bytecode.scm 
b/module/language/cps/compile-bytecode.scm
index 78de187..23ee43b 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -159,12 +159,12 @@
         (($ $primcall 'make-vector #f (length init))
          (emit-make-vector asm (from-sp dst) (from-sp (slot length))
                            (from-sp (slot init))))
-        (($ $primcall 'make-vector/immediate #f (length init))
-         (emit-make-vector/immediate asm (from-sp dst) (constant length)
-                                     (from-sp (slot init))))
-        (($ $primcall 'vector-ref/immediate #f (vector index))
-         (emit-vector-ref/immediate asm (from-sp dst) (from-sp (slot vector))
-                                    (constant index)))
+        (($ $primcall 'make-vector/immediate length (init))
+         (emit-make-vector/immediate asm
+                                     (from-sp dst) length (from-sp (slot 
init))))
+        (($ $primcall 'vector-ref/immediate index (vector))
+         (emit-vector-ref/immediate asm
+                                    (from-sp dst) (from-sp (slot vector)) 
index))
         (($ $primcall 'allocate-struct #f (vtable nfields))
          (emit-allocate-struct asm (from-sp dst) (from-sp (slot vtable))
                                (from-sp (slot nfields))))
@@ -315,9 +315,9 @@
         (($ $primcall 'vector-set! #f (vector index value))
          (emit-vector-set! asm (from-sp (slot vector)) (from-sp (slot index))
                            (from-sp (slot value))))
-        (($ $primcall 'vector-set!/immediate #f (vector index value))
+        (($ $primcall 'vector-set!/immediate index (vector value))
          (emit-vector-set!/immediate asm (from-sp (slot vector))
-                                     (constant index) (from-sp (slot value))))
+                                     index (from-sp (slot value))))
         (($ $primcall 'string-set! #f (string index char))
          (emit-string-set! asm (from-sp (slot string)) (from-sp (slot index))
                            (from-sp (slot char))))
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index f50a164..5dba8fc 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -280,14 +280,15 @@ false.  It could be that both true and false proofs are 
available."
              (add-def! `(primcall car #f ,pair) car))
             (('primcall 'set-cdr! #f pair cdr)
              (add-def! `(primcall cdr #f ,pair) cdr))
-            (('primcall (or 'make-vector 'make-vector/immediate) #f len fill)
+            ;; FIXME: how to propagate make-vector/immediate -> vector-length?
+            (('primcall 'make-vector #f len fill)
              (match defs
                ((vec)
                 (add-def! `(primcall vector-length #f ,(subst vec)) len))))
             (('primcall 'vector-set! #f vec idx val)
              (add-def! `(primcall vector-ref #f ,vec ,idx) val))
-            (('primcall 'vector-set!/immediate #f vec idx val)
-             (add-def! `(primcall vector-ref/immediate #f ,vec ,idx) val))
+            (('primcall 'vector-set!/immediate idx vec val)
+             (add-def! `(primcall vector-ref/immediate ,idx ,vec) val))
             (('primcall (or 'allocate-struct 'allocate-struct/immediate) #f
                         vtable size)
              (match defs
diff --git a/module/language/cps/effects-analysis.scm 
b/module/language/cps/effects-analysis.scm
index fc5d198..44814e6 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -331,20 +331,14 @@ is or might be a read or a write to the same location as 
A."
   ((box-set! v x)                  (&write-object &box)        &type-check))
 
 ;; Vectors.
-(define (vector-field n constants)
-  (indexed-field &vector n constants))
-(define (read-vector-field n constants)
-  (logior &read (vector-field n constants)))
-(define (write-vector-field n constants)
-  (logior &write (vector-field n constants)))
-(define-primitive-effects* constants
+(define-primitive-effects* param
   ((vector . _)                    (&allocate &vector))
   ((make-vector n init)            (&allocate &vector))
-  ((make-vector/immediate n init)  (&allocate &vector))
-  ((vector-ref v n)                (read-vector-field n constants) &type-check)
-  ((vector-ref/immediate v n)      (read-vector-field n constants) &type-check)
-  ((vector-set! v n x)             (write-vector-field n constants) 
&type-check)
-  ((vector-set!/immediate v n x)   (write-vector-field n constants) 
&type-check)
+  ((make-vector/immediate init)    (&allocate &vector))
+  ((vector-ref v n)                (&read-object &vector)      &type-check)
+  ((vector-ref/immediate v)        (&read-field &vector param) &type-check)
+  ((vector-set! v n x)             (&write-object &vector)     &type-check)
+  ((vector-set!/immediate v x)     (&write-field &vector param) &type-check)
   ((vector-length v)                                           &type-check))
 
 ;; Structs.
diff --git a/module/language/cps/slot-allocation.scm 
b/module/language/cps/slot-allocation.scm
index 6a51cca..38dbbda 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -335,12 +335,6 @@ the definitions that are live before and after LABEL, as 
intsets."
               empty-intset)
              ;; FIXME: Move all of these instructions to use $primcall
              ;; params.
-             (($ $primcall 'make-vector/immediate #f (len init))
-              (defs+ init))
-             (($ $primcall 'vector-ref/immediate #f (v i))
-              (defs+ v))
-             (($ $primcall 'vector-set!/immediate #f (v i x))
-              (defs+* (intset v x)))
              (($ $primcall 'allocate-struct/immediate #f (vtable nfields))
               (defs+ vtable))
              (($ $primcall 'struct-ref/immediate #f (s n))
diff --git a/module/language/cps/specialize-primcalls.scm 
b/module/language/cps/specialize-primcalls.scm
index 41629f7..61a2bc9 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -53,9 +53,15 @@
       (define (rename name)
         (build-exp ($primcall name param args)))
       (match (cons name args)
-        (('make-vector (? u8? n) init) (rename 'make-vector/immediate))
-        (('vector-ref v (? u8? n)) (rename 'vector-ref/immediate))
-        (('vector-set! v (? u8? n) x) (rename 'vector-set!/immediate))
+        (('make-vector (? u8? n) init)
+         (build-exp
+           ($primcall 'make-vector/immediate (intmap-ref constants n) (init))))
+        (('vector-ref v (? u8? n))
+         (build-exp
+           ($primcall 'vector-ref/immediate (intmap-ref constants n) (v))))
+        (('vector-set! v (? u8? n) x)
+         (build-exp
+           ($primcall 'vector-set!/immediate (intmap-ref constants n) (v x))))
         (('allocate-struct v (? u8? n)) (rename 'allocate-struct/immediate))
         (('struct-ref s (? u8? n)) (rename 'struct-ref/immediate))
         (('struct-set! s (? u8? n) x) (rename 'struct-set!/immediate))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 414c378..31d8b28 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -408,7 +408,7 @@ minimum, and maximum."
 (define-syntax-rule (&max/s64 x) (min (&max x) &s64-max))
 (define-syntax-rule (&max/size x) (min (&max x) *max-size-t*))
 
-(define-syntax-rule (define-type-checker (name arg ...) body ...)
+(define-syntax-rule (define-type-checker/param (name param arg ...) body ...)
   (hashq-set!
    *type-checkers*
    'name
@@ -419,6 +419,9 @@ minimum, and maximum."
           (&max  (syntax-rules () ((_ val) (var-max typeset val)))))
        body ...))))
 
+(define-syntax-rule (define-type-checker (name arg ...) body ...)
+  (define-type-checker/param (name param arg ...) body ...))
+
 (define-syntax-rule (check-type arg type min max)
   ;; If the arg is negative, it is a closure variable.
   (and (>= arg 0)
@@ -744,9 +747,20 @@ minimum, and maximum."
   (restrict! v &vector (1+ (&min/0 idx)) *max-vector-len*)
   (restrict! idx &u64 0 (1- (&max/vector v))))
 
-(define-type-aliases make-vector make-vector/immediate)
-(define-type-aliases vector-ref vector-ref/immediate)
-(define-type-aliases vector-set! vector-set!/immediate)
+(define-simple-type-checker (make-vector/immediate &all-types))
+(define-type-inferrer/param (make-vector/immediate size init result)
+  (define! result &vector size size))
+
+(define-type-checker/param (vector-ref/immediate idx v)
+  (and (check-type v &vector 0 *max-vector-len*) (< idx (&min v))))
+(define-type-inferrer/param (vector-ref/immediate idx v result)
+  (restrict! v &vector (1+ idx) *max-vector-len*)
+  (define! result &all-types -inf.0 +inf.0))
+
+(define-type-checker/param (vector-set!/immediate idx v val)
+  (and (check-type v &vector 0 *max-vector-len*) (< idx (&min v))))
+(define-type-inferrer/param (vector-set!/immediate idx v val)
+  (restrict! v &vector (1+ idx) *max-vector-len*))
 
 (define-simple-type-checker (vector-length &vector))
 (define-type-inferrer (vector-length v result)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]