1
2
3
4
5
6
7
8
9
10
11
12 get "bcpl_cg_head"
13 get "bcpl_opcodes"
14
15 let CompRel (r) be
16 $( test r = 0
17 then $( if AbsRelBits ge 1023 do PutAbsBits ()
18 AbsRelBits := AbsRelBits + 1
19 $)
20 or $( unless AbsRelBits = 0 do PutAbsBits ()
21 PutBits (r, 5)
22 $)
23 $)
24 and PutAbsBits () be
25 $( test AbsRelBits le 15
26 then PutBits (0, AbsRelBits)
27 or PutBits (RelExtendedAbs lshift 10 | AbsRelBits, 15)
28 AbsRelBits := 0
29 $)
30 and PutBits (r, n) be
31 $( RelbitsOffset := RelbitsOffset + n
32 test RelbitsOffset le 36
33 then RelbitsList!0 := RelbitsList!0 | r lshift (36 - RelbitsOffset)
34 or $( RelbitsOffset := RelbitsOffset - 36
35 RelbitsList!0 := RelbitsList!0 | r rshift RelbitsOffset
36 let New = Newvec (1)
37 RelbitsList!1 := New
38 RelbitsList, RelbitsLength := New, RelbitsLength + 1
39 RelbitsList!0 := r lshift (36 - RelbitsOffset)
40 $)
41 $)
42
43 let PutCode (Flags, a, b) be
44 $( if CodeP ge CodeSize - 3 do
45 $( let y = Newvec (CodeSize)
46 CodeV!0, CodeV!1 := y, CodeP
47 CodeV, CodeP := y, 2
48 $)
49 CodeV!CodeP, CodeV!(CodeP + 1), CodeV!(CodeP + 2) := Flags, a, b
50 CodeP := CodeP + 3
51 $)
52 and OutWord (x, ListType) be
53 $( PutCode (Param lshift Left | ListType, x, Comment)
54 CompRel (Reloc rshift Left)
55 CompRel (Reloc & Right)
56 LC, Param, Reloc, Comment := LC + 1, 0, 0, 0
57 $)
58
59 let SetLineNumber (n) be
60 $( PutCode (LineCountSwitch, n)
61 if LineMap do
62 $( unless (LineMapList!0 rshift Left) = LC do
63 $( let New = Newvec (1)
64 LineMapList!1 := New
65 LineMapList, LineMapLength := New, LineMapLength + 1
66 $)
67 LineMapList!0 := LC lshift Left | n
68 $)
69 $)
70 and SectionHeader (Comment) be
71 PutCode (HeaderSwitch, 0, Comment)
72
73 let OutW (x) be
74 $( if Jumpsw return
75 OutWord (x, CodeSwitch)
76 $)
77 and OutW2 (x, c) be
78 $( Comment := c
79 OutW (x)
80 $)
81
82 and Outop (Op) be
83 $( if Jumpsw return
84 let a, t = Address, Tag
85 if Reloc = 0 then test t = 0 & Param ne 0
86 then a, t := a - LC, t | Ic
87 or if (t & TagPrMask) = Lp do Reloc := (t & Star) = 0 -> RelStat15 lshift Left, RelLink15 lshift Left
88 if (t & TagPrMask) ne 0 do a := a & $877777
89 let Ext, Rest = Op rshift 9, Op & $8777
90 let Word = (a lshift 18) | (Rest lshift 9) | (Ext lshift 8) | t
91 if Listing do
92 $( WriteInstruction (Word, Param)
93 Writech (OUTPUT, '*n')
94 $)
95 OutWord (Word, InstructionSwitch)
96 $)
97 and Outop2 (Op, P) be
98 $( Address, Tag, Param := 0, 0, P
99 Outop (Op)
100 $)
101 and Outop3 (Op, A, T) be
102 $( Address, Tag, Param := A, T, 0
103 CheckAddr ()
104 Outop (Op)
105 $)
106 and Outop4 (Op, A, T, C) be
107 $( Address, Tag, Param, Comment := A, T, 0, C
108 CheckAddr ()
109 Outop (Op)
110 $)
111
112 and OutData (w) be
113 $( if Jumpsw return
114 if Listing do
115 $( WriteData (w, Param)
116 Writech (OUTPUT, '*n')
117 $)
118 OutWord (w, DataSwitch)
119 $)
120
121 and FormOpcode (Op, r) = valof
122 $( let OpAB, OpLP = nil, nil
123 switchon Op into
124 $( case Ada: case Als: case Ana: case Ansa:
125 case Arl: case Asa: case Cmpa: case Era:
126 case Ersa: case Lca: case Lda: case Ora:
127 case Orsa: case Sba: case Ssa: case Sta:
128 if r = Ar resultis Op
129 if r = Qr resultis Op + 1
130 endcase
131
132 case Mpy: case Div:
133 if r = Qr resultis Op
134 endcase
135
136 case Fad: case Fcmp: case Fdi: case Fdv:
137 case Fld: case Fmp: case Fneg: case Fsb:
138 case Fstr:
139 if r = EAQr resultis Op
140 endcase
141
142 case Eax0: case Lxl0:
143 switchon r into
144 $( case Xr0: resultis Op
145 case Xr1: resultis Op + 1
146 case Xr2: resultis Op + 2
147 case Xr3: resultis Op + 3
148 case Xr4: resultis Op + 4
149 case Xr5: resultis Op + 5
150 case Xr6: resultis Op + 6
151 case Xr7: resultis Op + 7
152 default:
153 $)
154 endcase
155
156 case Eabap:
157 OpAB, OpLP := 1, Eablp - Eabap
158 goto Bases
159 case Eapap:
160 OpAB, OpLP := Eapab - Eapap, Eaplp - Eapap
161 goto Bases
162 case Stpap:
163 OpAB, OpLP := Stpab - Stpap, Stplp - Stpap
164 goto Bases
165 case Lprpap: case Sprpap:
166 OpAB, OpLP := 1, 4
167 Bases:
168 switchon r into
169 $( case Apr: resultis Op
170 case Abr: resultis Op + OpAB
171 case Bpr: resultis Op + 2
172 case Bbr: resultis Op + 2 + OpAB
173 case Lpr: resultis Op + OpLP
174 case Lbr: resultis Op + OpLP + OpAB
175 case Spr: resultis Op + OpLP + 2
176 case Sbr: resultis Op + OpLP + 2 + OpAB
177 default:
178 $)
179 default:
180 $)
181 CGreport (BadRegOpPair, r, Op)
182 resultis Op
183 $)
184 and FormTag (r) = valof
185 switchon r into
186 $( case Ar: resultis Al
187 case Qr: resultis Ql
188 case Xr0: resultis X0
189 case Xr1: resultis X1
190 case Xr2: resultis X2
191 case Xr3: resultis X3
192 case Xr4: resultis X4
193 case Xr5: resultis X5
194 case Xr6: resultis X6
195 case Xr7: resultis X7
196 case Apr: resultis Ap
197 case Abr: resultis Ab
198 case Bpr: resultis Bp
199 case Bbr: resultis Bb
200 case Lpr: resultis Lp
201 case Lbr: resultis Lb
202 case Spr: resultis Sp
203 case Sbr: resultis Sb
204 default: CGreport (UnexpectedCase, r, "FormTag")
205 resultis 0
206 case 0: resultis 0
207 $)
208
209
210 and CheckAddr () be
211 $( manifest
212 $( TwoToTheEighteenth = 1 lshift 18
213 TwoToTheFourteenth = 1 lshift 14
214 $)
215 unless - TwoToTheEighteenth le Address < TwoToTheEighteenth do CGreport (BadAddress, Address)
216 if (Tag & $8100) ne 0 then unless - TwoToTheFourteenth le Address < TwoToTheFourteenth do
217 $( let t, p, c = Tag, Param, Comment
218 Tag, Param, Comment := Tag & TagXrMask, 0, "compute offset"
219 Outop (Eax7)
220 IndicatorsSetBy := Xr7
221 Address, Tag, Param, Comment := 0, (t & not TagXrMask) | X7, p, c
222 $)
223 $)