mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-29 22:40:34 +02:00
All clauses of function have same nlocals
* module/language/cps/compile-bytecode.scm (compile-function): * module/language/cps/slot-allocation.scm ($allocation) (lookup-nlocals, compute-frame-size, allocate-slots): Adapt to have one frame size per function, for all clauses.
This commit is contained in:
parent
f7909b9516
commit
6d9335ad46
2 changed files with 25 additions and 33 deletions
|
@ -84,7 +84,7 @@
|
|||
(define (compile-function cps asm)
|
||||
(let* ((allocation (allocate-slots cps))
|
||||
(forwarding-labels (compute-forwarding-labels cps allocation))
|
||||
(frame-size #f))
|
||||
(frame-size (lookup-nlocals allocation)))
|
||||
(define (forward-label k)
|
||||
(intmap-ref forwarding-labels k (lambda (k) k)))
|
||||
|
||||
|
@ -550,7 +550,6 @@
|
|||
(unless first?
|
||||
(emit-end-arity asm))
|
||||
(emit-label asm label)
|
||||
(set! frame-size (lookup-nlocals label allocation))
|
||||
(emit-begin-kw-arity asm req opt rest kw-indices allow-other-keys?
|
||||
frame-size alt)
|
||||
;; All arities define a closure binding in slot 0.
|
||||
|
|
|
@ -45,7 +45,7 @@
|
|||
|
||||
(define-record-type $allocation
|
||||
(make-allocation slots representations constant-values call-allocs
|
||||
shuffles frame-sizes)
|
||||
shuffles frame-size)
|
||||
allocation?
|
||||
|
||||
;; A map of VAR to slot allocation. A slot allocation is an integer,
|
||||
|
@ -86,9 +86,12 @@
|
|||
;;
|
||||
(shuffles allocation-shuffles)
|
||||
|
||||
;; The number of locals for a $kclause.
|
||||
;; The number of local slots needed for this function. Because we can
|
||||
;; contify common clause tails, we use one frame size for all clauses
|
||||
;; to avoid having to adjust the frame size when continuing to labels
|
||||
;; from other clauses.
|
||||
;;
|
||||
(frame-sizes allocation-frame-sizes))
|
||||
(frame-size allocation-frame-size))
|
||||
|
||||
(define-record-type $call-alloc
|
||||
(make-call-alloc proc-slot slot-map)
|
||||
|
@ -135,8 +138,8 @@
|
|||
(or (call-alloc-slot-map (lookup-call-alloc k allocation))
|
||||
(error "Call has no slot map" k)))
|
||||
|
||||
(define (lookup-nlocals k allocation)
|
||||
(intmap-ref (allocation-frame-sizes allocation) k))
|
||||
(define (lookup-nlocals allocation)
|
||||
(allocation-frame-size allocation))
|
||||
|
||||
(define-syntax-rule (persistent-intmap2 exp)
|
||||
(call-with-values (lambda () exp)
|
||||
|
@ -648,7 +651,7 @@ are comparable with eqv?. A tmp slot may be used."
|
|||
(persistent-intmap
|
||||
(intmap-fold compute-shuffles cps empty-intmap)))
|
||||
|
||||
(define (compute-frame-sizes cps slots call-allocs shuffles)
|
||||
(define (compute-frame-size cps slots call-allocs shuffles)
|
||||
;; Minimum frame has one slot: the closure.
|
||||
(define minimum-frame-size 1)
|
||||
(define (get-shuffles label)
|
||||
|
@ -671,33 +674,23 @@ are comparable with eqv?. A tmp slot may be used."
|
|||
(define (call-size label nargs size)
|
||||
(shuffle-size (get-shuffles label)
|
||||
(max (+ (get-proc-slot label) nargs) size)))
|
||||
(define (measure-cont label cont frame-sizes clause size)
|
||||
(define (measure-cont label cont size)
|
||||
(match cont
|
||||
(($ $kfun)
|
||||
(values #f #f #f))
|
||||
(($ $kclause)
|
||||
(let ((frame-sizes (if clause
|
||||
(intmap-add! frame-sizes clause size)
|
||||
empty-intmap)))
|
||||
(values frame-sizes label minimum-frame-size)))
|
||||
(($ $kargs names vars ($ $continue k src exp))
|
||||
(values frame-sizes clause
|
||||
(let ((size (max-size* vars size)))
|
||||
(match exp
|
||||
(($ $call proc args)
|
||||
(call-size label (1+ (length args)) size))
|
||||
(($ $callk _ proc args)
|
||||
(call-size label (1+ (length args)) size))
|
||||
(($ $values args)
|
||||
(shuffle-size (get-shuffles label) size))
|
||||
(_ size)))))
|
||||
(let ((size (max-size* vars size)))
|
||||
(match exp
|
||||
(($ $call proc args)
|
||||
(call-size label (1+ (length args)) size))
|
||||
(($ $callk _ proc args)
|
||||
(call-size label (1+ (length args)) size))
|
||||
(($ $values args)
|
||||
(shuffle-size (get-shuffles label) size))
|
||||
(_ size))))
|
||||
(($ $kreceive)
|
||||
(values frame-sizes clause
|
||||
(shuffle-size (get-shuffles label) size)))
|
||||
(($ $ktail)
|
||||
(values (intmap-add! frame-sizes clause size) #f #f))))
|
||||
(shuffle-size (get-shuffles label) size))
|
||||
(_ size)))
|
||||
|
||||
(persistent-intmap (intmap-fold measure-cont cps #f #f #f)))
|
||||
(intmap-fold measure-cont cps minimum-frame-size))
|
||||
|
||||
(define (allocate-args cps)
|
||||
(intmap-fold (lambda (label cont slots)
|
||||
|
@ -1043,6 +1036,6 @@ are comparable with eqv?. A tmp slot may be used."
|
|||
(lambda (slots calls)
|
||||
(let* ((slots (allocate-lazy-vars cps slots calls live-in lazy))
|
||||
(shuffles (compute-shuffles cps slots calls live-in))
|
||||
(frame-sizes (compute-frame-sizes cps slots calls shuffles)))
|
||||
(frame-size (compute-frame-size cps slots calls shuffles)))
|
||||
(make-allocation slots representations constants calls
|
||||
shuffles frame-sizes))))))
|
||||
shuffles frame-size))))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue