1
2
3
4
5
6
7
8
9
10
11
12 get "bcpl_cae_head"
13
14 let Rcom (n) = valof
15
16
17 $( let A, B, C, D = nil, nil, nil, nil
18 Top: let Op = Symb logor LineCount lshift Left
19 switchon Symb into
20 $( case LET_S:
21 case MANIFEST_S: case GLOBAL_S:
22 case EXTERNAL_S: case STATIC_S:
23 if n ge 8 do CaeReport (MisplacedDeclaration)
24 Nextsymb ()
25 test (Op & Right) = LET_S
26 then A := Rdef ()
27 or A := Rblock (Rdeclbody, Op & Right)
28 B := Rcom (0)
29 resultis List3 (Op, A, B)
30
31 case SEMICOLON_S:
32 unless n = 0 resultis 0
33 Nextsymb ()
34 goto Top
35
36 case SECTBRA_S:
37 case SECTBEGIN_S:
38 A := Rblock (Rcom, 0)
39 goto MORE
40
41 case SECTKET_S:
42 case SECTEND_S:
43 case ENDPROG_S:
44 resultis 0
45
46
47 case NAME_S: case NUMBER_S: case STRINGCONST_S: case CHARCONST_S:
48 case TRUE_S: case FALSE_S: case LV_S: case RV_S: case NOT_S:
49 case RBRA_S: case VALOF_S: case PLUS_S: case MINUS_S:
50 case LIST_S: case TABLE_S:
51 A := ReadList (false)
52 Op := Symb logor LineCount lshift Left
53 if Symb = ASSIGN_S do
54 $( Nextsymb ()
55 B := ReadList (true)
56 A := List3 (Op, A, B)
57 goto MORE
58 $)
59 if Symb = COLON_S do
60 $( unless (A!0 & Right) = NAME_S do CaeReport (NameExpected)
61 Nextsymb ()
62 B := Rcom (n = 0 -> 4, n)
63 A := List5 (Op, A, B, LabelList, 0)
64 LabelList := A
65 goto MORE
66 $)
67 if (A!0 & Right) = FNAP_S do
68 $( A!0 := A!0 + RTAP_S - FNAP_S
69 goto MORE
70 $)
71 CaeReport (IncompleteCommand)
72 goto Drain
73
74 case GOTO_S: case RESULTIS_S:
75 Nextsymb ()
76 A := List2 (Op, Rexp (0))
77 goto MORE
78
79 case CALL_S:
80 Nextsymb ()
81 A := List2 (Op, Rexp (0))
82 goto MORE
83
84 case IF_S: case UNLESS_S:
85 case WHILE_S: case UNTIL_S:
86 Nextsymb ()
87 A := Rexp (0)
88 test Symb = DO_S
89 then Nextsymb ()
90 or CaeReport (MissingDO)
91 B := Rcom (8)
92 A := List3 (Op, A, B)
93 goto MORE
94
95 case TEST_S:
96 Nextsymb ()
97 A := Rexp (0)
98 D := Symb
99 unless D = DO_S logor D = IFSO_S logor D = IFNOT_S do
100 $( CaeReport (MalformedTest)
101 goto Drain
102 $)
103 Nextsymb ()
104 B := Rcom (8)
105 unless Symb = (D = DO_S -> OR_S, D = IFSO_S -> IFNOT_S, IFSO_S) do
106 $( CaeReport (MalformedTest)
107 Op := D = IFNOT_S -> UNLESS_S, IF_S
108 A := List3 (Op, A, B)
109 goto Drain
110 $)
111 Nextsymb ()
112 C := Rcom (8)
113 if D = IFNOT_S do
114 $( let q = B
115 B := C
116 C := q
117 $)
118 A := List4 (Op, A, B, C)
119 goto MORE
120
121 case FOR_S:
122 Nextsymb ()
123 A := Rname ()
124 unless Symb = VALDEF_S do
125 $( CaeReport (ValdefExpected)
126 goto Drain
127 $)
128 Nextsymb ()
129 B := Rexp (0)
130 D := 0
131 if Symb = BY_S do
132 $( Nextsymb ()
133 D := Rexp (0)
134 $)
135 test Symb = TO_S
136 then $( Nextsymb ()
137 C := Rexp (0)
138 $)
139 or $( CaeReport (MissingTO)
140 C := ErrorNode
141 $)
142 if Symb = BY_S & D = 0 do
143 $( Nextsymb ()
144 D := Rexp (0)
145 $)
146 test Symb = DO_S
147 then Nextsymb ()
148 or CaeReport (MissingDO)
149 A := List6 (Op, A, B, C, D, Rcom (8))
150 goto MORE
151
152 case BREAK_S: case LOOP_S:
153 case RETURN_S: case FINISH_S:
154 case ENDCASE_S:
155 Nextsymb ()
156 A := List1 (Op)
157 goto MORE
158
159 case SWITCHON_S:
160 Nextsymb ()
161 A := Rexp (0)
162 test Symb = INTO_S
163 then Nextsymb ()
164 or CaeReport (MissingINTO)
165 B := Rblock (Rcom, 0)
166 A := List3 (Op, A, B)
167 goto MORE
168
169 case CASE_S:
170 Nextsymb ()
171 A := Rexp (0)
172 B := 0
173 if Symb = TO_S do
174 $( Nextsymb ()
175 B := Rexp (0)
176 $)
177 test Symb = COLON_S
178 then Nextsymb ()
179 or CaeReport (MissingCOLON)
180 C := Rcom (n = 0 -> 4, n)
181 A := List4 (Op, A, B, C)
182 goto MORE
183
184 case DEFAULT_S:
185 Nextsymb ()
186 test Symb = COLON_S
187 then Nextsymb ()
188 or CaeReport (MissingCOLON)
189 A := List2 (Op, Rcom (n = 0 -> 4, n))
190 goto MORE
191
192 default: CaeReport (UnrecognizedCommand)
193
194 Drain: A := 0
195 while true do switchon Symb into
196 $( case SEMICOLON_S:
197 if n = 0 goto MORE
198 case SECTKET_S:
199 case SECTEND_S:
200 case ENDPROG_S:
201 case LET_S:
202 case GLOBAL_S:
203 case MANIFEST_S:
204 case STATIC_S:
205 case EXTERNAL_S:
206 resultis A
207 case AND_S:
208 Nextsymb ()
209 A := Rdef ()
210 loop
211 case SECTBRA_S:
212 case SECTBEGIN_S:
213 A := Rblock (Rcom, 0)
214 loop
215 default: Nextsymb ()
216 $)
217 $)
218
219 MORE: Op := Symb logor LineCount lshift Left
220 switchon Symb into
221 $( case REPEAT_S:
222 Nextsymb ()
223 A := List2 (Op, A)
224 goto MORE
225
226 case REPEATWHILE_S:
227 case REPEATUNTIL_S:
228 Nextsymb ()
229 B := Rexp (0)
230 A := List3 (Op, A, B)
231 goto MORE
232
233 case SEMICOLON_S:
234 unless n = 0 resultis A
235 Nextsymb ()
236 B := Rcom (0)
237 resultis List3 (Op, A, B)
238
239 case SECTKET_S:
240 case SECTEND_S:
241 case ENDPROG_S:
242 case LET_S:
243 case GLOBAL_S:
244 case MANIFEST_S:
245 case STATIC_S:
246 case EXTERNAL_S:
247 case AND_S:
248 case OR_S:
249 resultis A
250
251 default: CaeReport (IncompleteCommand)
252 goto Drain
253 $)
254 $)