Transitioning to julia 0.6 (may be hard)
[forth.jl.git] / src / lib_2_control.4th
1 \ Flow control
2
3 \ ... if/unless ... [else ...] then
4
5 : IF IMMEDIATE
6         ['] 0BRANCH ,     \ compile 0BRANCH
7         HERE          \ save location of the offset on the stack
8         0 ,             \ compile a dummy offset
9 ;
10
11 : UNLESS IMMEDIATE
12         ['] NOT ,         \ compile NOT (to reverse the test)
13         [COMPILE] IF    \ continue by calling the normal IF
14 ;
15
16 : THEN IMMEDIATE
17         DUP
18         HERE SWAP -   \ calculate the offset from the address saved on the stack
19         SWAP !          \ store the offset in the back-filled location
20 ;
21
22 : ELSE IMMEDIATE
23         ['] BRANCH ,      \ definite branch to just over the false-part
24         HERE          \ save location of the offset on the stack
25         0 ,             \ compile a dummy offset
26         SWAP            \ now back-fill the original (IF) offset
27         DUP             \ same as for THEN word above
28         HERE SWAP -
29         SWAP !
30 ;
31
32
33 \ begin ... while ... repeat, begin ... until, begin ... repeat
34
35 : BEGIN IMMEDIATE
36         HERE          \ save location on the stack
37 ;
38
39 : UNTIL IMMEDIATE
40         ['] 0BRANCH ,     \ compile 0BRANCH
41         HERE -        \ calculate the offset from the address saved on the stack
42         ,               \ compile the offset here
43 ;
44
45 : AGAIN IMMEDIATE
46         ['] BRANCH ,      \ compile BRANCH
47         HERE -        \ calculate the offset back
48         ,               \ compile the offset here
49 ;
50
51 : WHILE IMMEDIATE
52         ['] 0BRANCH ,     \ compile 0BRANCH
53         HERE          \ save location of the offset2 on the stack
54         0 ,             \ compile a dummy offset2
55 ;
56
57 : REPEAT IMMEDIATE
58         ['] BRANCH ,      \ compile BRANCH
59         SWAP            \ get the original offset (from BEGIN)
60         HERE - ,      \ and compile it after BRANCH
61         DUP
62         HERE SWAP -   \ calculate the offset2
63         SWAP !          \ and back-fill it in the original location
64 ;
65
66
67 \ [?]do ... [+]loop 
68
69 : DO IMMEDIATE
70         ['] LIT , -1 , [COMPILE] IF
71         ['] >R , ['] >R ,
72         ['] LIT , HERE 0 , ['] >R ,
73         HERE
74 ;
75
76 : ?DO IMMEDIATE
77         ['] 2DUP , ['] - , [COMPILE] IF
78         ['] >R , ['] >R ,
79         ['] LIT , HERE 0 , ['] >R ,
80         HERE
81 ;
82
83 : I RSP@ 3 - @ ;
84
85 : J RSP@ 6 - @ ;
86
87 : K RSP@ 9 - @ ;
88
89 : ?LEAVE IMMEDIATE
90         ['] 0BRANCH , 13 ,
91         ['] R> , ['] RDROP , ['] RDROP ,
92         ['] LIT ,  HERE 7 + , ['] DUP , ['] -ROT , ['] - , ['] SWAP , ['] ! ,
93         ['] BRANCH ,
94         0 ,
95 ;
96
97 : LEAVE IMMEDIATE
98         ['] LIT , -1 ,
99         [COMPILE] ?LEAVE
100 ;
101
102 \ Clean up return stack
103 : UNLOOP IMMEDIATE
104         ['] RDROP , ['] RDROP , ['] RDROP ,
105 ;
106
107 : +LOOP IMMEDIATE
108
109         ['] DUP , \ Store copy of increment
110
111         ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] + , ['] 2DUP , ['] - ,
112         ['] SWAP , ['] >R , ['] SWAP , ['] >R , ['] SWAP , ['] >R ,
113
114         \ Condition differently depending on sign of increment
115         ['] SWAP , ['] 0>= , [COMPILE] IF
116             ['] 0<= ,
117         [COMPILE] ELSE
118             ['] 0> ,
119         [COMPILE] THEN
120
121         \ Branch back to begining of loop kernel
122         ['] 0BRANCH , HERE - ,
123
124         \ Clean up
125         ['] RDROP , ['] RDROP , ['] RDROP ,
126
127         \ Record address of loop end for any LEAVEs to use
128         HERE SWAP !
129
130         [COMPILE] ELSE
131             ['] 2DROP , \ Clean up if loop was entirely skipped (?DO)
132         [COMPILE] THEN
133 ;
134
135 : LOOP IMMEDIATE
136         ['] LIT , 1 ,
137         [COMPILE] +LOOP
138 ;
139
140
141 \ case [of ... endof]+ ... endcase
142
143 : CASE IMMEDIATE
144         0               \ push 0 to mark the bottom of the stack
145 ;
146
147 : OF IMMEDIATE
148         ['] OVER ,        \ compile OVER
149         ['] = ,           \ compile =
150         [COMPILE] IF      \ compile IF
151         ['] DROP ,        \ compile DROP
152 ;
153
154 : ENDOF IMMEDIATE
155         [COMPILE] ELSE    \ ENDOF is the same as ELSE
156 ;
157
158 : ENDCASE IMMEDIATE
159         ['] DROP ,        \ compile DROP
160
161         \ keep compiling THEN until we get to our zero marker
162         BEGIN
163                 ?DUP
164         WHILE
165                 [COMPILE] THEN
166         REPEAT
167 ;