1
2
3
4
5
6
7
8
9
10
11
12 get "bcpl_cg_head"
13 get "bcpl_opcodes"
14
15 let OpcodeName (Op) = valof
16 switchon Op into
17 $( default: CGreport (UnexpectedCase, Op, "OpcodeName")
18 resultis "<error>"
19
20 case Abd: resultis "abd"
21 case Ada: resultis "ada"
22 case Ada + 1: resultis "adq"
23 case Adlx1: resultis "adlx1"
24 case Als: resultis "als"
25 case Als + 1: resultis "qls"
26 case Ana: resultis "ana"
27 case Ana + 1: resultis "anq"
28 case Ansa: resultis "ansa"
29 case Ansa + 1: resultis "ansq"
30 case Anx0: resultis "anx0"
31 case Aos: resultis "aos"
32 case Arl: resultis "arl"
33 case Arl + 1: resultis "qrl"
34 case Asa: resultis "asa"
35 case Asa + 1: resultis "asq"
36 case Cmpa: resultis "cmpa"
37 case Cmpa + 1: resultis "cmpq"
38 case Div: resultis "div"
39 case Dvf: resultis "dvf"
40 case Eabap: resultis "eabap"
41 case Eabap + 1: resultis "eabab"
42 case Eabap + 2: resultis "eabbp"
43 case Eabap + 3: resultis "eabbb"
44 case Eablp: resultis "eablp"
45 case Eablp + 1: resultis "eablb"
46 case Eapap: resultis "eapap"
47 case Eapab: resultis "eapab"
48 case Eapap + 2: resultis "eapbp"
49 case Eapab + 2: resultis "eapbb"
50 case Eaplp: resultis "eaplp"
51 case Eaplb: resultis "eaplb"
52 case Eaplp + 2: resultis "eapsp"
53 case Eaplb + 2: resultis "eapsb"
54 case Eax0: resultis "eax0"
55 case Eax0 + 1: resultis "eax1"
56 case Eax0 + 2: resultis "eax2"
57 case Eax0 + 3: resultis "eax3"
58 case Eax0 + 4: resultis "eax4"
59 case Eax0 + 5: resultis "eax5"
60 case Eax0 + 6: resultis "eax6"
61 case Eax0 + 7: resultis "eax7"
62 case Epaq: resultis "epaq"
63 case Era: resultis "era"
64 case Era + 1: resultis "erq"
65 case Ersa: resultis "ersa"
66 case Ersa + 1: resultis "ersq"
67 case Fad: resultis "fad"
68 case Fcmp: resultis "fcmp"
69 case Fdi: resultis "fdi"
70 case Fdv: resultis "fdv"
71 case Fld: resultis "fld"
72 case Fmp: resultis "fmp"
73 case Fneg: resultis "fneg"
74 case Fsb: resultis "fsb"
75 case Fstr: resultis "fstr"
76 case Fszn: resultis "fszn"
77 case Lca: resultis "lca"
78 case Lca + 1: resultis "lcq"
79 case Lda: resultis "lda"
80 case Lda + 1: resultis "ldq"
81 case Ldaq: resultis "ldaq"
82 case Ldx7: resultis "ldx7"
83 case Llr: resultis "llr"
84 case Lprpap: resultis "lprpap"
85 case Lprpap + 1: resultis "lprpab"
86 case Lprpap + 2: resultis "lprpbp"
87 case Lprpap + 3: resultis "lprpbb"
88 case Lprplp: resultis "lprplp"
89 case Lprplp + 1: resultis "lprplb"
90 case Lprplp + 2: resultis "lprpsp"
91 case Lprplp + 3: resultis "lprpsb"
92 case Lrl: resultis "lrl"
93 case Lxl0: resultis "lxl0"
94 case Lxl0 + 1: resultis "lxl1"
95 case Lxl0 + 2: resultis "lxl2"
96 case Lxl0 + 3: resultis "lxl3"
97 case Lxl0 + 4: resultis "lxl4"
98 case Lxl0 + 5: resultis "lxl5"
99 case Lxl0 + 6: resultis "lxl6"
100 case Lxl0 + 7: resultis "lxl7"
101 case Mpy: resultis "mpy"
102 case Neg: resultis "neg"
103 case Negl: resultis "negl"
104 case Ora: resultis "ora"
105 case Ora + 1: resultis "orq"
106 case Orsa: resultis "orsa"
107 case Orsa + 1: resultis "orsq"
108 case Sba: resultis "sba"
109 case Sba + 1: resultis "sbq"
110 case Sblx1: resultis "sblx1"
111 case Sprpap: resultis "sprpap"
112 case Sprpap + 1: resultis "sprpab"
113 case Sprpap + 2: resultis "sprpbp"
114 case Sprpap + 3: resultis "sprpbb"
115 case Sprplp: resultis "sprplp"
116 case Sprplp + 1: resultis "sprplb"
117 case Sprplp + 2: resultis "sprpsp"
118 case Sprplp + 3: resultis "sprpsb"
119 case Sreg: resultis "sreg"
120 case Ssa: resultis "ssa"
121 case Ssa + 1: resultis "ssq"
122 case Sta: resultis "sta"
123 case Sta + 1: resultis "stq"
124 case Staq: resultis "staq"
125 case Stb: resultis "stb"
126 case Stc1: resultis "stc1"
127 case Stcd: resultis "stcd"
128 case Stpap: resultis "stpap"
129 case Stpab: resultis "stpab"
130 case Stpap + 2: resultis "stpbp"
131 case Stpab + 2: resultis "stpbb"
132 case Stplp: resultis "stplp"
133 case Stplb: resultis "stplb"
134 case Stplp + 2: resultis "stpsp"
135 case Stplb + 2: resultis "stpsb"
136 case Stx0: resultis "stx0"
137 case Stz: resultis "stz"
138 case Sxl0: resultis "sxl0"
139 case Sxl1: resultis "sxl1"
140 case Szn: resultis "szn"
141 case Tmi: resultis "tmi"
142 case Tmoz: resultis "tmoz"
143 case Tnz: resultis "tnz"
144 case Tpl: resultis "tpl"
145 case Tpnz: resultis "tpnz"
146 case Tra: resultis "tra"
147 case Trc: resultis "trc"
148 case Tsbap: resultis "tsbap"
149 case Tsbbp: resultis "tsbbp"
150 case Tsblp: resultis "tsblp"
151 case Tsx0: resultis "tsx0"
152 case Tze: resultis "tze"
153 $)
154 and RegisterName (Reg) = valof
155 switchon Reg & TagXrMask into
156 $( case 0: resultis "n"
157 case Au: resultis "au"
158 case Al: resultis "al"
159 case Qu: resultis "qu"
160 case Ql: resultis "ql"
161 case Du: resultis "du"
162 case Dl: resultis "dl"
163 case Ic: resultis "ic"
164 case X0: resultis "x0"
165 case X1: resultis "x1"
166 case X2: resultis "x2"
167 case X3: resultis "x3"
168 case X4: resultis "x4"
169 case X5: resultis "x5"
170 case X6: resultis "x6"
171 case X7: resultis "x7"
172 $)
173 and BaseName (Base) = valof
174 switchon Base & TagPrMask into
175 $( case Ap: resultis "ap"
176 case Ab: resultis "ab"
177 case Bp: resultis "bp"
178 case Bb: resultis "bb"
179 case Lp: resultis "lp"
180 case Lb: resultis "lb"
181 case Sp: resultis "sp"
182 case Sb: resultis "sb"
183 $)
184
185 let WriteH (x) be
186 $( Writech (OUTPUT, '*s')
187 for i = 15 to 0 by -3 do
188 Writech (OUTPUT, '0' + ((x rshift i) & 7))
189 $)
190 and WriteNcount (n) be
191 $( let v = vec 20
192 ConvertNtoS (n, v, 10)
193 WriteS (OUTPUT, v)
194 Column := Column + Length (v)
195 $)
196 and WriteAddress (Address, Param) be
197 $( if Param ne 0 do
198 $( Writech (OUTPUT, 'L')
199 Column := Column + 1
200 WriteNcount (Param)
201 if Address = 0 return
202 if (Address & (1 lshift 17)) = 0 do
203 $( Writech (OUTPUT, '+')
204 Column := Column + 1
205 $)
206 $)
207 if (Address & (1 lshift 17)) ne 0 do
208 $( Writech (OUTPUT, '-')
209 Column := Column + 1
210 Address := - (Address | (true lshift 18))
211 $)
212 WriteNcount (Address)
213 $)
214
215 let WriteInstruction (Word, Param) be
216 $( Format (OUTPUT, "*t^s*t", OpcodeName ((Word rshift 9) & $8777 | (Word lshift 1) & $81000))
217 if (Word & $8100) ne 0 do
218 $( Format (OUTPUT, "^s|", BaseName (Word))
219 Column := Column + 3
220 test (Word & (1 lshift 32)) = 0
221 then Word := Word & (true rshift 3)
222 or Word := Word | (true lshift 33)
223 $)
224 if (Word & $877) = Ic do Word := Word + (LC lshift 18) - Ic
225 WriteAddress (Word rshift Left, Param)
226 if (Word & $877) ne 0 do
227 $( let Reg = RegisterName (Word & $817)
228 switchon Word & $860 into
229 $( case $800:
230 Format (OUTPUT, ",^s", Reg)
231 Column := Column + Length (Reg) + 1
232 endcase
233 case $820:
234 if (Word & $817) = 0 do Reg := ""
235 Format (OUTPUT, ",^s**", Reg)
236 Column := Column + Length (Reg) + 2
237 endcase
238 case $840:
239 Format (OUTPUT, ",^o", Word & $877)
240 Column := Column + 3
241 endcase
242 case $860:
243 Format (OUTPUT, ",**^s", Reg)
244 Column := Column + Length (Reg) + 2
245 $)
246 $)
247 $)
248 and WriteData (Word, Param) be
249 $( WriteS (OUTPUT, "*tzero*t")
250 WriteAddress (Word rshift Left, Param)
251 if (Word & Right) ne 0 do
252 $( Writech (OUTPUT, ',')
253 Column := Column + 1
254 WriteAddress (Word & Right, 0)
255 $)
256 $)
257
258 let ListCodeItem (p) be
259 $( let Flags, Word, Comment = p!0, p!1, p!2
260 switchon Flags & Right into
261 $( case CodeSwitch:
262 case InstructionSwitch:
263 case DataSwitch:
264 Writech (OUTPUT, GetRelCode ())
265 Writech (OUTPUT, GetRelCode ())
266 WriteH (LC)
267 Writech (OUTPUT, '*s')
268 WriteH (Word rshift 18)
269 WriteH (Word & $8777777)
270 Column := 0
271 test (Flags & Right) = InstructionSwitch
272 then $( if LineCount ne 0 do
273 $( Format (OUTPUT, " ^d", LineCount)
274 LineCount := 0
275 $)
276 Writech (OUTPUT, '*t')
277 let Param = Flags rshift Left
278 if Param ne 0 test (Word & TagXrMask) = X1
279 then Param := 0
280 or Word := Word - (LookupLabel (Param) lshift 18)
281 WriteInstruction (Word, Param)
282 $)
283 or if (Flags & Right) = DataSwitch do
284 $( Writech (OUTPUT, '*t')
285 WriteData (Word, 0)
286 $)
287 if Comment ne 0 do
288 $( if Column < 10 do Writech (OUTPUT, '*t')
289 Format (OUTPUT, "*t*" ^s", Comment)
290 $)
291 Writech (OUTPUT, '*n')
292 LC := LC + 1
293 return
294
295 case LabelSwitch:
296 Format (OUTPUT, "*t*t*tL^d:*n", Word)
297 return
298
299 case LineCountSwitch:
300 LineCount := Word
301 return
302
303 case HeaderSwitch:
304 let v = vec Vmax
305 Unpackstring (Comment, v)
306 Format (OUTPUT, "^c*t*"*t", v!1)
307 for i = 2 to v!0 do Writech (OUTPUT, v!i)
308 WriteS (OUTPUT, "*n*n")
309 return
310
311 case SectionSwitch:
312 LC := Word
313 RelbitsList, RelbitsOffset, AbsRelBits := Comment, 0, 0
314 return
315
316 default: CGreport (UnexpectedCase, Flags, "ListCodeItem")
317 $)
318 $)
319 and GetRelCode () = valof
320 $( if AbsRelBits > 0 do
321 $( AbsRelBits := AbsRelBits - 1
322 resultis 'a'
323 $)
324 if GetBits (1) = 0 resultis 'a'
325 let c = GetBits (4)
326 if c = (RelExtendedAbs & $817) do
327 $( AbsRelBits := GetBits (10) - 1
328 resultis 'a'
329 $)
330 resultis '0' + c
331 $)
332 and GetBits (n) = valof
333 $( RelbitsOffset := RelbitsOffset + n
334 if RelbitsList = 0 do
335 $( CGreport (PhaseError, "GetBits")
336 resultis 0
337 $)
338 let r = nil
339 test RelbitsOffset le 36
340 then r := RelbitsList!0 rshift (36 - RelbitsOffset)
341 or $( RelbitsOffset := RelbitsOffset - 36
342 r := RelbitsList!0 lshift RelbitsOffset
343 RelbitsList := RelbitsList!1
344 r := r | RelbitsList!0 rshift (36 - RelbitsOffset)
345 $)
346 resultis r & true rshift (36 - n)
347 $)