1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
(define inline-dup
;; [x] -> [x x]
'(1 (#f jump) #f 1 call/cc))
(define inline-drop
;; [x] -> []
'(0 (#f jump) #f 2 call/cc))
(define inline-dropn
;; [x1 ... xn xn+1 ...] -> [x1 ... xn+1 ...]
(lambda (n)
`(,n
(#f ; [K n x1 ... xn xn+1 ...]
jump)
#f ,(+ n 2) call/cc)))
(define inline-pick
;; [x1 ... xn] -> [xn x1 ... xn]
(lambda (n)
`(1 ; [1 x1 ... xn]
(#f 2 ; [2 K 1 x1 ... xn]
(#f jump) ; [K' 2 K 1 x1 ... xn]
#f ,(+ 3 n) call/cc ; [K 1 xn ...]
jump)
#f 1 call/cc)))
(define inline-roll
(lambda (n)
`(,@(inline-pick n) ,@(inline-dropn (+ n 1)))))
(define stack-closure
;; Push a procedure to the stack that, when executed, will have the
;; current stack (plus whatever is pushed to it).
;;
;; The arguments to the stack closure are [N returnK self values ...],
;; where `N` is the total number of values to pass to the procedure
;; (`returnK` and `self` excluded).
(lambda (procedure n m)
`((#f ; [next v ...]
(#f ; [K next v ...]
#f 3 ,@(inline-pick 2) ; [K 3 #f K next v ...]
jump)
,m ,(+ n 1) call/cc
;; This is the entry-point into the continuation.
;;
;; [regular? K arg1 values ...]
;; When `regular?` is false, then `K` is the captured continuation,
;; and `arg1` is the continuation of this macro.
;; When `regular?` is true, then `K` is the return continuation, and
;; `arg1` is the number of arguments to the procedure body.
#t eqv?
(#f ; false: [K next]
;; The following is the returned procedure.
(#f ; [returnK N self values ...]
,@(inline-pick 2) 0 ref ; [K-here returnK N self values ...]
#t ,@(inline-pick 3) 4 + ; [(+ N 4) #t K-here returnK N self values ...]
,@(inline-roll 2) ; [K-here (+ N 4) #t returnK N self values ...]
jump) ; [proc K next]
,@inline-dup ; [proc proc K next]
,@(inline-roll 2) ; [K proc proc next]
0 set! ; [proc next]
1 ,@(inline-roll 2) ; [next 1 proc]
jump)
,procedure if)
#f 0 call/cc)))
|
