[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)
- [Guile-commits] branch master updated (2d8c75f -> f96a670), Andy Wingo, 2017/11/05
- [Guile-commits] 10/16: Tweak optimization order, Andy Wingo, 2017/11/05
- [Guile-commits] 12/16: Specialize primcalls more aggressively, Andy Wingo, 2017/11/05
- [Guile-commits] 13/16: Earlier conversion to /imm primcalls, Andy Wingo, 2017/11/05
- [Guile-commits] 02/16: cache-current-module, etc use immediate primcall parameters, Andy Wingo, 2017/11/05
- [Guile-commits] 05/16: Immediate variants of vector-ref, etc use immediate param,
Andy Wingo <=
- [Guile-commits] 15/16: error, scm-error primcalls expand to `throw', Andy Wingo, 2017/11/05
- [Guile-commits] 07/16: builtin-ref takes immediate parameter, Andy Wingo, 2017/11/05
- [Guile-commits] 09/16: reify-primitives reifies constants for out-of-range imm params, Andy Wingo, 2017/11/05
- [Guile-commits] 03/16: load-f64, etc take immediate parameters, Andy Wingo, 2017/11/05
- [Guile-commits] 04/16: free-ref, free-set take immediate parameters, Andy Wingo, 2017/11/05
- [Guile-commits] 11/16: (system base types) uses target's idea of max size_t, Andy Wingo, 2017/11/05
- [Guile-commits] 16/16: Add new "throw" VM ops, Andy Wingo, 2017/11/05
- [Guile-commits] 14/16: Add lsh, rsh instructions, Andy Wingo, 2017/11/05
- [Guile-commits] 06/16: Immediate parameter for struct-ref et al, Andy Wingo, 2017/11/05
- [Guile-commits] 08/16: Remaining /immediate instructions take primcall imm param, Andy Wingo, 2017/11/05