1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00

-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.
This commit is contained in:
Andy Wingo 2017-11-30 16:58:58 +01:00
parent 2ab89102e7
commit 5675e46410
3 changed files with 12 additions and 7 deletions

View file

@ -81,8 +81,9 @@
(_ forwarding-labels))) (_ forwarding-labels)))
cps empty-intmap))) cps empty-intmap)))
(define (compile-function cps asm) (define (compile-function cps asm opts)
(let* ((allocation (allocate-slots cps)) (let* ((allocation (allocate-slots cps #:precolor-calls?
(kw-arg-ref opts #:precolor-calls? #t)))
(forwarding-labels (compute-forwarding-labels cps allocation)) (forwarding-labels (compute-forwarding-labels cps allocation))
(frame-size (lookup-nlocals allocation))) (frame-size (lookup-nlocals allocation)))
(define (forward-label k) (define (forward-label k)
@ -600,7 +601,7 @@
(define (emit-bytecode exp env opts) (define (emit-bytecode exp env opts)
(let ((asm (make-assembler))) (let ((asm (make-assembler)))
(intmap-for-each (lambda (kfun body) (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)) (compute-reachable-functions exp 0))
(values (link-assembly asm #:page-aligned? (kw-arg-ref opts #:to-file? #f)) (values (link-assembly asm #:page-aligned? (kw-arg-ref opts #:to-file? #f))
env env

View file

@ -133,4 +133,6 @@
#:resolve-self-references? #t #:resolve-self-references? #t
#:specialize-numbers? #t #:specialize-numbers? #t
#:licm? #t #:licm? #t
#:rotate-loops? #t)) #:rotate-loops? #t
;; This one is used by the slot allocator.
#:precolor-calls? #t))

View file

@ -793,13 +793,15 @@ are comparable with eqv?. A tmp slot may be used."
cps cps
empty-intmap)) empty-intmap))
(define (allocate-slots cps) (define* (allocate-slots cps #:key (precolor-calls? #t))
(let*-values (((defs uses) (compute-defs-and-uses cps)) (let*-values (((defs uses) (compute-defs-and-uses cps))
((representations) (compute-var-representations cps)) ((representations) (compute-var-representations cps))
((live-in live-out) (compute-live-variables cps defs uses)) ((live-in live-out) (compute-live-variables cps defs uses))
((needs-slot) (compute-needs-slot cps defs uses)) ((needs-slot) (compute-needs-slot cps defs uses))
((lazy) (compute-lazy-vars cps live-in live-out defs ((lazy) (if precolor-calls?
needs-slot))) (compute-lazy-vars cps live-in live-out defs
needs-slot)
empty-intset)))
(define (empty-live-slots) (define (empty-live-slots)
#b0) #b0)