guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 02/04: Slot allocation allows s64/u64 representations of


From: Andy Wingo
Subject: [Guile-commits] 02/04: Slot allocation allows s64/u64 representations of same var
Date: Mon, 13 Nov 2017 09:27:16 -0500 (EST)

wingo pushed a commit to branch master
in repository guile.

commit a88614fb17ed7a3c7d891907414222fc8a9ccd24
Author: Andy Wingo <address@hidden>
Date:   Mon Nov 13 10:34:29 2017 +0100

    Slot allocation allows s64/u64 representations of same var
    
    * module/language/cps/slot-allocation.scm (compute-var-representations):
      If an optimization pass decided to e.g. use untag-fixnum for one
      definition of a variable and e.g. vector-length for the other, assume
      that their values are compatible.  We don't know at this point whether
      the values are meant to be s64 (e.g. because vector-length is a subset
      of the s64 range) or u64 (e.g. because although we're calling
      untag-fixnum on the value, actually we now that the value is
      non-negative, or actually we just want the unsigned bits).  Anyway we
      default to u64.  In the future we can perhasps be more precise.
---
 module/language/cps/slot-allocation.scm | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/module/language/cps/slot-allocation.scm 
b/module/language/cps/slot-allocation.scm
index b8b6681..17471c6 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -744,6 +744,13 @@ are comparable with eqv?.  A tmp slot may be used."
     (match (intmap-ref cps k)
       (($ $kargs names vars) vars)
       (_ '())))
+  (define (meet-s64-u64 old new)
+    (cond
+     ((and (eq? old 's64) (eq? new 'u64))
+      'u64)
+     ((and (eq? old 'u64) (eq? new 's64))
+      'u64)
+     (error "incompatible representations" old new)))
   (intmap-fold
    (lambda (label cont representations)
      (match cont
@@ -754,7 +761,8 @@ are comparable with eqv?.  A tmp slot may be used."
            (match exp
              (($ $values (arg))
               (intmap-add representations var
-                          (intmap-ref representations arg)))
+                          (intmap-ref representations arg)
+                          meet-s64-u64))
              (($ $primcall (or 'scm->f64 'load-f64
                                'bv-f32-ref 'bv-f64-ref
                                'fadd 'fsub 'fmul 'fdiv))
@@ -767,12 +775,12 @@ are comparable with eqv?.  A tmp slot may be used."
                                'uadd/immediate 'usub/immediate 'umul/immediate
                                'ursh/immediate 'ulsh/immediate
                                'bv-u8-ref 'bv-u16-ref 'bv-u32-ref 'bv-u64-ref))
-              (intmap-add representations var 'u64))
+              (intmap-add representations var 'u64 meet-s64-u64))
              (($ $primcall (or 'untag-fixnum
                                'scm->s64 'load-s64
                                'srsh 'srsh/immediate
                                'bv-s8-ref 'bv-s16-ref 'bv-s32-ref 'bv-s64-ref))
-              (intmap-add representations var 's64))
+              (intmap-add representations var 's64 meet-s64-u64))
              (_
               (intmap-add representations var 'scm))))
           (vars
@@ -780,7 +788,8 @@ are comparable with eqv?.  A tmp slot may be used."
              (($ $values args)
               (fold (lambda (arg var representations)
                       (intmap-add representations var
-                                  (intmap-ref representations arg)))
+                                  (intmap-ref representations arg)
+                                  meet-s64-u64))
                     representations args vars))))))
        (($ $kfun src meta self)
         (intmap-add representations self 'scm))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]