mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 06:20:23 +02:00
Preparation for compile-bytecode to work on $kfun $conts
* module/language/cps/compile-bytecode.scm (compile-fun): Change to take a $kfun $cont instead of a $fun. (visit-funs): Change likewise, and call the proc on $kfun $cont's, not $fun's. (compile-bytecode): Adapt. * module/language/cps/dfg.scm (analyze-reverse-control-flow): Adapt to expect a $kfun $cont.
This commit is contained in:
parent
a16af11320
commit
6bc36ca55e
2 changed files with 7 additions and 8 deletions
|
@ -89,9 +89,7 @@
|
||||||
exp))
|
exp))
|
||||||
|
|
||||||
(define (compile-fun f asm)
|
(define (compile-fun f asm)
|
||||||
(let* ((dfg (match f
|
(let* ((dfg (compute-dfg f #:global? #f))
|
||||||
(($ $fun free body)
|
|
||||||
(compute-dfg body #:global? #f))))
|
|
||||||
(allocation (allocate-slots f dfg)))
|
(allocation (allocate-slots f dfg)))
|
||||||
(define (maybe-slot sym)
|
(define (maybe-slot sym)
|
||||||
(lookup-maybe-slot sym allocation))
|
(lookup-maybe-slot sym allocation))
|
||||||
|
@ -473,7 +471,7 @@
|
||||||
(emit-call-label asm proc-slot nargs k))))))
|
(emit-call-label asm proc-slot nargs k))))))
|
||||||
|
|
||||||
(match f
|
(match f
|
||||||
(($ $fun free ($ $cont k ($ $kfun src meta self tail clause)))
|
(($ $cont k ($ $kfun src meta self tail clause))
|
||||||
(compile-entry)))))
|
(compile-entry)))))
|
||||||
|
|
||||||
(define (visit-funs proc exp)
|
(define (visit-funs proc exp)
|
||||||
|
@ -482,7 +480,6 @@
|
||||||
(visit-funs proc exp))
|
(visit-funs proc exp))
|
||||||
|
|
||||||
(($ $fun free body)
|
(($ $fun free body)
|
||||||
(proc exp)
|
|
||||||
(visit-funs proc body))
|
(visit-funs proc body))
|
||||||
|
|
||||||
(($ $letk conts body)
|
(($ $letk conts body)
|
||||||
|
@ -498,6 +495,7 @@
|
||||||
(visit-funs proc alternate)))
|
(visit-funs proc alternate)))
|
||||||
|
|
||||||
(($ $cont sym ($ $kfun src meta self tail clause))
|
(($ $cont sym ($ $kfun src meta self tail clause))
|
||||||
|
(proc exp)
|
||||||
(when clause
|
(when clause
|
||||||
(visit-funs proc clause)))
|
(visit-funs proc clause)))
|
||||||
|
|
||||||
|
@ -512,7 +510,9 @@
|
||||||
(asm (make-assembler)))
|
(asm (make-assembler)))
|
||||||
(visit-funs (lambda (fun)
|
(visit-funs (lambda (fun)
|
||||||
(compile-fun fun asm))
|
(compile-fun fun asm))
|
||||||
exp)
|
(match exp
|
||||||
|
(($ $fun free body)
|
||||||
|
body)))
|
||||||
(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
|
||||||
env)))
|
env)))
|
||||||
|
|
|
@ -325,8 +325,7 @@ body continuation in the prompt."
|
||||||
succs))
|
succs))
|
||||||
|
|
||||||
(match fun
|
(match fun
|
||||||
(($ $fun free
|
(($ $cont kfun ($ $kfun src meta self ($ $cont ktail tail)))
|
||||||
($ $cont kfun ($ $kfun src meta self ($ $cont ktail tail))))
|
|
||||||
(call-with-values
|
(call-with-values
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(compute-reverse-control-flow-order ktail dfg))
|
(compute-reverse-control-flow-order ktail dfg))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue