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:
parent
2ab89102e7
commit
5675e46410
3 changed files with 12 additions and 7 deletions
|
@ -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
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue