(_ 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)
(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
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))
((constants) (compute-constant-values cps))
((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)