[Guile-commits] 01/02: -O1 disables call precoloring

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 5675e46410c9a24b05ddf58cbe3b998a4c9cad7c
Author: Andy Wingo <address@hidden>
Date:   Thu Nov 30 16:58:58 2017 +0100

    -O1 disables call precoloring
    
    * module/language/cps/compile-bytecode.scm (compile-function)
      (emit-bytecode):
    * module/language/cps/slot-allocation.scm (allocate-slots):
    * module/language/cps/optimize.scm (cps-default-optimization-options):
      Allow the "lazy vars" optimization, a form of slot precoloring, to be
      disabled.  It will be disabled at -O0 or -O1, to speed compilation
      times.
---
 module/language/cps/compile-bytecode.scm | 7 ++++---
 module/language/cps/optimize.scm         | 4 +++-
 module/language/cps/slot-allocation.scm  | 8 +++++---
 3 files changed, 12 insertions(+), 7 deletions(-)

diff --git a/module/language/cps/compile-bytecode.scm 
b/module/language/cps/compile-bytecode.scm
index 8393138..f7c8fbb 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -81,8 +81,9 @@
                     (_ forwarding-labels)))
                 cps empty-intmap)))
 
-(define (compile-function cps asm)
-  (let* ((allocation (allocate-slots cps))
+(define (compile-function cps asm opts)
+  (let* ((allocation (allocate-slots cps #:precolor-calls?
+                                     (kw-arg-ref opts #:precolor-calls? #t)))
          (forwarding-labels (compute-forwarding-labels cps allocation))
          (frame-size (lookup-nlocals allocation)))
     (define (forward-label k)
@@ -600,7 +601,7 @@
 (define (emit-bytecode exp env opts)
   (let ((asm (make-assembler)))
     (intmap-for-each (lambda (kfun body)
-                       (compile-function (intmap-select exp body) asm))
+                       (compile-function (intmap-select exp body) asm opts))
                      (compute-reachable-functions exp 0))
     (values (link-assembly asm #:page-aligned? (kw-arg-ref opts #:to-file? #f))
             env
diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm
index e5f46b9..6621919 100644
--- a/module/language/cps/optimize.scm
+++ b/module/language/cps/optimize.scm
@@ -133,4 +133,6 @@
    #:resolve-self-references? #t
    #:specialize-numbers? #t
    #:licm? #t
-   #:rotate-loops? #t))
+   #:rotate-loops? #t
+   ;; This one is used by the slot allocator.
+   #:precolor-calls? #t))
diff --git a/module/language/cps/slot-allocation.scm 
b/module/language/cps/slot-allocation.scm
index 21f3e7f..d9963e3 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -793,13 +793,15 @@ are comparable with eqv?.  A tmp slot may be used."
    cps
    empty-intmap))
 
-(define (allocate-slots cps)
+(define* (allocate-slots cps #:key (precolor-calls? #t))
   (let*-values (((defs uses) (compute-defs-and-uses cps))
                 ((representations) (compute-var-representations cps))
                 ((live-in live-out) (compute-live-variables cps defs uses))
                 ((needs-slot) (compute-needs-slot cps defs uses))
-                ((lazy) (compute-lazy-vars cps live-in live-out defs
-                                           needs-slot)))
+                ((lazy) (if precolor-calls?
+                            (compute-lazy-vars cps live-in live-out defs
+                                               needs-slot)
+                            empty-intset)))
 
     (define (empty-live-slots)
       #b0)