mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-23 04:50:28 +02:00
Code Activity

Specialize primcalls more aggressively

Browse source 
* module/language/cps/specialize-primcalls.scm (specialize-primcalls):
  Don't restrict /imm params to encodeable immediates; specialize any
  imm.  Rely on reify-primitives to undo the transformation if needed.
This commit is contained in:
Andy Wingo 2017-11-03 09:28:27 +01:00
parent ecff426b89
commit 5457f28af9
1 changed files with 20 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -33,15 +33,14 @@
(define (specialize-primcalls conts)
(let ((constants (compute-constant-values conts)))
(define (u6? var)
(define (uint? var)
(let ((val (intmap-ref constants var (lambda (_) #f))))
(and (exact-integer? val) (<= 0 val 63))))
(define (u8? var)
(let ((val (intmap-ref constants var (lambda (_) #f))))
(and (exact-integer? val) (<= 0 val 255))))
(and (exact-integer? val) (<= 0 val))))
(define (u64? var)
(let ((val (intmap-ref constants var (lambda (_) #f))))
(and (exact-integer? val) (<= 0 val #xffffFFFFffffFFFF))))
(define (num? var)
(number? (intmap-ref constants var (lambda (_) #f))))
(define (s64? var)
(let ((val (intmap-ref constants var (lambda (_) #f))))
(and (exact-integer? val)
@ -60,22 +59,22 @@
...
(_ #f)))
(specialize-case
(('make-vector (? u8? n) init) (make-vector/immediate n (init)))
(('vector-ref v (? u8? n)) (vector-ref/immediate n (v)))
(('vector-set! v (? u8? n) x) (vector-set!/immediate n (v x)))
(('allocate-struct v (? u8? n)) (allocate-struct/immediate n (v)))
(('struct-ref s (? u8? n)) (struct-ref/immediate n (s)))
(('struct-set! s (? u8? n) x) (struct-set!/immediate n (s x)))
(('add x (? u8? y)) (add/immediate y (x)))
(('add (? u8? y) x) (add/immediate y (x)))
(('sub x (? u8? y)) (sub/immediate y (x)))
(('uadd x (? u8? y)) (uadd/immediate y (x)))
(('uadd (? u8? y) x) (uadd/immediate y (x)))
(('usub x (? u8? y)) (usub/immediate y (x)))
(('umul x (? u8? y)) (umul/immediate y (x)))
(('umul (? u8? y) x) (umul/immediate y (x)))
(('ursh x (? u6? y)) (ursh/immediate y (x)))
(('ulsh x (? u6? y)) (ulsh/immediate y (x)))
(('make-vector (? uint? n) init) (make-vector/immediate n (init)))
(('vector-ref v (? uint? n)) (vector-ref/immediate n (v)))
(('vector-set! v (? uint? n) x) (vector-set!/immediate n (v x)))
(('allocate-struct v (? uint? n)) (allocate-struct/immediate n (v)))
(('struct-ref s (? uint? n)) (struct-ref/immediate n (s)))
(('struct-set! s (? uint? n) x) (struct-set!/immediate n (s x)))
(('add x (? num? y)) (add/immediate y (x)))
(('add (? num? y) x) (add/immediate y (x)))
(('sub x (? num? y)) (sub/immediate y (x)))
(('uadd x (? uint? y)) (uadd/immediate y (x)))
(('uadd (? uint? y) x) (uadd/immediate y (x)))
(('usub x (? uint? y)) (usub/immediate y (x)))
(('umul x (? uint? y)) (umul/immediate y (x)))
(('umul (? uint? y) x) (umul/immediate y (x)))
(('ursh x (? uint? y)) (ursh/immediate y (x)))
(('ulsh x (? uint? y)) (ulsh/immediate y (x)))
(('scm->f64 (? f64? var)) (load-f64 var ()))
(('scm->u64 (? u64? var)) (load-u64 var ()))
(('scm->u64/truncate (? u64? var)) (load-u64 var ()))