1
2
3
4
5
6
7
8
9
10
11
12 get "bcpl_cg_head"
13 get "bcpl_opcodes"
14
15 let LookupTemp (a) = valof
16 $( let h = CgTempList
17 until h = 0 do
18 $( if h!0 = a resultis h
19 h := h!CgTempSize
20 $)
21 resultis 0
22 $)
23 and MakeCgTemp (a) = valof
24 $( let h = LookupTemp (a)
25 if h ne 0 resultis h
26 h := Newvec (CgTempSize)
27 h!CgTempSize := CgTempList
28 CgTempList := h
29 h!0, h!1 := a, 0
30 resultis h
31 $)
32
33 let IsNumber (t) = valof
34 switchon t!0 into
35 $( case NUMBER_S: case CONSTANT_S: case CHARCONST_S: case TRUE_S: case FALSE_S:
36 resultis true
37 default: resultis false
38 $)
39 and EvalNumber (Op, N) = valof
40 switchon Op into
41 $( case NUMBER_S:
42 resultis ConvertStoN (N)
43 case CONSTANT_S:
44 resultis N
45 case CHARCONST_S:
46 resultis FormCharconst (N)
47 case TRUE_S:
48 resultis true
49 case FALSE_S:
50 resultis false
51 default: CGreport (UnexpectedCase, Op, "EvalNumber")
52 resultis 0
53 $)
54 and IsZero (t) = IsNumber (t) -> EvalNumber (t!0, t!1) = 0, false
55 and IsAddress (t) = valof
56 switchon t!0 into
57 $( case STRINGCONST_S: case EXTERNAL_S: case TABLE_S:
58 case LABEL_S: case RTDEF_S:
59 case LV_GLOBAL: case LV_LOCAL: case LV_STATIC:
60 case LV_TEMP: case LV_ARG_OUT:
61 resultis true
62 case TEMP_S:
63 let h = LookupTemp (t!1)
64 if h = 0 resultis false
65 resultis h!1 = REGISTER_S -> Satisfactory (h!2, AnyPr), h!1 = LVECAP_S
66 case GLOBAL_S: case LOCAL_S: case STATIC_S:
67 case NUMBER_S: case CONSTANT_S: case CHARCONST_S: case TRUE_S: case FALSE_S:
68 resultis false
69 default: CGreport (UnexpectedCase, t!0, "IsAddress")
70 resultis false
71 $)
72 and IsStored (t) = valof
73 switchon t!0 into
74 $( case GLOBAL_S: case LOCAL_S: case STATIC_S:
75 resultis true
76 case TEMP_S:
77 let h = LookupTemp (t!1)
78 if h = 0 resultis true
79 resultis h!1 = VECAP_S
80 default: resultis false
81 $)
82 and FindInRegister (t, r) = valof
83 $( unless t!0 = TEMP_S resultis 0
84 let h = LookupTemp (t!1)
85 if h = 0 resultis 0
86 test h!1 = REGISTER_S
87 then if Satisfactory (h!2, r) resultis h!2
88 or if h!1 = LVECAP_S & IsZero (lv h!5) & h!8 = 0 resultis FindInRegister (lv h!2, r)
89 resultis 0
90 $)
91 and InRegister (t, r) = (FindInRegister (t, r) ne 0)
92
93 and CombineAddress (Pointer, Index, Delta) be
94 $( let Pr = GetRegister (AnyPr)
95 and Xr = IsZero (Index) -> 0, LoadIndex (Index, AnyXr)
96 SetupAddr (Pointer)
97 Comment := 0
98 test (Tag & TagXrMask) ne 0 & Xr ne 0 logor (Tag & Star) ne 0 & Delta ne 0
99 then $( Outop (FormOpcode (Eapap, Pr))
100 Address, Tag, Param := Delta, FormTag (Xr) | FormTag (Pr), 0
101 $)
102 or $( Address := Address + Delta
103 unless Xr = 0 do
104 $( Tag := Tag | FormTag (Xr)
105 if (Tag & Star) ne 0 do Tag := Tag + StarThenReg - Star
106 $)
107 $)
108 $)
109 and ClaimRegister (r, t) be
110 test r = 0
111 then DisclaimRegister (t)
112 or test t!0 = LV_TEMP
113 then $( let h = MakeCgTemp (t!1)
114 h!1, h!2 := REGISTER_S, Preserve (r)
115 RegisterTemps!r := h
116 $)
117 or $( StoreRegister (r, t)
118 DisclaimRegister (t)
119 $)
120 and DisclaimRegister (t) be
121 $( unless t!0 = TEMP_S return
122 let h = LookupTemp (t!1)
123 if h = 0 return
124 test h!1 = REGISTER_S
125 then RegisterTemps!(h!2), RegisterUsage!(h!2) := 0, 0
126 or $( DisclaimRegister (lv h!2)
127 DisclaimRegister (lv h!5)
128 $)
129 let p = lv CgTempList
130 until rv p = 0 do
131 $( if rv p = h do
132 $( rv p := h!CgTempSize
133 break
134 $)
135 p := lv ((rv p)!CgTempSize)
136 $)
137 Freevec (h, CgTempSize)
138 $)
139
140 let Complab (L) be
141 $( unless DeferredJumpLabel = 0 do
142 $( unless DeferredJumpLabel = L do
143 $( Jumpsw := false
144 Outop2 (Tra, DeferredJumpLabel)
145 $)
146 DeferredJumpLabel := 0
147 $)
148 ClearRegisters ()
149 ClearMemory ()
150 if Listing do Format (OUTPUT, "L^d:", L)
151 PutCode (LabelSwitch, L, LC)
152 DefineLab (L, LC)
153 Jumpsw, IndicatorsSetBy := false, 0
154 $)
155 and DefineLab (L, n) be
156 $( let P = LabelCell (L)
157 unless rv P = 0 do CGreport (DupLabel, L)
158 rv P := 1 lshift Left logor n
159 $)
160 and LookupLabel (L) = rv LabelCell (L)
161 and LabelCell (L) = valof
162 $( unless 0 < L < LabTableSize * 100 do
163 $( CGreport (BadLabel, L)
164 L := 0
165 $)
166 let Q = L / 100
167 let P = LabTable!Q
168 if P = 0 do
169 $( P := Newvec (100 - 1)
170 for i = 0 to 100 - 1 do P!i := 0
171 LabTable!Q := P
172 $)
173 resultis lv P!(L rem 100)
174 $)
175 and Compjump (n) be
176 $( unless Jumpsw do DeferredJumpLabel := n
177 Jumpsw := true
178 $)
179 and ClearMemory () be
180 return
181 and ClearRegisters () be
182 $( let T = table Xr2, Xr3, Xr4, Xr5, Xr6, Apr, Abr, Bpr, Bbr, Lbr, Ar, Qr, EAQr
183 for i = 0 to 12 do GetRegister (T!i)
184 $)
185
186 and Outstring (s) be
187 $( let v = vec Vmax
188 let Len = FormStringconst (s, v)
189 Comment := s
190 for i = 0 to Len do OutData (v!i)
191 $)
192 and OutLiterals () be
193 $( if NewLiteralsList = 0 return
194 ClearRegisters ()
195 SectionHeader ("*nLiteral pool")
196 let HaveAlignmentRequirements = true
197 until NewLiteralsList = 0 do
198 $( let Alignment = 2 - (LC & 1)
199 if HaveAlignmentRequirements do
200 $( let t, B = NewLiteralsList, false
201 until t = 0 do
202 $( if t!3 = Alignment do
203 $( PutOneLiteral (t)
204 goto OuterLoop
205 $)
206 if t!3 ne 0 do B := true
207 t := t!4
208 $)
209 HaveAlignmentRequirements := B
210 $)
211 let t = NewLiteralsList
212 until t = 0 do
213 $( if t!3 = 0 do
214 $( t!3 := Alignment
215 PutOneLiteral (t)
216 goto OuterLoop
217 $)
218 t := t!4
219 $)
220 HaveAlignmentRequirements := true
221 Comment := "padding"
222 OutData (0)
223 OuterLoop:
224 $)
225 $)
226 and PutOneLiteral (t) be
227 $( let u = lv NewLiteralsList
228 until rv u = t do u := lv (rv u)!4
229 rv u := t!4
230 Comment := t!2
231 let P = t!0
232 for i = 0 to t!1 * 2 - 2 by 2 do
233 $( unless P!i = 0 do Complab (P!i)
234 OutData (P!(i + 1))
235 $)
236 t!4 := OldLiteralsList
237 OldLiteralsList := t
238 $)
239
240 and AddLiteral (P, Len, C, Alignment) be
241 $( let Data, Ent = Newvec (Len * 2 - 1), Newvec (4)
242 for i = 0 to Len - 1 do Data!(i * 2), Data!(i * 2 + 1) := 0, P!i
243 Ent!0, Ent!1, Ent!2, Ent!3, Ent!4 := Data, Len, C, Alignment, NewLiteralsList
244 NewLiteralsList := Ent
245
246 let t = Ent!4
247 until t = 0 do
248 $( if CombineLiteral (Ent, t) return
249 t := t!4
250 $)
251 t := OldLiteralsList
252 until t = 0 do
253 $( if CombineLiteral (Ent, t) return
254 t := t!4
255 $)
256 t := Ent!4
257 until t = 0 do
258 $( CombineLiteral (t, Ent)
259 t := t!4
260 $)
261 if Data!0 = 0 do Data!0 := Nextparam ()
262 Address, Tag, Param, Comment := 0, 0, Data!0, C
263 $)
264 and CombineLiteral (New, Old) = valof
265 $( let Ndata, Odata = New!0, Old!0
266 for i = 0 to Old!1 - New!1 do
267 $( for j = 0 to New!1 - 1 if Ndata!(j * 2 + 1) ne Odata!((i + j) * 2 + 1)
268 | Ndata!(j * 2) ne 0 & Odata!((i + j) * 2) ne 0 goto OuterLoop
269 if New!3 ne 0 test Old!3 ne 0
270 then unless ((New!3 + Old!3 + i) & 1) = 0 goto OuterLoop
271 or Old!3 := 2 - ((New!3 + i) & 1)
272 for j = 0 to New!1 - 1 if Ndata!(j * 2) ne 0 do Odata!((i + j) * 2) := Ndata!(j * 2)
273 Address, Tag, Param := i, 0, Odata!0
274 let u = lv NewLiteralsList
275 until rv u = New do u := lv (rv u)!4
276 rv u := New!4
277 Freevec (Ndata, New!1 * 2 - 1)
278 Freevec (New, 4)
279 resultis true
280 OuterLoop:
281 $)
282 resultis false
283 $)