1
2
3
4
5
6
7
8
9
10
11
12 get "bcpl_cg_head"
13 get "bcpl_opcodes"
14
15 let ApplyDiadicOperator (Op, Result) be
16 $( let Reg = valof switchon Op into
17 $( case PLUS_S:
18 if Optimize then if TryDiadicRAR (Result, Asa) resultis 0
19 resultis ApplySymmetrical (Ada, AorQr)
20
21 case PLUS_F:
22 resultis ApplySymmetrical (Fad, EAQr)
23
24 case MINUS_S:
25 if Optimize do
26 $( if TryDiadicRAR (Result, Ssa) resultis 0
27 if InRegister (Rrand, AorQr) & not InRegister (Lrand, AorQr) do
28 $( let r = ApplyRL (Sba, AorQr)
29 resultis ApplyNegate (r)
30 $)
31 $)
32 resultis ApplyLR (Sba, AorQr)
33
34 case MINUS_F:
35 if Optimize then if InRegister (Rrand, EAQr) do
36 $( ApplyRL (Fsb, EAQr)
37 resultis ApplyNegate (EAQr)
38 $)
39 resultis ApplyLR (Fsb, EAQr)
40
41 case MULT_S:
42 if Optimize do
43 $( let r = TryShift (Lrand, Rrand)
44 if r ne 0 resultis r
45 r := TryShift (Rrand, Lrand)
46 if r ne 0 resultis r
47 if (InRegister (Lrand, Ar) & not InRegister (Rrand, Qr))
48 | (InRegister (Rrand, Ar) & not InRegister (Lrand, Qr)) do SwapAandQ ()
49 $)
50 GetRegister (Ar)
51 resultis ApplySymmetrical (Mpy, Qr)
52
53 case MULT_F:
54 resultis ApplySymmetrical (Fmp, EAQr)
55
56 case DIV_S:
57 if Optimize then if InRegister (Lrand, Ar) do SwapAandQ ()
58 GetRegister (Ar)
59 resultis ApplyLR (Div, Qr)
60
61 case DIV_F:
62 if Optimize then if InRegister (Rrand, EAQr) do
63 resultis ApplyRL (Fdi, EAQr)
64 resultis ApplyLR (Fdv, EAQr)
65
66 case REM_S:
67 if Optimize then if InRegister (Lrand, Ar) do SwapAandQ ()
68 GetRegister (Ar)
69 ApplyLR (Div, Qr)
70 resultis Ar
71
72 case LOGOR_S:
73 if Optimize then if TryDiadicRAR (Result, Orsa) resultis 0
74 resultis ApplySymmetrical (Ora, AorQr)
75
76 case LOGAND_S:
77 if Optimize then if TryDiadicRAR (Result, Ansa) resultis 0
78 resultis ApplySymmetrical (Ana, AorQr)
79
80 case NEQV_S:
81 if Optimize then if TryDiadicRAR (Result, Ersa) resultis 0
82 resultis ApplySymmetrical (Era, AorQr)
83
84 case EQV_S: $( let r = ApplySymmetrical (Era, AorQr)
85 Literal (true, "true")
86 Outop (FormOpcode (Era, r))
87 resultis r
88 $)
89
90 default: CGreport (UnexpectedCase, Op, "ApplyDiadicOperator")
91 resultis 0
92 $)
93 DisclaimRegister (Lrand)
94 DisclaimRegister (Rrand)
95 ClaimRegister (Reg, Result)
96 $)
97
98 and ApplyOffsetOperator (Op, Result, Offset) be
99 $( let Reg = valof switchon Op into
100 $( case VECAP_S:
101 if Result!0 = LV_TEMP goto RememberAddress
102 let r = GetRegister (AorQr)
103 CombineAddress (Lrand, Rrand, Offset)
104 Outop (FormOpcode (Lda, r))
105 IndicatorsSetBy := r
106 resultis r
107
108 case LVECAP_S:
109 if Result!0 = LV_TEMP goto RememberAddress
110 if Optimize then if IsSameLoc (Result, Lrand) do
111 $( let r = nil
112 test IsZero (Rrand)
113 then $( if Offset = 1 do
114 $( SetupAddr (Result)
115 Outop (Aos)
116 IndicatorsSetBy := 0
117 resultis 0
118 $)
119 r := LoadNumber (Offset, AorQr)
120 $)
121 or $( r := LoadRegister (Rrand, AorQr)
122 unless Offset = 0 do
123 $( Literal (Offset)
124 Outop (FormOpcode (Ada, r))
125 $)
126 $)
127 SetupAddr (Result)
128 Outop (FormOpcode (Asa, r))
129 IndicatorsSetBy := 0
130 RegisterUsage!r := 0
131 resultis 0
132 $)
133 r := GetRegister (AnyPr)
134 CombineAddress (Lrand, Rrand, Offset)
135 Outop (FormOpcode (Eapap, r))
136 resultis r
137
138 RememberAddress:
139 let h = MakeCgTemp (Result!1)
140 h!1 := Op
141 h!2, h!3, h!4 := Lrand!0, Lrand!1, Lrand!2
142 h!5, h!6, h!7 := Rrand!0, Rrand!1, Rrand!2
143 h!8 := Offset
144 return
145
146 case LSHIFT_S:
147 case RSHIFT_S:
148 $( let r = LoadRegister (Lrand, AorQr)
149 let Xr = IsZero (Rrand) -> 0, LoadIndex (Rrand, AnyXr)
150 Outop3 (FormOpcode (Op = LSHIFT_S -> Als, Arl, r), Offset, FormTag (Xr))
151 IndicatorsSetBy := r
152 resultis r
153 $)
154
155 default: CGreport (UnexpectedCase, Op, "ApplyAddressOperator")
156 resultis 0
157 $)
158 DisclaimRegister (Lrand)
159 DisclaimRegister (Rrand)
160 ClaimRegister (Reg, Result)
161 $)
162
163 and ApplyMonadicOperator (Op, Result) be
164 $( let Reg = valof switchon Op into
165 $( case POS_S:
166 case POS_F:
167 case ASSIGN_S:
168 if Optimize then if Result!0 ne LV_TEMP do
169 $( Store (Lrand, Result)
170 resultis 0
171 $)
172 resultis LoadAppropriateRegister (Lrand, 0)
173
174 case NEG_S:
175 if Optimize then if TryMonadicRAR (Result, Ssa, 0) resultis 0
176 resultis LoadNegative (Lrand)
177
178 case NEG_F:
179 resultis ApplyNegate (LoadRegister (Lrand, EAQr))
180
181 case NOT_S:
182 if Optimize then if TryMonadicRAR (Result, Ersa, true) resultis 0
183 let r = FindInRegister (Lrand, AorQr)
184 test r = 0
185 then $( r := LoadNumber (true, AorQr, "true")
186 Makeaddressable (Lrand)
187 $)
188 or Literal (true, "true")
189 Outop (FormOpcode (Era, r))
190 IndicatorsSetBy := r
191 resultis r
192
193 default: CGreport (UnexpectedCase, Op, "ApplyMonadicOperator")
194 resultis 0
195 $)
196 DisclaimRegister (Lrand)
197 ClaimRegister (Reg, Result)
198 $)
199
200 and ApplySymmetrical (Inst, Reg) = InRegister (Rrand, Reg) -> ApplyRL (Inst, Reg), ApplyLR (Inst, Reg)
201 and ApplyRL (Inst, Reg) = valof
202 $( let t, u = Lrand, Rrand
203 Rrand, Lrand := t, u
204 let r = ApplyLR (Inst, Reg)
205 Lrand, Rrand := t, u
206 resultis r
207 $)
208 and ApplyLR (Inst, Reg) = valof
209 $( let r = LoadRegister (Lrand, Reg)
210 Makeaddressable (Rrand)
211 Outop (FormOpcode (Inst, r))
212 IndicatorsSetBy := r
213 resultis r
214 $)
215 and ApplyNegate (r) = valof
216 switchon r into
217 $( case Qr: if RegisterTemps!Ar = 0 do
218 $( Outop3 (Negl, 0, Dl)
219 IndicatorsSetBy := 0
220 resultis Qr
221 $)
222 SwapAandQ ()
223 case Ar: Outop3 (Neg, 0, Dl)
224 IndicatorsSetBy := Ar
225 resultis Ar
226 case EAQr:Outop3 (Fneg, 0, Dl)
227 IndicatorsSetBy := EAQr
228 resultis EAQr
229 default: CGreport (UnexpectedCase, r, "ApplyNegate")
230 resultis r
231 $)
232 and LoadNegative (t) = valof
233 $( let r = FindInRegister (t, AorQr)
234 if r ne 0 resultis ApplyNegate (r)
235 r := GetRegister (AorQr)
236 Makeaddressable (t)
237 Outop (FormOpcode (Lca, r))
238 IndicatorsSetBy := r
239 resultis r
240 $)
241
242 and TryShift (Rand, Const) = valof
243 $( unless IsNumber (Const) resultis 0
244 let n, i = EvalNumber (Const!0, Const!1), 0
245 until n = (1 lshift i) do
246 $( if i > 36 resultis 0
247 i := i + 1
248 $)
249 let r = LoadRegister (Rand, AorQr)
250 Outop3 (FormOpcode (Als, r), i, 0)
251 IndicatorsSetBy := r
252 resultis r
253 $)
254
255 and TryMonadicRAR (Result, Op, Const) = valof
256 $( unless IsSameLoc (Result, Lrand) resultis false
257 let r = LoadNumber (Const, AorQr, 0)
258 SetupAddr (Result)
259 Outop (FormOpcode (Op, r))
260 IndicatorsSetBy := 0
261 RegisterUsage!r := 0
262 resultis true
263 $)
264 and TryDiadicRAR (Result, Op) = valof
265 $( let X = Rrand
266 unless IsSameLoc (Result, Lrand) do
267 $( X := Lrand
268 unless IsSameLoc (Result, Rrand) resultis false
269 $)
270 if Op = Asa & IsNumber (X) then if EvalNumber (X!0, X!1) = 1 do
271 $( SetupAddr (Result)
272 Outop (Aos)
273 IndicatorsSetBy := 0
274 resultis true
275 $)
276 let r = nil
277 test Op = Ssa & X = Rrand
278 then r, Op := LoadNegative (X), Asa
279 or r := LoadRegister (X, AorQr)
280 SetupAddr (Result)
281 Outop (FormOpcode (Op, r))
282 IndicatorsSetBy := 0
283 RegisterUsage!r := 0
284 resultis true
285 $)
286
287 and IsSameLoc (t, u) = valof
288 switchon t!0 into
289 $( case LV_GLOBAL:
290 resultis u!0 = GLOBAL_S & t!1 = u!1 -> true, false
291 case LV_LOCAL:
292 resultis u!0 = LOCAL_S & t!1 = u!1 -> true, false
293 case LV_STATIC:
294 resultis u!0 = STATIC_S & t!1 = u!1 -> true, false
295 case TEMP_S:
296 unless u!0 = TEMP_S resultis false
297 let g, h = LookupTemp (t!1), LookupTemp (u!1)
298 if g = 0 | h = 0 resultis false
299 unless g!1 = LVECAP_S & h!1 = VECAP_S resultis false
300 resultis g!2 = h!2 & g!3 = h!3 & g!5 = h!5 & g!6 = h!6 & g!8 = h!8 -> true, false
301 default: resultis false
302 $)
303
304 and DiadicJumpcond (Op, L) be
305 $( let Reversed = valof switchon Op into
306 $( case EQ_S: case NE_S: case LS_S: case GR_S: case LE_S: case GE_S:
307 if IsZero (Rrand) do
308 $( CompareToZero (Lrand)
309 resultis false
310 $)
311 if IsZero (Lrand) do
312 $( CompareToZero (Rrand)
313 resultis true
314 $)
315 if InRegister (Rrand, AorQr) do
316 $( ApplyRL (Cmpa, AorQr)
317 IndicatorsSetBy := 0
318 resultis true
319 $)
320 ApplyLR (Cmpa, AorQr)
321 IndicatorsSetBy := 0
322 resultis false
323
324 case EQ_F: case NE_F: case LS_F: case GR_F: case LE_F: case GE_F:
325 if InRegister (Rrand, EAQr) do
326 $( ApplyRL (Fcmp, EAQr)
327 IndicatorsSetBy := 0
328 resultis true
329 $)
330 ApplyLR (Fcmp, EAQr)
331 IndicatorsSetBy := 0
332 resultis false
333
334 default: CGreport (UnexpectedCase, Op, "DiadicJumpcond")
335 return
336 $)
337
338 let t = valof switchon Op into
339 $( case EQ_S: case EQ_F: resultis Tze
340 case NE_S: case NE_F: resultis Tnz
341 case LS_S: case LS_F: resultis Reversed -> Tpnz, Tmi
342 case GR_S: case GR_F: resultis Reversed -> Tmi, Tpnz
343 case LE_S: case LE_F: resultis Reversed -> Tpl, Tmoz
344 case GE_S: case GE_F: resultis Reversed -> Tmoz, Tpl
345 $)
346
347 if Machine = 645 test t = Tmoz
348 then $( Outop2 (Tmi, L)
349 t := Tze
350 $)
351 or if t = Tpnz do
352 $( Outop3 (Tze, 2, Ic)
353 t := Tpl
354 $)
355 Outop2 (t, L)
356 DisclaimRegister (Lrand)
357 DisclaimRegister (Rrand)
358 $)
359
360 and MonadicJumpcond (Op, L) be
361 $( CompareToZero (Lrand)
362 Outop2 (Op = TRUE_S -> Tnz, Tze, L)
363 DisclaimRegister (Lrand)
364 $)