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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~ ~~ High-level flow-control ~~
~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~
~ We use a novel suffix-based approach to flow control. We define words
~ { and } which describe the boundaries of blocks of code, leaving a
~ description on the value stack, while still compiling the contents
~ normally.
~
~ Then follow-up words such as "if" can use that information to slide
~ the blocks around and insert any needed branches and other logic.
~
~ Both the label transform and the log-load transform go out of their way
~ to make sure these words work. Because of that, we actually get to use these
~ before defining them... just keep in mind nothing under the transform is
~ calling THESE versions.
~ (-- start pointer)
: { here @ ; make-immediate
~ (start pointer -- start pointer, length)
: } dup here @ swap - ; make-immediate
~ (start pointer, length --)
: if
2dup swap dup 5 8 * + 3unroll swap
~ (start pointer, length, adjusted start pointer, start pointer, length)
memmove
~ (start pointer, length)
swap here @ swap here ! swap
~ (old here, length)
' lit entry-to-execution-token , 0 ,
' != entry-to-execution-token ,
~ The branch length needs to be one word longer than the block length,
~ because the length field itself is part of the scope of the branch.
' 0branch entry-to-execution-token , dup 8 + ,
~ (old here, length)
drop 5 8 * + here !
; make-immediate
~ (start pointer, length --)
: unless 2dup swap dup 5 8 * + 3unroll swap
~ (start pointer, length, start pointer, adjusted start pointer, length)
memmove
~ (start pointer, length)
swap here @ swap here ! swap
~ (old here, length)
' lit entry-to-execution-token , 0 ,
' = entry-to-execution-token ,
~ The branch length needs to be one word longer than the block length,
~ because the length field itself is part of the scope of the branch.
' 0branch entry-to-execution-token , dup 8 + ,
~ (old here, length)
drop 5 8 * + here ! ; make-immediate
~ (true start, true length, false start, false length --)
: if-else
dup 4 roll dup 5 unroll +
~ First we slide the false-block forward, then the true-block. We slide
~ them both directly into their final positions, leaving space at the start
~ for a test and branch, and space in between for an unconditional branch.
~ Those spaces will take five words, and two words, respectively. So the
~ false-block gets moved by seven words, and the true-block gets moved by
~ five words.
2dup swap dup 7 8 * + swap 3roll memmove
4 roll dup 5 unroll 4 roll dup 5 unroll
swap dup 5 8 * + swap 3roll memmove
~ (true start, true length, false start, false length)
~ Now we write out the initial test-and-branch.
4 roll dup 5 unroll here @ 6 unroll here !
~ (old here, true start, true length, false start, false length)
' lit entry-to-execution-token , 0 ,
' != entry-to-execution-token ,
~ Branch past the length field, the true-block, and the unconditional
~ branch in the middle.
' 0branch entry-to-execution-token ,
3roll dup 4 unroll 3 8 * + ,
~ Next, write out the unconditional branch in the middle.
swap dup 3unroll 5 8 * + here !
' branch entry-to-execution-token ,
~ Branch past the length field and the false-block.
dup 8 + ,
~ Set "here" to point to the true end.
drop drop drop drop 7 8 * + here !
; make-immediate
~ (start, length --)
: forever
' branch entry-to-execution-token , 8 + -1 * , drop
; make-immediate
~ This slides the body forward, leaving the test where it is. It puts a
~ conditional branch in-between them, then appends an unconditional branch
~ at the end.
~
~ (test start, test length, body start, body length --)
: while
~ The conditional branch needs five words.
2dup swap dup 5 8 * + swap 3roll memmove
here @ 5 unroll swap dup 3unroll here !
~ (old here, test start, test length, body start, body length)
' lit entry-to-execution-token , 0 ,
' != entry-to-execution-token ,
~ Branch past the length field, the body, and the unconditional branch.
' 0branch entry-to-execution-token ,
dup 3 8 * + ,
~ Set "here" to the new end.
5 8 * 6 roll + here !
~ (test start, test length, body start, body length)
~ Unconditionally branch backwards past the branch word, the body, the
~ conditional branch, and the test.
' branch entry-to-execution-token ,
6 8 * + swap drop + swap drop -1 * ,
; make-immediate
|