mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

Immediate variants of vector-ref, etc use immediate param

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2017-11-01 14:52:57 +01:00
parent 2f45cfcb9c
commit f9b8763921
6 changed files with 45 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

16
module/language/cps/compile-bytecode.scm
View file

@ -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))))

7
module/language/cps/cse.scm
View file

@ -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

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

@ -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.

6
module/language/cps/slot-allocation.scm
View file

@ -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))

12
module/language/cps/specialize-primcalls.scm
View file

@ -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))

22
module/language/cps/types.scm
View file

@ -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)