1
2
3
4
5
6
7
8
9
10
11
12
13 get "bcpl_trans_head"
14 get "bcpl_metering_head"
15
16
17 let CompileExpression (Result, x) be
18 $( let UsageTemp = nil
19 if Metering do UsageTemp := SaveOldUsage ()
20 let Op = x!0 & Right
21 switchon Op into
22 $( default: Transreport (UnrecognizedExpression, x)
23 case NIL_S:
24 endcase
25
26 case NAME_S:
27 case NUMBER_S:
28 case CHARCONST_S:
29 case STRINGCONST_S:
30 case CONSTANT_S:
31 case TRUE_S:
32 case FALSE_S:
33 case LV_S:
34 case VEC_S:
35 case LIST_S:
36 case TABLE_S:
37 case LOCAL_S:
38 Monadic (ASSIGN_S, Result, x)
39 endcase
40
41 case POS_S: case POS_F:
42 case NEG_S: case NEG_F:
43 case NOT_S:
44 if Optimize then if IsConst (x) goto AssignConstant
45 Monadic (Op, Result, x!1)
46 endcase
47
48 AssignConstant:
49 Monadic (ASSIGN_S, Result, x)
50 endcase
51
52
53 case PLUS_S: case PLUS_F:
54 case MINUS_S: case MINUS_F:
55 case MULT_S: case MULT_F:
56 case DIV_S: case DIV_F:
57 case REM_S:
58 case LOGOR_S:
59 case LOGAND_S:
60 case EQV_S:
61 case NEQV_S:
62 if Optimize then if IsConst (x) goto AssignConstant
63 $( let Order = DecideOrder (Result, x!1, x!2)
64 and Desc1, Desc2, Desc3 = vec DescSize, vec DescSize, vec DescSize
65 for i = 1 to 3 do
66 $( test (Order & $81) ne 0
67 then CompileLmode (Result, Desc1)
68 or test (Order & $82) ne 0
69 then CompileOperand (x!1, Desc2)
70 or CompileOperand (x!2, Desc3)
71 Order := Order rshift 3
72 $)
73 GenerateDiadicOperator (Op, Desc1, Desc2, Desc3)
74 endcase
75 $)
76
77 case LSHIFT_S:
78 case RSHIFT_S:
79 case VECAP_S:
80 CompileWithOffset (Op, Result, x!1, x!2)
81 endcase
82
83 case RV_S:
84 $( let Zero = list CONSTANT_S, 0
85 CompileWithOffset (VECAP_S, Result, x!1, Zero)
86 endcase
87 $)
88
89 case REL_S: $( let T, F = TRUE_S, FALSE_S
90 let Xprime = list COND_S, x, lv T, lv F
91 CompileExpression (Result, Xprime)
92 endcase
93 $)
94
95 case COND_S:
96 if Optimize then if IsConst (x!1) do
97 $( let B = Evalconst (x!1)
98 CompileExpression (Result, (B -> x!2, x!3))
99 endcase
100 $)
101
102 $( let L, M = Nextparam (), Nextparam ()
103 GenerateResultBlock ()
104 TransConditional (x!1, false, L)
105 SetResult (x!2)
106 GenerateJump (M)
107 GenerateLabel (L)
108 SetResult (x!3)
109 GenerateLabel (M)
110 ClaimResult (Result)
111 endcase
112 $)
113
114 case VALOF_S:
115 $( let s = SSP
116 let Rl, Rf = ValofLabel, ValofFlag
117 ValofLabel, ValofFlag := Nextparam (), true
118 GenerateResultBlock ()
119 Transbody (x!1)
120 GenerateLabel (ValofLabel)
121 ClaimResult (Result)
122 ValofLabel, ValofFlag := Rl, Rf
123 ResetSSP (s)
124 endcase
125 $)
126
127 case FNAP_S:
128 $( let Desc1, Desc2 = vec DescSize, vec DescSize
129 test (Result!0 & Right) = NAME_S
130 then $( CompileLmode (Result, Desc1)
131 TransFnap (Desc1, x!1, x!2)
132 $)
133 or $( let T = MakeTemp ()
134 CompileLmode (T, Desc1)
135 TransFnap (Desc1, x!1, x!2)
136 Monadic (ASSIGN_S, Result, T)
137 $)
138 endcase
139 $)
140 $)
141 if Metering do RecordUsage (CompileExpression_Meter, UsageTemp)
142 $)
143 and Monadic (Op, Result, x) be
144 $( let Desc1, Desc2 = vec DescSize, vec DescSize
145 and Order = ChooseOrder (CountTemporaries (Result), CountTemporaries (x))
146 if Order do CompileLmode (Result, Desc1)
147 CompileOperand (x, Desc2)
148 unless Order do CompileLmode (Result, Desc1)
149 GenerateMonadicOperator (Op, Desc1, Desc2)
150 $)
151 and ChooseOrder (a, b) = a = b -> (RandomI () & $81) = 0, a > b
152 and DecideOrder (a, b, c) = valof
153 $( let Min, Max = 0, 0
154 and T = list CountTemporaries (a), CountTemporaries (b), CountTemporaries (c)
155 for i = 1 to 2 test ChooseOrder (T!i, T!Max) then Max := i
156 or unless ChooseOrder (T!i, T!Min) do Min := i
157 if Min = Max do Min := (Max + 1) rem 3
158 let Middle = 3 - Min - Max
159 resultis ($81 lshift (Min + 6)) | ($81 lshift (Middle + 3)) | ($81 lshift Max)
160 $)
161
162 and SetResult (x) be
163 $( let Desc = vec DescSize
164 CompileOperand (x, Desc)
165 GenerateResultValue (Desc)
166 $)
167 and ClaimResult (x) be
168 $( let T, Desc = MakeTemp (), vec DescSize
169 CompileLmode (T, Desc)
170 GenerateClaimResult (Desc)
171 Monadic (ASSIGN_S, x, T)
172 $)
173
174 and CompileOperand (x, Desc) be
175 $( let Op = x!0 & Right
176 switchon Op into
177 $( case NAME_S:
178 let T = Cellwithname (x)
179 Desc!0, Desc!1, Desc!2 := T!1, T!2, x!1
180 if Desc!0 = LOCAL_S do
181 $( unless (Desc!1 rshift Left) = RtdefNesting do Transreport (FreeVar, x)
182 Desc!1 := Desc!1 & Right
183 $)
184 return
185
186 case LOCAL_S:
187 case TEMP_S:
188 Desc!0, Desc!1, Desc!2 := Op, x!1, 0
189 return
190
191 case NUMBER_S:
192 case CHARCONST_S:
193 case STRINGCONST_S:
194 Desc!0, Desc!1, Desc!2 := Op, x!1, x!1
195 return
196
197 case CONSTANT_S:
198 Desc!0, Desc!1, Desc!2 := CONSTANT_S, x!1, 0
199 return
200
201 case TRUE_S:
202 Desc!0, Desc!1, Desc!2 := TRUE_S, true, "true"
203 return
204
205 case FALSE_S:
206 Desc!0, Desc!1, Desc!2 := FALSE_S, false, "false"
207 return
208
209 case LV_S:
210 CompileLmode (x!1, Desc)
211 return
212
213 case VEC_S:
214 let n = Evalconst (x!1)
215 if n < 0 do
216 $( Transreport (NegVector, x!1)
217 n := 0
218 $)
219 let p = AllocateLocal (n + 1)
220 Desc!0, Desc!1, Desc!2 := LV_LOCAL, p, "a vector"
221 return
222
223 case LIST_S:
224 p := AllocateLocal (ListSize (x!1))
225 WalkList (x!1, LoadListItem, p)
226 Desc!0, Desc!1, Desc!2 := LV_LOCAL, p, "a list"
227 return
228
229 case TABLE_S:
230 n := ListSize (x!1)
231 p := TableCell
232 TableCell := Newvec (n * 2)
233 TableCell!0 := n
234 WalkList (x!1, StoreTableItem, 0)
235 Desc!0, Desc!1, Desc!2 := TABLE_S, TableCell, "a table"
236 TableCell := p
237 return
238
239 default: if Optimize then if IsConst (x) do
240 $( Desc!0, Desc!1, Desc!2 := CONSTANT_S, Evalconst (x), 0
241 return
242 $)
243 let Result = MakeTemp ()
244 CompileExpression (Result, x)
245 CompileOperand (Result, Desc)
246 return
247 $)
248 $)
249 and LoadListItem (x, p) be
250 $( let Cell = list LOCAL_S, p
251 CompileExpression (Cell, x)
252 $)
253 and StoreTableItem (x, n) be
254 PartialEvalconst (x, lv TableCell!(n * 2 + 1))
255
256 and CompileLmode (x, Desc) be
257 switchon x!0 & Right into
258 $( case RV_S:
259 CompileOperand (x!1, Desc)
260 return
261
262 case VECAP_S:
263 let Result = MakeTemp ()
264 CompileWithOffset (LVECAP_S, Result, x!1, x!2)
265 CompileOperand (Result, Desc)
266 return
267
268 case NAME_S:
269 let T = Cellwithname (x)
270 Desc!1, Desc!2 := T!2, x!1
271 Desc!0 := valof switchon T!1 into
272 $( case GLOBAL_S:
273 resultis LV_GLOBAL
274 case STATIC_S:
275 resultis LV_STATIC
276 case LOCAL_S:
277 unless (Desc!1 rshift Left) = RtdefNesting do Transreport (FreeVar, x)
278 Desc!1 := Desc!1 & Right
279 resultis LV_LOCAL
280 default: Transreport (LmodeRequired, x)
281 resultis T!1
282 $)
283 return
284
285 case LOCAL_S:
286 case TEMP_S:
287 Desc!0, Desc!1, Desc!2 := ((x!0 & Right) = LOCAL_S -> LV_LOCAL, LV_TEMP), x!1, 0
288 return
289
290 default: Transreport (LmodeRequired, x)
291 CompileOperand (x, Desc)
292 $)
293
294 and CompileWithOffset (Op, Result, a, b) be
295 $( let Desc1, Desc2, Desc3 = vec DescSize, vec DescSize, vec DescSize
296 and Order = DecideOrder (Result, a, b)
297 and Offset = 0
298 for i = 1 to 3 do
299 $( test (Order & $81) ne 0
300 then CompileLmode (Result, Desc1)
301 or test (Order & $82) ne 0
302 then CompileOperand (a, Desc2)
303 or CompileOffsetOperand (b, Desc3, lv Offset)
304 Order := Order rshift 3
305 $)
306 GenerateOffsetOperator (Op, Desc1, Desc2, Desc3, Offset)
307 $)
308 and CompileOffsetOperand (x, Desc, LvN) be
309 $( let Op = Op
310 switchon Op into
311 $( case PLUS_S:
312 if Optimize then if IsConst (x!1) do
313 $( CompileOffsetOperand (x!2, Desc, LvN)
314 rv LvN := EvaluateOperator (PLUS_S, Evalconst (x!1), rv LvN)
315 endcase
316 $)
317
318 case MINUS_S:
319 if Optimize then if IsConst (x!2) do
320 $( CompileOffsetOperand (x!1, Desc, LvN)
321 rv LvN := EvaluateOperator (Op, rv LvN, Evalconst (x!2))
322 endcase
323 $)
324
325 default: if Optimize then if IsConst (x) do
326 $( Desc!0, Desc!1, Desc!2 := CONSTANT_S, 0, 0
327 rv LvN := Evalconst (x)
328 endcase
329 $)
330 CompileOperand (x, Desc)
331 rv LvN := 0
332 $)
333 $)