summaryrefslogtreecommitdiff
path: root/module/language/cps/compile-bytecode.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2021-11-15 10:32:26 +0100
committerAndy Wingo <wingo@pobox.com>2021-11-15 15:32:54 +0100
commit4fcd643adb6e9c21e0ad3d22a9acf812b2228798 (patch)
tree0e458e0f24a166239732c7cbc798ce423e080e70 /module/language/cps/compile-bytecode.scm
parenta227c84a76da4fef2d15312d2a0b84eb56b72af7 (diff)
downloadguile-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.scm14
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)