diff options
author | Andy Wingo <wingo@pobox.com> | 2021-11-15 10:32:26 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2021-11-15 15:32:54 +0100 |
commit | 4fcd643adb6e9c21e0ad3d22a9acf812b2228798 (patch) | |
tree | 0e458e0f24a166239732c7cbc798ce423e080e70 /module/language/cps/compile-bytecode.scm | |
parent | a227c84a76da4fef2d15312d2a0b84eb56b72af7 (diff) | |
download | guile-4fcd643adb6e9c21e0ad3d22a9acf812b2228798.tar.gz |
Refactor send and receive shuffles in slot allocation
* module/language/cps/slot-allocation.scm (lookup-send-parallel-moves):
Rename from `lookup-parallel-moves'.
(lookup-receive-parallel-moves): New function. Now we attach "receive
moves" to call and prompt conts instead of to their continuations.
(compute-shuffles): Refactor to allow a continuation to have both send
and receive shuffles.
(compute-frame-size): Refactor for new shuffles mechanism
(allocate-slots): Allow calls to proceed directly to kargs.
Diffstat (limited to 'module/language/cps/compile-bytecode.scm')
-rw-r--r-- | module/language/cps/compile-bytecode.scm | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index ee3807f0c..58d908b1c 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -67,7 +67,7 @@ (intmap-fold (lambda (label cont forwarding-labels) (match cont (($ $kargs _ _ ($ $continue k _ ($ $values))) - (match (lookup-parallel-moves label allocation) + (match (lookup-send-parallel-moves label allocation) (() (match (intmap-ref cps k) (($ $ktail) forwarding-labels) @@ -118,7 +118,7 @@ (define (compile-receive label proc-slot cont) (define (shuffle-results) - (let lp ((moves (lookup-parallel-moves label allocation)) + (let lp ((moves (lookup-receive-parallel-moves label allocation)) (reset-frame? #f)) (cond ((and (not reset-frame?) @@ -143,7 +143,7 @@ rest))))) (cond ((and (= 1 nreq) rest-var (not (maybe-slot rest-var)) - (match (lookup-parallel-moves label allocation) + (match (lookup-receive-parallel-moves label allocation) ((((? (lambda (src) (= src proc-slot)) src) . dst)) dst) (_ #f))) @@ -424,7 +424,7 @@ receive-args) (emit-j asm k) (emit-label asm receive-args) - (compile-receive kh proc-slot (intmap-ref cps kh)) + (compile-receive label proc-slot (intmap-ref cps kh)) (emit-j asm (forward-label kh)))) (define (compile-test label next-label kf kt op param args) @@ -542,14 +542,14 @@ (unless fallthrough? (emit-j asm forwarded-k))) (define (compile-values nvalues) - (emit-moves (lookup-parallel-moves label allocation)) + (emit-moves (lookup-send-parallel-moves label allocation)) (match cont (($ $ktail) (compile-tail nvalues emit-return-values)) (($ $kargs) (maybe-emit-jump)))) (define (compile-call kfun proc args) - (emit-moves (lookup-parallel-moves label allocation)) + (emit-moves (lookup-send-parallel-moves label allocation)) (let* ((nclosure (if proc 1 0)) (nargs (+ nclosure (length args)))) (match cont @@ -567,7 +567,7 @@ (emit-call asm proc-slot nargs)) (emit-slot-map asm proc-slot (lookup-slot-map label allocation)) - (compile-receive k proc-slot cont) + (compile-receive label proc-slot cont) (maybe-emit-jump)))))) (match exp (($ $values args) |