From 5457f28af9c4cea934f61b0e11e2ebdd7e2ce718 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Fri, 3 Nov 2017 09:28:27 +0100
Subject: [PATCH] Specialize primcalls more aggressively

* 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.
---
 module/language/cps/specialize-primcalls.scm | 41 ++++++++++----------
 1 file changed, 20 insertions(+), 21 deletions(-)

diff --git a/module/language/cps/specialize-primcalls.scm b/module/language/cps/specialize-primcalls.scm
index 1bde78a4e..6e92365c9 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -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 ()))