constant-needs-allocation? fix

* module/language/cps/dfg.scm (constant-needs-allocation?): Constants
  need allocation when they are used as a slot-needing operand, not when
  they are not used as an immediate operand.  Fixes the case where one
  var is used in both ways after CSE, in struct-set!/immediate.

diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm
index 1b06b56..3180e3d 100644 (file)
--- a/module/language/cps/dfg.scm
+++ b/module/language/cps/dfg.scm
@@ -979,13 +979,13 @@ body continuation in the prompt."
     (else
      (values #f #f))))
 
-(define (constant-needs-allocation? sym val dfg)
+(define (constant-needs-allocation? var val dfg)
   (define (immediate-u8? val)
     (and (integer? val) (exact? val) (<= 0 val 255)))
 
   (define (find-exp term)
     (match term
-      (($ $kargs names syms body) (find-exp body))
+      (($ $kargs names vars body) (find-exp body))
       (($ $letk conts body) (find-exp body))
       (else term)))
 
@@ -996,33 +996,33 @@ body continuation in the prompt."
        (($ $callk) #f)
        (($ $values) #f)
        (($ $primcall 'free-ref (closure slot))
-        (not (eq? sym slot)))
+        (eq? var closure))
        (($ $primcall 'free-set! (closure slot value))
-        (not (eq? sym slot)))
+        (or (eq? var closure) (eq? var value)))
        (($ $primcall 'cache-current-module! (mod . _))
-        (eq? sym mod))
+        (eq? var mod))
        (($ $primcall 'cached-toplevel-box _)
         #f)
        (($ $primcall 'cached-module-box _)
         #f)
        (($ $primcall 'resolve (name bound?))
-        (eq? sym name))
+        (eq? var name))
        (($ $primcall 'make-vector/immediate (len init))
-        (not (eq? sym len)))
+        (eq? var init))
        (($ $primcall 'vector-ref/immediate (v i))
-        (not (eq? sym i)))
+        (eq? var v))
        (($ $primcall 'vector-set!/immediate (v i x))
-        (not (eq? sym i)))
+        (or (eq? var v) (eq? var x)))
        (($ $primcall 'allocate-struct/immediate (vtable nfields))
-        (not (eq? sym nfields)))
+        (eq? var vtable))
        (($ $primcall 'struct-ref/immediate (s n))
-        (not (eq? sym n)))
+        (eq? var s))
        (($ $primcall 'struct-set!/immediate (s n x))
-        (not (eq? sym n)))
+        (or (eq? var s) (eq? var x)))
        (($ $primcall 'builtin-ref (idx))
         #f)
        (_ #t)))
-   (vector-ref (dfg-uses dfg) (- sym (dfg-min-var dfg)))))
+   (vector-ref (dfg-uses dfg) (- var (dfg-min-var dfg)))))
 
 (define (continuation-scope-contains? scope-k k dfg)
   (let ((scope-level (lookup-scope-level scope-k dfg)))